diff --git a/src/HOL/Analysis/Abstract_Topology_2.thy b/src/HOL/Analysis/Abstract_Topology_2.thy
--- a/src/HOL/Analysis/Abstract_Topology_2.thy
+++ b/src/HOL/Analysis/Abstract_Topology_2.thy
@@ -1,1601 +1,1599 @@
 (*  Author:     L C Paulson, University of Cambridge
     Author:     Amine Chaieb, University of Cambridge
     Author:     Robert Himmelmann, TU Muenchen
     Author:     Brian Huffman, Portland State University
 *)
 
 section \<open>Abstract Topology 2\<close>
 
 theory Abstract_Topology_2
   imports
     Elementary_Topology
     Abstract_Topology
     "HOL-Library.Indicator_Function"
 begin
 
 text \<open>Combination of Elementary and Abstract Topology\<close>
 
 lemma approachable_lt_le2: 
     "(\<exists>(d::real) > 0. \<forall>x. Q x \<longrightarrow> f x < d \<longrightarrow> P x) \<longleftrightarrow> (\<exists>d>0. \<forall>x. f x \<le> d \<longrightarrow> Q x \<longrightarrow> P x)"
   apply auto
   apply (rule_tac x="d/2" in exI, auto)
   done
 
 lemma triangle_lemma:
   fixes x y z :: real
   assumes x: "0 \<le> x"
     and y: "0 \<le> y"
     and z: "0 \<le> z"
     and xy: "x\<^sup>2 \<le> y\<^sup>2 + z\<^sup>2"
   shows "x \<le> y + z"
 proof -
   have "y\<^sup>2 + z\<^sup>2 \<le> y\<^sup>2 + 2 * y * z + z\<^sup>2"
     using z y by simp
   with xy have th: "x\<^sup>2 \<le> (y + z)\<^sup>2"
     by (simp add: power2_eq_square field_simps)
   from y z have yz: "y + z \<ge> 0"
     by arith
   from power2_le_imp_le[OF th yz] show ?thesis .
 qed
 
 lemma isCont_indicator:
   fixes x :: "'a::t2_space"
   shows "isCont (indicator A :: 'a \<Rightarrow> real) x = (x \<notin> frontier A)"
 proof auto
   fix x
   assume cts_at: "isCont (indicator A :: 'a \<Rightarrow> real) x" and fr: "x \<in> frontier A"
   with continuous_at_open have 1: "\<forall>V::real set. open V \<and> indicator A x \<in> V \<longrightarrow>
     (\<exists>U::'a set. open U \<and> x \<in> U \<and> (\<forall>y\<in>U. indicator A y \<in> V))" by auto
   show False
   proof (cases "x \<in> A")
     assume x: "x \<in> A"
     hence "indicator A x \<in> ({0<..<2} :: real set)" by simp
-    hence "\<exists>U. open U \<and> x \<in> U \<and> (\<forall>y\<in>U. indicator A y \<in> ({0<..<2} :: real set))"
-      using 1 open_greaterThanLessThan by blast
-    then guess U .. note U = this
+    with 1 obtain U where U: "open U" "x \<in> U" "\<forall>y\<in>U. indicator A y \<in> ({0<..<2} :: real set)"
+      using open_greaterThanLessThan by metis
     hence "\<forall>y\<in>U. indicator A y > (0::real)"
       unfolding greaterThanLessThan_def by auto
     hence "U \<subseteq> A" using indicator_eq_0_iff by force
     hence "x \<in> interior A" using U interiorI by auto
     thus ?thesis using fr unfolding frontier_def by simp
   next
     assume x: "x \<notin> A"
     hence "indicator A x \<in> ({-1<..<1} :: real set)" by simp
-    hence "\<exists>U. open U \<and> x \<in> U \<and> (\<forall>y\<in>U. indicator A y \<in> ({-1<..<1} :: real set))"
-      using 1 open_greaterThanLessThan by blast
-    then guess U .. note U = this
+    with 1 obtain U where U: "open U" "x \<in> U" "\<forall>y\<in>U. indicator A y \<in> ({-1<..<1} :: real set)"
+      using 1 open_greaterThanLessThan by metis
     hence "\<forall>y\<in>U. indicator A y < (1::real)"
       unfolding greaterThanLessThan_def by auto
     hence "U \<subseteq> -A" by auto
     hence "x \<in> interior (-A)" using U interiorI by auto
     thus ?thesis using fr interior_complement unfolding frontier_def by auto
   qed
 next
   assume nfr: "x \<notin> frontier A"
   hence "x \<in> interior A \<or> x \<in> interior (-A)"
     by (auto simp: frontier_def closure_interior)
   thus "isCont ((indicator A)::'a \<Rightarrow> real) x"
   proof
     assume int: "x \<in> interior A"
     then obtain U where U: "open U" "x \<in> U" "U \<subseteq> A" unfolding interior_def by auto
     hence "\<forall>y\<in>U. indicator A y = (1::real)" unfolding indicator_def by auto
     hence "continuous_on U (indicator A)" by (simp add: indicator_eq_1_iff)
     thus ?thesis using U continuous_on_eq_continuous_at by auto
   next
     assume ext: "x \<in> interior (-A)"
     then obtain U where U: "open U" "x \<in> U" "U \<subseteq> -A" unfolding interior_def by auto
     then have "continuous_on U (indicator A)"
       using continuous_on_topological by (auto simp: subset_iff)
     thus ?thesis using U continuous_on_eq_continuous_at by auto
   qed
 qed
 
 lemma closedin_limpt:
   "closedin (top_of_set T) S \<longleftrightarrow> S \<subseteq> T \<and> (\<forall>x. x islimpt S \<and> x \<in> T \<longrightarrow> x \<in> S)"
   apply (simp add: closedin_closed, safe)
    apply (simp add: closed_limpt islimpt_subset)
   apply (rule_tac x="closure S" in exI, simp)
   apply (force simp: closure_def)
   done
 
 lemma closedin_closed_eq: "closed S \<Longrightarrow> closedin (top_of_set S) T \<longleftrightarrow> closed T \<and> T \<subseteq> S"
   by (meson closedin_limpt closed_subset closedin_closed_trans)
 
 lemma connected_closed_set:
    "closed S
     \<Longrightarrow> connected S \<longleftrightarrow> (\<nexists>A B. closed A \<and> closed B \<and> A \<noteq> {} \<and> B \<noteq> {} \<and> A \<union> B = S \<and> A \<inter> B = {})"
   unfolding connected_closedin_eq closedin_closed_eq connected_closedin_eq by blast
 
 text \<open>If a connnected set is written as the union of two nonempty closed sets, then these sets
 have to intersect.\<close>
 
 lemma connected_as_closed_union:
   assumes "connected C" "C = A \<union> B" "closed A" "closed B" "A \<noteq> {}" "B \<noteq> {}"
   shows "A \<inter> B \<noteq> {}"
 by (metis assms closed_Un connected_closed_set)
 
 lemma closedin_subset_trans:
   "closedin (top_of_set U) S \<Longrightarrow> S \<subseteq> T \<Longrightarrow> T \<subseteq> U \<Longrightarrow>
     closedin (top_of_set T) S"
   by (meson closedin_limpt subset_iff)
 
 lemma openin_subset_trans:
   "openin (top_of_set U) S \<Longrightarrow> S \<subseteq> T \<Longrightarrow> T \<subseteq> U \<Longrightarrow>
     openin (top_of_set T) S"
   by (auto simp: openin_open)
 
 lemma closedin_compact:
    "\<lbrakk>compact S; closedin (top_of_set S) T\<rbrakk> \<Longrightarrow> compact T"
 by (metis closedin_closed compact_Int_closed)
 
 lemma closedin_compact_eq:
   fixes S :: "'a::t2_space set"
   shows
    "compact S
          \<Longrightarrow> (closedin (top_of_set S) T \<longleftrightarrow>
               compact T \<and> T \<subseteq> S)"
 by (metis closedin_imp_subset closedin_compact closed_subset compact_imp_closed)
 
 
 subsection \<open>Closure\<close>
 
 lemma euclidean_closure_of [simp]: "euclidean closure_of S = closure S"
   by (auto simp: closure_of_def closure_def islimpt_def)
 
 lemma closure_openin_Int_closure:
   assumes ope: "openin (top_of_set U) S" and "T \<subseteq> U"
   shows "closure(S \<inter> closure T) = closure(S \<inter> T)"
 proof
   obtain V where "open V" and S: "S = U \<inter> V"
     using ope using openin_open by metis
   show "closure (S \<inter> closure T) \<subseteq> closure (S \<inter> T)"
     proof (clarsimp simp: S)
       fix x
       assume  "x \<in> closure (U \<inter> V \<inter> closure T)"
       then have "V \<inter> closure T \<subseteq> A \<Longrightarrow> x \<in> closure A" for A
           by (metis closure_mono subsetD inf.coboundedI2 inf_assoc)
       then have "x \<in> closure (T \<inter> V)"
          by (metis \<open>open V\<close> closure_closure inf_commute open_Int_closure_subset)
       then show "x \<in> closure (U \<inter> V \<inter> T)"
         by (metis \<open>T \<subseteq> U\<close> inf.absorb_iff2 inf_assoc inf_commute)
     qed
 next
   show "closure (S \<inter> T) \<subseteq> closure (S \<inter> closure T)"
     by (meson Int_mono closure_mono closure_subset order_refl)
 qed
 
 corollary infinite_openin:
   fixes S :: "'a :: t1_space set"
   shows "\<lbrakk>openin (top_of_set U) S; x \<in> S; x islimpt U\<rbrakk> \<Longrightarrow> infinite S"
   by (clarsimp simp add: openin_open islimpt_eq_acc_point inf_commute)
 
 lemma closure_Int_ballI:
   assumes "\<And>U. \<lbrakk>openin (top_of_set S) U; U \<noteq> {}\<rbrakk> \<Longrightarrow> T \<inter> U \<noteq> {}"
   shows "S \<subseteq> closure T"
 proof (clarsimp simp: closure_iff_nhds_not_empty)
   fix x and A and V
   assume "x \<in> S" "V \<subseteq> A" "open V" "x \<in> V" "T \<inter> A = {}"
   then have "openin (top_of_set S) (A \<inter> V \<inter> S)"
     by (auto simp: openin_open intro!: exI[where x="V"])
   moreover have "A \<inter> V \<inter> S \<noteq> {}" using \<open>x \<in> V\<close> \<open>V \<subseteq> A\<close> \<open>x \<in> S\<close>
     by auto
   ultimately have "T \<inter> (A \<inter> V \<inter> S) \<noteq> {}"
     by (rule assms)
   with \<open>T \<inter> A = {}\<close> show False by auto
 qed
 
 
 subsection \<open>Frontier\<close>
 
 lemma euclidean_interior_of [simp]: "euclidean interior_of S = interior S"
   by (auto simp: interior_of_def interior_def)
 
 lemma euclidean_frontier_of [simp]: "euclidean frontier_of S = frontier S"
   by (auto simp: frontier_of_def frontier_def)
 
 lemma connected_Int_frontier:
      "\<lbrakk>connected s; s \<inter> t \<noteq> {}; s - t \<noteq> {}\<rbrakk> \<Longrightarrow> (s \<inter> frontier t \<noteq> {})"
   apply (simp add: frontier_interiors connected_openin, safe)
   apply (drule_tac x="s \<inter> interior t" in spec, safe)
    apply (drule_tac [2] x="s \<inter> interior (-t)" in spec)
    apply (auto simp: disjoint_eq_subset_Compl dest: interior_subset [THEN subsetD])
   done
 
 subsection \<open>Compactness\<close>
 
 lemma openin_delete:
   fixes a :: "'a :: t1_space"
   shows "openin (top_of_set u) s
          \<Longrightarrow> openin (top_of_set u) (s - {a})"
 by (metis Int_Diff open_delete openin_open)
 
 lemma compact_eq_openin_cover:
   "compact S \<longleftrightarrow>
     (\<forall>C. (\<forall>c\<in>C. openin (top_of_set S) c) \<and> S \<subseteq> \<Union>C \<longrightarrow>
       (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D))"
 proof safe
   fix C
   assume "compact S" and "\<forall>c\<in>C. openin (top_of_set S) c" and "S \<subseteq> \<Union>C"
   then have "\<forall>c\<in>{T. open T \<and> S \<inter> T \<in> C}. open c" and "S \<subseteq> \<Union>{T. open T \<and> S \<inter> T \<in> C}"
     unfolding openin_open by force+
   with \<open>compact S\<close> obtain D where "D \<subseteq> {T. open T \<and> S \<inter> T \<in> C}" and "finite D" and "S \<subseteq> \<Union>D"
     by (meson compactE)
   then have "image (\<lambda>T. S \<inter> T) D \<subseteq> C \<and> finite (image (\<lambda>T. S \<inter> T) D) \<and> S \<subseteq> \<Union>(image (\<lambda>T. S \<inter> T) D)"
     by auto
   then show "\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D" ..
 next
   assume 1: "\<forall>C. (\<forall>c\<in>C. openin (top_of_set S) c) \<and> S \<subseteq> \<Union>C \<longrightarrow>
         (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D)"
   show "compact S"
   proof (rule compactI)
     fix C
     let ?C = "image (\<lambda>T. S \<inter> T) C"
     assume "\<forall>t\<in>C. open t" and "S \<subseteq> \<Union>C"
     then have "(\<forall>c\<in>?C. openin (top_of_set S) c) \<and> S \<subseteq> \<Union>?C"
       unfolding openin_open by auto
     with 1 obtain D where "D \<subseteq> ?C" and "finite D" and "S \<subseteq> \<Union>D"
       by metis
     let ?D = "inv_into C (\<lambda>T. S \<inter> T) ` D"
     have "?D \<subseteq> C \<and> finite ?D \<and> S \<subseteq> \<Union>?D"
     proof (intro conjI)
       from \<open>D \<subseteq> ?C\<close> show "?D \<subseteq> C"
         by (fast intro: inv_into_into)
       from \<open>finite D\<close> show "finite ?D"
         by (rule finite_imageI)
       from \<open>S \<subseteq> \<Union>D\<close> show "S \<subseteq> \<Union>?D"
         apply (rule subset_trans)
         by (metis Int_Union Int_lower2 \<open>D \<subseteq> (\<inter>) S ` C\<close> image_inv_into_cancel)
     qed
     then show "\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D" ..
   qed
 qed
 
 
 subsection \<open>Continuity\<close>
 
 lemma interior_image_subset:
   assumes "inj f" "\<And>x. continuous (at x) f"
   shows "interior (f ` S) \<subseteq> f ` (interior S)"
 proof
   fix x assume "x \<in> interior (f ` S)"
   then obtain T where as: "open T" "x \<in> T" "T \<subseteq> f ` S" ..
   then have "x \<in> f ` S" by auto
   then obtain y where y: "y \<in> S" "x = f y" by auto
   have "open (f -` T)"
     using assms \<open>open T\<close> by (simp add: continuous_at_imp_continuous_on open_vimage)
   moreover have "y \<in> vimage f T"
     using \<open>x = f y\<close> \<open>x \<in> T\<close> by simp
   moreover have "vimage f T \<subseteq> S"
     using \<open>T \<subseteq> image f S\<close> \<open>inj f\<close> unfolding inj_on_def subset_eq by auto
   ultimately have "y \<in> interior S" ..
   with \<open>x = f y\<close> show "x \<in> f ` interior S" ..
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Equality of continuous functions on closure and related results\<close>
 
 lemma continuous_closedin_preimage_constant:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   shows "continuous_on S f \<Longrightarrow> closedin (top_of_set S) {x \<in> S. f x = a}"
   using continuous_closedin_preimage[of S f "{a}"] by (simp add: vimage_def Collect_conj_eq)
 
 lemma continuous_closed_preimage_constant:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   shows "continuous_on S f \<Longrightarrow> closed S \<Longrightarrow> closed {x \<in> S. f x = a}"
   using continuous_closed_preimage[of S f "{a}"] by (simp add: vimage_def Collect_conj_eq)
 
 lemma continuous_constant_on_closure:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   assumes "continuous_on (closure S) f"
       and "\<And>x. x \<in> S \<Longrightarrow> f x = a"
       and "x \<in> closure S"
   shows "f x = a"
     using continuous_closed_preimage_constant[of "closure S" f a]
       assms closure_minimal[of S "{x \<in> closure S. f x = a}"] closure_subset
     unfolding subset_eq
     by auto
 
 lemma image_closure_subset:
   assumes contf: "continuous_on (closure S) f"
     and "closed T"
     and "(f ` S) \<subseteq> T"
   shows "f ` (closure S) \<subseteq> T"
 proof -
   have "S \<subseteq> {x \<in> closure S. f x \<in> T}"
     using assms(3) closure_subset by auto
   moreover have "closed (closure S \<inter> f -` T)"
     using continuous_closed_preimage[OF contf] \<open>closed T\<close> by auto
   ultimately have "closure S = (closure S \<inter> f -` T)"
     using closure_minimal[of S "(closure S \<inter> f -` T)"] by auto
   then show ?thesis by auto
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A function constant on a set\<close>
 
 definition constant_on  (infixl "(constant'_on)" 50)
   where "f constant_on A \<equiv> \<exists>y. \<forall>x\<in>A. f x = y"
 
 lemma constant_on_subset: "\<lbrakk>f constant_on A; B \<subseteq> A\<rbrakk> \<Longrightarrow> f constant_on B"
   unfolding constant_on_def by blast
 
 lemma injective_not_constant:
   fixes S :: "'a::{perfect_space} set"
   shows "\<lbrakk>open S; inj_on f S; f constant_on S\<rbrakk> \<Longrightarrow> S = {}"
 unfolding constant_on_def
 by (metis equals0I inj_on_contraD islimpt_UNIV islimpt_def)
 
 lemma constant_on_closureI:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   assumes cof: "f constant_on S" and contf: "continuous_on (closure S) f"
     shows "f constant_on (closure S)"
 using continuous_constant_on_closure [OF contf] cof unfolding constant_on_def
 by metis
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Continuity relative to a union.\<close>
 
 lemma continuous_on_Un_local:
     "\<lbrakk>closedin (top_of_set (s \<union> t)) s; closedin (top_of_set (s \<union> t)) t;
       continuous_on s f; continuous_on t f\<rbrakk>
      \<Longrightarrow> continuous_on (s \<union> t) f"
   unfolding continuous_on closedin_limpt
   by (metis Lim_trivial_limit Lim_within_union Un_iff trivial_limit_within)
 
 lemma continuous_on_cases_local:
      "\<lbrakk>closedin (top_of_set (s \<union> t)) s; closedin (top_of_set (s \<union> t)) t;
        continuous_on s f; continuous_on t g;
        \<And>x. \<lbrakk>x \<in> s \<and> \<not>P x \<or> x \<in> t \<and> P x\<rbrakk> \<Longrightarrow> f x = g x\<rbrakk>
       \<Longrightarrow> continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
   by (rule continuous_on_Un_local) (auto intro: continuous_on_eq)
 
 lemma continuous_on_cases_le:
   fixes h :: "'a :: topological_space \<Rightarrow> real"
   assumes "continuous_on {t \<in> s. h t \<le> a} f"
       and "continuous_on {t \<in> s. a \<le> h t} g"
       and h: "continuous_on s h"
       and "\<And>t. \<lbrakk>t \<in> s; h t = a\<rbrakk> \<Longrightarrow> f t = g t"
     shows "continuous_on s (\<lambda>t. if h t \<le> a then f(t) else g(t))"
 proof -
   have s: "s = (s \<inter> h -` atMost a) \<union> (s \<inter> h -` atLeast a)"
     by force
   have 1: "closedin (top_of_set s) (s \<inter> h -` atMost a)"
     by (rule continuous_closedin_preimage [OF h closed_atMost])
   have 2: "closedin (top_of_set s) (s \<inter> h -` atLeast a)"
     by (rule continuous_closedin_preimage [OF h closed_atLeast])
   have eq: "s \<inter> h -` {..a} = {t \<in> s. h t \<le> a}" "s \<inter> h -` {a..} = {t \<in> s. a \<le> h t}"
     by auto
   show ?thesis
     apply (rule continuous_on_subset [of s, OF _ order_refl])
     apply (subst s)
     apply (rule continuous_on_cases_local)
     using 1 2 s assms apply (auto simp: eq)
     done
 qed
 
 lemma continuous_on_cases_1:
   fixes s :: "real set"
   assumes "continuous_on {t \<in> s. t \<le> a} f"
       and "continuous_on {t \<in> s. a \<le> t} g"
       and "a \<in> s \<Longrightarrow> f a = g a"
     shows "continuous_on s (\<lambda>t. if t \<le> a then f(t) else g(t))"
 using assms
 by (auto intro: continuous_on_cases_le [where h = id, simplified])
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Inverse function property for open/closed maps\<close>
 
 lemma continuous_on_inverse_open_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     and oo: "\<And>U. openin (top_of_set S) U \<Longrightarrow> openin (top_of_set T) (f ` U)"
   shows "continuous_on T g"
 proof -
   from imf injf have gTS: "g ` T = S"
     by force
   from imf injf have fU: "U \<subseteq> S \<Longrightarrow> (f ` U) = T \<inter> g -` U" for U
     by force
   show ?thesis
     by (simp add: continuous_on_open [of T g] gTS) (metis openin_imp_subset fU oo)
 qed
 
 lemma continuous_on_inverse_closed_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
     and oo: "\<And>U. closedin (top_of_set S) U \<Longrightarrow> closedin (top_of_set T) (f ` U)"
   shows "continuous_on T g"
 proof -
   from imf injf have gTS: "g ` T = S"
     by force
   from imf injf have fU: "U \<subseteq> S \<Longrightarrow> (f ` U) = T \<inter> g -` U" for U
     by force
   show ?thesis
     by (simp add: continuous_on_closed [of T g] gTS) (metis closedin_imp_subset fU oo)
 qed
 
 lemma homeomorphism_injective_open_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "inj_on f S"
     and oo: "\<And>U. openin (top_of_set S) U \<Longrightarrow> openin (top_of_set T) (f ` U)"
   obtains g where "homeomorphism S T f g"
 proof
   have "continuous_on T (inv_into S f)"
     by (metis contf continuous_on_inverse_open_map imf injf inv_into_f_f oo)
   with imf injf contf show "homeomorphism S T f (inv_into S f)"
     by (auto simp: homeomorphism_def)
 qed
 
 lemma homeomorphism_injective_closed_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "inj_on f S"
     and oo: "\<And>U. closedin (top_of_set S) U \<Longrightarrow> closedin (top_of_set T) (f ` U)"
   obtains g where "homeomorphism S T f g"
 proof
   have "continuous_on T (inv_into S f)"
     by (metis contf continuous_on_inverse_closed_map imf injf inv_into_f_f oo)
   with imf injf contf show "homeomorphism S T f (inv_into S f)"
     by (auto simp: homeomorphism_def)
 qed
 
 lemma homeomorphism_imp_open_map:
   assumes hom: "homeomorphism S T f g"
     and oo: "openin (top_of_set S) U"
   shows "openin (top_of_set T) (f ` U)"
 proof -
   from hom oo have [simp]: "f ` U = T \<inter> g -` U"
     using openin_subset by (fastforce simp: homeomorphism_def rev_image_eqI)
   from hom have "continuous_on T g"
     unfolding homeomorphism_def by blast
   moreover have "g ` T = S"
     by (metis hom homeomorphism_def)
   ultimately show ?thesis
     by (simp add: continuous_on_open oo)
 qed
 
 lemma homeomorphism_imp_closed_map:
   assumes hom: "homeomorphism S T f g"
     and oo: "closedin (top_of_set S) U"
   shows "closedin (top_of_set T) (f ` U)"
 proof -
   from hom oo have [simp]: "f ` U = T \<inter> g -` U"
     using closedin_subset by (fastforce simp: homeomorphism_def rev_image_eqI)
   from hom have "continuous_on T g"
     unfolding homeomorphism_def by blast
   moreover have "g ` T = S"
     by (metis hom homeomorphism_def)
   ultimately show ?thesis
     by (simp add: continuous_on_closed oo)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Seperability\<close>
 
 lemma subset_second_countable:
   obtains \<B> :: "'a:: second_countable_topology set set"
     where "countable \<B>"
           "{} \<notin> \<B>"
           "\<And>C. C \<in> \<B> \<Longrightarrow> openin(top_of_set S) C"
           "\<And>T. openin(top_of_set S) T \<Longrightarrow> \<exists>\<U>. \<U> \<subseteq> \<B> \<and> T = \<Union>\<U>"
 proof -
   obtain \<B> :: "'a set set"
     where "countable \<B>"
       and opeB: "\<And>C. C \<in> \<B> \<Longrightarrow> openin(top_of_set S) C"
       and \<B>:    "\<And>T. openin(top_of_set S) T \<Longrightarrow> \<exists>\<U>. \<U> \<subseteq> \<B> \<and> T = \<Union>\<U>"
   proof -
     obtain \<C> :: "'a set set"
       where "countable \<C>" and ope: "\<And>C. C \<in> \<C> \<Longrightarrow> open C"
         and \<C>: "\<And>S. open S \<Longrightarrow> \<exists>U. U \<subseteq> \<C> \<and> S = \<Union>U"
       by (metis univ_second_countable that)
     show ?thesis
     proof
       show "countable ((\<lambda>C. S \<inter> C) ` \<C>)"
         by (simp add: \<open>countable \<C>\<close>)
       show "\<And>C. C \<in> (\<inter>) S ` \<C> \<Longrightarrow> openin (top_of_set S) C"
         using ope by auto
       show "\<And>T. openin (top_of_set S) T \<Longrightarrow> \<exists>\<U>\<subseteq>(\<inter>) S ` \<C>. T = \<Union>\<U>"
         by (metis \<C> image_mono inf_Sup openin_open)
     qed
   qed
   show ?thesis
   proof
     show "countable (\<B> - {{}})"
       using \<open>countable \<B>\<close> by blast
     show "\<And>C. \<lbrakk>C \<in> \<B> - {{}}\<rbrakk> \<Longrightarrow> openin (top_of_set S) C"
       by (simp add: \<open>\<And>C. C \<in> \<B> \<Longrightarrow> openin (top_of_set S) C\<close>)
     show "\<exists>\<U>\<subseteq>\<B> - {{}}. T = \<Union>\<U>" if "openin (top_of_set S) T" for T
       using \<B> [OF that]
       apply clarify
       apply (rule_tac x="\<U> - {{}}" in exI, auto)
         done
   qed auto
 qed
 
 lemma Lindelof_openin:
   fixes \<F> :: "'a::second_countable_topology set set"
   assumes "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set U) S"
   obtains \<F>' where "\<F>' \<subseteq> \<F>" "countable \<F>'" "\<Union>\<F>' = \<Union>\<F>"
 proof -
   have "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>T. open T \<and> S = U \<inter> T"
     using assms by (simp add: openin_open)
   then obtain tf where tf: "\<And>S. S \<in> \<F> \<Longrightarrow> open (tf S) \<and> (S = U \<inter> tf S)"
     by metis
   have [simp]: "\<And>\<F>'. \<F>' \<subseteq> \<F> \<Longrightarrow> \<Union>\<F>' = U \<inter> \<Union>(tf ` \<F>')"
     using tf by fastforce
   obtain \<G> where "countable \<G> \<and> \<G> \<subseteq> tf ` \<F>" "\<Union>\<G> = \<Union>(tf ` \<F>)"
     using tf by (force intro: Lindelof [of "tf ` \<F>"])
   then obtain \<F>' where \<F>': "\<F>' \<subseteq> \<F>" "countable \<F>'" "\<Union>\<F>' = \<Union>\<F>"
     by (clarsimp simp add: countable_subset_image)
   then show ?thesis ..
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Closed Maps\<close>
 
 lemma continuous_imp_closed_map:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::t2_space"
   assumes "closedin (top_of_set S) U"
           "continuous_on S f" "f ` S = T" "compact S"
     shows "closedin (top_of_set T) (f ` U)"
   by (metis assms closedin_compact_eq compact_continuous_image continuous_on_subset subset_image_iff)
 
 lemma closed_map_restrict:
   assumes cloU: "closedin (top_of_set (S \<inter> f -` T')) U"
     and cc: "\<And>U. closedin (top_of_set S) U \<Longrightarrow> closedin (top_of_set T) (f ` U)"
     and "T' \<subseteq> T"
   shows "closedin (top_of_set T') (f ` U)"
 proof -
   obtain V where "closed V" "U = S \<inter> f -` T' \<inter> V"
     using cloU by (auto simp: closedin_closed)
   with cc [of "S \<inter> V"] \<open>T' \<subseteq> T\<close> show ?thesis
     by (fastforce simp add: closedin_closed)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Open Maps\<close>
 
 lemma open_map_restrict:
   assumes opeU: "openin (top_of_set (S \<inter> f -` T')) U"
     and oo: "\<And>U. openin (top_of_set S) U \<Longrightarrow> openin (top_of_set T) (f ` U)"
     and "T' \<subseteq> T"
   shows "openin (top_of_set T') (f ` U)"
 proof -
   obtain V where "open V" "U = S \<inter> f -` T' \<inter> V"
     using opeU by (auto simp: openin_open)
   with oo [of "S \<inter> V"] \<open>T' \<subseteq> T\<close> show ?thesis
     by (fastforce simp add: openin_open)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Quotient maps\<close>
 
 lemma quotient_map_imp_continuous_open:
   assumes T: "f ` S \<subseteq> T"
       and ope: "\<And>U. U \<subseteq> T
               \<Longrightarrow> (openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
                    openin (top_of_set T) U)"
     shows "continuous_on S f"
 proof -
   have [simp]: "S \<inter> f -` f ` S = S" by auto
   show ?thesis
     by (meson T continuous_on_open_gen ope openin_imp_subset)
 qed
 
 lemma quotient_map_imp_continuous_closed:
   assumes T: "f ` S \<subseteq> T"
       and ope: "\<And>U. U \<subseteq> T
                   \<Longrightarrow> (closedin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
                        closedin (top_of_set T) U)"
     shows "continuous_on S f"
 proof -
   have [simp]: "S \<inter> f -` f ` S = S" by auto
   show ?thesis
     by (meson T closedin_imp_subset continuous_on_closed_gen ope)
 qed
 
 lemma open_map_imp_quotient_map:
   assumes contf: "continuous_on S f"
       and T: "T \<subseteq> f ` S"
       and ope: "\<And>T. openin (top_of_set S) T
                    \<Longrightarrow> openin (top_of_set (f ` S)) (f ` T)"
     shows "openin (top_of_set S) (S \<inter> f -` T) =
            openin (top_of_set (f ` S)) T"
 proof -
   have "T = f ` (S \<inter> f -` T)"
     using T by blast
   then show ?thesis
     using "ope" contf continuous_on_open by metis
 qed
 
 lemma closed_map_imp_quotient_map:
   assumes contf: "continuous_on S f"
       and T: "T \<subseteq> f ` S"
       and ope: "\<And>T. closedin (top_of_set S) T
               \<Longrightarrow> closedin (top_of_set (f ` S)) (f ` T)"
     shows "openin (top_of_set S) (S \<inter> f -` T) \<longleftrightarrow>
            openin (top_of_set (f ` S)) T"
           (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have *: "closedin (top_of_set S) (S - (S \<inter> f -` T))"
     using closedin_diff by fastforce
   have [simp]: "(f ` S - f ` (S - (S \<inter> f -` T))) = T"
     using T by blast
   show ?rhs
     using ope [OF *, unfolded closedin_def] by auto
 next
   assume ?rhs
   with contf show ?lhs
     by (auto simp: continuous_on_open)
 qed
 
 lemma continuous_right_inverse_imp_quotient_map:
   assumes contf: "continuous_on S f" and imf: "f ` S \<subseteq> T"
       and contg: "continuous_on T g" and img: "g ` T \<subseteq> S"
       and fg [simp]: "\<And>y. y \<in> T \<Longrightarrow> f(g y) = y"
       and U: "U \<subseteq> T"
     shows "openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
            openin (top_of_set T) U"
           (is "?lhs = ?rhs")
 proof -
   have f: "\<And>Z. openin (top_of_set (f ` S)) Z \<Longrightarrow>
                 openin (top_of_set S) (S \<inter> f -` Z)"
   and  g: "\<And>Z. openin (top_of_set (g ` T)) Z \<Longrightarrow>
                 openin (top_of_set T) (T \<inter> g -` Z)"
     using contf contg by (auto simp: continuous_on_open)
   show ?thesis
   proof
     have "T \<inter> g -` (g ` T \<inter> (S \<inter> f -` U)) = {x \<in> T. f (g x) \<in> U}"
       using imf img by blast
     also have "... = U"
       using U by auto
     finally have eq: "T \<inter> g -` (g ` T \<inter> (S \<inter> f -` U)) = U" .
     assume ?lhs
     then have *: "openin (top_of_set (g ` T)) (g ` T \<inter> (S \<inter> f -` U))"
       by (meson img openin_Int openin_subtopology_Int_subset openin_subtopology_self)
     show ?rhs
       using g [OF *] eq by auto
   next
     assume rhs: ?rhs
     show ?lhs
       by (metis f fg image_eqI image_subset_iff imf img openin_subopen openin_subtopology_self openin_trans rhs)
   qed
 qed
 
 lemma continuous_left_inverse_imp_quotient_map:
   assumes "continuous_on S f"
       and "continuous_on (f ` S) g"
       and  "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
       and "U \<subseteq> f ` S"
     shows "openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
            openin (top_of_set (f ` S)) U"
 apply (rule continuous_right_inverse_imp_quotient_map)
 using assms apply force+
 done
 
 lemma continuous_imp_quotient_map:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::t2_space"
   assumes "continuous_on S f" "f ` S = T" "compact S" "U \<subseteq> T"
     shows "openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
            openin (top_of_set T) U"
   by (metis (no_types, lifting) assms closed_map_imp_quotient_map continuous_imp_closed_map)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Pasting lemmas for functions, for of casewise definitions\<close>
 
 subsubsection\<open>on open sets\<close>
 
 lemma pasting_lemma:
   assumes ope: "\<And>i. i \<in> I \<Longrightarrow> openin X (T i)"
       and cont: "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
       and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
       and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
     shows "continuous_map X Y g"
   unfolding continuous_map_openin_preimage_eq
 proof (intro conjI allI impI)
   show "g ` topspace X \<subseteq> topspace Y"
     using g cont continuous_map_image_subset_topspace by fastforce
 next
   fix U
   assume Y: "openin Y U"
   have T: "T i \<subseteq> topspace X" if "i \<in> I" for i
     using ope by (simp add: openin_subset that)
   have *: "topspace X \<inter> g -` U = (\<Union>i \<in> I. T i \<inter> f i -` U)"
     using f g T by fastforce
   have "\<And>i. i \<in> I \<Longrightarrow> openin X (T i \<inter> f i -` U)"
     using cont unfolding continuous_map_openin_preimage_eq
     by (metis Y T inf.commute inf_absorb1 ope topspace_subtopology openin_trans_full)
   then show "openin X (topspace X \<inter> g -` U)"
     by (auto simp: *)
 qed
 
 lemma pasting_lemma_exists:
   assumes X: "topspace X \<subseteq> (\<Union>i \<in> I. T i)"
       and ope: "\<And>i. i \<in> I \<Longrightarrow> openin X (T i)"
       and cont: "\<And>i. i \<in> I \<Longrightarrow> continuous_map (subtopology X (T i)) Y (f i)"
       and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     obtains g where "continuous_map X Y g" "\<And>x i. \<lbrakk>i \<in> I; x \<in> topspace X \<inter> T i\<rbrakk> \<Longrightarrow> g x = f i x"
 proof
   let ?h = "\<lambda>x. f (SOME i. i \<in> I \<and> x \<in> T i) x"
   show "continuous_map X Y ?h"
     apply (rule pasting_lemma [OF ope cont])
      apply (blast intro: f)+
     by (metis (no_types, lifting) UN_E X subsetD someI_ex)
   show "f (SOME i. i \<in> I \<and> x \<in> T i) x = f i x" if "i \<in> I" "x \<in> topspace X \<inter> T i" for i x
     by (metis (no_types, lifting) IntD2 IntI f someI_ex that)
 qed
 
 lemma pasting_lemma_locally_finite:
   assumes fin: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>V. openin X V \<and> x \<in> V \<and> finite {i \<in> I. T i \<inter> V \<noteq> {}}"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
   shows "continuous_map X Y g"
   unfolding continuous_map_closedin_preimage_eq
 proof (intro conjI allI impI)
   show "g ` topspace X \<subseteq> topspace Y"
     using g cont continuous_map_image_subset_topspace by fastforce
 next
   fix U
   assume Y: "closedin Y U"
   have T: "T i \<subseteq> topspace X" if "i \<in> I" for i
     using clo by (simp add: closedin_subset that)
   have *: "topspace X \<inter> g -` U = (\<Union>i \<in> I. T i \<inter> f i -` U)"
     using f g T by fastforce
   have cTf: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i \<inter> f i -` U)"
     using cont unfolding continuous_map_closedin_preimage_eq topspace_subtopology
     by (simp add: Int_absorb1 T Y clo closedin_closed_subtopology)
   have sub: "{Z \<in> (\<lambda>i. T i \<inter> f i -` U) ` I. Z \<inter> V \<noteq> {}}
            \<subseteq> (\<lambda>i. T i \<inter> f i -` U) ` {i \<in> I. T i \<inter> V \<noteq> {}}" for V
     by auto
   have 1: "(\<Union>i\<in>I. T i \<inter> f i -` U) \<subseteq> topspace X"
     using T by blast
   then have lf: "locally_finite_in X ((\<lambda>i. T i \<inter> f i -` U) ` I)"
     unfolding locally_finite_in_def
     using finite_subset [OF sub] fin by force
   show "closedin X (topspace X \<inter> g -` U)"
     apply (subst *)
     apply (rule closedin_locally_finite_Union)
      apply (auto intro: cTf lf)
     done
 qed
 
 subsubsection\<open>Likewise on closed sets, with a finiteness assumption\<close>
 
 lemma pasting_lemma_closed:
   assumes fin: "finite I"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
   shows "continuous_map X Y g"
   using pasting_lemma_locally_finite [OF _ clo cont f g] fin by auto
 
 lemma pasting_lemma_exists_locally_finite:
   assumes fin: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>V. openin X V \<and> x \<in> V \<and> finite {i \<in> I. T i \<inter> V \<noteq> {}}"
     and X: "topspace X \<subseteq> \<Union>(T ` I)"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
   obtains g where "continuous_map X Y g" "\<And>x i. \<lbrakk>i \<in> I; x \<in> topspace X \<inter> T i\<rbrakk> \<Longrightarrow> g x = f i x"
 proof
   show "continuous_map X Y (\<lambda>x. f(@i. i \<in> I \<and> x \<in> T i) x)"
     apply (rule pasting_lemma_locally_finite [OF fin])
         apply (blast intro: assms)+
     by (metis (no_types, lifting) UN_E X set_rev_mp someI_ex)
 next
   fix x i
   assume "i \<in> I" and "x \<in> topspace X \<inter> T i"
   show "f (SOME i. i \<in> I \<and> x \<in> T i) x = f i x"
     apply (rule someI2_ex)
     using \<open>i \<in> I\<close> \<open>x \<in> topspace X \<inter> T i\<close> apply blast
     by (meson Int_iff \<open>i \<in> I\<close> \<open>x \<in> topspace X \<inter> T i\<close> f)
 qed
 
 lemma pasting_lemma_exists_closed:
   assumes fin: "finite I"
     and X: "topspace X \<subseteq> \<Union>(T ` I)"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
   obtains g where "continuous_map X Y g" "\<And>x i. \<lbrakk>i \<in> I; x \<in> topspace X \<inter> T i\<rbrakk> \<Longrightarrow> g x = f i x"
 proof
   show "continuous_map X Y (\<lambda>x. f (SOME i. i \<in> I \<and> x \<in> T i) x)"
     apply (rule pasting_lemma_closed [OF \<open>finite I\<close> clo cont])
      apply (blast intro: f)+
     by (metis (mono_tags, lifting) UN_iff X someI_ex subset_iff)
 next
   fix x i
   assume "i \<in> I" "x \<in> topspace X \<inter> T i"
   then show "f (SOME i. i \<in> I \<and> x \<in> T i) x = f i x"
     by (metis (no_types, lifting) IntD2 IntI f someI_ex)
 qed
 
 lemma continuous_map_cases:
   assumes f: "continuous_map (subtopology X (X closure_of {x. P x})) Y f"
       and g: "continuous_map (subtopology X (X closure_of {x. \<not> P x})) Y g"
       and fg: "\<And>x. x \<in> X frontier_of {x. P x} \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if P x then f x else g x)"
 proof (rule pasting_lemma_closed)
   let ?f = "\<lambda>b. if b then f else g"
   let ?g = "\<lambda>x. if P x then f x else g x"
   let ?T = "\<lambda>b. if b then X closure_of {x. P x} else X closure_of {x. ~P x}"
   show "finite {True,False}" by auto
   have eq: "topspace X - Collect P = topspace X \<inter> {x. \<not> P x}"
     by blast
   show "?f i x = ?f j x"
     if "i \<in> {True,False}" "j \<in> {True,False}" and x: "x \<in> topspace X \<inter> ?T i \<inter> ?T j" for i j x
   proof -
     have "f x = g x"
       if "i" "\<not> j"
       apply (rule fg)
       unfolding frontier_of_closures eq
       using x that closure_of_restrict by fastforce
     moreover
     have "g x = f x"
       if "x \<in> X closure_of {x. \<not> P x}" "x \<in> X closure_of Collect P" "\<not> i" "j" for x
         apply (rule fg [symmetric])
         unfolding frontier_of_closures eq
         using x that closure_of_restrict by fastforce
     ultimately show ?thesis
       using that by (auto simp flip: closure_of_restrict)
   qed
   show "\<exists>j. j \<in> {True,False} \<and> x \<in> ?T j \<and> (if P x then f x else g x) = ?f j x"
     if "x \<in> topspace X" for x
     apply simp
     apply safe
     apply (metis Int_iff closure_of inf_sup_absorb mem_Collect_eq that)
     by (metis DiffI eq closure_of_subset_Int contra_subsetD mem_Collect_eq that)
 qed (auto simp: f g)
 
 lemma continuous_map_cases_alt:
   assumes f: "continuous_map (subtopology X (X closure_of {x \<in> topspace X. P x})) Y f"
       and g: "continuous_map (subtopology X (X closure_of {x \<in> topspace X. ~P x})) Y g"
       and fg: "\<And>x. x \<in> X frontier_of {x \<in> topspace X. P x} \<Longrightarrow> f x = g x"
     shows "continuous_map X Y (\<lambda>x. if P x then f x else g x)"
   apply (rule continuous_map_cases)
   using assms
     apply (simp_all add: Collect_conj_eq closure_of_restrict [symmetric] frontier_of_restrict [symmetric])
   done
 
 lemma continuous_map_cases_function:
   assumes contp: "continuous_map X Z p"
     and contf: "continuous_map (subtopology X {x \<in> topspace X. p x \<in> Z closure_of U}) Y f"
     and contg: "continuous_map (subtopology X {x \<in> topspace X. p x \<in> Z closure_of (topspace Z - U)}) Y g"
     and fg: "\<And>x. \<lbrakk>x \<in> topspace X; p x \<in> Z frontier_of U\<rbrakk> \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if p x \<in> U then f x else g x)"
 proof (rule continuous_map_cases_alt)
   show "continuous_map (subtopology X (X closure_of {x \<in> topspace X. p x \<in> U})) Y f"
   proof (rule continuous_map_from_subtopology_mono)
     let ?T = "{x \<in> topspace X. p x \<in> Z closure_of U}"
     show "continuous_map (subtopology X ?T) Y f"
       by (simp add: contf)
     show "X closure_of {x \<in> topspace X. p x \<in> U} \<subseteq> ?T"
       by (rule continuous_map_closure_preimage_subset [OF contp])
   qed
   show "continuous_map (subtopology X (X closure_of {x \<in> topspace X. p x \<notin> U})) Y g"
   proof (rule continuous_map_from_subtopology_mono)
     let ?T = "{x \<in> topspace X. p x \<in> Z closure_of (topspace Z - U)}"
     show "continuous_map (subtopology X ?T) Y g"
       by (simp add: contg)
     have "X closure_of {x \<in> topspace X. p x \<notin> U} \<subseteq> X closure_of {x \<in> topspace X. p x \<in> topspace Z - U}"
       apply (rule closure_of_mono)
       using continuous_map_closedin contp by fastforce
     then show "X closure_of {x \<in> topspace X. p x \<notin> U} \<subseteq> ?T"
       by (rule order_trans [OF _ continuous_map_closure_preimage_subset [OF contp]])
   qed
 next
   show "f x = g x" if "x \<in> X frontier_of {x \<in> topspace X. p x \<in> U}" for x
     using that continuous_map_frontier_frontier_preimage_subset [OF contp, of U] fg by blast
 qed
 
 subsection \<open>Retractions\<close>
 
 definition\<^marker>\<open>tag important\<close> retraction :: "('a::topological_space) set \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> bool"
 where "retraction S T r \<longleftrightarrow>
   T \<subseteq> S \<and> continuous_on S r \<and> r ` S \<subseteq> T \<and> (\<forall>x\<in>T. r x = x)"
 
 definition\<^marker>\<open>tag important\<close> retract_of (infixl "retract'_of" 50) where
 "T retract_of S  \<longleftrightarrow>  (\<exists>r. retraction S T r)"
 
 lemma retraction_idempotent: "retraction S T r \<Longrightarrow> x \<in> S \<Longrightarrow>  r (r x) = r x"
   unfolding retraction_def by auto
 
 text \<open>Preservation of fixpoints under (more general notion of) retraction\<close>
 
 lemma invertible_fixpoint_property:
   fixes S :: "'a::topological_space set"
     and T :: "'b::topological_space set"
   assumes contt: "continuous_on T i"
     and "i ` T \<subseteq> S"
     and contr: "continuous_on S r"
     and "r ` S \<subseteq> T"
     and ri: "\<And>y. y \<in> T \<Longrightarrow> r (i y) = y"
     and FP: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>x\<in>S. f x = x"
     and contg: "continuous_on T g"
     and "g ` T \<subseteq> T"
   obtains y where "y \<in> T" and "g y = y"
 proof -
   have "\<exists>x\<in>S. (i \<circ> g \<circ> r) x = x"
   proof (rule FP)
     show "continuous_on S (i \<circ> g \<circ> r)"
       by (meson contt contr assms(4) contg assms(8) continuous_on_compose continuous_on_subset)
     show "(i \<circ> g \<circ> r) ` S \<subseteq> S"
       using assms(2,4,8) by force
   qed
   then obtain x where x: "x \<in> S" "(i \<circ> g \<circ> r) x = x" ..
   then have *: "g (r x) \<in> T"
     using assms(4,8) by auto
   have "r ((i \<circ> g \<circ> r) x) = r x"
     using x by auto
   then show ?thesis
     using "*" ri that by auto
 qed
 
 lemma homeomorphic_fixpoint_property:
   fixes S :: "'a::topological_space set"
     and T :: "'b::topological_space set"
   assumes "S homeomorphic T"
   shows "(\<forall>f. continuous_on S f \<and> f ` S \<subseteq> S \<longrightarrow> (\<exists>x\<in>S. f x = x)) \<longleftrightarrow>
          (\<forall>g. continuous_on T g \<and> g ` T \<subseteq> T \<longrightarrow> (\<exists>y\<in>T. g y = y))"
          (is "?lhs = ?rhs")
 proof -
   obtain r i where r:
       "\<forall>x\<in>S. i (r x) = x" "r ` S = T" "continuous_on S r"
       "\<forall>y\<in>T. r (i y) = y" "i ` T = S" "continuous_on T i"
     using assms unfolding homeomorphic_def homeomorphism_def  by blast
   show ?thesis
   proof
     assume ?lhs
     with r show ?rhs
       by (metis invertible_fixpoint_property[of T i S r] order_refl)
   next
     assume ?rhs
     with r show ?lhs
       by (metis invertible_fixpoint_property[of S r T i] order_refl)
   qed
 qed
 
 lemma retract_fixpoint_property:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
     and S :: "'a set"
   assumes "T retract_of S"
     and FP: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>x\<in>S. f x = x"
     and contg: "continuous_on T g"
     and "g ` T \<subseteq> T"
   obtains y where "y \<in> T" and "g y = y"
 proof -
   obtain h where "retraction S T h"
     using assms(1) unfolding retract_of_def ..
   then show ?thesis
     unfolding retraction_def
     using invertible_fixpoint_property[OF continuous_on_id _ _ _ _ FP]
     by (metis assms(4) contg image_ident that)
 qed
 
 lemma retraction:
   "retraction S T r \<longleftrightarrow>
     T \<subseteq> S \<and> continuous_on S r \<and> r ` S = T \<and> (\<forall>x \<in> T. r x = x)"
   by (force simp: retraction_def)
 
 lemma retractionE: \<comment> \<open>yields properties normalized wrt. simp -- less likely to loop\<close>
   assumes "retraction S T r"
   obtains "T = r ` S" "r ` S \<subseteq> S" "continuous_on S r" "\<And>x. x \<in> S \<Longrightarrow> r (r x) = r x"
 proof (rule that)
   from retraction [of S T r] assms
   have "T \<subseteq> S" "continuous_on S r" "r ` S = T" and "\<forall>x \<in> T. r x = x"
     by simp_all
   then show "T = r ` S" "r ` S \<subseteq> S" "continuous_on S r"
     by simp_all
   from \<open>\<forall>x \<in> T. r x = x\<close> have "r x = x" if "x \<in> T" for x
     using that by simp
   with \<open>r ` S = T\<close> show "r (r x) = r x" if "x \<in> S" for x
     using that by auto
 qed
 
 lemma retract_ofE: \<comment> \<open>yields properties normalized wrt. simp -- less likely to loop\<close>
   assumes "T retract_of S"
   obtains r where "T = r ` S" "r ` S \<subseteq> S" "continuous_on S r" "\<And>x. x \<in> S \<Longrightarrow> r (r x) = r x"
 proof -
   from assms obtain r where "retraction S T r"
     by (auto simp add: retract_of_def)
   with that show thesis
     by (auto elim: retractionE)
 qed
 
 lemma retract_of_imp_extensible:
   assumes "S retract_of T" and "continuous_on S f" and "f ` S \<subseteq> U"
   obtains g where "continuous_on T g" "g ` T \<subseteq> U" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   from \<open>S retract_of T\<close> obtain r where "retraction T S r"
     by (auto simp add: retract_of_def)
   show thesis
     by (rule that [of "f \<circ> r"])
       (use \<open>continuous_on S f\<close> \<open>f ` S \<subseteq> U\<close> \<open>retraction T S r\<close> in \<open>auto simp: continuous_on_compose2 retraction\<close>)
 qed
 
 lemma idempotent_imp_retraction:
   assumes "continuous_on S f" and "f ` S \<subseteq> S" and "\<And>x. x \<in> S \<Longrightarrow> f(f x) = f x"
     shows "retraction S (f ` S) f"
 by (simp add: assms retraction)
 
 lemma retraction_subset:
   assumes "retraction S T r" and "T \<subseteq> s'" and "s' \<subseteq> S"
   shows "retraction s' T r"
   unfolding retraction_def
   by (metis assms continuous_on_subset image_mono retraction)
 
 lemma retract_of_subset:
   assumes "T retract_of S" and "T \<subseteq> s'" and "s' \<subseteq> S"
     shows "T retract_of s'"
 by (meson assms retract_of_def retraction_subset)
 
 lemma retraction_refl [simp]: "retraction S S (\<lambda>x. x)"
 by (simp add: retraction)
 
 lemma retract_of_refl [iff]: "S retract_of S"
   unfolding retract_of_def retraction_def
   using continuous_on_id by blast
 
 lemma retract_of_imp_subset:
    "S retract_of T \<Longrightarrow> S \<subseteq> T"
 by (simp add: retract_of_def retraction_def)
 
 lemma retract_of_empty [simp]:
      "({} retract_of S) \<longleftrightarrow> S = {}"  "(S retract_of {}) \<longleftrightarrow> S = {}"
 by (auto simp: retract_of_def retraction_def)
 
 lemma retract_of_singleton [iff]: "({x} retract_of S) \<longleftrightarrow> x \<in> S"
   unfolding retract_of_def retraction_def by force
 
 lemma retraction_comp:
    "\<lbrakk>retraction S T f; retraction T U g\<rbrakk>
         \<Longrightarrow> retraction S U (g \<circ> f)"
 apply (auto simp: retraction_def intro: continuous_on_compose2)
 by blast
 
 lemma retract_of_trans [trans]:
   assumes "S retract_of T" and "T retract_of U"
     shows "S retract_of U"
 using assms by (auto simp: retract_of_def intro: retraction_comp)
 
 lemma closedin_retract:
   fixes S :: "'a :: t2_space set"
   assumes "S retract_of T"
     shows "closedin (top_of_set T) S"
 proof -
   obtain r where r: "S \<subseteq> T" "continuous_on T r" "r ` T \<subseteq> S" "\<And>x. x \<in> S \<Longrightarrow> r x = x"
     using assms by (auto simp: retract_of_def retraction_def)
   have "S = {x\<in>T. x = r x}"
     using r by auto
   also have "\<dots> = T \<inter> ((\<lambda>x. (x, r x)) -` ({y. \<exists>x. y = (x, x)}))"
     unfolding vimage_def mem_Times_iff fst_conv snd_conv
     using r
     by auto
   also have "closedin (top_of_set T) \<dots>"
     by (rule continuous_closedin_preimage) (auto intro!: closed_diagonal continuous_on_Pair r)
   finally show ?thesis .
 qed
 
 lemma closedin_self [simp]: "closedin (top_of_set S) S"
   by simp
 
 lemma retract_of_closed:
     fixes S :: "'a :: t2_space set"
     shows "\<lbrakk>closed T; S retract_of T\<rbrakk> \<Longrightarrow> closed S"
   by (metis closedin_retract closedin_closed_eq)
 
 lemma retract_of_compact:
      "\<lbrakk>compact T; S retract_of T\<rbrakk> \<Longrightarrow> compact S"
   by (metis compact_continuous_image retract_of_def retraction)
 
 lemma retract_of_connected:
     "\<lbrakk>connected T; S retract_of T\<rbrakk> \<Longrightarrow> connected S"
   by (metis Topological_Spaces.connected_continuous_image retract_of_def retraction)
 
 lemma retraction_openin_vimage_iff:
   "openin (top_of_set S) (S \<inter> r -` U) \<longleftrightarrow> openin (top_of_set T) U"
   if retraction: "retraction S T r" and "U \<subseteq> T"
   using retraction apply (rule retractionE)
   apply (rule continuous_right_inverse_imp_quotient_map [where g=r])
   using \<open>U \<subseteq> T\<close> apply (auto elim: continuous_on_subset)
   done
 
 lemma retract_of_Times:
    "\<lbrakk>S retract_of s'; T retract_of t'\<rbrakk> \<Longrightarrow> (S \<times> T) retract_of (s' \<times> t')"
 apply (simp add: retract_of_def retraction_def Sigma_mono, clarify)
 apply (rename_tac f g)
 apply (rule_tac x="\<lambda>z. ((f \<circ> fst) z, (g \<circ> snd) z)" in exI)
 apply (rule conjI continuous_intros | erule continuous_on_subset | force)+
 done
 
 subsection\<open>Retractions on a topological space\<close>
 
 definition retract_of_space :: "'a set \<Rightarrow> 'a topology \<Rightarrow> bool" (infix "retract'_of'_space" 50)
   where "S retract_of_space X
          \<equiv> S \<subseteq> topspace X \<and> (\<exists>r. continuous_map X (subtopology X S) r \<and> (\<forall>x \<in> S. r x = x))"
 
 lemma retract_of_space_retraction_maps:
    "S retract_of_space X \<longleftrightarrow> S \<subseteq> topspace X \<and> (\<exists>r. retraction_maps X (subtopology X S) r id)"
   by (auto simp: retract_of_space_def retraction_maps_def)
 
 lemma retract_of_space_section_map:
    "S retract_of_space X \<longleftrightarrow> S \<subseteq> topspace X \<and> section_map (subtopology X S) X id"
   unfolding retract_of_space_def retraction_maps_def section_map_def
   by (auto simp: continuous_map_from_subtopology)
 
 lemma retract_of_space_imp_subset:
    "S retract_of_space X \<Longrightarrow> S \<subseteq> topspace X"
   by (simp add: retract_of_space_def)
 
 lemma retract_of_space_topspace:
    "topspace X retract_of_space X"
   using retract_of_space_def by force
 
 lemma retract_of_space_empty [simp]:
    "{} retract_of_space X \<longleftrightarrow> topspace X = {}"
   by (auto simp: continuous_map_def retract_of_space_def)
 
 lemma retract_of_space_singleton [simp]:
   "{a} retract_of_space X \<longleftrightarrow> a \<in> topspace X"
 proof -
   have "continuous_map X (subtopology X {a}) (\<lambda>x. a) \<and> (\<lambda>x. a) a = a" if "a \<in> topspace X"
     using that by simp
   then show ?thesis
     by (force simp: retract_of_space_def)
 qed
 
 lemma retract_of_space_clopen:
   assumes "openin X S" "closedin X S" "S = {} \<Longrightarrow> topspace X = {}"
   shows "S retract_of_space X"
 proof (cases "S = {}")
   case False
   then obtain a where "a \<in> S"
     by blast
   show ?thesis
     unfolding retract_of_space_def
   proof (intro exI conjI)
     show "S \<subseteq> topspace X"
       by (simp add: assms closedin_subset)
     have "continuous_map X X (\<lambda>x. if x \<in> S then x else a)"
     proof (rule continuous_map_cases)
       show "continuous_map (subtopology X (X closure_of {x. x \<in> S})) X (\<lambda>x. x)"
         by (simp add: continuous_map_from_subtopology)
       show "continuous_map (subtopology X (X closure_of {x. x \<notin> S})) X (\<lambda>x. a)"
         using \<open>S \<subseteq> topspace X\<close> \<open>a \<in> S\<close> by force
       show "x = a" if "x \<in> X frontier_of {x. x \<in> S}" for x
         using assms that clopenin_eq_frontier_of by fastforce
     qed
     then show "continuous_map X (subtopology X S) (\<lambda>x. if x \<in> S then x else a)"
       using \<open>S \<subseteq> topspace X\<close> \<open>a \<in> S\<close>  by (auto simp: continuous_map_in_subtopology)
   qed auto
 qed (use assms in auto)
 
 lemma retract_of_space_disjoint_union:
   assumes "openin X S" "openin X T" and ST: "disjnt S T" "S \<union> T = topspace X" and "S = {} \<Longrightarrow> topspace X = {}"
   shows "S retract_of_space X"
 proof (rule retract_of_space_clopen)
   have "S \<inter> T = {}"
     by (meson ST disjnt_def)
   then have "S = topspace X - T"
     using ST by auto
   then show "closedin X S"
     using \<open>openin X T\<close> by blast
 qed (auto simp: assms)
 
 lemma retraction_maps_section_image1:
   assumes "retraction_maps X Y r s"
   shows "s ` (topspace Y) retract_of_space X"
   unfolding retract_of_space_section_map
 proof
   show "s ` topspace Y \<subseteq> topspace X"
     using assms continuous_map_image_subset_topspace retraction_maps_def by blast
   show "section_map (subtopology X (s ` topspace Y)) X id"
     unfolding section_map_def
     using assms retraction_maps_to_retract_maps by blast
 qed
 
 lemma retraction_maps_section_image2:
    "retraction_maps X Y r s
         \<Longrightarrow> subtopology X (s ` (topspace Y)) homeomorphic_space Y"
   using embedding_map_imp_homeomorphic_space homeomorphic_space_sym section_imp_embedding_map
         section_map_def by blast
 
 subsection\<open>Paths and path-connectedness\<close>
 
 definition pathin :: "'a topology \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> bool" where
    "pathin X g \<equiv> continuous_map (subtopology euclideanreal {0..1}) X g"
 
 lemma pathin_compose:
      "\<lbrakk>pathin X g; continuous_map X Y f\<rbrakk> \<Longrightarrow> pathin Y (f \<circ> g)"
    by (simp add: continuous_map_compose pathin_def)
 
 lemma pathin_subtopology:
      "pathin (subtopology X S) g \<longleftrightarrow> pathin X g \<and> (\<forall>x \<in> {0..1}. g x \<in> S)"
   by (auto simp: pathin_def continuous_map_in_subtopology)
 
 lemma pathin_const:
    "pathin X (\<lambda>x. a) \<longleftrightarrow> a \<in> topspace X"
   by (simp add: pathin_def)
    
 lemma path_start_in_topspace: "pathin X g \<Longrightarrow> g 0 \<in> topspace X"
   by (force simp: pathin_def continuous_map)
 
 lemma path_finish_in_topspace: "pathin X g \<Longrightarrow> g 1 \<in> topspace X"
   by (force simp: pathin_def continuous_map)
 
 lemma path_image_subset_topspace: "pathin X g \<Longrightarrow> g ` ({0..1}) \<subseteq> topspace X"
   by (force simp: pathin_def continuous_map)
 
 definition path_connected_space :: "'a topology \<Rightarrow> bool"
   where "path_connected_space X \<equiv> \<forall>x \<in> topspace X. \<forall> y \<in> topspace X. \<exists>g. pathin X g \<and> g 0 = x \<and> g 1 = y"
 
 definition path_connectedin :: "'a topology \<Rightarrow> 'a set \<Rightarrow> bool"
   where "path_connectedin X S \<equiv> S \<subseteq> topspace X \<and> path_connected_space(subtopology X S)"
 
 lemma path_connectedin_absolute [simp]:
      "path_connectedin (subtopology X S) S \<longleftrightarrow> path_connectedin X S"
   by (simp add: path_connectedin_def subtopology_subtopology)
 
 lemma path_connectedin_subset_topspace:
      "path_connectedin X S \<Longrightarrow> S \<subseteq> topspace X"
   by (simp add: path_connectedin_def)
 
 lemma path_connectedin_subtopology:
      "path_connectedin (subtopology X S) T \<longleftrightarrow> path_connectedin X T \<and> T \<subseteq> S"
   by (auto simp: path_connectedin_def subtopology_subtopology inf.absorb2)
 
 lemma path_connectedin:
      "path_connectedin X S \<longleftrightarrow>
         S \<subseteq> topspace X \<and>
         (\<forall>x \<in> S. \<forall>y \<in> S. \<exists>g. pathin X g \<and> g ` {0..1} \<subseteq> S \<and> g 0 = x \<and> g 1 = y)"
   unfolding path_connectedin_def path_connected_space_def pathin_def continuous_map_in_subtopology
   by (intro conj_cong refl ball_cong) (simp_all add: inf.absorb_iff2)
 
 lemma path_connectedin_topspace:
      "path_connectedin X (topspace X) \<longleftrightarrow> path_connected_space X"
   by (simp add: path_connectedin_def)
 
 lemma path_connected_imp_connected_space:
   assumes "path_connected_space X"
   shows "connected_space X"
 proof -
   have *: "\<exists>S. connectedin X S \<and> g 0 \<in> S \<and> g 1 \<in> S" if "pathin X g" for g
   proof (intro exI conjI)
     have "continuous_map (subtopology euclideanreal {0..1}) X g"
       using connectedin_absolute that by (simp add: pathin_def)
     then show "connectedin X (g ` {0..1})"
       by (rule connectedin_continuous_map_image) auto
   qed auto
   show ?thesis
     using assms
     by (auto intro: * simp add: path_connected_space_def connected_space_subconnected Ball_def)
 qed
 
 lemma path_connectedin_imp_connectedin:
      "path_connectedin X S \<Longrightarrow> connectedin X S"
   by (simp add: connectedin_def path_connected_imp_connected_space path_connectedin_def)
 
 lemma path_connected_space_topspace_empty:
      "topspace X = {} \<Longrightarrow> path_connected_space X"
   by (simp add: path_connected_space_def)
 
 lemma path_connectedin_empty [simp]: "path_connectedin X {}"
   by (simp add: path_connectedin)
 
 lemma path_connectedin_singleton [simp]: "path_connectedin X {a} \<longleftrightarrow> a \<in> topspace X"
 proof
   show "path_connectedin X {a} \<Longrightarrow> a \<in> topspace X"
     by (simp add: path_connectedin)
   show "a \<in> topspace X \<Longrightarrow> path_connectedin X {a}"
     unfolding path_connectedin
     using pathin_const by fastforce
 qed
 
 lemma path_connectedin_continuous_map_image:
   assumes f: "continuous_map X Y f" and S: "path_connectedin X S"
   shows "path_connectedin Y (f ` S)"
 proof -
   have fX: "f ` (topspace X) \<subseteq> topspace Y"
     by (metis f continuous_map_image_subset_topspace)
   show ?thesis
     unfolding path_connectedin
   proof (intro conjI ballI; clarify?)
     fix x
     assume "x \<in> S"
     show "f x \<in> topspace Y"
       by (meson S fX \<open>x \<in> S\<close> image_subset_iff path_connectedin_subset_topspace set_mp)
   next
     fix x y
     assume "x \<in> S" and "y \<in> S"
     then obtain g where g: "pathin X g" "g ` {0..1} \<subseteq> S" "g 0 = x" "g 1 = y"
       using S  by (force simp: path_connectedin)
     show "\<exists>g. pathin Y g \<and> g ` {0..1} \<subseteq> f ` S \<and> g 0 = f x \<and> g 1 = f y"
     proof (intro exI conjI)
       show "pathin Y (f \<circ> g)"
         using \<open>pathin X g\<close> f pathin_compose by auto
     qed (use g in auto)
   qed
 qed
 
 lemma path_connectedin_discrete_topology:
   "path_connectedin (discrete_topology U) S \<longleftrightarrow> S \<subseteq> U \<and> (\<exists>a. S \<subseteq> {a})"
   apply safe
   using path_connectedin_subset_topspace apply fastforce
    apply (meson connectedin_discrete_topology path_connectedin_imp_connectedin)
   using subset_singletonD by fastforce
 
 lemma path_connected_space_discrete_topology:
    "path_connected_space (discrete_topology U) \<longleftrightarrow> (\<exists>a. U \<subseteq> {a})"
   by (metis path_connectedin_discrete_topology path_connectedin_topspace path_connected_space_topspace_empty
             subset_singletonD topspace_discrete_topology)
 
 
 lemma homeomorphic_path_connected_space_imp:
      "\<lbrakk>path_connected_space X; X homeomorphic_space Y\<rbrakk> \<Longrightarrow> path_connected_space Y"
   unfolding homeomorphic_space_def homeomorphic_maps_def
   by (metis (no_types, opaque_lifting) continuous_map_closedin continuous_map_image_subset_topspace imageI order_class.order.antisym path_connectedin_continuous_map_image path_connectedin_topspace subsetI)
 
 lemma homeomorphic_path_connected_space:
    "X homeomorphic_space Y \<Longrightarrow> path_connected_space X \<longleftrightarrow> path_connected_space Y"
   by (meson homeomorphic_path_connected_space_imp homeomorphic_space_sym)
 
 lemma homeomorphic_map_path_connectedness:
   assumes "homeomorphic_map X Y f" "U \<subseteq> topspace X"
   shows "path_connectedin Y (f ` U) \<longleftrightarrow> path_connectedin X U"
   unfolding path_connectedin_def
 proof (intro conj_cong homeomorphic_path_connected_space)
   show "(f ` U \<subseteq> topspace Y) = (U \<subseteq> topspace X)"
     using assms homeomorphic_imp_surjective_map by blast
 next
   assume "U \<subseteq> topspace X"
   show "subtopology Y (f ` U) homeomorphic_space subtopology X U"
     using assms unfolding homeomorphic_eq_everything_map
     by (metis (no_types, opaque_lifting) assms homeomorphic_map_subtopologies homeomorphic_space homeomorphic_space_sym image_mono inf.absorb_iff2)
 qed
 
 lemma homeomorphic_map_path_connectedness_eq:
    "homeomorphic_map X Y f \<Longrightarrow> path_connectedin X U \<longleftrightarrow> U \<subseteq> topspace X \<and> path_connectedin Y (f ` U)"
   by (meson homeomorphic_map_path_connectedness path_connectedin_def)
 
 subsection\<open>Connected components\<close>
 
 definition connected_component_of :: "'a topology \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
   where "connected_component_of X x y \<equiv>
         \<exists>T. connectedin X T \<and> x \<in> T \<and> y \<in> T"
 
 abbreviation connected_component_of_set
   where "connected_component_of_set X x \<equiv> Collect (connected_component_of X x)"
 
 definition connected_components_of :: "'a topology \<Rightarrow> ('a set) set"
   where "connected_components_of X \<equiv> connected_component_of_set X ` topspace X"
 
 lemma connected_component_in_topspace:
    "connected_component_of X x y \<Longrightarrow> x \<in> topspace X \<and> y \<in> topspace X"
   by (meson connected_component_of_def connectedin_subset_topspace in_mono)
 
 lemma connected_component_of_refl:
    "connected_component_of X x x \<longleftrightarrow> x \<in> topspace X"
   by (meson connected_component_in_topspace connected_component_of_def connectedin_sing insertI1)
 
 lemma connected_component_of_sym:
    "connected_component_of X x y \<longleftrightarrow> connected_component_of X y x"
   by (meson connected_component_of_def)
 
 lemma connected_component_of_trans:
    "\<lbrakk>connected_component_of X x y; connected_component_of X y z\<rbrakk>
         \<Longrightarrow> connected_component_of X x z"
   unfolding connected_component_of_def
   using connectedin_Un by blast
 
 lemma connected_component_of_mono:
    "\<lbrakk>connected_component_of (subtopology X S) x y; S \<subseteq> T\<rbrakk>
         \<Longrightarrow> connected_component_of (subtopology X T) x y"
   by (metis connected_component_of_def connectedin_subtopology inf.absorb_iff2 subtopology_subtopology)
 
 lemma connected_component_of_set:
    "connected_component_of_set X x = {y. \<exists>T. connectedin X T \<and> x \<in> T \<and> y \<in> T}"
   by (meson connected_component_of_def)
 
 lemma connected_component_of_subset_topspace:
    "connected_component_of_set X x \<subseteq> topspace X"
   using connected_component_in_topspace by force
 
 lemma connected_component_of_eq_empty:
    "connected_component_of_set X x = {} \<longleftrightarrow> (x \<notin> topspace X)"
   using connected_component_in_topspace connected_component_of_refl by fastforce
 
 lemma connected_space_iff_connected_component:
    "connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. connected_component_of X x y)"
   by (simp add: connected_component_of_def connected_space_subconnected)
 
 lemma connected_space_imp_connected_component_of:
    "\<lbrakk>connected_space X; a \<in> topspace X; b \<in> topspace X\<rbrakk>
     \<Longrightarrow> connected_component_of X a b"
   by (simp add: connected_space_iff_connected_component)
 
 lemma connected_space_connected_component_set:
    "connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. connected_component_of_set X x = topspace X)"
   using connected_component_of_subset_topspace connected_space_iff_connected_component by fastforce
 
 lemma connected_component_of_maximal:
    "\<lbrakk>connectedin X S; x \<in> S\<rbrakk> \<Longrightarrow> S \<subseteq> connected_component_of_set X x"
   by (meson Ball_Collect connected_component_of_def)
 
 lemma connected_component_of_equiv:
    "connected_component_of X x y \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and> connected_component_of X x = connected_component_of X y"
   apply (simp add: connected_component_in_topspace fun_eq_iff)
   by (meson connected_component_of_refl connected_component_of_sym connected_component_of_trans)
 
 lemma connected_component_of_disjoint:
    "disjnt (connected_component_of_set X x) (connected_component_of_set X y)
     \<longleftrightarrow> ~(connected_component_of X x y)"
   using connected_component_of_equiv unfolding disjnt_iff by force
 
 lemma connected_component_of_eq:
    "connected_component_of X x = connected_component_of X y \<longleftrightarrow>
         (x \<notin> topspace X) \<and> (y \<notin> topspace X) \<or>
         x \<in> topspace X \<and> y \<in> topspace X \<and>
         connected_component_of X x y"
   by (metis Collect_empty_eq_bot connected_component_of_eq_empty connected_component_of_equiv)
 
 lemma connectedin_connected_component_of:
    "connectedin X (connected_component_of_set X x)"
 proof -
   have "connected_component_of_set X x = \<Union> {T. connectedin X T \<and> x \<in> T}"
     by (auto simp: connected_component_of_def)
   then show ?thesis
     apply (rule ssubst)
     by (blast intro: connectedin_Union)
 qed
 
 
 lemma Union_connected_components_of:
    "\<Union>(connected_components_of X) = topspace X"
   unfolding connected_components_of_def
   apply (rule equalityI)
   apply (simp add: SUP_least connected_component_of_subset_topspace)
   using connected_component_of_refl by fastforce
 
 lemma connected_components_of_maximal:
    "\<lbrakk>C \<in> connected_components_of X; connectedin X S; ~disjnt C S\<rbrakk> \<Longrightarrow> S \<subseteq> C"
   unfolding connected_components_of_def disjnt_def
   apply clarify
   by (metis Int_emptyI connected_component_of_def connected_component_of_trans mem_Collect_eq)
 
 lemma pairwise_disjoint_connected_components_of:
    "pairwise disjnt (connected_components_of X)"
   unfolding connected_components_of_def pairwise_def
   apply clarify
   by (metis connected_component_of_disjoint connected_component_of_equiv)
 
 lemma complement_connected_components_of_Union:
    "C \<in> connected_components_of X
       \<Longrightarrow> topspace X - C = \<Union> (connected_components_of X - {C})"
   apply (rule equalityI)
   using Union_connected_components_of apply fastforce
   by (metis Diff_cancel Diff_subset Union_connected_components_of cSup_singleton diff_Union_pairwise_disjoint equalityE insert_subsetI pairwise_disjoint_connected_components_of)
 
 lemma nonempty_connected_components_of:
    "C \<in> connected_components_of X \<Longrightarrow> C \<noteq> {}"
   unfolding connected_components_of_def
   by (metis (no_types, lifting) connected_component_of_eq_empty imageE)
 
 lemma connected_components_of_subset:
    "C \<in> connected_components_of X \<Longrightarrow> C \<subseteq> topspace X"
   using Union_connected_components_of by fastforce
 
 lemma connectedin_connected_components_of:
   assumes "C \<in> connected_components_of X"
   shows "connectedin X C"
 proof -
   have "C \<in> connected_component_of_set X ` topspace X"
     using assms connected_components_of_def by blast
 then show ?thesis
   using connectedin_connected_component_of by fastforce
 qed
 
 lemma connected_component_in_connected_components_of:
    "connected_component_of_set X a \<in> connected_components_of X \<longleftrightarrow> a \<in> topspace X"
   apply (rule iffI)
   using connected_component_of_eq_empty nonempty_connected_components_of apply fastforce
   by (simp add: connected_components_of_def)
 
 lemma connected_space_iff_components_eq:
    "connected_space X \<longleftrightarrow> (\<forall>C \<in> connected_components_of X. \<forall>C' \<in> connected_components_of X. C = C')"
   apply (rule iffI)
   apply (force simp: connected_components_of_def connected_space_connected_component_set image_iff)
   by (metis connected_component_in_connected_components_of connected_component_of_refl connected_space_iff_connected_component mem_Collect_eq)
 
 lemma connected_components_of_eq_empty:
    "connected_components_of X = {} \<longleftrightarrow> topspace X = {}"
   by (simp add: connected_components_of_def)
 
 lemma connected_components_of_empty_space:
    "topspace X = {} \<Longrightarrow> connected_components_of X = {}"
   by (simp add: connected_components_of_eq_empty)
 
 lemma connected_components_of_subset_sing:
    "connected_components_of X \<subseteq> {S} \<longleftrightarrow> connected_space X \<and> (topspace X = {} \<or> topspace X = S)"
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     by (simp add: connected_components_of_empty_space connected_space_topspace_empty)
 next
   case False
   then show ?thesis
     by (metis (no_types, opaque_lifting) Union_connected_components_of ccpo_Sup_singleton
         connected_components_of_eq_empty connected_space_iff_components_eq insertI1 singletonD
         subsetI subset_singleton_iff)
 qed
 
 lemma connected_space_iff_components_subset_singleton:
    "connected_space X \<longleftrightarrow> (\<exists>a. connected_components_of X \<subseteq> {a})"
   by (simp add: connected_components_of_subset_sing)
 
 lemma connected_components_of_eq_singleton:
    "connected_components_of X = {S}
 \<longleftrightarrow> connected_space X \<and> topspace X \<noteq> {} \<and> S = topspace X"
   by (metis ccpo_Sup_singleton connected_components_of_subset_sing insert_not_empty subset_singleton_iff)
 
 lemma connected_components_of_connected_space:
    "connected_space X \<Longrightarrow> connected_components_of X = (if topspace X = {} then {} else {topspace X})"
   by (simp add: connected_components_of_eq_empty connected_components_of_eq_singleton)
 
 lemma exists_connected_component_of_superset:
   assumes "connectedin X S" and ne: "topspace X \<noteq> {}"
   shows "\<exists>C. C \<in> connected_components_of X \<and> S \<subseteq> C"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using ne connected_components_of_def by blast
 next
   case False
   then show ?thesis
     by (meson all_not_in_conv assms(1) connected_component_in_connected_components_of connected_component_of_maximal connectedin_subset_topspace in_mono)
 qed
 
 lemma closedin_connected_components_of:
   assumes "C \<in> connected_components_of X"
   shows   "closedin X C"
 proof -
   obtain x where "x \<in> topspace X" and x: "C = connected_component_of_set X x"
     using assms by (auto simp: connected_components_of_def)
   have "connected_component_of_set X x \<subseteq> topspace X"
     by (simp add: connected_component_of_subset_topspace)
   moreover have "X closure_of connected_component_of_set X x \<subseteq> connected_component_of_set X x"
   proof (rule connected_component_of_maximal)
     show "connectedin X (X closure_of connected_component_of_set X x)"
       by (simp add: connectedin_closure_of connectedin_connected_component_of)
     show "x \<in> X closure_of connected_component_of_set X x"
       by (simp add: \<open>x \<in> topspace X\<close> closure_of connected_component_of_refl)
   qed
   ultimately
   show ?thesis
     using closure_of_subset_eq x by auto
 qed
 
 lemma closedin_connected_component_of:
    "closedin X (connected_component_of_set X x)"
   by (metis closedin_connected_components_of closedin_empty connected_component_in_connected_components_of connected_component_of_eq_empty)
 
 lemma connected_component_of_eq_overlap:
    "connected_component_of_set X x = connected_component_of_set X y \<longleftrightarrow>
       (x \<notin> topspace X) \<and> (y \<notin> topspace X) \<or>
       ~(connected_component_of_set X x \<inter> connected_component_of_set X y = {})"
   using connected_component_of_equiv by fastforce
 
 lemma connected_component_of_nonoverlap:
    "connected_component_of_set X x \<inter> connected_component_of_set X y = {} \<longleftrightarrow>
      (x \<notin> topspace X) \<or> (y \<notin> topspace X) \<or>
      ~(connected_component_of_set X x = connected_component_of_set X y)"
   by (metis connected_component_of_eq_empty connected_component_of_eq_overlap inf.idem)
 
 lemma connected_component_of_overlap:
    "~(connected_component_of_set X x \<inter> connected_component_of_set X y = {}) \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and>
     connected_component_of_set X x = connected_component_of_set X y"
   by (meson connected_component_of_nonoverlap)
 
 end
\ No newline at end of file
diff --git a/src/HOL/Analysis/Binary_Product_Measure.thy b/src/HOL/Analysis/Binary_Product_Measure.thy
--- a/src/HOL/Analysis/Binary_Product_Measure.thy
+++ b/src/HOL/Analysis/Binary_Product_Measure.thy
@@ -1,1159 +1,1179 @@
 (*  Title:      HOL/Analysis/Binary_Product_Measure.thy
     Author:     Johannes Hölzl, TU München
 *)
 
 section \<open>Binary Product Measure\<close>
 
 theory Binary_Product_Measure
 imports Nonnegative_Lebesgue_Integration
 begin
 
 lemma Pair_vimage_times[simp]: "Pair x -` (A \<times> B) = (if x \<in> A then B else {})"
   by auto
 
 lemma rev_Pair_vimage_times[simp]: "(\<lambda>x. (x, y)) -` (A \<times> B) = (if y \<in> B then A else {})"
   by auto
 
 subsection "Binary products"
 
 definition\<^marker>\<open>tag important\<close> pair_measure (infixr "\<Otimes>\<^sub>M" 80) where
   "A \<Otimes>\<^sub>M B = measure_of (space A \<times> space B)
       {a \<times> b | a b. a \<in> sets A \<and> b \<in> sets B}
       (\<lambda>X. \<integral>\<^sup>+x. (\<integral>\<^sup>+y. indicator X (x,y) \<partial>B) \<partial>A)"
 
 lemma pair_measure_closed: "{a \<times> b | a b. a \<in> sets A \<and> b \<in> sets B} \<subseteq> Pow (space A \<times> space B)"
   using sets.space_closed[of A] sets.space_closed[of B] by auto
 
 lemma space_pair_measure:
   "space (A \<Otimes>\<^sub>M B) = space A \<times> space B"
   unfolding pair_measure_def using pair_measure_closed[of A B]
   by (rule space_measure_of)
 
 lemma SIGMA_Collect_eq: "(SIGMA x:space M. {y\<in>space N. P x y}) = {x\<in>space (M \<Otimes>\<^sub>M N). P (fst x) (snd x)}"
   by (auto simp: space_pair_measure)
 
 lemma sets_pair_measure:
   "sets (A \<Otimes>\<^sub>M B) = sigma_sets (space A \<times> space B) {a \<times> b | a b. a \<in> sets A \<and> b \<in> sets B}"
   unfolding pair_measure_def using pair_measure_closed[of A B]
   by (rule sets_measure_of)
 
 lemma sets_pair_measure_cong[measurable_cong, cong]:
   "sets M1 = sets M1' \<Longrightarrow> sets M2 = sets M2' \<Longrightarrow> sets (M1 \<Otimes>\<^sub>M M2) = sets (M1' \<Otimes>\<^sub>M M2')"
   unfolding sets_pair_measure by (simp cong: sets_eq_imp_space_eq)
 
 lemma pair_measureI[intro, simp, measurable]:
   "x \<in> sets A \<Longrightarrow> y \<in> sets B \<Longrightarrow> x \<times> y \<in> sets (A \<Otimes>\<^sub>M B)"
   by (auto simp: sets_pair_measure)
 
 lemma sets_Pair: "{x} \<in> sets M1 \<Longrightarrow> {y} \<in> sets M2 \<Longrightarrow> {(x, y)} \<in> sets (M1 \<Otimes>\<^sub>M M2)"
   using pair_measureI[of "{x}" M1 "{y}" M2] by simp
 
 lemma measurable_pair_measureI:
   assumes 1: "f \<in> space M \<rightarrow> space M1 \<times> space M2"
   assumes 2: "\<And>A B. A \<in> sets M1 \<Longrightarrow> B \<in> sets M2 \<Longrightarrow> f -` (A \<times> B) \<inter> space M \<in> sets M"
   shows "f \<in> measurable M (M1 \<Otimes>\<^sub>M M2)"
   unfolding pair_measure_def using 1 2
   by (intro measurable_measure_of) (auto dest: sets.sets_into_space)
 
 lemma measurable_split_replace[measurable (raw)]:
   "(\<lambda>x. f x (fst (g x)) (snd (g x))) \<in> measurable M N \<Longrightarrow> (\<lambda>x. case_prod (f x) (g x)) \<in> measurable M N"
   unfolding split_beta' .
 
 lemma measurable_Pair[measurable (raw)]:
   assumes f: "f \<in> measurable M M1" and g: "g \<in> measurable M M2"
   shows "(\<lambda>x. (f x, g x)) \<in> measurable M (M1 \<Otimes>\<^sub>M M2)"
 proof (rule measurable_pair_measureI)
   show "(\<lambda>x. (f x, g x)) \<in> space M \<rightarrow> space M1 \<times> space M2"
     using f g by (auto simp: measurable_def)
   fix A B assume *: "A \<in> sets M1" "B \<in> sets M2"
   have "(\<lambda>x. (f x, g x)) -` (A \<times> B) \<inter> space M = (f -` A \<inter> space M) \<inter> (g -` B \<inter> space M)"
     by auto
   also have "\<dots> \<in> sets M"
     by (rule sets.Int) (auto intro!: measurable_sets * f g)
   finally show "(\<lambda>x. (f x, g x)) -` (A \<times> B) \<inter> space M \<in> sets M" .
 qed
 
 lemma measurable_fst[intro!, simp, measurable]: "fst \<in> measurable (M1 \<Otimes>\<^sub>M M2) M1"
   by (auto simp: fst_vimage_eq_Times space_pair_measure sets.sets_into_space Times_Int_Times
     measurable_def)
 
 lemma measurable_snd[intro!, simp, measurable]: "snd \<in> measurable (M1 \<Otimes>\<^sub>M M2) M2"
   by (auto simp: snd_vimage_eq_Times space_pair_measure sets.sets_into_space Times_Int_Times
     measurable_def)
 
 lemma measurable_Pair_compose_split[measurable_dest]:
   assumes f: "case_prod f \<in> measurable (M1 \<Otimes>\<^sub>M M2) N"
   assumes g: "g \<in> measurable M M1" and h: "h \<in> measurable M M2"
   shows "(\<lambda>x. f (g x) (h x)) \<in> measurable M N"
   using measurable_compose[OF measurable_Pair f, OF g h] by simp
 
 lemma measurable_Pair1_compose[measurable_dest]:
   assumes f: "(\<lambda>x. (f x, g x)) \<in> measurable M (M1 \<Otimes>\<^sub>M M2)"
   assumes [measurable]: "h \<in> measurable N M"
   shows "(\<lambda>x. f (h x)) \<in> measurable N M1"
   using measurable_compose[OF f measurable_fst] by simp
 
 lemma measurable_Pair2_compose[measurable_dest]:
   assumes f: "(\<lambda>x. (f x, g x)) \<in> measurable M (M1 \<Otimes>\<^sub>M M2)"
   assumes [measurable]: "h \<in> measurable N M"
   shows "(\<lambda>x. g (h x)) \<in> measurable N M2"
   using measurable_compose[OF f measurable_snd] by simp
 
 lemma measurable_pair:
   assumes "(fst \<circ> f) \<in> measurable M M1" "(snd \<circ> f) \<in> measurable M M2"
   shows "f \<in> measurable M (M1 \<Otimes>\<^sub>M M2)"
   using measurable_Pair[OF assms] by simp
 
 lemma
   assumes f[measurable]: "f \<in> measurable M (N \<Otimes>\<^sub>M P)"
   shows measurable_fst': "(\<lambda>x. fst (f x)) \<in> measurable M N"
     and measurable_snd': "(\<lambda>x. snd (f x)) \<in> measurable M P"
   by simp_all
 
 lemma
   assumes f[measurable]: "f \<in> measurable M N"
   shows measurable_fst'': "(\<lambda>x. f (fst x)) \<in> measurable (M \<Otimes>\<^sub>M P) N"
     and measurable_snd'': "(\<lambda>x. f (snd x)) \<in> measurable (P \<Otimes>\<^sub>M M) N"
   by simp_all
 
 lemma sets_pair_in_sets:
   assumes "\<And>a b. a \<in> sets A \<Longrightarrow> b \<in> sets B \<Longrightarrow> a \<times> b \<in> sets N"
   shows "sets (A \<Otimes>\<^sub>M B) \<subseteq> sets N"
   unfolding sets_pair_measure
   by (intro sets.sigma_sets_subset') (auto intro!: assms)
 
 lemma  sets_pair_eq_sets_fst_snd:
   "sets (A \<Otimes>\<^sub>M B) = sets (Sup {vimage_algebra (space A \<times> space B) fst A, vimage_algebra (space A \<times> space B) snd B})"
     (is "?P = sets (Sup {?fst, ?snd})")
 proof -
   { fix a b assume ab: "a \<in> sets A" "b \<in> sets B"
     then have "a \<times> b = (fst -` a \<inter> (space A \<times> space B)) \<inter> (snd -` b \<inter> (space A \<times> space B))"
       by (auto dest: sets.sets_into_space)
     also have "\<dots> \<in> sets (Sup {?fst, ?snd})"
       apply (rule sets.Int)
       apply (rule in_sets_Sup)
       apply auto []
       apply (rule insertI1)
       apply (auto intro: ab in_vimage_algebra) []
       apply (rule in_sets_Sup)
       apply auto []
       apply (rule insertI2)
       apply (auto intro: ab in_vimage_algebra)
       done
     finally have "a \<times> b \<in> sets (Sup {?fst, ?snd})" . }
   moreover have "sets ?fst \<subseteq> sets (A \<Otimes>\<^sub>M B)"
     by (rule sets_image_in_sets) (auto simp: space_pair_measure[symmetric])
   moreover have "sets ?snd \<subseteq> sets (A \<Otimes>\<^sub>M B)"
     by (rule sets_image_in_sets) (auto simp: space_pair_measure)
   ultimately show ?thesis
     apply (intro antisym[of "sets A" for A] sets_Sup_in_sets sets_pair_in_sets)
     apply simp
     apply simp
     apply simp
     apply (elim disjE)
     apply (simp add: space_pair_measure)
     apply (simp add: space_pair_measure)
     apply (auto simp add: space_pair_measure)
     done
 qed
 
 lemma measurable_pair_iff:
   "f \<in> measurable M (M1 \<Otimes>\<^sub>M M2) \<longleftrightarrow> (fst \<circ> f) \<in> measurable M M1 \<and> (snd \<circ> f) \<in> measurable M M2"
   by (auto intro: measurable_pair[of f M M1 M2])
 
 lemma  measurable_split_conv:
   "(\<lambda>(x, y). f x y) \<in> measurable A B \<longleftrightarrow> (\<lambda>x. f (fst x) (snd x)) \<in> measurable A B"
   by (intro arg_cong2[where f="(\<in>)"]) auto
 
 lemma measurable_pair_swap': "(\<lambda>(x,y). (y, x)) \<in> measurable (M1 \<Otimes>\<^sub>M M2) (M2 \<Otimes>\<^sub>M M1)"
   by (auto intro!: measurable_Pair simp: measurable_split_conv)
 
 lemma  measurable_pair_swap:
   assumes f: "f \<in> measurable (M1 \<Otimes>\<^sub>M M2) M" shows "(\<lambda>(x,y). f (y, x)) \<in> measurable (M2 \<Otimes>\<^sub>M M1) M"
   using measurable_comp[OF measurable_Pair f] by (auto simp: measurable_split_conv comp_def)
 
 lemma measurable_pair_swap_iff:
   "f \<in> measurable (M2 \<Otimes>\<^sub>M M1) M \<longleftrightarrow> (\<lambda>(x,y). f (y,x)) \<in> measurable (M1 \<Otimes>\<^sub>M M2) M"
   by (auto dest: measurable_pair_swap)
 
 lemma measurable_Pair1': "x \<in> space M1 \<Longrightarrow> Pair x \<in> measurable M2 (M1 \<Otimes>\<^sub>M M2)"
   by simp
 
 lemma sets_Pair1[measurable (raw)]:
   assumes A: "A \<in> sets (M1 \<Otimes>\<^sub>M M2)" shows "Pair x -` A \<in> sets M2"
 proof -
   have "Pair x -` A = (if x \<in> space M1 then Pair x -` A \<inter> space M2 else {})"
     using A[THEN sets.sets_into_space] by (auto simp: space_pair_measure)
   also have "\<dots> \<in> sets M2"
     using A by (auto simp add: measurable_Pair1' intro!: measurable_sets split: if_split_asm)
   finally show ?thesis .
 qed
 
 lemma measurable_Pair2': "y \<in> space M2 \<Longrightarrow> (\<lambda>x. (x, y)) \<in> measurable M1 (M1 \<Otimes>\<^sub>M M2)"
   by (auto intro!: measurable_Pair)
 
 lemma sets_Pair2: assumes A: "A \<in> sets (M1 \<Otimes>\<^sub>M M2)" shows "(\<lambda>x. (x, y)) -` A \<in> sets M1"
 proof -
   have "(\<lambda>x. (x, y)) -` A = (if y \<in> space M2 then (\<lambda>x. (x, y)) -` A \<inter> space M1 else {})"
     using A[THEN sets.sets_into_space] by (auto simp: space_pair_measure)
   also have "\<dots> \<in> sets M1"
     using A by (auto simp add: measurable_Pair2' intro!: measurable_sets split: if_split_asm)
   finally show ?thesis .
 qed
 
 lemma measurable_Pair2:
   assumes f: "f \<in> measurable (M1 \<Otimes>\<^sub>M M2) M" and x: "x \<in> space M1"
   shows "(\<lambda>y. f (x, y)) \<in> measurable M2 M"
   using measurable_comp[OF measurable_Pair1' f, OF x]
   by (simp add: comp_def)
 
 lemma measurable_Pair1:
   assumes f: "f \<in> measurable (M1 \<Otimes>\<^sub>M M2) M" and y: "y \<in> space M2"
   shows "(\<lambda>x. f (x, y)) \<in> measurable M1 M"
   using measurable_comp[OF measurable_Pair2' f, OF y]
   by (simp add: comp_def)
 
 lemma Int_stable_pair_measure_generator: "Int_stable {a \<times> b | a b. a \<in> sets A \<and> b \<in> sets B}"
   unfolding Int_stable_def
   by safe (auto simp add: Times_Int_Times)
 
 lemma (in finite_measure) finite_measure_cut_measurable:
   assumes [measurable]: "Q \<in> sets (N \<Otimes>\<^sub>M M)"
   shows "(\<lambda>x. emeasure M (Pair x -` Q)) \<in> borel_measurable N"
     (is "?s Q \<in> _")
   using Int_stable_pair_measure_generator pair_measure_closed assms
   unfolding sets_pair_measure
 proof (induct rule: sigma_sets_induct_disjoint)
   case (compl A)
   with sets.sets_into_space have "\<And>x. emeasure M (Pair x -` ((space N \<times> space M) - A)) =
       (if x \<in> space N then emeasure M (space M) - ?s A x else 0)"
     unfolding sets_pair_measure[symmetric]
     by (auto intro!: emeasure_compl simp: vimage_Diff sets_Pair1)
   with compl sets.top show ?case
     by (auto intro!: measurable_If simp: space_pair_measure)
 next
   case (union F)
   then have "\<And>x. emeasure M (Pair x -` (\<Union>i. F i)) = (\<Sum>i. ?s (F i) x)"
     by (simp add: suminf_emeasure disjoint_family_on_vimageI subset_eq vimage_UN sets_pair_measure[symmetric])
   with union show ?case
     unfolding sets_pair_measure[symmetric] by simp
 qed (auto simp add: if_distrib Int_def[symmetric] intro!: measurable_If)
 
 lemma (in sigma_finite_measure) measurable_emeasure_Pair:
   assumes Q: "Q \<in> sets (N \<Otimes>\<^sub>M M)" shows "(\<lambda>x. emeasure M (Pair x -` Q)) \<in> borel_measurable N" (is "?s Q \<in> _")
 proof -
-  from sigma_finite_disjoint guess F . note F = this
+  obtain F :: "nat \<Rightarrow> 'a set" where F:
+    "range F \<subseteq> sets M"
+    "\<Union> (range F) = space M"
+    "\<And>i. emeasure M (F i) \<noteq> \<infinity>"
+    "disjoint_family F" by (blast intro: sigma_finite_disjoint)
   then have F_sets: "\<And>i. F i \<in> sets M" by auto
   let ?C = "\<lambda>x i. F i \<inter> Pair x -` Q"
   { fix i
     have [simp]: "space N \<times> F i \<inter> space N \<times> space M = space N \<times> F i"
       using F sets.sets_into_space by auto
     let ?R = "density M (indicator (F i))"
     have "finite_measure ?R"
       using F by (intro finite_measureI) (auto simp: emeasure_restricted subset_eq)
     then have "(\<lambda>x. emeasure ?R (Pair x -` (space N \<times> space ?R \<inter> Q))) \<in> borel_measurable N"
      by (rule finite_measure.finite_measure_cut_measurable) (auto intro: Q)
     moreover have "\<And>x. emeasure ?R (Pair x -` (space N \<times> space ?R \<inter> Q))
         = emeasure M (F i \<inter> Pair x -` (space N \<times> space ?R \<inter> Q))"
       using Q F_sets by (intro emeasure_restricted) (auto intro: sets_Pair1)
     moreover have "\<And>x. F i \<inter> Pair x -` (space N \<times> space ?R \<inter> Q) = ?C x i"
       using sets.sets_into_space[OF Q] by (auto simp: space_pair_measure)
     ultimately have "(\<lambda>x. emeasure M (?C x i)) \<in> borel_measurable N"
       by simp }
   moreover
   { fix x
     have "(\<Sum>i. emeasure M (?C x i)) = emeasure M (\<Union>i. ?C x i)"
     proof (intro suminf_emeasure)
       show "range (?C x) \<subseteq> sets M"
         using F \<open>Q \<in> sets (N \<Otimes>\<^sub>M M)\<close> by (auto intro!: sets_Pair1)
       have "disjoint_family F" using F by auto
       show "disjoint_family (?C x)"
         by (rule disjoint_family_on_bisimulation[OF \<open>disjoint_family F\<close>]) auto
     qed
     also have "(\<Union>i. ?C x i) = Pair x -` Q"
       using F sets.sets_into_space[OF \<open>Q \<in> sets (N \<Otimes>\<^sub>M M)\<close>]
       by (auto simp: space_pair_measure)
     finally have "emeasure M (Pair x -` Q) = (\<Sum>i. emeasure M (?C x i))"
       by simp }
   ultimately show ?thesis using \<open>Q \<in> sets (N \<Otimes>\<^sub>M M)\<close> F_sets
     by auto
 qed
 
 lemma (in sigma_finite_measure) measurable_emeasure[measurable (raw)]:
   assumes space: "\<And>x. x \<in> space N \<Longrightarrow> A x \<subseteq> space M"
   assumes A: "{x\<in>space (N \<Otimes>\<^sub>M M). snd x \<in> A (fst x)} \<in> sets (N \<Otimes>\<^sub>M M)"
   shows "(\<lambda>x. emeasure M (A x)) \<in> borel_measurable N"
 proof -
   from space have "\<And>x. x \<in> space N \<Longrightarrow> Pair x -` {x \<in> space (N \<Otimes>\<^sub>M M). snd x \<in> A (fst x)} = A x"
     by (auto simp: space_pair_measure)
   with measurable_emeasure_Pair[OF A] show ?thesis
     by (auto cong: measurable_cong)
 qed
 
 lemma (in sigma_finite_measure) emeasure_pair_measure:
   assumes "X \<in> sets (N \<Otimes>\<^sub>M M)"
   shows "emeasure (N \<Otimes>\<^sub>M M) X = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator X (x, y) \<partial>M \<partial>N)" (is "_ = ?\<mu> X")
 proof (rule emeasure_measure_of[OF pair_measure_def])
   show "positive (sets (N \<Otimes>\<^sub>M M)) ?\<mu>"
     by (auto simp: positive_def)
   have eq[simp]: "\<And>A x y. indicator A (x, y) = indicator (Pair x -` A) y"
     by (auto simp: indicator_def)
   show "countably_additive (sets (N \<Otimes>\<^sub>M M)) ?\<mu>"
   proof (rule countably_additiveI)
     fix F :: "nat \<Rightarrow> ('b \<times> 'a) set" assume F: "range F \<subseteq> sets (N \<Otimes>\<^sub>M M)" "disjoint_family F"
     from F have *: "\<And>i. F i \<in> sets (N \<Otimes>\<^sub>M M)" by auto
     moreover have "\<And>x. disjoint_family (\<lambda>i. Pair x -` F i)"
       by (intro disjoint_family_on_bisimulation[OF F(2)]) auto
     moreover have "\<And>x. range (\<lambda>i. Pair x -` F i) \<subseteq> sets M"
       using F by (auto simp: sets_Pair1)
     ultimately show "(\<Sum>n. ?\<mu> (F n)) = ?\<mu> (\<Union>i. F i)"
       by (auto simp add: nn_integral_suminf[symmetric] vimage_UN suminf_emeasure
                intro!: nn_integral_cong nn_integral_indicator[symmetric])
   qed
   show "{a \<times> b |a b. a \<in> sets N \<and> b \<in> sets M} \<subseteq> Pow (space N \<times> space M)"
     using sets.space_closed[of N] sets.space_closed[of M] by auto
 qed fact
 
 lemma (in sigma_finite_measure) emeasure_pair_measure_alt:
   assumes X: "X \<in> sets (N \<Otimes>\<^sub>M M)"
   shows "emeasure (N  \<Otimes>\<^sub>M M) X = (\<integral>\<^sup>+x. emeasure M (Pair x -` X) \<partial>N)"
 proof -
   have [simp]: "\<And>x y. indicator X (x, y) = indicator (Pair x -` X) y"
     by (auto simp: indicator_def)
   show ?thesis
     using X by (auto intro!: nn_integral_cong simp: emeasure_pair_measure sets_Pair1)
 qed
 
 proposition (in sigma_finite_measure) emeasure_pair_measure_Times:
   assumes A: "A \<in> sets N" and B: "B \<in> sets M"
   shows "emeasure (N \<Otimes>\<^sub>M M) (A \<times> B) = emeasure N A * emeasure M B"
 proof -
   have "emeasure (N \<Otimes>\<^sub>M M) (A \<times> B) = (\<integral>\<^sup>+x. emeasure M B * indicator A x \<partial>N)"
     using A B by (auto intro!: nn_integral_cong simp: emeasure_pair_measure_alt)
   also have "\<dots> = emeasure M B * emeasure N A"
     using A by (simp add: nn_integral_cmult_indicator)
   finally show ?thesis
     by (simp add: ac_simps)
 qed
 
 subsection \<open>Binary products of \<open>\<sigma>\<close>-finite emeasure spaces\<close>
 
 locale\<^marker>\<open>tag unimportant\<close> pair_sigma_finite = M1?: sigma_finite_measure M1 + M2?: sigma_finite_measure M2
   for M1 :: "'a measure" and M2 :: "'b measure"
 
 lemma (in pair_sigma_finite) measurable_emeasure_Pair1:
   "Q \<in> sets (M1 \<Otimes>\<^sub>M M2) \<Longrightarrow> (\<lambda>x. emeasure M2 (Pair x -` Q)) \<in> borel_measurable M1"
   using M2.measurable_emeasure_Pair .
 
 lemma (in pair_sigma_finite) measurable_emeasure_Pair2:
   assumes Q: "Q \<in> sets (M1 \<Otimes>\<^sub>M M2)" shows "(\<lambda>y. emeasure M1 ((\<lambda>x. (x, y)) -` Q)) \<in> borel_measurable M2"
 proof -
   have "(\<lambda>(x, y). (y, x)) -` Q \<inter> space (M2 \<Otimes>\<^sub>M M1) \<in> sets (M2 \<Otimes>\<^sub>M M1)"
     using Q measurable_pair_swap' by (auto intro: measurable_sets)
   note M1.measurable_emeasure_Pair[OF this]
   moreover have "\<And>y. Pair y -` ((\<lambda>(x, y). (y, x)) -` Q \<inter> space (M2 \<Otimes>\<^sub>M M1)) = (\<lambda>x. (x, y)) -` Q"
     using Q[THEN sets.sets_into_space] by (auto simp: space_pair_measure)
   ultimately show ?thesis by simp
 qed
 
 proposition (in pair_sigma_finite) sigma_finite_up_in_pair_measure_generator:
   defines "E \<equiv> {A \<times> B | A B. A \<in> sets M1 \<and> B \<in> sets M2}"
   shows "\<exists>F::nat \<Rightarrow> ('a \<times> 'b) set. range F \<subseteq> E \<and> incseq F \<and> (\<Union>i. F i) = space M1 \<times> space M2 \<and>
     (\<forall>i. emeasure (M1 \<Otimes>\<^sub>M M2) (F i) \<noteq> \<infinity>)"
 proof -
-  from M1.sigma_finite_incseq guess F1 . note F1 = this
-  from M2.sigma_finite_incseq guess F2 . note F2 = this
+  obtain F1 where F1: "range F1 \<subseteq> sets M1"
+    "\<Union> (range F1) = space M1"
+    "\<And>i. emeasure M1 (F1 i) \<noteq> \<infinity>"
+    "incseq F1"
+    by (rule M1.sigma_finite_incseq) blast
+  obtain F2 where F2: "range F2 \<subseteq> sets M2"
+    "\<Union> (range F2) = space M2"
+    "\<And>i. emeasure M2 (F2 i) \<noteq> \<infinity>"
+    "incseq F2"
+    by (rule M2.sigma_finite_incseq) blast
   from F1 F2 have space: "space M1 = (\<Union>i. F1 i)" "space M2 = (\<Union>i. F2 i)" by auto
   let ?F = "\<lambda>i. F1 i \<times> F2 i"
   show ?thesis
   proof (intro exI[of _ ?F] conjI allI)
     show "range ?F \<subseteq> E" using F1 F2 by (auto simp: E_def) (metis range_subsetD)
   next
     have "space M1 \<times> space M2 \<subseteq> (\<Union>i. ?F i)"
     proof (intro subsetI)
       fix x assume "x \<in> space M1 \<times> space M2"
       then obtain i j where "fst x \<in> F1 i" "snd x \<in> F2 j"
         by (auto simp: space)
       then have "fst x \<in> F1 (max i j)" "snd x \<in> F2 (max j i)"
         using \<open>incseq F1\<close> \<open>incseq F2\<close> unfolding incseq_def
         by (force split: split_max)+
       then have "(fst x, snd x) \<in> F1 (max i j) \<times> F2 (max i j)"
         by (intro SigmaI) (auto simp add: max.commute)
       then show "x \<in> (\<Union>i. ?F i)" by auto
     qed
     then show "(\<Union>i. ?F i) = space M1 \<times> space M2"
       using space by (auto simp: space)
   next
     fix i show "incseq (\<lambda>i. F1 i \<times> F2 i)"
       using \<open>incseq F1\<close> \<open>incseq F2\<close> unfolding incseq_Suc_iff by auto
   next
     fix i
     from F1 F2 have "F1 i \<in> sets M1" "F2 i \<in> sets M2" by auto
     with F1 F2 show "emeasure (M1 \<Otimes>\<^sub>M M2) (F1 i \<times> F2 i) \<noteq> \<infinity>"
       by (auto simp add: emeasure_pair_measure_Times ennreal_mult_eq_top_iff)
   qed
 qed
 
 sublocale\<^marker>\<open>tag unimportant\<close> pair_sigma_finite \<subseteq> P?: sigma_finite_measure "M1 \<Otimes>\<^sub>M M2"
 proof
-  from M1.sigma_finite_countable guess F1 ..
-  moreover from M2.sigma_finite_countable guess F2 ..
-  ultimately show
+  obtain F1 :: "'a set set" and F2 :: "'b set set" where
+      "countable F1 \<and> F1 \<subseteq> sets M1 \<and> \<Union> F1 = space M1 \<and> (\<forall>a\<in>F1. emeasure M1 a \<noteq> \<infinity>)"
+      "countable F2 \<and> F2 \<subseteq> sets M2 \<and> \<Union> F2 = space M2 \<and> (\<forall>a\<in>F2. emeasure M2 a \<noteq> \<infinity>)"
+    using M1.sigma_finite_countable M2.sigma_finite_countable by auto
+  then show
     "\<exists>A. countable A \<and> A \<subseteq> sets (M1 \<Otimes>\<^sub>M M2) \<and> \<Union>A = space (M1 \<Otimes>\<^sub>M M2) \<and> (\<forall>a\<in>A. emeasure (M1 \<Otimes>\<^sub>M M2) a \<noteq> \<infinity>)"
     by (intro exI[of _ "(\<lambda>(a, b). a \<times> b) ` (F1 \<times> F2)"] conjI)
        (auto simp: M2.emeasure_pair_measure_Times space_pair_measure set_eq_iff subset_eq ennreal_mult_eq_top_iff)
 qed
 
 lemma sigma_finite_pair_measure:
   assumes A: "sigma_finite_measure A" and B: "sigma_finite_measure B"
   shows "sigma_finite_measure (A \<Otimes>\<^sub>M B)"
 proof -
   interpret A: sigma_finite_measure A by fact
   interpret B: sigma_finite_measure B by fact
   interpret AB: pair_sigma_finite A  B ..
   show ?thesis ..
 qed
 
 lemma sets_pair_swap:
   assumes "A \<in> sets (M1 \<Otimes>\<^sub>M M2)"
   shows "(\<lambda>(x, y). (y, x)) -` A \<inter> space (M2 \<Otimes>\<^sub>M M1) \<in> sets (M2 \<Otimes>\<^sub>M M1)"
   using measurable_pair_swap' assms by (rule measurable_sets)
 
 lemma (in pair_sigma_finite) distr_pair_swap:
   "M1 \<Otimes>\<^sub>M M2 = distr (M2 \<Otimes>\<^sub>M M1) (M1 \<Otimes>\<^sub>M M2) (\<lambda>(x, y). (y, x))" (is "?P = ?D")
 proof -
-  from sigma_finite_up_in_pair_measure_generator guess F :: "nat \<Rightarrow> ('a \<times> 'b) set" .. note F = this
   let ?E = "{a \<times> b |a b. a \<in> sets M1 \<and> b \<in> sets M2}"
+  obtain F :: "nat \<Rightarrow> ('a \<times> 'b) set" where F: "range F \<subseteq> ?E"
+    "incseq F" "\<Union> (range F) = space M1 \<times> space M2" "\<forall>i. emeasure (M1 \<Otimes>\<^sub>M M2) (F i) \<noteq> \<infinity>"
+    using sigma_finite_up_in_pair_measure_generator by auto
   show ?thesis
   proof (rule measure_eqI_generator_eq[OF Int_stable_pair_measure_generator[of M1 M2]])
     show "?E \<subseteq> Pow (space ?P)"
       using sets.space_closed[of M1] sets.space_closed[of M2] by (auto simp: space_pair_measure)
     show "sets ?P = sigma_sets (space ?P) ?E"
       by (simp add: sets_pair_measure space_pair_measure)
     then show "sets ?D = sigma_sets (space ?P) ?E"
       by simp
-  next
-    show "range F \<subseteq> ?E" "(\<Union>i. F i) = space ?P" "\<And>i. emeasure ?P (F i) \<noteq> \<infinity>"
-      using F by (auto simp: space_pair_measure)
+    from F show "range F \<subseteq> ?E" "(\<Union>i. F i) = space ?P" "\<And>i. emeasure ?P (F i) \<noteq> \<infinity>"
+      by (auto simp: space_pair_measure)
   next
     fix X assume "X \<in> ?E"
     then obtain A B where X[simp]: "X = A \<times> B" and A: "A \<in> sets M1" and B: "B \<in> sets M2" by auto
     have "(\<lambda>(y, x). (x, y)) -` X \<inter> space (M2 \<Otimes>\<^sub>M M1) = B \<times> A"
       using sets.sets_into_space[OF A] sets.sets_into_space[OF B] by (auto simp: space_pair_measure)
     with A B show "emeasure (M1 \<Otimes>\<^sub>M M2) X = emeasure ?D X"
       by (simp add: M2.emeasure_pair_measure_Times M1.emeasure_pair_measure_Times emeasure_distr
                     measurable_pair_swap' ac_simps)
   qed
 qed
 
 lemma (in pair_sigma_finite) emeasure_pair_measure_alt2:
   assumes A: "A \<in> sets (M1 \<Otimes>\<^sub>M M2)"
   shows "emeasure (M1 \<Otimes>\<^sub>M M2) A = (\<integral>\<^sup>+y. emeasure M1 ((\<lambda>x. (x, y)) -` A) \<partial>M2)"
     (is "_ = ?\<nu> A")
 proof -
   have [simp]: "\<And>y. (Pair y -` ((\<lambda>(x, y). (y, x)) -` A \<inter> space (M2 \<Otimes>\<^sub>M M1))) = (\<lambda>x. (x, y)) -` A"
     using sets.sets_into_space[OF A] by (auto simp: space_pair_measure)
   show ?thesis using A
     by (subst distr_pair_swap)
        (simp_all del: vimage_Int add: measurable_sets[OF measurable_pair_swap']
                  M1.emeasure_pair_measure_alt emeasure_distr[OF measurable_pair_swap' A])
 qed
 
 lemma (in pair_sigma_finite) AE_pair:
   assumes "AE x in (M1 \<Otimes>\<^sub>M M2). Q x"
   shows "AE x in M1. (AE y in M2. Q (x, y))"
 proof -
   obtain N where N: "N \<in> sets (M1 \<Otimes>\<^sub>M M2)" "emeasure (M1 \<Otimes>\<^sub>M M2) N = 0" "{x\<in>space (M1 \<Otimes>\<^sub>M M2). \<not> Q x} \<subseteq> N"
     using assms unfolding eventually_ae_filter by auto
   show ?thesis
   proof (rule AE_I)
     from N measurable_emeasure_Pair1[OF \<open>N \<in> sets (M1 \<Otimes>\<^sub>M M2)\<close>]
     show "emeasure M1 {x\<in>space M1. emeasure M2 (Pair x -` N) \<noteq> 0} = 0"
       by (auto simp: M2.emeasure_pair_measure_alt nn_integral_0_iff)
     show "{x \<in> space M1. emeasure M2 (Pair x -` N) \<noteq> 0} \<in> sets M1"
       by (intro borel_measurable_eq measurable_emeasure_Pair1 N sets.sets_Collect_neg N) simp
     { fix x assume "x \<in> space M1" "emeasure M2 (Pair x -` N) = 0"
       have "AE y in M2. Q (x, y)"
       proof (rule AE_I)
         show "emeasure M2 (Pair x -` N) = 0" by fact
         show "Pair x -` N \<in> sets M2" using N(1) by (rule sets_Pair1)
         show "{y \<in> space M2. \<not> Q (x, y)} \<subseteq> Pair x -` N"
           using N \<open>x \<in> space M1\<close> unfolding space_pair_measure by auto
       qed }
     then show "{x \<in> space M1. \<not> (AE y in M2. Q (x, y))} \<subseteq> {x \<in> space M1. emeasure M2 (Pair x -` N) \<noteq> 0}"
       by auto
   qed
 qed
 
 lemma (in pair_sigma_finite) AE_pair_measure:
   assumes "{x\<in>space (M1 \<Otimes>\<^sub>M M2). P x} \<in> sets (M1 \<Otimes>\<^sub>M M2)"
   assumes ae: "AE x in M1. AE y in M2. P (x, y)"
   shows "AE x in M1 \<Otimes>\<^sub>M M2. P x"
 proof (subst AE_iff_measurable[OF _ refl])
   show "{x\<in>space (M1 \<Otimes>\<^sub>M M2). \<not> P x} \<in> sets (M1 \<Otimes>\<^sub>M M2)"
     by (rule sets.sets_Collect) fact
   then have "emeasure (M1 \<Otimes>\<^sub>M M2) {x \<in> space (M1 \<Otimes>\<^sub>M M2). \<not> P x} =
       (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator {x \<in> space (M1 \<Otimes>\<^sub>M M2). \<not> P x} (x, y) \<partial>M2 \<partial>M1)"
     by (simp add: M2.emeasure_pair_measure)
   also have "\<dots> = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. 0 \<partial>M2 \<partial>M1)"
     using ae
     apply (safe intro!: nn_integral_cong_AE)
     apply (intro AE_I2)
     apply (safe intro!: nn_integral_cong_AE)
     apply auto
     done
   finally show "emeasure (M1 \<Otimes>\<^sub>M M2) {x \<in> space (M1 \<Otimes>\<^sub>M M2). \<not> P x} = 0" by simp
 qed
 
 lemma (in pair_sigma_finite) AE_pair_iff:
   "{x\<in>space (M1 \<Otimes>\<^sub>M M2). P (fst x) (snd x)} \<in> sets (M1 \<Otimes>\<^sub>M M2) \<Longrightarrow>
     (AE x in M1. AE y in M2. P x y) \<longleftrightarrow> (AE x in (M1 \<Otimes>\<^sub>M M2). P (fst x) (snd x))"
   using AE_pair[of "\<lambda>x. P (fst x) (snd x)"] AE_pair_measure[of "\<lambda>x. P (fst x) (snd x)"] by auto
 
 lemma (in pair_sigma_finite) AE_commute:
   assumes P: "{x\<in>space (M1 \<Otimes>\<^sub>M M2). P (fst x) (snd x)} \<in> sets (M1 \<Otimes>\<^sub>M M2)"
   shows "(AE x in M1. AE y in M2. P x y) \<longleftrightarrow> (AE y in M2. AE x in M1. P x y)"
 proof -
   interpret Q: pair_sigma_finite M2 M1 ..
   have [simp]: "\<And>x. (fst (case x of (x, y) \<Rightarrow> (y, x))) = snd x" "\<And>x. (snd (case x of (x, y) \<Rightarrow> (y, x))) = fst x"
     by auto
   have "{x \<in> space (M2 \<Otimes>\<^sub>M M1). P (snd x) (fst x)} =
     (\<lambda>(x, y). (y, x)) -` {x \<in> space (M1 \<Otimes>\<^sub>M M2). P (fst x) (snd x)} \<inter> space (M2 \<Otimes>\<^sub>M M1)"
     by (auto simp: space_pair_measure)
   also have "\<dots> \<in> sets (M2 \<Otimes>\<^sub>M M1)"
     by (intro sets_pair_swap P)
   finally show ?thesis
     apply (subst AE_pair_iff[OF P])
     apply (subst distr_pair_swap)
     apply (subst AE_distr_iff[OF measurable_pair_swap' P])
     apply (subst Q.AE_pair_iff)
     apply simp_all
     done
 qed
 
 subsection "Fubinis theorem"
 
 lemma measurable_compose_Pair1:
   "x \<in> space M1 \<Longrightarrow> g \<in> measurable (M1 \<Otimes>\<^sub>M M2) L \<Longrightarrow> (\<lambda>y. g (x, y)) \<in> measurable M2 L"
   by simp
 
 lemma (in sigma_finite_measure) borel_measurable_nn_integral_fst:
   assumes f: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M)"
   shows "(\<lambda>x. \<integral>\<^sup>+ y. f (x, y) \<partial>M) \<in> borel_measurable M1"
 using f proof induct
   case (cong u v)
   then have "\<And>w x. w \<in> space M1 \<Longrightarrow> x \<in> space M \<Longrightarrow> u (w, x) = v (w, x)"
     by (auto simp: space_pair_measure)
   show ?case
     apply (subst measurable_cong)
     apply (rule nn_integral_cong)
     apply fact+
     done
 next
   case (set Q)
   have [simp]: "\<And>x y. indicator Q (x, y) = indicator (Pair x -` Q) y"
     by (auto simp: indicator_def)
   have "\<And>x. x \<in> space M1 \<Longrightarrow> emeasure M (Pair x -` Q) = \<integral>\<^sup>+ y. indicator Q (x, y) \<partial>M"
     by (simp add: sets_Pair1[OF set])
   from this measurable_emeasure_Pair[OF set] show ?case
     by (rule measurable_cong[THEN iffD1])
 qed (simp_all add: nn_integral_add nn_integral_cmult measurable_compose_Pair1
                    nn_integral_monotone_convergence_SUP incseq_def le_fun_def image_comp
               cong: measurable_cong)
 
 lemma (in sigma_finite_measure) nn_integral_fst:
   assumes f: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M)"
   shows "(\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. f (x, y) \<partial>M \<partial>M1) = integral\<^sup>N (M1 \<Otimes>\<^sub>M M) f" (is "?I f = _")
   using f proof induct
   case (cong u v)
   then have "?I u = ?I v"
     by (intro nn_integral_cong) (auto simp: space_pair_measure)
   with cong show ?case
     by (simp cong: nn_integral_cong)
 qed (simp_all add: emeasure_pair_measure nn_integral_cmult nn_integral_add
                    nn_integral_monotone_convergence_SUP measurable_compose_Pair1
                    borel_measurable_nn_integral_fst nn_integral_mono incseq_def le_fun_def image_comp
               cong: nn_integral_cong)
 
 lemma (in sigma_finite_measure) borel_measurable_nn_integral[measurable (raw)]:
   "case_prod f \<in> borel_measurable (N \<Otimes>\<^sub>M M) \<Longrightarrow> (\<lambda>x. \<integral>\<^sup>+ y. f x y \<partial>M) \<in> borel_measurable N"
   using borel_measurable_nn_integral_fst[of "case_prod f" N] by simp
 
 proposition (in pair_sigma_finite) nn_integral_snd:
   assumes f[measurable]: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
   shows "(\<integral>\<^sup>+ y. (\<integral>\<^sup>+ x. f (x, y) \<partial>M1) \<partial>M2) = integral\<^sup>N (M1 \<Otimes>\<^sub>M M2) f"
 proof -
   note measurable_pair_swap[OF f]
   from M1.nn_integral_fst[OF this]
   have "(\<integral>\<^sup>+ y. (\<integral>\<^sup>+ x. f (x, y) \<partial>M1) \<partial>M2) = (\<integral>\<^sup>+ (x, y). f (y, x) \<partial>(M2 \<Otimes>\<^sub>M M1))"
     by simp
   also have "(\<integral>\<^sup>+ (x, y). f (y, x) \<partial>(M2 \<Otimes>\<^sub>M M1)) = integral\<^sup>N (M1 \<Otimes>\<^sub>M M2) f"
     by (subst distr_pair_swap) (auto simp add: nn_integral_distr intro!: nn_integral_cong)
   finally show ?thesis .
 qed
 
 theorem (in pair_sigma_finite) Fubini:
   assumes f: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
   shows "(\<integral>\<^sup>+ y. (\<integral>\<^sup>+ x. f (x, y) \<partial>M1) \<partial>M2) = (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. f (x, y) \<partial>M2) \<partial>M1)"
   unfolding nn_integral_snd[OF assms] M2.nn_integral_fst[OF assms] ..
 
 theorem (in pair_sigma_finite) Fubini':
   assumes f: "case_prod f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
   shows "(\<integral>\<^sup>+ y. (\<integral>\<^sup>+ x. f x y \<partial>M1) \<partial>M2) = (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. f x y \<partial>M2) \<partial>M1)"
   using Fubini[OF f] by simp
 
 subsection \<open>Products on counting spaces, densities and distributions\<close>
 
 proposition sigma_prod:
   assumes X_cover: "\<exists>E\<subseteq>A. countable E \<and> X = \<Union>E" and A: "A \<subseteq> Pow X"
   assumes Y_cover: "\<exists>E\<subseteq>B. countable E \<and> Y = \<Union>E" and B: "B \<subseteq> Pow Y"
   shows "sigma X A \<Otimes>\<^sub>M sigma Y B = sigma (X \<times> Y) {a \<times> b | a b. a \<in> A \<and> b \<in> B}"
     (is "?P = ?S")
 proof (rule measure_eqI)
   have [simp]: "snd \<in> X \<times> Y \<rightarrow> Y" "fst \<in> X \<times> Y \<rightarrow> X"
     by auto
   let ?XY = "{{fst -` a \<inter> X \<times> Y | a. a \<in> A}, {snd -` b \<inter> X \<times> Y | b. b \<in> B}}"
   have "sets ?P = sets (SUP xy\<in>?XY. sigma (X \<times> Y) xy)"
     by (simp add: vimage_algebra_sigma sets_pair_eq_sets_fst_snd A B)
   also have "\<dots> = sets (sigma (X \<times> Y) (\<Union>?XY))"
     by (intro Sup_sigma arg_cong[where f=sets]) auto
   also have "\<dots> = sets ?S"
   proof (intro arg_cong[where f=sets] sigma_eqI sigma_sets_eqI)
     show "\<Union>?XY \<subseteq> Pow (X \<times> Y)" "{a \<times> b |a b. a \<in> A \<and> b \<in> B} \<subseteq> Pow (X \<times> Y)"
       using A B by auto
   next
     interpret XY: sigma_algebra "X \<times> Y" "sigma_sets (X \<times> Y) {a \<times> b |a b. a \<in> A \<and> b \<in> B}"
       using A B by (intro sigma_algebra_sigma_sets) auto
     fix Z assume "Z \<in> \<Union>?XY"
     then show "Z \<in> sigma_sets (X \<times> Y) {a \<times> b |a b. a \<in> A \<and> b \<in> B}"
     proof safe
       fix a assume "a \<in> A"
       from Y_cover obtain E where E: "E \<subseteq> B" "countable E" and "Y = \<Union>E"
         by auto
       with \<open>a \<in> A\<close> A have eq: "fst -` a \<inter> X \<times> Y = (\<Union>e\<in>E. a \<times> e)"
         by auto
       show "fst -` a \<inter> X \<times> Y \<in> sigma_sets (X \<times> Y) {a \<times> b |a b. a \<in> A \<and> b \<in> B}"
         using \<open>a \<in> A\<close> E unfolding eq by (auto intro!: XY.countable_UN')
     next
       fix b assume "b \<in> B"
       from X_cover obtain E where E: "E \<subseteq> A" "countable E" and "X = \<Union>E"
         by auto
       with \<open>b \<in> B\<close> B have eq: "snd -` b \<inter> X \<times> Y = (\<Union>e\<in>E. e \<times> b)"
         by auto
       show "snd -` b \<inter> X \<times> Y \<in> sigma_sets (X \<times> Y) {a \<times> b |a b. a \<in> A \<and> b \<in> B}"
         using \<open>b \<in> B\<close> E unfolding eq by (auto intro!: XY.countable_UN')
     qed
   next
     fix Z assume "Z \<in> {a \<times> b |a b. a \<in> A \<and> b \<in> B}"
     then obtain a b where "Z = a \<times> b" and ab: "a \<in> A" "b \<in> B"
       by auto
     then have Z: "Z = (fst -` a \<inter> X \<times> Y) \<inter> (snd -` b \<inter> X \<times> Y)"
       using A B by auto
     interpret XY: sigma_algebra "X \<times> Y" "sigma_sets (X \<times> Y) (\<Union>?XY)"
       by (intro sigma_algebra_sigma_sets) auto
     show "Z \<in> sigma_sets (X \<times> Y) (\<Union>?XY)"
       unfolding Z by (rule XY.Int) (blast intro: ab)+
   qed
   finally show "sets ?P = sets ?S" .
 next
   interpret finite_measure "sigma X A" for X A
     proof qed (simp add: emeasure_sigma)
   fix A assume "A \<in> sets ?P" then show "emeasure ?P A = emeasure ?S A"
     by (simp add: emeasure_pair_measure_alt emeasure_sigma)
 qed
 
 lemma sigma_sets_pair_measure_generator_finite:
   assumes "finite A" and "finite B"
   shows "sigma_sets (A \<times> B) { a \<times> b | a b. a \<subseteq> A \<and> b \<subseteq> B} = Pow (A \<times> B)"
   (is "sigma_sets ?prod ?sets = _")
 proof safe
   have fin: "finite (A \<times> B)" using assms by (rule finite_cartesian_product)
   fix x assume subset: "x \<subseteq> A \<times> B"
   hence "finite x" using fin by (rule finite_subset)
   from this subset show "x \<in> sigma_sets ?prod ?sets"
   proof (induct x)
     case empty show ?case by (rule sigma_sets.Empty)
   next
     case (insert a x)
     hence "{a} \<in> sigma_sets ?prod ?sets" by auto
     moreover have "x \<in> sigma_sets ?prod ?sets" using insert by auto
     ultimately show ?case unfolding insert_is_Un[of a x] by (rule sigma_sets_Un)
   qed
 next
   fix x a b
   assume "x \<in> sigma_sets ?prod ?sets" and "(a, b) \<in> x"
   from sigma_sets_into_sp[OF _ this(1)] this(2)
   show "a \<in> A" and "b \<in> B" by auto
 qed
 
 proposition  sets_pair_eq:
   assumes Ea: "Ea \<subseteq> Pow (space A)" "sets A = sigma_sets (space A) Ea"
     and Ca: "countable Ca" "Ca \<subseteq> Ea" "\<Union>Ca = space A"
     and Eb: "Eb \<subseteq> Pow (space B)" "sets B = sigma_sets (space B) Eb"
     and Cb: "countable Cb" "Cb \<subseteq> Eb" "\<Union>Cb = space B"
   shows "sets (A \<Otimes>\<^sub>M B) = sets (sigma (space A \<times> space B) { a \<times> b | a b. a \<in> Ea \<and> b \<in> Eb })"
     (is "_ = sets (sigma ?\<Omega> ?E)")
 proof
   show "sets (sigma ?\<Omega> ?E) \<subseteq> sets (A \<Otimes>\<^sub>M B)"
     using Ea(1) Eb(1) by (subst sigma_le_sets) (auto simp: Ea(2) Eb(2))
   have "?E \<subseteq> Pow ?\<Omega>"
     using Ea(1) Eb(1) by auto
   then have E: "a \<in> Ea \<Longrightarrow> b \<in> Eb \<Longrightarrow> a \<times> b \<in> sets (sigma ?\<Omega> ?E)" for a b
     by auto
   have "sets (A \<Otimes>\<^sub>M B) \<subseteq> sets (Sup {vimage_algebra ?\<Omega> fst A, vimage_algebra ?\<Omega> snd B})"
     unfolding sets_pair_eq_sets_fst_snd ..
   also have "vimage_algebra ?\<Omega> fst A = vimage_algebra ?\<Omega> fst (sigma (space A) Ea)"
     by (intro vimage_algebra_cong[OF refl refl]) (simp add: Ea)
   also have "\<dots> = sigma ?\<Omega> {fst -` A \<inter> ?\<Omega> |A. A \<in> Ea}"
     by (intro Ea vimage_algebra_sigma) auto
   also have "vimage_algebra ?\<Omega> snd B = vimage_algebra ?\<Omega> snd (sigma (space B) Eb)"
     by (intro vimage_algebra_cong[OF refl refl]) (simp add: Eb)
   also have "\<dots> = sigma ?\<Omega> {snd -` A \<inter> ?\<Omega> |A. A \<in> Eb}"
     by (intro Eb vimage_algebra_sigma) auto
   also have "{sigma ?\<Omega> {fst -` Aa \<inter> ?\<Omega> |Aa. Aa \<in> Ea}, sigma ?\<Omega> {snd -` Aa \<inter> ?\<Omega> |Aa. Aa \<in> Eb}} =
     sigma ?\<Omega> ` {{fst -` Aa \<inter> ?\<Omega> |Aa. Aa \<in> Ea}, {snd -` Aa \<inter> ?\<Omega> |Aa. Aa \<in> Eb}}"
     by auto
   also have "sets (SUP S\<in>{{fst -` Aa \<inter> ?\<Omega> |Aa. Aa \<in> Ea}, {snd -` Aa \<inter> ?\<Omega> |Aa. Aa \<in> Eb}}. sigma ?\<Omega> S) =
     sets (sigma ?\<Omega> (\<Union>{{fst -` Aa \<inter> ?\<Omega> |Aa. Aa \<in> Ea}, {snd -` Aa \<inter> ?\<Omega> |Aa. Aa \<in> Eb}}))"
     using Ea(1) Eb(1) by (intro sets_Sup_sigma) auto
   also have "\<dots> \<subseteq> sets (sigma ?\<Omega> ?E)"
   proof (subst sigma_le_sets, safe intro!: space_in_measure_of)
     fix a assume "a \<in> Ea"
     then have "fst -` a \<inter> ?\<Omega> = (\<Union>b\<in>Cb. a \<times> b)"
       using Cb(3)[symmetric] Ea(1) by auto
     then show "fst -` a \<inter> ?\<Omega> \<in> sets (sigma ?\<Omega> ?E)"
       using Cb \<open>a \<in> Ea\<close> by (auto intro!: sets.countable_UN' E)
   next
     fix b assume "b \<in> Eb"
     then have "snd -` b \<inter> ?\<Omega> = (\<Union>a\<in>Ca. a \<times> b)"
       using Ca(3)[symmetric] Eb(1) by auto
     then show "snd -` b \<inter> ?\<Omega> \<in> sets (sigma ?\<Omega> ?E)"
       using Ca \<open>b \<in> Eb\<close> by (auto intro!: sets.countable_UN' E)
   qed
   finally show "sets (A \<Otimes>\<^sub>M B) \<subseteq> sets (sigma ?\<Omega> ?E)" .
 qed
 
 proposition  borel_prod:
   "(borel \<Otimes>\<^sub>M borel) = (borel :: ('a::second_countable_topology \<times> 'b::second_countable_topology) measure)"
   (is "?P = ?B")
 proof -
   have "?B = sigma UNIV {A \<times> B | A B. open A \<and> open B}"
     by (rule second_countable_borel_measurable[OF open_prod_generated])
   also have "\<dots> = ?P"
     unfolding borel_def
     by (subst sigma_prod) (auto intro!: exI[of _ "{UNIV}"])
   finally show ?thesis ..
 qed
 
 proposition pair_measure_count_space:
   assumes A: "finite A" and B: "finite B"
   shows "count_space A \<Otimes>\<^sub>M count_space B = count_space (A \<times> B)" (is "?P = ?C")
 proof (rule measure_eqI)
   interpret A: finite_measure "count_space A" by (rule finite_measure_count_space) fact
   interpret B: finite_measure "count_space B" by (rule finite_measure_count_space) fact
   interpret P: pair_sigma_finite "count_space A" "count_space B" ..
   show eq: "sets ?P = sets ?C"
     by (simp add: sets_pair_measure sigma_sets_pair_measure_generator_finite A B)
   fix X assume X: "X \<in> sets ?P"
   with eq have X_subset: "X \<subseteq> A \<times> B" by simp
   with A B have fin_Pair: "\<And>x. finite (Pair x -` X)"
     by (intro finite_subset[OF _ B]) auto
   have fin_X: "finite X" using X_subset by (rule finite_subset) (auto simp: A B)
   have card: "0 < card (Pair a -` X)" if "(a, b) \<in> X" for a b
     using card_gt_0_iff fin_Pair that by auto
   then have "emeasure ?P X = \<integral>\<^sup>+ x. emeasure (count_space B) (Pair x -` X)
             \<partial>count_space A"
     by (simp add: B.emeasure_pair_measure_alt X)
   also have "... = emeasure ?C X"
     apply (subst emeasure_count_space)
     using card X_subset A fin_Pair fin_X
     apply (auto simp add: nn_integral_count_space
                            of_nat_sum[symmetric] card_SigmaI[symmetric]
                 simp del:  card_SigmaI
                 intro!: arg_cong[where f=card])
     done
   finally show "emeasure ?P X = emeasure ?C X" .
 qed
 
 
 lemma emeasure_prod_count_space:
   assumes A: "A \<in> sets (count_space UNIV \<Otimes>\<^sub>M M)" (is "A \<in> sets (?A \<Otimes>\<^sub>M ?B)")
   shows "emeasure (?A \<Otimes>\<^sub>M ?B) A = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>?B \<partial>?A)"
   by (rule emeasure_measure_of[OF pair_measure_def])
      (auto simp: countably_additive_def positive_def suminf_indicator A
                  nn_integral_suminf[symmetric] dest: sets.sets_into_space)
 
 lemma emeasure_prod_count_space_single[simp]: "emeasure (count_space UNIV \<Otimes>\<^sub>M count_space UNIV) {x} = 1"
 proof -
   have [simp]: "\<And>a b x y. indicator {(a, b)} (x, y) = (indicator {a} x * indicator {b} y::ennreal)"
     by (auto split: split_indicator)
   show ?thesis
     by (cases x) (auto simp: emeasure_prod_count_space nn_integral_cmult sets_Pair)
 qed
 
 lemma emeasure_count_space_prod_eq:
   fixes A :: "('a \<times> 'b) set"
   assumes A: "A \<in> sets (count_space UNIV \<Otimes>\<^sub>M count_space UNIV)" (is "A \<in> sets (?A \<Otimes>\<^sub>M ?B)")
   shows "emeasure (?A \<Otimes>\<^sub>M ?B) A = emeasure (count_space UNIV) A"
 proof -
   { fix A :: "('a \<times> 'b) set" assume "countable A"
     then have "emeasure (?A \<Otimes>\<^sub>M ?B) (\<Union>a\<in>A. {a}) = (\<integral>\<^sup>+a. emeasure (?A \<Otimes>\<^sub>M ?B) {a} \<partial>count_space A)"
       by (intro emeasure_UN_countable) (auto simp: sets_Pair disjoint_family_on_def)
     also have "\<dots> = (\<integral>\<^sup>+a. indicator A a \<partial>count_space UNIV)"
       by (subst nn_integral_count_space_indicator) auto
     finally have "emeasure (?A \<Otimes>\<^sub>M ?B) A = emeasure (count_space UNIV) A"
       by simp }
   note * = this
 
   show ?thesis
   proof cases
     assume "finite A" then show ?thesis
       by (intro * countable_finite)
   next
     assume "infinite A"
     then obtain C where "countable C" and "infinite C" and "C \<subseteq> A"
       by (auto dest: infinite_countable_subset')
     with A have "emeasure (?A \<Otimes>\<^sub>M ?B) C \<le> emeasure (?A \<Otimes>\<^sub>M ?B) A"
       by (intro emeasure_mono) auto
     also have "emeasure (?A \<Otimes>\<^sub>M ?B) C = emeasure (count_space UNIV) C"
       using \<open>countable C\<close> by (rule *)
     finally show ?thesis
       using \<open>infinite C\<close> \<open>infinite A\<close> by (simp add: top_unique)
   qed
 qed
 
 lemma nn_integral_count_space_prod_eq:
   "nn_integral (count_space UNIV \<Otimes>\<^sub>M count_space UNIV) f = nn_integral (count_space UNIV) f"
     (is "nn_integral ?P f = _")
 proof cases
   assume cntbl: "countable {x. f x \<noteq> 0}"
   have [simp]: "\<And>x. card ({x} \<inter> {x. f x \<noteq> 0}) = (indicator {x. f x \<noteq> 0} x::ennreal)"
     by (auto split: split_indicator)
   have [measurable]: "\<And>y. (\<lambda>x. indicator {y} x) \<in> borel_measurable ?P"
     by (rule measurable_discrete_difference[of "\<lambda>x. 0" _ borel "{y}" "\<lambda>x. indicator {y} x" for y])
        (auto intro: sets_Pair)
 
   have "(\<integral>\<^sup>+x. f x \<partial>?P) = (\<integral>\<^sup>+x. \<integral>\<^sup>+x'. f x * indicator {x} x' \<partial>count_space {x. f x \<noteq> 0} \<partial>?P)"
     by (auto simp add: nn_integral_cmult nn_integral_indicator' intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = (\<integral>\<^sup>+x. \<integral>\<^sup>+x'. f x' * indicator {x'} x \<partial>count_space {x. f x \<noteq> 0} \<partial>?P)"
     by (auto intro!: nn_integral_cong split: split_indicator)
   also have "\<dots> = (\<integral>\<^sup>+x'. \<integral>\<^sup>+x. f x' * indicator {x'} x \<partial>?P \<partial>count_space {x. f x \<noteq> 0})"
     by (intro nn_integral_count_space_nn_integral cntbl) auto
   also have "\<dots> = (\<integral>\<^sup>+x'. f x' \<partial>count_space {x. f x \<noteq> 0})"
     by (intro nn_integral_cong) (auto simp: nn_integral_cmult sets_Pair)
   finally show ?thesis
     by (auto simp add: nn_integral_count_space_indicator intro!: nn_integral_cong split: split_indicator)
 next
   { fix x assume "f x \<noteq> 0"
     then have "(\<exists>r\<ge>0. 0 < r \<and> f x = ennreal r) \<or> f x = \<infinity>"
       by (cases "f x" rule: ennreal_cases) (auto simp: less_le)
     then have "\<exists>n. ennreal (1 / real (Suc n)) \<le> f x"
       by (auto elim!: nat_approx_posE intro!: less_imp_le) }
   note * = this
 
   assume cntbl: "uncountable {x. f x \<noteq> 0}"
   also have "{x. f x \<noteq> 0} = (\<Union>n. {x. 1/Suc n \<le> f x})"
     using * by auto
   finally obtain n where "infinite {x. 1/Suc n \<le> f x}"
     by (meson countableI_type countable_UN uncountable_infinite)
   then obtain C where C: "C \<subseteq> {x. 1/Suc n \<le> f x}" and "countable C" "infinite C"
     by (metis infinite_countable_subset')
 
   have [measurable]: "C \<in> sets ?P"
     using sets.countable[OF _ \<open>countable C\<close>, of ?P] by (auto simp: sets_Pair)
 
   have "(\<integral>\<^sup>+x. ennreal (1/Suc n) * indicator C x \<partial>?P) \<le> nn_integral ?P f"
     using C by (intro nn_integral_mono) (auto split: split_indicator simp: zero_ereal_def[symmetric])
   moreover have "(\<integral>\<^sup>+x. ennreal (1/Suc n) * indicator C x \<partial>?P) = \<infinity>"
     using \<open>infinite C\<close> by (simp add: nn_integral_cmult emeasure_count_space_prod_eq ennreal_mult_top)
   moreover have "(\<integral>\<^sup>+x. ennreal (1/Suc n) * indicator C x \<partial>count_space UNIV) \<le> nn_integral (count_space UNIV) f"
     using C by (intro nn_integral_mono) (auto split: split_indicator simp: zero_ereal_def[symmetric])
   moreover have "(\<integral>\<^sup>+x. ennreal (1/Suc n) * indicator C x \<partial>count_space UNIV) = \<infinity>"
     using \<open>infinite C\<close> by (simp add: nn_integral_cmult ennreal_mult_top)
   ultimately show ?thesis
     by (simp add: top_unique)
 qed
 
 theorem pair_measure_density:
   assumes f: "f \<in> borel_measurable M1"
   assumes g: "g \<in> borel_measurable M2"
   assumes "sigma_finite_measure M2" "sigma_finite_measure (density M2 g)"
   shows "density M1 f \<Otimes>\<^sub>M density M2 g = density (M1 \<Otimes>\<^sub>M M2) (\<lambda>(x,y). f x * g y)" (is "?L = ?R")
 proof (rule measure_eqI)
   interpret M2: sigma_finite_measure M2 by fact
   interpret D2: sigma_finite_measure "density M2 g" by fact
 
   fix A assume A: "A \<in> sets ?L"
   with f g have "(\<integral>\<^sup>+ x. f x * \<integral>\<^sup>+ y. g y * indicator A (x, y) \<partial>M2 \<partial>M1) =
     (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. f x * g y * indicator A (x, y) \<partial>M2 \<partial>M1)"
     by (intro nn_integral_cong_AE)
        (auto simp add: nn_integral_cmult[symmetric] ac_simps)
   with A f g show "emeasure ?L A = emeasure ?R A"
     by (simp add: D2.emeasure_pair_measure emeasure_density nn_integral_density
                   M2.nn_integral_fst[symmetric]
              cong: nn_integral_cong)
 qed simp
 
 lemma sigma_finite_measure_distr:
   assumes "sigma_finite_measure (distr M N f)" and f: "f \<in> measurable M N"
   shows "sigma_finite_measure M"
 proof -
   interpret sigma_finite_measure "distr M N f" by fact
-  from sigma_finite_countable guess A .. note A = this
+  obtain A where A: "countable A" "A \<subseteq> sets (distr M N f)"
+      "\<Union> A = space (distr M N f)" "\<forall>a\<in>A. emeasure (distr M N f) a \<noteq> \<infinity>"
+    using sigma_finite_countable by auto
   show ?thesis
   proof
     show "\<exists>A. countable A \<and> A \<subseteq> sets M \<and> \<Union>A = space M \<and> (\<forall>a\<in>A. emeasure M a \<noteq> \<infinity>)"
       using A f
       by (intro exI[of _ "(\<lambda>a. f -` a \<inter> space M) ` A"])
          (auto simp: emeasure_distr set_eq_iff subset_eq intro: measurable_space)
   qed
 qed
 
 lemma pair_measure_distr:
   assumes f: "f \<in> measurable M S" and g: "g \<in> measurable N T"
   assumes "sigma_finite_measure (distr N T g)"
   shows "distr M S f \<Otimes>\<^sub>M distr N T g = distr (M \<Otimes>\<^sub>M N) (S \<Otimes>\<^sub>M T) (\<lambda>(x, y). (f x, g y))" (is "?P = ?D")
 proof (rule measure_eqI)
   interpret T: sigma_finite_measure "distr N T g" by fact
   interpret N: sigma_finite_measure N by (rule sigma_finite_measure_distr) fact+
 
   fix A assume A: "A \<in> sets ?P"
   with f g show "emeasure ?P A = emeasure ?D A"
     by (auto simp add: N.emeasure_pair_measure_alt space_pair_measure emeasure_distr
                        T.emeasure_pair_measure_alt nn_integral_distr
              intro!: nn_integral_cong arg_cong[where f="emeasure N"])
 qed simp
 
 lemma pair_measure_eqI:
   assumes "sigma_finite_measure M1" "sigma_finite_measure M2"
   assumes sets: "sets (M1 \<Otimes>\<^sub>M M2) = sets M"
   assumes emeasure: "\<And>A B. A \<in> sets M1 \<Longrightarrow> B \<in> sets M2 \<Longrightarrow> emeasure M1 A * emeasure M2 B = emeasure M (A \<times> B)"
   shows "M1 \<Otimes>\<^sub>M M2 = M"
 proof -
   interpret M1: sigma_finite_measure M1 by fact
   interpret M2: sigma_finite_measure M2 by fact
   interpret pair_sigma_finite M1 M2 ..
-  from sigma_finite_up_in_pair_measure_generator guess F :: "nat \<Rightarrow> ('a \<times> 'b) set" .. note F = this
   let ?E = "{a \<times> b |a b. a \<in> sets M1 \<and> b \<in> sets M2}"
   let ?P = "M1 \<Otimes>\<^sub>M M2"
+  obtain F :: "nat \<Rightarrow> ('a \<times> 'b) set" where F:
+    "range F \<subseteq> ?E" "incseq F" "\<Union> (range F) = space M1 \<times> space M2" "\<forall>i. emeasure ?P (F i) \<noteq> \<infinity>"
+    using sigma_finite_up_in_pair_measure_generator
+    by blast
   show ?thesis
   proof (rule measure_eqI_generator_eq[OF Int_stable_pair_measure_generator[of M1 M2]])
     show "?E \<subseteq> Pow (space ?P)"
       using sets.space_closed[of M1] sets.space_closed[of M2] by (auto simp: space_pair_measure)
     show "sets ?P = sigma_sets (space ?P) ?E"
       by (simp add: sets_pair_measure space_pair_measure)
     then show "sets M = sigma_sets (space ?P) ?E"
       using sets[symmetric] by simp
   next
     show "range F \<subseteq> ?E" "(\<Union>i. F i) = space ?P" "\<And>i. emeasure ?P (F i) \<noteq> \<infinity>"
       using F by (auto simp: space_pair_measure)
   next
     fix X assume "X \<in> ?E"
     then obtain A B where X[simp]: "X = A \<times> B" and A: "A \<in> sets M1" and B: "B \<in> sets M2" by auto
     then have "emeasure ?P X = emeasure M1 A * emeasure M2 B"
        by (simp add: M2.emeasure_pair_measure_Times)
     also have "\<dots> = emeasure M (A \<times> B)"
       using A B emeasure by auto
     finally show "emeasure ?P X = emeasure M X"
       by simp
   qed
 qed
 
 lemma sets_pair_countable:
   assumes "countable S1" "countable S2"
   assumes M: "sets M = Pow S1" and N: "sets N = Pow S2"
   shows "sets (M \<Otimes>\<^sub>M N) = Pow (S1 \<times> S2)"
 proof auto
   fix x a b assume x: "x \<in> sets (M \<Otimes>\<^sub>M N)" "(a, b) \<in> x"
   from sets.sets_into_space[OF x(1)] x(2)
     sets_eq_imp_space_eq[of N "count_space S2"] sets_eq_imp_space_eq[of M "count_space S1"] M N
   show "a \<in> S1" "b \<in> S2"
     by (auto simp: space_pair_measure)
 next
   fix X assume X: "X \<subseteq> S1 \<times> S2"
   then have "countable X"
     by (metis countable_subset \<open>countable S1\<close> \<open>countable S2\<close> countable_SIGMA)
   have "X = (\<Union>(a, b)\<in>X. {a} \<times> {b})" by auto
   also have "\<dots> \<in> sets (M \<Otimes>\<^sub>M N)"
     using X
     by (safe intro!: sets.countable_UN' \<open>countable X\<close> subsetI pair_measureI) (auto simp: M N)
   finally show "X \<in> sets (M \<Otimes>\<^sub>M N)" .
 qed
 
 lemma pair_measure_countable:
   assumes "countable S1" "countable S2"
   shows "count_space S1 \<Otimes>\<^sub>M count_space S2 = count_space (S1 \<times> S2)"
 proof (rule pair_measure_eqI)
   show "sigma_finite_measure (count_space S1)" "sigma_finite_measure (count_space S2)"
     using assms by (auto intro!: sigma_finite_measure_count_space_countable)
   show "sets (count_space S1 \<Otimes>\<^sub>M count_space S2) = sets (count_space (S1 \<times> S2))"
     by (subst sets_pair_countable[OF assms]) auto
 next
   fix A B assume "A \<in> sets (count_space S1)" "B \<in> sets (count_space S2)"
   then show "emeasure (count_space S1) A * emeasure (count_space S2) B =
     emeasure (count_space (S1 \<times> S2)) (A \<times> B)"
     by (subst (1 2 3) emeasure_count_space) (auto simp: finite_cartesian_product_iff ennreal_mult_top ennreal_top_mult)
 qed
 
 proposition nn_integral_fst_count_space:
   "(\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. f (x, y) \<partial>count_space UNIV \<partial>count_space UNIV) = integral\<^sup>N (count_space UNIV) f"
   (is "?lhs = ?rhs")
 proof(cases)
   assume *: "countable {xy. f xy \<noteq> 0}"
   let ?A = "fst ` {xy. f xy \<noteq> 0}"
   let ?B = "snd ` {xy. f xy \<noteq> 0}"
   from * have [simp]: "countable ?A" "countable ?B" by(rule countable_image)+
   have "?lhs = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. f (x, y) \<partial>count_space UNIV \<partial>count_space ?A)"
     by(rule nn_integral_count_space_eq)
       (auto simp add: nn_integral_0_iff_AE AE_count_space not_le intro: rev_image_eqI)
   also have "\<dots> = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. f (x, y) \<partial>count_space ?B \<partial>count_space ?A)"
     by(intro nn_integral_count_space_eq nn_integral_cong)(auto intro: rev_image_eqI)
   also have "\<dots> = (\<integral>\<^sup>+ xy. f xy \<partial>count_space (?A \<times> ?B))"
     by(subst sigma_finite_measure.nn_integral_fst)
       (simp_all add: sigma_finite_measure_count_space_countable pair_measure_countable)
   also have "\<dots> = ?rhs"
     by(rule nn_integral_count_space_eq)(auto intro: rev_image_eqI)
   finally show ?thesis .
 next
   { fix xy assume "f xy \<noteq> 0"
     then have "(\<exists>r\<ge>0. 0 < r \<and> f xy = ennreal r) \<or> f xy = \<infinity>"
       by (cases "f xy" rule: ennreal_cases) (auto simp: less_le)
     then have "\<exists>n. ennreal (1 / real (Suc n)) \<le> f xy"
       by (auto elim!: nat_approx_posE intro!: less_imp_le) }
   note * = this
 
   assume cntbl: "uncountable {xy. f xy \<noteq> 0}"
   also have "{xy. f xy \<noteq> 0} = (\<Union>n. {xy. 1/Suc n \<le> f xy})"
     using * by auto
   finally obtain n where "infinite {xy. 1/Suc n \<le> f xy}"
     by (meson countableI_type countable_UN uncountable_infinite)
   then obtain C where C: "C \<subseteq> {xy. 1/Suc n \<le> f xy}" and "countable C" "infinite C"
     by (metis infinite_countable_subset')
 
   have "\<infinity> = (\<integral>\<^sup>+ xy. ennreal (1 / Suc n) * indicator C xy \<partial>count_space UNIV)"
     using \<open>infinite C\<close> by(simp add: nn_integral_cmult ennreal_mult_top)
   also have "\<dots> \<le> ?rhs" using C
     by(intro nn_integral_mono)(auto split: split_indicator)
   finally have "?rhs = \<infinity>" by (simp add: top_unique)
   moreover have "?lhs = \<infinity>"
   proof(cases "finite (fst ` C)")
     case True
     then obtain x C' where x: "x \<in> fst ` C"
       and C': "C' = fst -` {x} \<inter> C"
       and "infinite C'"
       using \<open>infinite C\<close> by(auto elim!: inf_img_fin_domE')
     from x C C' have **: "C' \<subseteq> {xy. 1 / Suc n \<le> f xy}" by auto
 
     from C' \<open>infinite C'\<close> have "infinite (snd ` C')"
       by(auto dest!: finite_imageD simp add: inj_on_def)
     then have "\<infinity> = (\<integral>\<^sup>+ y. ennreal (1 / Suc n) * indicator (snd ` C') y \<partial>count_space UNIV)"
       by(simp add: nn_integral_cmult ennreal_mult_top)
     also have "\<dots> = (\<integral>\<^sup>+ y. ennreal (1 / Suc n) * indicator C' (x, y) \<partial>count_space UNIV)"
       by(rule nn_integral_cong)(force split: split_indicator intro: rev_image_eqI simp add: C')
     also have "\<dots> = (\<integral>\<^sup>+ x'. (\<integral>\<^sup>+ y. ennreal (1 / Suc n) * indicator C' (x, y) \<partial>count_space UNIV) * indicator {x} x' \<partial>count_space UNIV)"
       by(simp add: one_ereal_def[symmetric])
     also have "\<dots> \<le> (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. ennreal (1 / Suc n) * indicator C' (x, y) \<partial>count_space UNIV \<partial>count_space UNIV)"
       by(rule nn_integral_mono)(simp split: split_indicator)
     also have "\<dots> \<le> ?lhs" using **
       by(intro nn_integral_mono)(auto split: split_indicator)
     finally show ?thesis by (simp add: top_unique)
   next
     case False
     define C' where "C' = fst ` C"
     have "\<infinity> = \<integral>\<^sup>+ x. ennreal (1 / Suc n) * indicator C' x \<partial>count_space UNIV"
       using C'_def False by(simp add: nn_integral_cmult ennreal_mult_top)
     also have "\<dots> = \<integral>\<^sup>+ x. \<integral>\<^sup>+ y. ennreal (1 / Suc n) * indicator C' x * indicator {SOME y. (x, y) \<in> C} y \<partial>count_space UNIV \<partial>count_space UNIV"
       by(auto simp add: one_ereal_def[symmetric] max_def intro: nn_integral_cong)
     also have "\<dots> \<le> \<integral>\<^sup>+ x. \<integral>\<^sup>+ y. ennreal (1 / Suc n) * indicator C (x, y) \<partial>count_space UNIV \<partial>count_space UNIV"
       by(intro nn_integral_mono)(auto simp add: C'_def split: split_indicator intro: someI)
     also have "\<dots> \<le> ?lhs" using C
       by(intro nn_integral_mono)(auto split: split_indicator)
     finally show ?thesis by (simp add: top_unique)
   qed
   ultimately show ?thesis by simp
 qed
 
 proposition nn_integral_snd_count_space:
   "(\<integral>\<^sup>+ y. \<integral>\<^sup>+ x. f (x, y) \<partial>count_space UNIV \<partial>count_space UNIV) = integral\<^sup>N (count_space UNIV) f"
   (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<integral>\<^sup>+ y. \<integral>\<^sup>+ x. (\<lambda>(y, x). f (x, y)) (y, x) \<partial>count_space UNIV \<partial>count_space UNIV)"
     by(simp)
   also have "\<dots> = \<integral>\<^sup>+ yx. (\<lambda>(y, x). f (x, y)) yx \<partial>count_space UNIV"
     by(rule nn_integral_fst_count_space)
   also have "\<dots> = \<integral>\<^sup>+ xy. f xy \<partial>count_space ((\<lambda>(x, y). (y, x)) ` UNIV)"
     by(subst nn_integral_bij_count_space[OF inj_on_imp_bij_betw, symmetric])
       (simp_all add: inj_on_def split_def)
   also have "\<dots> = ?rhs" by(rule nn_integral_count_space_eq) auto
   finally show ?thesis .
 qed
 
 lemma measurable_pair_measure_countable1:
   assumes "countable A"
   and [measurable]: "\<And>x. x \<in> A \<Longrightarrow> (\<lambda>y. f (x, y)) \<in> measurable N K"
   shows "f \<in> measurable (count_space A \<Otimes>\<^sub>M N) K"
 using _ _ assms(1)
 by(rule measurable_compose_countable'[where f="\<lambda>a b. f (a, snd b)" and g=fst and I=A, simplified])simp_all
 
 subsection \<open>Product of Borel spaces\<close>
 
 theorem borel_Times:
   fixes A :: "'a::topological_space set" and B :: "'b::topological_space set"
   assumes A: "A \<in> sets borel" and B: "B \<in> sets borel"
   shows "A \<times> B \<in> sets borel"
 proof -
   have "A \<times> B = (A\<times>UNIV) \<inter> (UNIV \<times> B)"
     by auto
   moreover
   { have "A \<in> sigma_sets UNIV {S. open S}" using A by (simp add: sets_borel)
     then have "A\<times>UNIV \<in> sets borel"
     proof (induct A)
       case (Basic S) then show ?case
         by (auto intro!: borel_open open_Times)
     next
       case (Compl A)
       moreover have *: "(UNIV - A) \<times> UNIV = UNIV - (A \<times> UNIV)"
         by auto
       ultimately show ?case
         unfolding * by auto
     next
       case (Union A)
       moreover have *: "(\<Union>(A ` UNIV)) \<times> UNIV = \<Union>((\<lambda>i. A i \<times> UNIV) ` UNIV)"
         by auto
       ultimately show ?case
         unfolding * by auto
     qed simp }
   moreover
   { have "B \<in> sigma_sets UNIV {S. open S}" using B by (simp add: sets_borel)
     then have "UNIV\<times>B \<in> sets borel"
     proof (induct B)
       case (Basic S) then show ?case
         by (auto intro!: borel_open open_Times)
     next
       case (Compl B)
       moreover have *: "UNIV \<times> (UNIV - B) = UNIV - (UNIV \<times> B)"
         by auto
       ultimately show ?case
         unfolding * by auto
     next
       case (Union B)
       moreover have *: "UNIV \<times> (\<Union>(B ` UNIV)) = \<Union>((\<lambda>i. UNIV \<times> B i) ` UNIV)"
         by auto
       ultimately show ?case
         unfolding * by auto
     qed simp }
   ultimately show ?thesis
     by auto
 qed
 
 lemma finite_measure_pair_measure:
   assumes "finite_measure M" "finite_measure N"
   shows "finite_measure (N  \<Otimes>\<^sub>M M)"
 proof (rule finite_measureI)
   interpret M: finite_measure M by fact
   interpret N: finite_measure N by fact
   show "emeasure (N  \<Otimes>\<^sub>M M) (space (N  \<Otimes>\<^sub>M M)) \<noteq> \<infinity>"
     by (auto simp: space_pair_measure M.emeasure_pair_measure_Times ennreal_mult_eq_top_iff)
 qed
 
 end
diff --git a/src/HOL/Analysis/Bochner_Integration.thy b/src/HOL/Analysis/Bochner_Integration.thy
--- a/src/HOL/Analysis/Bochner_Integration.thy
+++ b/src/HOL/Analysis/Bochner_Integration.thy
@@ -1,3428 +1,3432 @@
 (*  Title:      HOL/Analysis/Bochner_Integration.thy
     Author:     Johannes Hölzl, TU München
 *)
 
 section \<open>Bochner Integration for Vector-Valued Functions\<close>
 
 theory Bochner_Integration
   imports Finite_Product_Measure
 begin
 
 text \<open>
 
 In the following development of the Bochner integral we use second countable topologies instead
 of separable spaces. A second countable topology is also separable.
 
 \<close>
 
 proposition borel_measurable_implies_sequence_metric:
   fixes f :: "'a \<Rightarrow> 'b :: {metric_space, second_countable_topology}"
   assumes [measurable]: "f \<in> borel_measurable M"
   shows "\<exists>F. (\<forall>i. simple_function M (F i)) \<and> (\<forall>x\<in>space M. (\<lambda>i. F i x) \<longlonglongrightarrow> f x) \<and>
     (\<forall>i. \<forall>x\<in>space M. dist (F i x) z \<le> 2 * dist (f x) z)"
 proof -
   obtain D :: "'b set" where "countable D" and D: "\<And>X. open X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>d\<in>D. d \<in> X"
     by (erule countable_dense_setE)
 
   define e where "e = from_nat_into D"
   { fix n x
     obtain d where "d \<in> D" and d: "d \<in> ball x (1 / Suc n)"
       using D[of "ball x (1 / Suc n)"] by auto
     from \<open>d \<in> D\<close> D[of UNIV] \<open>countable D\<close> obtain i where "d = e i"
       unfolding e_def by (auto dest: from_nat_into_surj)
     with d have "\<exists>i. dist x (e i) < 1 / Suc n"
       by auto }
   note e = this
 
   define A where [abs_def]: "A m n =
     {x\<in>space M. dist (f x) (e n) < 1 / (Suc m) \<and> 1 / (Suc m) \<le> dist (f x) z}" for m n
   define B where [abs_def]: "B m = disjointed (A m)" for m
 
   define m where [abs_def]: "m N x = Max {m. m \<le> N \<and> x \<in> (\<Union>n\<le>N. B m n)}" for N x
   define F where [abs_def]: "F N x =
     (if (\<exists>m\<le>N. x \<in> (\<Union>n\<le>N. B m n)) \<and> (\<exists>n\<le>N. x \<in> B (m N x) n)
      then e (LEAST n. x \<in> B (m N x) n) else z)" for N x
 
   have B_imp_A[intro, simp]: "\<And>x m n. x \<in> B m n \<Longrightarrow> x \<in> A m n"
     using disjointed_subset[of "A m" for m] unfolding B_def by auto
 
   { fix m
     have "\<And>n. A m n \<in> sets M"
       by (auto simp: A_def)
     then have "\<And>n. B m n \<in> sets M"
       using sets.range_disjointed_sets[of "A m" M] by (auto simp: B_def) }
   note this[measurable]
 
   { fix N i x assume "\<exists>m\<le>N. x \<in> (\<Union>n\<le>N. B m n)"
     then have "m N x \<in> {m::nat. m \<le> N \<and> x \<in> (\<Union>n\<le>N. B m n)}"
       unfolding m_def by (intro Max_in) auto
     then have "m N x \<le> N" "\<exists>n\<le>N. x \<in> B (m N x) n"
       by auto }
   note m = this
 
   { fix j N i x assume "j \<le> N" "i \<le> N" "x \<in> B j i"
     then have "j \<le> m N x"
       unfolding m_def by (intro Max_ge) auto }
   note m_upper = this
 
   show ?thesis
     unfolding simple_function_def
   proof (safe intro!: exI[of _ F])
     have [measurable]: "\<And>i. F i \<in> borel_measurable M"
       unfolding F_def m_def by measurable
     show "\<And>x i. F i -` {x} \<inter> space M \<in> sets M"
       by measurable
 
     { fix i
       { fix n x assume "x \<in> B (m i x) n"
         then have "(LEAST n. x \<in> B (m i x) n) \<le> n"
           by (intro Least_le)
         also assume "n \<le> i"
         finally have "(LEAST n. x \<in> B (m i x) n) \<le> i" . }
       then have "F i ` space M \<subseteq> {z} \<union> e ` {.. i}"
         by (auto simp: F_def)
       then show "finite (F i ` space M)"
         by (rule finite_subset) auto }
 
     { fix N i n x assume "i \<le> N" "n \<le> N" "x \<in> B i n"
       then have 1: "\<exists>m\<le>N. x \<in> (\<Union>n\<le>N. B m n)" by auto
       from m[OF this] obtain n where n: "m N x \<le> N" "n \<le> N" "x \<in> B (m N x) n" by auto
       moreover
       define L where "L = (LEAST n. x \<in> B (m N x) n)"
       have "dist (f x) (e L) < 1 / Suc (m N x)"
       proof -
         have "x \<in> B (m N x) L"
           using n(3) unfolding L_def by (rule LeastI)
         then have "x \<in> A (m N x) L"
           by auto
         then show ?thesis
           unfolding A_def by simp
       qed
       ultimately have "dist (f x) (F N x) < 1 / Suc (m N x)"
         by (auto simp add: F_def L_def) }
     note * = this
 
     fix x assume "x \<in> space M"
     show "(\<lambda>i. F i x) \<longlonglongrightarrow> f x"
     proof cases
       assume "f x = z"
       then have "\<And>i n. x \<notin> A i n"
         unfolding A_def by auto
       then have "\<And>i. F i x = z"
         by (auto simp: F_def)
       then show ?thesis
         using \<open>f x = z\<close> by auto
     next
       assume "f x \<noteq> z"
 
       show ?thesis
       proof (rule tendstoI)
         fix e :: real assume "0 < e"
         with \<open>f x \<noteq> z\<close> obtain n where "1 / Suc n < e" "1 / Suc n < dist (f x) z"
           by (metis dist_nz order_less_trans neq_iff nat_approx_posE)
         with \<open>x\<in>space M\<close> \<open>f x \<noteq> z\<close> have "x \<in> (\<Union>i. B n i)"
           unfolding A_def B_def UN_disjointed_eq using e by auto
         then obtain i where i: "x \<in> B n i" by auto
 
         show "eventually (\<lambda>i. dist (F i x) (f x) < e) sequentially"
           using eventually_ge_at_top[of "max n i"]
         proof eventually_elim
           fix j assume j: "max n i \<le> j"
           with i have "dist (f x) (F j x) < 1 / Suc (m j x)"
             by (intro *[OF _ _ i]) auto
           also have "\<dots> \<le> 1 / Suc n"
             using j m_upper[OF _ _ i]
             by (auto simp: field_simps)
           also note \<open>1 / Suc n < e\<close>
           finally show "dist (F j x) (f x) < e"
             by (simp add: less_imp_le dist_commute)
         qed
       qed
     qed
     fix i
     { fix n m assume "x \<in> A n m"
       then have "dist (e m) (f x) + dist (f x) z \<le> 2 * dist (f x) z"
         unfolding A_def by (auto simp: dist_commute)
       also have "dist (e m) z \<le> dist (e m) (f x) + dist (f x) z"
         by (rule dist_triangle)
       finally (xtrans) have "dist (e m) z \<le> 2 * dist (f x) z" . }
     then show "dist (F i x) z \<le> 2 * dist (f x) z"
       unfolding F_def
       apply auto
       apply (rule LeastI2)
       apply auto
       done
   qed
 qed
 
 lemma
   fixes f :: "'a \<Rightarrow> 'b::semiring_1" assumes "finite A"
   shows sum_mult_indicator[simp]: "(\<Sum>x \<in> A. f x * indicator (B x) (g x)) = (\<Sum>x\<in>{x\<in>A. g x \<in> B x}. f x)"
   and sum_indicator_mult[simp]: "(\<Sum>x \<in> A. indicator (B x) (g x) * f x) = (\<Sum>x\<in>{x\<in>A. g x \<in> B x}. f x)"
   unfolding indicator_def
   using assms by (auto intro!: sum.mono_neutral_cong_right split: if_split_asm)
 
 lemma borel_measurable_induct_real[consumes 2, case_names set mult add seq]:
   fixes P :: "('a \<Rightarrow> real) \<Rightarrow> bool"
   assumes u: "u \<in> borel_measurable M" "\<And>x. 0 \<le> u x"
   assumes set: "\<And>A. A \<in> sets M \<Longrightarrow> P (indicator A)"
   assumes mult: "\<And>u c. 0 \<le> c \<Longrightarrow> u \<in> borel_measurable M \<Longrightarrow> (\<And>x. 0 \<le> u x) \<Longrightarrow> P u \<Longrightarrow> P (\<lambda>x. c * u x)"
   assumes add: "\<And>u v. u \<in> borel_measurable M \<Longrightarrow> (\<And>x. 0 \<le> u x) \<Longrightarrow> P u \<Longrightarrow> v \<in> borel_measurable M \<Longrightarrow> (\<And>x. 0 \<le> v x) \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> u x = 0 \<or> v x = 0) \<Longrightarrow> P v \<Longrightarrow> P (\<lambda>x. v x + u x)"
   assumes seq: "\<And>U. (\<And>i. U i \<in> borel_measurable M) \<Longrightarrow> (\<And>i x. 0 \<le> U i x) \<Longrightarrow> (\<And>i. P (U i)) \<Longrightarrow> incseq U \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. U i x) \<longlonglongrightarrow> u x) \<Longrightarrow> P u"
   shows "P u"
 proof -
   have "(\<lambda>x. ennreal (u x)) \<in> borel_measurable M" using u by auto
   from borel_measurable_implies_simple_function_sequence'[OF this]
   obtain U where U: "\<And>i. simple_function M (U i)" "incseq U" "\<And>i x. U i x < top" and
     sup: "\<And>x. (SUP i. U i x) = ennreal (u x)"
     by blast
 
   define U' where [abs_def]: "U' i x = indicator (space M) x * enn2real (U i x)" for i x
   then have U'_sf[measurable]: "\<And>i. simple_function M (U' i)"
     using U by (auto intro!: simple_function_compose1[where g=enn2real])
 
   show "P u"
   proof (rule seq)
     show U': "U' i \<in> borel_measurable M" "\<And>x. 0 \<le> U' i x" for i
       using U by (auto
           intro: borel_measurable_simple_function
           intro!: borel_measurable_enn2real borel_measurable_times
           simp: U'_def zero_le_mult_iff)
     show "incseq U'"
       using U(2,3)
       by (auto simp: incseq_def le_fun_def image_iff eq_commute U'_def indicator_def enn2real_mono)
 
     fix x assume x: "x \<in> space M"
     have "(\<lambda>i. U i x) \<longlonglongrightarrow> (SUP i. U i x)"
       using U(2) by (intro LIMSEQ_SUP) (auto simp: incseq_def le_fun_def)
     moreover have "(\<lambda>i. U i x) = (\<lambda>i. ennreal (U' i x))"
       using x U(3) by (auto simp: fun_eq_iff U'_def image_iff eq_commute)
     moreover have "(SUP i. U i x) = ennreal (u x)"
       using sup u(2) by (simp add: max_def)
     ultimately show "(\<lambda>i. U' i x) \<longlonglongrightarrow> u x"
       using u U' by simp
   next
     fix i
     have "U' i ` space M \<subseteq> enn2real ` (U i ` space M)" "finite (U i ` space M)"
       unfolding U'_def using U(1) by (auto dest: simple_functionD)
     then have fin: "finite (U' i ` space M)"
       by (metis finite_subset finite_imageI)
     moreover have "\<And>z. {y. U' i z = y \<and> y \<in> U' i ` space M \<and> z \<in> space M} = (if z \<in> space M then {U' i z} else {})"
       by auto
     ultimately have U': "(\<lambda>z. \<Sum>y\<in>U' i`space M. y * indicator {x\<in>space M. U' i x = y} z) = U' i"
       by (simp add: U'_def fun_eq_iff)
     have "\<And>x. x \<in> U' i ` space M \<Longrightarrow> 0 \<le> x"
       by (auto simp: U'_def)
     with fin have "P (\<lambda>z. \<Sum>y\<in>U' i`space M. y * indicator {x\<in>space M. U' i x = y} z)"
     proof induct
       case empty from set[of "{}"] show ?case
         by (simp add: indicator_def[abs_def])
     next
       case (insert x F)
       from insert.prems have nonneg: "x \<ge> 0" "\<And>y. y \<in> F \<Longrightarrow> y \<ge> 0"
         by simp_all
       hence *: "P (\<lambda>xa. x * indicat_real {x' \<in> space M. U' i x' = x} xa)"
         by (intro mult set) auto
       have "P (\<lambda>z. x * indicat_real {x' \<in> space M. U' i x' = x} z + 
                    (\<Sum>y\<in>F. y * indicat_real {x \<in> space M. U' i x = y} z))"
         using insert(1-3)
         by (intro add * sum_nonneg mult_nonneg_nonneg)
            (auto simp: nonneg indicator_def of_bool_def sum_nonneg_eq_0_iff)
       thus ?case 
         using insert.hyps by (subst sum.insert) auto
     qed
     with U' show "P (U' i)" by simp
   qed
 qed
 
 lemma scaleR_cong_right:
   fixes x :: "'a :: real_vector"
   shows "(x \<noteq> 0 \<Longrightarrow> r = p) \<Longrightarrow> r *\<^sub>R x = p *\<^sub>R x"
   by (cases "x = 0") auto
 
 inductive simple_bochner_integrable :: "'a measure \<Rightarrow> ('a \<Rightarrow> 'b::real_vector) \<Rightarrow> bool" for M f where
   "simple_function M f \<Longrightarrow> emeasure M {y\<in>space M. f y \<noteq> 0} \<noteq> \<infinity> \<Longrightarrow>
     simple_bochner_integrable M f"
 
 lemma simple_bochner_integrable_compose2:
   assumes p_0: "p 0 0 = 0"
   shows "simple_bochner_integrable M f \<Longrightarrow> simple_bochner_integrable M g \<Longrightarrow>
     simple_bochner_integrable M (\<lambda>x. p (f x) (g x))"
 proof (safe intro!: simple_bochner_integrable.intros elim!: simple_bochner_integrable.cases del: notI)
   assume sf: "simple_function M f" "simple_function M g"
   then show "simple_function M (\<lambda>x. p (f x) (g x))"
     by (rule simple_function_compose2)
 
   from sf have [measurable]:
       "f \<in> measurable M (count_space UNIV)"
       "g \<in> measurable M (count_space UNIV)"
     by (auto intro: measurable_simple_function)
 
   assume fin: "emeasure M {y \<in> space M. f y \<noteq> 0} \<noteq> \<infinity>" "emeasure M {y \<in> space M. g y \<noteq> 0} \<noteq> \<infinity>"
 
   have "emeasure M {x\<in>space M. p (f x) (g x) \<noteq> 0} \<le>
       emeasure M ({x\<in>space M. f x \<noteq> 0} \<union> {x\<in>space M. g x \<noteq> 0})"
     by (intro emeasure_mono) (auto simp: p_0)
   also have "\<dots> \<le> emeasure M {x\<in>space M. f x \<noteq> 0} + emeasure M {x\<in>space M. g x \<noteq> 0}"
     by (intro emeasure_subadditive) auto
   finally show "emeasure M {y \<in> space M. p (f y) (g y) \<noteq> 0} \<noteq> \<infinity>"
     using fin by (auto simp: top_unique)
 qed
 
 lemma simple_function_finite_support:
   assumes f: "simple_function M f" and fin: "(\<integral>\<^sup>+x. f x \<partial>M) < \<infinity>" and nn: "\<And>x. 0 \<le> f x"
   shows "emeasure M {x\<in>space M. f x \<noteq> 0} \<noteq> \<infinity>"
 proof cases
   from f have meas[measurable]: "f \<in> borel_measurable M"
     by (rule borel_measurable_simple_function)
 
   assume non_empty: "\<exists>x\<in>space M. f x \<noteq> 0"
 
   define m where "m = Min (f`space M - {0})"
   have "m \<in> f`space M - {0}"
     unfolding m_def using f non_empty by (intro Min_in) (auto simp: simple_function_def)
   then have m: "0 < m"
     using nn by (auto simp: less_le)
 
   from m have "m * emeasure M {x\<in>space M. 0 \<noteq> f x} =
     (\<integral>\<^sup>+x. m * indicator {x\<in>space M. 0 \<noteq> f x} x \<partial>M)"
     using f by (intro nn_integral_cmult_indicator[symmetric]) auto
   also have "\<dots> \<le> (\<integral>\<^sup>+x. f x \<partial>M)"
     using AE_space
   proof (intro nn_integral_mono_AE, eventually_elim)
     fix x assume "x \<in> space M"
     with nn show "m * indicator {x \<in> space M. 0 \<noteq> f x} x \<le> f x"
       using f by (auto split: split_indicator simp: simple_function_def m_def)
   qed
   also note \<open>\<dots> < \<infinity>\<close>
   finally show ?thesis
     using m by (auto simp: ennreal_mult_less_top)
 next
   assume "\<not> (\<exists>x\<in>space M. f x \<noteq> 0)"
   with nn have *: "{x\<in>space M. f x \<noteq> 0} = {}"
     by auto
   show ?thesis unfolding * by simp
 qed
 
 lemma simple_bochner_integrableI_bounded:
   assumes f: "simple_function M f" and fin: "(\<integral>\<^sup>+x. norm (f x) \<partial>M) < \<infinity>"
   shows "simple_bochner_integrable M f"
 proof
   have "emeasure M {y \<in> space M. ennreal (norm (f y)) \<noteq> 0} \<noteq> \<infinity>"
   proof (rule simple_function_finite_support)
     show "simple_function M (\<lambda>x. ennreal (norm (f x)))"
       using f by (rule simple_function_compose1)
     show "(\<integral>\<^sup>+ y. ennreal (norm (f y)) \<partial>M) < \<infinity>" by fact
   qed simp
   then show "emeasure M {y \<in> space M. f y \<noteq> 0} \<noteq> \<infinity>" by simp
 qed fact
 
 definition\<^marker>\<open>tag important\<close> simple_bochner_integral :: "'a measure \<Rightarrow> ('a \<Rightarrow> 'b::real_vector) \<Rightarrow> 'b" where
   "simple_bochner_integral M f = (\<Sum>y\<in>f`space M. measure M {x\<in>space M. f x = y} *\<^sub>R y)"
 
 proposition simple_bochner_integral_partition:
   assumes f: "simple_bochner_integrable M f" and g: "simple_function M g"
   assumes sub: "\<And>x y. x \<in> space M \<Longrightarrow> y \<in> space M \<Longrightarrow> g x = g y \<Longrightarrow> f x = f y"
   assumes v: "\<And>x. x \<in> space M \<Longrightarrow> f x = v (g x)"
   shows "simple_bochner_integral M f = (\<Sum>y\<in>g ` space M. measure M {x\<in>space M. g x = y} *\<^sub>R v y)"
     (is "_ = ?r")
 proof -
   from f g have [simp]: "finite (f`space M)" "finite (g`space M)"
     by (auto simp: simple_function_def elim: simple_bochner_integrable.cases)
 
   from f have [measurable]: "f \<in> measurable M (count_space UNIV)"
     by (auto intro: measurable_simple_function elim: simple_bochner_integrable.cases)
 
   from g have [measurable]: "g \<in> measurable M (count_space UNIV)"
     by (auto intro: measurable_simple_function elim: simple_bochner_integrable.cases)
 
   { fix y assume "y \<in> space M"
     then have "f ` space M \<inter> {i. \<exists>x\<in>space M. i = f x \<and> g y = g x} = {v (g y)}"
       by (auto cong: sub simp: v[symmetric]) }
   note eq = this
 
   have "simple_bochner_integral M f =
     (\<Sum>y\<in>f`space M. (\<Sum>z\<in>g`space M.
       if \<exists>x\<in>space M. y = f x \<and> z = g x then measure M {x\<in>space M. g x = z} else 0) *\<^sub>R y)"
     unfolding simple_bochner_integral_def
   proof (safe intro!: sum.cong scaleR_cong_right)
     fix y assume y: "y \<in> space M" "f y \<noteq> 0"
     have [simp]: "g ` space M \<inter> {z. \<exists>x\<in>space M. f y = f x \<and> z = g x} =
         {z. \<exists>x\<in>space M. f y = f x \<and> z = g x}"
       by auto
     have eq:"{x \<in> space M. f x = f y} =
         (\<Union>i\<in>{z. \<exists>x\<in>space M. f y = f x \<and> z = g x}. {x \<in> space M. g x = i})"
       by (auto simp: eq_commute cong: sub rev_conj_cong)
     have "finite (g`space M)" by simp
     then have "finite {z. \<exists>x\<in>space M. f y = f x \<and> z = g x}"
       by (rule rev_finite_subset) auto
     moreover
     { fix x assume "x \<in> space M" "f x = f y"
       then have "x \<in> space M" "f x \<noteq> 0"
         using y by auto
       then have "emeasure M {y \<in> space M. g y = g x} \<le> emeasure M {y \<in> space M. f y \<noteq> 0}"
         by (auto intro!: emeasure_mono cong: sub)
       then have "emeasure M {xa \<in> space M. g xa = g x} < \<infinity>"
         using f by (auto simp: simple_bochner_integrable.simps less_top) }
     ultimately
     show "measure M {x \<in> space M. f x = f y} =
       (\<Sum>z\<in>g ` space M. if \<exists>x\<in>space M. f y = f x \<and> z = g x then measure M {x \<in> space M. g x = z} else 0)"
       apply (simp add: sum.If_cases eq)
       apply (subst measure_finite_Union[symmetric])
       apply (auto simp: disjoint_family_on_def less_top)
       done
   qed
   also have "\<dots> = (\<Sum>y\<in>f`space M. (\<Sum>z\<in>g`space M.
       if \<exists>x\<in>space M. y = f x \<and> z = g x then measure M {x\<in>space M. g x = z} *\<^sub>R y else 0))"
     by (auto intro!: sum.cong simp: scaleR_sum_left)
   also have "\<dots> = ?r"
     by (subst sum.swap)
        (auto intro!: sum.cong simp: sum.If_cases scaleR_sum_right[symmetric] eq)
   finally show "simple_bochner_integral M f = ?r" .
 qed
 
 lemma simple_bochner_integral_add:
   assumes f: "simple_bochner_integrable M f" and g: "simple_bochner_integrable M g"
   shows "simple_bochner_integral M (\<lambda>x. f x + g x) =
     simple_bochner_integral M f + simple_bochner_integral M g"
 proof -
   from f g have "simple_bochner_integral M (\<lambda>x. f x + g x) =
     (\<Sum>y\<in>(\<lambda>x. (f x, g x)) ` space M. measure M {x \<in> space M. (f x, g x) = y} *\<^sub>R (fst y + snd y))"
     by (intro simple_bochner_integral_partition)
        (auto simp: simple_bochner_integrable_compose2 elim: simple_bochner_integrable.cases)
   moreover from f g have "simple_bochner_integral M f =
     (\<Sum>y\<in>(\<lambda>x. (f x, g x)) ` space M. measure M {x \<in> space M. (f x, g x) = y} *\<^sub>R fst y)"
     by (intro simple_bochner_integral_partition)
        (auto simp: simple_bochner_integrable_compose2 elim: simple_bochner_integrable.cases)
   moreover from f g have "simple_bochner_integral M g =
     (\<Sum>y\<in>(\<lambda>x. (f x, g x)) ` space M. measure M {x \<in> space M. (f x, g x) = y} *\<^sub>R snd y)"
     by (intro simple_bochner_integral_partition)
        (auto simp: simple_bochner_integrable_compose2 elim: simple_bochner_integrable.cases)
   ultimately show ?thesis
     by (simp add: sum.distrib[symmetric] scaleR_add_right)
 qed
 
 lemma simple_bochner_integral_linear:
   assumes "linear f"
   assumes g: "simple_bochner_integrable M g"
   shows "simple_bochner_integral M (\<lambda>x. f (g x)) = f (simple_bochner_integral M g)"
 proof -
   interpret linear f by fact
   from g have "simple_bochner_integral M (\<lambda>x. f (g x)) =
     (\<Sum>y\<in>g ` space M. measure M {x \<in> space M. g x = y} *\<^sub>R f y)"
     by (intro simple_bochner_integral_partition)
        (auto simp: simple_bochner_integrable_compose2[where p="\<lambda>x y. f x"]
              elim: simple_bochner_integrable.cases)
   also have "\<dots> = f (simple_bochner_integral M g)"
     by (simp add: simple_bochner_integral_def sum scale)
   finally show ?thesis .
 qed
 
 lemma simple_bochner_integral_minus:
   assumes f: "simple_bochner_integrable M f"
   shows "simple_bochner_integral M (\<lambda>x. - f x) = - simple_bochner_integral M f"
 proof -
   from linear_uminus f show ?thesis
     by (rule simple_bochner_integral_linear)
 qed
 
 lemma simple_bochner_integral_diff:
   assumes f: "simple_bochner_integrable M f" and g: "simple_bochner_integrable M g"
   shows "simple_bochner_integral M (\<lambda>x. f x - g x) =
     simple_bochner_integral M f - simple_bochner_integral M g"
   unfolding diff_conv_add_uminus using f g
   by (subst simple_bochner_integral_add)
      (auto simp: simple_bochner_integral_minus simple_bochner_integrable_compose2[where p="\<lambda>x y. - y"])
 
 lemma simple_bochner_integral_norm_bound:
   assumes f: "simple_bochner_integrable M f"
   shows "norm (simple_bochner_integral M f) \<le> simple_bochner_integral M (\<lambda>x. norm (f x))"
 proof -
   have "norm (simple_bochner_integral M f) \<le>
     (\<Sum>y\<in>f ` space M. norm (measure M {x \<in> space M. f x = y} *\<^sub>R y))"
     unfolding simple_bochner_integral_def by (rule norm_sum)
   also have "\<dots> = (\<Sum>y\<in>f ` space M. measure M {x \<in> space M. f x = y} *\<^sub>R norm y)"
     by simp
   also have "\<dots> = simple_bochner_integral M (\<lambda>x. norm (f x))"
     using f
     by (intro simple_bochner_integral_partition[symmetric])
        (auto intro: f simple_bochner_integrable_compose2 elim: simple_bochner_integrable.cases)
   finally show ?thesis .
 qed
 
 lemma simple_bochner_integral_nonneg[simp]:
   fixes f :: "'a \<Rightarrow> real"
   shows "(\<And>x. 0 \<le> f x) \<Longrightarrow> 0 \<le> simple_bochner_integral M f"
   by (force simp add: simple_bochner_integral_def intro: sum_nonneg)
 
 lemma simple_bochner_integral_eq_nn_integral:
   assumes f: "simple_bochner_integrable M f" "\<And>x. 0 \<le> f x"
   shows "simple_bochner_integral M f = (\<integral>\<^sup>+x. f x \<partial>M)"
 proof -
   { fix x y z have "(x \<noteq> 0 \<Longrightarrow> y = z) \<Longrightarrow> ennreal x * y = ennreal x * z"
       by (cases "x = 0") (auto simp: zero_ennreal_def[symmetric]) }
   note ennreal_cong_mult = this
 
   have [measurable]: "f \<in> borel_measurable M"
     using f(1) by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
 
   { fix y assume y: "y \<in> space M" "f y \<noteq> 0"
     have "ennreal (measure M {x \<in> space M. f x = f y}) = emeasure M {x \<in> space M. f x = f y}"
     proof (rule emeasure_eq_ennreal_measure[symmetric])
       have "emeasure M {x \<in> space M. f x = f y} \<le> emeasure M {x \<in> space M. f x \<noteq> 0}"
         using y by (intro emeasure_mono) auto
       with f show "emeasure M {x \<in> space M. f x = f y} \<noteq> top"
         by (auto simp: simple_bochner_integrable.simps top_unique)
     qed
     moreover have "{x \<in> space M. f x = f y} = (\<lambda>x. ennreal (f x)) -` {ennreal (f y)} \<inter> space M"
       using f by auto
     ultimately have "ennreal (measure M {x \<in> space M. f x = f y}) =
           emeasure M ((\<lambda>x. ennreal (f x)) -` {ennreal (f y)} \<inter> space M)" by simp }
   with f have "simple_bochner_integral M f = (\<integral>\<^sup>Sx. f x \<partial>M)"
     unfolding simple_integral_def
     by (subst simple_bochner_integral_partition[OF f(1), where g="\<lambda>x. ennreal (f x)" and v=enn2real])
        (auto intro: f simple_function_compose1 elim: simple_bochner_integrable.cases
              intro!: sum.cong ennreal_cong_mult
              simp: ac_simps ennreal_mult
              simp flip: sum_ennreal)
   also have "\<dots> = (\<integral>\<^sup>+x. f x \<partial>M)"
     using f
     by (intro nn_integral_eq_simple_integral[symmetric])
        (auto simp: simple_function_compose1 simple_bochner_integrable.simps)
   finally show ?thesis .
 qed
 
 lemma simple_bochner_integral_bounded:
   fixes f :: "'a \<Rightarrow> 'b::{real_normed_vector, second_countable_topology}"
   assumes f[measurable]: "f \<in> borel_measurable M"
   assumes s: "simple_bochner_integrable M s" and t: "simple_bochner_integrable M t"
   shows "ennreal (norm (simple_bochner_integral M s - simple_bochner_integral M t)) \<le>
     (\<integral>\<^sup>+ x. norm (f x - s x) \<partial>M) + (\<integral>\<^sup>+ x. norm (f x - t x) \<partial>M)"
     (is "ennreal (norm (?s - ?t)) \<le> ?S + ?T")
 proof -
   have [measurable]: "s \<in> borel_measurable M" "t \<in> borel_measurable M"
     using s t by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
 
   have "ennreal (norm (?s - ?t)) = norm (simple_bochner_integral M (\<lambda>x. s x - t x))"
     using s t by (subst simple_bochner_integral_diff) auto
   also have "\<dots> \<le> simple_bochner_integral M (\<lambda>x. norm (s x - t x))"
     using simple_bochner_integrable_compose2[of "(-)" M "s" "t"] s t
     by (auto intro!: simple_bochner_integral_norm_bound)
   also have "\<dots> = (\<integral>\<^sup>+x. norm (s x - t x) \<partial>M)"
     using simple_bochner_integrable_compose2[of "\<lambda>x y. norm (x - y)" M "s" "t"] s t
     by (auto intro!: simple_bochner_integral_eq_nn_integral)
   also have "\<dots> \<le> (\<integral>\<^sup>+x. ennreal (norm (f x - s x)) + ennreal (norm (f x - t x)) \<partial>M)"
     by (auto intro!: nn_integral_mono simp flip: ennreal_plus)
        (metis (erased, opaque_lifting) add_diff_cancel_left add_diff_eq diff_add_eq order_trans
               norm_minus_commute norm_triangle_ineq4 order_refl)
   also have "\<dots> = ?S + ?T"
    by (rule nn_integral_add) auto
   finally show ?thesis .
 qed
 
 inductive has_bochner_integral :: "'a measure \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b::{real_normed_vector, second_countable_topology} \<Rightarrow> bool"
   for M f x where
   "f \<in> borel_measurable M \<Longrightarrow>
     (\<And>i. simple_bochner_integrable M (s i)) \<Longrightarrow>
     (\<lambda>i. \<integral>\<^sup>+x. norm (f x - s i x) \<partial>M) \<longlonglongrightarrow> 0 \<Longrightarrow>
     (\<lambda>i. simple_bochner_integral M (s i)) \<longlonglongrightarrow> x \<Longrightarrow>
     has_bochner_integral M f x"
 
 lemma has_bochner_integral_cong:
   assumes "M = N" "\<And>x. x \<in> space N \<Longrightarrow> f x = g x" "x = y"
   shows "has_bochner_integral M f x \<longleftrightarrow> has_bochner_integral N g y"
   unfolding has_bochner_integral.simps assms(1,3)
   using assms(2) by (simp cong: measurable_cong_simp nn_integral_cong_simp)
 
 lemma has_bochner_integral_cong_AE:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (AE x in M. f x = g x) \<Longrightarrow>
     has_bochner_integral M f x \<longleftrightarrow> has_bochner_integral M g x"
   unfolding has_bochner_integral.simps
   by (intro arg_cong[where f=Ex] ext conj_cong rev_conj_cong refl arg_cong[where f="\<lambda>x. x \<longlonglongrightarrow> 0"]
             nn_integral_cong_AE)
      auto
 
 lemma borel_measurable_has_bochner_integral:
   "has_bochner_integral M f x \<Longrightarrow> f \<in> borel_measurable M"
   by (rule has_bochner_integral.cases)
 
 lemma borel_measurable_has_bochner_integral'[measurable_dest]:
   "has_bochner_integral M f x \<Longrightarrow> g \<in> measurable N M \<Longrightarrow> (\<lambda>x. f (g x)) \<in> borel_measurable N"
   using borel_measurable_has_bochner_integral[measurable] by measurable
 
 lemma has_bochner_integral_simple_bochner_integrable:
   "simple_bochner_integrable M f \<Longrightarrow> has_bochner_integral M f (simple_bochner_integral M f)"
   by (rule has_bochner_integral.intros[where s="\<lambda>_. f"])
      (auto intro: borel_measurable_simple_function
            elim: simple_bochner_integrable.cases
            simp: zero_ennreal_def[symmetric])
 
 lemma has_bochner_integral_real_indicator:
   assumes [measurable]: "A \<in> sets M" and A: "emeasure M A < \<infinity>"
   shows "has_bochner_integral M (indicator A) (measure M A)"
 proof -
   have sbi: "simple_bochner_integrable M (indicator A::'a \<Rightarrow> real)"
   proof
     have "{y \<in> space M. (indicator A y::real) \<noteq> 0} = A"
       using sets.sets_into_space[OF \<open>A\<in>sets M\<close>] by (auto split: split_indicator)
     then show "emeasure M {y \<in> space M. (indicator A y::real) \<noteq> 0} \<noteq> \<infinity>"
       using A by auto
   qed (rule simple_function_indicator assms)+
   moreover have "simple_bochner_integral M (indicator A) = measure M A"
     using simple_bochner_integral_eq_nn_integral[OF sbi] A
     by (simp add: ennreal_indicator emeasure_eq_ennreal_measure)
   ultimately show ?thesis
     by (metis has_bochner_integral_simple_bochner_integrable)
 qed
 
 lemma has_bochner_integral_add[intro]:
   "has_bochner_integral M f x \<Longrightarrow> has_bochner_integral M g y \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. f x + g x) (x + y)"
 proof (safe intro!: has_bochner_integral.intros elim!: has_bochner_integral.cases)
   fix sf sg
   assume f_sf: "(\<lambda>i. \<integral>\<^sup>+ x. norm (f x - sf i x) \<partial>M) \<longlonglongrightarrow> 0"
   assume g_sg: "(\<lambda>i. \<integral>\<^sup>+ x. norm (g x - sg i x) \<partial>M) \<longlonglongrightarrow> 0"
 
   assume sf: "\<forall>i. simple_bochner_integrable M (sf i)"
     and sg: "\<forall>i. simple_bochner_integrable M (sg i)"
   then have [measurable]: "\<And>i. sf i \<in> borel_measurable M" "\<And>i. sg i \<in> borel_measurable M"
     by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
   assume [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
 
   show "\<And>i. simple_bochner_integrable M (\<lambda>x. sf i x + sg i x)"
     using sf sg by (simp add: simple_bochner_integrable_compose2)
 
   show "(\<lambda>i. \<integral>\<^sup>+ x. (norm (f x + g x - (sf i x + sg i x))) \<partial>M) \<longlonglongrightarrow> 0"
     (is "?f \<longlonglongrightarrow> 0")
   proof (rule tendsto_sandwich)
     show "eventually (\<lambda>n. 0 \<le> ?f n) sequentially" "(\<lambda>_. 0) \<longlonglongrightarrow> 0"
       by auto
     show "eventually (\<lambda>i. ?f i \<le> (\<integral>\<^sup>+ x. (norm (f x - sf i x)) \<partial>M) + \<integral>\<^sup>+ x. (norm (g x - sg i x)) \<partial>M) sequentially"
       (is "eventually (\<lambda>i. ?f i \<le> ?g i) sequentially")
     proof (intro always_eventually allI)
       fix i have "?f i \<le> (\<integral>\<^sup>+ x. (norm (f x - sf i x)) + ennreal (norm (g x - sg i x)) \<partial>M)"
         by (auto intro!: nn_integral_mono norm_diff_triangle_ineq
                  simp flip: ennreal_plus)
       also have "\<dots> = ?g i"
         by (intro nn_integral_add) auto
       finally show "?f i \<le> ?g i" .
     qed
     show "?g \<longlonglongrightarrow> 0"
       using tendsto_add[OF f_sf g_sg] by simp
   qed
 qed (auto simp: simple_bochner_integral_add tendsto_add)
 
 lemma has_bochner_integral_bounded_linear:
   assumes "bounded_linear T"
   shows "has_bochner_integral M f x \<Longrightarrow> has_bochner_integral M (\<lambda>x. T (f x)) (T x)"
 proof (safe intro!: has_bochner_integral.intros elim!: has_bochner_integral.cases)
   interpret T: bounded_linear T by fact
   have [measurable]: "T \<in> borel_measurable borel"
     by (intro borel_measurable_continuous_onI T.continuous_on continuous_on_id)
   assume [measurable]: "f \<in> borel_measurable M"
   then show "(\<lambda>x. T (f x)) \<in> borel_measurable M"
     by auto
 
   fix s assume f_s: "(\<lambda>i. \<integral>\<^sup>+ x. norm (f x - s i x) \<partial>M) \<longlonglongrightarrow> 0"
   assume s: "\<forall>i. simple_bochner_integrable M (s i)"
   then show "\<And>i. simple_bochner_integrable M (\<lambda>x. T (s i x))"
     by (auto intro: simple_bochner_integrable_compose2 T.zero)
 
   have [measurable]: "\<And>i. s i \<in> borel_measurable M"
     using s by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
 
   obtain K where K: "K > 0" "\<And>x i. norm (T (f x) - T (s i x)) \<le> norm (f x - s i x) * K"
     using T.pos_bounded by (auto simp: T.diff[symmetric])
 
   show "(\<lambda>i. \<integral>\<^sup>+ x. norm (T (f x) - T (s i x)) \<partial>M) \<longlonglongrightarrow> 0"
     (is "?f \<longlonglongrightarrow> 0")
   proof (rule tendsto_sandwich)
     show "eventually (\<lambda>n. 0 \<le> ?f n) sequentially" "(\<lambda>_. 0) \<longlonglongrightarrow> 0"
       by auto
 
     show "eventually (\<lambda>i. ?f i \<le> K * (\<integral>\<^sup>+ x. norm (f x - s i x) \<partial>M)) sequentially"
       (is "eventually (\<lambda>i. ?f i \<le> ?g i) sequentially")
     proof (intro always_eventually allI)
       fix i have "?f i \<le> (\<integral>\<^sup>+ x. ennreal K * norm (f x - s i x) \<partial>M)"
         using K by (intro nn_integral_mono) (auto simp: ac_simps ennreal_mult[symmetric])
       also have "\<dots> = ?g i"
         using K by (intro nn_integral_cmult) auto
       finally show "?f i \<le> ?g i" .
     qed
     show "?g \<longlonglongrightarrow> 0"
       using ennreal_tendsto_cmult[OF _ f_s] by simp
   qed
 
   assume "(\<lambda>i. simple_bochner_integral M (s i)) \<longlonglongrightarrow> x"
   with s show "(\<lambda>i. simple_bochner_integral M (\<lambda>x. T (s i x))) \<longlonglongrightarrow> T x"
     by (auto intro!: T.tendsto simp: simple_bochner_integral_linear T.linear_axioms)
 qed
 
 lemma has_bochner_integral_zero[intro]: "has_bochner_integral M (\<lambda>x. 0) 0"
   by (auto intro!: has_bochner_integral.intros[where s="\<lambda>_ _. 0"]
            simp: zero_ennreal_def[symmetric] simple_bochner_integrable.simps
                  simple_bochner_integral_def image_constant_conv)
 
 lemma has_bochner_integral_scaleR_left[intro]:
   "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. f x *\<^sub>R c) (x *\<^sub>R c)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_scaleR_left])
 
 lemma has_bochner_integral_scaleR_right[intro]:
   "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. c *\<^sub>R f x) (c *\<^sub>R x)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_scaleR_right])
 
 lemma has_bochner_integral_mult_left[intro]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. f x * c) (x * c)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_mult_left])
 
 lemma has_bochner_integral_mult_right[intro]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. c * f x) (c * x)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_mult_right])
 
 lemmas has_bochner_integral_divide =
   has_bochner_integral_bounded_linear[OF bounded_linear_divide]
 
 lemma has_bochner_integral_divide_zero[intro]:
   fixes c :: "_::{real_normed_field, field, second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. f x / c) (x / c)"
   using has_bochner_integral_divide by (cases "c = 0") auto
 
 lemma has_bochner_integral_inner_left[intro]:
   "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. f x \<bullet> c) (x \<bullet> c)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_inner_left])
 
 lemma has_bochner_integral_inner_right[intro]:
   "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. c \<bullet> f x) (c \<bullet> x)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_inner_right])
 
 lemmas has_bochner_integral_minus =
   has_bochner_integral_bounded_linear[OF bounded_linear_minus[OF bounded_linear_ident]]
 lemmas has_bochner_integral_Re =
   has_bochner_integral_bounded_linear[OF bounded_linear_Re]
 lemmas has_bochner_integral_Im =
   has_bochner_integral_bounded_linear[OF bounded_linear_Im]
 lemmas has_bochner_integral_cnj =
   has_bochner_integral_bounded_linear[OF bounded_linear_cnj]
 lemmas has_bochner_integral_of_real =
   has_bochner_integral_bounded_linear[OF bounded_linear_of_real]
 lemmas has_bochner_integral_fst =
   has_bochner_integral_bounded_linear[OF bounded_linear_fst]
 lemmas has_bochner_integral_snd =
   has_bochner_integral_bounded_linear[OF bounded_linear_snd]
 
 lemma has_bochner_integral_indicator:
   "A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. indicator A x *\<^sub>R c) (measure M A *\<^sub>R c)"
   by (intro has_bochner_integral_scaleR_left has_bochner_integral_real_indicator)
 
 lemma has_bochner_integral_diff:
   "has_bochner_integral M f x \<Longrightarrow> has_bochner_integral M g y \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. f x - g x) (x - y)"
   unfolding diff_conv_add_uminus
   by (intro has_bochner_integral_add has_bochner_integral_minus)
 
 lemma has_bochner_integral_sum:
   "(\<And>i. i \<in> I \<Longrightarrow> has_bochner_integral M (f i) (x i)) \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. \<Sum>i\<in>I. f i x) (\<Sum>i\<in>I. x i)"
   by (induct I rule: infinite_finite_induct) auto
 
 proposition has_bochner_integral_implies_finite_norm:
   "has_bochner_integral M f x \<Longrightarrow> (\<integral>\<^sup>+x. norm (f x) \<partial>M) < \<infinity>"
 proof (elim has_bochner_integral.cases)
   fix s v
   assume [measurable]: "f \<in> borel_measurable M" and s: "\<And>i. simple_bochner_integrable M (s i)" and
     lim_0: "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) \<longlonglongrightarrow> 0"
   from order_tendstoD[OF lim_0, of "\<infinity>"]
   obtain i where f_s_fin: "(\<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) < \<infinity>"
     by (auto simp: eventually_sequentially)
 
   have [measurable]: "\<And>i. s i \<in> borel_measurable M"
     using s by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
 
   define m where "m = (if space M = {} then 0 else Max ((\<lambda>x. norm (s i x))`space M))"
   have "finite (s i ` space M)"
     using s by (auto simp: simple_function_def simple_bochner_integrable.simps)
   then have "finite (norm ` s i ` space M)"
     by (rule finite_imageI)
   then have "\<And>x. x \<in> space M \<Longrightarrow> norm (s i x) \<le> m" "0 \<le> m"
     by (auto simp: m_def image_comp comp_def Max_ge_iff)
   then have "(\<integral>\<^sup>+x. norm (s i x) \<partial>M) \<le> (\<integral>\<^sup>+x. ennreal m * indicator {x\<in>space M. s i x \<noteq> 0} x \<partial>M)"
     by (auto split: split_indicator intro!: Max_ge nn_integral_mono simp:)
   also have "\<dots> < \<infinity>"
     using s by (subst nn_integral_cmult_indicator) (auto simp: \<open>0 \<le> m\<close> simple_bochner_integrable.simps ennreal_mult_less_top less_top)
   finally have s_fin: "(\<integral>\<^sup>+x. norm (s i x) \<partial>M) < \<infinity>" .
 
   have "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) + ennreal (norm (s i x)) \<partial>M)"
     by (auto intro!: nn_integral_mono simp flip: ennreal_plus)
        (metis add.commute norm_triangle_sub)
   also have "\<dots> = (\<integral>\<^sup>+x. norm (f x - s i x) \<partial>M) + (\<integral>\<^sup>+x. norm (s i x) \<partial>M)"
     by (rule nn_integral_add) auto
   also have "\<dots> < \<infinity>"
     using s_fin f_s_fin by auto
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>" .
 qed
 
 proposition has_bochner_integral_norm_bound:
   assumes i: "has_bochner_integral M f x"
   shows "norm x \<le> (\<integral>\<^sup>+x. norm (f x) \<partial>M)"
 using assms proof
   fix s assume
     x: "(\<lambda>i. simple_bochner_integral M (s i)) \<longlonglongrightarrow> x" (is "?s \<longlonglongrightarrow> x") and
     s[simp]: "\<And>i. simple_bochner_integrable M (s i)" and
     lim: "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) \<longlonglongrightarrow> 0" and
     f[measurable]: "f \<in> borel_measurable M"
 
   have [measurable]: "\<And>i. s i \<in> borel_measurable M"
     using s by (auto simp: simple_bochner_integrable.simps intro: borel_measurable_simple_function)
 
   show "norm x \<le> (\<integral>\<^sup>+x. norm (f x) \<partial>M)"
   proof (rule LIMSEQ_le)
     show "(\<lambda>i. ennreal (norm (?s i))) \<longlonglongrightarrow> norm x"
       using x by (auto simp: tendsto_ennreal_iff intro: tendsto_intros)
     show "\<exists>N. \<forall>n\<ge>N. norm (?s n) \<le> (\<integral>\<^sup>+x. norm (f x - s n x) \<partial>M) + (\<integral>\<^sup>+x. norm (f x) \<partial>M)"
       (is "\<exists>N. \<forall>n\<ge>N. _ \<le> ?t n")
     proof (intro exI allI impI)
       fix n
       have "ennreal (norm (?s n)) \<le> simple_bochner_integral M (\<lambda>x. norm (s n x))"
         by (auto intro!: simple_bochner_integral_norm_bound)
       also have "\<dots> = (\<integral>\<^sup>+x. norm (s n x) \<partial>M)"
         by (intro simple_bochner_integral_eq_nn_integral)
            (auto intro: s simple_bochner_integrable_compose2)
       also have "\<dots> \<le> (\<integral>\<^sup>+x. ennreal (norm (f x - s n x)) + norm (f x) \<partial>M)"
         by (auto intro!: nn_integral_mono simp flip: ennreal_plus)
            (metis add.commute norm_minus_commute norm_triangle_sub)
       also have "\<dots> = ?t n"
         by (rule nn_integral_add) auto
       finally show "norm (?s n) \<le> ?t n" .
     qed
     have "?t \<longlonglongrightarrow> 0 + (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M)"
       using has_bochner_integral_implies_finite_norm[OF i]
       by (intro tendsto_add tendsto_const lim)
     then show "?t \<longlonglongrightarrow> \<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M"
       by simp
   qed
 qed
 
 lemma has_bochner_integral_eq:
   "has_bochner_integral M f x \<Longrightarrow> has_bochner_integral M f y \<Longrightarrow> x = y"
 proof (elim has_bochner_integral.cases)
   assume f[measurable]: "f \<in> borel_measurable M"
 
   fix s t
   assume "(\<lambda>i. \<integral>\<^sup>+ x. norm (f x - s i x) \<partial>M) \<longlonglongrightarrow> 0" (is "?S \<longlonglongrightarrow> 0")
   assume "(\<lambda>i. \<integral>\<^sup>+ x. norm (f x - t i x) \<partial>M) \<longlonglongrightarrow> 0" (is "?T \<longlonglongrightarrow> 0")
   assume s: "\<And>i. simple_bochner_integrable M (s i)"
   assume t: "\<And>i. simple_bochner_integrable M (t i)"
 
   have [measurable]: "\<And>i. s i \<in> borel_measurable M" "\<And>i. t i \<in> borel_measurable M"
     using s t by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
 
   let ?s = "\<lambda>i. simple_bochner_integral M (s i)"
   let ?t = "\<lambda>i. simple_bochner_integral M (t i)"
   assume "?s \<longlonglongrightarrow> x" "?t \<longlonglongrightarrow> y"
   then have "(\<lambda>i. norm (?s i - ?t i)) \<longlonglongrightarrow> norm (x - y)"
     by (intro tendsto_intros)
   moreover
   have "(\<lambda>i. ennreal (norm (?s i - ?t i))) \<longlonglongrightarrow> ennreal 0"
   proof (rule tendsto_sandwich)
     show "eventually (\<lambda>i. 0 \<le> ennreal (norm (?s i - ?t i))) sequentially" "(\<lambda>_. 0) \<longlonglongrightarrow> ennreal 0"
       by auto
 
     show "eventually (\<lambda>i. norm (?s i - ?t i) \<le> ?S i + ?T i) sequentially"
       by (intro always_eventually allI simple_bochner_integral_bounded s t f)
     show "(\<lambda>i. ?S i + ?T i) \<longlonglongrightarrow> ennreal 0"
       using tendsto_add[OF \<open>?S \<longlonglongrightarrow> 0\<close> \<open>?T \<longlonglongrightarrow> 0\<close>] by simp
   qed
   then have "(\<lambda>i. norm (?s i - ?t i)) \<longlonglongrightarrow> 0"
     by (simp flip: ennreal_0)
   ultimately have "norm (x - y) = 0"
     by (rule LIMSEQ_unique)
   then show "x = y" by simp
 qed
 
 lemma has_bochner_integralI_AE:
   assumes f: "has_bochner_integral M f x"
     and g: "g \<in> borel_measurable M"
     and ae: "AE x in M. f x = g x"
   shows "has_bochner_integral M g x"
   using f
 proof (safe intro!: has_bochner_integral.intros elim!: has_bochner_integral.cases)
   fix s assume "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) \<longlonglongrightarrow> 0"
   also have "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) = (\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (g x - s i x)) \<partial>M)"
     using ae
     by (intro ext nn_integral_cong_AE, eventually_elim) simp
   finally show "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (g x - s i x)) \<partial>M) \<longlonglongrightarrow> 0" .
 qed (auto intro: g)
 
 lemma has_bochner_integral_eq_AE:
   assumes f: "has_bochner_integral M f x"
     and g: "has_bochner_integral M g y"
     and ae: "AE x in M. f x = g x"
   shows "x = y"
 proof -
   from assms have "has_bochner_integral M g x"
     by (auto intro: has_bochner_integralI_AE)
   from this g show "x = y"
     by (rule has_bochner_integral_eq)
 qed
 
 lemma simple_bochner_integrable_restrict_space:
   fixes f :: "_ \<Rightarrow> 'b::real_normed_vector"
   assumes \<Omega>: "\<Omega> \<inter> space M \<in> sets M"
   shows "simple_bochner_integrable (restrict_space M \<Omega>) f \<longleftrightarrow>
     simple_bochner_integrable M (\<lambda>x. indicator \<Omega> x *\<^sub>R f x)"
   by (simp add: simple_bochner_integrable.simps space_restrict_space
     simple_function_restrict_space[OF \<Omega>] emeasure_restrict_space[OF \<Omega>] Collect_restrict
     indicator_eq_0_iff conj_left_commute)
 
 lemma simple_bochner_integral_restrict_space:
   fixes f :: "_ \<Rightarrow> 'b::real_normed_vector"
   assumes \<Omega>: "\<Omega> \<inter> space M \<in> sets M"
   assumes f: "simple_bochner_integrable (restrict_space M \<Omega>) f"
   shows "simple_bochner_integral (restrict_space M \<Omega>) f =
     simple_bochner_integral M (\<lambda>x. indicator \<Omega> x *\<^sub>R f x)"
 proof -
   have "finite ((\<lambda>x. indicator \<Omega> x *\<^sub>R f x)`space M)"
     using f simple_bochner_integrable_restrict_space[OF \<Omega>, of f]
     by (simp add: simple_bochner_integrable.simps simple_function_def)
   then show ?thesis
     by (auto simp: space_restrict_space measure_restrict_space[OF \<Omega>(1)] le_infI2
                    simple_bochner_integral_def Collect_restrict
              split: split_indicator split_indicator_asm
              intro!: sum.mono_neutral_cong_left arg_cong2[where f=measure])
 qed
 
 context
   notes [[inductive_internals]]
 begin
 
 inductive integrable for M f where
   "has_bochner_integral M f x \<Longrightarrow> integrable M f"
 
 end
 
 definition\<^marker>\<open>tag important\<close> lebesgue_integral ("integral\<^sup>L") where
   "integral\<^sup>L M f = (if \<exists>x. has_bochner_integral M f x then THE x. has_bochner_integral M f x else 0)"
 
 syntax
   "_lebesgue_integral" :: "pttrn \<Rightarrow> real \<Rightarrow> 'a measure \<Rightarrow> real" ("\<integral>((2 _./ _)/ \<partial>_)" [60,61] 110)
 
 translations
   "\<integral> x. f \<partial>M" == "CONST lebesgue_integral M (\<lambda>x. f)"
 
 syntax
   "_ascii_lebesgue_integral" :: "pttrn \<Rightarrow> 'a measure \<Rightarrow> real \<Rightarrow> real" ("(3LINT (1_)/|(_)./ _)" [0,110,60] 60)
 
 translations
   "LINT x|M. f" == "CONST lebesgue_integral M (\<lambda>x. f)"
 
 lemma has_bochner_integral_integral_eq: "has_bochner_integral M f x \<Longrightarrow> integral\<^sup>L M f = x"
   by (metis the_equality has_bochner_integral_eq lebesgue_integral_def)
 
 lemma has_bochner_integral_integrable:
   "integrable M f \<Longrightarrow> has_bochner_integral M f (integral\<^sup>L M f)"
   by (auto simp: has_bochner_integral_integral_eq integrable.simps)
 
 lemma has_bochner_integral_iff:
   "has_bochner_integral M f x \<longleftrightarrow> integrable M f \<and> integral\<^sup>L M f = x"
   by (metis has_bochner_integral_integrable has_bochner_integral_integral_eq integrable.intros)
 
 lemma simple_bochner_integrable_eq_integral:
   "simple_bochner_integrable M f \<Longrightarrow> simple_bochner_integral M f = integral\<^sup>L M f"
   using has_bochner_integral_simple_bochner_integrable[of M f]
   by (simp add: has_bochner_integral_integral_eq)
 
 lemma not_integrable_integral_eq: "\<not> integrable M f \<Longrightarrow> integral\<^sup>L M f = 0"
   unfolding integrable.simps lebesgue_integral_def by (auto intro!: arg_cong[where f=The])
 
 lemma integral_eq_cases:
   "integrable M f \<longleftrightarrow> integrable N g \<Longrightarrow>
     (integrable M f \<Longrightarrow> integrable N g \<Longrightarrow> integral\<^sup>L M f = integral\<^sup>L N g) \<Longrightarrow>
     integral\<^sup>L M f = integral\<^sup>L N g"
   by (metis not_integrable_integral_eq)
 
 lemma borel_measurable_integrable[measurable_dest]: "integrable M f \<Longrightarrow> f \<in> borel_measurable M"
   by (auto elim: integrable.cases has_bochner_integral.cases)
 
 lemma borel_measurable_integrable'[measurable_dest]:
   "integrable M f \<Longrightarrow> g \<in> measurable N M \<Longrightarrow> (\<lambda>x. f (g x)) \<in> borel_measurable N"
   using borel_measurable_integrable[measurable] by measurable
 
 lemma integrable_cong:
   "M = N \<Longrightarrow> (\<And>x. x \<in> space N \<Longrightarrow> f x = g x) \<Longrightarrow> integrable M f \<longleftrightarrow> integrable N g"
   by (simp cong: has_bochner_integral_cong add: integrable.simps)
 
 lemma integrable_cong_AE:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> AE x in M. f x = g x \<Longrightarrow>
     integrable M f \<longleftrightarrow> integrable M g"
   unfolding integrable.simps
   by (intro has_bochner_integral_cong_AE arg_cong[where f=Ex] ext)
 
 lemma integrable_cong_AE_imp:
   "integrable M g \<Longrightarrow> f \<in> borel_measurable M \<Longrightarrow> (AE x in M. g x = f x) \<Longrightarrow> integrable M f"
   using integrable_cong_AE[of f M g] by (auto simp: eq_commute)
 
 lemma integral_cong:
   "M = N \<Longrightarrow> (\<And>x. x \<in> space N \<Longrightarrow> f x = g x) \<Longrightarrow> integral\<^sup>L M f = integral\<^sup>L N g"
   by (simp cong: has_bochner_integral_cong cong del: if_weak_cong add: lebesgue_integral_def)
 
 lemma integral_cong_AE:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> AE x in M. f x = g x \<Longrightarrow>
     integral\<^sup>L M f = integral\<^sup>L M g"
   unfolding lebesgue_integral_def
   by (rule arg_cong[where x="has_bochner_integral M f"]) (intro has_bochner_integral_cong_AE ext)
 
 lemma integrable_add[simp, intro]: "integrable M f \<Longrightarrow> integrable M g \<Longrightarrow> integrable M (\<lambda>x. f x + g x)"
   by (auto simp: integrable.simps)
 
 lemma integrable_zero[simp, intro]: "integrable M (\<lambda>x. 0)"
   by (metis has_bochner_integral_zero integrable.simps)
 
 lemma integrable_sum[simp, intro]: "(\<And>i. i \<in> I \<Longrightarrow> integrable M (f i)) \<Longrightarrow> integrable M (\<lambda>x. \<Sum>i\<in>I. f i x)"
   by (metis has_bochner_integral_sum integrable.simps)
 
 lemma integrable_indicator[simp, intro]: "A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow>
   integrable M (\<lambda>x. indicator A x *\<^sub>R c)"
   by (metis has_bochner_integral_indicator integrable.simps)
 
 lemma integrable_real_indicator[simp, intro]: "A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow>
   integrable M (indicator A :: 'a \<Rightarrow> real)"
   by (metis has_bochner_integral_real_indicator integrable.simps)
 
 lemma integrable_diff[simp, intro]: "integrable M f \<Longrightarrow> integrable M g \<Longrightarrow> integrable M (\<lambda>x. f x - g x)"
   by (auto simp: integrable.simps intro: has_bochner_integral_diff)
 
 lemma integrable_bounded_linear: "bounded_linear T \<Longrightarrow> integrable M f \<Longrightarrow> integrable M (\<lambda>x. T (f x))"
   by (auto simp: integrable.simps intro: has_bochner_integral_bounded_linear)
 
 lemma integrable_scaleR_left[simp, intro]: "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. f x *\<^sub>R c)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_scaleR_right[simp, intro]: "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. c *\<^sub>R f x)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_mult_left[simp, intro]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. f x * c)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_mult_right[simp, intro]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. c * f x)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_divide_zero[simp, intro]:
   fixes c :: "_::{real_normed_field, field, second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. f x / c)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_inner_left[simp, intro]:
   "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. f x \<bullet> c)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_inner_right[simp, intro]:
   "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. c \<bullet> f x)"
   unfolding integrable.simps by fastforce
 
 lemmas integrable_minus[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_minus[OF bounded_linear_ident]]
 lemmas integrable_divide[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_divide]
 lemmas integrable_Re[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_Re]
 lemmas integrable_Im[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_Im]
 lemmas integrable_cnj[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_cnj]
 lemmas integrable_of_real[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_of_real]
 lemmas integrable_fst[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_fst]
 lemmas integrable_snd[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_snd]
 
 lemma integral_zero[simp]: "integral\<^sup>L M (\<lambda>x. 0) = 0"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_zero)
 
 lemma integral_add[simp]: "integrable M f \<Longrightarrow> integrable M g \<Longrightarrow>
     integral\<^sup>L M (\<lambda>x. f x + g x) = integral\<^sup>L M f + integral\<^sup>L M g"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_add has_bochner_integral_integrable)
 
 lemma integral_diff[simp]: "integrable M f \<Longrightarrow> integrable M g \<Longrightarrow>
     integral\<^sup>L M (\<lambda>x. f x - g x) = integral\<^sup>L M f - integral\<^sup>L M g"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_diff has_bochner_integral_integrable)
 
 lemma integral_sum: "(\<And>i. i \<in> I \<Longrightarrow> integrable M (f i)) \<Longrightarrow>
   integral\<^sup>L M (\<lambda>x. \<Sum>i\<in>I. f i x) = (\<Sum>i\<in>I. integral\<^sup>L M (f i))"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_sum has_bochner_integral_integrable)
 
 lemma integral_sum'[simp]: "(\<And>i. i \<in> I =simp=> integrable M (f i)) \<Longrightarrow>
   integral\<^sup>L M (\<lambda>x. \<Sum>i\<in>I. f i x) = (\<Sum>i\<in>I. integral\<^sup>L M (f i))"
   unfolding simp_implies_def by (rule integral_sum)
 
 lemma integral_bounded_linear: "bounded_linear T \<Longrightarrow> integrable M f \<Longrightarrow>
     integral\<^sup>L M (\<lambda>x. T (f x)) = T (integral\<^sup>L M f)"
   by (metis has_bochner_integral_bounded_linear has_bochner_integral_integrable has_bochner_integral_integral_eq)
 
 lemma integral_bounded_linear':
   assumes T: "bounded_linear T" and T': "bounded_linear T'"
   assumes *: "\<not> (\<forall>x. T x = 0) \<Longrightarrow> (\<forall>x. T' (T x) = x)"
   shows "integral\<^sup>L M (\<lambda>x. T (f x)) = T (integral\<^sup>L M f)"
 proof cases
   assume "(\<forall>x. T x = 0)" then show ?thesis
     by simp
 next
   assume **: "\<not> (\<forall>x. T x = 0)"
   show ?thesis
   proof cases
     assume "integrable M f" with T show ?thesis
       by (rule integral_bounded_linear)
   next
     assume not: "\<not> integrable M f"
     moreover have "\<not> integrable M (\<lambda>x. T (f x))"
     proof
       assume "integrable M (\<lambda>x. T (f x))"
       from integrable_bounded_linear[OF T' this] not *[OF **]
       show False
         by auto
     qed
     ultimately show ?thesis
       using T by (simp add: not_integrable_integral_eq linear_simps)
   qed
 qed
 
 lemma integral_scaleR_left[simp]: "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> (\<integral> x. f x *\<^sub>R c \<partial>M) = integral\<^sup>L M f *\<^sub>R c"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_integrable has_bochner_integral_scaleR_left)
 
 lemma integral_scaleR_right[simp]: "(\<integral> x. c *\<^sub>R f x \<partial>M) = c *\<^sub>R integral\<^sup>L M f"
   by (rule integral_bounded_linear'[OF bounded_linear_scaleR_right bounded_linear_scaleR_right[of "1 / c"]]) simp
 
 lemma integral_mult_left[simp]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> (\<integral> x. f x * c \<partial>M) = integral\<^sup>L M f * c"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_integrable has_bochner_integral_mult_left)
 
 lemma integral_mult_right[simp]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> (\<integral> x. c * f x \<partial>M) = c * integral\<^sup>L M f"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_integrable has_bochner_integral_mult_right)
 
 lemma integral_mult_left_zero[simp]:
   fixes c :: "_::{real_normed_field,second_countable_topology}"
   shows "(\<integral> x. f x * c \<partial>M) = integral\<^sup>L M f * c"
   by (rule integral_bounded_linear'[OF bounded_linear_mult_left bounded_linear_mult_left[of "1 / c"]]) simp
 
 lemma integral_mult_right_zero[simp]:
   fixes c :: "_::{real_normed_field,second_countable_topology}"
   shows "(\<integral> x. c * f x \<partial>M) = c * integral\<^sup>L M f"
   by (rule integral_bounded_linear'[OF bounded_linear_mult_right bounded_linear_mult_right[of "1 / c"]]) simp
 
 lemma integral_inner_left[simp]: "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> (\<integral> x. f x \<bullet> c \<partial>M) = integral\<^sup>L M f \<bullet> c"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_integrable has_bochner_integral_inner_left)
 
 lemma integral_inner_right[simp]: "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> (\<integral> x. c \<bullet> f x \<partial>M) = c \<bullet> integral\<^sup>L M f"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_integrable has_bochner_integral_inner_right)
 
 lemma integral_divide_zero[simp]:
   fixes c :: "_::{real_normed_field, field, second_countable_topology}"
   shows "integral\<^sup>L M (\<lambda>x. f x / c) = integral\<^sup>L M f / c"
   by (rule integral_bounded_linear'[OF bounded_linear_divide bounded_linear_mult_left[of c]]) simp
 
 lemma integral_minus[simp]: "integral\<^sup>L M (\<lambda>x. - f x) = - integral\<^sup>L M f"
   by (rule integral_bounded_linear'[OF bounded_linear_minus[OF bounded_linear_ident] bounded_linear_minus[OF bounded_linear_ident]]) simp
 
 lemma integral_complex_of_real[simp]: "integral\<^sup>L M (\<lambda>x. complex_of_real (f x)) = of_real (integral\<^sup>L M f)"
   by (rule integral_bounded_linear'[OF bounded_linear_of_real bounded_linear_Re]) simp
 
 lemma integral_cnj[simp]: "integral\<^sup>L M (\<lambda>x. cnj (f x)) = cnj (integral\<^sup>L M f)"
   by (rule integral_bounded_linear'[OF bounded_linear_cnj bounded_linear_cnj]) simp
 
 lemmas integral_divide[simp] =
   integral_bounded_linear[OF bounded_linear_divide]
 lemmas integral_Re[simp] =
   integral_bounded_linear[OF bounded_linear_Re]
 lemmas integral_Im[simp] =
   integral_bounded_linear[OF bounded_linear_Im]
 lemmas integral_of_real[simp] =
   integral_bounded_linear[OF bounded_linear_of_real]
 lemmas integral_fst[simp] =
   integral_bounded_linear[OF bounded_linear_fst]
 lemmas integral_snd[simp] =
   integral_bounded_linear[OF bounded_linear_snd]
 
 lemma integral_norm_bound_ennreal:
   "integrable M f \<Longrightarrow> norm (integral\<^sup>L M f) \<le> (\<integral>\<^sup>+x. norm (f x) \<partial>M)"
   by (metis has_bochner_integral_integrable has_bochner_integral_norm_bound)
 
 lemma integrableI_sequence:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes f[measurable]: "f \<in> borel_measurable M"
   assumes s: "\<And>i. simple_bochner_integrable M (s i)"
   assumes lim: "(\<lambda>i. \<integral>\<^sup>+x. norm (f x - s i x) \<partial>M) \<longlonglongrightarrow> 0" (is "?S \<longlonglongrightarrow> 0")
   shows "integrable M f"
 proof -
   let ?s = "\<lambda>n. simple_bochner_integral M (s n)"
 
   have "\<exists>x. ?s \<longlonglongrightarrow> x"
     unfolding convergent_eq_Cauchy
   proof (rule metric_CauchyI)
     fix e :: real assume "0 < e"
     then have "0 < ennreal (e / 2)" by auto
     from order_tendstoD(2)[OF lim this]
     obtain M where M: "\<And>n. M \<le> n \<Longrightarrow> ?S n < e / 2"
       by (auto simp: eventually_sequentially)
     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (?s m) (?s n) < e"
     proof (intro exI allI impI)
       fix m n assume m: "M \<le> m" and n: "M \<le> n"
       have "?S n \<noteq> \<infinity>"
         using M[OF n] by auto
       have "norm (?s n - ?s m) \<le> ?S n + ?S m"
         by (intro simple_bochner_integral_bounded s f)
       also have "\<dots> < ennreal (e / 2) + e / 2"
         by (intro add_strict_mono M n m)
       also have "\<dots> = e" using \<open>0<e\<close> by (simp flip: ennreal_plus)
       finally show "dist (?s n) (?s m) < e"
         using \<open>0<e\<close> by (simp add: dist_norm ennreal_less_iff)
     qed
   qed
   then obtain x where "?s \<longlonglongrightarrow> x" ..
   show ?thesis
     by (rule, rule) fact+
 qed
 
 proposition nn_integral_dominated_convergence_norm:
   fixes u' :: "_ \<Rightarrow> _::{real_normed_vector, second_countable_topology}"
   assumes [measurable]:
        "\<And>i. u i \<in> borel_measurable M" "u' \<in> borel_measurable M" "w \<in> borel_measurable M"
     and bound: "\<And>j. AE x in M. norm (u j x) \<le> w x"
     and w: "(\<integral>\<^sup>+x. w x \<partial>M) < \<infinity>"
     and u': "AE x in M. (\<lambda>i. u i x) \<longlonglongrightarrow> u' x"
   shows "(\<lambda>i. (\<integral>\<^sup>+x. norm (u' x - u i x) \<partial>M)) \<longlonglongrightarrow> 0"
 proof -
   have "AE x in M. \<forall>j. norm (u j x) \<le> w x"
     unfolding AE_all_countable by rule fact
   with u' have bnd: "AE x in M. \<forall>j. norm (u' x - u j x) \<le> 2 * w x"
   proof (eventually_elim, intro allI)
     fix i x assume "(\<lambda>i. u i x) \<longlonglongrightarrow> u' x" "\<forall>j. norm (u j x) \<le> w x" "\<forall>j. norm (u j x) \<le> w x"
     then have "norm (u' x) \<le> w x" "norm (u i x) \<le> w x"
       by (auto intro: LIMSEQ_le_const2 tendsto_norm)
     then have "norm (u' x) + norm (u i x) \<le> 2 * w x"
       by simp
     also have "norm (u' x - u i x) \<le> norm (u' x) + norm (u i x)"
       by (rule norm_triangle_ineq4)
     finally (xtrans) show "norm (u' x - u i x) \<le> 2 * w x" .
   qed
   have w_nonneg: "AE x in M. 0 \<le> w x"
     using bound[of 0] by (auto intro: order_trans[OF norm_ge_zero])
 
   have "(\<lambda>i. (\<integral>\<^sup>+x. norm (u' x - u i x) \<partial>M)) \<longlonglongrightarrow> (\<integral>\<^sup>+x. 0 \<partial>M)"
   proof (rule nn_integral_dominated_convergence)
     show "(\<integral>\<^sup>+x. 2 * w x \<partial>M) < \<infinity>"
       by (rule nn_integral_mult_bounded_inf[OF _ w, of 2]) (insert w_nonneg, auto simp: ennreal_mult )
     show "AE x in M. (\<lambda>i. ennreal (norm (u' x - u i x))) \<longlonglongrightarrow> 0"
       using u'
     proof eventually_elim
       fix x assume "(\<lambda>i. u i x) \<longlonglongrightarrow> u' x"
       from tendsto_diff[OF tendsto_const[of "u' x"] this]
       show "(\<lambda>i. ennreal (norm (u' x - u i x))) \<longlonglongrightarrow> 0"
         by (simp add: tendsto_norm_zero_iff flip: ennreal_0)
     qed
   qed (insert bnd w_nonneg, auto)
   then show ?thesis by simp
 qed
 
 proposition integrableI_bounded:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes f[measurable]: "f \<in> borel_measurable M" and fin: "(\<integral>\<^sup>+x. norm (f x) \<partial>M) < \<infinity>"
   shows "integrable M f"
 proof -
   from borel_measurable_implies_sequence_metric[OF f, of 0] obtain s where
     s: "\<And>i. simple_function M (s i)" and
     pointwise: "\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. s i x) \<longlonglongrightarrow> f x" and
     bound: "\<And>i x. x \<in> space M \<Longrightarrow> norm (s i x) \<le> 2 * norm (f x)"
     by simp metis
 
   show ?thesis
   proof (rule integrableI_sequence)
     { fix i
       have "(\<integral>\<^sup>+x. norm (s i x) \<partial>M) \<le> (\<integral>\<^sup>+x. ennreal (2 * norm (f x)) \<partial>M)"
         by (intro nn_integral_mono) (simp add: bound)
       also have "\<dots> = 2 * (\<integral>\<^sup>+x. ennreal (norm (f x)) \<partial>M)"
         by (simp add: ennreal_mult nn_integral_cmult)
       also have "\<dots> < top"
         using fin by (simp add: ennreal_mult_less_top)
       finally have "(\<integral>\<^sup>+x. norm (s i x) \<partial>M) < \<infinity>"
         by simp }
     note fin_s = this
 
     show "\<And>i. simple_bochner_integrable M (s i)"
       by (rule simple_bochner_integrableI_bounded) fact+
 
     show "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) \<longlonglongrightarrow> 0"
     proof (rule nn_integral_dominated_convergence_norm)
       show "\<And>j. AE x in M. norm (s j x) \<le> 2 * norm (f x)"
         using bound by auto
       show "\<And>i. s i \<in> borel_measurable M" "(\<lambda>x. 2 * norm (f x)) \<in> borel_measurable M"
         using s by (auto intro: borel_measurable_simple_function)
       show "(\<integral>\<^sup>+ x. ennreal (2 * norm (f x)) \<partial>M) < \<infinity>"
         using fin by (simp add: nn_integral_cmult ennreal_mult ennreal_mult_less_top)
       show "AE x in M. (\<lambda>i. s i x) \<longlonglongrightarrow> f x"
         using pointwise by auto
     qed fact
   qed fact
 qed
 
 lemma integrableI_bounded_set:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "A \<in> sets M" "f \<in> borel_measurable M"
   assumes finite: "emeasure M A < \<infinity>"
     and bnd: "AE x in M. x \<in> A \<longrightarrow> norm (f x) \<le> B"
     and null: "AE x in M. x \<notin> A \<longrightarrow> f x = 0"
   shows "integrable M f"
 proof (rule integrableI_bounded)
   { fix x :: 'b have "norm x \<le> B \<Longrightarrow> 0 \<le> B"
       using norm_ge_zero[of x] by arith }
   with bnd null have "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (max 0 B) * indicator A x \<partial>M)"
     by (intro nn_integral_mono_AE) (auto split: split_indicator split_max)
   also have "\<dots> < \<infinity>"
     using finite by (subst nn_integral_cmult_indicator) (auto simp: ennreal_mult_less_top)
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>" .
 qed simp
 
 lemma integrableI_bounded_set_indicator:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "A \<in> sets M \<Longrightarrow> f \<in> borel_measurable M \<Longrightarrow>
     emeasure M A < \<infinity> \<Longrightarrow> (AE x in M. x \<in> A \<longrightarrow> norm (f x) \<le> B) \<Longrightarrow>
     integrable M (\<lambda>x. indicator A x *\<^sub>R f x)"
   by (rule integrableI_bounded_set[where A=A]) auto
 
 lemma integrableI_nonneg:
   fixes f :: "'a \<Rightarrow> real"
   assumes "f \<in> borel_measurable M" "AE x in M. 0 \<le> f x" "(\<integral>\<^sup>+x. f x \<partial>M) < \<infinity>"
   shows "integrable M f"
 proof -
   have "(\<integral>\<^sup>+x. norm (f x) \<partial>M) = (\<integral>\<^sup>+x. f x \<partial>M)"
     using assms by (intro nn_integral_cong_AE) auto
   then show ?thesis
     using assms by (intro integrableI_bounded) auto
 qed
 
 lemma integrable_iff_bounded:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "integrable M f \<longleftrightarrow> f \<in> borel_measurable M \<and> (\<integral>\<^sup>+x. norm (f x) \<partial>M) < \<infinity>"
   using integrableI_bounded[of f M] has_bochner_integral_implies_finite_norm[of M f]
   unfolding integrable.simps has_bochner_integral.simps[abs_def] by auto
 
 lemma (in finite_measure) square_integrable_imp_integrable:
   fixes f :: "'a \<Rightarrow> 'b :: {second_countable_topology, banach, real_normed_div_algebra}"
   assumes [measurable]: "f \<in> borel_measurable M"
   assumes "integrable M (\<lambda>x. f x ^ 2)"
   shows   "integrable M f"
 proof -
   have less_top: "emeasure M (space M) < top"
     using finite_emeasure_space by (meson top.not_eq_extremum)
   have "nn_integral M (\<lambda>x. norm (f x)) ^ 2 \<le>
         nn_integral M (\<lambda>x. norm (f x) ^ 2) * emeasure M (space M)"
     using Cauchy_Schwarz_nn_integral[of "\<lambda>x. norm (f x)" M "\<lambda>_. 1"]
     by (simp add: ennreal_power)
   also have "\<dots> < \<infinity>"
     using assms(2) less_top
     by (subst (asm) integrable_iff_bounded) (auto simp: norm_power ennreal_mult_less_top)
   finally have "nn_integral M (\<lambda>x. norm (f x)) < \<infinity>"
     by (simp add: power_less_top_ennreal)
   thus ?thesis
     by (simp add: integrable_iff_bounded)
 qed
 
 lemma integrable_bound:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
     and g :: "'a \<Rightarrow> 'c::{banach, second_countable_topology}"
   shows "integrable M f \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (AE x in M. norm (g x) \<le> norm (f x)) \<Longrightarrow>
     integrable M g"
   unfolding integrable_iff_bounded
 proof safe
   assume "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   assume "AE x in M. norm (g x) \<le> norm (f x)"
   then have "(\<integral>\<^sup>+ x. ennreal (norm (g x)) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M)"
     by  (intro nn_integral_mono_AE) auto
   also assume "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>"
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (g x)) \<partial>M) < \<infinity>" .
 qed
 
 lemma integrable_mult_indicator:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "A \<in> sets M \<Longrightarrow> integrable M f \<Longrightarrow> integrable M (\<lambda>x. indicator A x *\<^sub>R f x)"
   by (rule integrable_bound[of M f]) (auto split: split_indicator)
 
 lemma integrable_real_mult_indicator:
   fixes f :: "'a \<Rightarrow> real"
   shows "A \<in> sets M \<Longrightarrow> integrable M f \<Longrightarrow> integrable M (\<lambda>x. f x * indicator A x)"
   using integrable_mult_indicator[of A M f] by (simp add: mult_ac)
 
 lemma integrable_abs[simp, intro]:
   fixes f :: "'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f" shows "integrable M (\<lambda>x. \<bar>f x\<bar>)"
   using assms by (rule integrable_bound) auto
 
 lemma integrable_norm[simp, intro]:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "integrable M f" shows "integrable M (\<lambda>x. norm (f x))"
   using assms by (rule integrable_bound) auto
 
 lemma integrable_norm_cancel:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "integrable M (\<lambda>x. norm (f x))" "f \<in> borel_measurable M" shows "integrable M f"
   using assms by (rule integrable_bound) auto
 
 lemma integrable_norm_iff:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "f \<in> borel_measurable M \<Longrightarrow> integrable M (\<lambda>x. norm (f x)) \<longleftrightarrow> integrable M f"
   by (auto intro: integrable_norm_cancel)
 
 lemma integrable_abs_cancel:
   fixes f :: "'a \<Rightarrow> real"
   assumes [measurable]: "integrable M (\<lambda>x. \<bar>f x\<bar>)" "f \<in> borel_measurable M" shows "integrable M f"
   using assms by (rule integrable_bound) auto
 
 lemma integrable_abs_iff:
   fixes f :: "'a \<Rightarrow> real"
   shows "f \<in> borel_measurable M \<Longrightarrow> integrable M (\<lambda>x. \<bar>f x\<bar>) \<longleftrightarrow> integrable M f"
   by (auto intro: integrable_abs_cancel)
 
 lemma integrable_max[simp, intro]:
   fixes f :: "'a \<Rightarrow> real"
   assumes fg[measurable]: "integrable M f" "integrable M g"
   shows "integrable M (\<lambda>x. max (f x) (g x))"
   using integrable_add[OF integrable_norm[OF fg(1)] integrable_norm[OF fg(2)]]
   by (rule integrable_bound) auto
 
 lemma integrable_min[simp, intro]:
   fixes f :: "'a \<Rightarrow> real"
   assumes fg[measurable]: "integrable M f" "integrable M g"
   shows "integrable M (\<lambda>x. min (f x) (g x))"
   using integrable_add[OF integrable_norm[OF fg(1)] integrable_norm[OF fg(2)]]
   by (rule integrable_bound) auto
 
 lemma integral_minus_iff[simp]:
   "integrable M (\<lambda>x. - f x ::'a::{banach, second_countable_topology}) \<longleftrightarrow> integrable M f"
   unfolding integrable_iff_bounded
   by (auto)
 
 lemma integrable_indicator_iff:
   "integrable M (indicator A::_ \<Rightarrow> real) \<longleftrightarrow> A \<inter> space M \<in> sets M \<and> emeasure M (A \<inter> space M) < \<infinity>"
   by (simp add: integrable_iff_bounded borel_measurable_indicator_iff ennreal_indicator nn_integral_indicator'
            cong: conj_cong)
 
 lemma integral_indicator[simp]: "integral\<^sup>L M (indicator A) = measure M (A \<inter> space M)"
 proof cases
   assume *: "A \<inter> space M \<in> sets M \<and> emeasure M (A \<inter> space M) < \<infinity>"
   have "integral\<^sup>L M (indicator A) = integral\<^sup>L M (indicator (A \<inter> space M))"
     by (intro integral_cong) (auto split: split_indicator)
   also have "\<dots> = measure M (A \<inter> space M)"
     using * by (intro has_bochner_integral_integral_eq has_bochner_integral_real_indicator) auto
   finally show ?thesis .
 next
   assume *: "\<not> (A \<inter> space M \<in> sets M \<and> emeasure M (A \<inter> space M) < \<infinity>)"
   have "integral\<^sup>L M (indicator A) = integral\<^sup>L M (indicator (A \<inter> space M) :: _ \<Rightarrow> real)"
     by (intro integral_cong) (auto split: split_indicator)
   also have "\<dots> = 0"
     using * by (subst not_integrable_integral_eq) (auto simp: integrable_indicator_iff)
   also have "\<dots> = measure M (A \<inter> space M)"
     using * by (auto simp: measure_def emeasure_notin_sets not_less top_unique)
   finally show ?thesis .
 qed
 
 lemma integrable_discrete_difference:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes X: "countable X"
   assumes null: "\<And>x. x \<in> X \<Longrightarrow> emeasure M {x} = 0"
   assumes sets: "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M"
   assumes eq: "\<And>x. x \<in> space M \<Longrightarrow> x \<notin> X \<Longrightarrow> f x = g x"
   shows "integrable M f \<longleftrightarrow> integrable M g"
   unfolding integrable_iff_bounded
 proof (rule conj_cong)
   { assume "f \<in> borel_measurable M" then have "g \<in> borel_measurable M"
       by (rule measurable_discrete_difference[where X=X]) (auto simp: assms) }
   moreover
   { assume "g \<in> borel_measurable M" then have "f \<in> borel_measurable M"
       by (rule measurable_discrete_difference[where X=X]) (auto simp: assms) }
   ultimately show "f \<in> borel_measurable M \<longleftrightarrow> g \<in> borel_measurable M" ..
 next
   have "AE x in M. x \<notin> X"
     by (rule AE_discrete_difference) fact+
   then have "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) = (\<integral>\<^sup>+ x. norm (g x) \<partial>M)"
     by (intro nn_integral_cong_AE) (auto simp: eq)
   then show "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) < \<infinity> \<longleftrightarrow> (\<integral>\<^sup>+ x. norm (g x) \<partial>M) < \<infinity>"
     by simp
 qed
 
 lemma integral_discrete_difference:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes X: "countable X"
   assumes null: "\<And>x. x \<in> X \<Longrightarrow> emeasure M {x} = 0"
   assumes sets: "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M"
   assumes eq: "\<And>x. x \<in> space M \<Longrightarrow> x \<notin> X \<Longrightarrow> f x = g x"
   shows "integral\<^sup>L M f = integral\<^sup>L M g"
 proof (rule integral_eq_cases)
   show eq: "integrable M f \<longleftrightarrow> integrable M g"
     by (rule integrable_discrete_difference[where X=X]) fact+
 
   assume f: "integrable M f"
   show "integral\<^sup>L M f = integral\<^sup>L M g"
   proof (rule integral_cong_AE)
     show "f \<in> borel_measurable M" "g \<in> borel_measurable M"
       using f eq by (auto intro: borel_measurable_integrable)
 
     have "AE x in M. x \<notin> X"
       by (rule AE_discrete_difference) fact+
     with AE_space show "AE x in M. f x = g x"
       by eventually_elim fact
   qed
 qed
 
 lemma has_bochner_integral_discrete_difference:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes X: "countable X"
   assumes null: "\<And>x. x \<in> X \<Longrightarrow> emeasure M {x} = 0"
   assumes sets: "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M"
   assumes eq: "\<And>x. x \<in> space M \<Longrightarrow> x \<notin> X \<Longrightarrow> f x = g x"
   shows "has_bochner_integral M f x \<longleftrightarrow> has_bochner_integral M g x"
   using integrable_discrete_difference[of X M f g, OF assms]
   using integral_discrete_difference[of X M f g, OF assms]
   by (metis has_bochner_integral_iff)
 
 lemma
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and w :: "'a \<Rightarrow> real"
   assumes "f \<in> borel_measurable M" "\<And>i. s i \<in> borel_measurable M" "integrable M w"
   assumes lim: "AE x in M. (\<lambda>i. s i x) \<longlonglongrightarrow> f x"
   assumes bound: "\<And>i. AE x in M. norm (s i x) \<le> w x"
   shows integrable_dominated_convergence: "integrable M f"
     and integrable_dominated_convergence2: "\<And>i. integrable M (s i)"
     and integral_dominated_convergence: "(\<lambda>i. integral\<^sup>L M (s i)) \<longlonglongrightarrow> integral\<^sup>L M f"
 proof -
   have w_nonneg: "AE x in M. 0 \<le> w x"
     using bound[of 0] by eventually_elim (auto intro: norm_ge_zero order_trans)
   then have "(\<integral>\<^sup>+x. w x \<partial>M) = (\<integral>\<^sup>+x. norm (w x) \<partial>M)"
     by (intro nn_integral_cong_AE) auto
   with \<open>integrable M w\<close> have w: "w \<in> borel_measurable M" "(\<integral>\<^sup>+x. w x \<partial>M) < \<infinity>"
     unfolding integrable_iff_bounded by auto
 
   show int_s: "\<And>i. integrable M (s i)"
     unfolding integrable_iff_bounded
   proof
     fix i
     have "(\<integral>\<^sup>+ x. ennreal (norm (s i x)) \<partial>M) \<le> (\<integral>\<^sup>+x. w x \<partial>M)"
       using bound[of i] w_nonneg by (intro nn_integral_mono_AE) auto
     with w show "(\<integral>\<^sup>+ x. ennreal (norm (s i x)) \<partial>M) < \<infinity>" by auto
   qed fact
 
   have all_bound: "AE x in M. \<forall>i. norm (s i x) \<le> w x"
     using bound unfolding AE_all_countable by auto
 
   show int_f: "integrable M f"
     unfolding integrable_iff_bounded
   proof
     have "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) \<le> (\<integral>\<^sup>+x. w x \<partial>M)"
       using all_bound lim w_nonneg
     proof (intro nn_integral_mono_AE, eventually_elim)
       fix x assume "\<forall>i. norm (s i x) \<le> w x" "(\<lambda>i. s i x) \<longlonglongrightarrow> f x" "0 \<le> w x"
       then show "ennreal (norm (f x)) \<le> ennreal (w x)"
         by (intro LIMSEQ_le_const2[where X="\<lambda>i. ennreal (norm (s i x))"]) (auto intro: tendsto_intros)
     qed
     with w show "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>" by auto
   qed fact
 
   have "(\<lambda>n. ennreal (norm (integral\<^sup>L M (s n) - integral\<^sup>L M f))) \<longlonglongrightarrow> ennreal 0" (is "?d \<longlonglongrightarrow> ennreal 0")
   proof (rule tendsto_sandwich)
     show "eventually (\<lambda>n. ennreal 0 \<le> ?d n) sequentially" "(\<lambda>_. ennreal 0) \<longlonglongrightarrow> ennreal 0" by auto
     show "eventually (\<lambda>n. ?d n \<le> (\<integral>\<^sup>+x. norm (s n x - f x) \<partial>M)) sequentially"
     proof (intro always_eventually allI)
       fix n
       have "?d n = norm (integral\<^sup>L M (\<lambda>x. s n x - f x))"
         using int_f int_s by simp
       also have "\<dots> \<le> (\<integral>\<^sup>+x. norm (s n x - f x) \<partial>M)"
         by (intro int_f int_s integrable_diff integral_norm_bound_ennreal)
       finally show "?d n \<le> (\<integral>\<^sup>+x. norm (s n x - f x) \<partial>M)" .
     qed
     show "(\<lambda>n. \<integral>\<^sup>+x. norm (s n x - f x) \<partial>M) \<longlonglongrightarrow> ennreal 0"
       unfolding ennreal_0
       apply (subst norm_minus_commute)
     proof (rule nn_integral_dominated_convergence_norm[where w=w])
       show "\<And>n. s n \<in> borel_measurable M"
         using int_s unfolding integrable_iff_bounded by auto
     qed fact+
   qed
   then have "(\<lambda>n. integral\<^sup>L M (s n) - integral\<^sup>L M f) \<longlonglongrightarrow> 0"
     by (simp add: tendsto_norm_zero_iff del: ennreal_0)
   from tendsto_add[OF this tendsto_const[of "integral\<^sup>L M f"]]
   show "(\<lambda>i. integral\<^sup>L M (s i)) \<longlonglongrightarrow> integral\<^sup>L M f"  by simp
 qed
 
 context
   fixes s :: "real \<Rightarrow> 'a \<Rightarrow> 'b::{banach, second_countable_topology}" and w :: "'a \<Rightarrow> real"
     and f :: "'a \<Rightarrow> 'b" and M
   assumes "f \<in> borel_measurable M" "\<And>t. s t \<in> borel_measurable M" "integrable M w"
   assumes lim: "AE x in M. ((\<lambda>i. s i x) \<longlongrightarrow> f x) at_top"
   assumes bound: "\<forall>\<^sub>F i in at_top. AE x in M. norm (s i x) \<le> w x"
 begin
 
 lemma integral_dominated_convergence_at_top: "((\<lambda>t. integral\<^sup>L M (s t)) \<longlongrightarrow> integral\<^sup>L M f) at_top"
 proof (rule tendsto_at_topI_sequentially)
   fix X :: "nat \<Rightarrow> real" assume X: "filterlim X at_top sequentially"
   from filterlim_iff[THEN iffD1, OF this, rule_format, OF bound]
   obtain N where w: "\<And>n. N \<le> n \<Longrightarrow> AE x in M. norm (s (X n) x) \<le> w x"
     by (auto simp: eventually_sequentially)
 
   show "(\<lambda>n. integral\<^sup>L M (s (X n))) \<longlonglongrightarrow> integral\<^sup>L M f"
   proof (rule LIMSEQ_offset, rule integral_dominated_convergence)
     show "AE x in M. norm (s (X (n + N)) x) \<le> w x" for n
       by (rule w) auto
     show "AE x in M. (\<lambda>n. s (X (n + N)) x) \<longlonglongrightarrow> f x"
       using lim
     proof eventually_elim
       fix x assume "((\<lambda>i. s i x) \<longlongrightarrow> f x) at_top"
       then show "(\<lambda>n. s (X (n + N)) x) \<longlonglongrightarrow> f x"
         by (intro LIMSEQ_ignore_initial_segment filterlim_compose[OF _ X])
     qed
   qed fact+
 qed
 
 lemma integrable_dominated_convergence_at_top: "integrable M f"
 proof -
   from bound obtain N where w: "\<And>n. N \<le> n \<Longrightarrow> AE x in M. norm (s n x) \<le> w x"
     by (auto simp: eventually_at_top_linorder)
   show ?thesis
   proof (rule integrable_dominated_convergence)
     show "AE x in M. norm (s (N + i) x) \<le> w x" for i :: nat
       by (intro w) auto
     show "AE x in M. (\<lambda>i. s (N + real i) x) \<longlonglongrightarrow> f x"
       using lim
     proof eventually_elim
       fix x assume "((\<lambda>i. s i x) \<longlongrightarrow> f x) at_top"
       then show "(\<lambda>n. s (N + n) x) \<longlonglongrightarrow> f x"
         by (rule filterlim_compose)
            (auto intro!: filterlim_tendsto_add_at_top filterlim_real_sequentially)
     qed
   qed fact+
 qed
 
 end
 
 lemma integrable_mult_left_iff [simp]:
   fixes f :: "'a \<Rightarrow> real"
   shows "integrable M (\<lambda>x. c * f x) \<longleftrightarrow> c = 0 \<or> integrable M f"
   using integrable_mult_left[of c M f] integrable_mult_left[of "1 / c" M "\<lambda>x. c * f x"]
   by (cases "c = 0") auto
 
 lemma integrable_mult_right_iff [simp]:
   fixes f :: "'a \<Rightarrow> real"
   shows "integrable M (\<lambda>x. f x * c) \<longleftrightarrow> c = 0 \<or> integrable M f"
   using integrable_mult_left_iff [of M c f] by (simp add: mult.commute)
 
 lemma integrableI_nn_integral_finite:
   assumes [measurable]: "f \<in> borel_measurable M"
     and nonneg: "AE x in M. 0 \<le> f x"
     and finite: "(\<integral>\<^sup>+x. f x \<partial>M) = ennreal x"
   shows "integrable M f"
 proof (rule integrableI_bounded)
   have "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) = (\<integral>\<^sup>+ x. ennreal (f x) \<partial>M)"
     using nonneg by (intro nn_integral_cong_AE) auto
   with finite show "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>"
     by auto
 qed simp
 
 lemma integral_nonneg_AE:
   fixes f :: "'a \<Rightarrow> real"
   assumes nonneg: "AE x in M. 0 \<le> f x"
   shows "0 \<le> integral\<^sup>L M f"
 proof cases
   assume f: "integrable M f"
   then have [measurable]: "f \<in> M \<rightarrow>\<^sub>M borel"
     by auto
   have "(\<lambda>x. max 0 (f x)) \<in> M \<rightarrow>\<^sub>M borel" "\<And>x. 0 \<le> max 0 (f x)" "integrable M (\<lambda>x. max 0 (f x))"
     using f by auto
   from this have "0 \<le> integral\<^sup>L M (\<lambda>x. max 0 (f x))"
   proof (induction rule: borel_measurable_induct_real)
     case (add f g)
     then have "integrable M f" "integrable M g"
       by (auto intro!: integrable_bound[OF add.prems])
     with add show ?case
       by (simp add: nn_integral_add)
   next
     case (seq U)
     show ?case
     proof (rule LIMSEQ_le_const)
       have U_le: "x \<in> space M \<Longrightarrow> U i x \<le> max 0 (f x)" for x i
         using seq by (intro incseq_le) (auto simp: incseq_def le_fun_def)
       with seq nonneg show "(\<lambda>i. integral\<^sup>L M (U i)) \<longlonglongrightarrow> LINT x|M. max 0 (f x)"
         by (intro integral_dominated_convergence)
           (simp_all, fastforce)
       have "integrable M (U i)" for i
         using seq.prems by (rule integrable_bound) (insert U_le seq, auto)
       with seq show "\<exists>N. \<forall>n\<ge>N. 0 \<le> integral\<^sup>L M (U n)"
         by auto
     qed
   qed (auto)
   also have "\<dots> = integral\<^sup>L M f"
     using nonneg by (auto intro!: integral_cong_AE)
   finally show ?thesis .
 qed (simp add: not_integrable_integral_eq)
 
 lemma integral_nonneg[simp]:
   fixes f :: "'a \<Rightarrow> real"
   shows "(\<And>x. x \<in> space M \<Longrightarrow> 0 \<le> f x) \<Longrightarrow> 0 \<le> integral\<^sup>L M f"
   by (intro integral_nonneg_AE) auto
 
 proposition nn_integral_eq_integral:
   assumes f: "integrable M f"
   assumes nonneg: "AE x in M. 0 \<le> f x"
   shows "(\<integral>\<^sup>+ x. f x \<partial>M) = integral\<^sup>L M f"
 proof -
   { fix f :: "'a \<Rightarrow> real" assume f: "f \<in> borel_measurable M" "\<And>x. 0 \<le> f x" "integrable M f"
     then have "(\<integral>\<^sup>+ x. f x \<partial>M) = integral\<^sup>L M f"
     proof (induct rule: borel_measurable_induct_real)
       case (set A) then show ?case
         by (simp add: integrable_indicator_iff ennreal_indicator emeasure_eq_ennreal_measure)
     next
       case (mult f c) then show ?case
         by (auto simp add: nn_integral_cmult ennreal_mult integral_nonneg_AE)
     next
       case (add g f)
       then have "integrable M f" "integrable M g"
         by (auto intro!: integrable_bound[OF add.prems])
       with add show ?case
         by (simp add: nn_integral_add integral_nonneg_AE)
     next
       case (seq U)
       show ?case
       proof (rule LIMSEQ_unique)
         have U_le_f: "x \<in> space M \<Longrightarrow> U i x \<le> f x" for x i
           using seq by (intro incseq_le) (auto simp: incseq_def le_fun_def)
         have int_U: "\<And>i. integrable M (U i)"
           using seq f U_le_f by (intro integrable_bound[OF f(3)]) auto
         from U_le_f seq have "(\<lambda>i. integral\<^sup>L M (U i)) \<longlonglongrightarrow> integral\<^sup>L M f"
           by (intro integral_dominated_convergence) auto
         then show "(\<lambda>i. ennreal (integral\<^sup>L M (U i))) \<longlonglongrightarrow> ennreal (integral\<^sup>L M f)"
           using seq f int_U by (simp add: f integral_nonneg_AE)
         have "(\<lambda>i. \<integral>\<^sup>+ x. U i x \<partial>M) \<longlonglongrightarrow> \<integral>\<^sup>+ x. f x \<partial>M"
           using seq U_le_f f
           by (intro nn_integral_dominated_convergence[where w=f]) (auto simp: integrable_iff_bounded)
         then show "(\<lambda>i. \<integral>x. U i x \<partial>M) \<longlonglongrightarrow> \<integral>\<^sup>+x. f x \<partial>M"
           using seq int_U by simp
       qed
     qed }
   from this[of "\<lambda>x. max 0 (f x)"] assms have "(\<integral>\<^sup>+ x. max 0 (f x) \<partial>M) = integral\<^sup>L M (\<lambda>x. max 0 (f x))"
     by simp
   also have "\<dots> = integral\<^sup>L M f"
     using assms by (auto intro!: integral_cong_AE simp: integral_nonneg_AE)
   also have "(\<integral>\<^sup>+ x. max 0 (f x) \<partial>M) = (\<integral>\<^sup>+ x. f x \<partial>M)"
     using assms by (auto intro!: nn_integral_cong_AE simp: max_def)
   finally show ?thesis .
 qed
 
 lemma nn_integral_eq_integrable:
   assumes f: "f \<in> M \<rightarrow>\<^sub>M borel" "AE x in M. 0 \<le> f x" and "0 \<le> x"
   shows "(\<integral>\<^sup>+x. f x \<partial>M) = ennreal x \<longleftrightarrow> (integrable M f \<and> integral\<^sup>L M f = x)"
 proof (safe intro!: nn_integral_eq_integral assms)
   assume *: "(\<integral>\<^sup>+x. f x \<partial>M) = ennreal x"
   with integrableI_nn_integral_finite[OF f this] nn_integral_eq_integral[of M f, OF _ f(2)]
   show "integrable M f" "integral\<^sup>L M f = x"
     by (simp_all add: * assms integral_nonneg_AE)
 qed
 
 lemma
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> 'a :: {banach, second_countable_topology}"
   assumes integrable[measurable]: "\<And>i. integrable M (f i)"
   and summable: "AE x in M. summable (\<lambda>i. norm (f i x))"
   and sums: "summable (\<lambda>i. (\<integral>x. norm (f i x) \<partial>M))"
   shows integrable_suminf: "integrable M (\<lambda>x. (\<Sum>i. f i x))" (is "integrable M ?S")
     and sums_integral: "(\<lambda>i. integral\<^sup>L M (f i)) sums (\<integral>x. (\<Sum>i. f i x) \<partial>M)" (is "?f sums ?x")
     and integral_suminf: "(\<integral>x. (\<Sum>i. f i x) \<partial>M) = (\<Sum>i. integral\<^sup>L M (f i))"
     and summable_integral: "summable (\<lambda>i. integral\<^sup>L M (f i))"
 proof -
   have 1: "integrable M (\<lambda>x. \<Sum>i. norm (f i x))"
   proof (rule integrableI_bounded)
     have "(\<integral>\<^sup>+ x. ennreal (norm (\<Sum>i. norm (f i x))) \<partial>M) = (\<integral>\<^sup>+ x. (\<Sum>i. ennreal (norm (f i x))) \<partial>M)"
       apply (intro nn_integral_cong_AE)
       using summable
       apply eventually_elim
       apply (simp add: suminf_nonneg ennreal_suminf_neq_top)
       done
     also have "\<dots> = (\<Sum>i. \<integral>\<^sup>+ x. norm (f i x) \<partial>M)"
       by (intro nn_integral_suminf) auto
     also have "\<dots> = (\<Sum>i. ennreal (\<integral>x. norm (f i x) \<partial>M))"
       by (intro arg_cong[where f=suminf] ext nn_integral_eq_integral integrable_norm integrable) auto
     finally show "(\<integral>\<^sup>+ x. ennreal (norm (\<Sum>i. norm (f i x))) \<partial>M) < \<infinity>"
       by (simp add: sums ennreal_suminf_neq_top less_top[symmetric] integral_nonneg_AE)
   qed simp
 
   have 2: "AE x in M. (\<lambda>n. \<Sum>i<n. f i x) \<longlonglongrightarrow> (\<Sum>i. f i x)"
     using summable by eventually_elim (auto intro: summable_LIMSEQ summable_norm_cancel)
 
   have 3: "\<And>j. AE x in M. norm (\<Sum>i<j. f i x) \<le> (\<Sum>i. norm (f i x))"
     using summable
   proof eventually_elim
     fix j x assume [simp]: "summable (\<lambda>i. norm (f i x))"
     have "norm (\<Sum>i<j. f i x) \<le> (\<Sum>i<j. norm (f i x))" by (rule norm_sum)
     also have "\<dots> \<le> (\<Sum>i. norm (f i x))"
       using sum_le_suminf[of "\<lambda>i. norm (f i x)"] unfolding sums_iff by auto
     finally show "norm (\<Sum>i<j. f i x) \<le> (\<Sum>i. norm (f i x))" by simp
   qed
 
   note ibl = integrable_dominated_convergence[OF _ _ 1 2 3]
   note int = integral_dominated_convergence[OF _ _ 1 2 3]
 
   show "integrable M ?S"
     by (rule ibl) measurable
 
   show "?f sums ?x" unfolding sums_def
     using int by (simp add: integrable)
   then show "?x = suminf ?f" "summable ?f"
     unfolding sums_iff by auto
 qed
 
 proposition integral_norm_bound [simp]:
   fixes f :: "_ \<Rightarrow> 'a :: {banach, second_countable_topology}"
   shows "norm (integral\<^sup>L M f) \<le> (\<integral>x. norm (f x) \<partial>M)"
 proof (cases "integrable M f")
   case True then show ?thesis
     using nn_integral_eq_integral[of M "\<lambda>x. norm (f x)"] integral_norm_bound_ennreal[of M f]
     by (simp add: integral_nonneg_AE)
 next
   case False
   then have "norm (integral\<^sup>L M f) = 0" by (simp add: not_integrable_integral_eq)
   moreover have "(\<integral>x. norm (f x) \<partial>M) \<ge> 0" by auto
   ultimately show ?thesis by simp
 qed
 
 proposition integral_abs_bound [simp]:
   fixes f :: "'a \<Rightarrow> real" shows "abs (\<integral>x. f x \<partial>M) \<le> (\<integral>x. \<bar>f x\<bar> \<partial>M)"
 using integral_norm_bound[of M f] by auto
 
 lemma integral_eq_nn_integral:
   assumes [measurable]: "f \<in> borel_measurable M"
   assumes nonneg: "AE x in M. 0 \<le> f x"
   shows "integral\<^sup>L M f = enn2real (\<integral>\<^sup>+ x. ennreal (f x) \<partial>M)"
 proof cases
   assume *: "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) = \<infinity>"
   also have "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) = (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M)"
     using nonneg by (intro nn_integral_cong_AE) auto
   finally have "\<not> integrable M f"
     by (auto simp: integrable_iff_bounded)
   then show ?thesis
     by (simp add: * not_integrable_integral_eq)
 next
   assume "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<noteq> \<infinity>"
   then have "integrable M f"
     by (cases "\<integral>\<^sup>+ x. ennreal (f x) \<partial>M" rule: ennreal_cases)
        (auto intro!: integrableI_nn_integral_finite assms)
   from nn_integral_eq_integral[OF this] nonneg show ?thesis
     by (simp add: integral_nonneg_AE)
 qed
 
 lemma enn2real_nn_integral_eq_integral:
   assumes eq: "AE x in M. f x = ennreal (g x)" and nn: "AE x in M. 0 \<le> g x"
     and fin: "(\<integral>\<^sup>+x. f x \<partial>M) < top"
     and [measurable]: "g \<in> M \<rightarrow>\<^sub>M borel"
   shows "enn2real (\<integral>\<^sup>+x. f x \<partial>M) = (\<integral>x. g x \<partial>M)"
 proof -
   have "ennreal (enn2real (\<integral>\<^sup>+x. f x \<partial>M)) = (\<integral>\<^sup>+x. f x \<partial>M)"
     using fin by (intro ennreal_enn2real) auto
   also have "\<dots> = (\<integral>\<^sup>+x. g x \<partial>M)"
     using eq by (rule nn_integral_cong_AE)
   also have "\<dots> = (\<integral>x. g x \<partial>M)"
   proof (rule nn_integral_eq_integral)
     show "integrable M g"
     proof (rule integrableI_bounded)
       have "(\<integral>\<^sup>+ x. ennreal (norm (g x)) \<partial>M) = (\<integral>\<^sup>+ x. f x \<partial>M)"
         using eq nn by (auto intro!: nn_integral_cong_AE elim!: eventually_elim2)
       also note fin
       finally show "(\<integral>\<^sup>+ x. ennreal (norm (g x)) \<partial>M) < \<infinity>"
         by simp
     qed simp
   qed fact
   finally show ?thesis
     using nn by (simp add: integral_nonneg_AE)
 qed
 
 lemma has_bochner_integral_nn_integral:
   assumes "f \<in> borel_measurable M" "AE x in M. 0 \<le> f x" "0 \<le> x"
   assumes "(\<integral>\<^sup>+x. f x \<partial>M) = ennreal x"
   shows "has_bochner_integral M f x"
   unfolding has_bochner_integral_iff
   using assms by (auto simp: assms integral_eq_nn_integral intro: integrableI_nn_integral_finite)
 
 lemma integrableI_simple_bochner_integrable:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "simple_bochner_integrable M f \<Longrightarrow> integrable M f"
   by (intro integrableI_sequence[where s="\<lambda>_. f"] borel_measurable_simple_function)
      (auto simp: zero_ennreal_def[symmetric] simple_bochner_integrable.simps)
 
 proposition integrable_induct[consumes 1, case_names base add lim, induct pred: integrable]:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes "integrable M f"
   assumes base: "\<And>A c. A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow> P (\<lambda>x. indicator A x *\<^sub>R c)"
   assumes add: "\<And>f g. integrable M f \<Longrightarrow> P f \<Longrightarrow> integrable M g \<Longrightarrow> P g \<Longrightarrow> P (\<lambda>x. f x + g x)"
   assumes lim: "\<And>f s. (\<And>i. integrable M (s i)) \<Longrightarrow> (\<And>i. P (s i)) \<Longrightarrow>
    (\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. s i x) \<longlonglongrightarrow> f x) \<Longrightarrow>
    (\<And>i x. x \<in> space M \<Longrightarrow> norm (s i x) \<le> 2 * norm (f x)) \<Longrightarrow> integrable M f \<Longrightarrow> P f"
   shows "P f"
 proof -
   from \<open>integrable M f\<close> have f: "f \<in> borel_measurable M" "(\<integral>\<^sup>+x. norm (f x) \<partial>M) < \<infinity>"
     unfolding integrable_iff_bounded by auto
   from borel_measurable_implies_sequence_metric[OF f(1)]
   obtain s where s: "\<And>i. simple_function M (s i)" "\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. s i x) \<longlonglongrightarrow> f x"
     "\<And>i x. x \<in> space M \<Longrightarrow> norm (s i x) \<le> 2 * norm (f x)"
     unfolding norm_conv_dist by metis
 
   { fix f A
     have [simp]: "P (\<lambda>x. 0)"
       using base[of "{}" undefined] by simp
     have "(\<And>i::'b. i \<in> A \<Longrightarrow> integrable M (f i::'a \<Rightarrow> 'b)) \<Longrightarrow>
     (\<And>i. i \<in> A \<Longrightarrow> P (f i)) \<Longrightarrow> P (\<lambda>x. \<Sum>i\<in>A. f i x)"
     by (induct A rule: infinite_finite_induct) (auto intro!: add) }
   note sum = this
 
   define s' where [abs_def]: "s' i z = indicator (space M) z *\<^sub>R s i z" for i z
   then have s'_eq_s: "\<And>i x. x \<in> space M \<Longrightarrow> s' i x = s i x"
     by simp
 
   have sf[measurable]: "\<And>i. simple_function M (s' i)"
     unfolding s'_def using s(1)
     by (intro simple_function_compose2[where h="(*\<^sub>R)"] simple_function_indicator) auto
 
   { fix i
     have "\<And>z. {y. s' i z = y \<and> y \<in> s' i ` space M \<and> y \<noteq> 0 \<and> z \<in> space M} =
         (if z \<in> space M \<and> s' i z \<noteq> 0 then {s' i z} else {})"
       by (auto simp add: s'_def split: split_indicator)
     then have "\<And>z. s' i = (\<lambda>z. \<Sum>y\<in>s' i`space M - {0}. indicator {x\<in>space M. s' i x = y} z *\<^sub>R y)"
       using sf by (auto simp: fun_eq_iff simple_function_def s'_def) }
   note s'_eq = this
 
   show "P f"
   proof (rule lim)
     fix i
 
     have "(\<integral>\<^sup>+x. norm (s' i x) \<partial>M) \<le> (\<integral>\<^sup>+x. ennreal (2 * norm (f x)) \<partial>M)"
       using s by (intro nn_integral_mono) (auto simp: s'_eq_s)
     also have "\<dots> < \<infinity>"
       using f by (simp add: nn_integral_cmult ennreal_mult_less_top ennreal_mult)
     finally have sbi: "simple_bochner_integrable M (s' i)"
       using sf by (intro simple_bochner_integrableI_bounded) auto
     then show "integrable M (s' i)"
       by (rule integrableI_simple_bochner_integrable)
 
     { fix x assume"x \<in> space M" "s' i x \<noteq> 0"
       then have "emeasure M {y \<in> space M. s' i y = s' i x} \<le> emeasure M {y \<in> space M. s' i y \<noteq> 0}"
         by (intro emeasure_mono) auto
       also have "\<dots> < \<infinity>"
         using sbi by (auto elim: simple_bochner_integrable.cases simp: less_top)
       finally have "emeasure M {y \<in> space M. s' i y = s' i x} \<noteq> \<infinity>" by simp }
     then show "P (s' i)"
       by (subst s'_eq) (auto intro!: sum base simp: less_top)
 
     fix x assume "x \<in> space M" with s show "(\<lambda>i. s' i x) \<longlonglongrightarrow> f x"
       by (simp add: s'_eq_s)
     show "norm (s' i x) \<le> 2 * norm (f x)"
       using \<open>x \<in> space M\<close> s by (simp add: s'_eq_s)
   qed fact
 qed
 
 lemma integral_eq_zero_AE:
   "(AE x in M. f x = 0) \<Longrightarrow> integral\<^sup>L M f = 0"
   using integral_cong_AE[of f M "\<lambda>_. 0"]
   by (cases "integrable M f") (simp_all add: not_integrable_integral_eq)
 
 lemma integral_nonneg_eq_0_iff_AE:
   fixes f :: "_ \<Rightarrow> real"
   assumes f[measurable]: "integrable M f" and nonneg: "AE x in M. 0 \<le> f x"
   shows "integral\<^sup>L M f = 0 \<longleftrightarrow> (AE x in M. f x = 0)"
 proof
   assume "integral\<^sup>L M f = 0"
   then have "integral\<^sup>N M f = 0"
     using nn_integral_eq_integral[OF f nonneg] by simp
   then have "AE x in M. ennreal (f x) \<le> 0"
     by (simp add: nn_integral_0_iff_AE)
   with nonneg show "AE x in M. f x = 0"
     by auto
 qed (auto simp add: integral_eq_zero_AE)
 
 lemma integral_mono_AE:
   fixes f :: "'a \<Rightarrow> real"
   assumes "integrable M f" "integrable M g" "AE x in M. f x \<le> g x"
   shows "integral\<^sup>L M f \<le> integral\<^sup>L M g"
 proof -
   have "0 \<le> integral\<^sup>L M (\<lambda>x. g x - f x)"
     using assms by (intro integral_nonneg_AE integrable_diff assms) auto
   also have "\<dots> = integral\<^sup>L M g - integral\<^sup>L M f"
     by (intro integral_diff assms)
   finally show ?thesis by simp
 qed
 
 lemma integral_mono:
   fixes f :: "'a \<Rightarrow> real"
   shows "integrable M f \<Longrightarrow> integrable M g \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> f x \<le> g x) \<Longrightarrow>
     integral\<^sup>L M f \<le> integral\<^sup>L M g"
   by (intro integral_mono_AE) auto
 
 lemma integral_norm_bound_integral:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{banach,second_countable_topology}"
   assumes "integrable M f" "integrable M g" "\<And>x. x \<in> space M \<Longrightarrow> norm(f x) \<le> g x"
   shows "norm (\<integral>x. f x \<partial>M) \<le> (\<integral>x. g x \<partial>M)"
 proof -
   have "norm (\<integral>x. f x \<partial>M) \<le> (\<integral>x. norm (f x) \<partial>M)"
     by (rule integral_norm_bound)
   also have "... \<le> (\<integral>x. g x \<partial>M)"
     using assms integrable_norm integral_mono by blast
   finally show ?thesis .
 qed
 
 lemma integral_abs_bound_integral:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "integrable M f" "integrable M g" "\<And>x. x \<in> space M \<Longrightarrow> \<bar>f x\<bar> \<le> g x"
   shows "\<bar>\<integral>x. f x \<partial>M\<bar> \<le> (\<integral>x. g x \<partial>M)"
   by (metis integral_norm_bound_integral assms real_norm_def)
 
 text \<open>The next two statements are useful to bound Lebesgue integrals, as they avoid one
 integrability assumption. The price to pay is that the upper function has to be nonnegative,
 but this is often true and easy to check in computations.\<close>
 
 lemma integral_mono_AE':
   fixes f::"_ \<Rightarrow> real"
   assumes "integrable M f" "AE x in M. g x \<le> f x" "AE x in M. 0 \<le> f x"
   shows "(\<integral>x. g x \<partial>M) \<le> (\<integral>x. f x \<partial>M)"
 proof (cases "integrable M g")
   case True
   show ?thesis by (rule integral_mono_AE, auto simp add: assms True)
 next
   case False
   then have "(\<integral>x. g x \<partial>M) = 0" by (simp add: not_integrable_integral_eq)
   also have "... \<le> (\<integral>x. f x \<partial>M)" by (simp add: integral_nonneg_AE[OF assms(3)])
   finally show ?thesis by simp
 qed
 
 lemma integral_mono':
   fixes f::"_ \<Rightarrow> real"
   assumes "integrable M f" "\<And>x. x \<in> space M \<Longrightarrow> g x \<le> f x" "\<And>x. x \<in> space M \<Longrightarrow> 0 \<le> f x"
   shows "(\<integral>x. g x \<partial>M) \<le> (\<integral>x. f x \<partial>M)"
 by (rule integral_mono_AE', insert assms, auto)
 
 lemma (in finite_measure) integrable_measure:
   assumes I: "disjoint_family_on X I" "countable I"
   shows "integrable (count_space I) (\<lambda>i. measure M (X i))"
 proof -
   have "(\<integral>\<^sup>+i. measure M (X i) \<partial>count_space I) = (\<integral>\<^sup>+i. measure M (if X i \<in> sets M then X i else {}) \<partial>count_space I)"
     by (auto intro!: nn_integral_cong measure_notin_sets)
   also have "\<dots> = measure M (\<Union>i\<in>I. if X i \<in> sets M then X i else {})"
     using I unfolding emeasure_eq_measure[symmetric]
     by (subst emeasure_UN_countable) (auto simp: disjoint_family_on_def)
   finally show ?thesis
     by (auto intro!: integrableI_bounded)
 qed
 
 lemma integrableI_real_bounded:
   assumes f: "f \<in> borel_measurable M" and ae: "AE x in M. 0 \<le> f x" and fin: "integral\<^sup>N M f < \<infinity>"
   shows "integrable M f"
 proof (rule integrableI_bounded)
   have "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) = \<integral>\<^sup>+ x. ennreal (f x) \<partial>M"
     using ae by (auto intro: nn_integral_cong_AE)
   also note fin
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>" .
 qed fact
 
 lemma nn_integral_nonneg_infinite:
   fixes f::"'a \<Rightarrow> real"
   assumes "f \<in> borel_measurable M" "\<not> integrable M f" "AE x in M. f x \<ge> 0"
   shows "(\<integral>\<^sup>+x. f x \<partial>M) = \<infinity>"
 using assms integrableI_real_bounded less_top by auto
 
 lemma integral_real_bounded:
   assumes "0 \<le> r" "integral\<^sup>N M f \<le> ennreal r"
   shows "integral\<^sup>L M f \<le> r"
 proof cases
   assume [simp]: "integrable M f"
 
   have "integral\<^sup>L M (\<lambda>x. max 0 (f x)) = integral\<^sup>N M (\<lambda>x. max 0 (f x))"
     by (intro nn_integral_eq_integral[symmetric]) auto
   also have "\<dots> = integral\<^sup>N M f"
     by (intro nn_integral_cong) (simp add: max_def ennreal_neg)
   also have "\<dots> \<le> r"
     by fact
   finally have "integral\<^sup>L M (\<lambda>x. max 0 (f x)) \<le> r"
     using \<open>0 \<le> r\<close> by simp
 
   moreover have "integral\<^sup>L M f \<le> integral\<^sup>L M (\<lambda>x. max 0 (f x))"
     by (rule integral_mono_AE) auto
   ultimately show ?thesis
     by simp
 next
   assume "\<not> integrable M f" then show ?thesis
     using \<open>0 \<le> r\<close> by (simp add: not_integrable_integral_eq)
 qed
 
 lemma integrable_MIN:
   fixes f:: "_ \<Rightarrow> _ \<Rightarrow> real"
   shows "\<lbrakk> finite I;  I \<noteq> {}; \<And>i. i \<in> I \<Longrightarrow> integrable M (f i) \<rbrakk>
    \<Longrightarrow> integrable M (\<lambda>x. MIN i\<in>I. f i x)"
 by (induct rule: finite_ne_induct) simp+
 
 lemma integrable_MAX:
   fixes f:: "_ \<Rightarrow> _ \<Rightarrow> real"
   shows "\<lbrakk> finite I;  I \<noteq> {};  \<And>i. i \<in> I \<Longrightarrow> integrable M (f i) \<rbrakk>
   \<Longrightarrow> integrable M (\<lambda>x. MAX i\<in>I. f i x)"
 by (induct rule: finite_ne_induct) simp+
 
 theorem integral_Markov_inequality:
   assumes [measurable]: "integrable M u" and "AE x in M. 0 \<le> u x" "0 < (c::real)"
   shows "(emeasure M) {x\<in>space M. u x \<ge> c} \<le> (1/c) * (\<integral>x. u x \<partial>M)"
 proof -
   have "(\<integral>\<^sup>+ x. ennreal(u x) * indicator (space M) x \<partial>M) \<le> (\<integral>\<^sup>+ x. u x \<partial>M)"
     by (rule nn_integral_mono_AE, auto simp add: \<open>c>0\<close> less_eq_real_def)
   also have "... = (\<integral>x. u x \<partial>M)"
     by (rule nn_integral_eq_integral, auto simp add: assms)
   finally have *: "(\<integral>\<^sup>+ x. ennreal(u x) * indicator (space M) x \<partial>M) \<le> (\<integral>x. u x \<partial>M)"
     by simp
 
   have "{x \<in> space M. u x \<ge> c} = {x \<in> space M. ennreal(1/c) * u x \<ge> 1} \<inter> (space M)"
     using \<open>c>0\<close> by (auto simp: ennreal_mult'[symmetric])
   then have "emeasure M {x \<in> space M. u x \<ge> c} = emeasure M ({x \<in> space M. ennreal(1/c) * u x \<ge> 1})"
     by simp
   also have "... \<le> ennreal(1/c) * (\<integral>\<^sup>+ x. ennreal(u x) * indicator (space M) x \<partial>M)"
     by (rule nn_integral_Markov_inequality) (auto simp add: assms)
   also have "... \<le> ennreal(1/c) * (\<integral>x. u x \<partial>M)"
     by (rule mult_left_mono) (use * \<open>c > 0\<close> in auto)
   finally show ?thesis
     using \<open>0<c\<close> by (simp add: ennreal_mult'[symmetric])
 qed
 
 theorem integral_Markov_inequality_measure:
   assumes [measurable]: "integrable M u" and "A \<in> sets M" and "AE x in M. 0 \<le> u x" "0 < (c::real)"
   shows "measure M {x\<in>space M. u x \<ge> c} \<le> (\<integral>x. u x \<partial>M) / c"
 proof -
   have le: "emeasure M {x\<in>space M. u x \<ge> c} \<le> ennreal ((1/c) * (\<integral>x. u x \<partial>M))"
     by (rule integral_Markov_inequality) (use assms in auto)
   also have "\<dots> < top"
     by auto
   finally have "ennreal (measure M {x\<in>space M. u x \<ge> c}) = emeasure M {x\<in>space M. u x \<ge> c}"
     by (intro emeasure_eq_ennreal_measure [symmetric]) auto
   also note le
   finally show ?thesis
     by (subst (asm) ennreal_le_iff)
        (auto intro!: divide_nonneg_pos Bochner_Integration.integral_nonneg_AE assms)
 qed
 
 theorem%important (in finite_measure) second_moment_method:
   assumes [measurable]: "f \<in> M \<rightarrow>\<^sub>M borel"
   assumes "integrable M (\<lambda>x. f x ^ 2)"
   defines "\<mu> \<equiv> lebesgue_integral M f"
   assumes "a > 0"
   shows "measure M {x\<in>space M. \<bar>f x\<bar> \<ge> a} \<le> lebesgue_integral M (\<lambda>x. f x ^ 2) / a\<^sup>2"
 proof -
   have integrable: "integrable M f"
     using assms by (blast dest: square_integrable_imp_integrable)
   have "{x\<in>space M. \<bar>f x\<bar> \<ge> a} = {x\<in>space M. f x ^ 2 \<ge> a\<^sup>2}"
     using \<open>a > 0\<close> by (simp flip: abs_le_square_iff)
   hence "measure M {x\<in>space M. \<bar>f x\<bar> \<ge> a} = measure M {x\<in>space M. f x ^ 2 \<ge> a\<^sup>2}"
     by simp
   also have "\<dots> \<le> lebesgue_integral M (\<lambda>x. f x ^ 2) / a\<^sup>2"
     using assms by (intro integral_Markov_inequality_measure) auto
   finally show ?thesis .
 qed
 
 lemma integral_ineq_eq_0_then_AE:
   fixes f::"_ \<Rightarrow> real"
   assumes "AE x in M. f x \<le> g x" "integrable M f" "integrable M g"
           "(\<integral>x. f x \<partial>M) = (\<integral>x. g x \<partial>M)"
   shows "AE x in M. f x = g x"
 proof -
   define h where "h = (\<lambda>x. g x - f x)"
   have "AE x in M. h x = 0"
     apply (subst integral_nonneg_eq_0_iff_AE[symmetric])
     unfolding h_def using assms by auto
   then show ?thesis unfolding h_def by auto
 qed
 
 lemma not_AE_zero_int_E:
   fixes f::"'a \<Rightarrow> real"
   assumes "AE x in M. f x \<ge> 0" "(\<integral>x. f x \<partial>M) > 0"
       and [measurable]: "f \<in> borel_measurable M"
   shows "\<exists>A e. A \<in> sets M \<and> e>0 \<and> emeasure M A > 0 \<and> (\<forall>x \<in> A. f x \<ge> e)"
 proof (rule not_AE_zero_E, auto simp add: assms)
   assume *: "AE x in M. f x = 0"
   have "(\<integral>x. f x \<partial>M) = (\<integral>x. 0 \<partial>M)" by (rule integral_cong_AE, auto simp add: *)
   then have "(\<integral>x. f x \<partial>M) = 0" by simp
   then show False using assms(2) by simp
 qed
 
 proposition tendsto_L1_int:
   fixes u :: "_ \<Rightarrow> _ \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "\<And>n. integrable M (u n)" "integrable M f"
           and "((\<lambda>n. (\<integral>\<^sup>+x. norm(u n x - f x) \<partial>M)) \<longlongrightarrow> 0) F"
   shows "((\<lambda>n. (\<integral>x. u n x \<partial>M)) \<longlongrightarrow> (\<integral>x. f x \<partial>M)) F"
 proof -
   have "((\<lambda>n. norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M))) \<longlongrightarrow> (0::ennreal)) F"
   proof (rule tendsto_sandwich[of "\<lambda>_. 0", where ?h = "\<lambda>n. (\<integral>\<^sup>+x. norm(u n x - f x) \<partial>M)"], auto simp add: assms)
     {
       fix n
       have "(\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M) = (\<integral>x. u n x - f x \<partial>M)"
         apply (rule Bochner_Integration.integral_diff[symmetric]) using assms by auto
       then have "norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M)) = norm (\<integral>x. u n x - f x \<partial>M)"
         by auto
       also have "... \<le> (\<integral>x. norm(u n x - f x) \<partial>M)"
         by (rule integral_norm_bound)
       finally have "ennreal(norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M))) \<le> (\<integral>x. norm(u n x - f x) \<partial>M)"
         by simp
       also have "... = (\<integral>\<^sup>+x. norm(u n x - f x) \<partial>M)"
         apply (rule nn_integral_eq_integral[symmetric]) using assms by auto
       finally have "norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M)) \<le> (\<integral>\<^sup>+x. norm(u n x - f x) \<partial>M)" by simp
     }
     then show "eventually (\<lambda>n. norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M)) \<le> (\<integral>\<^sup>+x. norm(u n x - f x) \<partial>M)) F"
       by auto
   qed
   then have "((\<lambda>n. norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M))) \<longlongrightarrow> 0) F"
     by (simp flip: ennreal_0)
   then have "((\<lambda>n. ((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M))) \<longlongrightarrow> 0) F" using tendsto_norm_zero_iff by blast
   then show ?thesis using Lim_null by auto
 qed
 
 text \<open>The next lemma asserts that, if a sequence of functions converges in \<open>L\<^sup>1\<close>, then
 it admits a subsequence that converges almost everywhere.\<close>
 
 proposition tendsto_L1_AE_subseq:
   fixes u :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "\<And>n. integrable M (u n)"
       and "(\<lambda>n. (\<integral>x. norm(u n x) \<partial>M)) \<longlonglongrightarrow> 0"
   shows "\<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (AE x in M. (\<lambda>n. u (r n) x) \<longlonglongrightarrow> 0)"
 proof -
   {
     fix k
     have "eventually (\<lambda>n. (\<integral>x. norm(u n x) \<partial>M) < (1/2)^k) sequentially"
       using order_tendstoD(2)[OF assms(2)] by auto
     with eventually_elim2[OF eventually_gt_at_top[of k] this]
     have "\<exists>n>k. (\<integral>x. norm(u n x) \<partial>M) < (1/2)^k"
       by (metis eventually_False_sequentially)
   }
   then have "\<exists>r. \<forall>n. True \<and> (r (Suc n) > r n \<and> (\<integral>x. norm(u (r (Suc n)) x) \<partial>M) < (1/2)^(r n))"
     by (intro dependent_nat_choice, auto)
   then obtain r0 where r0: "strict_mono r0" "\<And>n. (\<integral>x. norm(u (r0 (Suc n)) x) \<partial>M) < (1/2)^(r0 n)"
     by (auto simp: strict_mono_Suc_iff)
   define r where "r = (\<lambda>n. r0(n+1))"
   have "strict_mono r" unfolding r_def using r0(1) by (simp add: strict_mono_Suc_iff)
   have I: "(\<integral>\<^sup>+x. norm(u (r n) x) \<partial>M) < ennreal((1/2)^n)" for n
   proof -
     have "r0 n \<ge> n" using \<open>strict_mono r0\<close> by (simp add: seq_suble)
     have "(1/2::real)^(r0 n) \<le> (1/2)^n" by (rule power_decreasing[OF \<open>r0 n \<ge> n\<close>], auto)
     then have "(\<integral>x. norm(u (r0 (Suc n)) x) \<partial>M) < (1/2)^n" 
       using r0(2) less_le_trans by blast
     then have "(\<integral>x. norm(u (r n) x) \<partial>M) < (1/2)^n" 
       unfolding r_def by auto
     moreover have "(\<integral>\<^sup>+x. norm(u (r n) x) \<partial>M) = (\<integral>x. norm(u (r n) x) \<partial>M)"
       by (rule nn_integral_eq_integral, auto simp add: integrable_norm[OF assms(1)[of "r n"]])
     ultimately show ?thesis by (auto intro: ennreal_lessI)
   qed
 
   have "AE x in M. limsup (\<lambda>n. ennreal (norm(u (r n) x))) \<le> 0"
   proof (rule AE_upper_bound_inf_ennreal)
     fix e::real assume "e > 0"
     define A where "A = (\<lambda>n. {x \<in> space M. norm(u (r n) x) \<ge> e})"
     have A_meas [measurable]: "\<And>n. A n \<in> sets M" unfolding A_def by auto
     have A_bound: "emeasure M (A n) < (1/e) * ennreal((1/2)^n)" for n
     proof -
       have *: "indicator (A n) x \<le> (1/e) * ennreal(norm(u (r n) x))" for x
         apply (cases "x \<in> A n") unfolding A_def using \<open>0 < e\<close> by (auto simp: ennreal_mult[symmetric])
       have "emeasure M (A n) = (\<integral>\<^sup>+x. indicator (A n) x \<partial>M)" by auto
       also have "... \<le> (\<integral>\<^sup>+x. (1/e) * ennreal(norm(u (r n) x)) \<partial>M)"
         apply (rule nn_integral_mono) using * by auto
       also have "... = (1/e) * (\<integral>\<^sup>+x. norm(u (r n) x) \<partial>M)"
         apply (rule nn_integral_cmult) using \<open>e > 0\<close> by auto
       also have "... < (1/e) * ennreal((1/2)^n)"
         using I[of n] \<open>e > 0\<close> by (intro ennreal_mult_strict_left_mono) auto
       finally show ?thesis by simp
     qed
     have A_fin: "emeasure M (A n) < \<infinity>" for n
       using \<open>e > 0\<close> A_bound[of n]
       by (auto simp add: ennreal_mult less_top[symmetric])
 
     have A_sum: "summable (\<lambda>n. measure M (A n))"
     proof (rule summable_comparison_test'[of "\<lambda>n. (1/e) * (1/2)^n" 0])
       have "summable (\<lambda>n. (1/(2::real))^n)" by (simp add: summable_geometric)
       then show "summable (\<lambda>n. (1/e) * (1/2)^n)" using summable_mult by blast
       fix n::nat assume "n \<ge> 0"
       have "norm(measure M (A n)) = measure M (A n)" by simp
       also have "... = enn2real(emeasure M (A n))" unfolding measure_def by simp
       also have "... < enn2real((1/e) * (1/2)^n)"
         using A_bound[of n] \<open>emeasure M (A n) < \<infinity>\<close> \<open>0 < e\<close>
         by (auto simp: emeasure_eq_ennreal_measure ennreal_mult[symmetric] ennreal_less_iff)
       also have "... = (1/e) * (1/2)^n"
         using \<open>0<e\<close> by auto
       finally show "norm(measure M (A n)) \<le> (1/e) * (1/2)^n" by simp
     qed
 
     have "AE x in M. eventually (\<lambda>n. x \<in> space M - A n) sequentially"
       by (rule borel_cantelli_AE1[OF A_meas A_fin A_sum])
     moreover
     {
       fix x assume "eventually (\<lambda>n. x \<in> space M - A n) sequentially"
       moreover have "norm(u (r n) x) \<le> ennreal e" if "x \<in> space M - A n" for n
         using that unfolding A_def by (auto intro: ennreal_leI)
       ultimately have "eventually (\<lambda>n. norm(u (r n) x) \<le> ennreal e) sequentially"
         by (simp add: eventually_mono)
       then have "limsup (\<lambda>n. ennreal (norm(u (r n) x))) \<le> e"
         by (simp add: Limsup_bounded)
     }
     ultimately show "AE x in M. limsup (\<lambda>n. ennreal (norm(u (r n) x))) \<le> 0 + ennreal e" by auto
   qed
   moreover
   {
     fix x assume "limsup (\<lambda>n. ennreal (norm(u (r n) x))) \<le> 0"
     moreover then have "liminf (\<lambda>n. ennreal (norm(u (r n) x))) \<le> 0"
       by (rule order_trans[rotated]) (auto intro: Liminf_le_Limsup)
     ultimately have "(\<lambda>n. ennreal (norm(u (r n) x))) \<longlonglongrightarrow> 0"
       using tendsto_Limsup[of sequentially "\<lambda>n. ennreal (norm(u (r n) x))"] by auto
     then have "(\<lambda>n. norm(u (r n) x)) \<longlonglongrightarrow> 0"
       by (simp flip: ennreal_0)
     then have "(\<lambda>n. u (r n) x) \<longlonglongrightarrow> 0"
       by (simp add: tendsto_norm_zero_iff)
   }
   ultimately have "AE x in M. (\<lambda>n. u (r n) x) \<longlonglongrightarrow> 0" by auto
   then show ?thesis using \<open>strict_mono r\<close> by auto
 qed
 
 subsection \<open>Restricted measure spaces\<close>
 
 lemma integrable_restrict_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes \<Omega>[simp]: "\<Omega> \<inter> space M \<in> sets M"
   shows "integrable (restrict_space M \<Omega>) f \<longleftrightarrow> integrable M (\<lambda>x. indicator \<Omega> x *\<^sub>R f x)"
   unfolding integrable_iff_bounded
     borel_measurable_restrict_space_iff[OF \<Omega>]
     nn_integral_restrict_space[OF \<Omega>]
   by (simp add: ac_simps ennreal_indicator ennreal_mult)
 
 lemma integral_restrict_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes \<Omega>[simp]: "\<Omega> \<inter> space M \<in> sets M"
   shows "integral\<^sup>L (restrict_space M \<Omega>) f = integral\<^sup>L M (\<lambda>x. indicator \<Omega> x *\<^sub>R f x)"
 proof (rule integral_eq_cases)
   assume "integrable (restrict_space M \<Omega>) f"
   then show ?thesis
   proof induct
     case (base A c) then show ?case
       by (simp add: indicator_inter_arith[symmetric] sets_restrict_space_iff
                     emeasure_restrict_space Int_absorb1 measure_restrict_space)
   next
     case (add g f) then show ?case
       by (simp add: scaleR_add_right integrable_restrict_space)
   next
     case (lim f s)
     show ?case
     proof (rule LIMSEQ_unique)
       show "(\<lambda>i. integral\<^sup>L (restrict_space M \<Omega>) (s i)) \<longlonglongrightarrow> integral\<^sup>L (restrict_space M \<Omega>) f"
         using lim by (intro integral_dominated_convergence[where w="\<lambda>x. 2 * norm (f x)"]) simp_all
 
       show "(\<lambda>i. integral\<^sup>L (restrict_space M \<Omega>) (s i)) \<longlonglongrightarrow> (\<integral> x. indicator \<Omega> x *\<^sub>R f x \<partial>M)"
         unfolding lim
         using lim
         by (intro integral_dominated_convergence[where w="\<lambda>x. 2 * norm (indicator \<Omega> x *\<^sub>R f x)"])
            (auto simp add: space_restrict_space integrable_restrict_space simp del: norm_scaleR
                  split: split_indicator)
     qed
   qed
 qed (simp add: integrable_restrict_space)
 
 lemma integral_empty:
   assumes "space M = {}"
   shows "integral\<^sup>L M f = 0"
 proof -
   have "(\<integral> x. f x \<partial>M) = (\<integral> x. 0 \<partial>M)"
     by(rule integral_cong)(simp_all add: assms)
   thus ?thesis by simp
 qed
 
 subsection \<open>Measure spaces with an associated density\<close>
 
 lemma integrable_density:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and g :: "'a \<Rightarrow> real"
   assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
     and nn: "AE x in M. 0 \<le> g x"
   shows "integrable (density M g) f \<longleftrightarrow> integrable M (\<lambda>x. g x *\<^sub>R f x)"
   unfolding integrable_iff_bounded using nn
   apply (simp add: nn_integral_density less_top[symmetric])
   apply (intro arg_cong2[where f="(=)"] refl nn_integral_cong_AE)
   apply (auto simp: ennreal_mult)
   done
 
 lemma integral_density:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and g :: "'a \<Rightarrow> real"
   assumes f: "f \<in> borel_measurable M"
     and g[measurable]: "g \<in> borel_measurable M" "AE x in M. 0 \<le> g x"
   shows "integral\<^sup>L (density M g) f = integral\<^sup>L M (\<lambda>x. g x *\<^sub>R f x)"
 proof (rule integral_eq_cases)
   assume "integrable (density M g) f"
   then show ?thesis
   proof induct
     case (base A c)
     then have [measurable]: "A \<in> sets M" by auto
 
     have int: "integrable M (\<lambda>x. g x * indicator A x)"
       using g base integrable_density[of "indicator A :: 'a \<Rightarrow> real" M g] by simp
     then have "integral\<^sup>L M (\<lambda>x. g x * indicator A x) = (\<integral>\<^sup>+ x. ennreal (g x * indicator A x) \<partial>M)"
       using g by (subst nn_integral_eq_integral) auto
     also have "\<dots> = (\<integral>\<^sup>+ x. ennreal (g x) * indicator A x \<partial>M)"
       by (intro nn_integral_cong) (auto split: split_indicator)
     also have "\<dots> = emeasure (density M g) A"
       by (rule emeasure_density[symmetric]) auto
     also have "\<dots> = ennreal (measure (density M g) A)"
       using base by (auto intro: emeasure_eq_ennreal_measure)
     also have "\<dots> = integral\<^sup>L (density M g) (indicator A)"
       using base by simp
     finally show ?case
       using base g
       apply (simp add: int integral_nonneg_AE)
       apply (subst (asm) ennreal_inj)
       apply (auto intro!: integral_nonneg_AE)
       done
   next
     case (add f h)
     then have [measurable]: "f \<in> borel_measurable M" "h \<in> borel_measurable M"
       by (auto dest!: borel_measurable_integrable)
     from add g show ?case
       by (simp add: scaleR_add_right integrable_density)
   next
     case (lim f s)
     have [measurable]: "f \<in> borel_measurable M" "\<And>i. s i \<in> borel_measurable M"
       using lim(1,5)[THEN borel_measurable_integrable] by auto
 
     show ?case
     proof (rule LIMSEQ_unique)
       show "(\<lambda>i. integral\<^sup>L M (\<lambda>x. g x *\<^sub>R s i x)) \<longlonglongrightarrow> integral\<^sup>L M (\<lambda>x. g x *\<^sub>R f x)"
       proof (rule integral_dominated_convergence)
         show "integrable M (\<lambda>x. 2 * norm (g x *\<^sub>R f x))"
           by (intro integrable_mult_right integrable_norm integrable_density[THEN iffD1] lim g) auto
         show "AE x in M. (\<lambda>i. g x *\<^sub>R s i x) \<longlonglongrightarrow> g x *\<^sub>R f x"
           using lim(3) by (auto intro!: tendsto_scaleR AE_I2[of M])
         show "\<And>i. AE x in M. norm (g x *\<^sub>R s i x) \<le> 2 * norm (g x *\<^sub>R f x)"
           using lim(4) g by (auto intro!: AE_I2[of M] mult_left_mono simp: field_simps)
       qed auto
       show "(\<lambda>i. integral\<^sup>L M (\<lambda>x. g x *\<^sub>R s i x)) \<longlonglongrightarrow> integral\<^sup>L (density M g) f"
         unfolding lim(2)[symmetric]
         by (rule integral_dominated_convergence[where w="\<lambda>x. 2 * norm (f x)"])
            (insert lim(3-5), auto)
     qed
   qed
 qed (simp add: f g integrable_density)
 
 lemma
   fixes g :: "'a \<Rightarrow> real"
   assumes "f \<in> borel_measurable M" "AE x in M. 0 \<le> f x" "g \<in> borel_measurable M"
   shows integral_real_density: "integral\<^sup>L (density M f) g = (\<integral> x. f x * g x \<partial>M)"
     and integrable_real_density: "integrable (density M f) g \<longleftrightarrow> integrable M (\<lambda>x. f x * g x)"
   using assms integral_density[of g M f] integrable_density[of g M f] by auto
 
 lemma has_bochner_integral_density:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and g :: "'a \<Rightarrow> real"
   shows "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (AE x in M. 0 \<le> g x) \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. g x *\<^sub>R f x) x \<Longrightarrow> has_bochner_integral (density M g) f x"
   by (simp add: has_bochner_integral_iff integrable_density integral_density)
 
 subsection \<open>Distributions\<close>
 
 lemma integrable_distr_eq:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "g \<in> measurable M N" "f \<in> borel_measurable N"
   shows "integrable (distr M N g) f \<longleftrightarrow> integrable M (\<lambda>x. f (g x))"
   unfolding integrable_iff_bounded by (simp_all add: nn_integral_distr)
 
 lemma integrable_distr:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "T \<in> measurable M M' \<Longrightarrow> integrable (distr M M' T) f \<Longrightarrow> integrable M (\<lambda>x. f (T x))"
   by (subst integrable_distr_eq[symmetric, where g=T])
      (auto dest: borel_measurable_integrable)
 
 lemma integral_distr:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes g[measurable]: "g \<in> measurable M N" and f: "f \<in> borel_measurable N"
   shows "integral\<^sup>L (distr M N g) f = integral\<^sup>L M (\<lambda>x. f (g x))"
 proof (rule integral_eq_cases)
   assume "integrable (distr M N g) f"
   then show ?thesis
   proof induct
     case (base A c)
     then have [measurable]: "A \<in> sets N" by auto
     from base have int: "integrable (distr M N g) (\<lambda>a. indicator A a *\<^sub>R c)"
       by (intro integrable_indicator)
 
     have "integral\<^sup>L (distr M N g) (\<lambda>a. indicator A a *\<^sub>R c) = measure (distr M N g) A *\<^sub>R c"
       using base by auto
     also have "\<dots> = measure M (g -` A \<inter> space M) *\<^sub>R c"
       by (subst measure_distr) auto
     also have "\<dots> = integral\<^sup>L M (\<lambda>a. indicator (g -` A \<inter> space M) a *\<^sub>R c)"
       using base by (auto simp: emeasure_distr)
     also have "\<dots> = integral\<^sup>L M (\<lambda>a. indicator A (g a) *\<^sub>R c)"
       using int base by (intro integral_cong_AE) (auto simp: emeasure_distr split: split_indicator)
     finally show ?case .
   next
     case (add f h)
     then have [measurable]: "f \<in> borel_measurable N" "h \<in> borel_measurable N"
       by (auto dest!: borel_measurable_integrable)
     from add g show ?case
       by (simp add: scaleR_add_right integrable_distr_eq)
   next
     case (lim f s)
     have [measurable]: "f \<in> borel_measurable N" "\<And>i. s i \<in> borel_measurable N"
       using lim(1,5)[THEN borel_measurable_integrable] by auto
 
     show ?case
     proof (rule LIMSEQ_unique)
       show "(\<lambda>i. integral\<^sup>L M (\<lambda>x. s i (g x))) \<longlonglongrightarrow> integral\<^sup>L M (\<lambda>x. f (g x))"
       proof (rule integral_dominated_convergence)
         show "integrable M (\<lambda>x. 2 * norm (f (g x)))"
           using lim by (auto simp: integrable_distr_eq)
         show "AE x in M. (\<lambda>i. s i (g x)) \<longlonglongrightarrow> f (g x)"
           using lim(3) g[THEN measurable_space] by auto
         show "\<And>i. AE x in M. norm (s i (g x)) \<le> 2 * norm (f (g x))"
           using lim(4) g[THEN measurable_space] by auto
       qed auto
       show "(\<lambda>i. integral\<^sup>L M (\<lambda>x. s i (g x))) \<longlonglongrightarrow> integral\<^sup>L (distr M N g) f"
         unfolding lim(2)[symmetric]
         by (rule integral_dominated_convergence[where w="\<lambda>x. 2 * norm (f x)"])
            (insert lim(3-5), auto)
     qed
   qed
 qed (simp add: f g integrable_distr_eq)
 
 lemma has_bochner_integral_distr:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "f \<in> borel_measurable N \<Longrightarrow> g \<in> measurable M N \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. f (g x)) x \<Longrightarrow> has_bochner_integral (distr M N g) f x"
   by (simp add: has_bochner_integral_iff integrable_distr_eq integral_distr)
 
 subsection \<open>Lebesgue integration on \<^const>\<open>count_space\<close>\<close>
 
 lemma integrable_count_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach,second_countable_topology}"
   shows "finite X \<Longrightarrow> integrable (count_space X) f"
   by (auto simp: nn_integral_count_space integrable_iff_bounded)
 
 lemma measure_count_space[simp]:
   "B \<subseteq> A \<Longrightarrow> finite B \<Longrightarrow> measure (count_space A) B = card B"
   unfolding measure_def by (subst emeasure_count_space ) auto
 
 lemma lebesgue_integral_count_space_finite_support:
   assumes f: "finite {a\<in>A. f a \<noteq> 0}"
   shows "(\<integral>x. f x \<partial>count_space A) = (\<Sum>a | a \<in> A \<and> f a \<noteq> 0. f a)"
 proof -
   have eq: "\<And>x. x \<in> A \<Longrightarrow> (\<Sum>a | x = a \<and> a \<in> A \<and> f a \<noteq> 0. f a) = (\<Sum>x\<in>{x}. f x)"
     by (intro sum.mono_neutral_cong_left) auto
 
   have "(\<integral>x. f x \<partial>count_space A) = (\<integral>x. (\<Sum>a | a \<in> A \<and> f a \<noteq> 0. indicator {a} x *\<^sub>R f a) \<partial>count_space A)"
     by (intro integral_cong refl) (simp add: f eq)
   also have "\<dots> = (\<Sum>a | a \<in> A \<and> f a \<noteq> 0. measure (count_space A) {a} *\<^sub>R f a)"
     by (subst integral_sum) (auto intro!: sum.cong)
   finally show ?thesis
     by auto
 qed
 
 lemma lebesgue_integral_count_space_finite: "finite A \<Longrightarrow> (\<integral>x. f x \<partial>count_space A) = (\<Sum>a\<in>A. f a)"
   by (subst lebesgue_integral_count_space_finite_support)
      (auto intro!: sum.mono_neutral_cong_left)
 
 lemma integrable_count_space_nat_iff:
   fixes f :: "nat \<Rightarrow> _::{banach,second_countable_topology}"
   shows "integrable (count_space UNIV) f \<longleftrightarrow> summable (\<lambda>x. norm (f x))"
   by (auto simp add: integrable_iff_bounded nn_integral_count_space_nat ennreal_suminf_neq_top
            intro:  summable_suminf_not_top)
 
 lemma sums_integral_count_space_nat:
   fixes f :: "nat \<Rightarrow> _::{banach,second_countable_topology}"
   assumes *: "integrable (count_space UNIV) f"
   shows "f sums (integral\<^sup>L (count_space UNIV) f)"
 proof -
   let ?f = "\<lambda>n i. indicator {n} i *\<^sub>R f i"
   have f': "\<And>n i. ?f n i = indicator {n} i *\<^sub>R f n"
     by (auto simp: fun_eq_iff split: split_indicator)
 
   have "(\<lambda>i. \<integral>n. ?f i n \<partial>count_space UNIV) sums \<integral> n. (\<Sum>i. ?f i n) \<partial>count_space UNIV"
   proof (rule sums_integral)
     show "\<And>i. integrable (count_space UNIV) (?f i)"
       using * by (intro integrable_mult_indicator) auto
     show "AE n in count_space UNIV. summable (\<lambda>i. norm (?f i n))"
       using summable_finite[of "{n}" "\<lambda>i. norm (?f i n)" for n] by simp
     show "summable (\<lambda>i. \<integral> n. norm (?f i n) \<partial>count_space UNIV)"
       using * by (subst f') (simp add: integrable_count_space_nat_iff)
   qed
   also have "(\<integral> n. (\<Sum>i. ?f i n) \<partial>count_space UNIV) = (\<integral>n. f n \<partial>count_space UNIV)"
     using suminf_finite[of "{n}" "\<lambda>i. ?f i n" for n] by (auto intro!: integral_cong)
   also have "(\<lambda>i. \<integral>n. ?f i n \<partial>count_space UNIV) = f"
     by (subst f') simp
   finally show ?thesis .
 qed
 
 lemma integral_count_space_nat:
   fixes f :: "nat \<Rightarrow> _::{banach,second_countable_topology}"
   shows "integrable (count_space UNIV) f \<Longrightarrow> integral\<^sup>L (count_space UNIV) f = (\<Sum>x. f x)"
   using sums_integral_count_space_nat by (rule sums_unique)
 
 lemma integrable_bij_count_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes g: "bij_betw g A B"
   shows "integrable (count_space A) (\<lambda>x. f (g x)) \<longleftrightarrow> integrable (count_space B) f"
   unfolding integrable_iff_bounded by (subst nn_integral_bij_count_space[OF g]) auto
 
 lemma integral_bij_count_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes g: "bij_betw g A B"
   shows "integral\<^sup>L (count_space A) (\<lambda>x. f (g x)) = integral\<^sup>L (count_space B) f"
   using g[THEN bij_betw_imp_funcset]
   apply (subst distr_bij_count_space[OF g, symmetric])
   apply (intro integral_distr[symmetric])
   apply auto
   done
 
 lemma has_bochner_integral_count_space_nat:
   fixes f :: "nat \<Rightarrow> _::{banach,second_countable_topology}"
   shows "has_bochner_integral (count_space UNIV) f x \<Longrightarrow> f sums x"
   unfolding has_bochner_integral_iff by (auto intro!: sums_integral_count_space_nat)
 
 subsection \<open>Point measure\<close>
 
 lemma lebesgue_integral_point_measure_finite:
   fixes g :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "finite A \<Longrightarrow> (\<And>a. a \<in> A \<Longrightarrow> 0 \<le> f a) \<Longrightarrow>
     integral\<^sup>L (point_measure A f) g = (\<Sum>a\<in>A. f a *\<^sub>R g a)"
   by (simp add: lebesgue_integral_count_space_finite AE_count_space integral_density point_measure_def)
 
 proposition integrable_point_measure_finite:
   fixes g :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and f :: "'a \<Rightarrow> real"
   shows "finite A \<Longrightarrow> integrable (point_measure A f) g"
   unfolding point_measure_def
   apply (subst density_cong[where f'="\<lambda>x. ennreal (max 0 (f x))"])
   apply (auto split: split_max simp: ennreal_neg)
   apply (subst integrable_density)
   apply (auto simp: AE_count_space integrable_count_space)
   done
 
 subsection \<open>Lebesgue integration on \<^const>\<open>null_measure\<close>\<close>
 
 lemma has_bochner_integral_null_measure_iff[iff]:
   "has_bochner_integral (null_measure M) f 0 \<longleftrightarrow> f \<in> borel_measurable M"
   by (auto simp add: has_bochner_integral.simps simple_bochner_integral_def[abs_def]
            intro!: exI[of _ "\<lambda>n x. 0"] simple_bochner_integrable.intros)
 
 lemma integrable_null_measure_iff[iff]: "integrable (null_measure M) f \<longleftrightarrow> f \<in> borel_measurable M"
   by (auto simp add: integrable.simps)
 
 lemma integral_null_measure[simp]: "integral\<^sup>L (null_measure M) f = 0"
   by (cases "integrable (null_measure M) f")
      (auto simp add: not_integrable_integral_eq has_bochner_integral_integral_eq)
 
 subsection \<open>Legacy lemmas for the real-valued Lebesgue integral\<close>
 theorem real_lebesgue_integral_def:
   assumes f[measurable]: "integrable M f"
   shows "integral\<^sup>L M f = enn2real (\<integral>\<^sup>+x. f x \<partial>M) - enn2real (\<integral>\<^sup>+x. ennreal (- f x) \<partial>M)"
 proof -
   have "integral\<^sup>L M f = integral\<^sup>L M (\<lambda>x. max 0 (f x) - max 0 (- f x))"
     by (auto intro!: arg_cong[where f="integral\<^sup>L M"])
   also have "\<dots> = integral\<^sup>L M (\<lambda>x. max 0 (f x)) - integral\<^sup>L M (\<lambda>x. max 0 (- f x))"
     by (intro integral_diff integrable_max integrable_minus integrable_zero f)
   also have "integral\<^sup>L M (\<lambda>x. max 0 (f x)) = enn2real (\<integral>\<^sup>+x. ennreal (f x) \<partial>M)"
     by (subst integral_eq_nn_integral) (auto intro!: arg_cong[where f=enn2real] nn_integral_cong simp: max_def ennreal_neg)
   also have "integral\<^sup>L M (\<lambda>x. max 0 (- f x)) = enn2real (\<integral>\<^sup>+x. ennreal (- f x) \<partial>M)"
     by (subst integral_eq_nn_integral) (auto intro!: arg_cong[where f=enn2real] nn_integral_cong simp: max_def ennreal_neg)
   finally show ?thesis .
 qed
 
 theorem real_integrable_def:
   "integrable M f \<longleftrightarrow> f \<in> borel_measurable M \<and>
     (\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<noteq> \<infinity> \<and> (\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M) \<noteq> \<infinity>"
   unfolding integrable_iff_bounded
 proof (safe del: notI)
   assume *: "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>"
   have "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M)"
     by (intro nn_integral_mono) auto
   also note *
   finally show "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<noteq> \<infinity>"
     by simp
   have "(\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M)"
     by (intro nn_integral_mono) auto
   also note *
   finally show "(\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M) \<noteq> \<infinity>"
     by simp
 next
   assume [measurable]: "f \<in> borel_measurable M"
   assume fin: "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<noteq> \<infinity>" "(\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M) \<noteq> \<infinity>"
   have "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) = (\<integral>\<^sup>+ x. ennreal (f x) + ennreal (- f x) \<partial>M)"
     by (intro nn_integral_cong) (auto simp: abs_real_def ennreal_neg)
   also have"\<dots> = (\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) + (\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M)"
     by (intro nn_integral_add) auto
   also have "\<dots> < \<infinity>"
     using fin by (auto simp: less_top)
   finally show "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) < \<infinity>" .
 qed
 
 lemma integrableD[dest]:
   assumes "integrable M f"
   shows "f \<in> borel_measurable M" "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<noteq> \<infinity>" "(\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M) \<noteq> \<infinity>"
   using assms unfolding real_integrable_def by auto
 
 lemma integrableE:
   assumes "integrable M f"
   obtains r q where "0 \<le> r" "0 \<le> q"
     "(\<integral>\<^sup>+x. ennreal (f x)\<partial>M) = ennreal r"
     "(\<integral>\<^sup>+x. ennreal (-f x)\<partial>M) = ennreal q"
     "f \<in> borel_measurable M" "integral\<^sup>L M f = r - q"
   using assms unfolding real_integrable_def real_lebesgue_integral_def[OF assms]
   by (cases rule: ennreal2_cases[of "(\<integral>\<^sup>+x. ennreal (-f x)\<partial>M)" "(\<integral>\<^sup>+x. ennreal (f x)\<partial>M)"]) auto
 
 lemma integral_monotone_convergence_nonneg:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> real"
   assumes i: "\<And>i. integrable M (f i)" and mono: "AE x in M. mono (\<lambda>n. f n x)"
     and pos: "\<And>i. AE x in M. 0 \<le> f i x"
     and lim: "AE x in M. (\<lambda>i. f i x) \<longlonglongrightarrow> u x"
     and ilim: "(\<lambda>i. integral\<^sup>L M (f i)) \<longlonglongrightarrow> x"
     and u: "u \<in> borel_measurable M"
   shows "integrable M u"
   and "integral\<^sup>L M u = x"
 proof -
   have nn: "AE x in M. \<forall>i. 0 \<le> f i x"
     using pos unfolding AE_all_countable by auto
   with lim have u_nn: "AE x in M. 0 \<le> u x"
     by eventually_elim (auto intro: LIMSEQ_le_const)
   have [simp]: "0 \<le> x"
     by (intro LIMSEQ_le_const[OF ilim] allI exI impI integral_nonneg_AE pos)
   have "(\<integral>\<^sup>+ x. ennreal (u x) \<partial>M) = (SUP n. (\<integral>\<^sup>+ x. ennreal (f n x) \<partial>M))"
   proof (subst nn_integral_monotone_convergence_SUP_AE[symmetric])
     fix i
     from mono nn show "AE x in M. ennreal (f i x) \<le> ennreal (f (Suc i) x)"
       by eventually_elim (auto simp: mono_def)
     show "(\<lambda>x. ennreal (f i x)) \<in> borel_measurable M"
       using i by auto
   next
     show "(\<integral>\<^sup>+ x. ennreal (u x) \<partial>M) = \<integral>\<^sup>+ x. (SUP i. ennreal (f i x)) \<partial>M"
       apply (rule nn_integral_cong_AE)
       using lim mono nn u_nn
       apply eventually_elim
       apply (simp add: LIMSEQ_unique[OF _ LIMSEQ_SUP] incseq_def)
       done
   qed
   also have "\<dots> = ennreal x"
     using mono i nn unfolding nn_integral_eq_integral[OF i pos]
     by (subst LIMSEQ_unique[OF LIMSEQ_SUP]) (auto simp: mono_def integral_nonneg_AE pos intro!: integral_mono_AE ilim)
   finally have "(\<integral>\<^sup>+ x. ennreal (u x) \<partial>M) = ennreal x" .
   moreover have "(\<integral>\<^sup>+ x. ennreal (- u x) \<partial>M) = 0"
     using u u_nn by (subst nn_integral_0_iff_AE) (auto simp add: ennreal_neg)
   ultimately show "integrable M u" "integral\<^sup>L M u = x"
     by (auto simp: real_integrable_def real_lebesgue_integral_def u)
 qed
 
 lemma
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> real"
   assumes f: "\<And>i. integrable M (f i)" and mono: "AE x in M. mono (\<lambda>n. f n x)"
   and lim: "AE x in M. (\<lambda>i. f i x) \<longlonglongrightarrow> u x"
   and ilim: "(\<lambda>i. integral\<^sup>L M (f i)) \<longlonglongrightarrow> x"
   and u: "u \<in> borel_measurable M"
   shows integrable_monotone_convergence: "integrable M u"
     and integral_monotone_convergence: "integral\<^sup>L M u = x"
     and has_bochner_integral_monotone_convergence: "has_bochner_integral M u x"
 proof -
   have 1: "\<And>i. integrable M (\<lambda>x. f i x - f 0 x)"
     using f by auto
   have 2: "AE x in M. mono (\<lambda>n. f n x - f 0 x)"
     using mono by (auto simp: mono_def le_fun_def)
   have 3: "\<And>n. AE x in M. 0 \<le> f n x - f 0 x"
     using mono by (auto simp: field_simps mono_def le_fun_def)
   have 4: "AE x in M. (\<lambda>i. f i x - f 0 x) \<longlonglongrightarrow> u x - f 0 x"
     using lim by (auto intro!: tendsto_diff)
   have 5: "(\<lambda>i. (\<integral>x. f i x - f 0 x \<partial>M)) \<longlonglongrightarrow> x - integral\<^sup>L M (f 0)"
     using f ilim by (auto intro!: tendsto_diff)
   have 6: "(\<lambda>x. u x - f 0 x) \<in> borel_measurable M"
     using f[of 0] u by auto
   note diff = integral_monotone_convergence_nonneg[OF 1 2 3 4 5 6]
   have "integrable M (\<lambda>x. (u x - f 0 x) + f 0 x)"
     using diff(1) f by (rule integrable_add)
   with diff(2) f show "integrable M u" "integral\<^sup>L M u = x"
     by auto
   then show "has_bochner_integral M u x"
     by (metis has_bochner_integral_integrable)
 qed
 
 lemma integral_norm_eq_0_iff:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes f[measurable]: "integrable M f"
   shows "(\<integral>x. norm (f x) \<partial>M) = 0 \<longleftrightarrow> emeasure M {x\<in>space M. f x \<noteq> 0} = 0"
 proof -
   have "(\<integral>\<^sup>+x. norm (f x) \<partial>M) = (\<integral>x. norm (f x) \<partial>M)"
     using f by (intro nn_integral_eq_integral integrable_norm) auto
   then have "(\<integral>x. norm (f x) \<partial>M) = 0 \<longleftrightarrow> (\<integral>\<^sup>+x. norm (f x) \<partial>M) = 0"
     by simp
   also have "\<dots> \<longleftrightarrow> emeasure M {x\<in>space M. ennreal (norm (f x)) \<noteq> 0} = 0"
     by (intro nn_integral_0_iff) auto
   finally show ?thesis
     by simp
 qed
 
 lemma integral_0_iff:
   fixes f :: "'a \<Rightarrow> real"
   shows "integrable M f \<Longrightarrow> (\<integral>x. \<bar>f x\<bar> \<partial>M) = 0 \<longleftrightarrow> emeasure M {x\<in>space M. f x \<noteq> 0} = 0"
   using integral_norm_eq_0_iff[of M f] by simp
 
 lemma (in finite_measure) integrable_const[intro!, simp]: "integrable M (\<lambda>x. a)"
   using integrable_indicator[of "space M" M a] by (simp cong: integrable_cong add: less_top[symmetric])
 
 lemma lebesgue_integral_const[simp]:
   fixes a :: "'a :: {banach, second_countable_topology}"
   shows "(\<integral>x. a \<partial>M) = measure M (space M) *\<^sub>R a"
 proof -
   { assume "emeasure M (space M) = \<infinity>" "a \<noteq> 0"
     then have ?thesis
       by (auto simp add: not_integrable_integral_eq ennreal_mult_less_top measure_def integrable_iff_bounded) }
   moreover
   { assume "a = 0" then have ?thesis by simp }
   moreover
   { assume "emeasure M (space M) \<noteq> \<infinity>"
     interpret finite_measure M
       proof qed fact
     have "(\<integral>x. a \<partial>M) = (\<integral>x. indicator (space M) x *\<^sub>R a \<partial>M)"
       by (intro integral_cong) auto
     also have "\<dots> = measure M (space M) *\<^sub>R a"
       by (simp add: less_top[symmetric])
     finally have ?thesis . }
   ultimately show ?thesis by blast
 qed
 
 lemma (in finite_measure) integrable_const_bound:
   fixes f :: "'a \<Rightarrow> 'b::{banach,second_countable_topology}"
   shows "AE x in M. norm (f x) \<le> B \<Longrightarrow> f \<in> borel_measurable M \<Longrightarrow> integrable M f"
   apply (rule integrable_bound[OF integrable_const[of B], of f])
   apply assumption
   apply (cases "0 \<le> B")
   apply auto
   done
 
 lemma (in finite_measure) integral_bounded_eq_bound_then_AE:
   assumes "AE x in M. f x \<le> (c::real)"
     "integrable M f" "(\<integral>x. f x \<partial>M) = c * measure M (space M)"
   shows "AE x in M. f x = c"
   apply (rule integral_ineq_eq_0_then_AE) using assms by auto
 
 lemma integral_indicator_finite_real:
   fixes f :: "'a \<Rightarrow> real"
   assumes [simp]: "finite A"
   assumes [measurable]: "\<And>a. a \<in> A \<Longrightarrow> {a} \<in> sets M"
   assumes finite: "\<And>a. a \<in> A \<Longrightarrow> emeasure M {a} < \<infinity>"
   shows "(\<integral>x. f x * indicator A x \<partial>M) = (\<Sum>a\<in>A. f a * measure M {a})"
 proof -
   have "(\<integral>x. f x * indicator A x \<partial>M) = (\<integral>x. (\<Sum>a\<in>A. f a * indicator {a} x) \<partial>M)"
   proof (intro integral_cong refl)
     fix x show "f x * indicator A x = (\<Sum>a\<in>A. f a * indicator {a} x)"
       by (auto split: split_indicator simp: eq_commute[of x] cong: conj_cong)
   qed
   also have "\<dots> = (\<Sum>a\<in>A. f a * measure M {a})"
     using finite by (subst integral_sum) (auto)
   finally show ?thesis .
 qed
 
 lemma (in finite_measure) ennreal_integral_real:
   assumes [measurable]: "f \<in> borel_measurable M"
   assumes ae: "AE x in M. f x \<le> ennreal B" "0 \<le> B"
   shows "ennreal (\<integral>x. enn2real (f x) \<partial>M) = (\<integral>\<^sup>+x. f x \<partial>M)"
 proof (subst nn_integral_eq_integral[symmetric])
   show "integrable M (\<lambda>x. enn2real (f x))"
     using ae by (intro integrable_const_bound[where B=B]) (auto simp: enn2real_leI)
   show "(\<integral>\<^sup>+ x. ennreal (enn2real (f x)) \<partial>M) = integral\<^sup>N M f"
     using ae by (intro nn_integral_cong_AE) (auto simp: le_less_trans[OF _ ennreal_less_top])
 qed auto
 
 lemma (in finite_measure) integral_less_AE:
   fixes X Y :: "'a \<Rightarrow> real"
   assumes int: "integrable M X" "integrable M Y"
   assumes A: "(emeasure M) A \<noteq> 0" "A \<in> sets M" "AE x in M. x \<in> A \<longrightarrow> X x \<noteq> Y x"
   assumes gt: "AE x in M. X x \<le> Y x"
   shows "integral\<^sup>L M X < integral\<^sup>L M Y"
 proof -
   have "integral\<^sup>L M X \<le> integral\<^sup>L M Y"
     using gt int by (intro integral_mono_AE) auto
   moreover
   have "integral\<^sup>L M X \<noteq> integral\<^sup>L M Y"
   proof
     assume eq: "integral\<^sup>L M X = integral\<^sup>L M Y"
     have "integral\<^sup>L M (\<lambda>x. \<bar>Y x - X x\<bar>) = integral\<^sup>L M (\<lambda>x. Y x - X x)"
       using gt int by (intro integral_cong_AE) auto
     also have "\<dots> = 0"
       using eq int by simp
     finally have "(emeasure M) {x \<in> space M. Y x - X x \<noteq> 0} = 0"
       using int by (simp add: integral_0_iff)
     moreover
     have "(\<integral>\<^sup>+x. indicator A x \<partial>M) \<le> (\<integral>\<^sup>+x. indicator {x \<in> space M. Y x - X x \<noteq> 0} x \<partial>M)"
       using A by (intro nn_integral_mono_AE) auto
     then have "(emeasure M) A \<le> (emeasure M) {x \<in> space M. Y x - X x \<noteq> 0}"
       using int A by (simp add: integrable_def)
     ultimately have "emeasure M A = 0"
       by simp
     with \<open>(emeasure M) A \<noteq> 0\<close> show False by auto
   qed
   ultimately show ?thesis by auto
 qed
 
 lemma (in finite_measure) integral_less_AE_space:
   fixes X Y :: "'a \<Rightarrow> real"
   assumes int: "integrable M X" "integrable M Y"
   assumes gt: "AE x in M. X x < Y x" "emeasure M (space M) \<noteq> 0"
   shows "integral\<^sup>L M X < integral\<^sup>L M Y"
   using gt by (intro integral_less_AE[OF int, where A="space M"]) auto
 
 lemma tendsto_integral_at_top:
   fixes f :: "real \<Rightarrow> 'a::{banach, second_countable_topology}"
   assumes [measurable_cong]: "sets M = sets borel" and f[measurable]: "integrable M f"
   shows "((\<lambda>y. \<integral> x. indicator {.. y} x *\<^sub>R f x \<partial>M) \<longlongrightarrow> \<integral> x. f x \<partial>M) at_top"
 proof (rule tendsto_at_topI_sequentially)
   fix X :: "nat \<Rightarrow> real" assume "filterlim X at_top sequentially"
   show "(\<lambda>n. \<integral>x. indicator {..X n} x *\<^sub>R f x \<partial>M) \<longlonglongrightarrow> integral\<^sup>L M f"
   proof (rule integral_dominated_convergence)
     show "integrable M (\<lambda>x. norm (f x))"
       by (rule integrable_norm) fact
     show "AE x in M. (\<lambda>n. indicator {..X n} x *\<^sub>R f x) \<longlonglongrightarrow> f x"
     proof
       fix x
       from \<open>filterlim X at_top sequentially\<close>
       have "eventually (\<lambda>n. x \<le> X n) sequentially"
         unfolding filterlim_at_top_ge[where c=x] by auto
       then show "(\<lambda>n. indicator {..X n} x *\<^sub>R f x) \<longlonglongrightarrow> f x"
         by (intro tendsto_eventually) (auto split: split_indicator elim!: eventually_mono)
     qed
     fix n show "AE x in M. norm (indicator {..X n} x *\<^sub>R f x) \<le> norm (f x)"
       by (auto split: split_indicator)
   qed auto
 qed
 
 lemma
   fixes f :: "real \<Rightarrow> real"
   assumes M: "sets M = sets borel"
   assumes nonneg: "AE x in M. 0 \<le> f x"
   assumes borel: "f \<in> borel_measurable borel"
   assumes int: "\<And>y. integrable M (\<lambda>x. f x * indicator {.. y} x)"
   assumes conv: "((\<lambda>y. \<integral> x. f x * indicator {.. y} x \<partial>M) \<longlongrightarrow> x) at_top"
   shows has_bochner_integral_monotone_convergence_at_top: "has_bochner_integral M f x"
     and integrable_monotone_convergence_at_top: "integrable M f"
     and integral_monotone_convergence_at_top:"integral\<^sup>L M f = x"
 proof -
   from nonneg have "AE x in M. mono (\<lambda>n::nat. f x * indicator {..real n} x)"
     by (auto split: split_indicator intro!: monoI)
   { fix x have "eventually (\<lambda>n. f x * indicator {..real n} x = f x) sequentially"
       by (rule eventually_sequentiallyI[of "nat \<lceil>x\<rceil>"])
          (auto split: split_indicator simp: nat_le_iff ceiling_le_iff) }
   from filterlim_cong[OF refl refl this]
   have "AE x in M. (\<lambda>i. f x * indicator {..real i} x) \<longlonglongrightarrow> f x"
     by simp
   have "(\<lambda>i. \<integral> x. f x * indicator {..real i} x \<partial>M) \<longlonglongrightarrow> x"
     using conv filterlim_real_sequentially by (rule filterlim_compose)
   have M_measure[simp]: "borel_measurable M = borel_measurable borel"
     using M by (simp add: sets_eq_imp_space_eq measurable_def)
   have "f \<in> borel_measurable M"
     using borel by simp
   show "has_bochner_integral M f x"
     by (rule has_bochner_integral_monotone_convergence) fact+
   then show "integrable M f" "integral\<^sup>L M f = x"
     by (auto simp: _has_bochner_integral_iff)
 qed
 
 subsection \<open>Product measure\<close>
 
 lemma (in sigma_finite_measure) borel_measurable_lebesgue_integrable[measurable (raw)]:
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes [measurable]: "case_prod f \<in> borel_measurable (N \<Otimes>\<^sub>M M)"
   shows "Measurable.pred N (\<lambda>x. integrable M (f x))"
 proof -
   have [simp]: "\<And>x. x \<in> space N \<Longrightarrow> integrable M (f x) \<longleftrightarrow> (\<integral>\<^sup>+y. norm (f x y) \<partial>M) < \<infinity>"
     unfolding integrable_iff_bounded by simp
   show ?thesis
     by (simp cong: measurable_cong)
 qed
 
 lemma (in sigma_finite_measure) measurable_measure[measurable (raw)]:
   "(\<And>x. x \<in> space N \<Longrightarrow> A x \<subseteq> space M) \<Longrightarrow>
     {x \<in> space (N \<Otimes>\<^sub>M M). snd x \<in> A (fst x)} \<in> sets (N \<Otimes>\<^sub>M M) \<Longrightarrow>
     (\<lambda>x. measure M (A x)) \<in> borel_measurable N"
   unfolding measure_def by (intro measurable_emeasure borel_measurable_enn2real) auto
 
 proposition (in sigma_finite_measure) borel_measurable_lebesgue_integral[measurable (raw)]:
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "case_prod f \<in> borel_measurable (N \<Otimes>\<^sub>M M)"
   shows "(\<lambda>x. \<integral>y. f x y \<partial>M) \<in> borel_measurable N"
 proof -
-  from borel_measurable_implies_sequence_metric[OF f, of 0] guess s ..
-  then have s: "\<And>i. simple_function (N \<Otimes>\<^sub>M M) (s i)"
+  from borel_measurable_implies_sequence_metric[OF f, of 0]
+  obtain s where s: "\<And>i. simple_function (N \<Otimes>\<^sub>M M) (s i)"
+    and "\<forall>x\<in>space (N \<Otimes>\<^sub>M M). (\<lambda>i. s i x) \<longlonglongrightarrow> (case x of (x, y) \<Rightarrow> f x y)"
+    and "\<forall>i. \<forall>x\<in>space (N \<Otimes>\<^sub>M M). dist (s i x) 0 \<le> 2 * dist (case x of (x, xa) \<Rightarrow> f x xa) 0"
+    by auto
+  then have *:
     "\<And>x y. x \<in> space N \<Longrightarrow> y \<in> space M \<Longrightarrow> (\<lambda>i. s i (x, y)) \<longlonglongrightarrow> f x y"
     "\<And>i x y. x \<in> space N \<Longrightarrow> y \<in> space M \<Longrightarrow> norm (s i (x, y)) \<le> 2 * norm (f x y)"
     by (auto simp: space_pair_measure)
 
   have [measurable]: "\<And>i. s i \<in> borel_measurable (N \<Otimes>\<^sub>M M)"
     by (rule borel_measurable_simple_function) fact
 
   have "\<And>i. s i \<in> measurable (N \<Otimes>\<^sub>M M) (count_space UNIV)"
     by (rule measurable_simple_function) fact
 
   define f' where [abs_def]: "f' i x =
     (if integrable M (f x) then simple_bochner_integral M (\<lambda>y. s i (x, y)) else 0)" for i x
 
   { fix i x assume "x \<in> space N"
     then have "simple_bochner_integral M (\<lambda>y. s i (x, y)) =
       (\<Sum>z\<in>s i ` (space N \<times> space M). measure M {y \<in> space M. s i (x, y) = z} *\<^sub>R z)"
-      using s(1)[THEN simple_functionD(1)]
+      using s[THEN simple_functionD(1)]
       unfolding simple_bochner_integral_def
       by (intro sum.mono_neutral_cong_left)
          (auto simp: eq_commute space_pair_measure image_iff cong: conj_cong) }
   note eq = this
 
   show ?thesis
   proof (rule borel_measurable_LIMSEQ_metric)
     fix i show "f' i \<in> borel_measurable N"
       unfolding f'_def by (simp_all add: eq cong: measurable_cong if_cong)
   next
     fix x assume x: "x \<in> space N"
     { assume int_f: "integrable M (f x)"
       have int_2f: "integrable M (\<lambda>y. 2 * norm (f x y))"
         by (intro integrable_norm integrable_mult_right int_f)
       have "(\<lambda>i. integral\<^sup>L M (\<lambda>y. s i (x, y))) \<longlonglongrightarrow> integral\<^sup>L M (f x)"
       proof (rule integral_dominated_convergence)
         from int_f show "f x \<in> borel_measurable M" by auto
         show "\<And>i. (\<lambda>y. s i (x, y)) \<in> borel_measurable M"
           using x by simp
         show "AE xa in M. (\<lambda>i. s i (x, xa)) \<longlonglongrightarrow> f x xa"
-          using x s(2) by auto
+          using x * by auto
         show "\<And>i. AE xa in M. norm (s i (x, xa)) \<le> 2 * norm (f x xa)"
-          using x s(3) by auto
+          using x * by auto
       qed fact
       moreover
       { fix i
         have "simple_bochner_integrable M (\<lambda>y. s i (x, y))"
         proof (rule simple_bochner_integrableI_bounded)
           have "(\<lambda>y. s i (x, y)) ` space M \<subseteq> s i ` (space N \<times> space M)"
             using x by auto
           then show "simple_function M (\<lambda>y. s i (x, y))"
             using simple_functionD(1)[OF s(1), of i] x
             by (intro simple_function_borel_measurable)
                (auto simp: space_pair_measure dest: finite_subset)
           have "(\<integral>\<^sup>+ y. ennreal (norm (s i (x, y))) \<partial>M) \<le> (\<integral>\<^sup>+ y. 2 * norm (f x y) \<partial>M)"
-            using x s by (intro nn_integral_mono) auto
+            using x * by (intro nn_integral_mono) auto
           also have "(\<integral>\<^sup>+ y. 2 * norm (f x y) \<partial>M) < \<infinity>"
             using int_2f unfolding integrable_iff_bounded by simp
           finally show "(\<integral>\<^sup>+ xa. ennreal (norm (s i (x, xa))) \<partial>M) < \<infinity>" .
         qed
         then have "integral\<^sup>L M (\<lambda>y. s i (x, y)) = simple_bochner_integral M (\<lambda>y. s i (x, y))"
           by (rule simple_bochner_integrable_eq_integral[symmetric]) }
       ultimately have "(\<lambda>i. simple_bochner_integral M (\<lambda>y. s i (x, y))) \<longlonglongrightarrow> integral\<^sup>L M (f x)"
         by simp }
     then
     show "(\<lambda>i. f' i x) \<longlonglongrightarrow> integral\<^sup>L M (f x)"
       unfolding f'_def
       by (cases "integrable M (f x)") (simp_all add: not_integrable_integral_eq)
   qed
 qed
 
 lemma (in pair_sigma_finite) integrable_product_swap:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes "integrable (M1 \<Otimes>\<^sub>M M2) f"
   shows "integrable (M2 \<Otimes>\<^sub>M M1) (\<lambda>(x,y). f (y,x))"
 proof -
   interpret Q: pair_sigma_finite M2 M1 ..
   have *: "(\<lambda>(x,y). f (y,x)) = (\<lambda>x. f (case x of (x,y)\<Rightarrow>(y,x)))" by (auto simp: fun_eq_iff)
   show ?thesis unfolding *
     by (rule integrable_distr[OF measurable_pair_swap'])
        (simp add: distr_pair_swap[symmetric] assms)
 qed
 
 lemma (in pair_sigma_finite) integrable_product_swap_iff:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   shows "integrable (M2 \<Otimes>\<^sub>M M1) (\<lambda>(x,y). f (y,x)) \<longleftrightarrow> integrable (M1 \<Otimes>\<^sub>M M2) f"
 proof -
   interpret Q: pair_sigma_finite M2 M1 ..
   from Q.integrable_product_swap[of "\<lambda>(x,y). f (y,x)"] integrable_product_swap[of f]
   show ?thesis by auto
 qed
 
 lemma (in pair_sigma_finite) integral_product_swap:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
   shows "(\<integral>(x,y). f (y,x) \<partial>(M2 \<Otimes>\<^sub>M M1)) = integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) f"
 proof -
   have *: "(\<lambda>(x,y). f (y,x)) = (\<lambda>x. f (case x of (x,y)\<Rightarrow>(y,x)))" by (auto simp: fun_eq_iff)
   show ?thesis unfolding *
     by (simp add: integral_distr[symmetric, OF measurable_pair_swap' f] distr_pair_swap[symmetric])
 qed
 
 theorem (in pair_sigma_finite) Fubini_integrable:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
     and integ1: "integrable M1 (\<lambda>x. \<integral> y. norm (f (x, y)) \<partial>M2)"
     and integ2: "AE x in M1. integrable M2 (\<lambda>y. f (x, y))"
   shows "integrable (M1 \<Otimes>\<^sub>M M2) f"
 proof (rule integrableI_bounded)
   have "(\<integral>\<^sup>+ p. norm (f p) \<partial>(M1 \<Otimes>\<^sub>M M2)) = (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. norm (f (x, y)) \<partial>M2) \<partial>M1)"
     by (simp add: M2.nn_integral_fst [symmetric])
   also have "\<dots> = (\<integral>\<^sup>+ x. \<bar>\<integral>y. norm (f (x, y)) \<partial>M2\<bar> \<partial>M1)"
     apply (intro nn_integral_cong_AE)
     using integ2
   proof eventually_elim
     fix x assume "integrable M2 (\<lambda>y. f (x, y))"
     then have f: "integrable M2 (\<lambda>y. norm (f (x, y)))"
       by simp
     then have "(\<integral>\<^sup>+y. ennreal (norm (f (x, y))) \<partial>M2) = ennreal (LINT y|M2. norm (f (x, y)))"
       by (rule nn_integral_eq_integral) simp
     also have "\<dots> = ennreal \<bar>LINT y|M2. norm (f (x, y))\<bar>"
       using f by simp
     finally show "(\<integral>\<^sup>+y. ennreal (norm (f (x, y))) \<partial>M2) = ennreal \<bar>LINT y|M2. norm (f (x, y))\<bar>" .
   qed
   also have "\<dots> < \<infinity>"
     using integ1 by (simp add: integrable_iff_bounded integral_nonneg_AE)
   finally show "(\<integral>\<^sup>+ p. norm (f p) \<partial>(M1 \<Otimes>\<^sub>M M2)) < \<infinity>" .
 qed fact
 
 lemma (in pair_sigma_finite) emeasure_pair_measure_finite:
   assumes A: "A \<in> sets (M1 \<Otimes>\<^sub>M M2)" and finite: "emeasure (M1 \<Otimes>\<^sub>M M2) A < \<infinity>"
   shows "AE x in M1. emeasure M2 {y\<in>space M2. (x, y) \<in> A} < \<infinity>"
 proof -
   from M2.emeasure_pair_measure_alt[OF A] finite
   have "(\<integral>\<^sup>+ x. emeasure M2 (Pair x -` A) \<partial>M1) \<noteq> \<infinity>"
     by simp
   then have "AE x in M1. emeasure M2 (Pair x -` A) \<noteq> \<infinity>"
     by (rule nn_integral_PInf_AE[rotated]) (intro M2.measurable_emeasure_Pair A)
   moreover have "\<And>x. x \<in> space M1 \<Longrightarrow> Pair x -` A = {y\<in>space M2. (x, y) \<in> A}"
     using sets.sets_into_space[OF A] by (auto simp: space_pair_measure)
   ultimately show ?thesis by (auto simp: less_top)
 qed
 
 lemma (in pair_sigma_finite) AE_integrable_fst':
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "integrable (M1 \<Otimes>\<^sub>M M2) f"
   shows "AE x in M1. integrable M2 (\<lambda>y. f (x, y))"
 proof -
   have "(\<integral>\<^sup>+x. (\<integral>\<^sup>+y. norm (f (x, y)) \<partial>M2) \<partial>M1) = (\<integral>\<^sup>+x. norm (f x) \<partial>(M1 \<Otimes>\<^sub>M M2))"
     by (rule M2.nn_integral_fst) simp
   also have "(\<integral>\<^sup>+x. norm (f x) \<partial>(M1 \<Otimes>\<^sub>M M2)) \<noteq> \<infinity>"
     using f unfolding integrable_iff_bounded by simp
   finally have "AE x in M1. (\<integral>\<^sup>+y. norm (f (x, y)) \<partial>M2) \<noteq> \<infinity>"
     by (intro nn_integral_PInf_AE M2.borel_measurable_nn_integral )
        (auto simp: measurable_split_conv)
   with AE_space show ?thesis
     by eventually_elim
        (auto simp: integrable_iff_bounded measurable_compose[OF _ borel_measurable_integrable[OF f]] less_top)
 qed
 
 lemma (in pair_sigma_finite) integrable_fst':
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "integrable (M1 \<Otimes>\<^sub>M M2) f"
   shows "integrable M1 (\<lambda>x. \<integral>y. f (x, y) \<partial>M2)"
   unfolding integrable_iff_bounded
 proof
   show "(\<lambda>x. \<integral> y. f (x, y) \<partial>M2) \<in> borel_measurable M1"
     by (rule M2.borel_measurable_lebesgue_integral) simp
   have "(\<integral>\<^sup>+ x. ennreal (norm (\<integral> y. f (x, y) \<partial>M2)) \<partial>M1) \<le> (\<integral>\<^sup>+x. (\<integral>\<^sup>+y. norm (f (x, y)) \<partial>M2) \<partial>M1)"
     using AE_integrable_fst'[OF f] by (auto intro!: nn_integral_mono_AE integral_norm_bound_ennreal)
   also have "(\<integral>\<^sup>+x. (\<integral>\<^sup>+y. norm (f (x, y)) \<partial>M2) \<partial>M1) = (\<integral>\<^sup>+x. norm (f x) \<partial>(M1 \<Otimes>\<^sub>M M2))"
     by (rule M2.nn_integral_fst) simp
   also have "(\<integral>\<^sup>+x. norm (f x) \<partial>(M1 \<Otimes>\<^sub>M M2)) < \<infinity>"
     using f unfolding integrable_iff_bounded by simp
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (\<integral> y. f (x, y) \<partial>M2)) \<partial>M1) < \<infinity>" .
 qed
 
 proposition (in pair_sigma_finite) integral_fst':
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f: "integrable (M1 \<Otimes>\<^sub>M M2) f"
   shows "(\<integral>x. (\<integral>y. f (x, y) \<partial>M2) \<partial>M1) = integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) f"
 using f proof induct
   case (base A c)
   have A[measurable]: "A \<in> sets (M1 \<Otimes>\<^sub>M M2)" by fact
 
   have eq: "\<And>x y. x \<in> space M1 \<Longrightarrow> indicator A (x, y) = indicator {y\<in>space M2. (x, y) \<in> A} y"
     using sets.sets_into_space[OF A] by (auto split: split_indicator simp: space_pair_measure)
 
   have int_A: "integrable (M1 \<Otimes>\<^sub>M M2) (indicator A :: _ \<Rightarrow> real)"
     using base by (rule integrable_real_indicator)
 
   have "(\<integral> x. \<integral> y. indicator A (x, y) *\<^sub>R c \<partial>M2 \<partial>M1) = (\<integral>x. measure M2 {y\<in>space M2. (x, y) \<in> A} *\<^sub>R c \<partial>M1)"
   proof (intro integral_cong_AE, simp, simp)
     from AE_integrable_fst'[OF int_A] AE_space
     show "AE x in M1. (\<integral>y. indicator A (x, y) *\<^sub>R c \<partial>M2) = measure M2 {y\<in>space M2. (x, y) \<in> A} *\<^sub>R c"
       by eventually_elim (simp add: eq integrable_indicator_iff)
   qed
   also have "\<dots> = measure (M1 \<Otimes>\<^sub>M M2) A *\<^sub>R c"
   proof (subst integral_scaleR_left)
     have "(\<integral>\<^sup>+x. ennreal (measure M2 {y \<in> space M2. (x, y) \<in> A}) \<partial>M1) =
       (\<integral>\<^sup>+x. emeasure M2 {y \<in> space M2. (x, y) \<in> A} \<partial>M1)"
       using emeasure_pair_measure_finite[OF base]
       by (intro nn_integral_cong_AE, eventually_elim) (simp add: emeasure_eq_ennreal_measure)
     also have "\<dots> = emeasure (M1 \<Otimes>\<^sub>M M2) A"
       using sets.sets_into_space[OF A]
       by (subst M2.emeasure_pair_measure_alt)
          (auto intro!: nn_integral_cong arg_cong[where f="emeasure M2"] simp: space_pair_measure)
     finally have *: "(\<integral>\<^sup>+x. ennreal (measure M2 {y \<in> space M2. (x, y) \<in> A}) \<partial>M1) = emeasure (M1 \<Otimes>\<^sub>M M2) A" .
 
     from base * show "integrable M1 (\<lambda>x. measure M2 {y \<in> space M2. (x, y) \<in> A})"
       by (simp add: integrable_iff_bounded)
     then have "(\<integral>x. measure M2 {y \<in> space M2. (x, y) \<in> A} \<partial>M1) =
       (\<integral>\<^sup>+x. ennreal (measure M2 {y \<in> space M2. (x, y) \<in> A}) \<partial>M1)"
       by (rule nn_integral_eq_integral[symmetric]) simp
     also note *
     finally show "(\<integral>x. measure M2 {y \<in> space M2. (x, y) \<in> A} \<partial>M1) *\<^sub>R c = measure (M1 \<Otimes>\<^sub>M M2) A *\<^sub>R c"
       using base by (simp add: emeasure_eq_ennreal_measure)
   qed
   also have "\<dots> = (\<integral> a. indicator A a *\<^sub>R c \<partial>(M1 \<Otimes>\<^sub>M M2))"
     using base by simp
   finally show ?case .
 next
   case (add f g)
   then have [measurable]: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)" "g \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
     by auto
   have "(\<integral> x. \<integral> y. f (x, y) + g (x, y) \<partial>M2 \<partial>M1) =
     (\<integral> x. (\<integral> y. f (x, y) \<partial>M2) + (\<integral> y. g (x, y) \<partial>M2) \<partial>M1)"
     apply (rule integral_cong_AE)
     apply simp_all
     using AE_integrable_fst'[OF add(1)] AE_integrable_fst'[OF add(3)]
     apply eventually_elim
     apply simp
     done
   also have "\<dots> = (\<integral> x. f x \<partial>(M1 \<Otimes>\<^sub>M M2)) + (\<integral> x. g x \<partial>(M1 \<Otimes>\<^sub>M M2))"
     using integrable_fst'[OF add(1)] integrable_fst'[OF add(3)] add(2,4) by simp
   finally show ?case
     using add by simp
 next
   case (lim f s)
   then have [measurable]: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)" "\<And>i. s i \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
     by auto
 
   show ?case
   proof (rule LIMSEQ_unique)
     show "(\<lambda>i. integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) (s i)) \<longlonglongrightarrow> integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) f"
     proof (rule integral_dominated_convergence)
       show "integrable (M1 \<Otimes>\<^sub>M M2) (\<lambda>x. 2 * norm (f x))"
         using lim(5) by auto
     qed (insert lim, auto)
     have "(\<lambda>i. \<integral> x. \<integral> y. s i (x, y) \<partial>M2 \<partial>M1) \<longlonglongrightarrow> \<integral> x. \<integral> y. f (x, y) \<partial>M2 \<partial>M1"
     proof (rule integral_dominated_convergence)
       have "AE x in M1. \<forall>i. integrable M2 (\<lambda>y. s i (x, y))"
         unfolding AE_all_countable using AE_integrable_fst'[OF lim(1)] ..
       with AE_space AE_integrable_fst'[OF lim(5)]
       show "AE x in M1. (\<lambda>i. \<integral> y. s i (x, y) \<partial>M2) \<longlonglongrightarrow> \<integral> y. f (x, y) \<partial>M2"
       proof eventually_elim
         fix x assume x: "x \<in> space M1" and
           s: "\<forall>i. integrable M2 (\<lambda>y. s i (x, y))" and f: "integrable M2 (\<lambda>y. f (x, y))"
         show "(\<lambda>i. \<integral> y. s i (x, y) \<partial>M2) \<longlonglongrightarrow> \<integral> y. f (x, y) \<partial>M2"
         proof (rule integral_dominated_convergence)
           show "integrable M2 (\<lambda>y. 2 * norm (f (x, y)))"
              using f by auto
           show "AE xa in M2. (\<lambda>i. s i (x, xa)) \<longlonglongrightarrow> f (x, xa)"
             using x lim(3) by (auto simp: space_pair_measure)
           show "\<And>i. AE xa in M2. norm (s i (x, xa)) \<le> 2 * norm (f (x, xa))"
             using x lim(4) by (auto simp: space_pair_measure)
         qed (insert x, measurable)
       qed
       show "integrable M1 (\<lambda>x. (\<integral> y. 2 * norm (f (x, y)) \<partial>M2))"
         by (intro integrable_mult_right integrable_norm integrable_fst' lim)
       fix i show "AE x in M1. norm (\<integral> y. s i (x, y) \<partial>M2) \<le> (\<integral> y. 2 * norm (f (x, y)) \<partial>M2)"
         using AE_space AE_integrable_fst'[OF lim(1), of i] AE_integrable_fst'[OF lim(5)]
       proof eventually_elim
         fix x assume x: "x \<in> space M1"
           and s: "integrable M2 (\<lambda>y. s i (x, y))" and f: "integrable M2 (\<lambda>y. f (x, y))"
         from s have "norm (\<integral> y. s i (x, y) \<partial>M2) \<le> (\<integral>\<^sup>+y. norm (s i (x, y)) \<partial>M2)"
           by (rule integral_norm_bound_ennreal)
         also have "\<dots> \<le> (\<integral>\<^sup>+y. 2 * norm (f (x, y)) \<partial>M2)"
           using x lim by (auto intro!: nn_integral_mono simp: space_pair_measure)
         also have "\<dots> = (\<integral>y. 2 * norm (f (x, y)) \<partial>M2)"
           using f by (intro nn_integral_eq_integral) auto
         finally show "norm (\<integral> y. s i (x, y) \<partial>M2) \<le> (\<integral> y. 2 * norm (f (x, y)) \<partial>M2)"
           by simp
       qed
     qed simp_all
     then show "(\<lambda>i. integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) (s i)) \<longlonglongrightarrow> \<integral> x. \<integral> y. f (x, y) \<partial>M2 \<partial>M1"
       using lim by simp
   qed
 qed
 
 lemma (in pair_sigma_finite)
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f: "integrable (M1 \<Otimes>\<^sub>M M2) (case_prod f)"
   shows AE_integrable_fst: "AE x in M1. integrable M2 (\<lambda>y. f x y)" (is "?AE")
     and integrable_fst: "integrable M1 (\<lambda>x. \<integral>y. f x y \<partial>M2)" (is "?INT")
     and integral_fst: "(\<integral>x. (\<integral>y. f x y \<partial>M2) \<partial>M1) = integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) (\<lambda>(x, y). f x y)" (is "?EQ")
   using AE_integrable_fst'[OF f] integrable_fst'[OF f] integral_fst'[OF f] by auto
 
 lemma (in pair_sigma_finite)
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "integrable (M1 \<Otimes>\<^sub>M M2) (case_prod f)"
   shows AE_integrable_snd: "AE y in M2. integrable M1 (\<lambda>x. f x y)" (is "?AE")
     and integrable_snd: "integrable M2 (\<lambda>y. \<integral>x. f x y \<partial>M1)" (is "?INT")
     and integral_snd: "(\<integral>y. (\<integral>x. f x y \<partial>M1) \<partial>M2) = integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) (case_prod f)" (is "?EQ")
 proof -
   interpret Q: pair_sigma_finite M2 M1 ..
   have Q_int: "integrable (M2 \<Otimes>\<^sub>M M1) (\<lambda>(x, y). f y x)"
     using f unfolding integrable_product_swap_iff[symmetric] by simp
   show ?AE  using Q.AE_integrable_fst'[OF Q_int] by simp
   show ?INT using Q.integrable_fst'[OF Q_int] by simp
   show ?EQ using Q.integral_fst'[OF Q_int]
     using integral_product_swap[of "case_prod f"] by simp
 qed
 
 proposition (in pair_sigma_finite) Fubini_integral:
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes f: "integrable (M1 \<Otimes>\<^sub>M M2) (case_prod f)"
   shows "(\<integral>y. (\<integral>x. f x y \<partial>M1) \<partial>M2) = (\<integral>x. (\<integral>y. f x y \<partial>M2) \<partial>M1)"
   unfolding integral_snd[OF assms] integral_fst[OF assms] ..
 
 lemma (in product_sigma_finite) product_integral_singleton:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   shows "f \<in> borel_measurable (M i) \<Longrightarrow> (\<integral>x. f (x i) \<partial>Pi\<^sub>M {i} M) = integral\<^sup>L (M i) f"
   apply (subst distr_singleton[symmetric])
   apply (subst integral_distr)
   apply simp_all
   done
 
 lemma (in product_sigma_finite) product_integral_fold:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes IJ[simp]: "I \<inter> J = {}" and fin: "finite I" "finite J"
   and f: "integrable (Pi\<^sub>M (I \<union> J) M) f"
   shows "integral\<^sup>L (Pi\<^sub>M (I \<union> J) M) f = (\<integral>x. (\<integral>y. f (merge I J (x, y)) \<partial>Pi\<^sub>M J M) \<partial>Pi\<^sub>M I M)"
 proof -
   interpret I: finite_product_sigma_finite M I by standard fact
   interpret J: finite_product_sigma_finite M J by standard fact
   have "finite (I \<union> J)" using fin by auto
   interpret IJ: finite_product_sigma_finite M "I \<union> J" by standard fact
   interpret P: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" ..
   let ?M = "merge I J"
   let ?f = "\<lambda>x. f (?M x)"
   from f have f_borel: "f \<in> borel_measurable (Pi\<^sub>M (I \<union> J) M)"
     by auto
   have P_borel: "(\<lambda>x. f (merge I J x)) \<in> borel_measurable (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M)"
     using measurable_comp[OF measurable_merge f_borel] by (simp add: comp_def)
   have f_int: "integrable (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M) ?f"
     by (rule integrable_distr[OF measurable_merge]) (simp add: distr_merge[OF IJ fin] f)
   show ?thesis
     apply (subst distr_merge[symmetric, OF IJ fin])
     apply (subst integral_distr[OF measurable_merge f_borel])
     apply (subst P.integral_fst'[symmetric, OF f_int])
     apply simp
     done
 qed
 
 lemma (in product_sigma_finite) product_integral_insert:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes I: "finite I" "i \<notin> I"
     and f: "integrable (Pi\<^sub>M (insert i I) M) f"
   shows "integral\<^sup>L (Pi\<^sub>M (insert i I) M) f = (\<integral>x. (\<integral>y. f (x(i:=y)) \<partial>M i) \<partial>Pi\<^sub>M I M)"
 proof -
   have "integral\<^sup>L (Pi\<^sub>M (insert i I) M) f = integral\<^sup>L (Pi\<^sub>M (I \<union> {i}) M) f"
     by simp
   also have "\<dots> = (\<integral>x. (\<integral>y. f (merge I {i} (x,y)) \<partial>Pi\<^sub>M {i} M) \<partial>Pi\<^sub>M I M)"
     using f I by (intro product_integral_fold) auto
   also have "\<dots> = (\<integral>x. (\<integral>y. f (x(i := y)) \<partial>M i) \<partial>Pi\<^sub>M I M)"
   proof (rule integral_cong[OF refl], subst product_integral_singleton[symmetric])
     fix x assume x: "x \<in> space (Pi\<^sub>M I M)"
     have f_borel: "f \<in> borel_measurable (Pi\<^sub>M (insert i I) M)"
       using f by auto
     show "(\<lambda>y. f (x(i := y))) \<in> borel_measurable (M i)"
       using measurable_comp[OF measurable_component_update f_borel, OF x \<open>i \<notin> I\<close>]
       unfolding comp_def .
     from x I show "(\<integral> y. f (merge I {i} (x,y)) \<partial>Pi\<^sub>M {i} M) = (\<integral> xa. f (x(i := xa i)) \<partial>Pi\<^sub>M {i} M)"
       by (auto intro!: integral_cong arg_cong[where f=f] simp: merge_def space_PiM extensional_def PiE_def)
   qed
   finally show ?thesis .
 qed
 
 lemma (in product_sigma_finite) product_integrable_prod:
   fixes f :: "'i \<Rightarrow> 'a \<Rightarrow> _::{real_normed_field,banach,second_countable_topology}"
   assumes [simp]: "finite I" and integrable: "\<And>i. i \<in> I \<Longrightarrow> integrable (M i) (f i)"
   shows "integrable (Pi\<^sub>M I M) (\<lambda>x. (\<Prod>i\<in>I. f i (x i)))" (is "integrable _ ?f")
 proof (unfold integrable_iff_bounded, intro conjI)
   interpret finite_product_sigma_finite M I by standard fact
 
   show "?f \<in> borel_measurable (Pi\<^sub>M I M)"
     using assms by simp
   have "(\<integral>\<^sup>+ x. ennreal (norm (\<Prod>i\<in>I. f i (x i))) \<partial>Pi\<^sub>M I M) =
       (\<integral>\<^sup>+ x. (\<Prod>i\<in>I. ennreal (norm (f i (x i)))) \<partial>Pi\<^sub>M I M)"
     by (simp add: prod_norm prod_ennreal)
   also have "\<dots> = (\<Prod>i\<in>I. \<integral>\<^sup>+ x. ennreal (norm (f i x)) \<partial>M i)"
     using assms by (intro product_nn_integral_prod) auto
   also have "\<dots> < \<infinity>"
     using integrable by (simp add: less_top[symmetric] ennreal_prod_eq_top integrable_iff_bounded)
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (\<Prod>i\<in>I. f i (x i))) \<partial>Pi\<^sub>M I M) < \<infinity>" .
 qed
 
 lemma (in product_sigma_finite) product_integral_prod:
   fixes f :: "'i \<Rightarrow> 'a \<Rightarrow> _::{real_normed_field,banach,second_countable_topology}"
   assumes "finite I" and integrable: "\<And>i. i \<in> I \<Longrightarrow> integrable (M i) (f i)"
   shows "(\<integral>x. (\<Prod>i\<in>I. f i (x i)) \<partial>Pi\<^sub>M I M) = (\<Prod>i\<in>I. integral\<^sup>L (M i) (f i))"
 using assms proof induct
   case empty
   interpret finite_measure "Pi\<^sub>M {} M"
     by rule (simp add: space_PiM)
   show ?case by (simp add: space_PiM measure_def)
 next
   case (insert i I)
   then have iI: "finite (insert i I)" by auto
   then have prod: "\<And>J. J \<subseteq> insert i I \<Longrightarrow>
     integrable (Pi\<^sub>M J M) (\<lambda>x. (\<Prod>i\<in>J. f i (x i)))"
     by (intro product_integrable_prod insert(4)) (auto intro: finite_subset)
   interpret I: finite_product_sigma_finite M I by standard fact
   have *: "\<And>x y. (\<Prod>j\<in>I. f j (if j = i then y else x j)) = (\<Prod>j\<in>I. f j (x j))"
     using \<open>i \<notin> I\<close> by (auto intro!: prod.cong)
   show ?case
     unfolding product_integral_insert[OF insert(1,2) prod[OF subset_refl]]
     by (simp add: * insert prod subset_insertI)
 qed
 
 lemma integrable_subalgebra:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes borel: "f \<in> borel_measurable N"
   and N: "sets N \<subseteq> sets M" "space N = space M" "\<And>A. A \<in> sets N \<Longrightarrow> emeasure N A = emeasure M A"
   shows "integrable N f \<longleftrightarrow> integrable M f" (is ?P)
 proof -
   have "f \<in> borel_measurable M"
     using assms by (auto simp: measurable_def)
   with assms show ?thesis
     using assms by (auto simp: integrable_iff_bounded nn_integral_subalgebra)
 qed
 
 lemma integral_subalgebra:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes borel: "f \<in> borel_measurable N"
   and N: "sets N \<subseteq> sets M" "space N = space M" "\<And>A. A \<in> sets N \<Longrightarrow> emeasure N A = emeasure M A"
   shows "integral\<^sup>L N f = integral\<^sup>L M f"
 proof cases
   assume "integrable N f"
   then show ?thesis
   proof induct
     case base with assms show ?case by (auto simp: subset_eq measure_def)
   next
     case (add f g)
     then have "(\<integral> a. f a + g a \<partial>N) = integral\<^sup>L M f + integral\<^sup>L M g"
       by simp
     also have "\<dots> = (\<integral> a. f a + g a \<partial>M)"
       using add integrable_subalgebra[OF _ N, of f] integrable_subalgebra[OF _ N, of g] by simp
     finally show ?case .
   next
     case (lim f s)
     then have M: "\<And>i. integrable M (s i)" "integrable M f"
       using integrable_subalgebra[OF _ N, of f] integrable_subalgebra[OF _ N, of "s i" for i] by simp_all
     show ?case
     proof (intro LIMSEQ_unique)
       show "(\<lambda>i. integral\<^sup>L N (s i)) \<longlonglongrightarrow> integral\<^sup>L N f"
         apply (rule integral_dominated_convergence[where w="\<lambda>x. 2 * norm (f x)"])
         using lim
         apply auto
         done
       show "(\<lambda>i. integral\<^sup>L N (s i)) \<longlonglongrightarrow> integral\<^sup>L M f"
         unfolding lim
         apply (rule integral_dominated_convergence[where w="\<lambda>x. 2 * norm (f x)"])
         using lim M N(2)
         apply auto
         done
     qed
   qed
 qed (simp add: not_integrable_integral_eq integrable_subalgebra[OF assms])
 
 hide_const (open) simple_bochner_integral
 hide_const (open) simple_bochner_integrable
 
 end
diff --git a/src/HOL/Analysis/Borel_Space.thy b/src/HOL/Analysis/Borel_Space.thy
--- a/src/HOL/Analysis/Borel_Space.thy
+++ b/src/HOL/Analysis/Borel_Space.thy
@@ -1,2086 +1,2086 @@
 (*  Title:      HOL/Analysis/Borel_Space.thy
     Author:     Johannes Hölzl, TU München
     Author:     Armin Heller, TU München
 *)
 
 section \<open>Borel Space\<close>
 
 theory Borel_Space
 imports
   Measurable Derivative Ordered_Euclidean_Space Extended_Real_Limits
 begin
 
 lemma is_interval_real_ereal_oo: "is_interval (real_of_ereal ` {N<..<M::ereal})"
   by (auto simp: real_atLeastGreaterThan_eq)
 
 lemma sets_Collect_eventually_sequentially[measurable]:
   "(\<And>i. {x\<in>space M. P x i} \<in> sets M) \<Longrightarrow> {x\<in>space M. eventually (P x) sequentially} \<in> sets M"
   unfolding eventually_sequentially by simp
 
 lemma topological_basis_trivial: "topological_basis {A. open A}"
   by (auto simp: topological_basis_def)
 
 proposition open_prod_generated: "open = generate_topology {A \<times> B | A B. open A \<and> open B}"
 proof -
   have "{A \<times> B :: ('a \<times> 'b) set | A B. open A \<and> open B} = ((\<lambda>(a, b). a \<times> b) ` ({A. open A} \<times> {A. open A}))"
     by auto
   then show ?thesis
     by (auto intro: topological_basis_prod topological_basis_trivial topological_basis_imp_subbasis)
 qed
 
 proposition mono_on_imp_deriv_nonneg:
   assumes mono: "mono_on f A" and deriv: "(f has_real_derivative D) (at x)"
   assumes "x \<in> interior A"
   shows "D \<ge> 0"
 proof (rule tendsto_lowerbound)
   let ?A' = "(\<lambda>y. y - x) ` interior A"
   from deriv show "((\<lambda>h. (f (x + h) - f x) / h) \<longlongrightarrow> D) (at 0)"
       by (simp add: field_has_derivative_at has_field_derivative_def)
   from mono have mono': "mono_on f (interior A)" by (rule mono_on_subset) (rule interior_subset)
 
   show "eventually (\<lambda>h. (f (x + h) - f x) / h \<ge> 0) (at 0)"
   proof (subst eventually_at_topological, intro exI conjI ballI impI)
     have "open (interior A)" by simp
     hence "open ((+) (-x) ` interior A)" by (rule open_translation)
     also have "((+) (-x) ` interior A) = ?A'" by auto
     finally show "open ?A'" .
   next
     from \<open>x \<in> interior A\<close> show "0 \<in> ?A'" by auto
   next
     fix h assume "h \<in> ?A'"
     hence "x + h \<in> interior A" by auto
     with mono' and \<open>x \<in> interior A\<close> show "(f (x + h) - f x) / h \<ge> 0"
       by (cases h rule: linorder_cases[of _ 0])
          (simp_all add: divide_nonpos_neg divide_nonneg_pos mono_onD field_simps)
   qed
 qed simp
 
 proposition mono_on_ctble_discont:
   fixes f :: "real \<Rightarrow> real"
   fixes A :: "real set"
   assumes "mono_on f A"
   shows "countable {a\<in>A. \<not> continuous (at a within A) f}"
 proof -
   have mono: "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<le> f y"
     using \<open>mono_on f A\<close> by (simp add: mono_on_def)
   have "\<forall>a \<in> {a\<in>A. \<not> continuous (at a within A) f}. \<exists>q :: nat \<times> rat.
       (fst q = 0 \<and> of_rat (snd q) < f a \<and> (\<forall>x \<in> A. x < a \<longrightarrow> f x < of_rat (snd q))) \<or>
       (fst q = 1 \<and> of_rat (snd q) > f a \<and> (\<forall>x \<in> A. x > a \<longrightarrow> f x > of_rat (snd q)))"
   proof (clarsimp simp del: One_nat_def)
     fix a assume "a \<in> A" assume "\<not> continuous (at a within A) f"
     thus "\<exists>q1 q2.
             q1 = 0 \<and> real_of_rat q2 < f a \<and> (\<forall>x\<in>A. x < a \<longrightarrow> f x < real_of_rat q2) \<or>
             q1 = 1 \<and> f a < real_of_rat q2 \<and> (\<forall>x\<in>A. a < x \<longrightarrow> real_of_rat q2 < f x)"
     proof (auto simp add: continuous_within order_tendsto_iff eventually_at)
       fix l assume "l < f a"
       then obtain q2 where q2: "l < of_rat q2" "of_rat q2 < f a"
         using of_rat_dense by blast
       assume * [rule_format]: "\<forall>d>0. \<exists>x\<in>A. x \<noteq> a \<and> dist x a < d \<and> \<not> l < f x"
       from q2 have "real_of_rat q2 < f a \<and> (\<forall>x\<in>A. x < a \<longrightarrow> f x < real_of_rat q2)"
       proof auto
         fix x assume "x \<in> 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 \<le> f xa")
           by (auto intro: mono)
       qed
       thus ?thesis by auto
     next
       fix u assume "u > f a"
       then obtain q2 where q2: "f a < of_rat q2" "of_rat q2 < u"
         using of_rat_dense by blast
       assume *[rule_format]: "\<forall>d>0. \<exists>x\<in>A. x \<noteq> a \<and> dist x a < d \<and> \<not> u > f x"
       from q2 have "real_of_rat q2 > f a \<and> (\<forall>x\<in>A. x > a \<longrightarrow> f x > real_of_rat q2)"
       proof auto
         fix x assume "x \<in> 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 \<ge> f xa")
           by (auto intro: mono)
       qed
       thus ?thesis by auto
     qed
   qed
-  hence "\<exists>g :: real \<Rightarrow> nat \<times> rat . \<forall>a \<in> {a\<in>A. \<not> continuous (at a within A) f}.
+  then obtain g :: "real \<Rightarrow> nat \<times> rat" where "\<forall>a \<in> {a\<in>A. \<not> continuous (at a within A) f}.
       (fst (g a) = 0 \<and> of_rat (snd (g a)) < f a \<and> (\<forall>x \<in> A. x < a \<longrightarrow> f x < of_rat (snd (g a)))) |
       (fst (g a) = 1 \<and> of_rat (snd (g a)) > f a \<and> (\<forall>x \<in> A. x > a \<longrightarrow> f x > of_rat (snd (g a))))"
-    by (rule bchoice)
-  then guess g ..
+    by (rule bchoice [THEN exE]) blast
   hence g: "\<And>a x. a \<in> A \<Longrightarrow> \<not> continuous (at a within A) f \<Longrightarrow> x \<in> A \<Longrightarrow>
       (fst (g a) = 0 \<and> of_rat (snd (g a)) < f a \<and> (x < a \<longrightarrow> f x < of_rat (snd (g a)))) |
       (fst (g a) = 1 \<and> of_rat (snd (g a)) > f a \<and> (x > a \<longrightarrow> f x > of_rat (snd (g a))))"
     by auto
   have "inj_on g {a\<in>A. \<not> continuous (at a within A) f}"
   proof (auto simp add: inj_on_def)
     fix w z
     assume 1: "w \<in> A" and 2: "\<not> continuous (at w within A) f" and
            3: "z \<in> A" and 4: "\<not> continuous (at z within A) f" and
            5: "g w = g z"
     from g [OF 1 2 3] g [OF 3 4 1] 5
     show "w = z" by auto
   qed
   thus ?thesis
     by (rule countableI')
 qed
 
 lemma mono_on_ctble_discont_open:
   fixes f :: "real \<Rightarrow> real"
   fixes A :: "real set"
   assumes "open A" "mono_on f A"
   shows "countable {a\<in>A. \<not>isCont f a}"
 proof -
   have "{a\<in>A. \<not>isCont f a} = {a\<in>A. \<not>(continuous (at a within A) f)}"
     by (auto simp add: continuous_within_open [OF _ \<open>open A\<close>])
   thus ?thesis
     apply (elim ssubst)
     by (rule mono_on_ctble_discont, rule assms)
 qed
 
 lemma mono_ctble_discont:
   fixes f :: "real \<Rightarrow> real"
   assumes "mono f"
   shows "countable {a. \<not> isCont f a}"
   using assms mono_on_ctble_discont [of f UNIV] unfolding mono_on_def mono_def by auto
 
 lemma has_real_derivative_imp_continuous_on:
   assumes "\<And>x. x \<in> A \<Longrightarrow> (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
 
 lemma continuous_interval_vimage_Int:
   assumes "continuous_on {a::real..b} g" and mono: "\<And>x y. a \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> b \<Longrightarrow> g x \<le> g y"
   assumes "a \<le> b" "(c::real) \<le> d" "{c..d} \<subseteq> {g a..g b}"
   obtains c' d' where "{a..b} \<inter> g -` {c..d} = {c'..d'}" "c' \<le> d'" "g c' = c" "g d' = d"
 proof-
   let ?A = "{a..b} \<inter> g -` {c..d}"
   from IVT'[of g a c b, OF _ _ \<open>a \<le> b\<close> assms(1)] assms(4,5)
   obtain c'' where c'': "c'' \<in> ?A" "g c'' = c" by auto
   from IVT'[of g a d b, OF _ _ \<open>a \<le> b\<close> assms(1)] assms(4,5)
   obtain d'' where d'': "d'' \<in> ?A" "g d'' = d" by auto
   hence [simp]: "?A \<noteq> {}" by blast
 
   define c' where "c' = Inf ?A"
   define d' where "d' = Sup ?A"
   have "?A \<subseteq> {c'..d'}" unfolding c'_def d'_def
     by (intro subsetI) (auto intro: cInf_lower cSup_upper)
   moreover from assms have "closed ?A"
     using continuous_on_closed_vimage[of "{a..b}" g] by (subst Int_commute) simp
   hence c'd'_in_set: "c' \<in> ?A" "d' \<in> ?A" unfolding c'_def d'_def
     by ((intro closed_contains_Inf closed_contains_Sup, simp_all)[])+
   hence "{c'..d'} \<subseteq> ?A" using assms
     by (intro subsetI)
        (auto intro!: order_trans[of c "g c'" "g x" for x] order_trans[of "g x" "g d'" d for x]
              intro!: mono)
   moreover have "c' \<le> d'" using c'd'_in_set(2) unfolding c'_def by (intro cInf_lower) auto
   moreover have "g c' \<le> c" "g d' \<ge> 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
 qed
 
 subsection \<open>Generic Borel spaces\<close>
 
 definition\<^marker>\<open>tag important\<close> (in topological_space) borel :: "'a measure" where
   "borel = sigma UNIV {S. open S}"
 
 abbreviation "borel_measurable M \<equiv> measurable M borel"
 
 lemma in_borel_measurable:
    "f \<in> borel_measurable M \<longleftrightarrow>
     (\<forall>S \<in> sigma_sets UNIV {S. open S}. f -` S \<inter> space M \<in> sets M)"
   by (auto simp add: measurable_def borel_def)
 
 lemma in_borel_measurable_borel:
    "f \<in> borel_measurable M \<longleftrightarrow>
     (\<forall>S \<in> sets borel.
       f -` S \<inter> space M \<in> sets M)"
   by (auto simp add: measurable_def borel_def)
 
 lemma space_borel[simp]: "space borel = UNIV"
   unfolding borel_def by auto
 
 lemma space_in_borel[measurable]: "UNIV \<in> sets borel"
   unfolding borel_def by auto
 
 lemma sets_borel: "sets borel = sigma_sets UNIV {S. open S}"
   unfolding borel_def by (rule sets_measure_of) simp
 
 lemma measurable_sets_borel:
     "\<lbrakk>f \<in> measurable borel M; A \<in> sets M\<rbrakk> \<Longrightarrow> f -` A \<in> sets borel"
   by (drule (1) measurable_sets) simp
 
 lemma pred_Collect_borel[measurable (raw)]: "Measurable.pred borel P \<Longrightarrow> {x. P x} \<in> sets borel"
   unfolding borel_def pred_def by auto
 
 lemma borel_open[measurable (raw generic)]:
   assumes "open A" shows "A \<in> sets borel"
 proof -
   have "A \<in> {S. open S}" unfolding mem_Collect_eq using assms .
   thus ?thesis unfolding borel_def by auto
 qed
 
 lemma borel_closed[measurable (raw generic)]:
   assumes "closed A" shows "A \<in> sets borel"
 proof -
   have "space borel - (- A) \<in> sets borel"
     using assms unfolding closed_def by (blast intro: borel_open)
   thus ?thesis by simp
 qed
 
 lemma borel_singleton[measurable]:
   "A \<in> sets borel \<Longrightarrow> insert x A \<in> sets (borel :: 'a::t1_space measure)"
   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 "(\<Union>a\<in>A. {a}) \<in> sets borel" for A :: "'a set"
     by (intro sets.countable_UN') auto
   then show ?thesis
     by auto
 qed
 
 lemma borel_comp[measurable]: "A \<in> sets borel \<Longrightarrow> - A \<in> sets borel"
   unfolding Compl_eq_Diff_UNIV by simp
 
 lemma borel_measurable_vimage:
   fixes f :: "'a \<Rightarrow> 'x::t2_space"
   assumes borel[measurable]: "f \<in> borel_measurable M"
   shows "f -` {x} \<inter> space M \<in> sets M"
   by simp
 
 lemma borel_measurableI:
   fixes f :: "'a \<Rightarrow> 'x::topological_space"
   assumes "\<And>S. open S \<Longrightarrow> f -` S \<inter> space M \<in> sets M"
   shows "f \<in> borel_measurable M"
   unfolding borel_def
 proof (rule measurable_measure_of, simp_all)
   fix S :: "'x set" assume "open S" thus "f -` S \<inter> space M \<in> sets M"
     using assms[of S] by simp
 qed
 
 lemma borel_measurable_const:
   "(\<lambda>x. c) \<in> borel_measurable M"
   by auto
 
 lemma borel_measurable_indicator:
   assumes A: "A \<in> sets M"
   shows "indicator A \<in> borel_measurable M"
   unfolding indicator_def [abs_def] using A
   by (auto intro!: measurable_If_set)
 
 lemma borel_measurable_count_space[measurable (raw)]:
   "f \<in> borel_measurable (count_space S)"
   unfolding measurable_def by auto
 
 lemma borel_measurable_indicator'[measurable (raw)]:
   assumes [measurable]: "{x\<in>space M. f x \<in> A x} \<in> sets M"
   shows "(\<lambda>x. indicator (A x) (f x)) \<in> borel_measurable M"
   unfolding indicator_def[abs_def]
   by (auto intro!: measurable_If)
 
 lemma borel_measurable_indicator_iff:
   "(indicator A :: 'a \<Rightarrow> 'x::{t1_space, zero_neq_one}) \<in> borel_measurable M \<longleftrightarrow> A \<inter> space M \<in> sets M"
     (is "?I \<in> borel_measurable M \<longleftrightarrow> _")
 proof
   assume "?I \<in> borel_measurable M"
   then have "?I -` {1} \<inter> space M \<in> sets M"
     unfolding measurable_def by auto
   also have "?I -` {1} \<inter> space M = A \<inter> space M"
     unfolding indicator_def [abs_def] by auto
   finally show "A \<inter> space M \<in> sets M" .
 next
   assume "A \<inter> space M \<in> sets M"
   moreover have "?I \<in> borel_measurable M \<longleftrightarrow>
     (indicator (A \<inter> space M) :: 'a \<Rightarrow> 'x) \<in> borel_measurable M"
     by (intro measurable_cong) (auto simp: indicator_def)
   ultimately show "?I \<in> borel_measurable M" by auto
 qed
 
 lemma borel_measurable_subalgebra:
   assumes "sets N \<subseteq> sets M" "space N = space M" "f \<in> borel_measurable N"
   shows "f \<in> borel_measurable M"
   using assms unfolding measurable_def by auto
 
 lemma borel_measurable_restrict_space_iff_ereal:
   fixes f :: "'a \<Rightarrow> ereal"
   assumes \<Omega>[measurable, simp]: "\<Omega> \<inter> space M \<in> sets M"
   shows "f \<in> borel_measurable (restrict_space M \<Omega>) \<longleftrightarrow>
     (\<lambda>x. f x * indicator \<Omega> x) \<in> borel_measurable M"
   by (subst measurable_restrict_space_iff)
      (auto simp: indicator_def of_bool_def if_distrib[where f="\<lambda>x. a * x" for a] cong del: if_weak_cong)
 
 lemma borel_measurable_restrict_space_iff_ennreal:
   fixes f :: "'a \<Rightarrow> ennreal"
   assumes \<Omega>[measurable, simp]: "\<Omega> \<inter> space M \<in> sets M"
   shows "f \<in> borel_measurable (restrict_space M \<Omega>) \<longleftrightarrow>
     (\<lambda>x. f x * indicator \<Omega> x) \<in> borel_measurable M"
   by (subst measurable_restrict_space_iff)
      (auto simp: indicator_def of_bool_def if_distrib[where f="\<lambda>x. a * x" for a] cong del: if_weak_cong)
 
 lemma borel_measurable_restrict_space_iff:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   assumes \<Omega>[measurable, simp]: "\<Omega> \<inter> space M \<in> sets M"
   shows "f \<in> borel_measurable (restrict_space M \<Omega>) \<longleftrightarrow>
     (\<lambda>x. indicator \<Omega> x *\<^sub>R f x) \<in> borel_measurable M"
   by (subst measurable_restrict_space_iff)
      (auto simp: indicator_def of_bool_def if_distrib[where f="\<lambda>x. x *\<^sub>R a" for a] ac_simps
        cong del: if_weak_cong)
 
 lemma cbox_borel[measurable]: "cbox a b \<in> sets borel"
   by (auto intro: borel_closed)
 
 lemma box_borel[measurable]: "box a b \<in> sets borel"
   by (auto intro: borel_open)
 
 lemma borel_compact: "compact (A::'a::t2_space set) \<Longrightarrow> A \<in> sets borel"
   by (auto intro: borel_closed dest!: compact_imp_closed)
 
 lemma borel_sigma_sets_subset:
   "A \<subseteq> sets borel \<Longrightarrow> sigma_sets UNIV A \<subseteq> sets borel"
   using sets.sigma_sets_subset[of A borel] by simp
 
 lemma borel_eq_sigmaI1:
   fixes F :: "'i \<Rightarrow> 'a::topological_space set" and X :: "'a::topological_space set set"
   assumes borel_eq: "borel = sigma UNIV X"
   assumes X: "\<And>x. x \<in> X \<Longrightarrow> x \<in> sets (sigma UNIV (F ` A))"
   assumes F: "\<And>i. i \<in> A \<Longrightarrow> F i \<in> sets borel"
   shows "borel = sigma UNIV (F ` A)"
   unfolding borel_def
 proof (intro sigma_eqI antisym)
   have borel_rev_eq: "sigma_sets UNIV {S::'a set. open S} = sets borel"
     unfolding borel_def by simp
   also have "\<dots> = sigma_sets UNIV X"
     unfolding borel_eq by simp
   also have "\<dots> \<subseteq> sigma_sets UNIV (F`A)"
     using X by (intro sigma_algebra.sigma_sets_subset[OF sigma_algebra_sigma_sets]) auto
   finally show "sigma_sets UNIV {S. open S} \<subseteq> sigma_sets UNIV (F`A)" .
   show "sigma_sets UNIV (F`A) \<subseteq> sigma_sets UNIV {S. open S}"
     unfolding borel_rev_eq using F by (intro borel_sigma_sets_subset) auto
 qed auto
 
 lemma borel_eq_sigmaI2:
   fixes F :: "'i \<Rightarrow> 'j \<Rightarrow> 'a::topological_space set"
     and G :: "'l \<Rightarrow> 'k \<Rightarrow> 'a::topological_space set"
   assumes borel_eq: "borel = sigma UNIV ((\<lambda>(i, j). G i j)`B)"
   assumes X: "\<And>i j. (i, j) \<in> B \<Longrightarrow> G i j \<in> sets (sigma UNIV ((\<lambda>(i, j). F i j) ` A))"
   assumes F: "\<And>i j. (i, j) \<in> A \<Longrightarrow> F i j \<in> sets borel"
   shows "borel = sigma UNIV ((\<lambda>(i, j). F i j) ` A)"
   using assms
   by (intro borel_eq_sigmaI1[where X="(\<lambda>(i, j). G i j) ` B" and F="(\<lambda>(i, j). F i j)"]) auto
 
 lemma borel_eq_sigmaI3:
   fixes F :: "'i \<Rightarrow> 'j \<Rightarrow> 'a::topological_space set" and X :: "'a::topological_space set set"
   assumes borel_eq: "borel = sigma UNIV X"
   assumes X: "\<And>x. x \<in> X \<Longrightarrow> x \<in> sets (sigma UNIV ((\<lambda>(i, j). F i j) ` A))"
   assumes F: "\<And>i j. (i, j) \<in> A \<Longrightarrow> F i j \<in> sets borel"
   shows "borel = sigma UNIV ((\<lambda>(i, j). F i j) ` A)"
   using assms by (intro borel_eq_sigmaI1[where X=X and F="(\<lambda>(i, j). F i j)"]) auto
 
 lemma borel_eq_sigmaI4:
   fixes F :: "'i \<Rightarrow> 'a::topological_space set"
     and G :: "'l \<Rightarrow> 'k \<Rightarrow> 'a::topological_space set"
   assumes borel_eq: "borel = sigma UNIV ((\<lambda>(i, j). G i j)`A)"
   assumes X: "\<And>i j. (i, j) \<in> A \<Longrightarrow> G i j \<in> sets (sigma UNIV (range F))"
   assumes F: "\<And>i. F i \<in> sets borel"
   shows "borel = sigma UNIV (range F)"
   using assms by (intro borel_eq_sigmaI1[where X="(\<lambda>(i, j). G i j) ` A" and F=F]) auto
 
 lemma borel_eq_sigmaI5:
   fixes F :: "'i \<Rightarrow> 'j \<Rightarrow> 'a::topological_space set" and G :: "'l \<Rightarrow> 'a::topological_space set"
   assumes borel_eq: "borel = sigma UNIV (range G)"
   assumes X: "\<And>i. G i \<in> sets (sigma UNIV (range (\<lambda>(i, j). F i j)))"
   assumes F: "\<And>i j. F i j \<in> sets borel"
   shows "borel = sigma UNIV (range (\<lambda>(i, j). F i j))"
   using assms by (intro borel_eq_sigmaI1[where X="range G" and F="(\<lambda>(i, j). F i j)"]) auto
 
 theorem second_countable_borel_measurable:
   fixes X :: "'a::second_countable_topology set set"
   assumes eq: "open = generate_topology X"
   shows "borel = sigma UNIV X"
   unfolding borel_def
 proof (intro sigma_eqI sigma_sets_eqI)
   interpret X: sigma_algebra UNIV "sigma_sets UNIV X"
     by (rule sigma_algebra_sigma_sets) simp
 
   fix S :: "'a set" assume "S \<in> Collect open"
   then have "generate_topology X S"
     by (auto simp: eq)
   then show "S \<in> sigma_sets UNIV X"
   proof induction
     case (UN K)
     then have K: "\<And>k. k \<in> K \<Longrightarrow> open k"
       unfolding eq by auto
     from ex_countable_basis obtain B :: "'a set set" where
       B:  "\<And>b. b \<in> B \<Longrightarrow> open b" "\<And>X. open X \<Longrightarrow> \<exists>b\<subseteq>B. (\<Union>b) = X" and "countable B"
       by (auto simp: topological_basis_def)
     from B(2)[OF K] obtain m where m: "\<And>k. k \<in> K \<Longrightarrow> m k \<subseteq> B" "\<And>k. k \<in> K \<Longrightarrow> \<Union>(m k) = k"
       by metis
     define U where "U = (\<Union>k\<in>K. m k)"
     with m have "countable U"
       by (intro countable_subset[OF _ \<open>countable B\<close>]) auto
     have "\<Union>U = (\<Union>A\<in>U. A)" by simp
     also have "\<dots> = \<Union>K"
       unfolding U_def UN_simps by (simp add: m)
     finally have "\<Union>U = \<Union>K" .
 
     have "\<forall>b\<in>U. \<exists>k\<in>K. b \<subseteq> k"
       using m by (auto simp: U_def)
     then obtain u where u: "\<And>b. b \<in> U \<Longrightarrow> u b \<in> K" and "\<And>b. b \<in> U \<Longrightarrow> b \<subseteq> u b"
       by metis
     then have "(\<Union>b\<in>U. u b) \<subseteq> \<Union>K" "\<Union>U \<subseteq> (\<Union>b\<in>U. u b)"
       by auto
     then have "\<Union>K = (\<Union>b\<in>U. u b)"
       unfolding \<open>\<Union>U = \<Union>K\<close> by auto
     also have "\<dots> \<in> sigma_sets UNIV X"
       using u UN by (intro X.countable_UN' \<open>countable U\<close>) auto
     finally show "\<Union>K \<in> sigma_sets UNIV X" .
   qed auto
 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 "\<dots> \<in> sigma_sets UNIV (Collect closed)"
     by (force intro: sigma_sets.Compl simp: \<open>open x\<close>)
   finally show "x \<in> sigma_sets UNIV (Collect closed)" by simp
 next
   fix x :: "'a set" assume "closed x"
   hence "x = UNIV - (UNIV - x)" by auto
   also have "\<dots> \<in> sigma_sets UNIV (Collect open)"
     by (force intro: sigma_sets.Compl simp: \<open>closed x\<close>)
   finally show "x \<in> sigma_sets UNIV (Collect open)" by simp
 qed simp_all
 
 proposition borel_eq_countable_basis:
   fixes B::"'a::topological_space set set"
   assumes "countable B"
   assumes "topological_basis B"
   shows "borel = sigma UNIV B"
   unfolding borel_def
 proof (intro sigma_eqI sigma_sets_eqI, safe)
   interpret countable_basis "open" B using assms by (rule countable_basis_openI)
   fix X::"'a set" assume "open X"
   from open_countable_basisE[OF this] obtain B' where B': "B' \<subseteq> B" "X = \<Union> B'" .
   then show "X \<in> sigma_sets UNIV B"
     by (blast intro: sigma_sets_UNION \<open>countable B\<close> countable_subset)
 next
   fix b assume "b \<in> B"
   hence "open b" by (rule topological_basis_open[OF assms(2)])
   thus "b \<in> sigma_sets UNIV (Collect open)" by auto
 qed simp_all
 
 lemma borel_measurable_continuous_on_restrict:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   assumes f: "continuous_on A f"
   shows "f \<in> borel_measurable (restrict_space borel A)"
 proof (rule borel_measurableI)
   fix S :: "'b set" assume "open S"
   with f obtain T where "f -` S \<inter> A = T \<inter> A" "open T"
     by (metis continuous_on_open_invariant)
   then show "f -` S \<inter> space (restrict_space borel A) \<in> sets (restrict_space borel A)"
     by (force simp add: sets_restrict_space space_restrict_space)
 qed
 
 lemma borel_measurable_continuous_onI: "continuous_on UNIV f \<Longrightarrow> f \<in> borel_measurable borel"
   by (drule borel_measurable_continuous_on_restrict) simp
 
 lemma borel_measurable_continuous_on_if:
   "A \<in> sets borel \<Longrightarrow> continuous_on A f \<Longrightarrow> continuous_on (- A) g \<Longrightarrow>
     (\<lambda>x. if x \<in> A then f x else g x) \<in> borel_measurable borel"
   by (auto simp add: measurable_If_restrict_space_iff Collect_neg_eq
            intro!: borel_measurable_continuous_on_restrict)
 
 lemma borel_measurable_continuous_countable_exceptions:
   fixes f :: "'a::t1_space \<Rightarrow> 'b::topological_space"
   assumes X: "countable X"
   assumes "continuous_on (- X) f"
   shows "f \<in> borel_measurable borel"
 proof (rule measurable_discrete_difference[OF _ X])
   have "X \<in> sets borel"
     by (rule sets.countable[OF _ X]) auto
   then show "(\<lambda>x. if x \<in> X then undefined else f x) \<in> borel_measurable borel"
     by (intro borel_measurable_continuous_on_if assms continuous_intros)
 qed auto
 
 lemma borel_measurable_continuous_on:
   assumes f: "continuous_on UNIV f" and g: "g \<in> borel_measurable M"
   shows "(\<lambda>x. f (g x)) \<in> borel_measurable M"
   using measurable_comp[OF g borel_measurable_continuous_onI[OF f]] by (simp add: comp_def)
 
 lemma borel_measurable_continuous_on_indicator:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::real_normed_vector"
   shows "A \<in> sets borel \<Longrightarrow> continuous_on A f \<Longrightarrow> (\<lambda>x. indicator A x *\<^sub>R f x) \<in> borel_measurable borel"
   by (subst borel_measurable_restrict_space_iff[symmetric])
      (auto intro: borel_measurable_continuous_on_restrict)
 
 lemma borel_measurable_Pair[measurable (raw)]:
   fixes f :: "'a \<Rightarrow> 'b::second_countable_topology" and g :: "'a \<Rightarrow> 'c::second_countable_topology"
   assumes f[measurable]: "f \<in> borel_measurable M"
   assumes g[measurable]: "g \<in> borel_measurable M"
   shows "(\<lambda>x. (f x, g x)) \<in> borel_measurable M"
 proof (subst borel_eq_countable_basis)
   let ?B = "SOME B::'b set set. countable B \<and> topological_basis B"
   let ?C = "SOME B::'c set set. countable B \<and> topological_basis B"
   let ?P = "(\<lambda>(b, c). b \<times> c) ` (?B \<times> ?C)"
   show "countable ?P" "topological_basis ?P"
     by (auto intro!: countable_basis topological_basis_prod is_basis)
 
   show "(\<lambda>x. (f x, g x)) \<in> measurable M (sigma UNIV ?P)"
   proof (rule measurable_measure_of)
     fix S assume "S \<in> ?P"
     then obtain b c where "b \<in> ?B" "c \<in> ?C" and S: "S = b \<times> c" by auto
     then have borel: "open b" "open c"
       by (auto intro: is_basis topological_basis_open)
     have "(\<lambda>x. (f x, g x)) -` S \<inter> space M = (f -` b \<inter> space M) \<inter> (g -` c \<inter> space M)"
       unfolding S by auto
     also have "\<dots> \<in> sets M"
       using borel by simp
     finally show "(\<lambda>x. (f x, g x)) -` S \<inter> space M \<in> sets M" .
   qed auto
 qed
 
 lemma borel_measurable_continuous_Pair:
   fixes f :: "'a \<Rightarrow> 'b::second_countable_topology" and g :: "'a \<Rightarrow> 'c::second_countable_topology"
   assumes [measurable]: "f \<in> borel_measurable M"
   assumes [measurable]: "g \<in> borel_measurable M"
   assumes H: "continuous_on UNIV (\<lambda>x. H (fst x) (snd x))"
   shows "(\<lambda>x. H (f x) (g x)) \<in> borel_measurable M"
 proof -
   have eq: "(\<lambda>x. H (f x) (g x)) = (\<lambda>x. (\<lambda>x. H (fst x) (snd x)) (f x, g x))" by auto
   show ?thesis
     unfolding eq by (rule borel_measurable_continuous_on[OF H]) auto
 qed
 
 subsection \<open>Borel spaces on order topologies\<close>
 
 lemma [measurable]:
   fixes a b :: "'a::linorder_topology"
   shows lessThan_borel: "{..< a} \<in> sets borel"
     and greaterThan_borel: "{a <..} \<in> sets borel"
     and greaterThanLessThan_borel: "{a<..<b} \<in> sets borel"
     and atMost_borel: "{..a} \<in> sets borel"
     and atLeast_borel: "{a..} \<in> sets borel"
     and atLeastAtMost_borel: "{a..b} \<in> sets borel"
     and greaterThanAtMost_borel: "{a<..b} \<in> sets borel"
     and atLeastLessThan_borel: "{a..<b} \<in> sets borel"
   unfolding greaterThanAtMost_def atLeastLessThan_def
   by (blast intro: borel_open borel_closed open_lessThan open_greaterThan open_greaterThanLessThan
                    closed_atMost closed_atLeast closed_atLeastAtMost)+
 
 lemma borel_Iio:
   "borel = sigma UNIV (range lessThan :: 'a::{linorder_topology, second_countable_topology} set set)"
   unfolding second_countable_borel_measurable[OF open_generated_order]
 proof (intro sigma_eqI sigma_sets_eqI)
-  from countable_dense_setE guess D :: "'a set" . note D = this
+  obtain D :: "'a set" where D: "countable D" "\<And>X. open X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>d\<in>D. d \<in> X"
+    by (rule countable_dense_setE) blast
 
   interpret L: sigma_algebra UNIV "sigma_sets UNIV (range lessThan)"
     by (rule sigma_algebra_sigma_sets) simp
 
   fix A :: "'a set" assume "A \<in> range lessThan \<union> range greaterThan"
   then obtain y where "A = {y <..} \<or> A = {..< y}"
     by blast
   then show "A \<in> sigma_sets UNIV (range lessThan)"
   proof
     assume A: "A = {y <..}"
     show ?thesis
     proof cases
       assume "\<forall>x>y. \<exists>d. y < d \<and> d < x"
       with D(2)[of "{y <..< x}" for x] have "\<forall>x>y. \<exists>d\<in>D. y < d \<and> d < x"
         by (auto simp: set_eq_iff)
       then have "A = UNIV - (\<Inter>d\<in>{d\<in>D. y < d}. {..< d})"
         by (auto simp: A) (metis less_asym)
       also have "\<dots> \<in> sigma_sets UNIV (range lessThan)"
         using D(1) by (intro L.Diff L.top L.countable_INT'') auto
       finally show ?thesis .
     next
       assume "\<not> (\<forall>x>y. \<exists>d. y < d \<and> d < x)"
       then obtain x where "y < x"  "\<And>d. y < d \<Longrightarrow> \<not> d < x"
         by auto
       then have "A = UNIV - {..< x}"
         unfolding A by (auto simp: not_less[symmetric])
       also have "\<dots> \<in> sigma_sets UNIV (range lessThan)"
         by auto
       finally show ?thesis .
     qed
   qed auto
 qed auto
 
 lemma borel_Ioi:
   "borel = sigma UNIV (range greaterThan :: 'a::{linorder_topology, second_countable_topology} set set)"
   unfolding second_countable_borel_measurable[OF open_generated_order]
 proof (intro sigma_eqI sigma_sets_eqI)
-  from countable_dense_setE guess D :: "'a set" . note D = this
+  obtain D :: "'a set" where D: "countable D" "\<And>X. open X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>d\<in>D. d \<in> X"
+    by (rule countable_dense_setE) blast
 
   interpret L: sigma_algebra UNIV "sigma_sets UNIV (range greaterThan)"
     by (rule sigma_algebra_sigma_sets) simp
 
   fix A :: "'a set" assume "A \<in> range lessThan \<union> range greaterThan"
   then obtain y where "A = {y <..} \<or> A = {..< y}"
     by blast
   then show "A \<in> sigma_sets UNIV (range greaterThan)"
   proof
     assume A: "A = {..< y}"
     show ?thesis
     proof cases
       assume "\<forall>x<y. \<exists>d. x < d \<and> d < y"
       with D(2)[of "{x <..< y}" for x] have "\<forall>x<y. \<exists>d\<in>D. x < d \<and> d < y"
         by (auto simp: set_eq_iff)
       then have "A = UNIV - (\<Inter>d\<in>{d\<in>D. d < y}. {d <..})"
         by (auto simp: A) (metis less_asym)
       also have "\<dots> \<in> sigma_sets UNIV (range greaterThan)"
         using D(1) by (intro L.Diff L.top L.countable_INT'') auto
       finally show ?thesis .
     next
       assume "\<not> (\<forall>x<y. \<exists>d. x < d \<and> d < y)"
       then obtain x where "x < y"  "\<And>d. y > d \<Longrightarrow> x \<ge> d"
         by (auto simp: not_less[symmetric])
       then have "A = UNIV - {x <..}"
         unfolding A Compl_eq_Diff_UNIV[symmetric] by auto
       also have "\<dots> \<in> sigma_sets UNIV (range greaterThan)"
         by auto
       finally show ?thesis .
     qed
   qed auto
 qed auto
 
 lemma borel_measurableI_less:
   fixes f :: "'a \<Rightarrow> 'b::{linorder_topology, second_countable_topology}"
   shows "(\<And>y. {x\<in>space M. f x < y} \<in> sets M) \<Longrightarrow> f \<in> borel_measurable M"
   unfolding borel_Iio
   by (rule measurable_measure_of) (auto simp: Int_def conj_commute)
 
 lemma borel_measurableI_greater:
   fixes f :: "'a \<Rightarrow> 'b::{linorder_topology, second_countable_topology}"
   shows "(\<And>y. {x\<in>space M. y < f x} \<in> sets M) \<Longrightarrow> f \<in> borel_measurable M"
   unfolding borel_Ioi
   by (rule measurable_measure_of) (auto simp: Int_def conj_commute)
 
 lemma borel_measurableI_le:
   fixes f :: "'a \<Rightarrow> 'b::{linorder_topology, second_countable_topology}"
   shows "(\<And>y. {x\<in>space M. f x \<le> y} \<in> sets M) \<Longrightarrow> f \<in> borel_measurable M"
   by (rule borel_measurableI_greater) (auto simp: not_le[symmetric])
 
 lemma borel_measurableI_ge:
   fixes f :: "'a \<Rightarrow> 'b::{linorder_topology, second_countable_topology}"
   shows "(\<And>y. {x\<in>space M. y \<le> f x} \<in> sets M) \<Longrightarrow> f \<in> borel_measurable M"
   by (rule borel_measurableI_less) (auto simp: not_le[symmetric])
 
 lemma borel_measurable_less[measurable]:
   fixes f :: "'a \<Rightarrow> 'b::{second_countable_topology, linorder_topology}"
   assumes "f \<in> borel_measurable M"
   assumes "g \<in> borel_measurable M"
   shows "{w \<in> space M. f w < g w} \<in> sets M"
 proof -
   have "{w \<in> space M. f w < g w} = (\<lambda>x. (f x, g x)) -` {x. fst x < snd x} \<inter> space M"
     by auto
   also have "\<dots> \<in> sets M"
     by (intro measurable_sets[OF borel_measurable_Pair borel_open, OF assms open_Collect_less]
               continuous_intros)
   finally show ?thesis .
 qed
 
 lemma
   fixes f :: "'a \<Rightarrow> 'b::{second_countable_topology, linorder_topology}"
   assumes f[measurable]: "f \<in> borel_measurable M"
   assumes g[measurable]: "g \<in> borel_measurable M"
   shows borel_measurable_le[measurable]: "{w \<in> space M. f w \<le> g w} \<in> sets M"
     and borel_measurable_eq[measurable]: "{w \<in> space M. f w = g w} \<in> sets M"
     and borel_measurable_neq: "{w \<in> space M. f w \<noteq> g w} \<in> sets M"
   unfolding eq_iff not_less[symmetric]
   by measurable
 
 lemma borel_measurable_SUP[measurable (raw)]:
   fixes F :: "_ \<Rightarrow> _ \<Rightarrow> _::{complete_linorder, linorder_topology, second_countable_topology}"
   assumes [simp]: "countable I"
   assumes [measurable]: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> borel_measurable M"
   shows "(\<lambda>x. SUP i\<in>I. F i x) \<in> borel_measurable M"
   by (rule borel_measurableI_greater) (simp add: less_SUP_iff)
 
 lemma borel_measurable_INF[measurable (raw)]:
   fixes F :: "_ \<Rightarrow> _ \<Rightarrow> _::{complete_linorder, linorder_topology, second_countable_topology}"
   assumes [simp]: "countable I"
   assumes [measurable]: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> borel_measurable M"
   shows "(\<lambda>x. INF i\<in>I. F i x) \<in> borel_measurable M"
   by (rule borel_measurableI_less) (simp add: INF_less_iff)
 
 lemma borel_measurable_cSUP[measurable (raw)]:
   fixes F :: "_ \<Rightarrow> _ \<Rightarrow> 'a::{conditionally_complete_linorder, linorder_topology, second_countable_topology}"
   assumes [simp]: "countable I"
   assumes [measurable]: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> borel_measurable M"
   assumes bdd: "\<And>x. x \<in> space M \<Longrightarrow> bdd_above ((\<lambda>i. F i x) ` I)"
   shows "(\<lambda>x. SUP i\<in>I. F i x) \<in> borel_measurable M"
 proof cases
   assume "I = {}" then show ?thesis
     unfolding \<open>I = {}\<close> image_empty by simp
 next
   assume "I \<noteq> {}"
   show ?thesis
   proof (rule borel_measurableI_le)
     fix y
     have "{x \<in> space M. \<forall>i\<in>I. F i x \<le> y} \<in> sets M"
       by measurable
     also have "{x \<in> space M. \<forall>i\<in>I. F i x \<le> y} = {x \<in> space M. (SUP i\<in>I. F i x) \<le> y}"
       by (simp add: cSUP_le_iff \<open>I \<noteq> {}\<close> bdd cong: conj_cong)
     finally show "{x \<in> space M. (SUP i\<in>I. F i x) \<le>  y} \<in> sets M"  .
   qed
 qed
 
 lemma borel_measurable_cINF[measurable (raw)]:
   fixes F :: "_ \<Rightarrow> _ \<Rightarrow> 'a::{conditionally_complete_linorder, linorder_topology, second_countable_topology}"
   assumes [simp]: "countable I"
   assumes [measurable]: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> borel_measurable M"
   assumes bdd: "\<And>x. x \<in> space M \<Longrightarrow> bdd_below ((\<lambda>i. F i x) ` I)"
   shows "(\<lambda>x. INF i\<in>I. F i x) \<in> borel_measurable M"
 proof cases
   assume "I = {}" then show ?thesis
     unfolding \<open>I = {}\<close> image_empty by simp
 next
   assume "I \<noteq> {}"
   show ?thesis
   proof (rule borel_measurableI_ge)
     fix y
     have "{x \<in> space M. \<forall>i\<in>I. y \<le> F i x} \<in> sets M"
       by measurable
     also have "{x \<in> space M. \<forall>i\<in>I. y \<le> F i x} = {x \<in> space M. y \<le> (INF i\<in>I. F i x)}"
       by (simp add: le_cINF_iff \<open>I \<noteq> {}\<close> bdd cong: conj_cong)
     finally show "{x \<in> space M. y \<le> (INF i\<in>I. F i x)} \<in> sets M"  .
   qed
 qed
 
 lemma borel_measurable_lfp[consumes 1, case_names continuity step]:
   fixes F :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b::{complete_linorder, linorder_topology, second_countable_topology})"
   assumes "sup_continuous F"
   assumes *: "\<And>f. f \<in> borel_measurable M \<Longrightarrow> F f \<in> borel_measurable M"
   shows "lfp F \<in> borel_measurable M"
 proof -
   { fix i have "((F ^^ i) bot) \<in> borel_measurable M"
       by (induct i) (auto intro!: *) }
   then have "(\<lambda>x. SUP i. (F ^^ i) bot x) \<in> borel_measurable M"
     by measurable
   also have "(\<lambda>x. SUP i. (F ^^ i) bot x) = (SUP i. (F ^^ i) bot)"
     by (auto simp add: image_comp)
   also have "(SUP i. (F ^^ i) bot) = lfp F"
     by (rule sup_continuous_lfp[symmetric]) fact
   finally show ?thesis .
 qed
 
 lemma borel_measurable_gfp[consumes 1, case_names continuity step]:
   fixes F :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b::{complete_linorder, linorder_topology, second_countable_topology})"
   assumes "inf_continuous F"
   assumes *: "\<And>f. f \<in> borel_measurable M \<Longrightarrow> F f \<in> borel_measurable M"
   shows "gfp F \<in> borel_measurable M"
 proof -
   { fix i have "((F ^^ i) top) \<in> borel_measurable M"
       by (induct i) (auto intro!: * simp: bot_fun_def) }
   then have "(\<lambda>x. INF i. (F ^^ i) top x) \<in> borel_measurable M"
     by measurable
   also have "(\<lambda>x. INF i. (F ^^ i) top x) = (INF i. (F ^^ i) top)"
     by (auto simp add: image_comp)
   also have "\<dots> = gfp F"
     by (rule inf_continuous_gfp[symmetric]) fact
   finally show ?thesis .
 qed
 
 lemma borel_measurable_max[measurable (raw)]:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (\<lambda>x. max (g x) (f x) :: 'b::{second_countable_topology, linorder_topology}) \<in> borel_measurable M"
   by (rule borel_measurableI_less) simp
 
 lemma borel_measurable_min[measurable (raw)]:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (\<lambda>x. min (g x) (f x) :: 'b::{second_countable_topology, linorder_topology}) \<in> borel_measurable M"
   by (rule borel_measurableI_greater) simp
 
 lemma borel_measurable_Min[measurable (raw)]:
   "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M) \<Longrightarrow> (\<lambda>x. Min ((\<lambda>i. f i x)`I) :: 'b::{second_countable_topology, linorder_topology}) \<in> borel_measurable M"
 proof (induct I rule: finite_induct)
   case (insert i I) then show ?case
     by (cases "I = {}") auto
 qed auto
 
 lemma borel_measurable_Max[measurable (raw)]:
   "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M) \<Longrightarrow> (\<lambda>x. Max ((\<lambda>i. f i x)`I) :: 'b::{second_countable_topology, linorder_topology}) \<in> borel_measurable M"
 proof (induct I rule: finite_induct)
   case (insert i I) then show ?case
     by (cases "I = {}") auto
 qed auto
 
 lemma borel_measurable_sup[measurable (raw)]:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (\<lambda>x. sup (g x) (f x) :: 'b::{lattice, second_countable_topology, linorder_topology}) \<in> borel_measurable M"
   unfolding sup_max by measurable
 
 lemma borel_measurable_inf[measurable (raw)]:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (\<lambda>x. inf (g x) (f x) :: 'b::{lattice, second_countable_topology, linorder_topology}) \<in> borel_measurable M"
   unfolding inf_min by measurable
 
 lemma [measurable (raw)]:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::{complete_linorder, second_countable_topology, linorder_topology}"
   assumes "\<And>i. f i \<in> borel_measurable M"
   shows borel_measurable_liminf: "(\<lambda>x. liminf (\<lambda>i. f i x)) \<in> borel_measurable M"
     and borel_measurable_limsup: "(\<lambda>x. limsup (\<lambda>i. f i x)) \<in> borel_measurable M"
   unfolding liminf_SUP_INF limsup_INF_SUP using assms by auto
 
 lemma measurable_convergent[measurable (raw)]:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::{complete_linorder, second_countable_topology, linorder_topology}"
   assumes [measurable]: "\<And>i. f i \<in> borel_measurable M"
   shows "Measurable.pred M (\<lambda>x. convergent (\<lambda>i. f i x))"
   unfolding convergent_ereal by measurable
 
 lemma sets_Collect_convergent[measurable]:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::{complete_linorder, second_countable_topology, linorder_topology}"
   assumes f[measurable]: "\<And>i. f i \<in> borel_measurable M"
   shows "{x\<in>space M. convergent (\<lambda>i. f i x)} \<in> sets M"
   by measurable
 
 lemma borel_measurable_lim[measurable (raw)]:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::{complete_linorder, second_countable_topology, linorder_topology}"
   assumes [measurable]: "\<And>i. f i \<in> borel_measurable M"
   shows "(\<lambda>x. lim (\<lambda>i. f i x)) \<in> borel_measurable M"
 proof -
   have "\<And>x. lim (\<lambda>i. f i x) = (if convergent (\<lambda>i. f i x) then limsup (\<lambda>i. f i x) else (THE i. False))"
     by (simp add: lim_def convergent_def convergent_limsup_cl)
   then show ?thesis
     by simp
 qed
 
 lemma borel_measurable_LIMSEQ_order:
   fixes u :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::{complete_linorder, second_countable_topology, linorder_topology}"
   assumes u': "\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. u i x) \<longlonglongrightarrow> u' x"
   and u: "\<And>i. u i \<in> borel_measurable M"
   shows "u' \<in> borel_measurable M"
 proof -
   have "\<And>x. x \<in> space M \<Longrightarrow> u' x = liminf (\<lambda>n. u n x)"
     using u' by (simp add: lim_imp_Liminf[symmetric])
   with u show ?thesis by (simp cong: measurable_cong)
 qed
 
 subsection \<open>Borel spaces on topological monoids\<close>
 
 lemma borel_measurable_add[measurable (raw)]:
   fixes f g :: "'a \<Rightarrow> 'b::{second_countable_topology, topological_monoid_add}"
   assumes f: "f \<in> borel_measurable M"
   assumes g: "g \<in> borel_measurable M"
   shows "(\<lambda>x. f x + g x) \<in> borel_measurable M"
   using f g by (rule borel_measurable_continuous_Pair) (intro continuous_intros)
 
 lemma borel_measurable_sum[measurable (raw)]:
   fixes f :: "'c \<Rightarrow> 'a \<Rightarrow> 'b::{second_countable_topology, topological_comm_monoid_add}"
   assumes "\<And>i. i \<in> S \<Longrightarrow> f i \<in> borel_measurable M"
   shows "(\<lambda>x. \<Sum>i\<in>S. f i x) \<in> borel_measurable M"
 proof cases
   assume "finite S"
   thus ?thesis using assms by induct auto
 qed simp
 
 lemma borel_measurable_suminf_order[measurable (raw)]:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::{complete_linorder, second_countable_topology, linorder_topology, topological_comm_monoid_add}"
   assumes f[measurable]: "\<And>i. f i \<in> borel_measurable M"
   shows "(\<lambda>x. suminf (\<lambda>i. f i x)) \<in> borel_measurable M"
   unfolding suminf_def sums_def[abs_def] lim_def[symmetric] by simp
 
 subsection \<open>Borel spaces on Euclidean spaces\<close>
 
 lemma borel_measurable_inner[measurable (raw)]:
   fixes f g :: "'a \<Rightarrow> 'b::{second_countable_topology, real_inner}"
   assumes "f \<in> borel_measurable M"
   assumes "g \<in> borel_measurable M"
   shows "(\<lambda>x. f x \<bullet> g x) \<in> borel_measurable M"
   using assms
   by (rule borel_measurable_continuous_Pair) (intro continuous_intros)
 
 notation
   eucl_less (infix "<e" 50)
 
 lemma box_oc: "{x. a <e x \<and> x \<le> b} = {x. a <e x} \<inter> {..b}"
   and box_co: "{x. a \<le> x \<and> x <e b} = {a..} \<inter> {x. x <e b}"
   by auto
 
 lemma eucl_ivals[measurable]:
   fixes a b :: "'a::ordered_euclidean_space"
   shows "{x. x <e a} \<in> sets borel"
     and "{x. a <e x} \<in> sets borel"
     and "{..a} \<in> sets borel"
     and "{a..} \<in> sets borel"
     and "{a..b} \<in> sets borel"
     and  "{x. a <e x \<and> x \<le> b} \<in> sets borel"
     and "{x. a \<le> x \<and>  x <e b} \<in> sets borel"
   unfolding box_oc box_co
   by (auto intro: borel_open borel_closed)
 
 lemma
   fixes i :: "'a::{second_countable_topology, real_inner}"
   shows hafspace_less_borel: "{x. a < x \<bullet> i} \<in> sets borel"
     and hafspace_greater_borel: "{x. x \<bullet> i < a} \<in> sets borel"
     and hafspace_less_eq_borel: "{x. a \<le> x \<bullet> i} \<in> sets borel"
     and hafspace_greater_eq_borel: "{x. x \<bullet> i \<le> a} \<in> sets borel"
   by simp_all
 
 lemma borel_eq_box:
   "borel = sigma UNIV (range (\<lambda> (a, b). box a b :: 'a :: euclidean_space set))"
     (is "_ = ?SIGMA")
 proof (rule borel_eq_sigmaI1[OF borel_def])
   fix M :: "'a set" assume "M \<in> {S. open S}"
   then have "open M" by simp
   show "M \<in> ?SIGMA"
     apply (subst open_UNION_box[OF \<open>open M\<close>])
     apply (safe intro!: sets.countable_UN' countable_PiE countable_Collect)
     apply (auto intro: countable_rat)
     done
 qed (auto simp: box_def)
 
 lemma halfspace_gt_in_halfspace:
   assumes i: "i \<in> A"
   shows "{x::'a. a < x \<bullet> i} \<in>
     sigma_sets UNIV ((\<lambda> (a, i). {x::'a::euclidean_space. x \<bullet> i < a}) ` (UNIV \<times> A))"
   (is "?set \<in> ?SIGMA")
 proof -
   interpret sigma_algebra UNIV ?SIGMA
     by (intro sigma_algebra_sigma_sets) simp_all
   have *: "?set = (\<Union>n. UNIV - {x::'a. x \<bullet> i < a + 1 / real (Suc n)})"
   proof (safe, simp_all add: not_less del: of_nat_Suc)
     fix x :: 'a assume "a < x \<bullet> i"
     with reals_Archimedean[of "x \<bullet> i - a"]
     obtain n where "a + 1 / real (Suc n) < x \<bullet> i"
       by (auto simp: field_simps)
     then show "\<exists>n. a + 1 / real (Suc n) \<le> x \<bullet> i"
       by (blast intro: less_imp_le)
   next
     fix x n
     have "a < a + 1 / real (Suc n)" by auto
     also assume "\<dots> \<le> x"
     finally show "a < x" .
   qed
   show "?set \<in> ?SIGMA" unfolding *
     by (auto intro!: Diff sigma_sets_Inter i)
 qed
 
 lemma borel_eq_halfspace_less:
   "borel = sigma UNIV ((\<lambda>(a, i). {x::'a::euclidean_space. x \<bullet> i < a}) ` (UNIV \<times> Basis))"
   (is "_ = ?SIGMA")
 proof (rule borel_eq_sigmaI2[OF borel_eq_box])
   fix a b :: 'a
   have "box a b = {x\<in>space ?SIGMA. \<forall>i\<in>Basis. a \<bullet> i < x \<bullet> i \<and> x \<bullet> i < b \<bullet> i}"
     by (auto simp: box_def)
   also have "\<dots> \<in> sets ?SIGMA"
     by (intro sets.sets_Collect_conj sets.sets_Collect_finite_All sets.sets_Collect_const)
        (auto intro!: halfspace_gt_in_halfspace countable_PiE countable_rat)
   finally show "box a b \<in> sets ?SIGMA" .
 qed auto
 
 lemma borel_eq_halfspace_le:
   "borel = sigma UNIV ((\<lambda> (a, i). {x::'a::euclidean_space. x \<bullet> i \<le> a}) ` (UNIV \<times> Basis))"
   (is "_ = ?SIGMA")
 proof (rule borel_eq_sigmaI2[OF borel_eq_halfspace_less])
   fix a :: real and i :: 'a assume "(a, i) \<in> UNIV \<times> Basis"
   then have i: "i \<in> Basis" by auto
   have *: "{x::'a. x\<bullet>i < a} = (\<Union>n. {x. x\<bullet>i \<le> a - 1/real (Suc n)})"
   proof (safe, simp_all del: of_nat_Suc)
     fix x::'a assume *: "x\<bullet>i < a"
     with reals_Archimedean[of "a - x\<bullet>i"]
     obtain n where "x \<bullet> i < a - 1 / (real (Suc n))"
       by (auto simp: field_simps)
     then show "\<exists>n. x \<bullet> i \<le> a - 1 / (real (Suc n))"
       by (blast intro: less_imp_le)
   next
     fix x::'a and n
     assume "x\<bullet>i \<le> a - 1 / real (Suc n)"
     also have "\<dots> < a" by auto
     finally show "x\<bullet>i < a" .
   qed
   show "{x. x\<bullet>i < a} \<in> ?SIGMA" unfolding *
     by (intro sets.countable_UN) (auto intro: i)
 qed auto
 
 lemma borel_eq_halfspace_ge:
   "borel = sigma UNIV ((\<lambda> (a, i). {x::'a::euclidean_space. a \<le> x \<bullet> i}) ` (UNIV \<times> Basis))"
   (is "_ = ?SIGMA")
 proof (rule borel_eq_sigmaI2[OF borel_eq_halfspace_less])
   fix a :: real and i :: 'a assume i: "(a, i) \<in> UNIV \<times> Basis"
   have *: "{x::'a. x\<bullet>i < a} = space ?SIGMA - {x::'a. a \<le> x\<bullet>i}" by auto
   show "{x. x\<bullet>i < a} \<in> ?SIGMA" unfolding *
     using i by (intro sets.compl_sets) auto
 qed auto
 
 lemma borel_eq_halfspace_greater:
   "borel = sigma UNIV ((\<lambda> (a, i). {x::'a::euclidean_space. a < x \<bullet> i}) ` (UNIV \<times> Basis))"
   (is "_ = ?SIGMA")
 proof (rule borel_eq_sigmaI2[OF borel_eq_halfspace_le])
   fix a :: real and i :: 'a assume "(a, i) \<in> (UNIV \<times> Basis)"
   then have i: "i \<in> Basis" by auto
   have *: "{x::'a. x\<bullet>i \<le> a} = space ?SIGMA - {x::'a. a < x\<bullet>i}" by auto
   show "{x. x\<bullet>i \<le> a} \<in> ?SIGMA" unfolding *
     by (intro sets.compl_sets) (auto intro: i)
 qed auto
 
 lemma borel_eq_atMost:
   "borel = sigma UNIV (range (\<lambda>a. {..a::'a::ordered_euclidean_space}))"
   (is "_ = ?SIGMA")
 proof (rule borel_eq_sigmaI4[OF borel_eq_halfspace_le])
   fix a :: real and i :: 'a assume "(a, i) \<in> UNIV \<times> Basis"
   then have "i \<in> Basis" by auto
   then have *: "{x::'a. x\<bullet>i \<le> a} = (\<Union>k::nat. {.. (\<Sum>n\<in>Basis. (if n = i then a else real k)*\<^sub>R n)})"
   proof (safe, simp_all add: eucl_le[where 'a='a] split: if_split_asm)
     fix x :: 'a
-    from real_arch_simple[of "Max ((\<lambda>i. x\<bullet>i)`Basis)"] guess k::nat ..
+    obtain k where "Max ((\<bullet>) x ` Basis) \<le> real k"
+      using real_arch_simple by blast
     then have "\<And>i. i \<in> Basis \<Longrightarrow> x\<bullet>i \<le> real k"
       by (subst (asm) Max_le_iff) auto
     then show "\<exists>k::nat. \<forall>ia\<in>Basis. ia \<noteq> i \<longrightarrow> x \<bullet> ia \<le> real k"
       by (auto intro!: exI[of _ k])
   qed
   show "{x. x\<bullet>i \<le> a} \<in> ?SIGMA" unfolding *
     by (intro sets.countable_UN) auto
 qed auto
 
 lemma borel_eq_greaterThan:
   "borel = sigma UNIV (range (\<lambda>a::'a::ordered_euclidean_space. {x. a <e x}))"
   (is "_ = ?SIGMA")
 proof (rule borel_eq_sigmaI4[OF borel_eq_halfspace_le])
   fix a :: real and i :: 'a assume "(a, i) \<in> UNIV \<times> Basis"
   then have i: "i \<in> Basis" by auto
   have "{x::'a. x\<bullet>i \<le> a} = UNIV - {x::'a. a < x\<bullet>i}" by auto
   also have *: "{x::'a. a < x\<bullet>i} =
       (\<Union>k::nat. {x. (\<Sum>n\<in>Basis. (if n = i then a else -real k) *\<^sub>R n) <e x})" using i
   proof (safe, simp_all add: eucl_less_def split: if_split_asm)
     fix x :: 'a
-    from reals_Archimedean2[of "Max ((\<lambda>i. -x\<bullet>i)`Basis)"]
-    guess k::nat .. note k = this
+    obtain k where k: "Max ((\<bullet>) (- x) ` Basis) < real k"
+      using reals_Archimedean2 by blast
     { fix i :: 'a assume "i \<in> Basis"
       then have "-x\<bullet>i < real k"
         using k by (subst (asm) Max_less_iff) auto
       then have "- real k < x\<bullet>i" by simp }
     then show "\<exists>k::nat. \<forall>ia\<in>Basis. ia \<noteq> i \<longrightarrow> -real k < x \<bullet> ia"
       by (auto intro!: exI[of _ k])
   qed
   finally show "{x. x\<bullet>i \<le> a} \<in> ?SIGMA"
     apply (simp only:)
     apply (intro sets.countable_UN sets.Diff)
     apply (auto intro: sigma_sets_top)
     done
 qed auto
 
 lemma borel_eq_lessThan:
   "borel = sigma UNIV (range (\<lambda>a::'a::ordered_euclidean_space. {x. x <e a}))"
   (is "_ = ?SIGMA")
 proof (rule borel_eq_sigmaI4[OF borel_eq_halfspace_ge])
   fix a :: real and i :: 'a assume "(a, i) \<in> UNIV \<times> Basis"
   then have i: "i \<in> Basis" by auto
   have "{x::'a. a \<le> x\<bullet>i} = UNIV - {x::'a. x\<bullet>i < a}" by auto
   also have *: "{x::'a. x\<bullet>i < a} = (\<Union>k::nat. {x. x <e (\<Sum>n\<in>Basis. (if n = i then a else real k) *\<^sub>R n)})" using \<open>i\<in> Basis\<close>
   proof (safe, simp_all add: eucl_less_def split: if_split_asm)
     fix x :: 'a
-    from reals_Archimedean2[of "Max ((\<lambda>i. x\<bullet>i)`Basis)"]
-    guess k::nat .. note k = this
+    obtain k where k: "Max ((\<bullet>) x ` Basis) < real k"
+      using reals_Archimedean2 by blast
     { fix i :: 'a assume "i \<in> Basis"
       then have "x\<bullet>i < real k"
         using k by (subst (asm) Max_less_iff) auto
       then have "x\<bullet>i < real k" by simp }
     then show "\<exists>k::nat. \<forall>ia\<in>Basis. ia \<noteq> i \<longrightarrow> x \<bullet> ia < real k"
       by (auto intro!: exI[of _ k])
   qed
   finally show "{x. a \<le> x\<bullet>i} \<in> ?SIGMA"
     apply (simp only:)
     apply (intro sets.countable_UN sets.Diff)
     apply (auto intro: sigma_sets_top )
     done
 qed auto
 
 lemma borel_eq_atLeastAtMost:
   "borel = sigma UNIV (range (\<lambda>(a,b). {a..b} ::'a::ordered_euclidean_space set))"
   (is "_ = ?SIGMA")
 proof (rule borel_eq_sigmaI5[OF borel_eq_atMost])
   fix a::'a
   have *: "{..a} = (\<Union>n::nat. {- real n *\<^sub>R One .. a})"
   proof (safe, simp_all add: eucl_le[where 'a='a])
     fix x :: 'a
-    from real_arch_simple[of "Max ((\<lambda>i. - x\<bullet>i)`Basis)"]
-    guess k::nat .. note k = this
+    obtain k where k: "Max ((\<bullet>) (- x) ` Basis) \<le> real k"
+      using real_arch_simple by blast
     { fix i :: 'a assume "i \<in> Basis"
       with k have "- x\<bullet>i \<le> real k"
         by (subst (asm) Max_le_iff) (auto simp: field_simps)
       then have "- real k \<le> x\<bullet>i" by simp }
     then show "\<exists>n::nat. \<forall>i\<in>Basis. - real n \<le> x \<bullet> i"
       by (auto intro!: exI[of _ k])
   qed
   show "{..a} \<in> ?SIGMA" unfolding *
     by (intro sets.countable_UN)
        (auto intro!: sigma_sets_top)
 qed auto
 
 lemma borel_set_induct[consumes 1, case_names empty interval compl union]:
   assumes "A \<in> sets borel"
   assumes empty: "P {}" and int: "\<And>a b. a \<le> b \<Longrightarrow> P {a..b}" and compl: "\<And>A. A \<in> sets borel \<Longrightarrow> P A \<Longrightarrow> P (-A)" and
           un: "\<And>f. disjoint_family f \<Longrightarrow> (\<And>i. f i \<in> sets borel) \<Longrightarrow>  (\<And>i. P (f i)) \<Longrightarrow> P (\<Union>i::nat. f i)"
   shows "P (A::real set)"
 proof -
   let ?G = "range (\<lambda>(a,b). {a..b::real})"
   have "Int_stable ?G" "?G \<subseteq> Pow UNIV" "A \<in> sigma_sets UNIV ?G"
       using assms(1) by (auto simp add: borel_eq_atLeastAtMost Int_stable_def)
   thus ?thesis
   proof (induction rule: sigma_sets_induct_disjoint)
     case (union f)
       from union.hyps(2) have "\<And>i. f i \<in> sets borel" by (auto simp: borel_eq_atLeastAtMost)
       with union show ?case by (auto intro: un)
   next
     case (basic A)
     then obtain a b where "A = {a .. b}" by auto
     then show ?case
       by (cases "a \<le> b") (auto intro: int empty)
   qed (auto intro: empty compl simp: Compl_eq_Diff_UNIV[symmetric] borel_eq_atLeastAtMost)
 qed
 
 lemma borel_sigma_sets_Ioc: "borel = sigma UNIV (range (\<lambda>(a, b). {a <.. b::real}))"
 proof (rule borel_eq_sigmaI5[OF borel_eq_atMost])
   fix i :: real
   have "{..i} = (\<Union>j::nat. {-j <.. i})"
     by (auto simp: minus_less_iff reals_Archimedean2)
   also have "\<dots> \<in> sets (sigma UNIV (range (\<lambda>(i, j). {i<..j})))"
     by (intro sets.countable_nat_UN) auto
   finally show "{..i} \<in> sets (sigma UNIV (range (\<lambda>(i, j). {i<..j})))" .
 qed simp
 
 lemma eucl_lessThan: "{x::real. x <e a} = lessThan a"
   by (simp add: eucl_less_def lessThan_def)
 
 lemma borel_eq_atLeastLessThan:
   "borel = sigma UNIV (range (\<lambda>(a, b). {a ..< b :: real}))" (is "_ = ?SIGMA")
 proof (rule borel_eq_sigmaI5[OF borel_eq_lessThan])
   have move_uminus: "\<And>x y::real. -x \<le> y \<longleftrightarrow> -y \<le> x" by auto
   fix x :: real
   have "{..<x} = (\<Union>i::nat. {-real i ..< x})"
     by (auto simp: move_uminus real_arch_simple)
   then show "{y. y <e x} \<in> ?SIGMA"
     by (auto intro: sigma_sets.intros(2-) simp: eucl_lessThan)
 qed auto
 
 lemma borel_measurable_halfspacesI:
   fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
   assumes F: "borel = sigma UNIV (F ` (UNIV \<times> Basis))"
   and S_eq: "\<And>a i. S a i = f -` F (a,i) \<inter> space M"
   shows "f \<in> borel_measurable M = (\<forall>i\<in>Basis. \<forall>a::real. S a i \<in> sets M)"
 proof safe
   fix a :: real and i :: 'b assume i: "i \<in> Basis" and f: "f \<in> borel_measurable M"
   then show "S a i \<in> sets M" unfolding assms
     by (auto intro!: measurable_sets simp: assms(1))
 next
   assume a: "\<forall>i\<in>Basis. \<forall>a. S a i \<in> sets M"
   then show "f \<in> borel_measurable M"
     by (auto intro!: measurable_measure_of simp: S_eq F)
 qed
 
 lemma borel_measurable_iff_halfspace_le:
   fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
   shows "f \<in> borel_measurable M = (\<forall>i\<in>Basis. \<forall>a. {w \<in> space M. f w \<bullet> i \<le> a} \<in> sets M)"
   by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_le]) auto
 
 lemma borel_measurable_iff_halfspace_less:
   fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
   shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i\<in>Basis. \<forall>a. {w \<in> space M. f w \<bullet> i < a} \<in> sets M)"
   by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_less]) auto
 
 lemma borel_measurable_iff_halfspace_ge:
   fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
   shows "f \<in> borel_measurable M = (\<forall>i\<in>Basis. \<forall>a. {w \<in> space M. a \<le> f w \<bullet> i} \<in> sets M)"
   by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_ge]) auto
 
 lemma borel_measurable_iff_halfspace_greater:
   fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
   shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i\<in>Basis. \<forall>a. {w \<in> space M. a < f w \<bullet> i} \<in> sets M)"
   by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_greater]) auto
 
 lemma borel_measurable_iff_le:
   "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. f w \<le> a} \<in> sets M)"
   using borel_measurable_iff_halfspace_le[where 'c=real] by simp
 
 lemma borel_measurable_iff_less:
   "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. f w < a} \<in> sets M)"
   using borel_measurable_iff_halfspace_less[where 'c=real] by simp
 
 lemma borel_measurable_iff_ge:
   "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. a \<le> f w} \<in> sets M)"
   using borel_measurable_iff_halfspace_ge[where 'c=real]
   by simp
 
 lemma borel_measurable_iff_greater:
   "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. a < f w} \<in> sets M)"
   using borel_measurable_iff_halfspace_greater[where 'c=real] by simp
 
 lemma borel_measurable_euclidean_space:
   fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
   shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i\<in>Basis. (\<lambda>x. f x \<bullet> i) \<in> borel_measurable M)"
 proof safe
   assume f: "\<forall>i\<in>Basis. (\<lambda>x. f x \<bullet> i) \<in> borel_measurable M"
   then show "f \<in> borel_measurable M"
     by (subst borel_measurable_iff_halfspace_le) auto
 qed auto
 
 subsection "Borel measurable operators"
 
 lemma borel_measurable_norm[measurable]: "norm \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_intros)
 
 lemma borel_measurable_sgn [measurable]: "(sgn::'a::real_normed_vector \<Rightarrow> 'a) \<in> borel_measurable borel"
   by (rule borel_measurable_continuous_countable_exceptions[where X="{0}"])
      (auto intro!: continuous_on_sgn continuous_on_id)
 
 lemma borel_measurable_uminus[measurable (raw)]:
   fixes g :: "'a \<Rightarrow> 'b::{second_countable_topology, real_normed_vector}"
   assumes g: "g \<in> borel_measurable M"
   shows "(\<lambda>x. - g x) \<in> borel_measurable M"
   by (rule borel_measurable_continuous_on[OF _ g]) (intro continuous_intros)
 
 lemma borel_measurable_diff[measurable (raw)]:
   fixes f :: "'a \<Rightarrow> 'b::{second_countable_topology, real_normed_vector}"
   assumes f: "f \<in> borel_measurable M"
   assumes g: "g \<in> borel_measurable M"
   shows "(\<lambda>x. f x - g x) \<in> borel_measurable M"
   using borel_measurable_add [of f M "- g"] assms by (simp add: fun_Compl_def)
 
 lemma borel_measurable_times[measurable (raw)]:
   fixes f :: "'a \<Rightarrow> 'b::{second_countable_topology, real_normed_algebra}"
   assumes f: "f \<in> borel_measurable M"
   assumes g: "g \<in> borel_measurable M"
   shows "(\<lambda>x. f x * g x) \<in> borel_measurable M"
   using f g by (rule borel_measurable_continuous_Pair) (intro continuous_intros)
 
 lemma borel_measurable_prod[measurable (raw)]:
   fixes f :: "'c \<Rightarrow> 'a \<Rightarrow> 'b::{second_countable_topology, real_normed_field}"
   assumes "\<And>i. i \<in> S \<Longrightarrow> f i \<in> borel_measurable M"
   shows "(\<lambda>x. \<Prod>i\<in>S. f i x) \<in> borel_measurable M"
 proof cases
   assume "finite S"
   thus ?thesis using assms by induct auto
 qed simp
 
 lemma borel_measurable_dist[measurable (raw)]:
   fixes g f :: "'a \<Rightarrow> 'b::{second_countable_topology, metric_space}"
   assumes f: "f \<in> borel_measurable M"
   assumes g: "g \<in> borel_measurable M"
   shows "(\<lambda>x. dist (f x) (g x)) \<in> borel_measurable M"
   using f g by (rule borel_measurable_continuous_Pair) (intro continuous_intros)
 
 lemma borel_measurable_scaleR[measurable (raw)]:
   fixes g :: "'a \<Rightarrow> 'b::{second_countable_topology, real_normed_vector}"
   assumes f: "f \<in> borel_measurable M"
   assumes g: "g \<in> borel_measurable M"
   shows "(\<lambda>x. f x *\<^sub>R g x) \<in> borel_measurable M"
   using f g by (rule borel_measurable_continuous_Pair) (intro continuous_intros)
 
 lemma borel_measurable_uminus_eq [simp]:
   fixes f :: "'a \<Rightarrow> 'b::{second_countable_topology, real_normed_vector}"
   shows "(\<lambda>x. - f x) \<in> borel_measurable M \<longleftrightarrow> f \<in> borel_measurable M" (is "?l = ?r")
 proof
   assume ?l from borel_measurable_uminus[OF this] show ?r by simp
 qed auto
 
 lemma affine_borel_measurable_vector:
   fixes f :: "'a \<Rightarrow> 'x::real_normed_vector"
   assumes "f \<in> borel_measurable M"
   shows "(\<lambda>x. a + b *\<^sub>R f x) \<in> borel_measurable M"
 proof (rule borel_measurableI)
   fix S :: "'x set" assume "open S"
   show "(\<lambda>x. a + b *\<^sub>R f x) -` S \<inter> space M \<in> sets M"
   proof cases
     assume "b \<noteq> 0"
     with \<open>open S\<close> have "open ((\<lambda>x. (- a + x) /\<^sub>R b) ` S)" (is "open ?S")
       using open_affinity [of S "inverse b" "- a /\<^sub>R b"]
       by (auto simp: algebra_simps)
     hence "?S \<in> sets borel" by auto
     moreover
     from \<open>b \<noteq> 0\<close> have "(\<lambda>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)
     ultimately show ?thesis using assms unfolding in_borel_measurable_borel
       by auto
   qed simp
 qed
 
 lemma borel_measurable_const_scaleR[measurable (raw)]:
   "f \<in> borel_measurable M \<Longrightarrow> (\<lambda>x. b *\<^sub>R f x ::'a::real_normed_vector) \<in> borel_measurable M"
   using affine_borel_measurable_vector[of f M 0 b] by simp
 
 lemma borel_measurable_const_add[measurable (raw)]:
   "f \<in> borel_measurable M \<Longrightarrow> (\<lambda>x. a + f x ::'a::real_normed_vector) \<in> borel_measurable M"
   using affine_borel_measurable_vector[of f M a 1] by simp
 
 lemma borel_measurable_inverse[measurable (raw)]:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_div_algebra"
   assumes f: "f \<in> borel_measurable M"
   shows "(\<lambda>x. inverse (f x)) \<in> 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
 
 lemma borel_measurable_divide[measurable (raw)]:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow>
     (\<lambda>x. f x / g x::'b::{second_countable_topology, real_normed_div_algebra}) \<in> borel_measurable M"
   by (simp add: divide_inverse)
 
 lemma borel_measurable_abs[measurable (raw)]:
   "f \<in> borel_measurable M \<Longrightarrow> (\<lambda>x. \<bar>f x :: real\<bar>) \<in> borel_measurable M"
   unfolding abs_real_def by simp
 
 lemma borel_measurable_nth[measurable (raw)]:
   "(\<lambda>x::real^'n. x $ i) \<in> borel_measurable borel"
   by (simp add: cart_eq_inner_axis)
 
 lemma convex_measurable:
   fixes A :: "'a :: euclidean_space set"
   shows "X \<in> borel_measurable M \<Longrightarrow> X ` space M \<subseteq> A \<Longrightarrow> open A \<Longrightarrow> convex_on A q \<Longrightarrow>
     (\<lambda>x. q (X x)) \<in> borel_measurable M"
   by (rule measurable_compose[where f=X and N="restrict_space borel A"])
      (auto intro!: borel_measurable_continuous_on_restrict convex_on_continuous measurable_restrict_space2)
 
 lemma borel_measurable_ln[measurable (raw)]:
   assumes f: "f \<in> borel_measurable M"
   shows "(\<lambda>x. ln (f x :: real)) \<in> 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
 
 lemma borel_measurable_log[measurable (raw)]:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (\<lambda>x. log (g x) (f x)) \<in> borel_measurable M"
   unfolding log_def by auto
 
 lemma borel_measurable_exp[measurable]:
   "(exp::'a::{real_normed_field,banach}\<Rightarrow>'a) \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_at_imp_continuous_on ballI isCont_exp)
 
 lemma measurable_real_floor[measurable]:
   "(floor :: real \<Rightarrow> int) \<in> measurable borel (count_space UNIV)"
 proof -
   have "\<And>a x. \<lfloor>x\<rfloor> = a \<longleftrightarrow> (real_of_int a \<le> x \<and> x < real_of_int (a + 1))"
     by (auto intro: floor_eq2)
   then show ?thesis
     by (auto simp: vimage_def measurable_count_space_eq2_countable)
 qed
 
 lemma measurable_real_ceiling[measurable]:
   "(ceiling :: real \<Rightarrow> int) \<in> measurable borel (count_space UNIV)"
   unfolding ceiling_def[abs_def] by simp
 
 lemma borel_measurable_real_floor: "(\<lambda>x::real. real_of_int \<lfloor>x\<rfloor>) \<in> borel_measurable borel"
   by simp
 
 lemma borel_measurable_root [measurable]: "root n \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_intros)
 
 lemma borel_measurable_sqrt [measurable]: "sqrt \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_intros)
 
 lemma borel_measurable_power [measurable (raw)]:
   fixes f :: "_ \<Rightarrow> 'b::{power,real_normed_algebra}"
   assumes f: "f \<in> borel_measurable M"
   shows "(\<lambda>x. (f x) ^ n) \<in> borel_measurable M"
   by (intro borel_measurable_continuous_on [OF _ f] continuous_intros)
 
 lemma borel_measurable_Re [measurable]: "Re \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_intros)
 
 lemma borel_measurable_Im [measurable]: "Im \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_intros)
 
 lemma borel_measurable_of_real [measurable]: "(of_real :: _ \<Rightarrow> (_::real_normed_algebra)) \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_intros)
 
 lemma borel_measurable_sin [measurable]: "(sin :: _ \<Rightarrow> (_::{real_normed_field,banach})) \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_intros)
 
 lemma borel_measurable_cos [measurable]: "(cos :: _ \<Rightarrow> (_::{real_normed_field,banach})) \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_intros)
 
 lemma borel_measurable_arctan [measurable]: "arctan \<in> borel_measurable borel"
   by (intro borel_measurable_continuous_onI continuous_intros)
 
 lemma\<^marker>\<open>tag important\<close> borel_measurable_complex_iff:
   "f \<in> borel_measurable M \<longleftrightarrow>
     (\<lambda>x. Re (f x)) \<in> borel_measurable M \<and> (\<lambda>x. Im (f x)) \<in> borel_measurable M"
   apply auto
   apply (subst fun_complex_eq)
   apply (intro borel_measurable_add)
   apply auto
   done
 
 lemma powr_real_measurable [measurable]:
   assumes "f \<in> measurable M borel" "g \<in> measurable M borel"
   shows   "(\<lambda>x. f x powr g x :: real) \<in> measurable M borel"
   using assms by (simp_all add: powr_def)
 
 lemma measurable_of_bool[measurable]: "of_bool \<in> count_space UNIV \<rightarrow>\<^sub>M borel"
   by simp
 
 subsection "Borel space on the extended reals"
 
 lemma borel_measurable_ereal[measurable (raw)]:
   assumes f: "f \<in> borel_measurable M" shows "(\<lambda>x. ereal (f x)) \<in> borel_measurable M"
   using continuous_on_ereal f by (rule borel_measurable_continuous_on) (rule continuous_on_id)
 
 lemma borel_measurable_real_of_ereal[measurable (raw)]:
   fixes f :: "'a \<Rightarrow> ereal"
   assumes f: "f \<in> borel_measurable M"
   shows "(\<lambda>x. real_of_ereal (f x)) \<in> borel_measurable M"
   apply (rule measurable_compose[OF f])
   apply (rule borel_measurable_continuous_countable_exceptions[of "{\<infinity>, -\<infinity> }"])
   apply (auto intro: continuous_on_real simp: Compl_eq_Diff_UNIV)
   done
 
 lemma borel_measurable_ereal_cases:
   fixes f :: "'a \<Rightarrow> ereal"
   assumes f: "f \<in> borel_measurable M"
   assumes H: "(\<lambda>x. H (ereal (real_of_ereal (f x)))) \<in> borel_measurable M"
   shows "(\<lambda>x. H (f x)) \<in> borel_measurable M"
 proof -
   let ?F = "\<lambda>x. if f x = \<infinity> then H \<infinity> else if f x = - \<infinity> then H (-\<infinity>) else H (ereal (real_of_ereal (f x)))"
   { fix x have "H (f x) = ?F x" by (cases "f x") auto }
   with f H show ?thesis by simp
 qed
 
 lemma
   fixes f :: "'a \<Rightarrow> ereal" assumes f[measurable]: "f \<in> borel_measurable M"
   shows borel_measurable_ereal_abs[measurable(raw)]: "(\<lambda>x. \<bar>f x\<bar>) \<in> borel_measurable M"
     and borel_measurable_ereal_inverse[measurable(raw)]: "(\<lambda>x. inverse (f x) :: ereal) \<in> borel_measurable M"
     and borel_measurable_uminus_ereal[measurable(raw)]: "(\<lambda>x. - f x :: ereal) \<in> borel_measurable M"
   by (auto simp del: abs_real_of_ereal simp: borel_measurable_ereal_cases[OF f] measurable_If)
 
 lemma borel_measurable_uminus_eq_ereal[simp]:
   "(\<lambda>x. - f x :: ereal) \<in> borel_measurable M \<longleftrightarrow> f \<in> borel_measurable M" (is "?l = ?r")
 proof
   assume ?l from borel_measurable_uminus_ereal[OF this] show ?r by simp
 qed auto
 
 lemma set_Collect_ereal2:
   fixes f g :: "'a \<Rightarrow> ereal"
   assumes f: "f \<in> borel_measurable M"
   assumes g: "g \<in> borel_measurable M"
   assumes H: "{x \<in> space M. H (ereal (real_of_ereal (f x))) (ereal (real_of_ereal (g x)))} \<in> sets M"
     "{x \<in> space borel. H (-\<infinity>) (ereal x)} \<in> sets borel"
     "{x \<in> space borel. H (\<infinity>) (ereal x)} \<in> sets borel"
     "{x \<in> space borel. H (ereal x) (-\<infinity>)} \<in> sets borel"
     "{x \<in> space borel. H (ereal x) (\<infinity>)} \<in> sets borel"
   shows "{x \<in> space M. H (f x) (g x)} \<in> sets M"
 proof -
   let ?G = "\<lambda>y x. if g x = \<infinity> then H y \<infinity> else if g x = -\<infinity> then H y (-\<infinity>) else H y (ereal (real_of_ereal (g x)))"
   let ?F = "\<lambda>x. if f x = \<infinity> then ?G \<infinity> x else if f x = -\<infinity> then ?G (-\<infinity>) x else ?G (ereal (real_of_ereal (f x))) x"
   { fix x have "H (f x) (g x) = ?F x" by (cases "f x" "g x" rule: ereal2_cases) auto }
   note * = this
   from assms show ?thesis
     by (subst *) (simp del: space_borel split del: if_split)
 qed
 
 lemma borel_measurable_ereal_iff:
   shows "(\<lambda>x. ereal (f x)) \<in> borel_measurable M \<longleftrightarrow> f \<in> borel_measurable M"
 proof
   assume "(\<lambda>x. ereal (f x)) \<in> borel_measurable M"
   from borel_measurable_real_of_ereal[OF this]
   show "f \<in> borel_measurable M" by auto
 qed auto
 
 lemma borel_measurable_erealD[measurable_dest]:
   "(\<lambda>x. ereal (f x)) \<in> borel_measurable M \<Longrightarrow> g \<in> measurable N M \<Longrightarrow> (\<lambda>x. f (g x)) \<in> borel_measurable N"
   unfolding borel_measurable_ereal_iff by simp
 
 theorem borel_measurable_ereal_iff_real:
   fixes f :: "'a \<Rightarrow> ereal"
   shows "f \<in> borel_measurable M \<longleftrightarrow>
     ((\<lambda>x. real_of_ereal (f x)) \<in> borel_measurable M \<and> f -` {\<infinity>} \<inter> space M \<in> sets M \<and> f -` {-\<infinity>} \<inter> space M \<in> sets M)"
 proof safe
   assume *: "(\<lambda>x. real_of_ereal (f x)) \<in> borel_measurable M" "f -` {\<infinity>} \<inter> space M \<in> sets M" "f -` {-\<infinity>} \<inter> space M \<in> sets M"
   have "f -` {\<infinity>} \<inter> space M = {x\<in>space M. f x = \<infinity>}" "f -` {-\<infinity>} \<inter> space M = {x\<in>space M. f x = -\<infinity>}" by auto
   with * have **: "{x\<in>space M. f x = \<infinity>} \<in> sets M" "{x\<in>space M. f x = -\<infinity>} \<in> sets M" by simp_all
   let ?f = "\<lambda>x. if f x = \<infinity> then \<infinity> else if f x = -\<infinity> then -\<infinity> else ereal (real_of_ereal (f x))"
   have "?f \<in> borel_measurable M" using * ** by (intro measurable_If) auto
   also have "?f = f" by (auto simp: fun_eq_iff ereal_real)
   finally show "f \<in> borel_measurable M" .
 qed simp_all
 
 lemma borel_measurable_ereal_iff_Iio:
   "(f::'a \<Rightarrow> ereal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. f -` {..< a} \<inter> space M \<in> sets M)"
   by (auto simp: borel_Iio measurable_iff_measure_of)
 
 lemma borel_measurable_ereal_iff_Ioi:
   "(f::'a \<Rightarrow> ereal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. f -` {a <..} \<inter> space M \<in> sets M)"
   by (auto simp: borel_Ioi measurable_iff_measure_of)
 
 lemma vimage_sets_compl_iff:
   "f -` A \<inter> space M \<in> sets M \<longleftrightarrow> f -` (- A) \<inter> space M \<in> sets M"
 proof -
   { fix A assume "f -` A \<inter> space M \<in> sets M"
     moreover have "f -` (- A) \<inter> space M = space M - f -` A \<inter> space M" by auto
     ultimately have "f -` (- A) \<inter> space M \<in> sets M" by auto }
   from this[of A] this[of "-A"] show ?thesis
     by (metis double_complement)
 qed
 
 lemma borel_measurable_iff_Iic_ereal:
   "(f::'a\<Rightarrow>ereal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. f -` {..a} \<inter> space M \<in> sets M)"
   unfolding borel_measurable_ereal_iff_Ioi vimage_sets_compl_iff[where A="{a <..}" for a] by simp
 
 lemma borel_measurable_iff_Ici_ereal:
   "(f::'a \<Rightarrow> ereal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. f -` {a..} \<inter> space M \<in> sets M)"
   unfolding borel_measurable_ereal_iff_Iio vimage_sets_compl_iff[where A="{..< a}" for a] by simp
 
 lemma borel_measurable_ereal2:
   fixes f g :: "'a \<Rightarrow> ereal"
   assumes f: "f \<in> borel_measurable M"
   assumes g: "g \<in> borel_measurable M"
   assumes H: "(\<lambda>x. H (ereal (real_of_ereal (f x))) (ereal (real_of_ereal (g x)))) \<in> borel_measurable M"
     "(\<lambda>x. H (-\<infinity>) (ereal (real_of_ereal (g x)))) \<in> borel_measurable M"
     "(\<lambda>x. H (\<infinity>) (ereal (real_of_ereal (g x)))) \<in> borel_measurable M"
     "(\<lambda>x. H (ereal (real_of_ereal (f x))) (-\<infinity>)) \<in> borel_measurable M"
     "(\<lambda>x. H (ereal (real_of_ereal (f x))) (\<infinity>)) \<in> borel_measurable M"
   shows "(\<lambda>x. H (f x) (g x)) \<in> borel_measurable M"
 proof -
   let ?G = "\<lambda>y x. if g x = \<infinity> then H y \<infinity> else if g x = - \<infinity> then H y (-\<infinity>) else H y (ereal (real_of_ereal (g x)))"
   let ?F = "\<lambda>x. if f x = \<infinity> then ?G \<infinity> x else if f x = - \<infinity> then ?G (-\<infinity>) x else ?G (ereal (real_of_ereal (f x))) x"
   { fix x have "H (f x) (g x) = ?F x" by (cases "f x" "g x" rule: ereal2_cases) auto }
   note * = this
   from assms show ?thesis unfolding * by simp
 qed
 
 lemma [measurable(raw)]:
   fixes f :: "'a \<Rightarrow> ereal"
   assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   shows borel_measurable_ereal_add: "(\<lambda>x. f x + g x) \<in> borel_measurable M"
     and borel_measurable_ereal_times: "(\<lambda>x. f x * g x) \<in> borel_measurable M"
   by (simp_all add: borel_measurable_ereal2)
 
 lemma [measurable(raw)]:
   fixes f g :: "'a \<Rightarrow> ereal"
   assumes "f \<in> borel_measurable M"
   assumes "g \<in> borel_measurable M"
   shows borel_measurable_ereal_diff: "(\<lambda>x. f x - g x) \<in> borel_measurable M"
     and borel_measurable_ereal_divide: "(\<lambda>x. f x / g x) \<in> borel_measurable M"
   using assms by (simp_all add: minus_ereal_def divide_ereal_def)
 
 lemma borel_measurable_ereal_sum[measurable (raw)]:
   fixes f :: "'c \<Rightarrow> 'a \<Rightarrow> ereal"
   assumes "\<And>i. i \<in> S \<Longrightarrow> f i \<in> borel_measurable M"
   shows "(\<lambda>x. \<Sum>i\<in>S. f i x) \<in> borel_measurable M"
   using assms by (induction S rule: infinite_finite_induct) auto
 
 lemma borel_measurable_ereal_prod[measurable (raw)]:
   fixes f :: "'c \<Rightarrow> 'a \<Rightarrow> ereal"
   assumes "\<And>i. i \<in> S \<Longrightarrow> f i \<in> borel_measurable M"
   shows "(\<lambda>x. \<Prod>i\<in>S. f i x) \<in> borel_measurable M"
   using assms by (induction S rule: infinite_finite_induct) auto
 
 lemma borel_measurable_extreal_suminf[measurable (raw)]:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> ereal"
   assumes [measurable]: "\<And>i. f i \<in> borel_measurable M"
   shows "(\<lambda>x. (\<Sum>i. f i x)) \<in> borel_measurable M"
   unfolding suminf_def sums_def[abs_def] lim_def[symmetric] by simp
 
 subsection "Borel space on the extended non-negative reals"
 
 text \<open> \<^type>\<open>ennreal\<close> is a topological monoid, so no rules for plus are required, also all order
   statements are usually done on type classes. \<close>
 
 lemma measurable_enn2ereal[measurable]: "enn2ereal \<in> borel \<rightarrow>\<^sub>M borel"
   by (intro borel_measurable_continuous_onI continuous_on_enn2ereal)
 
 lemma measurable_e2ennreal[measurable]: "e2ennreal \<in> borel \<rightarrow>\<^sub>M borel"
   by (intro borel_measurable_continuous_onI continuous_on_e2ennreal)
 
 lemma borel_measurable_enn2real[measurable (raw)]:
   "f \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> (\<lambda>x. enn2real (f x)) \<in> M \<rightarrow>\<^sub>M borel"
   unfolding enn2real_def[abs_def] by measurable
 
 definition\<^marker>\<open>tag important\<close> [simp]: "is_borel f M \<longleftrightarrow> f \<in> borel_measurable M"
 
 lemma is_borel_transfer[transfer_rule]: "rel_fun (rel_fun (=) pcr_ennreal) (=) is_borel is_borel"
   unfolding is_borel_def[abs_def]
 proof (safe intro!: rel_funI ext dest!: rel_fun_eq_pcr_ennreal[THEN iffD1])
   fix f and M :: "'a measure"
   show "f \<in> borel_measurable M" if f: "enn2ereal \<circ> f \<in> borel_measurable M"
     using measurable_compose[OF f measurable_e2ennreal] by simp
 qed simp
 
 context
   includes ennreal.lifting
 begin
 
 lemma measurable_ennreal[measurable]: "ennreal \<in> borel \<rightarrow>\<^sub>M borel"
   unfolding is_borel_def[symmetric]
   by transfer simp
 
 lemma borel_measurable_ennreal_iff[simp]:
   assumes [simp]: "\<And>x. x \<in> space M \<Longrightarrow> 0 \<le> f x"
   shows "(\<lambda>x. ennreal (f x)) \<in> M \<rightarrow>\<^sub>M borel \<longleftrightarrow> f \<in> M \<rightarrow>\<^sub>M borel"
 proof safe
   assume "(\<lambda>x. ennreal (f x)) \<in> M \<rightarrow>\<^sub>M borel"
   then have "(\<lambda>x. enn2real (ennreal (f x))) \<in> M \<rightarrow>\<^sub>M borel"
     by measurable
   then show "f \<in> M \<rightarrow>\<^sub>M borel"
     by (rule measurable_cong[THEN iffD1, rotated]) auto
 qed measurable
 
 lemma borel_measurable_times_ennreal[measurable (raw)]:
   fixes f g :: "'a \<Rightarrow> ennreal"
   shows "f \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> g \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> (\<lambda>x. f x * g x) \<in> M \<rightarrow>\<^sub>M borel"
   unfolding is_borel_def[symmetric] by transfer simp
 
 lemma borel_measurable_inverse_ennreal[measurable (raw)]:
   fixes f :: "'a \<Rightarrow> ennreal"
   shows "f \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> (\<lambda>x. inverse (f x)) \<in> M \<rightarrow>\<^sub>M borel"
   unfolding is_borel_def[symmetric] by transfer simp
 
 lemma borel_measurable_divide_ennreal[measurable (raw)]:
   fixes f :: "'a \<Rightarrow> ennreal"
   shows "f \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> g \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> (\<lambda>x. f x / g x) \<in> M \<rightarrow>\<^sub>M borel"
   unfolding divide_ennreal_def by simp
 
 lemma borel_measurable_minus_ennreal[measurable (raw)]:
   fixes f :: "'a \<Rightarrow> ennreal"
   shows "f \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> g \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> (\<lambda>x. f x - g x) \<in> M \<rightarrow>\<^sub>M borel"
   unfolding is_borel_def[symmetric] by transfer simp
 
 lemma borel_measurable_power_ennreal [measurable (raw)]:
   fixes f :: "_ \<Rightarrow> ennreal"
   assumes f: "f \<in> borel_measurable M"
   shows "(\<lambda>x. (f x) ^ n) \<in> borel_measurable M"
   by (induction n) (use f in auto)
 
 lemma borel_measurable_prod_ennreal[measurable (raw)]:
   fixes f :: "'c \<Rightarrow> 'a \<Rightarrow> ennreal"
   assumes "\<And>i. i \<in> S \<Longrightarrow> f i \<in> borel_measurable M"
   shows "(\<lambda>x. \<Prod>i\<in>S. f i x) \<in> borel_measurable M"
   using assms by (induction S rule: infinite_finite_induct) auto
 
 end
 
 hide_const (open) is_borel
 
 subsection \<open>LIMSEQ is borel measurable\<close>
 
 lemma borel_measurable_LIMSEQ_real:
   fixes u :: "nat \<Rightarrow> 'a \<Rightarrow> real"
   assumes u': "\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. u i x) \<longlonglongrightarrow> u' x"
   and u: "\<And>i. u i \<in> borel_measurable M"
   shows "u' \<in> borel_measurable M"
 proof -
   have "\<And>x. x \<in> space M \<Longrightarrow> liminf (\<lambda>n. ereal (u n x)) = ereal (u' x)"
     using u' by (simp add: lim_imp_Liminf)
   moreover from u have "(\<lambda>x. liminf (\<lambda>n. ereal (u n x))) \<in> borel_measurable M"
     by auto
   ultimately show ?thesis by (simp cong: measurable_cong add: borel_measurable_ereal_iff)
 qed
 
 lemma borel_measurable_LIMSEQ_metric:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> 'b :: metric_space"
   assumes [measurable]: "\<And>i. f i \<in> borel_measurable M"
   assumes lim: "\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. f i x) \<longlonglongrightarrow> g x"
   shows "g \<in> borel_measurable M"
   unfolding borel_eq_closed
 proof (safe intro!: measurable_measure_of)
   fix A :: "'b set" assume "closed A"
 
   have [measurable]: "(\<lambda>x. infdist (g x) A) \<in> borel_measurable M"
   proof (rule borel_measurable_LIMSEQ_real)
     show "\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. infdist (f i x) A) \<longlonglongrightarrow> infdist (g x) A"
       by (intro tendsto_infdist lim)
     show "\<And>i. (\<lambda>x. infdist (f i x) A) \<in> borel_measurable M"
       by (intro borel_measurable_continuous_on[where f="\<lambda>x. infdist x A"]
         continuous_at_imp_continuous_on ballI continuous_infdist continuous_ident) auto
   qed
 
   show "g -` A \<inter> space M \<in> sets M"
   proof cases
     assume "A \<noteq> {}"
     then have "\<And>x. infdist x A = 0 \<longleftrightarrow> x \<in> A"
       using \<open>closed A\<close> by (simp add: in_closed_iff_infdist_zero)
     then have "g -` A \<inter> space M = {x\<in>space M. infdist (g x) A = 0}"
       by auto
     also have "\<dots> \<in> sets M"
       by measurable
     finally show ?thesis .
   qed simp
 qed auto
 
 lemma sets_Collect_Cauchy[measurable]:
   fixes f :: "nat \<Rightarrow> 'a => 'b::{metric_space, second_countable_topology}"
   assumes f[measurable]: "\<And>i. f i \<in> borel_measurable M"
   shows "{x\<in>space M. Cauchy (\<lambda>i. f i x)} \<in> sets M"
   unfolding metric_Cauchy_iff2 using f by auto
 
 lemma borel_measurable_lim_metric[measurable (raw)]:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes f[measurable]: "\<And>i. f i \<in> borel_measurable M"
   shows "(\<lambda>x. lim (\<lambda>i. f i x)) \<in> borel_measurable M"
 proof -
   define u' where "u' x = lim (\<lambda>i. if Cauchy (\<lambda>i. f i x) then f i x else 0)" for x
   then have *: "\<And>x. lim (\<lambda>i. f i x) = (if Cauchy (\<lambda>i. f i x) then u' x else (THE x. False))"
     by (auto simp: lim_def convergent_eq_Cauchy[symmetric])
   have "u' \<in> borel_measurable M"
   proof (rule borel_measurable_LIMSEQ_metric)
     fix x
     have "convergent (\<lambda>i. if Cauchy (\<lambda>i. f i x) then f i x else 0)"
       by (cases "Cauchy (\<lambda>i. f i x)")
          (auto simp add: convergent_eq_Cauchy[symmetric] convergent_def)
     then show "(\<lambda>i. if Cauchy (\<lambda>i. f i x) then f i x else 0) \<longlonglongrightarrow> u' x"
       unfolding u'_def
       by (rule convergent_LIMSEQ_iff[THEN iffD1])
   qed measurable
   then show ?thesis
     unfolding * by measurable
 qed
 
 lemma borel_measurable_suminf[measurable (raw)]:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes f[measurable]: "\<And>i. f i \<in> borel_measurable M"
   shows "(\<lambda>x. suminf (\<lambda>i. f i x)) \<in> borel_measurable M"
   unfolding suminf_def sums_def[abs_def] lim_def[symmetric] by simp
 
 lemma Collect_closed_imp_pred_borel: "closed {x. P x} \<Longrightarrow> Measurable.pred borel P"
   by (simp add: pred_def)
 
 (* Proof by Jeremy Avigad and Luke Serafin *)
 lemma isCont_borel_pred[measurable]:
   fixes f :: "'b::metric_space \<Rightarrow> 'a::metric_space"
   shows "Measurable.pred borel (isCont f)"
 proof (subst measurable_cong)
   let ?I = "\<lambda>j. inverse(real (Suc j))"
   show "isCont f x = (\<forall>i. \<exists>j. \<forall>y z. dist x y < ?I j \<and> dist x z < ?I j \<longrightarrow> dist (f y) (f z) \<le> ?I i)" for x
     unfolding continuous_at_eps_delta
   proof safe
     fix i assume "\<forall>e>0. \<exists>d>0. \<forall>y. dist y x < d \<longrightarrow> dist (f y) (f x) < e"
     moreover have "0 < ?I i / 2"
       by simp
     ultimately obtain d where d: "0 < d" "\<And>y. dist x y < d \<Longrightarrow> dist (f y) (f x) < ?I i / 2"
       by (metis dist_commute)
     then obtain j where j: "?I j < d"
       by (metis reals_Archimedean)
 
     show "\<exists>j. \<forall>y z. dist x y < ?I j \<and> dist x z < ?I j \<longrightarrow> dist (f y) (f z) \<le> ?I i"
     proof (safe intro!: exI[where x=j])
       fix y z assume *: "dist x y < ?I j" "dist x z < ?I j"
       have "dist (f y) (f z) \<le> dist (f y) (f x) + dist (f z) (f x)"
         by (rule dist_triangle2)
       also have "\<dots> < ?I i / 2 + ?I i / 2"
         by (intro add_strict_mono d less_trans[OF _ j] *)
       also have "\<dots> \<le> ?I i"
         by (simp add: field_simps)
       finally show "dist (f y) (f z) \<le> ?I i"
         by simp
     qed
   next
     fix e::real assume "0 < e"
     then obtain n where n: "?I n < e"
       by (metis reals_Archimedean)
     assume "\<forall>i. \<exists>j. \<forall>y z. dist x y < ?I j \<and> dist x z < ?I j \<longrightarrow> dist (f y) (f z) \<le> ?I i"
     from this[THEN spec, of "Suc n"]
     obtain j where j: "\<And>y z. dist x y < ?I j \<Longrightarrow> dist x z < ?I j \<Longrightarrow> dist (f y) (f z) \<le> ?I (Suc n)"
       by auto
 
     show "\<exists>d>0. \<forall>y. dist y x < d \<longrightarrow> dist (f y) (f x) < e"
     proof (safe intro!: exI[of _ "?I j"])
       fix y assume "dist y x < ?I j"
       then have "dist (f y) (f x) \<le> ?I (Suc n)"
         by (intro j) (auto simp: dist_commute)
       also have "?I (Suc n) < ?I n"
         by simp
       also note n
       finally show "dist (f y) (f x) < e" .
     qed simp
   qed
 qed (intro pred_intros_countable closed_Collect_all closed_Collect_le open_Collect_less
            Collect_closed_imp_pred_borel closed_Collect_imp open_Collect_conj continuous_intros)
 
 lemma isCont_borel:
   fixes f :: "'b::metric_space \<Rightarrow> 'a::metric_space"
   shows "{x. isCont f x} \<in> sets borel"
   by simp
 
 lemma is_real_interval:
   assumes S: "is_interval S"
   shows "\<exists>a b::real. S = {} \<or> S = UNIV \<or> S = {..<b} \<or> S = {..b} \<or> S = {a<..} \<or> S = {a..} \<or>
     S = {a<..<b} \<or> S = {a<..b} \<or> S = {a..<b} \<or> S = {a..b}"
   using S unfolding is_interval_1 by (blast intro: interval_cases)
 
 lemma real_interval_borel_measurable:
   assumes "is_interval (S::real set)"
   shows "S \<in> sets borel"
 proof -
   from assms is_real_interval have "\<exists>a b::real. S = {} \<or> S = UNIV \<or> S = {..<b} \<or> S = {..b} \<or>
     S = {a<..} \<or> S = {a..} \<or> S = {a<..<b} \<or> S = {a<..b} \<or> S = {a..<b} \<or> S = {a..b}" by auto
-  then guess a ..
-  then guess b ..
-  thus ?thesis
+  then show ?thesis
     by auto
 qed
 
 text \<open>The next lemmas hold in any second countable linorder (including ennreal or ereal for instance),
 but in the current state they are restricted to reals.\<close>
 
 lemma borel_measurable_mono_on_fnc:
   fixes f :: "real \<Rightarrow> real" and A :: "real set"
   assumes "mono_on f A"
   shows "f \<in> 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
 
 lemma borel_measurable_piecewise_mono:
   fixes f::"real \<Rightarrow> real" and C::"real set set"
   assumes "countable C" "\<And>c. c \<in> C \<Longrightarrow> c \<in> sets borel" "\<And>c. c \<in> C \<Longrightarrow> mono_on f c" "(\<Union>C) = UNIV"
   shows "f \<in> borel_measurable borel"
   by (rule measurable_piecewise_restrict[of C], auto intro: borel_measurable_mono_on_fnc simp: assms)
 
 lemma borel_measurable_mono:
   fixes f :: "real \<Rightarrow> real"
   shows "mono f \<Longrightarrow> f \<in> borel_measurable borel"
   using borel_measurable_mono_on_fnc[of f UNIV] by (simp add: mono_def mono_on_def)
 
 lemma measurable_bdd_below_real[measurable (raw)]:
   fixes F :: "'a \<Rightarrow> 'i \<Rightarrow> real"
   assumes [simp]: "countable I" and [measurable]: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> M \<rightarrow>\<^sub>M borel"
   shows "Measurable.pred M (\<lambda>x. bdd_below ((\<lambda>i. F i x)`I))"
 proof (subst measurable_cong)
   show "bdd_below ((\<lambda>i. F i x)`I) \<longleftrightarrow> (\<exists>q\<in>\<int>. \<forall>i\<in>I. q \<le> F i x)" for x
     by (auto simp: bdd_below_def intro!: bexI[of _ "of_int (floor _)"] intro: order_trans of_int_floor_le)
   show "Measurable.pred M (\<lambda>w. \<exists>q\<in>\<int>. \<forall>i\<in>I. q \<le> F i w)"
     using countable_int by measurable
 qed
 
 lemma borel_measurable_cINF_real[measurable (raw)]:
   fixes F :: "_ \<Rightarrow> _ \<Rightarrow> real"
   assumes [simp]: "countable I"
   assumes F[measurable]: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> borel_measurable M"
   shows "(\<lambda>x. INF i\<in>I. F i x) \<in> borel_measurable M"
 proof (rule measurable_piecewise_restrict)
   let ?\<Omega> = "{x\<in>space M. bdd_below ((\<lambda>i. F i x)`I)}"
   show "countable {?\<Omega>, - ?\<Omega>}" "space M \<subseteq> \<Union>{?\<Omega>, - ?\<Omega>}" "\<And>X. X \<in> {?\<Omega>, - ?\<Omega>} \<Longrightarrow> X \<inter> space M \<in> sets M"
     by auto
   fix X assume "X \<in> {?\<Omega>, - ?\<Omega>}" then show "(\<lambda>x. INF i\<in>I. F i x) \<in> borel_measurable (restrict_space M X)"
   proof safe
     show "(\<lambda>x. INF i\<in>I. F i x) \<in> borel_measurable (restrict_space M ?\<Omega>)"
       by (intro borel_measurable_cINF measurable_restrict_space1 F)
          (auto simp: space_restrict_space)
     show "(\<lambda>x. INF i\<in>I. F i x) \<in> borel_measurable (restrict_space M (-?\<Omega>))"
     proof (subst measurable_cong)
       fix x assume "x \<in> space (restrict_space M (-?\<Omega>))"
       then have "\<not> (\<forall>i\<in>I. - F i x \<le> y)" for y
         by (auto simp: space_restrict_space bdd_above_def bdd_above_uminus[symmetric])
       then show "(INF i\<in>I. F i x) = - (THE x. False)"
         by (auto simp: space_restrict_space Inf_real_def Sup_real_def Least_def simp del: Set.ball_simps(10))
     qed simp
   qed
 qed
 
 lemma borel_Ici: "borel = sigma UNIV (range (\<lambda>x::real. {x ..}))"
 proof (safe intro!: borel_eq_sigmaI1[OF borel_Iio])
   fix x :: real
   have eq: "{..<x} = space (sigma UNIV (range atLeast)) - {x ..}"
     by auto
   show "{..<x} \<in> sets (sigma UNIV (range atLeast))"
     unfolding eq by (intro sets.compl_sets) auto
 qed auto
 
 lemma borel_measurable_pred_less[measurable (raw)]:
   fixes f :: "'a \<Rightarrow> 'b::{second_countable_topology, linorder_topology}"
   shows "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> Measurable.pred M (\<lambda>w. f w < g w)"
   unfolding Measurable.pred_def by (rule borel_measurable_less)
 
 no_notation
   eucl_less (infix "<e" 50)
 
 lemma borel_measurable_Max2[measurable (raw)]:
   fixes f::"_ \<Rightarrow> _ \<Rightarrow> 'a::{second_countable_topology, dense_linorder, linorder_topology}"
   assumes "finite I"
     and [measurable]: "\<And>i. f i \<in> borel_measurable M"
   shows "(\<lambda>x. Max{f i x |i. i \<in> I}) \<in> borel_measurable M"
   by (simp add: borel_measurable_Max[OF assms(1), where ?f=f and ?M=M] Setcompr_eq_image)
 
 lemma measurable_compose_n [measurable (raw)]:
   assumes "T \<in> measurable M M"
   shows "(T^^n) \<in> measurable M M"
 by (induction n, auto simp add: measurable_compose[OF _ assms])
 
 lemma measurable_real_imp_nat:
   fixes f::"'a \<Rightarrow> nat"
   assumes [measurable]: "(\<lambda>x. real(f x)) \<in> borel_measurable M"
   shows "f \<in> measurable M (count_space UNIV)"
 proof -
   let ?g = "(\<lambda>x. real(f x))"
   have "\<And>(n::nat). ?g-`({real n}) \<inter> space M = f-`{n} \<inter> space M" by auto
   moreover have "\<And>(n::nat). ?g-`({real n}) \<inter> space M \<in> sets M" using assms by measurable
   ultimately have "\<And>(n::nat). f-`{n} \<inter> space M \<in> sets M" by simp
   then show ?thesis using measurable_count_space_eq2_countable by blast
 qed
 
 lemma measurable_equality_set [measurable]:
   fixes f g::"_\<Rightarrow> 'a::{second_countable_topology, t2_space}"
   assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   shows "{x \<in> space M. f x = g x} \<in> sets M"
 
 proof -
   define A where "A = {x \<in> space M. f x = g x}"
   define B where "B = {y. \<exists>x::'a. y = (x,x)}"
   have "A = (\<lambda>x. (f x, g x))-`B \<inter> space M" unfolding A_def B_def by auto
   moreover have "(\<lambda>x. (f x, g x)) \<in> borel_measurable M" by simp
   moreover have "B \<in> sets borel" unfolding B_def by (simp add: closed_diagonal)
   ultimately have "A \<in> sets M" by simp
   then show ?thesis unfolding A_def by simp
 qed
 
 lemma measurable_inequality_set [measurable]:
   fixes f g::"_ \<Rightarrow> 'a::{second_countable_topology, linorder_topology}"
   assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   shows "{x \<in> space M. f x \<le> g x} \<in> sets M"
         "{x \<in> space M. f x < g x} \<in> sets M"
         "{x \<in> space M. f x \<ge> g x} \<in> sets M"
         "{x \<in> space M. f x > g x} \<in> sets M"
 proof -
   define F where "F = (\<lambda>x. (f x, g x))"
   have * [measurable]: "F \<in> borel_measurable M" unfolding F_def by simp
 
   have "{x \<in> space M. f x \<le> g x} = F-`{(x, y) | x y. x \<le> y} \<inter> space M" unfolding F_def by auto
   moreover have "{(x, y) | x y. x \<le> (y::'a)} \<in> sets borel" using closed_subdiagonal borel_closed by blast
   ultimately show "{x \<in> space M. f x \<le> g x} \<in> sets M" using * by (metis (mono_tags, lifting) measurable_sets)
 
   have "{x \<in> space M. f x < g x} = F-`{(x, y) | x y. x < y} \<inter> space M" unfolding F_def by auto
   moreover have "{(x, y) | x y. x < (y::'a)} \<in> sets borel" using open_subdiagonal borel_open by blast
   ultimately show "{x \<in> space M. f x < g x} \<in> sets M" using * by (metis (mono_tags, lifting) measurable_sets)
 
   have "{x \<in> space M. f x \<ge> g x} = F-`{(x, y) | x y. x \<ge> y} \<inter> space M" unfolding F_def by auto
   moreover have "{(x, y) | x y. x \<ge> (y::'a)} \<in> sets borel" using closed_superdiagonal borel_closed by blast
   ultimately show "{x \<in> space M. f x \<ge> g x} \<in> sets M" using * by (metis (mono_tags, lifting) measurable_sets)
 
   have "{x \<in> space M. f x > g x} = F-`{(x, y) | x y. x > y} \<inter> space M" unfolding F_def by auto
   moreover have "{(x, y) | x y. x > (y::'a)} \<in> sets borel" using open_superdiagonal borel_open by blast
   ultimately show "{x \<in> space M. f x > g x} \<in> sets M" using * by (metis (mono_tags, lifting) measurable_sets)
 qed
 
 proposition measurable_limit [measurable]:
   fixes f::"nat \<Rightarrow> 'a \<Rightarrow> 'b::first_countable_topology"
   assumes [measurable]: "\<And>n::nat. f n \<in> borel_measurable M"
   shows "Measurable.pred M (\<lambda>x. (\<lambda>n. f n x) \<longlonglongrightarrow> c)"
 proof -
   obtain A :: "nat \<Rightarrow> 'b set" where A:
     "\<And>i. open (A i)"
     "\<And>i. c \<in> A i"
     "\<And>S. open S \<Longrightarrow> c \<in> S \<Longrightarrow> eventually (\<lambda>i. A i \<subseteq> S) sequentially"
   by (rule countable_basis_at_decseq) blast
 
   have [measurable]: "\<And>N i. (f N)-`(A i) \<inter> space M \<in> sets M" using A(1) by auto
   then have mes: "(\<Inter>i. \<Union>n. \<Inter>N\<in>{n..}. (f N)-`(A i) \<inter> space M) \<in> sets M" by blast
 
   have "(u \<longlonglongrightarrow> c) \<longleftrightarrow> (\<forall>i. eventually (\<lambda>n. u n \<in> A i) sequentially)" for u::"nat \<Rightarrow> 'b"
   proof
     assume "u \<longlonglongrightarrow> c"
     then have "eventually (\<lambda>n. u n \<in> A i) sequentially" for i using A(1)[of i] A(2)[of i]
       by (simp add: topological_tendstoD)
     then show "(\<forall>i. eventually (\<lambda>n. u n \<in> A i) sequentially)" by auto
   next
     assume H: "(\<forall>i. eventually (\<lambda>n. u n \<in> A i) sequentially)"
     show "(u \<longlonglongrightarrow> c)"
     proof (rule topological_tendstoI)
       fix S assume "open S" "c \<in> S"
       with A(3)[OF this] obtain i where "A i \<subseteq> S"
         using eventually_False_sequentially eventually_mono by blast
       moreover have "eventually (\<lambda>n. u n \<in> A i) sequentially" using H by simp
       ultimately show "\<forall>\<^sub>F n in sequentially. u n \<in> S"
         by (simp add: eventually_mono subset_eq)
     qed
   qed
   then have "{x. (\<lambda>n. f n x) \<longlonglongrightarrow> c} = (\<Inter>i. \<Union>n. \<Inter>N\<in>{n..}. (f N)-`(A i))"
     by (auto simp add: atLeast_def eventually_at_top_linorder)
   then have "{x \<in> space M. (\<lambda>n. f n x) \<longlonglongrightarrow> c} = (\<Inter>i. \<Union>n. \<Inter>N\<in>{n..}. (f N)-`(A i) \<inter> space M)"
     by auto
   then have "{x \<in> space M. (\<lambda>n. f n x) \<longlonglongrightarrow> c} \<in> sets M" using mes by simp
   then show ?thesis by auto
 qed
 
 lemma measurable_limit2 [measurable]:
   fixes u::"nat \<Rightarrow> 'a \<Rightarrow> real"
   assumes [measurable]: "\<And>n. u n \<in> borel_measurable M" "v \<in> borel_measurable M"
   shows "Measurable.pred M (\<lambda>x. (\<lambda>n. u n x) \<longlonglongrightarrow> v x)"
 proof -
   define w where "w = (\<lambda>n x. u n x - v x)"
   have [measurable]: "w n \<in> borel_measurable M" for n unfolding w_def by auto
   have "((\<lambda>n. u n x) \<longlonglongrightarrow> v x) \<longleftrightarrow> ((\<lambda>n. w n x) \<longlonglongrightarrow> 0)" for x
     unfolding w_def using Lim_null by auto
   then show ?thesis using measurable_limit by auto
 qed
 
 lemma measurable_P_restriction [measurable (raw)]:
   assumes [measurable]: "Measurable.pred M P" "A \<in> sets M"
   shows "{x \<in> A. P x} \<in> sets M"
 proof -
   have "A \<subseteq> space M" using sets.sets_into_space[OF assms(2)].
   then have "{x \<in> A. P x} = A \<inter> {x \<in> space M. P x}" by blast
   then show ?thesis by auto
 qed
 
 lemma measurable_sum_nat [measurable (raw)]:
   fixes f :: "'c \<Rightarrow> 'a \<Rightarrow> nat"
   assumes "\<And>i. i \<in> S \<Longrightarrow> f i \<in> measurable M (count_space UNIV)"
   shows "(\<lambda>x. \<Sum>i\<in>S. f i x) \<in> measurable M (count_space UNIV)"
 proof cases
   assume "finite S"
   then show ?thesis using assms by induct auto
 qed simp
 
 
 lemma measurable_abs_powr [measurable]:
   fixes p::real
   assumes [measurable]: "f \<in> borel_measurable M"
   shows "(\<lambda>x. \<bar>f x\<bar> powr p) \<in> borel_measurable M"
   by simp
 
 text \<open>The next one is a variation around \<open>measurable_restrict_space\<close>.\<close>
 
 lemma measurable_restrict_space3:
   assumes "f \<in> measurable M N" and
           "f \<in> A \<rightarrow> B"
   shows "f \<in> measurable (restrict_space M A) (restrict_space N B)"
 proof -
   have "f \<in> measurable (restrict_space M A) N" using assms(1) measurable_restrict_space1 by auto
   then show ?thesis by (metis Int_iff funcsetI funcset_mem
       measurable_restrict_space2[of f, of "restrict_space M A", of B, of N] assms(2) space_restrict_space)
 qed
 
 lemma measurable_restrict_mono:
   assumes f: "f \<in> restrict_space M A \<rightarrow>\<^sub>M N" and "B \<subseteq> A"
   shows "f \<in> restrict_space M B \<rightarrow>\<^sub>M N"
 by (rule measurable_compose[OF measurable_restrict_space3 f])
    (insert \<open>B \<subseteq> A\<close>, auto)
 
 text \<open>The next one is a variation around \<open>measurable_piecewise_restrict\<close>.\<close>
 
 lemma measurable_piecewise_restrict2:
   assumes [measurable]: "\<And>n. A n \<in> sets M"
       and "space M = (\<Union>(n::nat). A n)"
           "\<And>n. \<exists>h \<in> measurable M N. (\<forall>x \<in> A n. f x = h x)"
   shows "f \<in> measurable M N"
 proof (rule measurableI)
   fix B assume [measurable]: "B \<in> sets N"
   {
     fix n::nat
     obtain h where [measurable]: "h \<in> measurable M N" and "\<forall>x \<in> A n. f x = h x" using assms(3) by blast
     then have *: "f-`B \<inter> A n = h-`B \<inter> A n" by auto
     have "h-`B \<inter> A n = h-`B \<inter> space M \<inter> A n" using assms(2) sets.sets_into_space by auto
     then have "h-`B \<inter> A n \<in> sets M" by simp
     then have "f-`B \<inter> A n \<in> sets M" using * by simp
   }
   then have "(\<Union>n. f-`B \<inter> A n) \<in> sets M" by measurable
   moreover have "f-`B \<inter> space M = (\<Union>n. f-`B \<inter> A n)" using assms(2) by blast
   ultimately show "f-`B \<inter> space M \<in> sets M" by simp
 next
   fix x assume "x \<in> space M"
   then obtain n where "x \<in> A n" using assms(2) by blast
   obtain h where [measurable]: "h \<in> measurable M N" and "\<forall>x \<in> A n. f x = h x" using assms(3) by blast
   then have "f x = h x" using \<open>x \<in> A n\<close> by blast
   moreover have "h x \<in> space N" by (metis measurable_space \<open>x \<in> space M\<close> \<open>h \<in> measurable M N\<close>)
   ultimately show "f x \<in> space N" by simp
 qed
 
 end
diff --git a/src/HOL/Analysis/Caratheodory.thy b/src/HOL/Analysis/Caratheodory.thy
--- a/src/HOL/Analysis/Caratheodory.thy
+++ b/src/HOL/Analysis/Caratheodory.thy
@@ -1,891 +1,900 @@
 (*  Title:      HOL/Analysis/Caratheodory.thy
     Author:     Lawrence C Paulson
     Author:     Johannes Hölzl, TU München
 *)
 
 section \<open>Caratheodory Extension Theorem\<close>
 
 theory Caratheodory
 imports Measure_Space
 begin
 
 text \<open>
   Originally from the Hurd/Coble measure theory development, translated by Lawrence Paulson.
 \<close>
 
 lemma suminf_ennreal_2dimen:
   fixes f:: "nat \<times> nat \<Rightarrow> ennreal"
   assumes "\<And>m. g m = (\<Sum>n. f (m,n))"
   shows "(\<Sum>i. f (prod_decode i)) = suminf g"
 proof -
   have g_def: "g = (\<lambda>m. (\<Sum>n. f (m,n)))"
     using assms by (simp add: fun_eq_iff)
   have reindex: "\<And>B. (\<Sum>x\<in>B. f (prod_decode x)) = sum f (prod_decode ` B)"
     by (simp add: sum.reindex[OF inj_prod_decode] comp_def)
   have "(SUP n. \<Sum>i<n. f (prod_decode i)) = (SUP p \<in> UNIV \<times> UNIV. \<Sum>i<fst p. \<Sum>n<snd p. f (i, n))"
   proof (intro SUP_eq; clarsimp simp: sum.cartesian_product reindex)
     fix n
     let ?M = "\<lambda>f. Suc (Max (f ` prod_decode ` {..<n}))"
     { fix a b x assume "x < n" and [symmetric]: "(a, b) = prod_decode x"
       then have "a < ?M fst" "b < ?M snd"
         by (auto intro!: Max_ge le_imp_less_Suc image_eqI) }
     then have "sum f (prod_decode ` {..<n}) \<le> sum f ({..<?M fst} \<times> {..<?M snd})"
       by (auto intro!: sum_mono2)
     then show "\<exists>a b. sum f (prod_decode ` {..<n}) \<le> sum f ({..<a} \<times> {..<b})" by auto
   next
     fix a b
     let ?M = "prod_decode ` {..<Suc (Max (prod_encode ` ({..<a} \<times> {..<b})))}"
     { fix a' b' assume "a' < a" "b' < b" then have "(a', b') \<in> ?M"
         by (auto intro!: Max_ge le_imp_less_Suc image_eqI[where x="prod_encode (a', b')"]) }
     then have "sum f ({..<a} \<times> {..<b}) \<le> sum f ?M"
       by (auto intro!: sum_mono2)
     then show "\<exists>n. sum f ({..<a} \<times> {..<b}) \<le> sum f (prod_decode ` {..<n})"
       by auto
   qed
   also have "\<dots> = (SUP p. \<Sum>i<p. \<Sum>n. f (i, n))"
     unfolding suminf_sum[OF summableI, symmetric]
     by (simp add: suminf_eq_SUP SUP_pair sum.swap[of _ "{..< fst _}"])
   finally show ?thesis unfolding g_def
     by (simp add: suminf_eq_SUP)
 qed
 
 subsection \<open>Characterizations of Measures\<close>
 
 definition\<^marker>\<open>tag important\<close> outer_measure_space where
   "outer_measure_space M f \<longleftrightarrow> positive M f \<and> increasing M f \<and> countably_subadditive M f"
 
 subsubsection\<^marker>\<open>tag important\<close> \<open>Lambda Systems\<close>
 
 definition\<^marker>\<open>tag important\<close> lambda_system :: "'a set \<Rightarrow> 'a set set \<Rightarrow> ('a set \<Rightarrow> ennreal) \<Rightarrow> 'a set set"
 where
   "lambda_system \<Omega> M f = {l \<in> M. \<forall>x \<in> M. f (l \<inter> x) + f ((\<Omega> - l) \<inter> x) = f x}"
 
 lemma (in algebra) lambda_system_eq:
   "lambda_system \<Omega> M f = {l \<in> M. \<forall>x \<in> M. f (x \<inter> l) + f (x - l) = f x}"
 proof -
   have [simp]: "\<And>l x. l \<in> M \<Longrightarrow> x \<in> M \<Longrightarrow> (\<Omega> - l) \<inter> x = x - l"
     by (metis Int_Diff Int_absorb1 Int_commute sets_into_space)
   show ?thesis
     by (auto simp add: lambda_system_def) (metis Int_commute)+
 qed
 
 lemma (in algebra) lambda_system_empty: "positive M f \<Longrightarrow> {} \<in> lambda_system \<Omega> M f"
   by (auto simp add: positive_def lambda_system_eq)
 
 lemma lambda_system_sets: "x \<in> lambda_system \<Omega> M f \<Longrightarrow> x \<in> M"
   by (simp add: lambda_system_def)
 
 lemma (in algebra) lambda_system_Compl:
   fixes f:: "'a set \<Rightarrow> ennreal"
   assumes x: "x \<in> lambda_system \<Omega> M f"
   shows "\<Omega> - x \<in> lambda_system \<Omega> M f"
 proof -
   have "x \<subseteq> \<Omega>"
     by (metis sets_into_space lambda_system_sets x)
   hence "\<Omega> - (\<Omega> - x) = x"
     by (metis double_diff equalityE)
   with x show ?thesis
     by (force simp add: lambda_system_def ac_simps)
 qed
 
 lemma (in algebra) lambda_system_Int:
   fixes f:: "'a set \<Rightarrow> ennreal"
   assumes xl: "x \<in> lambda_system \<Omega> M f" and yl: "y \<in> lambda_system \<Omega> M f"
   shows "x \<inter> y \<in> lambda_system \<Omega> M f"
 proof -
   from xl yl show ?thesis
   proof (auto simp add: positive_def lambda_system_eq Int)
     fix u
     assume x: "x \<in> M" and y: "y \<in> M" and u: "u \<in> M"
        and fx: "\<forall>z\<in>M. f (z \<inter> x) + f (z - x) = f z"
        and fy: "\<forall>z\<in>M. f (z \<inter> y) + f (z - y) = f z"
     have "u - x \<inter> y \<in> M"
       by (metis Diff Diff_Int Un u x y)
     moreover
     have "(u - (x \<inter> y)) \<inter> y = u \<inter> y - x" by blast
     moreover
     have "u - x \<inter> y - y = u - y" by blast
     ultimately
     have ey: "f (u - x \<inter> y) = f (u \<inter> y - x) + f (u - y)" using fy
       by force
     have "f (u \<inter> (x \<inter> y)) + f (u - x \<inter> y)
           = (f (u \<inter> (x \<inter> y)) + f (u \<inter> y - x)) + f (u - y)"
       by (simp add: ey ac_simps)
     also have "... =  (f ((u \<inter> y) \<inter> x) + f (u \<inter> y - x)) + f (u - y)"
       by (simp add: Int_ac)
     also have "... = f (u \<inter> y) + f (u - y)"
       using fx [THEN bspec, of "u \<inter> y"] Int y u
       by force
     also have "... = f u"
       by (metis fy u)
     finally show "f (u \<inter> (x \<inter> y)) + f (u - x \<inter> y) = f u" .
   qed
 qed
 
 lemma (in algebra) lambda_system_Un:
   fixes f:: "'a set \<Rightarrow> ennreal"
   assumes xl: "x \<in> lambda_system \<Omega> M f" and yl: "y \<in> lambda_system \<Omega> M f"
   shows "x \<union> y \<in> lambda_system \<Omega> M f"
 proof -
   have "(\<Omega> - x) \<inter> (\<Omega> - y) \<in> M"
     by (metis Diff_Un Un compl_sets lambda_system_sets xl yl)
   moreover
   have "x \<union> y = \<Omega> - ((\<Omega> - x) \<inter> (\<Omega> - y))"
     by auto (metis subsetD lambda_system_sets sets_into_space xl yl)+
   ultimately show ?thesis
     by (metis lambda_system_Compl lambda_system_Int xl yl)
 qed
 
 lemma (in algebra) lambda_system_algebra:
   "positive M f \<Longrightarrow> algebra \<Omega> (lambda_system \<Omega> M f)"
   apply (auto simp add: algebra_iff_Un)
   apply (metis lambda_system_sets subsetD sets_into_space)
   apply (metis lambda_system_empty)
   apply (metis lambda_system_Compl)
   apply (metis lambda_system_Un)
   done
 
 lemma (in algebra) lambda_system_strong_additive:
   assumes z: "z \<in> M" and disj: "x \<inter> y = {}"
       and xl: "x \<in> lambda_system \<Omega> M f" and yl: "y \<in> lambda_system \<Omega> M f"
   shows "f (z \<inter> (x \<union> y)) = f (z \<inter> x) + f (z \<inter> y)"
 proof -
   have "z \<inter> x = (z \<inter> (x \<union> y)) \<inter> x" using disj by blast
   moreover
   have "z \<inter> y = (z \<inter> (x \<union> y)) - x" using disj by blast
   moreover
   have "(z \<inter> (x \<union> y)) \<in> M"
     by (metis Int Un lambda_system_sets xl yl z)
   ultimately show ?thesis using xl yl
     by (simp add: lambda_system_eq)
 qed
 
 lemma (in algebra) lambda_system_additive: "additive (lambda_system \<Omega> M f) f"
 proof (auto simp add: additive_def)
   fix x and y
   assume disj: "x \<inter> y = {}"
      and xl: "x \<in> lambda_system \<Omega> M f" and yl: "y \<in> lambda_system \<Omega> M f"
   hence  "x \<in> M" "y \<in> M" by (blast intro: lambda_system_sets)+
   thus "f (x \<union> y) = f x + f y"
     using lambda_system_strong_additive [OF top disj xl yl]
     by (simp add: Un)
 qed
 
 lemma lambda_system_increasing: "increasing M f \<Longrightarrow> increasing (lambda_system \<Omega> M f) f"
   by (simp add: increasing_def lambda_system_def)
 
 lemma lambda_system_positive: "positive M f \<Longrightarrow> positive (lambda_system \<Omega> M f) f"
   by (simp add: positive_def lambda_system_def)
 
 lemma (in algebra) lambda_system_strong_sum:
   fixes A:: "nat \<Rightarrow> 'a set" and f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" and a: "a \<in> M"
       and A: "range A \<subseteq> lambda_system \<Omega> M f"
       and disj: "disjoint_family A"
   shows  "(\<Sum>i = 0..<n. f (a \<inter>A i)) = f (a \<inter> (\<Union>i\<in>{0..<n}. A i))"
 proof (induct n)
   case 0 show ?case using f by (simp add: positive_def)
 next
   case (Suc n)
   have 2: "A n \<inter> \<Union> (A ` {0..<n}) = {}" using disj
     by (force simp add: disjoint_family_on_def neq_iff)
   have 3: "A n \<in> lambda_system \<Omega> M f" using A
     by blast
   interpret l: algebra \<Omega> "lambda_system \<Omega> M f"
     using f by (rule lambda_system_algebra)
   have 4: "\<Union> (A ` {0..<n}) \<in> lambda_system \<Omega> M f"
     using A l.UNION_in_sets by simp
   from Suc.hyps show ?case
     by (simp add: atLeastLessThanSuc lambda_system_strong_additive [OF a 2 3 4])
 qed
 
 proposition (in sigma_algebra) lambda_system_caratheodory:
   assumes oms: "outer_measure_space M f"
       and A: "range A \<subseteq> lambda_system \<Omega> M f"
       and disj: "disjoint_family A"
   shows  "(\<Union>i. A i) \<in> lambda_system \<Omega> M f \<and> (\<Sum>i. f (A i)) = f (\<Union>i. A i)"
 proof -
   have pos: "positive M f" and inc: "increasing M f"
    and csa: "countably_subadditive M f"
     by (metis oms outer_measure_space_def)+
   have sa: "subadditive M f"
     by (metis countably_subadditive_subadditive csa pos)
   have A': "\<And>S. A`S \<subseteq> (lambda_system \<Omega> M f)" using A
     by auto
   interpret ls: algebra \<Omega> "lambda_system \<Omega> M f"
     using pos by (rule lambda_system_algebra)
   have A'': "range A \<subseteq> M"
      by (metis A image_subset_iff lambda_system_sets)
 
   have U_in: "(\<Union>i. A i) \<in> M"
     by (metis A'' countable_UN)
   have U_eq: "f (\<Union>i. A i) = (\<Sum>i. f (A i))"
   proof (rule antisym)
     show "f (\<Union>i. A i) \<le> (\<Sum>i. f (A i))"
       using csa[unfolded countably_subadditive_def] A'' disj U_in by auto
     have dis: "\<And>N. disjoint_family_on A {..<N}" by (intro disjoint_family_on_mono[OF _ disj]) auto
     show "(\<Sum>i. f (A i)) \<le> f (\<Union>i. A i)"
       using ls.additive_sum [OF lambda_system_positive[OF pos] lambda_system_additive _ A' dis] A''
       by (intro suminf_le_const[OF summableI]) (auto intro!: increasingD[OF inc] countable_UN)
   qed
   have "f (a \<inter> (\<Union>i. A i)) + f (a - (\<Union>i. A i)) = f a"
     if a [iff]: "a \<in> M" for a
   proof (rule antisym)
     have "range (\<lambda>i. a \<inter> A i) \<subseteq> M" using A''
       by blast
     moreover
     have "disjoint_family (\<lambda>i. a \<inter> A i)" using disj
       by (auto simp add: disjoint_family_on_def)
     moreover
     have "a \<inter> (\<Union>i. A i) \<in> M"
       by (metis Int U_in a)
     ultimately
     have "f (a \<inter> (\<Union>i. A i)) \<le> (\<Sum>i. f (a \<inter> A i))"
       using csa[unfolded countably_subadditive_def, rule_format, of "(\<lambda>i. a \<inter> A i)"]
       by (simp add: o_def)
     hence "f (a \<inter> (\<Union>i. A i)) + f (a - (\<Union>i. A i)) \<le> (\<Sum>i. f (a \<inter> A i)) + f (a - (\<Union>i. A i))"
       by (rule add_right_mono)
     also have "\<dots> \<le> f a"
     proof (intro ennreal_suminf_bound_add)
       fix n
       have UNION_in: "(\<Union>i\<in>{0..<n}. A i) \<in> M"
         by (metis A'' UNION_in_sets)
       have le_fa: "f (\<Union> (A ` {0..<n}) \<inter> a) \<le> f a" using A''
         by (blast intro: increasingD [OF inc] A'' UNION_in_sets)
       have ls: "(\<Union>i\<in>{0..<n}. A i) \<in> lambda_system \<Omega> M f"
         using ls.UNION_in_sets by (simp add: A)
       hence eq_fa: "f a = f (a \<inter> (\<Union>i\<in>{0..<n}. A i)) + f (a - (\<Union>i\<in>{0..<n}. A i))"
         by (simp add: lambda_system_eq UNION_in)
       have "f (a - (\<Union>i. A i)) \<le> f (a - (\<Union>i\<in>{0..<n}. A i))"
         by (blast intro: increasingD [OF inc] UNION_in U_in)
       thus "(\<Sum>i<n. f (a \<inter> A i)) + f (a - (\<Union>i. A i)) \<le> f a"
         by (simp add: lambda_system_strong_sum pos A disj eq_fa add_left_mono atLeast0LessThan[symmetric])
     qed
     finally show "f (a \<inter> (\<Union>i. A i)) + f (a - (\<Union>i. A i)) \<le> f a"
       by simp
   next
     have "f a \<le> f (a \<inter> (\<Union>i. A i) \<union> (a - (\<Union>i. A i)))"
       by (blast intro:  increasingD [OF inc] U_in)
     also have "... \<le>  f (a \<inter> (\<Union>i. A i)) + f (a - (\<Union>i. A i))"
       by (blast intro: subadditiveD [OF sa] U_in)
     finally show "f a \<le> f (a \<inter> (\<Union>i. A i)) + f (a - (\<Union>i. A i))" .
   qed
   thus  ?thesis
     by (simp add: lambda_system_eq sums_iff U_eq U_in)
 qed
 
 proposition (in sigma_algebra) caratheodory_lemma:
   assumes oms: "outer_measure_space M f"
   defines "L \<equiv> lambda_system \<Omega> M f"
   shows "measure_space \<Omega> L f"
 proof -
   have pos: "positive M f"
     by (metis oms outer_measure_space_def)
   have alg: "algebra \<Omega> L"
     using lambda_system_algebra [of f, OF pos]
     by (simp add: algebra_iff_Un L_def)
   then
   have "sigma_algebra \<Omega> L"
     using lambda_system_caratheodory [OF oms]
     by (simp add: sigma_algebra_disjoint_iff L_def)
   moreover
   have "countably_additive L f" "positive L f"
     using pos lambda_system_caratheodory [OF oms]
     by (auto simp add: lambda_system_sets L_def countably_additive_def positive_def)
   ultimately
   show ?thesis
     using pos by (simp add: measure_space_def)
 qed
 
 definition\<^marker>\<open>tag important\<close> outer_measure :: "'a set set \<Rightarrow> ('a set \<Rightarrow> ennreal) \<Rightarrow> 'a set \<Rightarrow> ennreal" where
    "outer_measure M f X =
      (INF A\<in>{A. range A \<subseteq> M \<and> disjoint_family A \<and> X \<subseteq> (\<Union>i. A i)}. \<Sum>i. f (A i))"
 
 lemma (in ring_of_sets) outer_measure_agrees:
   assumes posf: "positive M f" and ca: "countably_additive M f" and s: "s \<in> M"
   shows "outer_measure M f s = f s"
   unfolding outer_measure_def
 proof (safe intro!: antisym INF_greatest)
   fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> M" and dA: "disjoint_family A" and sA: "s \<subseteq> (\<Union>x. A x)"
   have inc: "increasing M f"
     by (metis additive_increasing ca countably_additive_additive posf)
   have "f s = f (\<Union>i. A i \<inter> s)"
     using sA by (auto simp: Int_absorb1)
   also have "\<dots> = (\<Sum>i. f (A i \<inter> s))"
     using sA dA A s
     by (intro ca[unfolded countably_additive_def, rule_format, symmetric])
        (auto simp: Int_absorb1 disjoint_family_on_def)
   also have "... \<le> (\<Sum>i. f (A i))"
     using A s by (auto intro!: suminf_le increasingD[OF inc])
   finally show "f s \<le> (\<Sum>i. f (A i))" .
 next
   have "(\<Sum>i. f (if i = 0 then s else {})) \<le> f s"
     using positiveD1[OF posf] by (subst suminf_finite[of "{0}"]) auto
   with s show "(INF A\<in>{A. range A \<subseteq> M \<and> disjoint_family A \<and> s \<subseteq> \<Union>(A ` UNIV)}. \<Sum>i. f (A i)) \<le> f s"
     by (intro INF_lower2[of "\<lambda>i. if i = 0 then s else {}"])
        (auto simp: disjoint_family_on_def)
 qed
 
 lemma outer_measure_empty:
   "positive M f \<Longrightarrow> {} \<in> M \<Longrightarrow> outer_measure M f {} = 0"
   unfolding outer_measure_def
   by (intro antisym INF_lower2[of  "\<lambda>_. {}"]) (auto simp: disjoint_family_on_def positive_def)
 
 lemma (in ring_of_sets) positive_outer_measure:
   assumes "positive M f" shows "positive (Pow \<Omega>) (outer_measure M f)"
   unfolding positive_def by (auto simp: assms outer_measure_empty)
 
 lemma (in ring_of_sets) increasing_outer_measure: "increasing (Pow \<Omega>) (outer_measure M f)"
   by (force simp: increasing_def outer_measure_def intro!: INF_greatest intro: INF_lower)
 
 lemma (in ring_of_sets) outer_measure_le:
   assumes pos: "positive M f" and inc: "increasing M f" and A: "range A \<subseteq> M" and X: "X \<subseteq> (\<Union>i. A i)"
   shows "outer_measure M f X \<le> (\<Sum>i. f (A i))"
   unfolding outer_measure_def
 proof (safe intro!: INF_lower2[of "disjointed A"] del: subsetI)
   show dA: "range (disjointed A) \<subseteq> M"
     by (auto intro!: A range_disjointed_sets)
   have "\<forall>n. f (disjointed A n) \<le> f (A n)"
     by (metis increasingD [OF inc] UNIV_I dA image_subset_iff disjointed_subset A)
   then show "(\<Sum>i. f (disjointed A i)) \<le> (\<Sum>i. f (A i))"
     by (blast intro!: suminf_le)
 qed (auto simp: X UN_disjointed_eq disjoint_family_disjointed)
 
 lemma (in ring_of_sets) outer_measure_close:
   "outer_measure M f X < e \<Longrightarrow> \<exists>A. range A \<subseteq> M \<and> disjoint_family A \<and> X \<subseteq> (\<Union>i. A i) \<and> (\<Sum>i. f (A i)) < e"
   unfolding outer_measure_def INF_less_iff by auto
 
 lemma (in ring_of_sets) countably_subadditive_outer_measure:
   assumes posf: "positive M f" and inc: "increasing M f"
   shows "countably_subadditive (Pow \<Omega>) (outer_measure M f)"
 proof (simp add: countably_subadditive_def, safe)
   fix A :: "nat \<Rightarrow> _" assume A: "range A \<subseteq> Pow (\<Omega>)" and sb: "(\<Union>i. A i) \<subseteq> \<Omega>"
   let ?O = "outer_measure M f"
   show "?O (\<Union>i. A i) \<le> (\<Sum>n. ?O (A n))"
   proof (rule ennreal_le_epsilon)
     fix b and e :: real assume "0 < e" "(\<Sum>n. outer_measure M f (A n)) < top"
     then have *: "\<And>n. outer_measure M f (A n) < outer_measure M f (A n) + e * (1/2)^Suc n"
       by (auto simp add: less_top dest!: ennreal_suminf_lessD)
     obtain B
       where B: "\<And>n. range (B n) \<subseteq> M"
       and sbB: "\<And>n. A n \<subseteq> (\<Union>i. B n i)"
       and Ble: "\<And>n. (\<Sum>i. f (B n i)) \<le> ?O (A n) + e * (1/2)^(Suc n)"
       by (metis less_imp_le outer_measure_close[OF *])
 
     define C where "C = case_prod B o prod_decode"
     from B have B_in_M: "\<And>i j. B i j \<in> M"
       by (rule range_subsetD)
     then have C: "range C \<subseteq> M"
       by (auto simp add: C_def split_def)
     have A_C: "(\<Union>i. A i) \<subseteq> (\<Union>i. C i)"
       using sbB by (auto simp add: C_def subset_eq) (metis prod.case prod_encode_inverse)
 
     have "?O (\<Union>i. A i) \<le> ?O (\<Union>i. C i)"
       using A_C A C by (intro increasing_outer_measure[THEN increasingD]) (auto dest!: sets_into_space)
     also have "\<dots> \<le> (\<Sum>i. f (C i))"
       using C by (intro outer_measure_le[OF posf inc]) auto
     also have "\<dots> = (\<Sum>n. \<Sum>i. f (B n i))"
       using B_in_M unfolding C_def comp_def by (intro suminf_ennreal_2dimen) auto
     also have "\<dots> \<le> (\<Sum>n. ?O (A n) + e * (1/2) ^ Suc n)"
       using B_in_M by (intro suminf_le suminf_nonneg allI Ble) auto
     also have "... = (\<Sum>n. ?O (A n)) + (\<Sum>n. ennreal e * ennreal ((1/2) ^ Suc n))"
       using \<open>0 < e\<close> by (subst suminf_add[symmetric])
                        (auto simp del: ennreal_suminf_cmult simp add: ennreal_mult[symmetric])
     also have "\<dots> = (\<Sum>n. ?O (A n)) + e"
       unfolding ennreal_suminf_cmult
       by (subst suminf_ennreal_eq[OF zero_le_power power_half_series]) auto
     finally show "?O (\<Union>i. A i) \<le> (\<Sum>n. ?O (A n)) + e" .
   qed
 qed
 
 lemma (in ring_of_sets) outer_measure_space_outer_measure:
   "positive M f \<Longrightarrow> increasing M f \<Longrightarrow> outer_measure_space (Pow \<Omega>) (outer_measure M f)"
   by (simp add: outer_measure_space_def
     positive_outer_measure increasing_outer_measure countably_subadditive_outer_measure)
 
 lemma (in ring_of_sets) algebra_subset_lambda_system:
   assumes posf: "positive M f" and inc: "increasing M f"
       and add: "additive M f"
   shows "M \<subseteq> lambda_system \<Omega> (Pow \<Omega>) (outer_measure M f)"
 proof (auto dest: sets_into_space
             simp add: algebra.lambda_system_eq [OF algebra_Pow])
   fix x s assume x: "x \<in> M" and s: "s \<subseteq> \<Omega>"
   have [simp]: "\<And>x. x \<in> M \<Longrightarrow> s \<inter> (\<Omega> - x) = s - x" using s
     by blast
   have "outer_measure M f (s \<inter> x) + outer_measure M f (s - x) \<le> outer_measure M f s"
     unfolding outer_measure_def[of M f s]
   proof (safe intro!: INF_greatest)
     fix A :: "nat \<Rightarrow> 'a set" assume A: "disjoint_family A" "range A \<subseteq> M" "s \<subseteq> (\<Union>i. A i)"
     have "outer_measure M f (s \<inter> x) \<le> (\<Sum>i. f (A i \<inter> x))"
       unfolding outer_measure_def
     proof (safe intro!: INF_lower2[of "\<lambda>i. A i \<inter> x"])
       from A(1) show "disjoint_family (\<lambda>i. A i \<inter> x)"
         by (rule disjoint_family_on_bisimulation) auto
     qed (insert x A, auto)
     moreover
     have "outer_measure M f (s - x) \<le> (\<Sum>i. f (A i - x))"
       unfolding outer_measure_def
     proof (safe intro!: INF_lower2[of "\<lambda>i. A i - x"])
       from A(1) show "disjoint_family (\<lambda>i. A i - x)"
         by (rule disjoint_family_on_bisimulation) auto
     qed (insert x A, auto)
     ultimately have "outer_measure M f (s \<inter> x) + outer_measure M f (s - x) \<le>
         (\<Sum>i. f (A i \<inter> x)) + (\<Sum>i. f (A i - x))" by (rule add_mono)
     also have "\<dots> = (\<Sum>i. f (A i \<inter> x) + f (A i - x))"
       using A(2) x posf by (subst suminf_add) (auto simp: positive_def)
     also have "\<dots> = (\<Sum>i. f (A i))"
       using A x
       by (subst add[THEN additiveD, symmetric])
          (auto intro!: arg_cong[where f=suminf] arg_cong[where f=f])
     finally show "outer_measure M f (s \<inter> x) + outer_measure M f (s - x) \<le> (\<Sum>i. f (A i))" .
   qed
   moreover
   have "outer_measure M f s \<le> outer_measure M f (s \<inter> x) + outer_measure M f (s - x)"
   proof -
     have "outer_measure M f s = outer_measure M f ((s \<inter> x) \<union> (s - x))"
       by (metis Un_Diff_Int Un_commute)
     also have "... \<le> outer_measure M f (s \<inter> x) + outer_measure M f (s - x)"
       apply (rule subadditiveD)
       apply (rule ring_of_sets.countably_subadditive_subadditive [OF ring_of_sets_Pow])
       apply (simp add: positive_def outer_measure_empty[OF posf])
       apply (rule countably_subadditive_outer_measure)
       using s by (auto intro!: posf inc)
     finally show ?thesis .
   qed
   ultimately
   show "outer_measure M f (s \<inter> x) + outer_measure M f (s - x) = outer_measure M f s"
     by (rule order_antisym)
 qed
 
 lemma measure_down: "measure_space \<Omega> N \<mu> \<Longrightarrow> sigma_algebra \<Omega> M \<Longrightarrow> M \<subseteq> N \<Longrightarrow> measure_space \<Omega> M \<mu>"
   by (auto simp add: measure_space_def positive_def countably_additive_def subset_eq)
 
 subsection \<open>Caratheodory's theorem\<close>
 
 theorem (in ring_of_sets) caratheodory':
   assumes posf: "positive M f" and ca: "countably_additive M f"
   shows "\<exists>\<mu> :: 'a set \<Rightarrow> ennreal. (\<forall>s \<in> M. \<mu> s = f s) \<and> measure_space \<Omega> (sigma_sets \<Omega> M) \<mu>"
 proof -
   have inc: "increasing M f"
     by (metis additive_increasing ca countably_additive_additive posf)
   let ?O = "outer_measure M f"
   define ls where "ls = lambda_system \<Omega> (Pow \<Omega>) ?O"
   have mls: "measure_space \<Omega> ls ?O"
     using sigma_algebra.caratheodory_lemma
             [OF sigma_algebra_Pow outer_measure_space_outer_measure [OF posf inc]]
     by (simp add: ls_def)
   hence sls: "sigma_algebra \<Omega> ls"
     by (simp add: measure_space_def)
   have "M \<subseteq> ls"
     by (simp add: ls_def)
        (metis ca posf inc countably_additive_additive algebra_subset_lambda_system)
   hence sgs_sb: "sigma_sets (\<Omega>) (M) \<subseteq> ls"
     using sigma_algebra.sigma_sets_subset [OF sls, of "M"]
     by simp
   have "measure_space \<Omega> (sigma_sets \<Omega> M) ?O"
     by (rule measure_down [OF mls], rule sigma_algebra_sigma_sets)
        (simp_all add: sgs_sb space_closed)
   thus ?thesis using outer_measure_agrees [OF posf ca]
     by (intro exI[of _ ?O]) auto
 qed
 
 lemma (in ring_of_sets) caratheodory_empty_continuous:
   assumes f: "positive M f" "additive M f" and fin: "\<And>A. A \<in> M \<Longrightarrow> f A \<noteq> \<infinity>"
   assumes cont: "\<And>A. range A \<subseteq> M \<Longrightarrow> decseq A \<Longrightarrow> (\<Inter>i. A i) = {} \<Longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> 0"
   shows "\<exists>\<mu> :: 'a set \<Rightarrow> ennreal. (\<forall>s \<in> M. \<mu> s = f s) \<and> measure_space \<Omega> (sigma_sets \<Omega> M) \<mu>"
 proof (intro caratheodory' empty_continuous_imp_countably_additive f)
   show "\<forall>A\<in>M. f A \<noteq> \<infinity>" using fin by auto
 qed (rule cont)
 
 subsection \<open>Volumes\<close>
 
 definition\<^marker>\<open>tag important\<close> volume :: "'a set set \<Rightarrow> ('a set \<Rightarrow> ennreal) \<Rightarrow> bool" where
   "volume M f \<longleftrightarrow>
   (f {} = 0) \<and> (\<forall>a\<in>M. 0 \<le> f a) \<and>
   (\<forall>C\<subseteq>M. disjoint C \<longrightarrow> finite C \<longrightarrow> \<Union>C \<in> M \<longrightarrow> f (\<Union>C) = (\<Sum>c\<in>C. f c))"
 
 lemma volumeI:
   assumes "f {} = 0"
   assumes "\<And>a. a \<in> M \<Longrightarrow> 0 \<le> f a"
   assumes "\<And>C. C \<subseteq> M \<Longrightarrow> disjoint C \<Longrightarrow> finite C \<Longrightarrow> \<Union>C \<in> M \<Longrightarrow> f (\<Union>C) = (\<Sum>c\<in>C. f c)"
   shows "volume M f"
   using assms by (auto simp: volume_def)
 
 lemma volume_positive:
   "volume M f \<Longrightarrow> a \<in> M \<Longrightarrow> 0 \<le> f a"
   by (auto simp: volume_def)
 
 lemma volume_empty:
   "volume M f \<Longrightarrow> f {} = 0"
   by (auto simp: volume_def)
 
 proposition volume_finite_additive:
   assumes "volume M f"
   assumes A: "\<And>i. i \<in> I \<Longrightarrow> A i \<in> M" "disjoint_family_on A I" "finite I" "\<Union>(A ` I) \<in> M"
   shows "f (\<Union>(A ` I)) = (\<Sum>i\<in>I. f (A i))"
 proof -
   have "A`I \<subseteq> M" "disjoint (A`I)" "finite (A`I)" "\<Union>(A`I) \<in> M"
     using A by (auto simp: disjoint_family_on_disjoint_image)
   with \<open>volume M f\<close> have "f (\<Union>(A`I)) = (\<Sum>a\<in>A`I. f a)"
     unfolding volume_def by blast
   also have "\<dots> = (\<Sum>i\<in>I. f (A i))"
   proof (subst sum.reindex_nontrivial)
     fix i j assume "i \<in> I" "j \<in> I" "i \<noteq> j" "A i = A j"
     with \<open>disjoint_family_on A I\<close> have "A i = {}"
       by (auto simp: disjoint_family_on_def)
     then show "f (A i) = 0"
       using volume_empty[OF \<open>volume M f\<close>] by simp
   qed (auto intro: \<open>finite I\<close>)
   finally show "f (\<Union>(A ` I)) = (\<Sum>i\<in>I. f (A i))"
     by simp
 qed
 
 lemma (in ring_of_sets) volume_additiveI:
   assumes pos: "\<And>a. a \<in> M \<Longrightarrow> 0 \<le> \<mu> a"
   assumes [simp]: "\<mu> {} = 0"
   assumes add: "\<And>a b. a \<in> M \<Longrightarrow> b \<in> M \<Longrightarrow> a \<inter> b = {} \<Longrightarrow> \<mu> (a \<union> b) = \<mu> a + \<mu> b"
   shows "volume M \<mu>"
 proof (unfold volume_def, safe)
   fix C assume "finite C" "C \<subseteq> M" "disjoint C"
   then show "\<mu> (\<Union>C) = sum \<mu> C"
   proof (induct C)
     case (insert c C)
     from insert(1,2,4,5) have "\<mu> (\<Union>(insert c C)) = \<mu> c + \<mu> (\<Union>C)"
       by (auto intro!: add simp: disjoint_def)
     with insert show ?case
       by (simp add: disjoint_def)
   qed simp
 qed fact+
 
 proposition (in semiring_of_sets) extend_volume:
   assumes "volume M \<mu>"
   shows "\<exists>\<mu>'. volume generated_ring \<mu>' \<and> (\<forall>a\<in>M. \<mu>' a = \<mu> a)"
 proof -
   let ?R = generated_ring
   have "\<forall>a\<in>?R. \<exists>m. \<exists>C\<subseteq>M. a = \<Union>C \<and> finite C \<and> disjoint C \<and> m = (\<Sum>c\<in>C. \<mu> c)"
     by (auto simp: generated_ring_def)
-  from bchoice[OF this] guess \<mu>' .. note \<mu>'_spec = this
-
+  from bchoice[OF this] obtain \<mu>'
+    where \<mu>'_spec: "\<forall>x\<in>generated_ring. \<exists>C\<subseteq>M. x = \<Union> C \<and> finite C \<and> disjoint C \<and> \<mu>' x = sum \<mu> C"
+    by blast
   { fix C assume C: "C \<subseteq> M" "finite C" "disjoint C"
     fix D assume D: "D \<subseteq> M" "finite D" "disjoint D"
     assume "\<Union>C = \<Union>D"
     have "(\<Sum>d\<in>D. \<mu> d) = (\<Sum>d\<in>D. \<Sum>c\<in>C. \<mu> (c \<inter> d))"
     proof (intro sum.cong refl)
       fix d assume "d \<in> D"
       have Un_eq_d: "(\<Union>c\<in>C. c \<inter> d) = d"
         using \<open>d \<in> D\<close> \<open>\<Union>C = \<Union>D\<close> by auto
       moreover have "\<mu> (\<Union>c\<in>C. c \<inter> d) = (\<Sum>c\<in>C. \<mu> (c \<inter> d))"
       proof (rule volume_finite_additive)
         { fix c assume "c \<in> C" then show "c \<inter> d \<in> M"
             using C D \<open>d \<in> D\<close> by auto }
         show "(\<Union>a\<in>C. a \<inter> d) \<in> M"
           unfolding Un_eq_d using \<open>d \<in> D\<close> D by auto
         show "disjoint_family_on (\<lambda>a. a \<inter> d) C"
           using \<open>disjoint C\<close> by (auto simp: disjoint_family_on_def disjoint_def)
       qed fact+
       ultimately show "\<mu> d = (\<Sum>c\<in>C. \<mu> (c \<inter> d))" by simp
     qed }
   note split_sum = this
 
   { fix C assume C: "C \<subseteq> M" "finite C" "disjoint C"
     fix D assume D: "D \<subseteq> M" "finite D" "disjoint D"
     assume "\<Union>C = \<Union>D"
     with split_sum[OF C D] split_sum[OF D C]
     have "(\<Sum>d\<in>D. \<mu> d) = (\<Sum>c\<in>C. \<mu> c)"
       by (simp, subst sum.swap, simp add: ac_simps) }
   note sum_eq = this
 
   { fix C assume C: "C \<subseteq> M" "finite C" "disjoint C"
     then have "\<Union>C \<in> ?R" by (auto simp: generated_ring_def)
     with \<mu>'_spec[THEN bspec, of "\<Union>C"]
     obtain D where
       D: "D \<subseteq> M" "finite D" "disjoint D" "\<Union>C = \<Union>D" and "\<mu>' (\<Union>C) = (\<Sum>d\<in>D. \<mu> d)"
       by auto
     with sum_eq[OF C D] have "\<mu>' (\<Union>C) = (\<Sum>c\<in>C. \<mu> c)" by simp }
   note \<mu>' = this
 
   show ?thesis
   proof (intro exI conjI ring_of_sets.volume_additiveI[OF generating_ring] ballI)
     fix a assume "a \<in> M" with \<mu>'[of "{a}"] show "\<mu>' a = \<mu> a"
       by (simp add: disjoint_def)
   next
-    fix a assume "a \<in> ?R" then guess Ca .. note Ca = this
+    fix a assume "a \<in> ?R"
+    then obtain Ca where Ca: "finite Ca" "disjoint Ca" "Ca \<subseteq> M" "a = \<Union> Ca" ..
     with \<mu>'[of Ca] \<open>volume M \<mu>\<close>[THEN volume_positive]
     show "0 \<le> \<mu>' a"
       by (auto intro!: sum_nonneg)
   next
     show "\<mu>' {} = 0" using \<mu>'[of "{}"] by auto
   next
-    fix a assume "a \<in> ?R" then guess Ca .. note Ca = this
-    fix b assume "b \<in> ?R" then guess Cb .. note Cb = this
+    fix a b assume "a \<in> ?R" "b \<in> ?R"
+    then obtain Ca Cb
+      where Ca: "finite Ca" "disjoint Ca" "Ca \<subseteq> M" "a = \<Union> Ca"
+        and Cb: "finite Cb" "disjoint Cb" "Cb \<subseteq> M" "b = \<Union> Cb"
+      by (meson generated_ringE)
     assume "a \<inter> b = {}"
     with Ca Cb have "Ca \<inter> Cb \<subseteq> {{}}" by auto
     then have C_Int_cases: "Ca \<inter> Cb = {{}} \<or> Ca \<inter> Cb = {}" by auto
 
     from \<open>a \<inter> b = {}\<close> have "\<mu>' (\<Union>(Ca \<union> Cb)) = (\<Sum>c\<in>Ca \<union> Cb. \<mu> c)"
       using Ca Cb by (intro \<mu>') (auto intro!: disjoint_union)
     also have "\<dots> = (\<Sum>c\<in>Ca \<union> Cb. \<mu> c) + (\<Sum>c\<in>Ca \<inter> Cb. \<mu> c)"
       using C_Int_cases volume_empty[OF \<open>volume M \<mu>\<close>] by (elim disjE) simp_all
     also have "\<dots> = (\<Sum>c\<in>Ca. \<mu> c) + (\<Sum>c\<in>Cb. \<mu> c)"
       using Ca Cb by (simp add: sum.union_inter)
     also have "\<dots> = \<mu>' a + \<mu>' b"
       using Ca Cb by (simp add: \<mu>')
     finally show "\<mu>' (a \<union> b) = \<mu>' a + \<mu>' b"
       using Ca Cb by simp
   qed
 qed
 
 subsubsection\<^marker>\<open>tag important\<close> \<open>Caratheodory on semirings\<close>
 
 theorem (in semiring_of_sets) caratheodory:
   assumes pos: "positive M \<mu>" and ca: "countably_additive M \<mu>"
   shows "\<exists>\<mu>' :: 'a set \<Rightarrow> ennreal. (\<forall>s \<in> M. \<mu>' s = \<mu> s) \<and> measure_space \<Omega> (sigma_sets \<Omega> M) \<mu>'"
 proof -
   have "volume M \<mu>"
   proof (rule volumeI)
     { fix a assume "a \<in> M" then show "0 \<le> \<mu> a"
         using pos unfolding positive_def by auto }
     note p = this
 
     fix C assume sets_C: "C \<subseteq> M" "\<Union>C \<in> M" and "disjoint C" "finite C"
     have "\<exists>F'. bij_betw F' {..<card C} C"
       by (rule finite_same_card_bij[OF _ \<open>finite C\<close>]) auto
-    then guess F' .. note F' = this
+    then obtain F' where "bij_betw F' {..<card C} C" ..
     then have F': "C = F' ` {..< card C}" "inj_on F' {..< card C}"
       by (auto simp: bij_betw_def)
     { fix i j assume *: "i < card C" "j < card C" "i \<noteq> j"
       with F' have "F' i \<in> C" "F' j \<in> C" "F' i \<noteq> F' j"
         unfolding inj_on_def by auto
       with \<open>disjoint C\<close>[THEN disjointD]
       have "F' i \<inter> F' j = {}"
         by auto }
     note F'_disj = this
     define F where "F i = (if i < card C then F' i else {})" for i
     then have "disjoint_family F"
       using F'_disj by (auto simp: disjoint_family_on_def)
     moreover from F' have "(\<Union>i. F i) = \<Union>C"
       by (auto simp add: F_def split: if_split_asm cong del: SUP_cong)
     moreover have sets_F: "\<And>i. F i \<in> M"
       using F' sets_C by (auto simp: F_def)
     moreover note sets_C
     ultimately have "\<mu> (\<Union>C) = (\<Sum>i. \<mu> (F i))"
       using ca[unfolded countably_additive_def, THEN spec, of F] by auto
     also have "\<dots> = (\<Sum>i<card C. \<mu> (F' i))"
     proof -
       have "(\<lambda>i. if i \<in> {..< card C} then \<mu> (F' i) else 0) sums (\<Sum>i<card C. \<mu> (F' i))"
         by (rule sums_If_finite_set) auto
       also have "(\<lambda>i. if i \<in> {..< card C} then \<mu> (F' i) else 0) = (\<lambda>i. \<mu> (F i))"
         using pos by (auto simp: positive_def F_def)
       finally show "(\<Sum>i. \<mu> (F i)) = (\<Sum>i<card C. \<mu> (F' i))"
         by (simp add: sums_iff)
     qed
     also have "\<dots> = (\<Sum>c\<in>C. \<mu> c)"
       using F'(2) by (subst (2) F') (simp add: sum.reindex)
     finally show "\<mu> (\<Union>C) = (\<Sum>c\<in>C. \<mu> c)" .
   next
     show "\<mu> {} = 0"
       using \<open>positive M \<mu>\<close> by (rule positiveD1)
   qed
   from extend_volume[OF this] obtain \<mu>_r where
     V: "volume generated_ring \<mu>_r" "\<And>a. a \<in> M \<Longrightarrow> \<mu> a = \<mu>_r a"
     by auto
 
   interpret G: ring_of_sets \<Omega> generated_ring
     by (rule generating_ring)
 
   have pos: "positive generated_ring \<mu>_r"
     using V unfolding positive_def by (auto simp: positive_def intro!: volume_positive volume_empty)
 
   have "countably_additive generated_ring \<mu>_r"
   proof (rule countably_additiveI)
-    fix A' :: "nat \<Rightarrow> 'a set" assume A': "range A' \<subseteq> generated_ring" "disjoint_family A'"
+    fix A' :: "nat \<Rightarrow> 'a set"
+    assume A': "range A' \<subseteq> generated_ring" "disjoint_family A'"
       and Un_A: "(\<Union>i. A' i) \<in> generated_ring"
 
-    from generated_ringE[OF Un_A] guess C' . note C' = this
+    obtain C' where C': "finite C'" "disjoint C'" "C' \<subseteq> M" "\<Union> (range A') = \<Union> C'"
+      using generated_ringE[OF Un_A] by auto
 
     { fix c assume "c \<in> C'"
       moreover define A where [abs_def]: "A i = A' i \<inter> c" for i
       ultimately have A: "range A \<subseteq> generated_ring" "disjoint_family A"
         and Un_A: "(\<Union>i. A i) \<in> generated_ring"
         using A' C'
         by (auto intro!: G.Int G.finite_Union intro: generated_ringI_Basic simp: disjoint_family_on_def)
       from A C' \<open>c \<in> C'\<close> have UN_eq: "(\<Union>i. A i) = c"
         by (auto simp: A_def)
 
       have "\<forall>i::nat. \<exists>f::nat \<Rightarrow> 'a set. \<mu>_r (A i) = (\<Sum>j. \<mu>_r (f j)) \<and> disjoint_family f \<and> \<Union>(range f) = A i \<and> (\<forall>j. f j \<in> M)"
         (is "\<forall>i. ?P i")
       proof
         fix i
         from A have Ai: "A i \<in> generated_ring" by auto
-        from generated_ringE[OF this] guess C . note C = this
-
+        from generated_ringE[OF this] obtain C
+          where C: "finite C" "disjoint C" "C \<subseteq> M" "A i = \<Union> C" by auto
         have "\<exists>F'. bij_betw F' {..<card C} C"
           by (rule finite_same_card_bij[OF _ \<open>finite C\<close>]) auto
-        then guess F .. note F = this
+        then obtain F where F: "bij_betw F {..<card C} C" ..
         define f where [abs_def]: "f i = (if i < card C then F i else {})" for i
         then have f: "bij_betw f {..< card C} C"
           by (intro bij_betw_cong[THEN iffD1, OF _ F]) auto
         with C have "\<forall>j. f j \<in> M"
           by (auto simp: Pi_iff f_def dest!: bij_betw_imp_funcset)
         moreover
         from f C have d_f: "disjoint_family_on f {..<card C}"
           by (intro disjoint_image_disjoint_family_on) (auto simp: bij_betw_def)
         then have "disjoint_family f"
           by (auto simp: disjoint_family_on_def f_def)
         moreover
         have Ai_eq: "A i = (\<Union>x<card C. f x)"
           using f C Ai unfolding bij_betw_def by auto
         then have "\<Union>(range f) = A i"
           using f by (auto simp add: f_def)
         moreover
         { have "(\<Sum>j. \<mu>_r (f j)) = (\<Sum>j. if j \<in> {..< card C} then \<mu>_r (f j) else 0)"
             using volume_empty[OF V(1)] by (auto intro!: arg_cong[where f=suminf] simp: f_def)
           also have "\<dots> = (\<Sum>j<card C. \<mu>_r (f j))"
             by (rule sums_If_finite_set[THEN sums_unique, symmetric]) simp
           also have "\<dots> = \<mu>_r (A i)"
             using C f[THEN bij_betw_imp_funcset] unfolding Ai_eq
             by (intro volume_finite_additive[OF V(1) _ d_f, symmetric])
                (auto simp: Pi_iff Ai_eq intro: generated_ringI_Basic)
           finally have "\<mu>_r (A i) = (\<Sum>j. \<mu>_r (f j))" .. }
         ultimately show "?P i"
           by blast
       qed
-      from choice[OF this] guess f .. note f = this
+      from choice[OF this] obtain f
+        where f: "\<forall>x. \<mu>_r (A x) = (\<Sum>j. \<mu>_r (f x j)) \<and> disjoint_family (f x) \<and> \<Union> (range (f x)) = A x \<and> (\<forall>j. f x j \<in> M)"
+        ..
       then have UN_f_eq: "(\<Union>i. case_prod f (prod_decode i)) = (\<Union>i. A i)"
         unfolding UN_extend_simps surj_prod_decode by (auto simp: set_eq_iff)
 
       have d: "disjoint_family (\<lambda>i. case_prod f (prod_decode i))"
         unfolding disjoint_family_on_def
       proof (intro ballI impI)
         fix m n :: nat assume "m \<noteq> n"
         then have neq: "prod_decode m \<noteq> prod_decode n"
           using inj_prod_decode[of UNIV] by (auto simp: inj_on_def)
         show "case_prod f (prod_decode m) \<inter> case_prod f (prod_decode n) = {}"
         proof cases
           assume "fst (prod_decode m) = fst (prod_decode n)"
           then show ?thesis
             using neq f by (fastforce simp: disjoint_family_on_def)
         next
           assume neq: "fst (prod_decode m) \<noteq> fst (prod_decode n)"
           have "case_prod f (prod_decode m) \<subseteq> A (fst (prod_decode m))"
             "case_prod f (prod_decode n) \<subseteq> A (fst (prod_decode n))"
             using f[THEN spec, of "fst (prod_decode m)"]
             using f[THEN spec, of "fst (prod_decode n)"]
             by (auto simp: set_eq_iff)
           with f A neq show ?thesis
             by (fastforce simp: disjoint_family_on_def subset_eq set_eq_iff)
         qed
       qed
       from f have "(\<Sum>n. \<mu>_r (A n)) = (\<Sum>n. \<mu>_r (case_prod f (prod_decode n)))"
         by (intro suminf_ennreal_2dimen[symmetric] generated_ringI_Basic)
          (auto split: prod.split)
       also have "\<dots> = (\<Sum>n. \<mu> (case_prod f (prod_decode n)))"
         using f V(2) by (auto intro!: arg_cong[where f=suminf] split: prod.split)
       also have "\<dots> = \<mu> (\<Union>i. case_prod f (prod_decode i))"
         using f \<open>c \<in> C'\<close> C'
         by (intro ca[unfolded countably_additive_def, rule_format])
            (auto split: prod.split simp: UN_f_eq d UN_eq)
       finally have "(\<Sum>n. \<mu>_r (A' n \<inter> c)) = \<mu> c"
         using UN_f_eq UN_eq by (simp add: A_def) }
     note eq = this
 
     have "(\<Sum>n. \<mu>_r (A' n)) = (\<Sum>n. \<Sum>c\<in>C'. \<mu>_r (A' n \<inter> c))"
       using C' A'
       by (subst volume_finite_additive[symmetric, OF V(1)])
          (auto simp: disjoint_def disjoint_family_on_def
                intro!: G.Int G.finite_Union arg_cong[where f="\<lambda>X. suminf (\<lambda>i. \<mu>_r (X i))"] ext
                intro: generated_ringI_Basic)
     also have "\<dots> = (\<Sum>c\<in>C'. \<Sum>n. \<mu>_r (A' n \<inter> c))"
       using C' A'
       by (intro suminf_sum G.Int G.finite_Union) (auto intro: generated_ringI_Basic)
     also have "\<dots> = (\<Sum>c\<in>C'. \<mu>_r c)"
       using eq V C' by (auto intro!: sum.cong)
     also have "\<dots> = \<mu>_r (\<Union>C')"
       using C' Un_A
       by (subst volume_finite_additive[symmetric, OF V(1)])
          (auto simp: disjoint_family_on_def disjoint_def
                intro: generated_ringI_Basic)
     finally show "(\<Sum>n. \<mu>_r (A' n)) = \<mu>_r (\<Union>i. A' i)"
       using C' by simp
   qed
-  from G.caratheodory'[OF \<open>positive generated_ring \<mu>_r\<close> \<open>countably_additive generated_ring \<mu>_r\<close>]
-  guess \<mu>' ..
+  obtain \<mu>' where "(\<forall>s\<in>generated_ring. \<mu>' s = \<mu>_r s) \<and> measure_space \<Omega> (sigma_sets \<Omega> generated_ring) \<mu>'"
+    using G.caratheodory'[OF pos \<open>countably_additive generated_ring \<mu>_r\<close>] by auto
   with V show ?thesis
     unfolding sigma_sets_generated_ring_eq
     by (intro exI[of _ \<mu>']) (auto intro: generated_ringI_Basic)
 qed
 
 lemma extend_measure_caratheodory:
   fixes G :: "'i \<Rightarrow> 'a set"
   assumes M: "M = extend_measure \<Omega> I G \<mu>"
   assumes "i \<in> I"
   assumes "semiring_of_sets \<Omega> (G ` I)"
   assumes empty: "\<And>i. i \<in> I \<Longrightarrow> G i = {} \<Longrightarrow> \<mu> i = 0"
   assumes inj: "\<And>i j. i \<in> I \<Longrightarrow> j \<in> I \<Longrightarrow> G i = G j \<Longrightarrow> \<mu> i = \<mu> j"
   assumes nonneg: "\<And>i. i \<in> I \<Longrightarrow> 0 \<le> \<mu> i"
   assumes add: "\<And>A::nat \<Rightarrow> 'i. \<And>j. A \<in> UNIV \<rightarrow> I \<Longrightarrow> j \<in> I \<Longrightarrow> disjoint_family (G \<circ> A) \<Longrightarrow>
     (\<Union>i. G (A i)) = G j \<Longrightarrow> (\<Sum>n. \<mu> (A n)) = \<mu> j"
   shows "emeasure M (G i) = \<mu> i"
 
 proof -
   interpret semiring_of_sets \<Omega> "G ` I"
     by fact
   have "\<forall>g\<in>G`I. \<exists>i\<in>I. g = G i"
     by auto
   then obtain sel where sel: "\<And>g. g \<in> G ` I \<Longrightarrow> sel g \<in> I" "\<And>g. g \<in> G ` I \<Longrightarrow> G (sel g) = g"
     by metis
 
   have "\<exists>\<mu>'. (\<forall>s\<in>G ` I. \<mu>' s = \<mu> (sel s)) \<and> measure_space \<Omega> (sigma_sets \<Omega> (G ` I)) \<mu>'"
   proof (rule caratheodory)
     show "positive (G ` I) (\<lambda>s. \<mu> (sel s))"
       by (auto simp: positive_def intro!: empty sel nonneg)
     show "countably_additive (G ` I) (\<lambda>s. \<mu> (sel s))"
     proof (rule countably_additiveI)
       fix A :: "nat \<Rightarrow> 'a set" assume "range A \<subseteq> G ` I" "disjoint_family A" "(\<Union>i. A i) \<in> G ` I"
       then show "(\<Sum>i. \<mu> (sel (A i))) = \<mu> (sel (\<Union>i. A i))"
         by (intro add) (auto simp: sel image_subset_iff_funcset comp_def Pi_iff intro!: sel)
     qed
   qed
   then obtain \<mu>' where \<mu>': "\<forall>s\<in>G ` I. \<mu>' s = \<mu> (sel s)" "measure_space \<Omega> (sigma_sets \<Omega> (G ` I)) \<mu>'"
     by metis
 
   show ?thesis
   proof (rule emeasure_extend_measure[OF M])
     { fix i assume "i \<in> I" then show "\<mu>' (G i) = \<mu> i"
       using \<mu>' by (auto intro!: inj sel) }
     show "G ` I \<subseteq> Pow \<Omega>"
       by (rule space_closed)
     then show "positive (sets M) \<mu>'" "countably_additive (sets M) \<mu>'"
       using \<mu>' by (simp_all add: M sets_extend_measure measure_space_def)
   qed fact
 qed
 
 proposition extend_measure_caratheodory_pair:
   fixes G :: "'i \<Rightarrow> 'j \<Rightarrow> 'a set"
   assumes M: "M = extend_measure \<Omega> {(a, b). P a b} (\<lambda>(a, b). G a b) (\<lambda>(a, b). \<mu> a b)"
   assumes "P i j"
   assumes semiring: "semiring_of_sets \<Omega> {G a b | a b. P a b}"
   assumes empty: "\<And>i j. P i j \<Longrightarrow> G i j = {} \<Longrightarrow> \<mu> i j = 0"
   assumes inj: "\<And>i j k l. P i j \<Longrightarrow> P k l \<Longrightarrow> G i j = G k l \<Longrightarrow> \<mu> i j = \<mu> k l"
   assumes nonneg: "\<And>i j. P i j \<Longrightarrow> 0 \<le> \<mu> i j"
   assumes add: "\<And>A::nat \<Rightarrow> 'i. \<And>B::nat \<Rightarrow> 'j. \<And>j k.
     (\<And>n. P (A n) (B n)) \<Longrightarrow> P j k \<Longrightarrow> disjoint_family (\<lambda>n. G (A n) (B n)) \<Longrightarrow>
     (\<Union>i. G (A i) (B i)) = G j k \<Longrightarrow> (\<Sum>n. \<mu> (A n) (B n)) = \<mu> j k"
   shows "emeasure M (G i j) = \<mu> i j"
 proof -
   have "emeasure M ((\<lambda>(a, b). G a b) (i, j)) = (\<lambda>(a, b). \<mu> a b) (i, j)"
   proof (rule extend_measure_caratheodory[OF M])
     show "semiring_of_sets \<Omega> ((\<lambda>(a, b). G a b) ` {(a, b). P a b})"
       using semiring by (simp add: image_def conj_commute)
   next
     fix A :: "nat \<Rightarrow> ('i \<times> 'j)" and j assume "A \<in> UNIV \<rightarrow> {(a, b). P a b}" "j \<in> {(a, b). P a b}"
       "disjoint_family ((\<lambda>(a, b). G a b) \<circ> A)"
       "(\<Union>i. case A i of (a, b) \<Rightarrow> G a b) = (case j of (a, b) \<Rightarrow> G a b)"
     then show "(\<Sum>n. case A n of (a, b) \<Rightarrow> \<mu> a b) = (case j of (a, b) \<Rightarrow> \<mu> a b)"
       using add[of "\<lambda>i. fst (A i)" "\<lambda>i. snd (A i)" "fst j" "snd j"]
       by (simp add: split_beta' comp_def Pi_iff)
   qed (auto split: prod.splits intro: assms)
   then show ?thesis by simp
 qed
 
 end
diff --git a/src/HOL/Analysis/Complete_Measure.thy b/src/HOL/Analysis/Complete_Measure.thy
--- a/src/HOL/Analysis/Complete_Measure.thy
+++ b/src/HOL/Analysis/Complete_Measure.thy
@@ -1,1159 +1,1164 @@
 (*  Title:      HOL/Analysis/Complete_Measure.thy
     Author:     Robert Himmelmann, Johannes Hoelzl, TU Muenchen
 *)
 section \<open>Complete Measures\<close>
 theory Complete_Measure
   imports Bochner_Integration
 begin
 
 locale\<^marker>\<open>tag important\<close> complete_measure =
   fixes M :: "'a measure"
   assumes complete: "\<And>A B. B \<subseteq> A \<Longrightarrow> A \<in> null_sets M \<Longrightarrow> B \<in> sets M"
 
 definition\<^marker>\<open>tag important\<close>
   "split_completion M A p = (if A \<in> sets M then p = (A, {}) else
    \<exists>N'. A = fst p \<union> snd p \<and> fst p \<inter> snd p = {} \<and> fst p \<in> sets M \<and> snd p \<subseteq> N' \<and> N' \<in> null_sets M)"
 
 definition\<^marker>\<open>tag important\<close>
   "main_part M A = fst (Eps (split_completion M A))"
 
 definition\<^marker>\<open>tag important\<close>
   "null_part M A = snd (Eps (split_completion M A))"
 
 definition\<^marker>\<open>tag important\<close> completion :: "'a measure \<Rightarrow> 'a measure" where
   "completion M = measure_of (space M) { S \<union> N |S N N'. S \<in> sets M \<and> N' \<in> null_sets M \<and> N \<subseteq> N' }
     (emeasure M \<circ> main_part M)"
 
 lemma completion_into_space:
   "{ S \<union> N |S N N'. S \<in> sets M \<and> N' \<in> null_sets M \<and> N \<subseteq> N' } \<subseteq> Pow (space M)"
   using sets.sets_into_space by auto
 
 lemma space_completion[simp]: "space (completion M) = space M"
   unfolding completion_def using space_measure_of[OF completion_into_space] by simp
 
 lemma completionI:
   assumes "A = S \<union> N" "N \<subseteq> N'" "N' \<in> null_sets M" "S \<in> sets M"
   shows "A \<in> { S \<union> N |S N N'. S \<in> sets M \<and> N' \<in> null_sets M \<and> N \<subseteq> N' }"
   using assms by auto
 
 lemma completionE:
   assumes "A \<in> { S \<union> N |S N N'. S \<in> sets M \<and> N' \<in> null_sets M \<and> N \<subseteq> N' }"
   obtains S N N' where "A = S \<union> N" "N \<subseteq> N'" "N' \<in> null_sets M" "S \<in> sets M"
   using assms by auto
 
 lemma sigma_algebra_completion:
   "sigma_algebra (space M) { S \<union> N |S N N'. S \<in> sets M \<and> N' \<in> null_sets M \<and> N \<subseteq> N' }"
     (is "sigma_algebra _ ?A")
   unfolding sigma_algebra_iff2
 proof (intro conjI ballI allI impI)
   show "?A \<subseteq> Pow (space M)"
     using sets.sets_into_space by auto
 next
   show "{} \<in> ?A" by auto
 next
   let ?C = "space M"
-  fix A assume "A \<in> ?A" from completionE[OF this] guess S N N' .
+  fix A assume "A \<in> ?A"
+  then obtain S N N'
+    where "A = S \<union> N" "N \<subseteq> N'" "N' \<in> null_sets M" "S \<in> sets M"
+    by (rule completionE)
   then show "space M - A \<in> ?A"
     by (intro completionI[of _ "(?C - S) \<inter> (?C - N')" "(?C - S) \<inter> N' \<inter> (?C - N)"]) auto
 next
   fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> ?A"
   then have "\<forall>n. \<exists>S N N'. A n = S \<union> N \<and> S \<in> sets M \<and> N' \<in> null_sets M \<and> N \<subseteq> N'"
     by (auto simp: image_subset_iff)
-  from choice[OF this] guess S ..
-  from choice[OF this] guess N ..
-  from choice[OF this] guess N' ..
+  then obtain S N N' where "\<forall>x. A x = S x \<union> N x \<and> S x \<in> sets M \<and> N' x \<in> null_sets M \<and> N x \<subseteq> N' x"
+    by metis
   then show "\<Union>(A ` UNIV) \<in> ?A"
     using null_sets_UN[of N']
     by (intro completionI[of _ "\<Union>(S ` UNIV)" "\<Union>(N ` UNIV)" "\<Union>(N' ` UNIV)"]) auto
 qed
 
 lemma\<^marker>\<open>tag important\<close> sets_completion:
   "sets (completion M) = { S \<union> N |S N N'. S \<in> sets M \<and> N' \<in> null_sets M \<and> N \<subseteq> N' }"
   using sigma_algebra.sets_measure_of_eq[OF sigma_algebra_completion] 
   by (simp add: completion_def)
 
 lemma sets_completionE:
   assumes "A \<in> sets (completion M)"
   obtains S N N' where "A = S \<union> N" "N \<subseteq> N'" "N' \<in> null_sets M" "S \<in> sets M"
   using assms unfolding sets_completion by auto
 
 lemma sets_completionI:
   assumes "A = S \<union> N" "N \<subseteq> N'" "N' \<in> null_sets M" "S \<in> sets M"
   shows "A \<in> sets (completion M)"
   using assms unfolding sets_completion by auto
 
 lemma sets_completionI_sets[intro, simp]:
   "A \<in> sets M \<Longrightarrow> A \<in> sets (completion M)"
   unfolding sets_completion by force
 
 lemma\<^marker>\<open>tag important\<close> measurable_completion: "f \<in> M \<rightarrow>\<^sub>M N \<Longrightarrow> f \<in> completion M \<rightarrow>\<^sub>M N"
   by (auto simp: measurable_def)
 
 lemma null_sets_completion:
   assumes "N' \<in> null_sets M" "N \<subseteq> N'" shows "N \<in> sets (completion M)"
   using assms by (intro sets_completionI[of N "{}" N N']) auto
 
 lemma\<^marker>\<open>tag important\<close> split_completion:
   assumes "A \<in> sets (completion M)"
   shows "split_completion M A (main_part M A, null_part M A)"
 proof cases
   assume "A \<in> sets M" then show ?thesis
     by (simp add: split_completion_def[abs_def] main_part_def null_part_def)
 next
   assume nA: "A \<notin> sets M"
   show ?thesis
     unfolding main_part_def null_part_def if_not_P[OF nA]
   proof (rule someI2_ex)
-    from assms[THEN sets_completionE] guess S N N' . note A = this
+    from assms obtain S N N' where A: "A = S \<union> N" "N \<subseteq> N'" "N' \<in> null_sets M" "S \<in> sets M"
+      by (blast intro: sets_completionE)
     let ?P = "(S, N - S)"
     show "\<exists>p. split_completion M A p"
       unfolding split_completion_def if_not_P[OF nA] using A
     proof (intro exI conjI)
       show "A = fst ?P \<union> snd ?P" using A by auto
       show "snd ?P \<subseteq> N'" using A by auto
    qed auto
   qed auto
 qed
 
 lemma sets_restrict_space_subset:
   assumes S: "S \<in> sets (completion M)"
   shows "sets (restrict_space (completion M) S) \<subseteq> sets (completion M)"
   by (metis assms sets.Int_space_eq2 sets_restrict_space_iff subsetI)
 
 lemma
   assumes "S \<in> sets (completion M)"
   shows main_part_sets[intro, simp]: "main_part M S \<in> sets M"
     and main_part_null_part_Un[simp]: "main_part M S \<union> null_part M S = S"
     and main_part_null_part_Int[simp]: "main_part M S \<inter> null_part M S = {}"
   using split_completion[OF assms]
   by (auto simp: split_completion_def split: if_split_asm)
 
 lemma main_part[simp]: "S \<in> sets M \<Longrightarrow> main_part M S = S"
   using split_completion[of S M]
   by (auto simp: split_completion_def split: if_split_asm)
 
 lemma null_part:
   assumes "S \<in> sets (completion M)" shows "\<exists>N. N\<in>null_sets M \<and> null_part M S \<subseteq> N"
   using split_completion[OF assms] by (auto simp: split_completion_def split: if_split_asm)
 
 lemma null_part_sets[intro, simp]:
   assumes "S \<in> sets M" shows "null_part M S \<in> sets M" "emeasure M (null_part M S) = 0"
 proof -
   have S: "S \<in> sets (completion M)" using assms by auto
-  have "S - main_part M S \<in> sets M" using assms by auto
-  moreover
+  have *: "S - main_part M S \<in> sets M" using assms by auto
   from main_part_null_part_Un[OF S] main_part_null_part_Int[OF S]
   have "S - main_part M S = null_part M S" by auto
-  ultimately show sets: "null_part M S \<in> sets M" by auto
-  from null_part[OF S] guess N ..
+  with * show sets: "null_part M S \<in> sets M" by auto
+  from null_part[OF S] obtain N where "N \<in> null_sets M \<and> null_part M S \<subseteq> N" ..
   with emeasure_eq_0[of N _ "null_part M S"] sets
   show "emeasure M (null_part M S) = 0" by auto
 qed
 
 lemma emeasure_main_part_UN:
   fixes S :: "nat \<Rightarrow> 'a set"
   assumes "range S \<subseteq> sets (completion M)"
   shows "emeasure M (main_part M (\<Union>i. (S i))) = emeasure M (\<Union>i. main_part M (S i))"
 proof -
   have S: "\<And>i. S i \<in> sets (completion M)" using assms by auto
   then have UN: "(\<Union>i. S i) \<in> sets (completion M)" by auto
   have "\<forall>i. \<exists>N. N \<in> null_sets M \<and> null_part M (S i) \<subseteq> N"
     using null_part[OF S] by auto
-  from choice[OF this] guess N .. note N = this
+  then obtain N where N: "\<forall>x. N x \<in> null_sets M \<and> null_part M (S x) \<subseteq> N x" by metis
   then have UN_N: "(\<Union>i. N i) \<in> null_sets M" by (intro null_sets_UN) auto
-  have "(\<Union>i. S i) \<in> sets (completion M)" using S by auto
-  from null_part[OF this] guess N' .. note N' = this
+  from S have "(\<Union>i. S i) \<in> sets (completion M)" by auto
+  from null_part[OF this] obtain N' where N': "N' \<in> null_sets M \<and> null_part M (\<Union> (range S)) \<subseteq> N'" ..
   let ?N = "(\<Union>i. N i) \<union> N'"
   have null_set: "?N \<in> null_sets M" using N' UN_N by (intro null_sets.Un) auto
   have "main_part M (\<Union>i. S i) \<union> ?N = (main_part M (\<Union>i. S i) \<union> null_part M (\<Union>i. S i)) \<union> ?N"
     using N' by auto
   also have "\<dots> = (\<Union>i. main_part M (S i) \<union> null_part M (S i)) \<union> ?N"
     unfolding main_part_null_part_Un[OF S] main_part_null_part_Un[OF UN] by auto
   also have "\<dots> = (\<Union>i. main_part M (S i)) \<union> ?N"
     using N by auto
   finally have *: "main_part M (\<Union>i. S i) \<union> ?N = (\<Union>i. main_part M (S i)) \<union> ?N" .
   have "emeasure M (main_part M (\<Union>i. S i)) = emeasure M (main_part M (\<Union>i. S i) \<union> ?N)"
     using null_set UN by (intro emeasure_Un_null_set[symmetric]) auto
   also have "\<dots> = emeasure M ((\<Union>i. main_part M (S i)) \<union> ?N)"
     unfolding * ..
   also have "\<dots> = emeasure M (\<Union>i. main_part M (S i))"
     using null_set S by (intro emeasure_Un_null_set) auto
   finally show ?thesis .
 qed
 
 lemma\<^marker>\<open>tag important\<close> emeasure_completion[simp]:
   assumes S: "S \<in> sets (completion M)"
   shows "emeasure (completion M) S = emeasure M (main_part M S)"
 proof (subst emeasure_measure_of[OF completion_def completion_into_space])
   let ?\<mu> = "emeasure M \<circ> main_part M"
   show "S \<in> sets (completion M)" "?\<mu> S = emeasure M (main_part M S) " using S by simp_all
   show "positive (sets (completion M)) ?\<mu>"
     by (simp add: positive_def)
   show "countably_additive (sets (completion M)) ?\<mu>"
   proof (intro countably_additiveI)
     fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> sets (completion M)" "disjoint_family A"
     have "disjoint_family (\<lambda>i. main_part M (A i))"
     proof (intro disjoint_family_on_bisimulation[OF A(2)])
       fix n m assume "A n \<inter> A m = {}"
       then have "(main_part M (A n) \<union> null_part M (A n)) \<inter> (main_part M (A m) \<union> null_part M (A m)) = {}"
         using A by (subst (1 2) main_part_null_part_Un) auto
       then show "main_part M (A n) \<inter> main_part M (A m) = {}" by auto
     qed
     then have "(\<Sum>n. emeasure M (main_part M (A n))) = emeasure M (\<Union>i. main_part M (A i))"
       using A by (auto intro!: suminf_emeasure)
     then show "(\<Sum>n. ?\<mu> (A n)) = ?\<mu> (\<Union>(A ` UNIV))"
       by (simp add: completion_def emeasure_main_part_UN[OF A(1)])
   qed
 qed
 
 lemma measure_completion[simp]: "S \<in> sets M \<Longrightarrow> measure (completion M) S = measure M S"
   unfolding measure_def by auto
 
 lemma emeasure_completion_UN:
   "range S \<subseteq> sets (completion M) \<Longrightarrow>
     emeasure (completion M) (\<Union>i::nat. (S i)) = emeasure M (\<Union>i. main_part M (S i))"
   by (subst emeasure_completion) (auto simp add: emeasure_main_part_UN)
 
 lemma emeasure_completion_Un:
   assumes S: "S \<in> sets (completion M)" and T: "T \<in> sets (completion M)"
   shows "emeasure (completion M) (S \<union> T) = emeasure M (main_part M S \<union> main_part M T)"
 proof (subst emeasure_completion)
   have UN: "(\<Union>i. binary (main_part M S) (main_part M T) i) = (\<Union>i. main_part M (binary S T i))"
     unfolding binary_def by (auto split: if_split_asm)
   show "emeasure M (main_part M (S \<union> T)) = emeasure M (main_part M S \<union> main_part M T)"
     using emeasure_main_part_UN[of "binary S T" M] assms
     by (simp add: range_binary_eq, simp add: Un_range_binary UN)
 qed (auto intro: S T)
 
 lemma sets_completionI_sub:
   assumes N: "N' \<in> null_sets M" "N \<subseteq> N'"
   shows "N \<in> sets (completion M)"
   using assms by (intro sets_completionI[of _ "{}" N N']) auto
 
 lemma completion_ex_simple_function:
   assumes f: "simple_function (completion M) f"
   shows "\<exists>f'. simple_function M f' \<and> (AE x in M. f x = f' x)"
 proof -
   let ?F = "\<lambda>x. f -` {x} \<inter> space M"
   have F: "\<And>x. ?F x \<in> sets (completion M)" and fin: "finite (f`space M)"
     using simple_functionD[OF f] simple_functionD[OF f] by simp_all
   have "\<forall>x. \<exists>N. N \<in> null_sets M \<and> null_part M (?F x) \<subseteq> N"
     using F null_part by auto
   from choice[OF this] obtain N where
     N: "\<And>x. null_part M (?F x) \<subseteq> N x" "\<And>x. N x \<in> null_sets M" by auto
   let ?N = "\<Union>x\<in>f`space M. N x"
   let ?f' = "\<lambda>x. if x \<in> ?N then undefined else f x"
   have sets: "?N \<in> null_sets M" using N fin by (intro null_sets.finite_UN) auto
   show ?thesis unfolding simple_function_def
   proof (safe intro!: exI[of _ ?f'])
     have "?f' ` space M \<subseteq> f`space M \<union> {undefined}" by auto
     from finite_subset[OF this] simple_functionD(1)[OF f]
     show "finite (?f' ` space M)" by auto
   next
     fix x assume "x \<in> space M"
     have "?f' -` {?f' x} \<inter> space M =
       (if x \<in> ?N then ?F undefined \<union> ?N
        else if f x = undefined then ?F (f x) \<union> ?N
        else ?F (f x) - ?N)"
       using N(2) sets.sets_into_space by (auto split: if_split_asm simp: null_sets_def)
     moreover { fix y have "?F y \<union> ?N \<in> sets M"
       proof cases
         assume y: "y \<in> f`space M"
         have "?F y \<union> ?N = (main_part M (?F y) \<union> null_part M (?F y)) \<union> ?N"
           using main_part_null_part_Un[OF F] by auto
         also have "\<dots> = main_part M (?F y) \<union> ?N"
           using y N by auto
         finally show ?thesis
           using F sets by auto
       next
         assume "y \<notin> f`space M" then have "?F y = {}" by auto
         then show ?thesis using sets by auto
       qed }
     moreover {
       have "?F (f x) - ?N = main_part M (?F (f x)) \<union> null_part M (?F (f x)) - ?N"
         using main_part_null_part_Un[OF F] by auto
       also have "\<dots> = main_part M (?F (f x)) - ?N"
         using N \<open>x \<in> space M\<close> by auto
       finally have "?F (f x) - ?N \<in> sets M"
         using F sets by auto }
     ultimately show "?f' -` {?f' x} \<inter> space M \<in> sets M" by auto
   next
     show "AE x in M. f x = ?f' x"
       by (rule AE_I', rule sets) auto
   qed
 qed
 
 lemma\<^marker>\<open>tag important\<close> completion_ex_borel_measurable:
   fixes g :: "'a \<Rightarrow> ennreal"
   assumes g: "g \<in> borel_measurable (completion M)"
   shows "\<exists>g'\<in>borel_measurable M. (AE x in M. g x = g' x)"
 proof -
-  from g[THEN borel_measurable_implies_simple_function_sequence'] guess f . note f = this
-  from this(1)[THEN completion_ex_simple_function]
+  obtain f :: "nat \<Rightarrow> 'a \<Rightarrow> ennreal"
+    where *: "\<And>i. simple_function (completion M) (f i)"
+      and **: "\<And>x. (SUP i. f i x) = g x"
+    using g[THEN borel_measurable_implies_simple_function_sequence'] by metis
+  from *[THEN completion_ex_simple_function]
   have "\<forall>i. \<exists>f'. simple_function M f' \<and> (AE x in M. f i x = f' x)" ..
-  from this[THEN choice] obtain f' where
-    sf: "\<And>i. simple_function M (f' i)" and
-    AE: "\<forall>i. AE x in M. f i x = f' i x" by auto
+  then obtain f'
+    where sf: "\<And>i. simple_function M (f' i)"
+      and AE: "\<forall>i. AE x in M. f i x = f' i x"
+    by metis
   show ?thesis
   proof (intro bexI)
     from AE[unfolded AE_all_countable[symmetric]]
     show "AE x in M. g x = (SUP i. f' i x)" (is "AE x in M. g x = ?f x")
     proof (elim AE_mp, safe intro!: AE_I2)
       fix x assume eq: "\<forall>i. f i x = f' i x"
-      moreover have "g x = (SUP i. f i x)"
-        unfolding f by (auto split: split_max)
-      ultimately show "g x = ?f x" by auto
+      have "g x = (SUP i. f i x)" by (auto simp: ** split: split_max)
+      with eq show "g x = ?f x" by auto
     qed
     show "?f \<in> borel_measurable M"
       using sf[THEN borel_measurable_simple_function] by auto
   qed
 qed
 
 lemma null_sets_completionI: "N \<in> null_sets M \<Longrightarrow> N \<in> null_sets (completion M)"
   by (auto simp: null_sets_def)
 
 lemma AE_completion: "(AE x in M. P x) \<Longrightarrow> (AE x in completion M. P x)"
   unfolding eventually_ae_filter by (auto intro: null_sets_completionI)
 
 lemma null_sets_completion_iff: "N \<in> sets M \<Longrightarrow> N \<in> null_sets (completion M) \<longleftrightarrow> N \<in> null_sets M"
   by (auto simp: null_sets_def)
 
 lemma sets_completion_AE: "(AE x in M. \<not> P x) \<Longrightarrow> Measurable.pred (completion M) P"
   unfolding pred_def sets_completion eventually_ae_filter
   by auto
 
 lemma null_sets_completion_iff2:
   "A \<in> null_sets (completion M) \<longleftrightarrow> (\<exists>N'\<in>null_sets M. A \<subseteq> N')"
 proof safe
   assume "A \<in> null_sets (completion M)"
   then have A: "A \<in> sets (completion M)" and "main_part M A \<in> null_sets M"
     by (auto simp: null_sets_def)
   moreover obtain N where "N \<in> null_sets M" "null_part M A \<subseteq> N"
     using null_part[OF A] by auto
   ultimately show "\<exists>N'\<in>null_sets M. A \<subseteq> N'"
   proof (intro bexI)
     show "A \<subseteq> N \<union> main_part M A"
       using \<open>null_part M A \<subseteq> N\<close> by (subst main_part_null_part_Un[OF A, symmetric]) auto
   qed auto
 next
   fix N assume "N \<in> null_sets M" "A \<subseteq> N"
   then have "A \<in> sets (completion M)" and N: "N \<in> sets M" "A \<subseteq> N" "emeasure M N = 0"
     by (auto intro: null_sets_completion)
   moreover have "emeasure (completion M) A = 0"
     using N by (intro emeasure_eq_0[of N _ A]) auto
   ultimately show "A \<in> null_sets (completion M)"
     by auto
 qed
 
 lemma null_sets_completion_subset:
   "B \<subseteq> A \<Longrightarrow> A \<in> null_sets (completion M) \<Longrightarrow> B \<in> null_sets (completion M)"
   unfolding null_sets_completion_iff2 by auto
 
 interpretation completion: complete_measure "completion M" for M
 proof
   show "B \<subseteq> A \<Longrightarrow> A \<in> null_sets (completion M) \<Longrightarrow> B \<in> sets (completion M)" for B A
     using null_sets_completion_subset[of B A M] by (simp add: null_sets_def)
 qed
 
 lemma null_sets_restrict_space:
   "\<Omega> \<in> sets M \<Longrightarrow> A \<in> null_sets (restrict_space M \<Omega>) \<longleftrightarrow> A \<subseteq> \<Omega> \<and> A \<in> null_sets M"
   by (auto simp: null_sets_def emeasure_restrict_space sets_restrict_space)
 
 lemma completion_ex_borel_measurable_real:
   fixes g :: "'a \<Rightarrow> real"
   assumes g: "g \<in> borel_measurable (completion M)"
   shows "\<exists>g'\<in>borel_measurable M. (AE x in M. g x = g' x)"
 proof -
   have "(\<lambda>x. ennreal (g x)) \<in> completion M \<rightarrow>\<^sub>M borel" "(\<lambda>x. ennreal (- g x)) \<in> completion M \<rightarrow>\<^sub>M borel"
     using g by auto
   from this[THEN completion_ex_borel_measurable]
   obtain pf nf :: "'a \<Rightarrow> ennreal"
     where [measurable]: "nf \<in> M \<rightarrow>\<^sub>M borel" "pf \<in> M \<rightarrow>\<^sub>M borel"
       and ae: "AE x in M. pf x = ennreal (g x)" "AE x in M. nf x = ennreal (- g x)"
     by (auto simp: eq_commute)
   then have "AE x in M. pf x = ennreal (g x) \<and> nf x = ennreal (- g x)"
     by auto
   then obtain N where "N \<in> null_sets M" "{x\<in>space M. pf x \<noteq> ennreal (g x) \<and> nf x \<noteq> ennreal (- g x)} \<subseteq> N"
     by (auto elim!: AE_E)
   show ?thesis
   proof
     let ?F = "\<lambda>x. indicator (space M - N) x * (enn2real (pf x) - enn2real (nf x))"
     show "?F \<in> M \<rightarrow>\<^sub>M borel"
       using \<open>N \<in> null_sets M\<close> by auto
     show "AE x in M. g x = ?F x"
       using \<open>N \<in> null_sets M\<close>[THEN AE_not_in] ae AE_space
       apply eventually_elim
       subgoal for x
         by (cases "0::real" "g x" rule: linorder_le_cases) (auto simp: ennreal_neg)
       done
   qed
 qed
 
 lemma simple_function_completion: "simple_function M f \<Longrightarrow> simple_function (completion M) f"
   by (simp add: simple_function_def)
 
 lemma simple_integral_completion:
   "simple_function M f \<Longrightarrow> simple_integral (completion M) f = simple_integral M f"
   unfolding simple_integral_def by simp
 
 lemma nn_integral_completion: "nn_integral (completion M) f = nn_integral M f"
   unfolding nn_integral_def
 proof (safe intro!: SUP_eq)
   fix s assume s: "simple_function (completion M) s" and "s \<le> f"
   then obtain s' where s': "simple_function M s'" "AE x in M. s x = s' x"
     by (auto dest: completion_ex_simple_function)
   then obtain N where N: "N \<in> null_sets M" "{x\<in>space M. s x \<noteq> s' x} \<subseteq> N"
     by (auto elim!: AE_E)
   then have ae_N: "AE x in M. (s x \<noteq> s' x \<longrightarrow> x \<in> N) \<and> x \<notin> N"
     by (auto dest: AE_not_in)
   define s'' where "s'' x = (if x \<in> N then 0 else s x)" for x
   then have ae_s_eq_s'': "AE x in completion M. s x = s'' x"
     using s' ae_N by (intro AE_completion) auto
   have s'': "simple_function M s''"
   proof (subst simple_function_cong)
     show "t \<in> space M \<Longrightarrow> s'' t = (if t \<in> N then 0 else s' t)" for t
       using N by (auto simp: s''_def dest: sets.sets_into_space)
     show "simple_function M (\<lambda>t. if t \<in> N then 0 else s' t)"
       unfolding s''_def[abs_def] using N by (auto intro!: simple_function_If s')
   qed
 
   show "\<exists>j\<in>{g. simple_function M g \<and> g \<le> f}. integral\<^sup>S (completion M) s \<le> integral\<^sup>S M j"
   proof (safe intro!: bexI[of _ s''])
     have "integral\<^sup>S (completion M) s = integral\<^sup>S (completion M) s''"
       by (intro simple_integral_cong_AE s simple_function_completion s'' ae_s_eq_s'')
     then show "integral\<^sup>S (completion M) s \<le> integral\<^sup>S M s''"
       using s'' by (simp add: simple_integral_completion)
     from \<open>s \<le> f\<close> show "s'' \<le> f"
       unfolding s''_def le_fun_def by auto
   qed fact
 next
   fix s assume "simple_function M s" "s \<le> f"
   then show "\<exists>j\<in>{g. simple_function (completion M) g \<and> g \<le> f}. integral\<^sup>S M s \<le> integral\<^sup>S (completion M) j"
     by (intro bexI[of _ s]) (auto simp: simple_integral_completion simple_function_completion)
 qed
 
 lemma integrable_completion:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "f \<in> M \<rightarrow>\<^sub>M borel \<Longrightarrow> integrable (completion M) f \<longleftrightarrow> integrable M f"
   by (rule integrable_subalgebra[symmetric]) auto
 
 lemma integral_completion:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes f: "f \<in> M \<rightarrow>\<^sub>M borel" shows "integral\<^sup>L (completion M) f = integral\<^sup>L M f"
   by (rule integral_subalgebra[symmetric]) (auto intro: f)
 
 locale\<^marker>\<open>tag important\<close> semifinite_measure =
   fixes M :: "'a measure"
   assumes semifinite:
     "\<And>A. A \<in> sets M \<Longrightarrow> emeasure M A = \<infinity> \<Longrightarrow> \<exists>B\<in>sets M. B \<subseteq> A \<and> emeasure M B < \<infinity>"
 
 locale\<^marker>\<open>tag important\<close> locally_determined_measure = semifinite_measure +
   assumes locally_determined:
     "\<And>A. A \<subseteq> space M \<Longrightarrow> (\<And>B. B \<in> sets M \<Longrightarrow> emeasure M B < \<infinity> \<Longrightarrow> A \<inter> B \<in> sets M) \<Longrightarrow> A \<in> sets M"
 
 locale\<^marker>\<open>tag important\<close> cld_measure =
   complete_measure M + locally_determined_measure M for M :: "'a measure"
 
 definition\<^marker>\<open>tag important\<close> outer_measure_of :: "'a measure \<Rightarrow> 'a set \<Rightarrow> ennreal"
   where "outer_measure_of M A = (INF B \<in> {B\<in>sets M. A \<subseteq> B}. emeasure M B)"
 
 lemma outer_measure_of_eq[simp]: "A \<in> sets M \<Longrightarrow> outer_measure_of M A = emeasure M A"
   by (auto simp: outer_measure_of_def intro!: INF_eqI emeasure_mono)
 
 lemma outer_measure_of_mono: "A \<subseteq> B \<Longrightarrow> outer_measure_of M A \<le> outer_measure_of M B"
   unfolding outer_measure_of_def by (intro INF_superset_mono) auto
 
 lemma outer_measure_of_attain:
   assumes "A \<subseteq> space M"
   shows "\<exists>E\<in>sets M. A \<subseteq> E \<and> outer_measure_of M A = emeasure M E"
 proof -
   have "emeasure M ` {B \<in> sets M. A \<subseteq> B} \<noteq> {}"
     using \<open>A \<subseteq> space M\<close> by auto
   from ennreal_Inf_countable_INF[OF this]
   obtain f
     where f: "range f \<subseteq> emeasure M ` {B \<in> sets M. A \<subseteq> B}" "decseq f"
       and "outer_measure_of M A = (INF i. f i)"
     unfolding outer_measure_of_def by auto
   have "\<exists>E. \<forall>n. (E n \<in> sets M \<and> A \<subseteq> E n \<and> emeasure M (E n) \<le> f n) \<and> E (Suc n) \<subseteq> E n"
   proof (rule dependent_nat_choice)
     show "\<exists>x. x \<in> sets M \<and> A \<subseteq> x \<and> emeasure M x \<le> f 0"
       using f(1) by (fastforce simp: image_subset_iff image_iff intro: eq_refl[OF sym])
   next
     fix E n assume "E \<in> sets M \<and> A \<subseteq> E \<and> emeasure M E \<le> f n"
     moreover obtain F where "F \<in> sets M" "A \<subseteq> F" "f (Suc n) = emeasure M F"
       using f(1) by (auto simp: image_subset_iff image_iff)
     ultimately show "\<exists>y. (y \<in> sets M \<and> A \<subseteq> y \<and> emeasure M y \<le> f (Suc n)) \<and> y \<subseteq> E"
       by (auto intro!: exI[of _ "F \<inter> E"] emeasure_mono)
   qed
   then obtain E
     where [simp]: "\<And>n. E n \<in> sets M"
       and "\<And>n. A \<subseteq> E n"
       and le_f: "\<And>n. emeasure M (E n) \<le> f n"
       and "decseq E"
     by (auto simp: decseq_Suc_iff)
   show ?thesis
   proof cases
     assume fin: "\<exists>i. emeasure M (E i) < \<infinity>"
     show ?thesis
     proof (intro bexI[of _ "\<Inter>i. E i"] conjI)
       show "A \<subseteq> (\<Inter>i. E i)" "(\<Inter>i. E i) \<in> sets M"
         using \<open>\<And>n. A \<subseteq> E n\<close> by auto
 
       have " (INF i. emeasure M (E i)) \<le> outer_measure_of M A"
         unfolding \<open>outer_measure_of M A = (INF n. f n)\<close>
         by (intro INF_superset_mono le_f) auto
       moreover have "outer_measure_of M A \<le> (INF i. outer_measure_of M (E i))"
         by (intro INF_greatest outer_measure_of_mono \<open>\<And>n. A \<subseteq> E n\<close>)
       ultimately have "outer_measure_of M A = (INF i. emeasure M (E i))"
         by auto
       also have "\<dots> = emeasure M (\<Inter>i. E i)"
         using fin by (intro INF_emeasure_decseq' \<open>decseq E\<close>) (auto simp: less_top)
       finally show "outer_measure_of M A = emeasure M (\<Inter>i. E i)" .
     qed
   next
     assume "\<nexists>i. emeasure M (E i) < \<infinity>"
     then have "f n = \<infinity>" for n
       using le_f by (auto simp: not_less top_unique)
     moreover have "\<exists>E\<in>sets M. A \<subseteq> E \<and> f 0 = emeasure M E"
       using f by auto
     ultimately show ?thesis
       unfolding \<open>outer_measure_of M A = (INF n. f n)\<close> by simp
   qed
 qed
 
 lemma SUP_outer_measure_of_incseq:
   assumes A: "\<And>n. A n \<subseteq> space M" and "incseq A"
   shows "(SUP n. outer_measure_of M (A n)) = outer_measure_of M (\<Union>i. A i)"
 proof (rule antisym)
   obtain E
     where E: "\<And>n. E n \<in> sets M" "\<And>n. A n \<subseteq> E n" "\<And>n. outer_measure_of M (A n) = emeasure M (E n)"
     using outer_measure_of_attain[OF A] by metis
 
   define F where "F n = (\<Inter>i\<in>{n ..}. E i)" for n
   with E have F: "incseq F" "\<And>n. F n \<in> sets M"
     by (auto simp: incseq_def)
   have "A n \<subseteq> F n" for n
     using incseqD[OF \<open>incseq A\<close>, of n] \<open>\<And>n. A n \<subseteq> E n\<close> by (auto simp: F_def)
 
   have eq: "outer_measure_of M (A n) = outer_measure_of M (F n)" for n
   proof (intro antisym)
     have "outer_measure_of M (F n) \<le> outer_measure_of M (E n)"
       by (intro outer_measure_of_mono) (auto simp add: F_def)
     with E show "outer_measure_of M (F n) \<le> outer_measure_of M (A n)"
       by auto
     show "outer_measure_of M (A n) \<le> outer_measure_of M (F n)"
       by (intro outer_measure_of_mono \<open>A n \<subseteq> F n\<close>)
   qed
 
   have "outer_measure_of M (\<Union>n. A n) \<le> outer_measure_of M (\<Union>n. F n)"
     using \<open>\<And>n. A n \<subseteq> F n\<close> by (intro outer_measure_of_mono) auto
   also have "\<dots> = (SUP n. emeasure M (F n))"
     using F by (simp add: SUP_emeasure_incseq subset_eq)
   finally show "outer_measure_of M (\<Union>n. A n) \<le> (SUP n. outer_measure_of M (A n))"
     by (simp add: eq F)
 qed (auto intro: SUP_least outer_measure_of_mono)
 
 definition\<^marker>\<open>tag important\<close> measurable_envelope :: "'a measure \<Rightarrow> 'a set \<Rightarrow> 'a set \<Rightarrow> bool"
   where "measurable_envelope M A E \<longleftrightarrow>
     (A \<subseteq> E \<and> E \<in> sets M \<and> (\<forall>F\<in>sets M. emeasure M (F \<inter> E) = outer_measure_of M (F \<inter> A)))"
 
 lemma measurable_envelopeD:
   assumes "measurable_envelope M A E"
   shows "A \<subseteq> E"
     and "E \<in> sets M"
     and "\<And>F. F \<in> sets M \<Longrightarrow> emeasure M (F \<inter> E) = outer_measure_of M (F \<inter> A)"
     and "A \<subseteq> space M"
   using assms sets.sets_into_space[of E] by (auto simp: measurable_envelope_def)
 
 lemma measurable_envelopeD1:
   assumes E: "measurable_envelope M A E" and F: "F \<in> sets M" "F \<subseteq> E - A"
   shows "emeasure M F = 0"
 proof -
   have "emeasure M F = emeasure M (F \<inter> E)"
     using F by (intro arg_cong2[where f=emeasure]) auto
   also have "\<dots> = outer_measure_of M (F \<inter> A)"
     using measurable_envelopeD[OF E] \<open>F \<in> sets M\<close> by (auto simp: measurable_envelope_def)
   also have "\<dots> = outer_measure_of M {}"
     using \<open>F \<subseteq> E - A\<close> by (intro arg_cong2[where f=outer_measure_of]) auto
   finally show "emeasure M F = 0"
     by simp
 qed
 
 lemma measurable_envelope_eq1:
   assumes "A \<subseteq> E" "E \<in> sets M"
   shows "measurable_envelope M A E \<longleftrightarrow> (\<forall>F\<in>sets M. F \<subseteq> E - A \<longrightarrow> emeasure M F = 0)"
 proof safe
   assume *: "\<forall>F\<in>sets M. F \<subseteq> E - A \<longrightarrow> emeasure M F = 0"
   show "measurable_envelope M A E"
     unfolding measurable_envelope_def
   proof (rule ccontr, auto simp add: \<open>E \<in> sets M\<close> \<open>A \<subseteq> E\<close>)
     fix F assume "F \<in> sets M" "emeasure M (F \<inter> E) \<noteq> outer_measure_of M (F \<inter> A)"
     then have "outer_measure_of M (F \<inter> A) < emeasure M (F \<inter> E)"
       using outer_measure_of_mono[of "F \<inter> A" "F \<inter> E" M] \<open>A \<subseteq> E\<close> \<open>E \<in> sets M\<close> by (auto simp: less_le)
     then obtain G where G: "G \<in> sets M" "F \<inter> A \<subseteq> G" and less: "emeasure M G < emeasure M (E \<inter> F)"
       unfolding outer_measure_of_def INF_less_iff by (auto simp: ac_simps)
     have le: "emeasure M (G \<inter> E \<inter> F) \<le> emeasure M G"
       using \<open>E \<in> sets M\<close> \<open>G \<in> sets M\<close> \<open>F \<in> sets M\<close> by (auto intro!: emeasure_mono)
 
     from G have "E \<inter> F - G \<in> sets M" "E \<inter> F - G \<subseteq> E - A"
       using \<open>F \<in> sets M\<close> \<open>E \<in> sets M\<close> by auto
     with * have "0 = emeasure M (E \<inter> F - G)"
       by auto
     also have "E \<inter> F - G = E \<inter> F - (G \<inter> E \<inter> F)"
       by auto
     also have "emeasure M (E \<inter> F - (G \<inter> E \<inter> F)) = emeasure M (E \<inter> F) - emeasure M (G \<inter> E \<inter> F)"
       using \<open>E \<in> sets M\<close> \<open>F \<in> sets M\<close> le less G by (intro emeasure_Diff) (auto simp: top_unique)
     also have "\<dots> > 0"
       using le less by (intro diff_gr0_ennreal) auto
     finally show False by auto
   qed
 qed (rule measurable_envelopeD1)
 
 lemma measurable_envelopeD2:
   assumes E: "measurable_envelope M A E" shows "emeasure M E = outer_measure_of M A"
 proof -
   from \<open>measurable_envelope M A E\<close> have "emeasure M (E \<inter> E) = outer_measure_of M (E \<inter> A)"
     by (auto simp: measurable_envelope_def)
   with measurable_envelopeD[OF E] show "emeasure M E = outer_measure_of M A"
     by (auto simp: Int_absorb1)
 qed
 
 lemma\<^marker>\<open>tag important\<close> measurable_envelope_eq2:
   assumes "A \<subseteq> E" "E \<in> sets M" "emeasure M E < \<infinity>"
   shows "measurable_envelope M A E \<longleftrightarrow> (emeasure M E = outer_measure_of M A)"
 proof safe
   assume *: "emeasure M E = outer_measure_of M A"
   show "measurable_envelope M A E"
     unfolding measurable_envelope_eq1[OF \<open>A \<subseteq> E\<close> \<open>E \<in> sets M\<close>]
   proof (intro conjI ballI impI assms)
     fix F assume F: "F \<in> sets M" "F \<subseteq> E - A"
     with \<open>E \<in> sets M\<close> have le: "emeasure M F \<le> emeasure M  E"
       by (intro emeasure_mono) auto
     from F \<open>A \<subseteq> E\<close> have "outer_measure_of M A \<le> outer_measure_of M (E - F)"
       by (intro outer_measure_of_mono) auto
     then have "emeasure M E - 0 \<le> emeasure M (E - F)"
       using * \<open>E \<in> sets M\<close> \<open>F \<in> sets M\<close> by simp
     also have "\<dots> = emeasure M E - emeasure M F"
       using \<open>E \<in> sets M\<close> \<open>emeasure M E < \<infinity>\<close> F le by (intro emeasure_Diff) (auto simp: top_unique)
     finally show "emeasure M F = 0"
       using ennreal_mono_minus_cancel[of "emeasure M E" 0 "emeasure M F"] le assms by auto
   qed
 qed (auto intro: measurable_envelopeD2)
 
 lemma measurable_envelopeI_countable:
   fixes A :: "nat \<Rightarrow> 'a set"
   assumes E: "\<And>n. measurable_envelope M (A n) (E n)"
   shows "measurable_envelope M (\<Union>n. A n) (\<Union>n. E n)"
 proof (subst measurable_envelope_eq1)
   show "(\<Union>n. A n) \<subseteq> (\<Union>n. E n)" "(\<Union>n. E n) \<in> sets M"
     using measurable_envelopeD(1,2)[OF E] by auto
   show "\<forall>F\<in>sets M. F \<subseteq> (\<Union>n. E n) - (\<Union>n. A n) \<longrightarrow> emeasure M F = 0"
   proof safe
     fix F assume F: "F \<in> sets M" "F \<subseteq> (\<Union>n. E n) - (\<Union>n. A n)"
     then have "F \<inter> E n \<in> sets M" "F \<inter> E n \<subseteq> E n - A n" "F \<subseteq> (\<Union>n. E n)" for n
       using measurable_envelopeD(1,2)[OF E] by auto
     then have "emeasure M (\<Union>n. F \<inter> E n) = 0"
       by (intro emeasure_UN_eq_0 measurable_envelopeD1[OF E]) auto
     then show "emeasure M F = 0"
       using \<open>F \<subseteq> (\<Union>n. E n)\<close> by (auto simp: Int_absorb2)
   qed
 qed
 
 lemma measurable_envelopeI_countable_cover:
   fixes A and C :: "nat \<Rightarrow> 'a set"
   assumes C: "A \<subseteq> (\<Union>n. C n)" "\<And>n. C n \<in> sets M" "\<And>n. emeasure M (C n) < \<infinity>"
   shows "\<exists>E\<subseteq>(\<Union>n. C n). measurable_envelope M A E"
 proof -
   have "A \<inter> C n \<subseteq> space M" for n
     using \<open>C n \<in> sets M\<close> by (auto dest: sets.sets_into_space)
   then have "\<forall>n. \<exists>E\<in>sets M. A \<inter> C n \<subseteq> E \<and> outer_measure_of M (A \<inter> C n) = emeasure M E"
     using outer_measure_of_attain[of "A \<inter> C n" M for n] by auto
   then obtain E
     where E: "\<And>n. E n \<in> sets M" "\<And>n. A \<inter> C n \<subseteq> E n"
       and eq: "\<And>n. outer_measure_of M (A \<inter> C n) = emeasure M (E n)"
     by metis
 
   have "outer_measure_of M (A \<inter> C n) \<le> outer_measure_of M (E n \<inter> C n)" for n
     using E by (intro outer_measure_of_mono) auto
   moreover have "outer_measure_of M (E n \<inter> C n) \<le> outer_measure_of M (E n)" for n
     by (intro outer_measure_of_mono) auto
   ultimately have eq: "outer_measure_of M (A \<inter> C n) = emeasure M (E n \<inter> C n)" for n
     using E C by (intro antisym) (auto simp: eq)
 
   { fix n
     have "outer_measure_of M (A \<inter> C n) \<le> outer_measure_of M (C n)"
       by (intro outer_measure_of_mono) simp
     also have "\<dots> < \<infinity>"
       using assms by auto
     finally have "emeasure M (E n \<inter> C n) < \<infinity>"
       using eq by simp }
   then have "measurable_envelope M (\<Union>n. A \<inter> C n) (\<Union>n. E n \<inter> C n)"
     using E C by (intro measurable_envelopeI_countable measurable_envelope_eq2[THEN iffD2]) (auto simp: eq)
   with \<open>A \<subseteq> (\<Union>n. C n)\<close> show ?thesis
     by (intro exI[of _ "(\<Union>n. E n \<inter> C n)"]) (auto simp add: Int_absorb2)
 qed
 
 lemma (in complete_measure) complete_sets_sandwich:
   assumes [measurable]: "A \<in> sets M" "C \<in> sets M" and subset: "A \<subseteq> B" "B \<subseteq> C"
     and measure: "emeasure M A = emeasure M C" "emeasure M A < \<infinity>"
   shows "B \<in> sets M"
 proof -
   have "B - A \<in> sets M"
   proof (rule complete)
     show "B - A \<subseteq> C - A"
       using subset by auto
     show "C - A \<in> null_sets M"
       using measure subset by(simp add: emeasure_Diff null_setsI)
   qed
   then have "A \<union> (B - A) \<in> sets M"
     by measurable
   also have "A \<union> (B - A) = B"
     using \<open>A \<subseteq> B\<close> by auto
   finally show ?thesis .
 qed
 
 lemma (in complete_measure) complete_sets_sandwich_fmeasurable:
   assumes [measurable]: "A \<in> fmeasurable M" "C \<in> fmeasurable M" and subset: "A \<subseteq> B" "B \<subseteq> C"
     and measure: "measure M A = measure M C"
   shows "B \<in> fmeasurable M"
 proof (rule fmeasurableI2)
   show "B \<subseteq> C" "C \<in> fmeasurable M" by fact+
   show "B \<in> sets M"
   proof (rule complete_sets_sandwich)
     show "A \<in> sets M" "C \<in> sets M" "A \<subseteq> B" "B \<subseteq> C"
       using assms by auto
     show "emeasure M A < \<infinity>"
       using \<open>A \<in> fmeasurable M\<close> by (auto simp: fmeasurable_def)
     show "emeasure M A = emeasure M C"
       using assms by (simp add: emeasure_eq_measure2)
   qed
 qed
 
 lemma AE_completion_iff: "(AE x in completion M. P x) \<longleftrightarrow> (AE x in M. P x)"
 proof
   assume "AE x in completion M. P x"
   then obtain N where "N \<in> null_sets (completion M)" and P: "{x\<in>space M. \<not> P x} \<subseteq> N"
     unfolding eventually_ae_filter by auto
   then obtain N' where N': "N' \<in> null_sets M" and "N \<subseteq> N'"
     unfolding null_sets_completion_iff2 by auto
   from P \<open>N \<subseteq> N'\<close> have "{x\<in>space M. \<not> P x} \<subseteq> N'"
     by auto
   with N' show "AE x in M. P x"
     unfolding eventually_ae_filter by auto
 qed (rule AE_completion)
 
 lemma null_part_null_sets: "S \<in> completion M \<Longrightarrow> null_part M S \<in> null_sets (completion M)"
   by (auto dest!: null_part intro: null_sets_completionI null_sets_completion_subset)
 
 lemma AE_notin_null_part: "S \<in> completion M \<Longrightarrow> (AE x in M. x \<notin> null_part M S)"
   by (auto dest!: null_part_null_sets AE_not_in simp: AE_completion_iff)
 
 lemma completion_upper:
   assumes A: "A \<in> sets (completion M)"
   shows "\<exists>A'\<in>sets M. A \<subseteq> A' \<and> emeasure (completion M) A = emeasure M A'"
 proof -
   from AE_notin_null_part[OF A] obtain N where N: "N \<in> null_sets M" "null_part M A \<subseteq> N"
     unfolding eventually_ae_filter using null_part_null_sets[OF A, THEN null_setsD2, THEN sets.sets_into_space] by auto
   show ?thesis
   proof (intro bexI conjI)
     show "A \<subseteq> main_part M A \<union> N"
       using \<open>null_part M A \<subseteq> N\<close> by (subst main_part_null_part_Un[symmetric, OF A]) auto
     show "emeasure (completion M) A = emeasure M (main_part M A \<union> N)"
       using A \<open>N \<in> null_sets M\<close> by (simp add: emeasure_Un_null_set)
   qed (use A N in auto)
 qed
 
 lemma AE_in_main_part:
   assumes A: "A \<in> completion M" shows "AE x in M. x \<in> main_part M A \<longleftrightarrow> x \<in> A"
   using AE_notin_null_part[OF A]
   by (subst (2) main_part_null_part_Un[symmetric, OF A]) auto
 
 lemma completion_density_eq:
   assumes ae: "AE x in M. 0 < f x" and [measurable]: "f \<in> M \<rightarrow>\<^sub>M borel"
   shows "completion (density M f) = density (completion M) f"
 proof (intro measure_eqI)
   have "N' \<in> sets M \<and> (AE x\<in>N' in M. f x = 0) \<longleftrightarrow> N' \<in> null_sets M" for N'
   proof safe
     assume N': "N' \<in> sets M" and ae_N': "AE x\<in>N' in M. f x = 0"
     from ae_N' ae have "AE x in M. x \<notin> N'"
       by eventually_elim auto
     then show "N' \<in> null_sets M"
       using N' by (simp add: AE_iff_null_sets)
   next
     assume N': "N' \<in> null_sets M" then show "N' \<in> sets M" "AE x\<in>N' in M. f x = 0"
       using ae AE_not_in[OF N'] by (auto simp: less_le)
   qed
   then show sets_eq: "sets (completion (density M f)) = sets (density (completion M) f)"
     by (simp add: sets_completion null_sets_density_iff)
 
   fix A assume A: \<open>A \<in> completion (density M f)\<close>
   moreover
   have "A \<in> completion M"
     using A unfolding sets_eq by simp
   moreover
   have "main_part (density M f) A \<in> M"
     using A main_part_sets[of A "density M f"] unfolding sets_density sets_eq by simp
   moreover have "AE x in M. x \<in> main_part (density M f) A \<longleftrightarrow> x \<in> A"
     using AE_in_main_part[OF \<open>A \<in> completion (density M f)\<close>] ae by (auto simp add: AE_density)
   ultimately show "emeasure (completion (density M f)) A = emeasure (density (completion M) f) A"
     by (auto simp add: emeasure_density measurable_completion nn_integral_completion intro!: nn_integral_cong_AE)
 qed
 
 lemma null_sets_subset: "B \<in> null_sets M \<Longrightarrow> A \<in> sets M \<Longrightarrow> A \<subseteq> B \<Longrightarrow> A \<in> null_sets M"
   using emeasure_mono[of A B M] by (simp add: null_sets_def)
 
 lemma (in complete_measure) complete2: "A \<subseteq> B \<Longrightarrow> B \<in> null_sets M \<Longrightarrow> A \<in> null_sets M"
   using complete[of A B] null_sets_subset[of B M A] by simp
 
 lemma (in complete_measure) AE_iff_null_sets: "(AE x in M. P x) \<longleftrightarrow> {x\<in>space M. \<not> P x} \<in> null_sets M"
   unfolding eventually_ae_filter by (auto intro: complete2)
 
 lemma (in complete_measure) null_sets_iff_AE: "A \<in> null_sets M \<longleftrightarrow> ((AE x in M. x \<notin> A) \<and> A \<subseteq> space M)"
   unfolding AE_iff_null_sets by (auto cong: rev_conj_cong dest: sets.sets_into_space simp: subset_eq)
 
 lemma (in complete_measure) in_sets_AE:
   assumes ae: "AE x in M. x \<in> A \<longleftrightarrow> x \<in> B" and A: "A \<in> sets M" and B: "B \<subseteq> space M"
   shows "B \<in> sets M"
 proof -
   have "(AE x in M. x \<notin> B - A \<and> x \<notin> A - B)"
     using ae by eventually_elim auto
   then have "B - A \<in> null_sets M" "A - B \<in> null_sets M"
     using A B unfolding null_sets_iff_AE by (auto dest: sets.sets_into_space)
   then have "A \<union> (B - A) - (A - B) \<in> sets M"
     using A by blast
   also have "A \<union> (B - A) - (A - B) = B"
     by auto
   finally show "B \<in> sets M" .
 qed
 
 lemma (in complete_measure) vimage_null_part_null_sets:
   assumes f: "f \<in> M \<rightarrow>\<^sub>M N" and eq: "null_sets N \<subseteq> null_sets (distr M N f)"
     and A: "A \<in> completion N"
   shows "f -` null_part N A \<inter> space M \<in> null_sets M"
 proof -
   obtain N' where "N' \<in> null_sets N" "null_part N A \<subseteq> N'"
     using null_part[OF A] by auto
   then have N': "N' \<in> null_sets (distr M N f)"
     using eq by auto
   show ?thesis
   proof (rule complete2)
     show "f -` null_part N A \<inter> space M \<subseteq> f -` N' \<inter> space M"
       using \<open>null_part N A \<subseteq> N'\<close> by auto
     show "f -` N' \<inter> space M \<in> null_sets M"
       using f N' by (auto simp: null_sets_def emeasure_distr)
   qed
 qed
 
 lemma (in complete_measure) vimage_null_part_sets:
   "f \<in> M \<rightarrow>\<^sub>M N \<Longrightarrow> null_sets N \<subseteq> null_sets (distr M N f) \<Longrightarrow> A \<in> completion N \<Longrightarrow>
   f -` null_part N A \<inter> space M \<in> sets M"
   using vimage_null_part_null_sets[of f N A] by auto
 
 lemma (in complete_measure) measurable_completion2:
   assumes f: "f \<in> M \<rightarrow>\<^sub>M N" and null_sets: "null_sets N \<subseteq> null_sets (distr M N f)"
   shows "f \<in> M \<rightarrow>\<^sub>M completion N"
 proof (rule measurableI)
   show "x \<in> space M \<Longrightarrow> f x \<in> space (completion N)" for x
     using f[THEN measurable_space] by auto
   fix A assume A: "A \<in> sets (completion N)"
   have "f -` A \<inter> space M = (f -` main_part N A \<inter> space M) \<union> (f -` null_part N A \<inter> space M)"
     using main_part_null_part_Un[OF A] by auto
   then show "f -` A \<inter> space M \<in> sets M"
     using f A null_sets by (auto intro: vimage_null_part_sets measurable_sets)
 qed
 
 lemma (in complete_measure) completion_distr_eq:
   assumes X: "X \<in> M \<rightarrow>\<^sub>M N" and null_sets: "null_sets (distr M N X) = null_sets N"
   shows "completion (distr M N X) = distr M (completion N) X"
 proof (rule measure_eqI)
   show eq: "sets (completion (distr M N X)) = sets (distr M (completion N) X)"
     by (simp add: sets_completion null_sets)
 
   fix A assume A: "A \<in> completion (distr M N X)"
   moreover have A': "A \<in> completion N"
     using A by (simp add: eq)
   moreover have "main_part (distr M N X) A \<in> sets N"
     using main_part_sets[OF A] by simp
   moreover have "X -` A \<inter> space M = (X -` main_part (distr M N X) A \<inter> space M) \<union> (X -` null_part (distr M N X) A \<inter> space M)"
     using main_part_null_part_Un[OF A] by auto
   moreover have "X -` null_part (distr M N X) A \<inter> space M \<in> null_sets M"
     using X A by (intro vimage_null_part_null_sets) (auto cong: distr_cong)
   ultimately show "emeasure (completion (distr M N X)) A = emeasure (distr M (completion N) X) A"
     using X by (auto simp: emeasure_distr measurable_completion null_sets measurable_completion2
                      intro!: emeasure_Un_null_set[symmetric])
 qed
 
 lemma distr_completion: "X \<in> M \<rightarrow>\<^sub>M N \<Longrightarrow> distr (completion M) N X = distr M N X"
   by (intro measure_eqI) (auto simp: emeasure_distr measurable_completion)
 
 proposition (in complete_measure) fmeasurable_inner_outer:
   "S \<in> fmeasurable M \<longleftrightarrow>
     (\<forall>e>0. \<exists>T\<in>fmeasurable M. \<exists>U\<in>fmeasurable M. T \<subseteq> S \<and> S \<subseteq> U \<and> \<bar>measure M T - measure M U\<bar> < e)"
   (is "_ \<longleftrightarrow> ?approx")
 proof safe
   let ?\<mu> = "measure M" let ?D = "\<lambda>T U . \<bar>?\<mu> T - ?\<mu> U\<bar>"
   assume ?approx
   have "\<exists>A. \<forall>n. (fst (A n) \<in> fmeasurable M \<and> snd (A n) \<in> fmeasurable M \<and> fst (A n) \<subseteq> S \<and> S \<subseteq> snd (A n) \<and>
     ?D (fst (A n)) (snd (A n)) < 1/Suc n) \<and> (fst (A n) \<subseteq> fst (A (Suc n)) \<and> snd (A (Suc n)) \<subseteq> snd (A n))"
     (is "\<exists>A. \<forall>n. ?P n (A n) \<and> ?Q (A n) (A (Suc n))")
   proof (intro dependent_nat_choice)
     show "\<exists>A. ?P 0 A"
       using \<open>?approx\<close>[THEN spec, of 1] by auto
   next
     fix A n assume "?P n A"
     moreover
     from \<open>?approx\<close>[THEN spec, of "1/Suc (Suc n)"]
     obtain T U where *: "T \<in> fmeasurable M" "U \<in> fmeasurable M" "T \<subseteq> S" "S \<subseteq> U" "?D T U < 1 / Suc (Suc n)"
       by auto
     ultimately have "?\<mu> T \<le> ?\<mu> (T \<union> fst A)" "?\<mu> (U \<inter> snd A) \<le> ?\<mu> U"
       "?\<mu> T \<le> ?\<mu> U" "?\<mu> (T \<union> fst A) \<le> ?\<mu> (U \<inter> snd A)"
       by (auto intro!: measure_mono_fmeasurable)
     then have "?D (T \<union> fst A) (U \<inter> snd A) \<le> ?D T U"
       by auto
     also have "?D T U < 1/Suc (Suc n)" by fact
     finally show "\<exists>B. ?P (Suc n) B \<and> ?Q A B"
       using \<open>?P n A\<close> *
       by (intro exI[of _ "(T \<union> fst A, U \<inter> snd A)"] conjI) auto
   qed
   then obtain A
     where lm: "\<And>n. fst (A n) \<in> fmeasurable M" "\<And>n. snd (A n) \<in> fmeasurable M"
       and set_bound: "\<And>n. fst (A n) \<subseteq> S" "\<And>n. S \<subseteq> snd (A n)"
       and mono: "\<And>n. fst (A n) \<subseteq> fst (A (Suc n))" "\<And>n. snd (A (Suc n)) \<subseteq> snd (A n)"
       and bound: "\<And>n. ?D (fst (A n)) (snd (A n)) < 1/Suc n"
     by metis
 
   have INT_sA: "(\<Inter>n. snd (A n)) \<in> fmeasurable M"
     using lm by (intro fmeasurable_INT[of _ 0]) auto
   have UN_fA: "(\<Union>n. fst (A n)) \<in> fmeasurable M"
     using lm order_trans[OF set_bound(1) set_bound(2)[of 0]] by (intro fmeasurable_UN[of _ _ "snd (A 0)"]) auto
 
   have "(\<lambda>n. ?\<mu> (fst (A n)) - ?\<mu> (snd (A n))) \<longlonglongrightarrow> 0"
     using bound
     by (subst tendsto_rabs_zero_iff[symmetric])
        (intro tendsto_sandwich[OF _ _ tendsto_const LIMSEQ_inverse_real_of_nat];
         auto intro!: always_eventually less_imp_le simp: divide_inverse)
   moreover
   have "(\<lambda>n. ?\<mu> (fst (A n)) - ?\<mu> (snd (A n))) \<longlonglongrightarrow> ?\<mu> (\<Union>n. fst (A n)) - ?\<mu> (\<Inter>n. snd (A n))"
   proof (intro tendsto_diff Lim_measure_incseq Lim_measure_decseq)
     show "range (\<lambda>i. fst (A i)) \<subseteq> sets M" "range (\<lambda>i. snd (A i)) \<subseteq> sets M"
       "incseq (\<lambda>i. fst (A i))" "decseq (\<lambda>n. snd (A n))"
       using mono lm by (auto simp: incseq_Suc_iff decseq_Suc_iff intro!: measure_mono_fmeasurable)
     show "emeasure M (\<Union>x. fst (A x)) \<noteq> \<infinity>" "emeasure M (snd (A n)) \<noteq> \<infinity>" for n
       using lm(2)[of n] UN_fA by (auto simp: fmeasurable_def)
   qed
   ultimately have eq: "0 = ?\<mu> (\<Union>n. fst (A n)) - ?\<mu> (\<Inter>n. snd (A n))"
     by (rule LIMSEQ_unique)
 
   show "S \<in> fmeasurable M"
     using UN_fA INT_sA
   proof (rule complete_sets_sandwich_fmeasurable)
     show "(\<Union>n. fst (A n)) \<subseteq> S" "S \<subseteq> (\<Inter>n. snd (A n))"
       using set_bound by auto
     show "?\<mu> (\<Union>n. fst (A n)) = ?\<mu> (\<Inter>n. snd (A n))"
       using eq by auto
   qed
 qed (auto intro!: bexI[of _ S])
 
 lemma (in complete_measure) fmeasurable_measure_inner_outer:
    "(S \<in> fmeasurable M \<and> m = measure M S) \<longleftrightarrow>
       (\<forall>e>0. \<exists>T\<in>fmeasurable M. T \<subseteq> S \<and> m - e < measure M T) \<and>
       (\<forall>e>0. \<exists>U\<in>fmeasurable M. S \<subseteq> U \<and> measure M U < m + e)"
     (is "?lhs = ?rhs")
 proof
   assume RHS: ?rhs
   then have T: "\<And>e. 0 < e \<longrightarrow> (\<exists>T\<in>fmeasurable M. T \<subseteq> S \<and> m - e < measure M T)"
         and U: "\<And>e. 0 < e \<longrightarrow> (\<exists>U\<in>fmeasurable M. S \<subseteq> U \<and> measure M U < m + e)"
     by auto
   have "S \<in> fmeasurable M"
   proof (subst fmeasurable_inner_outer, safe)
     fix e::real assume "0 < e"
     with RHS obtain T U where T: "T \<in> fmeasurable M" "T \<subseteq> S" "m - e/2 < measure M T"
                           and U: "U \<in> fmeasurable M" "S \<subseteq> U" "measure M U < m + e/2"
       by (meson half_gt_zero)+
     moreover have "measure M U - measure M T < (m + e/2) - (m - e/2)"
       by (intro diff_strict_mono) fact+
     moreover have "measure M T \<le> measure M U"
       using T U by (intro measure_mono_fmeasurable) auto
     ultimately show "\<exists>T\<in>fmeasurable M. \<exists>U\<in>fmeasurable M. T \<subseteq> S \<and> S \<subseteq> U \<and> \<bar>measure M T - measure M U\<bar> < e"
       apply (rule_tac bexI[OF _ \<open>T \<in> fmeasurable M\<close>])
       apply (rule_tac bexI[OF _ \<open>U \<in> fmeasurable M\<close>])
       by auto
   qed
   moreover have "m = measure M S"
     using \<open>S \<in> fmeasurable M\<close> U[of "measure M S - m"] T[of "m - measure M S"]
     by (cases m "measure M S" rule: linorder_cases)
        (auto simp: not_le[symmetric] measure_mono_fmeasurable)
   ultimately show ?lhs
     by simp
 qed (auto intro!: bexI[of _ S])
 
 lemma (in complete_measure) null_sets_outer:
   "S \<in> null_sets M \<longleftrightarrow> (\<forall>e>0. \<exists>T\<in>fmeasurable M. S \<subseteq> T \<and> measure M T < e)"
 proof -
   have "S \<in> null_sets M \<longleftrightarrow> (S \<in> fmeasurable M \<and> 0 = measure M S)"
     by (auto simp: null_sets_def emeasure_eq_measure2 intro: fmeasurableI) (simp add: measure_def)
   also have "\<dots> = (\<forall>e>0. \<exists>T\<in>fmeasurable M. S \<subseteq> T \<and> measure M T < e)"
     unfolding fmeasurable_measure_inner_outer by auto
   finally show ?thesis .
 qed
 
 lemma (in complete_measure) fmeasurable_measure_inner_outer_le:
      "(S \<in> fmeasurable M \<and> m = measure M S) \<longleftrightarrow>
         (\<forall>e>0. \<exists>T\<in>fmeasurable M. T \<subseteq> S \<and> m - e \<le> measure M T) \<and>
         (\<forall>e>0. \<exists>U\<in>fmeasurable M. S \<subseteq> U \<and> measure M U \<le> m + e)" (is ?T1)
   and null_sets_outer_le:
      "S \<in> null_sets M \<longleftrightarrow> (\<forall>e>0. \<exists>T\<in>fmeasurable M. S \<subseteq> T \<and> measure M T \<le> e)" (is ?T2)
 proof -
   have "e > 0 \<and> m - e/2 \<le> t \<Longrightarrow> m - e < t"
        "e > 0 \<and> t \<le> m + e/2 \<Longrightarrow> t < m + e"
        "e > 0 \<longleftrightarrow> e/2 > 0"
        for e t
     by auto
   then show ?T1 ?T2
     unfolding fmeasurable_measure_inner_outer null_sets_outer
     by (meson dense le_less_trans less_imp_le)+
 qed
 
 lemma (in cld_measure) notin_sets_outer_measure_of_cover:
   assumes E: "E \<subseteq> space M" "E \<notin> sets M"
   shows "\<exists>B\<in>sets M. 0 < emeasure M B \<and> emeasure M B < \<infinity> \<and>
     outer_measure_of M (B \<inter> E) = emeasure M B \<and> outer_measure_of M (B - E) = emeasure M B"
 proof -
   from locally_determined[OF \<open>E \<subseteq> space M\<close>] \<open>E \<notin> sets M\<close>
   obtain F
     where [measurable]: "F \<in> sets M" and "emeasure M F < \<infinity>" "E \<inter> F \<notin> sets M"
     by blast
   then obtain H H'
     where H: "measurable_envelope M (F \<inter> E) H" and H': "measurable_envelope M (F - E) H'"
     using measurable_envelopeI_countable_cover[of "F \<inter> E" "\<lambda>_. F" M]
        measurable_envelopeI_countable_cover[of "F - E" "\<lambda>_. F" M]
     by auto
   note measurable_envelopeD(2)[OF H', measurable] measurable_envelopeD(2)[OF H, measurable]
 
   from measurable_envelopeD(1)[OF H'] measurable_envelopeD(1)[OF H]
   have subset: "F - H' \<subseteq> F \<inter> E" "F \<inter> E \<subseteq> F \<inter> H"
     by auto
   moreover define G where "G = (F \<inter> H) - (F - H')"
   ultimately have G: "G = F \<inter> H \<inter> H'"
     by auto
   have "emeasure M (F \<inter> H) \<noteq> 0"
   proof
     assume "emeasure M (F \<inter> H) = 0"
     then have "F \<inter> H \<in> null_sets M"
       by auto
     with \<open>E \<inter> F \<notin> sets M\<close> show False
       using complete[OF \<open>F \<inter> E \<subseteq> F \<inter> H\<close>] by (auto simp: Int_commute)
   qed
   moreover
   have "emeasure M (F - H') \<noteq> emeasure M (F \<inter> H)"
   proof
     assume "emeasure M (F - H') = emeasure M (F \<inter> H)"
     with \<open>E \<inter> F \<notin> sets M\<close> emeasure_mono[of "F \<inter> H" F M] \<open>emeasure M F < \<infinity>\<close>
     have "F \<inter> E \<in> sets M"
       by (intro complete_sets_sandwich[OF _ _ subset]) auto
     with \<open>E \<inter> F \<notin> sets M\<close> show False
       by (simp add: Int_commute)
   qed
   moreover have "emeasure M (F - H') \<le> emeasure M (F \<inter> H)"
     using subset by (intro emeasure_mono) auto
   ultimately have "emeasure M G \<noteq> 0"
     unfolding G_def using subset
     by (subst emeasure_Diff) (auto simp: top_unique diff_eq_0_iff_ennreal)
   show ?thesis
   proof (intro bexI conjI)
     have "emeasure M G \<le> emeasure M F"
       unfolding G by (auto intro!: emeasure_mono)
     with \<open>emeasure M F < \<infinity>\<close> show "0 < emeasure M G" "emeasure M G < \<infinity>"
       using \<open>emeasure M G \<noteq> 0\<close> by (auto simp: zero_less_iff_neq_zero)
     show [measurable]: "G \<in> sets M"
       unfolding G by auto
 
     have "emeasure M G = outer_measure_of M (F \<inter> H' \<inter> (F \<inter> E))"
       using measurable_envelopeD(3)[OF H, of "F \<inter> H'"] unfolding G by (simp add: ac_simps)
     also have "\<dots> \<le> outer_measure_of M (G \<inter> E)"
       using measurable_envelopeD(1)[OF H] by (intro outer_measure_of_mono) (auto simp: G)
     finally show "outer_measure_of M (G \<inter> E) = emeasure M G"
       using outer_measure_of_mono[of "G \<inter> E" G M] by auto
 
     have "emeasure M G = outer_measure_of M (F \<inter> H \<inter> (F - E))"
       using measurable_envelopeD(3)[OF H', of "F \<inter> H"] unfolding G by (simp add: ac_simps)
     also have "\<dots> \<le> outer_measure_of M (G - E)"
       using measurable_envelopeD(1)[OF H'] by (intro outer_measure_of_mono) (auto simp: G)
     finally show "outer_measure_of M (G - E) = emeasure M G"
       using outer_measure_of_mono[of "G - E" G M] by auto
   qed
 qed
 
 text \<open>The following theorem is a specialization of D.H. Fremlin, Measure Theory vol 4I (413G). We
   only show one direction and do not use a inner regular family \<open>K\<close>.\<close>
 
 lemma (in cld_measure) borel_measurable_cld:
   fixes f :: "'a \<Rightarrow> real"
   assumes "\<And>A a b. A \<in> sets M \<Longrightarrow> 0 < emeasure M A \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow> a < b \<Longrightarrow>
       min (outer_measure_of M {x\<in>A. f x \<le> a}) (outer_measure_of M {x\<in>A. b \<le> f x}) < emeasure M A"
   shows "f \<in> M \<rightarrow>\<^sub>M borel"
 proof (rule ccontr)
   let ?E = "\<lambda>a. {x\<in>space M. f x \<le> a}" and ?F = "\<lambda>a. {x\<in>space M. a \<le> f x}"
 
   assume "f \<notin> M \<rightarrow>\<^sub>M borel"
   then obtain a where "?E a \<notin> sets M"
     unfolding borel_measurable_iff_le by blast
   from notin_sets_outer_measure_of_cover[OF _ this]
   obtain K
     where K: "K \<in> sets M" "0 < emeasure M K" "emeasure M K < \<infinity>"
       and eq1: "outer_measure_of M (K \<inter> ?E a) = emeasure M K"
       and eq2: "outer_measure_of M (K - ?E a) = emeasure M K"
     by auto
   then have me_K: "measurable_envelope M (K \<inter> ?E a) K"
     by (subst measurable_envelope_eq2) auto
 
   define b where "b n = a + inverse (real (Suc n))" for n
   have "(SUP n. outer_measure_of M (K \<inter> ?F (b n))) = outer_measure_of M (\<Union>n. K \<inter> ?F (b n))"
   proof (intro SUP_outer_measure_of_incseq)
     have "x \<le> y \<Longrightarrow> b y \<le> b x" for x y
       by (auto simp: b_def field_simps)
     then show "incseq (\<lambda>n. K \<inter> {x \<in> space M. b n \<le> f x})"
       by (auto simp: incseq_def intro: order_trans)
   qed auto
   also have "(\<Union>n. K \<inter> ?F (b n)) = K - ?E a"
   proof -
     have "b \<longlonglongrightarrow> a"
       unfolding b_def by (rule LIMSEQ_inverse_real_of_nat_add)
     then have "\<forall>n. \<not> b n \<le> f x \<Longrightarrow> f x \<le> a" for x
       by (rule LIMSEQ_le_const) (auto intro: less_imp_le simp: not_le)
     moreover have "\<not> b n \<le> a" for n
       by (auto simp: b_def)
     ultimately show ?thesis
       using \<open>K \<in> sets M\<close>[THEN sets.sets_into_space] by (auto simp: subset_eq intro: order_trans)
   qed
   finally have "0 < (SUP n. outer_measure_of M (K \<inter> ?F (b n)))"
     using K by (simp add: eq2)
   then obtain n where pos_b: "0 < outer_measure_of M (K \<inter> ?F (b n))" and "a < b n"
     unfolding less_SUP_iff by (auto simp: b_def)
   from measurable_envelopeI_countable_cover[of "K \<inter> ?F (b n)" "\<lambda>_. K" M] K
   obtain K' where "K' \<subseteq> K" and me_K': "measurable_envelope M (K \<inter> ?F (b n)) K'"
     by auto
   then have K'_le_K: "emeasure M K' \<le> emeasure M K"
     by (intro emeasure_mono K)
   have "K' \<in> sets M"
     using me_K' by (rule measurable_envelopeD)
 
   have "min (outer_measure_of M {x\<in>K'. f x \<le> a}) (outer_measure_of M {x\<in>K'. b n \<le> f x}) < emeasure M K'"
   proof (rule assms)
     show "0 < emeasure M K'" "emeasure M K' < \<infinity>"
       using measurable_envelopeD2[OF me_K'] pos_b K K'_le_K by auto
   qed fact+
   also have "{x\<in>K'. f x \<le> a} = K' \<inter> (K \<inter> ?E a)"
     using \<open>K' \<in> sets M\<close>[THEN sets.sets_into_space] \<open>K' \<subseteq> K\<close> by auto
   also have "{x\<in>K'. b n \<le> f x} = K' \<inter> (K \<inter> ?F (b n))"
     using \<open>K' \<in> sets M\<close>[THEN sets.sets_into_space] \<open>K' \<subseteq> K\<close> by auto
   finally have "min (emeasure M K) (emeasure M K') < emeasure M K'"
     unfolding
       measurable_envelopeD(3)[OF me_K \<open>K' \<in> sets M\<close>, symmetric]
       measurable_envelopeD(3)[OF me_K' \<open>K' \<in> sets M\<close>, symmetric]
     using \<open>K' \<subseteq> K\<close> by (simp add: Int_absorb1 Int_absorb2)
   with K'_le_K show False
     by (auto simp: min_def split: if_split_asm)
 qed
 
 end
diff --git a/src/HOL/Analysis/Finite_Product_Measure.thy b/src/HOL/Analysis/Finite_Product_Measure.thy
--- a/src/HOL/Analysis/Finite_Product_Measure.thy
+++ b/src/HOL/Analysis/Finite_Product_Measure.thy
@@ -1,1343 +1,1380 @@
 (*  Title:      HOL/Analysis/Finite_Product_Measure.thy
     Author:     Johannes Hölzl, TU München
 *)
 
 section \<open>Finite Product Measure\<close>
 
 theory Finite_Product_Measure
 imports Binary_Product_Measure Function_Topology
 begin
 
 lemma PiE_choice: "(\<exists>f\<in>Pi\<^sub>E I F. \<forall>i\<in>I. P i (f i)) \<longleftrightarrow> (\<forall>i\<in>I. \<exists>x\<in>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 case_prod_const: "(\<lambda>(i, j). c) = (\<lambda>_. c)"
   by auto
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More about Function restricted by \<^const>\<open>extensional\<close>\<close>
 
 definition
   "merge I J = (\<lambda>(x, y) i. if i \<in> I then x i else if i \<in> J then y i else undefined)"
 
 lemma merge_apply[simp]:
   "I \<inter> J = {} \<Longrightarrow> i \<in> I \<Longrightarrow> merge I J (x, y) i = x i"
   "I \<inter> J = {} \<Longrightarrow> i \<in> J \<Longrightarrow> merge I J (x, y) i = y i"
   "J \<inter> I = {} \<Longrightarrow> i \<in> I \<Longrightarrow> merge I J (x, y) i = x i"
   "J \<inter> I = {} \<Longrightarrow> i \<in> J \<Longrightarrow> merge I J (x, y) i = y i"
   "i \<notin> I \<Longrightarrow> i \<notin> J \<Longrightarrow> merge I J (x, y) i = undefined"
   unfolding merge_def by auto
 
 lemma merge_commute:
   "I \<inter> J = {} \<Longrightarrow> merge I J (x, y) = merge J I (y, x)"
   by (force simp: merge_def)
 
 lemma Pi_cancel_merge_range[simp]:
   "I \<inter> J = {} \<Longrightarrow> x \<in> Pi I (merge I J (A, B)) \<longleftrightarrow> x \<in> Pi I A"
   "I \<inter> J = {} \<Longrightarrow> x \<in> Pi I (merge J I (B, A)) \<longleftrightarrow> x \<in> Pi I A"
   "J \<inter> I = {} \<Longrightarrow> x \<in> Pi I (merge I J (A, B)) \<longleftrightarrow> x \<in> Pi I A"
   "J \<inter> I = {} \<Longrightarrow> x \<in> Pi I (merge J I (B, A)) \<longleftrightarrow> x \<in> Pi I A"
   by (auto simp: Pi_def)
 
 lemma Pi_cancel_merge[simp]:
   "I \<inter> J = {} \<Longrightarrow> merge I J (x, y) \<in> Pi I B \<longleftrightarrow> x \<in> Pi I B"
   "J \<inter> I = {} \<Longrightarrow> merge I J (x, y) \<in> Pi I B \<longleftrightarrow> x \<in> Pi I B"
   "I \<inter> J = {} \<Longrightarrow> merge I J (x, y) \<in> Pi J B \<longleftrightarrow> y \<in> Pi J B"
   "J \<inter> I = {} \<Longrightarrow> merge I J (x, y) \<in> Pi J B \<longleftrightarrow> y \<in> Pi J B"
   by (auto simp: Pi_def)
 
 lemma extensional_merge[simp]: "merge I J (x, y) \<in> extensional (I \<union> J)"
   by (auto simp: extensional_def)
 
 lemma restrict_merge[simp]:
   "I \<inter> J = {} \<Longrightarrow> restrict (merge I J (x, y)) I = restrict x I"
   "I \<inter> J = {} \<Longrightarrow> restrict (merge I J (x, y)) J = restrict y J"
   "J \<inter> I = {} \<Longrightarrow> restrict (merge I J (x, y)) I = restrict x I"
   "J \<inter> I = {} \<Longrightarrow> restrict (merge I J (x, y)) J = restrict y J"
   by (auto simp: restrict_def)
 
 lemma split_merge: "P (merge I J (x,y) i) \<longleftrightarrow> (i \<in> I \<longrightarrow> P (x i)) \<and> (i \<in> J - I \<longrightarrow> P (y i)) \<and> (i \<notin> I \<union> J \<longrightarrow> P undefined)"
   unfolding merge_def by auto
 
 lemma PiE_cancel_merge[simp]:
   "I \<inter> J = {} \<Longrightarrow>
     merge I J (x, y) \<in> Pi\<^sub>E (I \<union> J) B \<longleftrightarrow> x \<in> Pi I B \<and> y \<in> Pi J B"
   by (auto simp: PiE_def restrict_Pi_cancel)
 
 lemma merge_singleton[simp]: "i \<notin> I \<Longrightarrow> merge I {i} (x,y) = restrict (x(i := y i)) (insert i I)"
   unfolding merge_def by (auto simp: fun_eq_iff)
 
 lemma extensional_merge_sub: "I \<union> J \<subseteq> K \<Longrightarrow> merge I J (x, y) \<in> extensional K"
   unfolding merge_def extensional_def by auto
 
 lemma merge_restrict[simp]:
   "merge I J (restrict x I, y) = merge I J (x, y)"
   "merge I J (x, restrict y J) = merge I J (x, y)"
   unfolding merge_def by auto
 
 lemma merge_x_x_eq_restrict[simp]:
   "merge I J (x, x) = restrict x (I \<union> J)"
   unfolding merge_def by auto
 
 lemma injective_vimage_restrict:
   assumes J: "J \<subseteq> I"
   and sets: "A \<subseteq> (\<Pi>\<^sub>E i\<in>J. S i)" "B \<subseteq> (\<Pi>\<^sub>E i\<in>J. S i)" and ne: "(\<Pi>\<^sub>E i\<in>I. S i) \<noteq> {}"
   and eq: "(\<lambda>x. restrict x J) -` A \<inter> (\<Pi>\<^sub>E i\<in>I. S i) = (\<lambda>x. restrict x J) -` B \<inter> (\<Pi>\<^sub>E i\<in>I. S i)"
   shows "A = B"
 proof  (intro set_eqI)
   fix x
   from ne obtain y where y: "\<And>i. i \<in> I \<Longrightarrow> y i \<in> S i" by auto
   have "J \<inter> (I - J) = {}" by auto
   show "x \<in> A \<longleftrightarrow> x \<in> B"
   proof cases
     assume x: "x \<in> (\<Pi>\<^sub>E i\<in>J. S i)"
     have "x \<in> A \<longleftrightarrow> merge J (I - J) (x,y) \<in> (\<lambda>x. restrict x J) -` A \<inter> (\<Pi>\<^sub>E i\<in>I. S i)"
       using y x \<open>J \<subseteq> I\<close> PiE_cancel_merge[of "J" "I - J" x y S]
       by (auto simp del: PiE_cancel_merge simp add: Un_absorb1)
     then show "x \<in> A \<longleftrightarrow> x \<in> B"
       using y x \<open>J \<subseteq> I\<close> 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
 
 lemma restrict_vimage:
   "I \<inter> J = {} \<Longrightarrow>
     (\<lambda>x. (restrict x I, restrict x J)) -` (Pi\<^sub>E I E \<times> Pi\<^sub>E J F) = Pi (I \<union> J) (merge I J (E, F))"
   by (auto simp: restrict_Pi_cancel PiE_def)
 
 lemma merge_vimage:
   "I \<inter> J = {} \<Longrightarrow> merge I J -` Pi\<^sub>E (I \<union> J) E = Pi I E \<times> Pi J E"
   by (auto simp: restrict_Pi_cancel PiE_def)
 
 subsection \<open>Finite product spaces\<close>
 
 definition\<^marker>\<open>tag important\<close> prod_emb where
   "prod_emb I M K X = (\<lambda>x. restrict x K) -` X \<inter> (\<Pi>\<^sub>E i\<in>I. space (M i))"
 
 lemma prod_emb_iff:
   "f \<in> prod_emb I M K X \<longleftrightarrow> f \<in> extensional I \<and> (restrict f K \<in> X) \<and> (\<forall>i\<in>I. f i \<in> space (M i))"
   unfolding prod_emb_def PiE_def by auto
 
 lemma
   shows prod_emb_empty[simp]: "prod_emb M L K {} = {}"
     and prod_emb_Un[simp]: "prod_emb M L K (A \<union> B) = prod_emb M L K A \<union> prod_emb M L K B"
     and prod_emb_Int: "prod_emb M L K (A \<inter> B) = prod_emb M L K A \<inter> prod_emb M L K B"
     and prod_emb_UN[simp]: "prod_emb M L K (\<Union>i\<in>I. F i) = (\<Union>i\<in>I. prod_emb M L K (F i))"
     and prod_emb_INT[simp]: "I \<noteq> {} \<Longrightarrow> prod_emb M L K (\<Inter>i\<in>I. F i) = (\<Inter>i\<in>I. prod_emb M L K (F i))"
     and prod_emb_Diff[simp]: "prod_emb M L K (A - B) = prod_emb M L K A - prod_emb M L K B"
   by (auto simp: prod_emb_def)
 
 lemma prod_emb_PiE: "J \<subseteq> I \<Longrightarrow> (\<And>i. i \<in> J \<Longrightarrow> E i \<subseteq> space (M i)) \<Longrightarrow>
     prod_emb I M J (\<Pi>\<^sub>E i\<in>J. E i) = (\<Pi>\<^sub>E i\<in>I. if i \<in> J then E i else space (M i))"
   by (force simp: prod_emb_def PiE_iff if_split_mem2)
 
 lemma prod_emb_PiE_same_index[simp]:
     "(\<And>i. i \<in> I \<Longrightarrow> E i \<subseteq> space (M i)) \<Longrightarrow> prod_emb I M I (Pi\<^sub>E I E) = Pi\<^sub>E I E"
   by (auto simp: prod_emb_def PiE_iff)
 
 lemma prod_emb_trans[simp]:
   "J \<subseteq> K \<Longrightarrow> K \<subseteq> L \<Longrightarrow> prod_emb L M K (prod_emb K M J X) = prod_emb L M J X"
   by (auto simp add: Int_absorb1 prod_emb_def PiE_def)
 
 lemma prod_emb_Pi:
   assumes "X \<in> (\<Pi> j\<in>J. sets (M j))" "J \<subseteq> K"
   shows "prod_emb K M J (Pi\<^sub>E J X) = (\<Pi>\<^sub>E i\<in>K. if i \<in> J then X i else space (M i))"
   using assms sets.space_closed
   by (auto simp: prod_emb_def PiE_iff split: if_split_asm) blast+
 
 lemma prod_emb_id:
   "B \<subseteq> (\<Pi>\<^sub>E i\<in>L. space (M i)) \<Longrightarrow> prod_emb L M L B = B"
   by (auto simp: prod_emb_def subset_eq extensional_restrict)
 
 lemma prod_emb_mono:
   "F \<subseteq> G \<Longrightarrow> prod_emb A M B F \<subseteq> prod_emb A M B G"
   by (auto simp: prod_emb_def)
 
 definition\<^marker>\<open>tag important\<close> PiM :: "'i set \<Rightarrow> ('i \<Rightarrow> 'a measure) \<Rightarrow> ('i \<Rightarrow> 'a) measure" where
   "PiM I M = extend_measure (\<Pi>\<^sub>E i\<in>I. space (M i))
     {(J, X). (J \<noteq> {} \<or> I = {}) \<and> finite J \<and> J \<subseteq> I \<and> X \<in> (\<Pi> j\<in>J. sets (M j))}
     (\<lambda>(J, X). prod_emb I M J (\<Pi>\<^sub>E j\<in>J. X j))
     (\<lambda>(J, X). \<Prod>j\<in>J \<union> {i\<in>I. emeasure (M i) (space (M i)) \<noteq> 1}. if j \<in> J then emeasure (M j) (X j) else emeasure (M j) (space (M j)))"
 
 definition\<^marker>\<open>tag important\<close> prod_algebra :: "'i set \<Rightarrow> ('i \<Rightarrow> 'a measure) \<Rightarrow> ('i \<Rightarrow> 'a) set set" where
   "prod_algebra I M = (\<lambda>(J, X). prod_emb I M J (\<Pi>\<^sub>E j\<in>J. X j)) `
     {(J, X). (J \<noteq> {} \<or> I = {}) \<and> finite J \<and> J \<subseteq> I \<and> X \<in> (\<Pi> j\<in>J. sets (M j))}"
 
 abbreviation
   "Pi\<^sub>M I M \<equiv> PiM I M"
 
 syntax
   "_PiM" :: "pttrn \<Rightarrow> 'i set \<Rightarrow> 'a measure \<Rightarrow> ('i => 'a) measure"  ("(3\<Pi>\<^sub>M _\<in>_./ _)"  10)
 translations
   "\<Pi>\<^sub>M x\<in>I. M" == "CONST PiM I (%x. M)"
 
 lemma extend_measure_cong:
   assumes "\<Omega> = \<Omega>'" "I = I'" "G = G'" "\<And>i. i \<in> I' \<Longrightarrow> \<mu> i = \<mu>' i"
   shows "extend_measure \<Omega> I G \<mu> = extend_measure \<Omega>' I' G' \<mu>'"
   unfolding extend_measure_def by (auto simp add: assms)
 
 lemma Pi_cong_sets:
     "\<lbrakk>I = J; \<And>x. x \<in> I \<Longrightarrow> M x = N x\<rbrakk> \<Longrightarrow> Pi I M = Pi J N"
   unfolding Pi_def by auto
 
 lemma PiM_cong:
   assumes "I = J" "\<And>x. x \<in> I \<Longrightarrow> M x = N x"
   shows "PiM I M = PiM J N"
   unfolding PiM_def
 proof (rule extend_measure_cong, goal_cases)
   case 1
   show ?case using assms
     by (subst assms(1), intro PiE_cong[of J "\<lambda>i. space (M i)" "\<lambda>i. space (N i)"]) simp_all
 next
   case 2
   have "\<And>K. K \<subseteq> J \<Longrightarrow> (\<Pi> j\<in>K. sets (M j)) = (\<Pi> j\<in>K. sets (N j))"
     using assms by (intro Pi_cong_sets) auto
   thus ?case by (auto simp: assms)
 next
   case 3
   show ?case using assms
     by (intro ext) (auto simp: prod_emb_def dest: PiE_mem)
 next
   case (4 x)
   thus ?case using assms
     by (auto intro!: prod.cong split: if_split_asm)
 qed
 
 
 lemma prod_algebra_sets_into_space:
   "prod_algebra I M \<subseteq> Pow (\<Pi>\<^sub>E i\<in>I. space (M i))"
   by (auto simp: prod_emb_def prod_algebra_def)
 
 lemma prod_algebra_eq_finite:
   assumes I: "finite I"
   shows "prod_algebra I M = {(\<Pi>\<^sub>E i\<in>I. X i) |X. X \<in> (\<Pi> j\<in>I. sets (M j))}" (is "?L = ?R")
 proof (intro iffI set_eqI)
   fix A assume "A \<in> ?L"
   then obtain J E where J: "J \<noteq> {} \<or> I = {}" "finite J" "J \<subseteq> I" "\<forall>i\<in>J. E i \<in> sets (M i)"
     and A: "A = prod_emb I M J (\<Pi>\<^sub>E j\<in>J. E j)"
     by (auto simp: prod_algebra_def)
   let ?A = "\<Pi>\<^sub>E i\<in>I. if i \<in> J then E i else space (M i)"
   have A: "A = ?A"
     unfolding A using J by (intro prod_emb_PiE sets.sets_into_space) auto
   show "A \<in> ?R" unfolding A using J sets.top
     by (intro CollectI exI[of _ "\<lambda>i. if i \<in> J then E i else space (M i)"]) simp
 next
   fix A assume "A \<in> ?R"
   then obtain X where A: "A = (\<Pi>\<^sub>E i\<in>I. X i)" and X: "X \<in> (\<Pi> j\<in>I. sets (M j))" by auto
   then have A: "A = prod_emb I M I (\<Pi>\<^sub>E i\<in>I. X i)"
     by (simp add: prod_emb_PiE_same_index[OF sets.sets_into_space] Pi_iff)
   from X I show "A \<in> ?L" unfolding A
     by (auto simp: prod_algebra_def)
 qed
 
 lemma prod_algebraI:
   "finite J \<Longrightarrow> (J \<noteq> {} \<or> I = {}) \<Longrightarrow> J \<subseteq> I \<Longrightarrow> (\<And>i. i \<in> J \<Longrightarrow> E i \<in> sets (M i))
     \<Longrightarrow> prod_emb I M J (\<Pi>\<^sub>E j\<in>J. E j) \<in> prod_algebra I M"
   by (auto simp: prod_algebra_def)
 
 lemma prod_algebraI_finite:
   "finite I \<Longrightarrow> (\<forall>i\<in>I. E i \<in> sets (M i)) \<Longrightarrow> (Pi\<^sub>E I E) \<in> prod_algebra I M"
   using prod_algebraI[of I I E M] prod_emb_PiE_same_index[of I E M, OF sets.sets_into_space] by simp
 
 lemma Int_stable_PiE: "Int_stable {Pi\<^sub>E J E | E. \<forall>i\<in>I. E i \<in> sets (M i)}"
 proof (safe intro!: Int_stableI)
   fix E F assume "\<forall>i\<in>I. E i \<in> sets (M i)" "\<forall>i\<in>I. F i \<in> sets (M i)"
   then show "\<exists>G. Pi\<^sub>E J E \<inter> Pi\<^sub>E J F = Pi\<^sub>E J G \<and> (\<forall>i\<in>I. G i \<in> sets (M i))"
     by (auto intro!: exI[of _ "\<lambda>i. E i \<inter> F i"] simp: PiE_Int)
 qed
 
 lemma prod_algebraE:
   assumes A: "A \<in> prod_algebra I M"
   obtains J E where "A = prod_emb I M J (\<Pi>\<^sub>E j\<in>J. E j)"
     "finite J" "J \<noteq> {} \<or> I = {}" "J \<subseteq> I" "\<And>i. i \<in> J \<Longrightarrow> E i \<in> sets (M i)"
   using A by (auto simp: prod_algebra_def)
 
 lemma prod_algebraE_all:
   assumes A: "A \<in> prod_algebra I M"
   obtains E where "A = Pi\<^sub>E I E" "E \<in> (\<Pi> i\<in>I. sets (M i))"
 proof -
   from A obtain E J where A: "A = prod_emb I M J (Pi\<^sub>E J E)"
     and J: "J \<subseteq> I" and E: "E \<in> (\<Pi> i\<in>J. sets (M i))"
     by (auto simp: prod_algebra_def)
   from E have "\<And>i. i \<in> J \<Longrightarrow> E i \<subseteq> space (M i)"
     using sets.sets_into_space by auto
   then have "A = (\<Pi>\<^sub>E i\<in>I. if i\<in>J then E i else space (M i))"
     using A J by (auto simp: prod_emb_PiE)
   moreover have "(\<lambda>i. if i\<in>J then E i else space (M i)) \<in> (\<Pi> i\<in>I. sets (M i))"
     using sets.top E by auto
   ultimately show ?thesis using that by auto
 qed
 
 lemma Int_stable_prod_algebra: "Int_stable (prod_algebra I M)"
-proof (unfold Int_stable_def, safe)
+  unfolding Int_stable_def
+proof safe
   fix A assume "A \<in> prod_algebra I M"
-  from prod_algebraE[OF this] guess J E . note A = this
+  from prod_algebraE[OF this] obtain J E where A:
+    "A = prod_emb I M J (Pi\<^sub>E J E)"
+    "finite J"
+    "J \<noteq> {} \<or> I = {}"
+    "J \<subseteq> I"
+    "\<And>i. i \<in> J \<Longrightarrow> E i \<in> sets (M i)"
+    by auto
   fix B assume "B \<in> prod_algebra I M"
-  from prod_algebraE[OF this] guess K F . note B = this
+  from prod_algebraE[OF this] obtain K F where B:
+    "B = prod_emb I M K (Pi\<^sub>E K F)"
+    "finite K"
+    "K \<noteq> {} \<or> I = {}"
+    "K \<subseteq> I"
+    "\<And>i. i \<in> K \<Longrightarrow> F i \<in> sets (M i)"
+    by auto
   have "A \<inter> B = prod_emb I M (J \<union> K) (\<Pi>\<^sub>E i\<in>J \<union> K. (if i \<in> J then E i else space (M i)) \<inter>
       (if i \<in> K then F i else space (M i)))"
     unfolding A B using A(2,3,4) A(5)[THEN sets.sets_into_space] B(2,3,4)
       B(5)[THEN sets.sets_into_space]
     apply (subst (1 2 3) prod_emb_PiE)
     apply (simp_all add: subset_eq PiE_Int)
     apply blast
     apply (intro PiE_cong)
     apply auto
     done
   also have "\<dots> \<in> prod_algebra I M"
     using A B by (auto intro!: prod_algebraI)
   finally show "A \<inter> B \<in> prod_algebra I M" .
 qed
 
 proposition prod_algebra_mono:
   assumes space: "\<And>i. i \<in> I \<Longrightarrow> space (E i) = space (F i)"
   assumes sets: "\<And>i. i \<in> I \<Longrightarrow> sets (E i) \<subseteq> sets (F i)"
   shows "prod_algebra I E \<subseteq> prod_algebra I F"
 proof
   fix A assume "A \<in> prod_algebra I E"
   then obtain J G where J: "J \<noteq> {} \<or> I = {}" "finite J" "J \<subseteq> I"
     and A: "A = prod_emb I E J (\<Pi>\<^sub>E i\<in>J. G i)"
     and G: "\<And>i. i \<in> J \<Longrightarrow> G i \<in> sets (E i)"
     by (auto simp: prod_algebra_def)
   moreover
   from space have "(\<Pi>\<^sub>E i\<in>I. space (E i)) = (\<Pi>\<^sub>E i\<in>I. space (F i))"
     by (rule PiE_cong)
   with A have "A = prod_emb I F J (\<Pi>\<^sub>E i\<in>J. G i)"
     by (simp add: prod_emb_def)
   moreover
   from sets G J have "\<And>i. i \<in> J \<Longrightarrow> G i \<in> sets (F i)"
     by auto
   ultimately show "A \<in> prod_algebra I F"
     apply (simp add: prod_algebra_def image_iff)
     apply (intro exI[of _ J] exI[of _ G] conjI)
     apply auto
     done
 qed
 proposition prod_algebra_cong:
   assumes "I = J" and sets: "(\<And>i. i \<in> I \<Longrightarrow> sets (M i) = sets (N i))"
   shows "prod_algebra I M = prod_algebra J N"
 proof -
   have space: "\<And>i. i \<in> I \<Longrightarrow> space (M i) = space (N i)"
     using sets_eq_imp_space_eq[OF sets] by auto
   with sets show ?thesis unfolding \<open>I = J\<close>
     by (intro antisym prod_algebra_mono) auto
 qed
 
 lemma space_in_prod_algebra:
   "(\<Pi>\<^sub>E i\<in>I. space (M i)) \<in> prod_algebra I M"
 proof cases
   assume "I = {}" then show ?thesis
     by (auto simp add: prod_algebra_def image_iff prod_emb_def)
 next
   assume "I \<noteq> {}"
   then obtain i where "i \<in> I" by auto
   then have "(\<Pi>\<^sub>E i\<in>I. space (M i)) = prod_emb I M {i} (\<Pi>\<^sub>E i\<in>{i}. space (M i))"
     by (auto simp: prod_emb_def)
   also have "\<dots> \<in> prod_algebra I M"
     using \<open>i \<in> I\<close> by (intro prod_algebraI) auto
   finally show ?thesis .
 qed
 
 lemma space_PiM: "space (\<Pi>\<^sub>M i\<in>I. M i) = (\<Pi>\<^sub>E i\<in>I. space (M i))"
   using prod_algebra_sets_into_space unfolding PiM_def prod_algebra_def by (intro space_extend_measure) simp
 
 lemma prod_emb_subset_PiM[simp]: "prod_emb I M K X \<subseteq> space (PiM I M)"
   by (auto simp: prod_emb_def space_PiM)
 
 lemma space_PiM_empty_iff[simp]: "space (PiM I M) = {} \<longleftrightarrow>  (\<exists>i\<in>I. space (M i) = {})"
   by (auto simp: space_PiM PiE_eq_empty_iff)
 
 lemma undefined_in_PiM_empty[simp]: "(\<lambda>x. undefined) \<in> space (PiM {} M)"
   by (auto simp: space_PiM)
 
 lemma sets_PiM: "sets (\<Pi>\<^sub>M i\<in>I. M i) = sigma_sets (\<Pi>\<^sub>E i\<in>I. space (M i)) (prod_algebra I M)"
   using prod_algebra_sets_into_space unfolding PiM_def prod_algebra_def by (intro sets_extend_measure) simp
 
 proposition sets_PiM_single: "sets (PiM I M) =
     sigma_sets (\<Pi>\<^sub>E i\<in>I. space (M i)) {{f\<in>\<Pi>\<^sub>E i\<in>I. space (M i). f i \<in> A} | i A. i \<in> I \<and> A \<in> sets (M i)}"
     (is "_ = sigma_sets ?\<Omega> ?R")
   unfolding sets_PiM
 proof (rule sigma_sets_eqI)
   interpret R: sigma_algebra ?\<Omega> "sigma_sets ?\<Omega> ?R" by (rule sigma_algebra_sigma_sets) auto
   fix A assume "A \<in> prod_algebra I M"
-  from prod_algebraE[OF this] guess J X . note X = this
+  from prod_algebraE[OF this] obtain J X where X:
+    "A = prod_emb I M J (Pi\<^sub>E J X)"
+    "finite J"
+    "J \<noteq> {} \<or> I = {}"
+    "J \<subseteq> I"
+    "\<And>i. i \<in> J \<Longrightarrow> X i \<in> sets (M i)"
+    by auto
   show "A \<in> sigma_sets ?\<Omega> ?R"
   proof cases
     assume "I = {}"
     with X have "A = {\<lambda>x. undefined}" by (auto simp: prod_emb_def)
     with \<open>I = {}\<close> show ?thesis by (auto intro!: sigma_sets_top)
   next
     assume "I \<noteq> {}"
     with X have "A = (\<Inter>j\<in>J. {f\<in>(\<Pi>\<^sub>E i\<in>I. space (M i)). f j \<in> X j})"
       by (auto simp: prod_emb_def)
     also have "\<dots> \<in> sigma_sets ?\<Omega> ?R"
       using X \<open>I \<noteq> {}\<close> by (intro R.finite_INT sigma_sets.Basic) auto
     finally show "A \<in> sigma_sets ?\<Omega> ?R" .
   qed
 next
   fix A assume "A \<in> ?R"
   then obtain i B where A: "A = {f\<in>\<Pi>\<^sub>E i\<in>I. space (M i). f i \<in> B}" "i \<in> I" "B \<in> sets (M i)"
     by auto
   then have "A = prod_emb I M {i} (\<Pi>\<^sub>E i\<in>{i}. B)"
      by (auto simp: prod_emb_def)
   also have "\<dots> \<in> sigma_sets ?\<Omega> (prod_algebra I M)"
     using A by (intro sigma_sets.Basic prod_algebraI) auto
   finally show "A \<in> sigma_sets ?\<Omega> (prod_algebra I M)" .
 qed
 
 lemma sets_PiM_eq_proj:
   "I \<noteq> {} \<Longrightarrow> sets (PiM I M) = sets (SUP i\<in>I. vimage_algebra (\<Pi>\<^sub>E i\<in>I. space (M i)) (\<lambda>x. x i) (M i))"
   apply (simp add: sets_PiM_single)
   apply (subst sets_Sup_eq[where X="\<Pi>\<^sub>E i\<in>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
 
 lemma
   shows space_PiM_empty: "space (Pi\<^sub>M {} M) = {\<lambda>k. undefined}"
     and sets_PiM_empty: "sets (Pi\<^sub>M {} M) = { {}, {\<lambda>k. undefined} }"
   by (simp_all add: space_PiM sets_PiM_single image_constant sigma_sets_empty_eq)
 
 proposition sets_PiM_sigma:
   assumes \<Omega>_cover: "\<And>i. i \<in> I \<Longrightarrow> \<exists>S\<subseteq>E i. countable S \<and> \<Omega> i = \<Union>S"
   assumes E: "\<And>i. i \<in> I \<Longrightarrow> E i \<subseteq> Pow (\<Omega> i)"
   assumes J: "\<And>j. j \<in> J \<Longrightarrow> finite j" "\<Union>J = I"
   defines "P \<equiv> {{f\<in>(\<Pi>\<^sub>E i\<in>I. \<Omega> i). \<forall>i\<in>j. f i \<in> A i} | A j. j \<in> J \<and> A \<in> Pi j E}"
   shows "sets (\<Pi>\<^sub>M i\<in>I. sigma (\<Omega> i) (E i)) = sets (sigma (\<Pi>\<^sub>E i\<in>I. \<Omega> i) P)"
 proof cases
   assume "I = {}"
   with \<open>\<Union>J = I\<close> have "P = {{\<lambda>_. undefined}} \<or> P = {}"
     by (auto simp: P_def)
   with \<open>I = {}\<close> show ?thesis
     by (auto simp add: sets_PiM_empty sigma_sets_empty_eq)
 next
   let ?F = "\<lambda>i. {(\<lambda>x. x i) -` A \<inter> Pi\<^sub>E I \<Omega> |A. A \<in> E i}"
   assume "I \<noteq> {}"
   then have "sets (Pi\<^sub>M I (\<lambda>i. sigma (\<Omega> i) (E i))) =
       sets (SUP i\<in>I. vimage_algebra (\<Pi>\<^sub>E i\<in>I. \<Omega> i) (\<lambda>x. x i) (sigma (\<Omega> i) (E i)))"
     by (subst sets_PiM_eq_proj) (auto simp: space_measure_of_conv)
   also have "\<dots> = sets (SUP i\<in>I. sigma (Pi\<^sub>E I \<Omega>) (?F i))"
     using E by (intro sets_SUP_cong arg_cong[where f=sets] vimage_algebra_sigma) auto
   also have "\<dots> = sets (sigma (Pi\<^sub>E I \<Omega>) (\<Union>i\<in>I. ?F i))"
     using \<open>I \<noteq> {}\<close> by (intro arg_cong[where f=sets] SUP_sigma_sigma) auto
   also have "\<dots> = sets (sigma (Pi\<^sub>E I \<Omega>) P)"
   proof (intro arg_cong[where f=sets] sigma_eqI sigma_sets_eqI)
     show "(\<Union>i\<in>I. ?F i) \<subseteq> Pow (Pi\<^sub>E I \<Omega>)" "P \<subseteq> Pow (Pi\<^sub>E I \<Omega>)"
       by (auto simp: P_def)
   next
     interpret P: sigma_algebra "\<Pi>\<^sub>E i\<in>I. \<Omega> i" "sigma_sets (\<Pi>\<^sub>E i\<in>I. \<Omega> i) P"
       by (auto intro!: sigma_algebra_sigma_sets simp: P_def)
 
     fix Z assume "Z \<in> (\<Union>i\<in>I. ?F i)"
     then obtain i A where i: "i \<in> I" "A \<in> E i" and Z_def: "Z = (\<lambda>x. x i) -` A \<inter> Pi\<^sub>E I \<Omega>"
       by auto
     from \<open>i \<in> I\<close> J obtain j where j: "i \<in> j" "j \<in> J" "j \<subseteq> I" "finite j"
       by auto
     obtain S where S: "\<And>i. i \<in> j \<Longrightarrow> S i \<subseteq> E i" "\<And>i. i \<in> j \<Longrightarrow> countable (S i)"
       "\<And>i. i \<in> j \<Longrightarrow> \<Omega> i = \<Union>(S i)"
       by (metis subset_eq \<Omega>_cover \<open>j \<subseteq> I\<close>)
     define A' where "A' n = n(i := A)" for n
     then have A'_i: "\<And>n. A' n i = A"
       by simp
     { fix n assume "n \<in> Pi\<^sub>E (j - {i}) S"
       then have "A' n \<in> Pi j E"
         unfolding PiE_def Pi_def using S(1) by (auto simp: A'_def \<open>A \<in> E i\<close> )
       with \<open>j \<in> J\<close> have "{f \<in> Pi\<^sub>E I \<Omega>. \<forall>i\<in>j. f i \<in> A' n i} \<in> P"
         by (auto simp: P_def) }
     note A'_in_P = this
 
     { fix x assume "x i \<in> A" "x \<in> Pi\<^sub>E I \<Omega>"
       with S(3) \<open>j \<subseteq> I\<close> have "\<forall>i\<in>j. \<exists>s\<in>S i. x i \<in> s"
         by (auto simp: PiE_def Pi_def)
       then obtain s where s: "\<And>i. i \<in> j \<Longrightarrow> s i \<in> S i" "\<And>i. i \<in> j \<Longrightarrow> x i \<in> s i"
         by metis
       with \<open>x i \<in> A\<close> have "\<exists>n\<in>Pi\<^sub>E (j-{i}) S. \<forall>i\<in>j. x i \<in> A' n i"
         by (intro bexI[of _ "restrict (s(i := A)) (j-{i})"]) (auto simp: A'_def split: if_splits) }
     then have "Z = (\<Union>n\<in>Pi\<^sub>E (j-{i}) S. {f\<in>(\<Pi>\<^sub>E i\<in>I. \<Omega> i). \<forall>i\<in>j. f i \<in> A' n i})"
       unfolding Z_def
       by (auto simp add: set_eq_iff ball_conj_distrib \<open>i\<in>j\<close> A'_i dest: bspec[OF _ \<open>i\<in>j\<close>]
                cong: conj_cong)
     also have "\<dots> \<in> sigma_sets (\<Pi>\<^sub>E i\<in>I. \<Omega> i) P"
       using \<open>finite j\<close> S(2)
       by (intro P.countable_UN' countable_PiE) (simp_all add: image_subset_iff A'_in_P)
     finally show "Z \<in> sigma_sets (\<Pi>\<^sub>E i\<in>I. \<Omega> i) P" .
   next
     interpret F: sigma_algebra "\<Pi>\<^sub>E i\<in>I. \<Omega> i" "sigma_sets (\<Pi>\<^sub>E i\<in>I. \<Omega> i) (\<Union>i\<in>I. ?F i)"
       by (auto intro!: sigma_algebra_sigma_sets)
 
     fix b assume "b \<in> P"
     then obtain A j where b: "b = {f\<in>(\<Pi>\<^sub>E i\<in>I. \<Omega> i). \<forall>i\<in>j. f i \<in> A i}" "j \<in> J" "A \<in> Pi j E"
       by (auto simp: P_def)
     show "b \<in> sigma_sets (Pi\<^sub>E I \<Omega>) (\<Union>i\<in>I. ?F i)"
     proof cases
       assume "j = {}"
       with b have "b = (\<Pi>\<^sub>E i\<in>I. \<Omega> i)"
         by auto
       then show ?thesis
         by blast
     next
       assume "j \<noteq> {}"
       with J b(2,3) have eq: "b = (\<Inter>i\<in>j. ((\<lambda>x. x i) -` A i \<inter> Pi\<^sub>E I \<Omega>))"
         unfolding b(1)
         by (auto simp: PiE_def Pi_def)
       show ?thesis
         unfolding eq using \<open>A \<in> Pi j E\<close> \<open>j \<in> J\<close> J(2)
         by (intro F.finite_INT J \<open>j \<in> J\<close> \<open>j \<noteq> {}\<close> sigma_sets.Basic) blast
     qed
   qed
   finally show "?thesis" .
 qed
 
 lemma sets_PiM_in_sets:
   assumes space: "space N = (\<Pi>\<^sub>E i\<in>I. space (M i))"
   assumes sets: "\<And>i A. i \<in> I \<Longrightarrow> A \<in> sets (M i) \<Longrightarrow> {x\<in>space N. x i \<in> A} \<in> sets N"
   shows "sets (\<Pi>\<^sub>M i \<in> I. M i) \<subseteq> sets N"
   unfolding sets_PiM_single space[symmetric]
   by (intro sets.sigma_sets_subset subsetI) (auto intro: sets)
 
 lemma sets_PiM_cong[measurable_cong]:
   assumes "I = J" "\<And>i. i \<in> J \<Longrightarrow> sets (M i) = sets (N i)" shows "sets (PiM I M) = sets (PiM J N)"
   using assms sets_eq_imp_space_eq[OF assms(2)] by (simp add: sets_PiM_single cong: PiE_cong conj_cong)
 
 lemma sets_PiM_I:
   assumes "finite J" "J \<subseteq> I" "\<forall>i\<in>J. E i \<in> sets (M i)"
   shows "prod_emb I M J (\<Pi>\<^sub>E j\<in>J. E j) \<in> sets (\<Pi>\<^sub>M i\<in>I. M i)"
 proof cases
   assume "J = {}"
   then have "prod_emb I M J (\<Pi>\<^sub>E j\<in>J. E j) = (\<Pi>\<^sub>E j\<in>I. space (M j))"
     by (auto simp: prod_emb_def)
   then show ?thesis
     by (auto simp add: sets_PiM intro!: sigma_sets_top)
 next
   assume "J \<noteq> {}" with assms show ?thesis
     by (force simp add: sets_PiM prod_algebra_def)
 qed
 
 proposition measurable_PiM:
   assumes space: "f \<in> space N \<rightarrow> (\<Pi>\<^sub>E i\<in>I. space (M i))"
   assumes sets: "\<And>X J. J \<noteq> {} \<or> I = {} \<Longrightarrow> finite J \<Longrightarrow> J \<subseteq> I \<Longrightarrow> (\<And>i. i \<in> J \<Longrightarrow> X i \<in> sets (M i)) \<Longrightarrow>
     f -` prod_emb I M J (Pi\<^sub>E J X) \<inter> space N \<in> sets N"
   shows "f \<in> measurable N (PiM I M)"
   using sets_PiM prod_algebra_sets_into_space space
 proof (rule measurable_sigma_sets)
   fix A assume "A \<in> prod_algebra I M"
-  from prod_algebraE[OF this] guess J X .
+  from prod_algebraE[OF this] obtain J X where
+    "A = prod_emb I M J (Pi\<^sub>E J X)"
+    "finite J"
+    "J \<noteq> {} \<or> I = {}"
+    "J \<subseteq> I"
+    "\<And>i. i \<in> J \<Longrightarrow> X i \<in> sets (M i)"
+    by auto
   with sets[of J X] show "f -` A \<inter> space N \<in> sets N" by auto
 qed
 
 lemma measurable_PiM_Collect:
   assumes space: "f \<in> space N \<rightarrow> (\<Pi>\<^sub>E i\<in>I. space (M i))"
   assumes sets: "\<And>X J. J \<noteq> {} \<or> I = {} \<Longrightarrow> finite J \<Longrightarrow> J \<subseteq> I \<Longrightarrow> (\<And>i. i \<in> J \<Longrightarrow> X i \<in> sets (M i)) \<Longrightarrow>
     {\<omega>\<in>space N. \<forall>i\<in>J. f \<omega> i \<in> X i} \<in> sets N"
   shows "f \<in> measurable N (PiM I M)"
   using sets_PiM prod_algebra_sets_into_space space
 proof (rule measurable_sigma_sets)
   fix A assume "A \<in> prod_algebra I M"
-  from prod_algebraE[OF this] guess J X . note X = this
+  from prod_algebraE[OF this] obtain J X
+    where X:
+      "A = prod_emb I M J (Pi\<^sub>E J X)"
+      "finite J"
+      "J \<noteq> {} \<or> I = {}"
+      "J \<subseteq> I"
+      "\<And>i. i \<in> J \<Longrightarrow> X i \<in> sets (M i)"
+    by auto
   then have "f -` A \<inter> space N = {\<omega> \<in> space N. \<forall>i\<in>J. f \<omega> i \<in> X i}"
     using space by (auto simp: prod_emb_def del: PiE_I)
   also have "\<dots> \<in> sets N" using X(3,2,4,5) by (rule sets)
   finally show "f -` A \<inter> space N \<in> sets N" .
 qed
 
 lemma measurable_PiM_single:
   assumes space: "f \<in> space N \<rightarrow> (\<Pi>\<^sub>E i\<in>I. space (M i))"
   assumes sets: "\<And>A i. i \<in> I \<Longrightarrow> A \<in> sets (M i) \<Longrightarrow> {\<omega> \<in> space N. f \<omega> i \<in> A} \<in> sets N"
   shows "f \<in> measurable N (PiM I M)"
   using sets_PiM_single
 proof (rule measurable_sigma_sets)
   fix A assume "A \<in> {{f \<in> \<Pi>\<^sub>E i\<in>I. space (M i). f i \<in> A} |i A. i \<in> I \<and> A \<in> sets (M i)}"
   then obtain B i where "A = {f \<in> \<Pi>\<^sub>E i\<in>I. space (M i). f i \<in> B}" and B: "i \<in> I" "B \<in> sets (M i)"
     by auto
   with space have "f -` A \<inter> space N = {\<omega> \<in> space N. f \<omega> i \<in> B}" by auto
   also have "\<dots> \<in> sets N" using B by (rule sets)
   finally show "f -` A \<inter> space N \<in> sets N" .
 qed (auto simp: space)
 
 lemma measurable_PiM_single':
   assumes f: "\<And>i. i \<in> I \<Longrightarrow> f i \<in> measurable N (M i)"
     and "(\<lambda>\<omega> i. f i \<omega>) \<in> space N \<rightarrow> (\<Pi>\<^sub>E i\<in>I. space (M i))"
   shows "(\<lambda>\<omega> i. f i \<omega>) \<in> measurable N (Pi\<^sub>M I M)"
 proof (rule measurable_PiM_single)
   fix A i assume A: "i \<in> I" "A \<in> sets (M i)"
   then have "{\<omega> \<in> space N. f i \<omega> \<in> A} = f i -` A \<inter> space N"
     by auto
   then show "{\<omega> \<in> space N. f i \<omega> \<in> A} \<in> sets N"
     using A f by (auto intro!: measurable_sets)
 qed fact
 
 lemma sets_PiM_I_finite[measurable]:
   assumes "finite I" and sets: "(\<And>i. i \<in> I \<Longrightarrow> E i \<in> sets (M i))"
   shows "(\<Pi>\<^sub>E j\<in>I. E j) \<in> sets (\<Pi>\<^sub>M i\<in>I. M i)"
   using sets_PiM_I[of I I E M] sets.sets_into_space[OF sets] \<open>finite I\<close> sets by auto
 
 lemma measurable_component_singleton[measurable (raw)]:
   assumes "i \<in> I" shows "(\<lambda>x. x i) \<in> measurable (Pi\<^sub>M I M) (M i)"
 proof (unfold measurable_def, intro CollectI conjI ballI)
   fix A assume "A \<in> sets (M i)"
   then have "(\<lambda>x. x i) -` A \<inter> space (Pi\<^sub>M I M) = prod_emb I M {i} (\<Pi>\<^sub>E j\<in>{i}. A)"
     using sets.sets_into_space \<open>i \<in> I\<close>
     by (fastforce dest: Pi_mem simp: prod_emb_def space_PiM split: if_split_asm)
   then show "(\<lambda>x. x i) -` A \<inter> space (Pi\<^sub>M I M) \<in> sets (Pi\<^sub>M I M)"
     using \<open>A \<in> sets (M i)\<close> \<open>i \<in> I\<close> by (auto intro!: sets_PiM_I)
 qed (insert \<open>i \<in> I\<close>, auto simp: space_PiM)
 
 lemma measurable_component_singleton'[measurable_dest]:
   assumes f: "f \<in> measurable N (Pi\<^sub>M I M)"
   assumes g: "g \<in> measurable L N"
   assumes i: "i \<in> I"
   shows "(\<lambda>x. (f (g x)) i) \<in> measurable L (M i)"
   using measurable_compose[OF measurable_compose[OF g f] measurable_component_singleton, OF i] .
 
 lemma measurable_PiM_component_rev:
   "i \<in> I \<Longrightarrow> f \<in> measurable (M i) N \<Longrightarrow> (\<lambda>x. f (x i)) \<in> measurable (PiM I M) N"
   by simp
 
 lemma measurable_case_nat[measurable (raw)]:
   assumes [measurable (raw)]: "i = 0 \<Longrightarrow> f \<in> measurable M N"
     "\<And>j. i = Suc j \<Longrightarrow> (\<lambda>x. g x j) \<in> measurable M N"
   shows "(\<lambda>x. case_nat (f x) (g x) i) \<in> measurable M N"
   by (cases i) simp_all
 
 lemma measurable_case_nat'[measurable (raw)]:
   assumes fg[measurable]: "f \<in> measurable N M" "g \<in> measurable N (\<Pi>\<^sub>M i\<in>UNIV. M)"
   shows "(\<lambda>x. case_nat (f x) (g x)) \<in> measurable N (\<Pi>\<^sub>M i\<in>UNIV. M)"
   using fg[THEN measurable_space]
   by (auto intro!: measurable_PiM_single' simp add: space_PiM PiE_iff split: nat.split)
 
 lemma measurable_add_dim[measurable]:
   "(\<lambda>(f, y). f(i := y)) \<in> measurable (Pi\<^sub>M I M \<Otimes>\<^sub>M M i) (Pi\<^sub>M (insert i I) M)"
     (is "?f \<in> measurable ?P ?I")
 proof (rule measurable_PiM_single)
   fix j A assume j: "j \<in> insert i I" and A: "A \<in> sets (M j)"
   have "{\<omega> \<in> space ?P. (\<lambda>(f, x). fun_upd f i x) \<omega> j \<in> A} =
     (if j = i then space (Pi\<^sub>M I M) \<times> A else ((\<lambda>x. x j) \<circ> fst) -` A \<inter> space ?P)"
     using sets.sets_into_space[OF A] by (auto simp add: space_pair_measure space_PiM)
   also have "\<dots> \<in> sets ?P"
     using A j
     by (auto intro!: measurable_sets[OF measurable_comp, OF _ measurable_component_singleton])
   finally show "{\<omega> \<in> space ?P. case_prod (\<lambda>f. fun_upd f i) \<omega> j \<in> A} \<in> sets ?P" .
 qed (auto simp: space_pair_measure space_PiM PiE_def)
 
 proposition measurable_fun_upd:
   assumes I: "I = J \<union> {i}"
   assumes f[measurable]: "f \<in> measurable N (PiM J M)"
   assumes h[measurable]: "h \<in> measurable N (M i)"
   shows "(\<lambda>x. (f x) (i := h x)) \<in> measurable N (PiM I M)"
 proof (intro measurable_PiM_single')
   fix j assume "j \<in> I" then show "(\<lambda>\<omega>. ((f \<omega>)(i := h \<omega>)) j) \<in> measurable N (M j)"
     unfolding I by (cases "j = i") auto
 next
   show "(\<lambda>x. (f x)(i := h x)) \<in> space N \<rightarrow> (\<Pi>\<^sub>E i\<in>I. space (M i))"
     using I f[THEN measurable_space] h[THEN measurable_space]
     by (auto simp: space_PiM PiE_iff extensional_def)
 qed
 
 lemma measurable_component_update:
   "x \<in> space (Pi\<^sub>M I M) \<Longrightarrow> i \<notin> I \<Longrightarrow> (\<lambda>v. x(i := v)) \<in> measurable (M i) (Pi\<^sub>M (insert i I) M)"
   by simp
 
 lemma measurable_merge[measurable]:
   "merge I J \<in> measurable (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M) (Pi\<^sub>M (I \<union> J) M)"
     (is "?f \<in> measurable ?P ?U")
 proof (rule measurable_PiM_single)
   fix i A assume A: "A \<in> sets (M i)" "i \<in> I \<union> J"
   then have "{\<omega> \<in> space ?P. merge I J \<omega> i \<in> A} =
     (if i \<in> I then ((\<lambda>x. x i) \<circ> fst) -` A \<inter> space ?P else ((\<lambda>x. x i) \<circ> snd) -` A \<inter> space ?P)"
     by (auto simp: merge_def)
   also have "\<dots> \<in> sets ?P"
     using A
     by (auto intro!: measurable_sets[OF measurable_comp, OF _ measurable_component_singleton])
   finally show "{\<omega> \<in> space ?P. merge I J \<omega> i \<in> A} \<in> sets ?P" .
 qed (auto simp: space_pair_measure space_PiM PiE_iff merge_def extensional_def)
 
 lemma measurable_restrict[measurable (raw)]:
   assumes X: "\<And>i. i \<in> I \<Longrightarrow> X i \<in> measurable N (M i)"
   shows "(\<lambda>x. \<lambda>i\<in>I. X i x) \<in> measurable N (Pi\<^sub>M I M)"
 proof (rule measurable_PiM_single)
   fix A i assume A: "i \<in> I" "A \<in> sets (M i)"
   then have "{\<omega> \<in> space N. (\<lambda>i\<in>I. X i \<omega>) i \<in> A} = X i -` A \<inter> space N"
     by auto
   then show "{\<omega> \<in> space N. (\<lambda>i\<in>I. X i \<omega>) i \<in> A} \<in> sets N"
     using A X by (auto intro!: measurable_sets)
 qed (insert X, auto simp add: PiE_def dest: measurable_space)
 
 lemma measurable_abs_UNIV:
   "(\<And>n. (\<lambda>\<omega>. f n \<omega>) \<in> measurable M (N n)) \<Longrightarrow> (\<lambda>\<omega> n. f n \<omega>) \<in> measurable M (PiM UNIV N)"
   by (intro measurable_PiM_single) (auto dest: measurable_space)
 
 lemma measurable_restrict_subset: "J \<subseteq> L \<Longrightarrow> (\<lambda>f. restrict f J) \<in> measurable (Pi\<^sub>M L M) (Pi\<^sub>M J M)"
   by (intro measurable_restrict measurable_component_singleton) auto
 
 lemma measurable_restrict_subset':
   assumes "J \<subseteq> L" "\<And>x. x \<in> J \<Longrightarrow> sets (M x) = sets (N x)"
   shows "(\<lambda>f. restrict f J) \<in> measurable (Pi\<^sub>M L M) (Pi\<^sub>M J N)"
 proof-
   from assms(1) have "(\<lambda>f. restrict f J) \<in> 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
 
 lemma measurable_prod_emb[intro, simp]:
   "J \<subseteq> L \<Longrightarrow> X \<in> sets (Pi\<^sub>M J M) \<Longrightarrow> prod_emb L M J X \<in> sets (Pi\<^sub>M L M)"
   unfolding prod_emb_def space_PiM[symmetric]
   by (auto intro!: measurable_sets measurable_restrict measurable_component_singleton)
 
 lemma merge_in_prod_emb:
   assumes "y \<in> space (PiM I M)" "x \<in> X" and X: "X \<in> sets (Pi\<^sub>M J M)" and "J \<subseteq> I"
   shows "merge J I (x, y) \<in> prod_emb I M J X"
   using assms sets.sets_into_space[OF X]
   by (simp add: merge_def prod_emb_def subset_eq space_PiM PiE_def extensional_restrict Pi_iff
            cong: if_cong restrict_cong)
      (simp add: extensional_def)
 
 lemma prod_emb_eq_emptyD:
   assumes J: "J \<subseteq> I" and ne: "space (PiM I M) \<noteq> {}" and X: "X \<in> sets (Pi\<^sub>M J M)"
     and *: "prod_emb I M J X = {}"
   shows "X = {}"
 proof safe
   fix x assume "x \<in> X"
   obtain \<omega> where "\<omega> \<in> space (PiM I M)"
     using ne by blast
   from merge_in_prod_emb[OF this \<open>x\<in>X\<close> X J] * show "x \<in> {}" by auto
 qed
 
 lemma sets_in_Pi_aux:
   "finite I \<Longrightarrow> (\<And>j. j \<in> I \<Longrightarrow> {x\<in>space (M j). x \<in> F j} \<in> sets (M j)) \<Longrightarrow>
   {x\<in>space (PiM I M). x \<in> Pi I F} \<in> sets (PiM I M)"
   by (simp add: subset_eq Pi_iff)
 
 lemma sets_in_Pi[measurable (raw)]:
   "finite I \<Longrightarrow> f \<in> measurable N (PiM I M) \<Longrightarrow>
   (\<And>j. j \<in> I \<Longrightarrow> {x\<in>space (M j). x \<in> F j} \<in> sets (M j)) \<Longrightarrow>
   Measurable.pred N (\<lambda>x. f x \<in> Pi I F)"
   unfolding pred_def
   by (rule measurable_sets_Collect[of f N "PiM I M", OF _ sets_in_Pi_aux]) auto
 
 lemma sets_in_extensional_aux:
   "{x\<in>space (PiM I M). x \<in> extensional I} \<in> sets (PiM I M)"
 proof -
   have "{x\<in>space (PiM I M). x \<in> extensional I} = space (PiM I M)"
     by (auto simp add: extensional_def space_PiM)
   then show ?thesis by simp
 qed
 
 lemma sets_in_extensional[measurable (raw)]:
   "f \<in> measurable N (PiM I M) \<Longrightarrow> Measurable.pred N (\<lambda>x. f x \<in> extensional I)"
   unfolding pred_def
   by (rule measurable_sets_Collect[of f N "PiM I M", OF _ sets_in_extensional_aux]) auto
 
 lemma sets_PiM_I_countable:
   assumes I: "countable I" and E: "\<And>i. i \<in> I \<Longrightarrow> E i \<in> sets (M i)" shows "Pi\<^sub>E I E \<in> sets (Pi\<^sub>M I M)"
 proof cases
   assume "I \<noteq> {}"
   then have "Pi\<^sub>E I E = (\<Inter>i\<in>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 "\<dots> \<in> sets (PiM I M)"
     using I \<open>I \<noteq> {}\<close> by (safe intro!: sets.countable_INT' measurable_prod_emb sets_PiM_I_finite E)
   finally show ?thesis .
 qed (simp add: sets_PiM_empty)
 
 lemma sets_PiM_D_countable:
   assumes A: "A \<in> PiM I M"
   shows "\<exists>J\<subseteq>I. \<exists>X\<in>PiM J M. countable J \<and> A = prod_emb I M J X"
   using A[unfolded sets_PiM_single]
 proof induction
   case (Basic A)
   then obtain i X where *: "i \<in> I" "X \<in> sets (M i)" and "A = {f \<in> \<Pi>\<^sub>E i\<in>I. space (M i). f i \<in> X}"
     by auto
   then have A: "A = prod_emb I M {i} (\<Pi>\<^sub>E _\<in>{i}. X)"
     by (auto simp: prod_emb_def)
   then show ?case
     by (intro exI[of _ "{i}"] conjI bexI[of _ "\<Pi>\<^sub>E _\<in>{i}. X"])
        (auto intro: countable_finite * sets_PiM_I_finite)
 next
   case Empty then show ?case
     by (intro exI[of _ "{}"] conjI bexI[of _ "{}"]) auto
 next
   case (Compl A)
   then obtain J X where "J \<subseteq> I" "X \<in> sets (Pi\<^sub>M J M)" "countable J" "A = prod_emb I M J X"
     by auto
   then show ?case
     by (intro exI[of _ J] bexI[of _ "space (PiM J M) - X"] conjI)
        (auto simp add: space_PiM prod_emb_PiE intro!: sets_PiM_I_countable)
 next
   case (Union K)
   obtain J X where J: "\<And>i. J i \<subseteq> I" "\<And>i. countable (J i)" and X: "\<And>i. X i \<in> sets (Pi\<^sub>M (J i) M)"
     and K: "\<And>i. K i = prod_emb I M (J i) (X i)"
     by (metis Union.IH)
   show ?case
   proof (intro exI[of _ "\<Union>i. J i"] bexI[of _ "\<Union>i. prod_emb (\<Union>i. J i) M (J i) (X i)"] conjI)
     show "(\<Union>i. J i) \<subseteq> I" "countable (\<Union>i. J i)" using J by auto
     with J show "\<Union>(K ` UNIV) = prod_emb I M (\<Union>i. J i) (\<Union>i. prod_emb (\<Union>i. J i) M (J i) (X i))"
       by (simp add: K[abs_def] SUP_upper)
   qed(auto intro: X)
 qed
 
 proposition measure_eqI_PiM_finite:
   assumes [simp]: "finite I" "sets P = PiM I M" "sets Q = PiM I M"
   assumes eq: "\<And>A. (\<And>i. i \<in> I \<Longrightarrow> A i \<in> sets (M i)) \<Longrightarrow> P (Pi\<^sub>E I A) = Q (Pi\<^sub>E I A)"
   assumes A: "range A \<subseteq> prod_algebra I M" "(\<Union>i. A i) = space (PiM I M)" "\<And>i::nat. P (A i) \<noteq> \<infinity>"
   shows "P = Q"
 proof (rule measure_eqI_generator_eq[OF Int_stable_prod_algebra prod_algebra_sets_into_space])
   show "range A \<subseteq> prod_algebra I M" "(\<Union>i. A i) = (\<Pi>\<^sub>E i\<in>I. space (M i))" "\<And>i. P (A i) \<noteq> \<infinity>"
     unfolding space_PiM[symmetric] by fact+
   fix X assume "X \<in> prod_algebra I M"
   then obtain J E where X: "X = prod_emb I M J (\<Pi>\<^sub>E j\<in>J. E j)"
     and J: "finite J" "J \<subseteq> I" "\<And>j. j \<in> J \<Longrightarrow> E j \<in> sets (M j)"
     by (force elim!: prod_algebraE)
   then show "emeasure P X = emeasure Q X"
     unfolding X by (subst (1 2) prod_emb_Pi) (auto simp: eq)
 qed (simp_all add: sets_PiM)
 
 proposition measure_eqI_PiM_infinite:
   assumes [simp]: "sets P = PiM I M" "sets Q = PiM I M"
   assumes eq: "\<And>A J. finite J \<Longrightarrow> J \<subseteq> I \<Longrightarrow> (\<And>i. i \<in> J \<Longrightarrow> A i \<in> sets (M i)) \<Longrightarrow>
     P (prod_emb I M J (Pi\<^sub>E J A)) = Q (prod_emb I M J (Pi\<^sub>E J A))"
   assumes A: "finite_measure P"
   shows "P = Q"
 proof (rule measure_eqI_generator_eq[OF Int_stable_prod_algebra prod_algebra_sets_into_space])
   interpret finite_measure P by fact
   define i where "i = (SOME i. i \<in> I)"
   have i: "I \<noteq> {} \<Longrightarrow> i \<in> I"
     unfolding i_def by (rule someI_ex) auto
   define A where "A n =
     (if I = {} then prod_emb I M {} (\<Pi>\<^sub>E i\<in>{}. {}) else prod_emb I M {i} (\<Pi>\<^sub>E i\<in>{i}. space (M i)))"
     for n :: nat
   then show "range A \<subseteq> prod_algebra I M"
     using prod_algebraI[of "{}" I "\<lambda>i. space (M i)" M] by (auto intro!: prod_algebraI i)
   have "\<And>i. A i = space (PiM I M)"
     by (auto simp: prod_emb_def space_PiM PiE_iff A_def i ex_in_conv[symmetric] exI)
   then show "(\<Union>i. A i) = (\<Pi>\<^sub>E i\<in>I. space (M i))" "\<And>i. emeasure P (A i) \<noteq> \<infinity>"
     by (auto simp: space_PiM)
 next
   fix X assume X: "X \<in> prod_algebra I M"
   then obtain J E where X: "X = prod_emb I M J (\<Pi>\<^sub>E j\<in>J. E j)"
     and J: "finite J" "J \<subseteq> I" "\<And>j. j \<in> J \<Longrightarrow> E j \<in> sets (M j)"
     by (force elim!: prod_algebraE)
   then show "emeasure P X = emeasure Q X"
     by (auto intro!: eq)
 qed (auto simp: sets_PiM)
 
 locale\<^marker>\<open>tag unimportant\<close> product_sigma_finite =
   fixes M :: "'i \<Rightarrow> 'a measure"
   assumes sigma_finite_measures: "\<And>i. sigma_finite_measure (M i)"
 
 sublocale\<^marker>\<open>tag unimportant\<close> product_sigma_finite \<subseteq> M?: sigma_finite_measure "M i" for i
   by (rule sigma_finite_measures)
 
 locale\<^marker>\<open>tag unimportant\<close> finite_product_sigma_finite = product_sigma_finite M for M :: "'i \<Rightarrow> 'a measure" +
   fixes I :: "'i set"
   assumes finite_index: "finite I"
 
 proposition (in finite_product_sigma_finite) sigma_finite_pairs:
   "\<exists>F::'i \<Rightarrow> nat \<Rightarrow> 'a set.
     (\<forall>i\<in>I. range (F i) \<subseteq> sets (M i)) \<and>
     (\<forall>k. \<forall>i\<in>I. emeasure (M i) (F i k) \<noteq> \<infinity>) \<and> incseq (\<lambda>k. \<Pi>\<^sub>E i\<in>I. F i k) \<and>
     (\<Union>k. \<Pi>\<^sub>E i\<in>I. F i k) = space (PiM I M)"
 proof -
   have "\<forall>i::'i. \<exists>F::nat \<Rightarrow> 'a set. range F \<subseteq> sets (M i) \<and> incseq F \<and> (\<Union>i. F i) = space (M i) \<and> (\<forall>k. emeasure (M i) (F k) \<noteq> \<infinity>)"
     using M.sigma_finite_incseq by metis
-  from choice[OF this] guess F :: "'i \<Rightarrow> nat \<Rightarrow> 'a set" ..
+  then obtain F :: "'i \<Rightarrow> nat \<Rightarrow> 'a set"
+    where "\<forall>x. range (F x) \<subseteq> sets (M x) \<and> incseq (F x) \<and> \<Union> (range (F x)) = space (M x) \<and> (\<forall>k. emeasure (M x) (F x k) \<noteq> \<infinity>)"
+    by metis
   then have F: "\<And>i. range (F i) \<subseteq> sets (M i)" "\<And>i. incseq (F i)" "\<And>i. (\<Union>j. F i j) = space (M i)" "\<And>i k. emeasure (M i) (F i k) \<noteq> \<infinity>"
     by auto
   let ?F = "\<lambda>k. \<Pi>\<^sub>E i\<in>I. F i k"
   note space_PiM[simp]
   show ?thesis
   proof (intro exI[of _ F] conjI allI incseq_SucI set_eqI iffI ballI)
     fix i show "range (F i) \<subseteq> sets (M i)" by fact
   next
     fix i k show "emeasure (M i) (F i k) \<noteq> \<infinity>" by fact
   next
     fix x assume "x \<in> (\<Union>i. ?F i)" with F(1) show "x \<in> space (PiM I M)"
       by (auto simp: PiE_def dest!: sets.sets_into_space)
   next
     fix f assume "f \<in> space (PiM I M)"
     with Pi_UN[OF finite_index, of "\<lambda>k i. F i k"] F
     show "f \<in> (\<Union>i. ?F i)" by (auto simp: incseq_def PiE_def)
   next
     fix i show "?F i \<subseteq> ?F (Suc i)"
       using \<open>\<And>i. incseq (F i)\<close>[THEN incseq_SucD] by auto
   qed
 qed
 
 lemma emeasure_PiM_empty[simp]: "emeasure (PiM {} M) {\<lambda>_. undefined} = 1"
 proof -
   let ?\<mu> = "\<lambda>A. if A = {} then 0 else (1::ennreal)"
   have "emeasure (Pi\<^sub>M {} M) (prod_emb {} M {} (\<Pi>\<^sub>E i\<in>{}. {})) = 1"
   proof (subst emeasure_extend_measure_Pair[OF PiM_def])
     show "positive (PiM {} M) ?\<mu>"
       by (auto simp: positive_def)
     show "countably_additive (PiM {} M) ?\<mu>"
       by (rule sets.countably_additiveI_finite)
          (auto simp: additive_def positive_def sets_PiM_empty space_PiM_empty intro!: )
   qed (auto simp: prod_emb_def)
   also have "(prod_emb {} M {} (\<Pi>\<^sub>E i\<in>{}. {})) = {\<lambda>_. undefined}"
     by (auto simp: prod_emb_def)
   finally show ?thesis
     by simp
 qed
 
 lemma PiM_empty: "PiM {} M = count_space {\<lambda>_. undefined}"
   by (rule measure_eqI) (auto simp add: sets_PiM_empty)
 
 lemma (in product_sigma_finite) emeasure_PiM:
   "finite I \<Longrightarrow> (\<And>i. i\<in>I \<Longrightarrow> A i \<in> sets (M i)) \<Longrightarrow> emeasure (PiM I M) (Pi\<^sub>E I A) = (\<Prod>i\<in>I. emeasure (M i) (A i))"
 proof (induct I arbitrary: A rule: finite_induct)
   case (insert i I)
   interpret finite_product_sigma_finite M I by standard fact
   have "finite (insert i I)" using \<open>finite I\<close> by auto
   interpret I': finite_product_sigma_finite M "insert i I" by standard fact
   let ?h = "(\<lambda>(f, y). f(i := y))"
 
   let ?P = "distr (Pi\<^sub>M I M \<Otimes>\<^sub>M M i) (Pi\<^sub>M (insert i I) M) ?h"
   let ?\<mu> = "emeasure ?P"
   let ?I = "{j \<in> insert i I. emeasure (M j) (space (M j)) \<noteq> 1}"
   let ?f = "\<lambda>J E j. if j \<in> J then emeasure (M j) (E j) else emeasure (M j) (space (M j))"
 
   have "emeasure (Pi\<^sub>M (insert i I) M) (prod_emb (insert i I) M (insert i I) (Pi\<^sub>E (insert i I) A)) =
     (\<Prod>i\<in>insert i I. emeasure (M i) (A i))"
   proof (subst emeasure_extend_measure_Pair[OF PiM_def])
     fix J E assume "(J \<noteq> {} \<or> insert i I = {}) \<and> finite J \<and> J \<subseteq> insert i I \<and> E \<in> (\<Pi> j\<in>J. sets (M j))"
     then have J: "J \<noteq> {}" "finite J" "J \<subseteq> insert i I" and E: "\<forall>j\<in>J. E j \<in> sets (M j)" by auto
     let ?p = "prod_emb (insert i I) M J (Pi\<^sub>E J E)"
     let ?p' = "prod_emb I M (J - {i}) (\<Pi>\<^sub>E j\<in>J-{i}. E j)"
     have "?\<mu> ?p =
       emeasure (Pi\<^sub>M I M \<Otimes>\<^sub>M (M i)) (?h -` ?p \<inter> space (Pi\<^sub>M I M \<Otimes>\<^sub>M M i))"
       by (intro emeasure_distr measurable_add_dim sets_PiM_I) fact+
     also have "?h -` ?p \<inter> space (Pi\<^sub>M I M \<Otimes>\<^sub>M M i) = ?p' \<times> (if i \<in> J then E i else space (M i))"
       using J E[rule_format, THEN sets.sets_into_space]
       by (force simp: space_pair_measure space_PiM prod_emb_iff PiE_def Pi_iff split: if_split_asm)
     also have "emeasure (Pi\<^sub>M I M \<Otimes>\<^sub>M (M i)) (?p' \<times> (if i \<in> J then E i else space (M i))) =
       emeasure (Pi\<^sub>M I M) ?p' * emeasure (M i) (if i \<in> J then (E i) else space (M i))"
       using J E by (intro M.emeasure_pair_measure_Times sets_PiM_I) auto
     also have "?p' = (\<Pi>\<^sub>E j\<in>I. if j \<in> J-{i} then E j else space (M j))"
       using J E[rule_format, THEN sets.sets_into_space]
       by (auto simp: prod_emb_iff PiE_def Pi_iff split: if_split_asm) blast+
     also have "emeasure (Pi\<^sub>M I M) (\<Pi>\<^sub>E j\<in>I. if j \<in> J-{i} then E j else space (M j)) =
       (\<Prod> j\<in>I. if j \<in> J-{i} then emeasure (M j) (E j) else emeasure (M j) (space (M j)))"
       using E by (subst insert) (auto intro!: prod.cong)
     also have "(\<Prod>j\<in>I. if j \<in> J - {i} then emeasure (M j) (E j) else emeasure (M j) (space (M j))) *
        emeasure (M i) (if i \<in> J then E i else space (M i)) = (\<Prod>j\<in>insert i I. ?f J E j)"
       using insert by (auto simp: mult.commute intro!: arg_cong2[where f="(*)"] prod.cong)
     also have "\<dots> = (\<Prod>j\<in>J \<union> ?I. ?f J E j)"
       using insert(1,2) J E by (intro prod.mono_neutral_right) auto
     finally show "?\<mu> ?p = \<dots>" .
 
     show "prod_emb (insert i I) M J (Pi\<^sub>E J E) \<in> Pow (\<Pi>\<^sub>E i\<in>insert i I. space (M i))"
       using J E[rule_format, THEN sets.sets_into_space] by (auto simp: prod_emb_iff PiE_def)
   next
     show "positive (sets (Pi\<^sub>M (insert i I) M)) ?\<mu>" "countably_additive (sets (Pi\<^sub>M (insert i I) M)) ?\<mu>"
       using emeasure_positive[of ?P] emeasure_countably_additive[of ?P] by simp_all
   next
     show "(insert i I \<noteq> {} \<or> insert i I = {}) \<and> finite (insert i I) \<and>
       insert i I \<subseteq> insert i I \<and> A \<in> (\<Pi> j\<in>insert i I. sets (M j))"
       using insert by auto
   qed (auto intro!: prod.cong)
   with insert show ?case
     by (subst (asm) prod_emb_PiE_same_index) (auto intro!: sets.sets_into_space)
 qed simp
 
 lemma (in product_sigma_finite) PiM_eqI:
   assumes I[simp]: "finite I" and P: "sets P = PiM I M"
   assumes eq: "\<And>A. (\<And>i. i \<in> I \<Longrightarrow> A i \<in> sets (M i)) \<Longrightarrow> P (Pi\<^sub>E I A) = (\<Prod>i\<in>I. emeasure (M i) (A i))"
   shows "P = PiM I M"
 proof -
   interpret finite_product_sigma_finite M I
-    proof qed fact
-  from sigma_finite_pairs guess C .. note C = this
+    by standard fact
+  from sigma_finite_pairs obtain C where C:
+    "\<forall>i\<in>I. range (C i) \<subseteq> sets (M i)" "\<forall>k. \<forall>i\<in>I. emeasure (M i) (C i k) \<noteq> \<infinity>"
+    "incseq (\<lambda>k. \<Pi>\<^sub>E i\<in>I. C i k)" "(\<Union>k. \<Pi>\<^sub>E i\<in>I. C i k) = space (Pi\<^sub>M I M)"
+    by auto
   show ?thesis
   proof (rule measure_eqI_PiM_finite[OF I refl P, symmetric])
     show "(\<And>i. i \<in> I \<Longrightarrow> A i \<in> sets (M i)) \<Longrightarrow> (Pi\<^sub>M I M) (Pi\<^sub>E I A) = P (Pi\<^sub>E I A)" for A
       by (simp add: eq emeasure_PiM)
     define A where "A n = (\<Pi>\<^sub>E i\<in>I. C i n)" for n
     with C show "range A \<subseteq> prod_algebra I M" "\<And>i. emeasure (Pi\<^sub>M I M) (A i) \<noteq> \<infinity>" "(\<Union>i. A i) = space (PiM I M)"
       by (auto intro!: prod_algebraI_finite simp: emeasure_PiM subset_eq ennreal_prod_eq_top)
   qed
 qed
 
 lemma (in product_sigma_finite) sigma_finite:
   assumes "finite I"
   shows "sigma_finite_measure (PiM I M)"
 proof
   interpret finite_product_sigma_finite M I by standard fact
 
   obtain F where F: "\<And>j. countable (F j)" "\<And>j f. f \<in> F j \<Longrightarrow> f \<in> sets (M j)"
     "\<And>j f. f \<in> F j \<Longrightarrow> emeasure (M j) f \<noteq> \<infinity>" and
     in_space: "\<And>j. space (M j) = \<Union>(F j)"
     using sigma_finite_countable by (metis subset_eq)
   moreover have "(\<Union>(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])
   ultimately show "\<exists>A. countable A \<and> A \<subseteq> sets (Pi\<^sub>M I M) \<and> \<Union>A = space (Pi\<^sub>M I M) \<and> (\<forall>a\<in>A. emeasure (Pi\<^sub>M I M) a \<noteq> \<infinity>)"
     by (intro exI[of _ "Pi\<^sub>E I ` Pi\<^sub>E I F"])
        (auto intro!: countable_PiE sets_PiM_I_finite
              simp: PiE_iff emeasure_PiM finite_index ennreal_prod_eq_top)
 qed
 
 sublocale finite_product_sigma_finite \<subseteq> sigma_finite_measure "Pi\<^sub>M I M"
   using sigma_finite[OF finite_index] .
 
 lemma (in finite_product_sigma_finite) measure_times:
   "(\<And>i. i \<in> I \<Longrightarrow> A i \<in> sets (M i)) \<Longrightarrow> emeasure (Pi\<^sub>M I M) (Pi\<^sub>E I A) = (\<Prod>i\<in>I. emeasure (M i) (A i))"
   using emeasure_PiM[OF finite_index] by auto
 
 lemma (in product_sigma_finite) nn_integral_empty:
   "0 \<le> f (\<lambda>k. undefined) \<Longrightarrow> integral\<^sup>N (Pi\<^sub>M {} M) f = f (\<lambda>k. undefined)"
   by (simp add: PiM_empty nn_integral_count_space_finite max.absorb2)
 
 lemma\<^marker>\<open>tag important\<close> (in product_sigma_finite) distr_merge:
   assumes IJ[simp]: "I \<inter> J = {}" and fin: "finite I" "finite J"
   shows "distr (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M) (Pi\<^sub>M (I \<union> J) M) (merge I J) = Pi\<^sub>M (I \<union> J) M"
    (is "?D = ?P")
 proof (rule PiM_eqI)
   interpret I: finite_product_sigma_finite M I by standard fact
   interpret J: finite_product_sigma_finite M J by standard fact
   fix A assume A: "\<And>i. i \<in> I \<union> J \<Longrightarrow> A i \<in> sets (M i)"
   have *: "(merge I J -` Pi\<^sub>E (I \<union> J) A \<inter> space (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M)) = Pi\<^sub>E I A \<times> Pi\<^sub>E J A"
     using A[THEN sets.sets_into_space] by (auto simp: space_PiM space_pair_measure)
   from A fin show "emeasure (distr (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M) (Pi\<^sub>M (I \<union> J) M) (merge I J)) (Pi\<^sub>E (I \<union> J) A) =
       (\<Prod>i\<in>I \<union> 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)
 
 proposition (in product_sigma_finite) product_nn_integral_fold:
   assumes IJ: "I \<inter> J = {}" "finite I" "finite J"
   and f[measurable]: "f \<in> borel_measurable (Pi\<^sub>M (I \<union> J) M)"
   shows "integral\<^sup>N (Pi\<^sub>M (I \<union> J) M) f =
     (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. f (merge I J (x, y)) \<partial>(Pi\<^sub>M J M)) \<partial>(Pi\<^sub>M I M))"
 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: "(\<lambda>x. f (merge I J x)) \<in> borel_measurable (Pi\<^sub>M I M \<Otimes>\<^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
 qed
 
 lemma (in product_sigma_finite) distr_singleton:
   "distr (Pi\<^sub>M {i} M) (M i) (\<lambda>x. x i) = M i" (is "?D = _")
 proof (intro measure_eqI[symmetric])
   interpret I: finite_product_sigma_finite M "{i}" by standard simp
   fix A assume A: "A \<in> sets (M i)"
   then have "(\<lambda>x. x i) -` A \<inter> space (Pi\<^sub>M {i} M) = (\<Pi>\<^sub>E i\<in>{i}. A)"
     using sets.sets_into_space by (auto simp: space_PiM)
   then show "emeasure (M i) A = emeasure ?D A"
     using A I.measure_times[of "\<lambda>_. A"]
     by (simp add: emeasure_distr measurable_component_singleton)
 qed simp
 
 lemma (in product_sigma_finite) product_nn_integral_singleton:
   assumes f: "f \<in> borel_measurable (M i)"
   shows "integral\<^sup>N (Pi\<^sub>M {i} M) (\<lambda>x. f (x i)) = integral\<^sup>N (M i) f"
 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
 qed
 
 proposition (in product_sigma_finite) product_nn_integral_insert:
   assumes I[simp]: "finite I" "i \<notin> I"
     and f: "f \<in> borel_measurable (Pi\<^sub>M (insert i I) M)"
   shows "integral\<^sup>N (Pi\<^sub>M (insert i I) M) f = (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. f (x(i := y)) \<partial>(M i)) \<partial>(Pi\<^sub>M I M))"
 proof -
   interpret I: finite_product_sigma_finite M I by standard auto
   interpret i: finite_product_sigma_finite M "{i}" by standard auto
   have IJ: "I \<inter> {i} = {}" and insert: "I \<union> {i} = insert i I"
     using f by auto
   show ?thesis
     unfolding product_nn_integral_fold[OF IJ, unfolded insert, OF I(1) i.finite_index f]
   proof (rule nn_integral_cong, subst product_nn_integral_singleton[symmetric])
     fix x assume x: "x \<in> space (Pi\<^sub>M I M)"
     let ?f = "\<lambda>y. f (x(i := y))"
     show "?f \<in> borel_measurable (M i)"
       using measurable_comp[OF measurable_component_update f, OF x \<open>i \<notin> I\<close>]
       unfolding comp_def .
     show "(\<integral>\<^sup>+ y. f (merge I {i} (x, y)) \<partial>Pi\<^sub>M {i} M) = (\<integral>\<^sup>+ y. f (x(i := y i)) \<partial>Pi\<^sub>M {i} M)"
       using x
       by (auto intro!: nn_integral_cong arg_cong[where f=f]
                simp add: space_PiM extensional_def PiE_def)
   qed
 qed
 
 lemma (in product_sigma_finite) product_nn_integral_insert_rev:
   assumes I[simp]: "finite I" "i \<notin> I"
     and [measurable]: "f \<in> borel_measurable (Pi\<^sub>M (insert i I) M)"
   shows "integral\<^sup>N (Pi\<^sub>M (insert i I) M) f = (\<integral>\<^sup>+ y. (\<integral>\<^sup>+ x. f (x(i := y)) \<partial>(Pi\<^sub>M I M)) \<partial>(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 measurable
   done
 
 lemma (in product_sigma_finite) product_nn_integral_prod:
   assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable (M i)"
   shows "(\<integral>\<^sup>+ x. (\<Prod>i\<in>I. f i (x i)) \<partial>Pi\<^sub>M I M) = (\<Prod>i\<in>I. integral\<^sup>N (M i) (f i))"
 using assms proof (induction I)
   case (insert i I)
   note insert.prems[measurable]
   note \<open>finite I\<close>[intro, simp]
   interpret I: finite_product_sigma_finite M I by standard auto
   have *: "\<And>x y. (\<Prod>j\<in>I. f j (if j = i then y else x j)) = (\<Prod>j\<in>I. f j (x j))"
     using insert by (auto intro!: prod.cong)
   have prod: "\<And>J. J \<subseteq> insert i I \<Longrightarrow> (\<lambda>x. (\<Prod>i\<in>J. f i (x i))) \<in> borel_measurable (Pi\<^sub>M J M)"
     using sets.sets_into_space insert
     by (intro borel_measurable_prod_ennreal
               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
 qed (simp add: space_PiM)
 
 proposition (in product_sigma_finite) product_nn_integral_pair:
   assumes [measurable]: "case_prod f \<in> borel_measurable (M x \<Otimes>\<^sub>M M y)"
   assumes xy: "x \<noteq> y"
   shows "(\<integral>\<^sup>+\<sigma>. f (\<sigma> x) (\<sigma> y) \<partial>PiM {x, y} M) = (\<integral>\<^sup>+z. f (fst z) (snd z) \<partial>(M x \<Otimes>\<^sub>M M y))"
 proof -
   interpret psm: pair_sigma_finite "M x" "M y"
     unfolding pair_sigma_finite_def using sigma_finite_measures by simp_all
   have "{x, y} = {y, x}" by auto
   also have "(\<integral>\<^sup>+\<sigma>. f (\<sigma> x) (\<sigma> y) \<partial>PiM {y, x} M) = (\<integral>\<^sup>+y. \<integral>\<^sup>+\<sigma>. f (\<sigma> x) y \<partial>PiM {x} M \<partial>M y)"
     using xy by (subst product_nn_integral_insert_rev) simp_all
   also have "... = (\<integral>\<^sup>+y. \<integral>\<^sup>+x. f x y \<partial>M x \<partial>M y)"
     by (intro nn_integral_cong, subst product_nn_integral_singleton) simp_all
   also have "... = (\<integral>\<^sup>+z. f (fst z) (snd z) \<partial>(M x \<Otimes>\<^sub>M M y))"
     by (subst psm.nn_integral_snd[symmetric]) simp_all
   finally show ?thesis .
 qed
 
 lemma (in product_sigma_finite) distr_component:
   "distr (M i) (Pi\<^sub>M {i} M) (\<lambda>x. \<lambda>i\<in>{i}. x) = Pi\<^sub>M {i} M" (is "?D = ?P")
 proof (intro PiM_eqI)
   fix A assume A: "\<And>ia. ia \<in> {i} \<Longrightarrow> A ia \<in> sets (M ia)"
   then have "(\<lambda>x. \<lambda>i\<in>{i}. x) -` Pi\<^sub>E {i} A \<inter> space (M i) = A i"
     by (fastforce dest: sets.sets_into_space)
   with A show "emeasure (distr (M i) (Pi\<^sub>M {i} M) (\<lambda>x. \<lambda>i\<in>{i}. x)) (Pi\<^sub>E {i} A) = (\<Prod>i\<in>{i}. emeasure (M i) (A i))"
     by (subst emeasure_distr) (auto intro!: sets_PiM_I_finite measurable_restrict)
 qed simp_all
 
 lemma (in product_sigma_finite)
   assumes IJ: "I \<inter> J = {}" "finite I" "finite J" and A: "A \<in> sets (Pi\<^sub>M (I \<union> J) M)"
   shows emeasure_fold_integral:
     "emeasure (Pi\<^sub>M (I \<union> J) M) A = (\<integral>\<^sup>+x. emeasure (Pi\<^sub>M J M) ((\<lambda>y. merge I J (x, y)) -` A \<inter> space (Pi\<^sub>M J M)) \<partial>Pi\<^sub>M I M)" (is ?I)
     and emeasure_fold_measurable:
     "(\<lambda>x. emeasure (Pi\<^sub>M J M) ((\<lambda>y. merge I J (x, y)) -` A \<inter> space (Pi\<^sub>M J M))) \<in> borel_measurable (Pi\<^sub>M I M)" (is ?B)
 proof -
   interpret I: finite_product_sigma_finite M I by standard fact
   interpret J: finite_product_sigma_finite M J by standard fact
   interpret IJ: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" ..
   have merge: "merge I J -` A \<inter> space (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M) \<in> sets (Pi\<^sub>M I M \<Otimes>\<^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])
     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
 
   show ?B
     using IJ.measurable_emeasure_Pair1[OF merge]
     by (simp add: vimage_comp comp_def space_pair_measure cong: measurable_cong)
 qed
 
 lemma sets_Collect_single:
   "i \<in> I \<Longrightarrow> A \<in> sets (M i) \<Longrightarrow> { x \<in> space (Pi\<^sub>M I M). x i \<in> A } \<in> 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"
   shows "(M1 \<Otimes>\<^sub>M M2) = distr (Pi\<^sub>M UNIV (case_bool M1 M2)) (M1 \<Otimes>\<^sub>M M2) (\<lambda>x. (x True, x False))"
     (is "?P = ?D")
 proof (rule pair_measure_eqI[OF assms])
   interpret B: product_sigma_finite "case_bool M1 M2"
     unfolding product_sigma_finite_def using assms by (auto split: bool.split)
   let ?B = "Pi\<^sub>M UNIV (case_bool M1 M2)"
 
   have [simp]: "fst \<circ> (\<lambda>x. (x True, x False)) = (\<lambda>x. x True)" "snd \<circ> (\<lambda>x. (x True, x False)) = (\<lambda>x. x False)"
     by auto
   fix A B assume A: "A \<in> sets M1" and B: "B \<in> sets M2"
   have "emeasure M1 A * emeasure M2 B = (\<Prod> i\<in>UNIV. emeasure (case_bool M1 M2 i) (case_bool A B i))"
     by (simp add: UNIV_bool ac_simps)
   also have "\<dots> = emeasure ?B (Pi\<^sub>E UNIV (case_bool A B))"
     using A B by (subst B.emeasure_PiM) (auto split: bool.split)
   also have "Pi\<^sub>E UNIV (case_bool A B) = (\<lambda>x. (x True, x False)) -` (A \<times> B) \<inter> space ?B"
     using A[THEN sets.sets_into_space] B[THEN sets.sets_into_space]
     by (auto simp: PiE_iff all_bool_eq space_PiM split: bool.split)
   finally show "emeasure M1 A * emeasure M2 B = emeasure ?D (A \<times> B)"
     using A B
       measurable_component_singleton[of True UNIV "case_bool M1 M2"]
       measurable_component_singleton[of False UNIV "case_bool M1 M2"]
     by (subst emeasure_distr) (auto simp: measurable_pair_iff)
 qed simp
 
 lemma infprod_in_sets[intro]:
   fixes E :: "nat \<Rightarrow> 'a set" assumes E: "\<And>i. E i \<in> sets (M i)"
   shows "Pi UNIV E \<in> sets (\<Pi>\<^sub>M i\<in>UNIV::nat set. M i)"
 proof -
   have "Pi UNIV E = (\<Inter>i. prod_emb UNIV M {..i} (\<Pi>\<^sub>E j\<in>{..i}. E j))"
     using E E[THEN sets.sets_into_space]
     by (auto simp: prod_emb_def Pi_iff extensional_def)
   with E show ?thesis by auto
 qed
 
 
 
 subsection \<open>Measurability\<close>
 
 text \<open>There are two natural sigma-algebras on a product space: the borel sigma algebra,
 generated by open sets in the product, and the product sigma algebra, countably generated by
 products of measurable sets along finitely many coordinates. The second one is defined and studied
 in \<^file>\<open>Finite_Product_Measure.thy\<close>.
 
 These sigma-algebra share a lot of natural properties (measurability of coordinates, for instance),
 but there is a fundamental difference: open sets are generated by arbitrary unions, not only
 countable ones, so typically many open sets will not be measurable with respect to the product sigma
 algebra (while all sets in the product sigma algebra are borel). The two sigma algebras coincide
 only when everything is countable (i.e., the product is countable, and the borel sigma algebra in
 the factor is countably generated).
 
 In this paragraph, we develop basic measurability properties for the borel sigma algebra, and
 compare it with the product sigma algebra as explained above.
 \<close>
 
 lemma measurable_product_coordinates [measurable (raw)]:
   "(\<lambda>x. x i) \<in> measurable borel borel"
 by (rule borel_measurable_continuous_onI[OF continuous_on_product_coordinates])
 
 lemma measurable_product_then_coordinatewise:
   fixes f::"'a \<Rightarrow> 'b \<Rightarrow> ('c::topological_space)"
   assumes [measurable]: "f \<in> borel_measurable M"
   shows "(\<lambda>x. f x i) \<in> borel_measurable M"
 proof -
   have "(\<lambda>x. f x i) = (\<lambda>y. y i) o f"
     unfolding comp_def by auto
   then show ?thesis by simp
 qed
 
 text \<open>To compare the Borel sigma algebra with the product sigma algebra, we give a presentation
 of the product sigma algebra that is more similar to the one we used above for the product
 topology.\<close>
 
 lemma sets_PiM_finite:
   "sets (Pi\<^sub>M I M) = sigma_sets (\<Pi>\<^sub>E i\<in>I. space (M i))
         {(\<Pi>\<^sub>E i\<in>I. X i) |X. (\<forall>i. X i \<in> sets (M i)) \<and> finite {i. X i \<noteq> space (M i)}}"
 proof
   have "{(\<Pi>\<^sub>E i\<in>I. X i) |X. (\<forall>i. X i \<in> sets (M i)) \<and> finite {i. X i \<noteq> space (M i)}} \<subseteq> sets (Pi\<^sub>M I M)"
   proof (auto)
     fix X assume H: "\<forall>i. X i \<in> sets (M i)" "finite {i. X i \<noteq> space (M i)}"
     then have *: "X i \<in> sets (M i)" for i by simp
     define J where "J = {i \<in> I. X i \<noteq> space (M i)}"
     have "finite J" "J \<subseteq> I" unfolding J_def using H by auto
     define Y where "Y = (\<Pi>\<^sub>E j\<in>J. X j)"
     have "prod_emb I M J Y \<in> sets (Pi\<^sub>M I M)"
       unfolding Y_def apply (rule sets_PiM_I) using \<open>finite J\<close> \<open>J \<subseteq> I\<close> * by auto
     moreover have "prod_emb I M J Y = (\<Pi>\<^sub>E i\<in>I. X i)"
       unfolding prod_emb_def Y_def J_def using H sets.sets_into_space[OF *]
       by (auto simp add: PiE_iff, blast)
     ultimately show "Pi\<^sub>E I X \<in> sets (Pi\<^sub>M I M)" by simp
   qed
   then show "sigma_sets (\<Pi>\<^sub>E i\<in>I. space (M i)) {(\<Pi>\<^sub>E i\<in>I. X i) |X. (\<forall>i. X i \<in> sets (M i)) \<and> finite {i. X i \<noteq> space (M i)}}
               \<subseteq> sets (Pi\<^sub>M I M)"
     by (metis (mono_tags, lifting) sets.sigma_sets_subset' sets.top space_PiM)
 
   have *: "\<exists>X. {f. (\<forall>i\<in>I. f i \<in> space (M i)) \<and> f \<in> extensional I \<and> f i \<in> A} = Pi\<^sub>E I X \<and>
                 (\<forall>i. X i \<in> sets (M i)) \<and> finite {i. X i \<noteq> space (M i)}"
     if "i \<in> I" "A \<in> sets (M i)" for i A
   proof -
     define X where "X = (\<lambda>j. if j = i then A else space (M j))"
     have "{f. (\<forall>i\<in>I. f i \<in> space (M i)) \<and> f \<in> extensional I \<and> f i \<in> A} = Pi\<^sub>E I X"
       unfolding X_def using sets.sets_into_space[OF \<open>A \<in> sets (M i)\<close>] \<open>i \<in> I\<close>
       by (auto simp add: PiE_iff extensional_def, metis subsetCE, metis)
     moreover have "X j \<in> sets (M j)" for j
       unfolding X_def using \<open>A \<in> sets (M i)\<close> by auto
     moreover have "finite {j. X j \<noteq> space (M j)}"
       unfolding X_def by simp
     ultimately show ?thesis by auto
   qed
   show "sets (Pi\<^sub>M I M) \<subseteq> sigma_sets (\<Pi>\<^sub>E i\<in>I. space (M i)) {(\<Pi>\<^sub>E i\<in>I. X i) |X. (\<forall>i. X i \<in> sets (M i)) \<and> finite {i. X i \<noteq> space (M i)}}"
     unfolding sets_PiM_single
     apply (rule sigma_sets_mono')
     apply (auto simp add: PiE_iff *)
     done
 qed
 
 lemma sets_PiM_subset_borel:
   "sets (Pi\<^sub>M UNIV (\<lambda>_. borel)) \<subseteq> sets borel"
 proof -
   have *: "Pi\<^sub>E UNIV X \<in> sets borel" if [measurable]: "\<And>i. X i \<in> sets borel" "finite {i. X i \<noteq> UNIV}" for X::"'a \<Rightarrow> 'b set"
   proof -
     define I where "I = {i. X i \<noteq> UNIV}"
     have "finite I" unfolding I_def using that by simp
     have "Pi\<^sub>E UNIV X = (\<Inter>i\<in>I. (\<lambda>x. x i)-`(X i) \<inter> space borel) \<inter> space borel"
       unfolding I_def by auto
     also have "... \<in> sets borel"
       using that \<open>finite I\<close> by measurable
     finally show ?thesis by simp
   qed
   then have "{(\<Pi>\<^sub>E i\<in>UNIV. X i) |X::('a \<Rightarrow> 'b set). (\<forall>i. X i \<in> sets borel) \<and> finite {i. X i \<noteq> space borel}} \<subseteq> sets borel"
     by auto
   then show ?thesis unfolding sets_PiM_finite space_borel
     by (simp add: * sets.sigma_sets_subset')
 qed
 
 proposition sets_PiM_equal_borel:
   "sets (Pi\<^sub>M UNIV (\<lambda>i::('a::countable). borel::('b::second_countable_topology measure))) = sets borel"
 proof
   obtain K::"('a \<Rightarrow> 'b) set set" where K: "topological_basis K" "countable K"
             "\<And>k. k \<in> K \<Longrightarrow> \<exists>X. (k = Pi\<^sub>E UNIV X) \<and> (\<forall>i. open (X i)) \<and> finite {i. X i \<noteq> UNIV}"
     using product_topology_countable_basis by fast
   have *: "k \<in> sets (Pi\<^sub>M UNIV (\<lambda>_. borel))" if "k \<in> K" for k
   proof -
     obtain X where H: "k = Pi\<^sub>E UNIV X" "\<And>i. open (X i)" "finite {i. X i \<noteq> UNIV}"
       using K(3)[OF \<open>k \<in> K\<close>] by blast
     show ?thesis unfolding H(1) sets_PiM_finite space_borel using borel_open[OF H(2)] H(3) by auto
   qed
   have **: "U \<in> sets (Pi\<^sub>M UNIV (\<lambda>_. borel))" if "open U" for U::"('a \<Rightarrow> 'b) set"
   proof -
     obtain B where "B \<subseteq> K" "U = (\<Union>B)"
       using \<open>open U\<close> \<open>topological_basis K\<close> by (metis topological_basis_def)
     have "countable B" using \<open>B \<subseteq> K\<close> \<open>countable K\<close> countable_subset by blast
     moreover have "k \<in> sets (Pi\<^sub>M UNIV (\<lambda>_. borel))" if "k \<in> B" for k
       using \<open>B \<subseteq> K\<close> * that by auto
     ultimately show ?thesis unfolding \<open>U = (\<Union>B)\<close> by auto
   qed
   have "sigma_sets UNIV (Collect open) \<subseteq> sets (Pi\<^sub>M UNIV (\<lambda>i::'a. (borel::('b measure))))"
     apply (rule sets.sigma_sets_subset') using ** by auto
   then show "sets (borel::('a \<Rightarrow> 'b) measure) \<subseteq> sets (Pi\<^sub>M UNIV (\<lambda>_. borel))"
     unfolding borel_def by auto
 qed (simp add: sets_PiM_subset_borel)
 
 lemma measurable_coordinatewise_then_product:
   fixes f::"'a \<Rightarrow> ('b::countable) \<Rightarrow> ('c::second_countable_topology)"
   assumes [measurable]: "\<And>i. (\<lambda>x. f x i) \<in> borel_measurable M"
   shows "f \<in> borel_measurable M"
 proof -
   have "f \<in> measurable M (Pi\<^sub>M UNIV (\<lambda>_. borel))"
     by (rule measurable_PiM_single', auto simp add: assms)
   then show ?thesis using sets_PiM_equal_borel measurable_cong_sets by blast
 qed
 
 
 end
diff --git a/src/HOL/Analysis/Gamma_Function.thy b/src/HOL/Analysis/Gamma_Function.thy
--- a/src/HOL/Analysis/Gamma_Function.thy
+++ b/src/HOL/Analysis/Gamma_Function.thy
@@ -1,3542 +1,3556 @@
 (*  Title:    HOL/Analysis/Gamma_Function.thy
     Author:   Manuel Eberl, TU München
 *)
 
 section \<open>The Gamma Function\<close>
 
 theory Gamma_Function
   imports
   Equivalence_Lebesgue_Henstock_Integration
   Summation_Tests
   Harmonic_Numbers
   "HOL-Library.Nonpos_Ints"
   "HOL-Library.Periodic_Fun"
 begin
 
 text \<open>
   Several equivalent definitions of the Gamma function and its
   most important properties. Also contains the definition and some properties
   of the log-Gamma function and the Digamma function and the other Polygamma functions.
 
   Based on the Gamma function, we also prove the Weierstra{\ss} product form of the
   sin function and, based on this, the solution of the Basel problem (the
   sum over all \<^term>\<open>1 / (n::nat)^2\<close>.
 \<close>
 
 lemma pochhammer_eq_0_imp_nonpos_Int:
   "pochhammer (x::'a::field_char_0) n = 0 \<Longrightarrow> x \<in> \<int>\<^sub>\<le>\<^sub>0"
   by (auto simp: pochhammer_eq_0_iff)
 
 lemma closed_nonpos_Ints [simp]: "closed (\<int>\<^sub>\<le>\<^sub>0 :: 'a :: real_normed_algebra_1 set)"
 proof -
   have "\<int>\<^sub>\<le>\<^sub>0 = (of_int ` {n. n \<le> 0} :: 'a set)"
     by (auto elim!: nonpos_Ints_cases intro!: nonpos_Ints_of_int)
   also have "closed \<dots>" by (rule closed_of_int_image)
   finally show ?thesis .
 qed
 
 lemma plus_one_in_nonpos_Ints_imp: "z + 1 \<in> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> z \<in> \<int>\<^sub>\<le>\<^sub>0"
   using nonpos_Ints_diff_Nats[of "z+1" "1"] by simp_all
 
 lemma of_int_in_nonpos_Ints_iff:
   "(of_int n :: 'a :: ring_char_0) \<in> \<int>\<^sub>\<le>\<^sub>0 \<longleftrightarrow> n \<le> 0"
   by (auto simp: nonpos_Ints_def)
 
 lemma one_plus_of_int_in_nonpos_Ints_iff:
   "(1 + of_int n :: 'a :: ring_char_0) \<in> \<int>\<^sub>\<le>\<^sub>0 \<longleftrightarrow> n \<le> -1"
 proof -
   have "1 + of_int n = (of_int (n + 1) :: 'a)" by simp
   also have "\<dots> \<in> \<int>\<^sub>\<le>\<^sub>0 \<longleftrightarrow> n + 1 \<le> 0" by (subst of_int_in_nonpos_Ints_iff) simp_all
   also have "\<dots> \<longleftrightarrow> n \<le> -1" by presburger
   finally show ?thesis .
 qed
 
 lemma one_minus_of_nat_in_nonpos_Ints_iff:
   "(1 - of_nat n :: 'a :: ring_char_0) \<in> \<int>\<^sub>\<le>\<^sub>0 \<longleftrightarrow> n > 0"
 proof -
   have "(1 - of_nat n :: 'a) = of_int (1 - int n)" by simp
   also have "\<dots> \<in> \<int>\<^sub>\<le>\<^sub>0 \<longleftrightarrow> n > 0" by (subst of_int_in_nonpos_Ints_iff) presburger
   finally show ?thesis .
 qed
 
 lemma fraction_not_in_ints:
   assumes "\<not>(n dvd m)" "n \<noteq> 0"
   shows   "of_int m / of_int n \<notin> (\<int> :: 'a :: {division_ring,ring_char_0} set)"
 proof
   assume "of_int m / (of_int n :: 'a) \<in> \<int>"
   then obtain k where "of_int m / of_int n = (of_int k :: 'a)" by (elim Ints_cases)
   with assms have "of_int m = (of_int (k * n) :: 'a)" by (auto simp add: field_split_simps)
   hence "m = k * n" by (subst (asm) of_int_eq_iff)
   hence "n dvd m" by simp
   with assms(1) show False by contradiction
 qed
 
 lemma fraction_not_in_nats:
   assumes "\<not>n dvd m" "n \<noteq> 0"
   shows   "of_int m / of_int n \<notin> (\<nat> :: 'a :: {division_ring,ring_char_0} set)"
 proof
   assume "of_int m / of_int n \<in> (\<nat> :: 'a set)"
   also note Nats_subset_Ints
   finally have "of_int m / of_int n \<in> (\<int> :: 'a set)" .
   moreover have "of_int m / of_int n \<notin> (\<int> :: 'a set)"
     using assms by (intro fraction_not_in_ints)
   ultimately show False by contradiction
 qed
 
 lemma not_in_Ints_imp_not_in_nonpos_Ints: "z \<notin> \<int> \<Longrightarrow> z \<notin> \<int>\<^sub>\<le>\<^sub>0"
   by (auto simp: Ints_def nonpos_Ints_def)
 
 lemma double_in_nonpos_Ints_imp:
   assumes "2 * (z :: 'a :: field_char_0) \<in> \<int>\<^sub>\<le>\<^sub>0"
   shows   "z \<in> \<int>\<^sub>\<le>\<^sub>0 \<or> z + 1/2 \<in> \<int>\<^sub>\<le>\<^sub>0"
 proof-
   from assms obtain k where k: "2 * z = - of_nat k" by (elim nonpos_Ints_cases')
   thus ?thesis by (cases "even k") (auto elim!: evenE oddE simp: field_simps)
 qed
 
 
 lemma sin_series: "(\<lambda>n. ((-1)^n / fact (2*n+1)) *\<^sub>R z^(2*n+1)) sums sin z"
 proof -
   from sin_converges[of z] have "(\<lambda>n. sin_coeff n *\<^sub>R z^n) sums sin z" .
   also have "(\<lambda>n. sin_coeff n *\<^sub>R z^n) sums sin z \<longleftrightarrow>
                  (\<lambda>n. ((-1)^n / fact (2*n+1)) *\<^sub>R z^(2*n+1)) sums sin z"
     by (subst sums_mono_reindex[of "\<lambda>n. 2*n+1", symmetric])
        (auto simp: sin_coeff_def strict_mono_def ac_simps elim!: oddE)
   finally show ?thesis .
 qed
 
 lemma cos_series: "(\<lambda>n. ((-1)^n / fact (2*n)) *\<^sub>R z^(2*n)) sums cos z"
 proof -
   from cos_converges[of z] have "(\<lambda>n. cos_coeff n *\<^sub>R z^n) sums cos z" .
   also have "(\<lambda>n. cos_coeff n *\<^sub>R z^n) sums cos z \<longleftrightarrow>
                  (\<lambda>n. ((-1)^n / fact (2*n)) *\<^sub>R z^(2*n)) sums cos z"
     by (subst sums_mono_reindex[of "\<lambda>n. 2*n", symmetric])
        (auto simp: cos_coeff_def strict_mono_def ac_simps elim!: evenE)
   finally show ?thesis .
 qed
 
 lemma sin_z_over_z_series:
   fixes z :: "'a :: {real_normed_field,banach}"
   assumes "z \<noteq> 0"
   shows   "(\<lambda>n. (-1)^n / fact (2*n+1) * z^(2*n)) sums (sin z / z)"
 proof -
   from sin_series[of z] have "(\<lambda>n. z * ((-1)^n / fact (2*n+1)) * z^(2*n)) sums sin z"
     by (simp add: field_simps scaleR_conv_of_real)
   from sums_mult[OF this, of "inverse z"] and assms show ?thesis
     by (simp add: field_simps)
 qed
 
 lemma sin_z_over_z_series':
   fixes z :: "'a :: {real_normed_field,banach}"
   assumes "z \<noteq> 0"
   shows   "(\<lambda>n. sin_coeff (n+1) *\<^sub>R z^n) sums (sin z / z)"
 proof -
   from sums_split_initial_segment[OF sin_converges[of z], of 1]
     have "(\<lambda>n. z * (sin_coeff (n+1) *\<^sub>R z ^ n)) sums sin z" by simp
   from sums_mult[OF this, of "inverse z"] assms show ?thesis by (simp add: field_simps)
 qed
 
 lemma has_field_derivative_sin_z_over_z:
   fixes A :: "'a :: {real_normed_field,banach} set"
   shows "((\<lambda>z. if z = 0 then 1 else sin z / z) has_field_derivative 0) (at 0 within A)"
       (is "(?f has_field_derivative ?f') _")
 proof (rule has_field_derivative_at_within)
   have "((\<lambda>z::'a. \<Sum>n. of_real (sin_coeff (n+1)) * z^n)
             has_field_derivative (\<Sum>n. diffs (\<lambda>n. of_real (sin_coeff (n+1))) n * 0^n)) (at 0)"
   proof (rule termdiffs_strong)
     from summable_ignore_initial_segment[OF sums_summable[OF sin_converges[of "1::'a"]], of 1]
       show "summable (\<lambda>n. of_real (sin_coeff (n+1)) * (1::'a)^n)" by (simp add: of_real_def)
   qed simp
   also have "(\<lambda>z::'a. \<Sum>n. of_real (sin_coeff (n+1)) * z^n) = ?f"
   proof
     fix z
     show "(\<Sum>n. of_real (sin_coeff (n+1)) * z^n)  = ?f z"
       by (cases "z = 0") (insert sin_z_over_z_series'[of z],
             simp_all add: scaleR_conv_of_real sums_iff sin_coeff_def)
   qed
   also have "(\<Sum>n. diffs (\<lambda>n. of_real (sin_coeff (n + 1))) n * (0::'a) ^ n) =
                  diffs (\<lambda>n. of_real (sin_coeff (Suc n))) 0" by simp
   also have "\<dots> = 0" by (simp add: sin_coeff_def diffs_def)
   finally show "((\<lambda>z::'a. if z = 0 then 1 else sin z / z) has_field_derivative 0) (at 0)" .
 qed
 
 lemma round_Re_minimises_norm:
   "norm ((z::complex) - of_int m) \<ge> norm (z - of_int (round (Re z)))"
 proof -
   let ?n = "round (Re z)"
   have "norm (z - of_int ?n) = sqrt ((Re z - of_int ?n)\<^sup>2 + (Im z)\<^sup>2)"
     by (simp add: cmod_def)
   also have "\<bar>Re z - of_int ?n\<bar> \<le> \<bar>Re z - of_int m\<bar>" by (rule round_diff_minimal)
   hence "sqrt ((Re z - of_int ?n)\<^sup>2 + (Im z)\<^sup>2) \<le> sqrt ((Re z - of_int m)\<^sup>2 + (Im z)\<^sup>2)"
     by (intro real_sqrt_le_mono add_mono) (simp_all add: abs_le_square_iff)
   also have "\<dots> = norm (z - of_int m)" by (simp add: cmod_def)
   finally show ?thesis .
 qed
 
 lemma Re_pos_in_ball:
   assumes "Re z > 0" "t \<in> ball z (Re z/2)"
   shows   "Re t > 0"
 proof -
   have "Re (z - t) \<le> norm (z - t)" by (rule complex_Re_le_cmod)
   also from assms have "\<dots> < Re z / 2" by (simp add: dist_complex_def)
   finally show "Re t > 0" using assms by simp
 qed
 
 lemma no_nonpos_Int_in_ball_complex:
   assumes "Re z > 0" "t \<in> ball z (Re z/2)"
   shows   "t \<notin> \<int>\<^sub>\<le>\<^sub>0"
   using Re_pos_in_ball[OF assms] by (force elim!: nonpos_Ints_cases)
 
 lemma no_nonpos_Int_in_ball:
   assumes "t \<in> ball z (dist z (round (Re z)))"
   shows   "t \<notin> \<int>\<^sub>\<le>\<^sub>0"
 proof
   assume "t \<in> \<int>\<^sub>\<le>\<^sub>0"
   then obtain n where "t = of_int n" by (auto elim!: nonpos_Ints_cases)
   have "dist z (of_int n) \<le> dist z t + dist t (of_int n)" by (rule dist_triangle)
   also from assms have "dist z t < dist z (round (Re z))" by simp
   also have "\<dots> \<le> dist z (of_int n)"
     using round_Re_minimises_norm[of z] by (simp add: dist_complex_def)
   finally have "dist t (of_int n) > 0" by simp
   with \<open>t = of_int n\<close> show False by simp
 qed
 
 lemma no_nonpos_Int_in_ball':
   assumes "(z :: 'a :: {euclidean_space,real_normed_algebra_1}) \<notin> \<int>\<^sub>\<le>\<^sub>0"
   obtains d where "d > 0" "\<And>t. t \<in> ball z d \<Longrightarrow> t \<notin> \<int>\<^sub>\<le>\<^sub>0"
 proof (rule that)
   from assms show "setdist {z} \<int>\<^sub>\<le>\<^sub>0 > 0" by (subst setdist_gt_0_compact_closed) auto
 next
   fix t assume "t \<in> ball z (setdist {z} \<int>\<^sub>\<le>\<^sub>0)"
   thus "t \<notin> \<int>\<^sub>\<le>\<^sub>0" using setdist_le_dist[of z "{z}" t "\<int>\<^sub>\<le>\<^sub>0"] by force
 qed
 
 lemma no_nonpos_Real_in_ball:
   assumes z: "z \<notin> \<real>\<^sub>\<le>\<^sub>0" and t: "t \<in> ball z (if Im z = 0 then Re z / 2 else abs (Im z) / 2)"
   shows   "t \<notin> \<real>\<^sub>\<le>\<^sub>0"
 using z
 proof (cases "Im z = 0")
   assume A: "Im z = 0"
   with z have "Re z > 0" by (force simp add: complex_nonpos_Reals_iff)
   with t A Re_pos_in_ball[of z t] show ?thesis by (force simp add: complex_nonpos_Reals_iff)
 next
   assume A: "Im z \<noteq> 0"
   have "abs (Im z) - abs (Im t) \<le> abs (Im z - Im t)" by linarith
   also have "\<dots> = abs (Im (z - t))" by simp
   also have "\<dots> \<le> norm (z - t)" by (rule abs_Im_le_cmod)
   also from A t have "\<dots> \<le> abs (Im z) / 2" by (simp add: dist_complex_def)
   finally have "abs (Im t) > 0" using A by simp
   thus ?thesis by (force simp add: complex_nonpos_Reals_iff)
 qed
 
 
 subsection \<open>The Euler form and the logarithmic Gamma function\<close>
 
 text \<open>
   We define the Gamma function by first defining its multiplicative inverse \<open>rGamma\<close>.
   This is more convenient because \<open>rGamma\<close> is entire, which makes proofs of its
   properties more convenient because one does not have to watch out for discontinuities.
   (e.g. \<open>rGamma\<close> fulfils \<open>rGamma z = z * rGamma (z + 1)\<close> everywhere, whereas the \<open>\<Gamma>\<close> function
   does not fulfil the analogous equation on the non-positive integers)
 
   We define the \<open>\<Gamma>\<close> function (resp.\ its reciprocale) in the Euler form. This form has the advantage
   that it is a relatively simple limit that converges everywhere. The limit at the poles is 0
   (due to division by 0). The functional equation \<open>Gamma (z + 1) = z * Gamma z\<close> follows
   immediately from the definition.
 \<close>
 
 definition\<^marker>\<open>tag important\<close> Gamma_series :: "('a :: {banach,real_normed_field}) \<Rightarrow> nat \<Rightarrow> 'a" where
   "Gamma_series z n = fact n * exp (z * of_real (ln (of_nat n))) / pochhammer z (n+1)"
 
 definition Gamma_series' :: "('a :: {banach,real_normed_field}) \<Rightarrow> nat \<Rightarrow> 'a" where
   "Gamma_series' z n = fact (n - 1) * exp (z * of_real (ln (of_nat n))) / pochhammer z n"
 
 definition rGamma_series :: "('a :: {banach,real_normed_field}) \<Rightarrow> nat \<Rightarrow> 'a" where
   "rGamma_series z n = pochhammer z (n+1) / (fact n * exp (z * of_real (ln (of_nat n))))"
 
 lemma Gamma_series_altdef: "Gamma_series z n = inverse (rGamma_series z n)"
   and rGamma_series_altdef: "rGamma_series z n = inverse (Gamma_series z n)"
   unfolding Gamma_series_def rGamma_series_def by simp_all
 
 lemma rGamma_series_minus_of_nat:
   "eventually (\<lambda>n. rGamma_series (- of_nat k) n = 0) sequentially"
   using eventually_ge_at_top[of k]
   by eventually_elim (auto simp: rGamma_series_def pochhammer_of_nat_eq_0_iff)
 
 lemma Gamma_series_minus_of_nat:
   "eventually (\<lambda>n. Gamma_series (- of_nat k) n = 0) sequentially"
   using eventually_ge_at_top[of k]
   by eventually_elim (auto simp: Gamma_series_def pochhammer_of_nat_eq_0_iff)
 
 lemma Gamma_series'_minus_of_nat:
   "eventually (\<lambda>n. Gamma_series' (- of_nat k) n = 0) sequentially"
   using eventually_gt_at_top[of k]
   by eventually_elim (auto simp: Gamma_series'_def pochhammer_of_nat_eq_0_iff)
 
 lemma rGamma_series_nonpos_Ints_LIMSEQ: "z \<in> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> rGamma_series z \<longlonglongrightarrow> 0"
   by (elim nonpos_Ints_cases', hypsubst, subst tendsto_cong, rule rGamma_series_minus_of_nat, simp)
 
 lemma Gamma_series_nonpos_Ints_LIMSEQ: "z \<in> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> Gamma_series z \<longlonglongrightarrow> 0"
   by (elim nonpos_Ints_cases', hypsubst, subst tendsto_cong, rule Gamma_series_minus_of_nat, simp)
 
 lemma Gamma_series'_nonpos_Ints_LIMSEQ: "z \<in> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> Gamma_series' z \<longlonglongrightarrow> 0"
   by (elim nonpos_Ints_cases', hypsubst, subst tendsto_cong, rule Gamma_series'_minus_of_nat, simp)
 
 lemma Gamma_series_Gamma_series':
   assumes z: "z \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "(\<lambda>n. Gamma_series' z n / Gamma_series z n) \<longlonglongrightarrow> 1"
 proof (rule Lim_transform_eventually)
   from eventually_gt_at_top[of "0::nat"]
     show "eventually (\<lambda>n. z / of_nat n + 1 = Gamma_series' z n / Gamma_series z n) sequentially"
   proof eventually_elim
     fix n :: nat assume n: "n > 0"
     from n z have "Gamma_series' z n / Gamma_series z n = (z + of_nat n) / of_nat n"
       by (cases n, simp)
          (auto simp add: Gamma_series_def Gamma_series'_def pochhammer_rec'
                dest: pochhammer_eq_0_imp_nonpos_Int plus_of_nat_eq_0_imp)
     also from n have "\<dots> = z / of_nat n + 1" by (simp add: field_split_simps)
     finally show "z / of_nat n + 1 = Gamma_series' z n / Gamma_series z n" ..
   qed
   have "(\<lambda>x. z / of_nat x) \<longlonglongrightarrow> 0"
     by (rule tendsto_norm_zero_cancel)
        (insert tendsto_mult[OF tendsto_const[of "norm z"] lim_inverse_n],
         simp add:  norm_divide inverse_eq_divide)
   from tendsto_add[OF this tendsto_const[of 1]] show "(\<lambda>n. z / of_nat n + 1) \<longlonglongrightarrow> 1" by simp
 qed
 
 text \<open>
   We now show that the series that defines the \<open>\<Gamma>\<close> function in the Euler form converges
   and that the function defined by it is continuous on the complex halfspace with positive
   real part.
 
   We do this by showing that the logarithm of the Euler series is continuous and converges
   locally uniformly, which means that the log-Gamma function defined by its limit is also
   continuous.
 
   This will later allow us to lift holomorphicity and continuity from the log-Gamma
   function to the inverse of the Gamma function, and from that to the Gamma function itself.
 \<close>
 
 definition\<^marker>\<open>tag important\<close> ln_Gamma_series :: "('a :: {banach,real_normed_field,ln}) \<Rightarrow> nat \<Rightarrow> 'a" where
   "ln_Gamma_series z n = z * ln (of_nat n) - ln z - (\<Sum>k=1..n. ln (z / of_nat k + 1))"
 
 definition\<^marker>\<open>tag unimportant\<close> ln_Gamma_series' :: "('a :: {banach,real_normed_field,ln}) \<Rightarrow> nat \<Rightarrow> 'a" where
   "ln_Gamma_series' z n =
      - euler_mascheroni*z - ln z + (\<Sum>k=1..n. z / of_nat n - ln (z / of_nat k + 1))"
 
 definition ln_Gamma :: "('a :: {banach,real_normed_field,ln}) \<Rightarrow> 'a" where
   "ln_Gamma z = lim (ln_Gamma_series z)"
 
 
 text \<open>
   We now show that the log-Gamma series converges locally uniformly for all complex numbers except
   the non-positive integers. We do this by proving that the series is locally Cauchy.
 \<close>
 
 context
 begin
 
 private lemma ln_Gamma_series_complex_converges_aux:
   fixes z :: complex and k :: nat
   assumes z: "z \<noteq> 0" and k: "of_nat k \<ge> 2*norm z" "k \<ge> 2"
   shows "norm (z * ln (1 - 1/of_nat k) + ln (z/of_nat k + 1)) \<le> 2*(norm z + norm z^2) / of_nat k^2"
 proof -
   let ?k = "of_nat k :: complex" and ?z = "norm z"
   have "z *ln (1 - 1/?k) + ln (z/?k+1) = z*(ln (1 - 1/?k :: complex) + 1/?k) + (ln (1+z/?k) - z/?k)"
     by (simp add: algebra_simps)
   also have "norm ... \<le> ?z * norm (ln (1-1/?k) + 1/?k :: complex) + norm (ln (1+z/?k) - z/?k)"
     by (subst norm_mult [symmetric], rule norm_triangle_ineq)
   also have "norm (Ln (1 + -1/?k) - (-1/?k)) \<le> (norm (-1/?k))\<^sup>2 / (1 - norm(-1/?k))"
     using k by (intro Ln_approx_linear) (simp add: norm_divide)
   hence "?z * norm (ln (1-1/?k) + 1/?k) \<le> ?z * ((norm (1/?k))^2 / (1 - norm (1/?k)))"
     by (intro mult_left_mono) simp_all
   also have "... \<le> (?z * (of_nat k / (of_nat k - 1))) / of_nat k^2" using k
     by (simp add: field_simps power2_eq_square norm_divide)
   also have "... \<le> (?z * 2) / of_nat k^2" using k
     by (intro divide_right_mono mult_left_mono) (simp_all add: field_simps)
   also have "norm (ln (1+z/?k) - z/?k) \<le> norm (z/?k)^2 / (1 - norm (z/?k))" using k
     by (intro Ln_approx_linear) (simp add: norm_divide)
   hence "norm (ln (1+z/?k) - z/?k) \<le> ?z^2 / of_nat k^2 / (1 - ?z / of_nat k)"
     by (simp add: field_simps norm_divide)
   also have "... \<le> (?z^2 * (of_nat k / (of_nat k - ?z))) / of_nat k^2" using k
     by (simp add: field_simps power2_eq_square)
   also have "... \<le> (?z^2 * 2) / of_nat k^2" using k
     by (intro divide_right_mono mult_left_mono) (simp_all add: field_simps)
   also note add_divide_distrib [symmetric]
   finally show ?thesis by (simp only: distrib_left mult.commute)
 qed
 
 lemma ln_Gamma_series_complex_converges:
   assumes z: "z \<notin> \<int>\<^sub>\<le>\<^sub>0"
   assumes d: "d > 0" "\<And>n. n \<in> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> norm (z - of_int n) > d"
   shows "uniformly_convergent_on (ball z d) (\<lambda>n z. ln_Gamma_series z n :: complex)"
 proof (intro Cauchy_uniformly_convergent uniformly_Cauchy_onI')
   fix e :: real assume e: "e > 0"
   define e'' where "e'' = (SUP t\<in>ball z d. norm t + norm t^2)"
   define e' where "e' = e / (2*e'')"
   have "bounded ((\<lambda>t. norm t + norm t^2) ` cball z d)"
     by (intro compact_imp_bounded compact_continuous_image) (auto intro!: continuous_intros)
   hence "bounded ((\<lambda>t. norm t + norm t^2) ` ball z d)" by (rule bounded_subset) auto
   hence bdd: "bdd_above ((\<lambda>t. norm t + norm t^2) ` ball z d)" by (rule bounded_imp_bdd_above)
 
   with z d(1) d(2)[of "-1"] have e''_pos: "e'' > 0" unfolding e''_def
     by (subst less_cSUP_iff) (auto intro!: add_pos_nonneg bexI[of _ z])
   have e'': "norm t + norm t^2 \<le> e''" if "t \<in> ball z d" for t unfolding e''_def using that
     by (rule cSUP_upper[OF _ bdd])
   from e z e''_pos have e': "e' > 0" unfolding e'_def
     by (intro divide_pos_pos mult_pos_pos add_pos_pos) (simp_all add: field_simps)
 
   have "summable (\<lambda>k. inverse ((real_of_nat k)^2))"
     by (rule inverse_power_summable) simp
-  from summable_partial_sum_bound[OF this e'] guess M . note M = this
+  from summable_partial_sum_bound[OF this e']
+  obtain M where M: "\<And>m n. M \<le> m \<Longrightarrow> norm (\<Sum>k = m..n. inverse ((real k)\<^sup>2)) < e'"
+    by auto
 
   define N where "N = max 2 (max (nat \<lceil>2 * (norm z + d)\<rceil>) M)"
   {
     from d have "\<lceil>2 * (cmod z + d)\<rceil> \<ge> \<lceil>0::real\<rceil>"
       by (intro ceiling_mono mult_nonneg_nonneg add_nonneg_nonneg) simp_all
     hence "2 * (norm z + d) \<le> of_nat (nat \<lceil>2 * (norm z + d)\<rceil>)" unfolding N_def
       by (simp_all)
     also have "... \<le> of_nat N" unfolding N_def
       by (subst of_nat_le_iff) (rule max.coboundedI2, rule max.cobounded1)
     finally have "of_nat N \<ge> 2 * (norm z + d)" .
     moreover have "N \<ge> 2" "N \<ge> M" unfolding N_def by simp_all
     moreover have "(\<Sum>k=m..n. 1/(of_nat k)\<^sup>2) < e'" if "m \<ge> N" for m n
       using M[OF order.trans[OF \<open>N \<ge> M\<close> that]] unfolding real_norm_def
       by (subst (asm) abs_of_nonneg) (auto intro: sum_nonneg simp: field_split_simps)
     moreover note calculation
   } note N = this
 
   show "\<exists>M. \<forall>t\<in>ball z d. \<forall>m\<ge>M. \<forall>n>m. dist (ln_Gamma_series t m) (ln_Gamma_series t n) < e"
     unfolding dist_complex_def
   proof (intro exI[of _ N] ballI allI impI)
     fix t m n assume t: "t \<in> ball z d" and mn: "m \<ge> N" "n > m"
     from d(2)[of 0] t have "0 < dist z 0 - dist z t" by (simp add: field_simps dist_complex_def)
     also have "dist z 0 - dist z t \<le> dist 0 t" using dist_triangle[of 0 z t]
       by (simp add: dist_commute)
     finally have t_nz: "t \<noteq> 0" by auto
 
     have "norm t \<le> norm z + norm (t - z)" by (rule norm_triangle_sub)
     also from t have "norm (t - z) < d" by (simp add: dist_complex_def norm_minus_commute)
     also have "2 * (norm z + d) \<le> of_nat N" by (rule N)
     also have "N \<le> m" by (rule mn)
     finally have norm_t: "2 * norm t < of_nat m" by simp
 
     have "ln_Gamma_series t m - ln_Gamma_series t n =
               (-(t * Ln (of_nat n)) - (-(t * Ln (of_nat m)))) +
               ((\<Sum>k=1..n. Ln (t / of_nat k + 1)) - (\<Sum>k=1..m. Ln (t / of_nat k + 1)))"
       by (simp add: ln_Gamma_series_def algebra_simps)
     also have "(\<Sum>k=1..n. Ln (t / of_nat k + 1)) - (\<Sum>k=1..m. Ln (t / of_nat k + 1)) =
                  (\<Sum>k\<in>{1..n}-{1..m}. Ln (t / of_nat k + 1))" using mn
       by (simp add: sum_diff)
     also from mn have "{1..n}-{1..m} = {Suc m..n}" by fastforce
     also have "-(t * Ln (of_nat n)) - (-(t * Ln (of_nat m))) =
                    (\<Sum>k = Suc m..n. t * Ln (of_nat (k - 1)) - t * Ln (of_nat k))" using mn
       by (subst sum_telescope'' [symmetric]) simp_all
     also have "... = (\<Sum>k = Suc m..n. t * Ln (of_nat (k - 1) / of_nat k))" using mn N
       by (intro sum_cong_Suc)
          (simp_all del: of_nat_Suc add: field_simps Ln_of_nat Ln_of_nat_over_of_nat)
     also have "of_nat (k - 1) / of_nat k = 1 - 1 / (of_nat k :: complex)" if "k \<in> {Suc m..n}" for k
       using that of_nat_eq_0_iff[of "Suc i" for i] by (cases k) (simp_all add: field_split_simps)
     hence "(\<Sum>k = Suc m..n. t * Ln (of_nat (k - 1) / of_nat k)) =
              (\<Sum>k = Suc m..n. t * Ln (1 - 1 / of_nat k))" using mn N
       by (intro sum.cong) simp_all
     also note sum.distrib [symmetric]
     also have "norm (\<Sum>k=Suc m..n. t * Ln (1 - 1/of_nat k) + Ln (t/of_nat k + 1)) \<le>
       (\<Sum>k=Suc m..n. 2 * (norm t + (norm t)\<^sup>2) / (real_of_nat k)\<^sup>2)" using t_nz N(2) mn norm_t
       by (intro order.trans[OF norm_sum sum_mono[OF ln_Gamma_series_complex_converges_aux]]) simp_all
     also have "... \<le> 2 * (norm t + norm t^2) * (\<Sum>k=Suc m..n. 1 / (of_nat k)\<^sup>2)"
       by (simp add: sum_distrib_left)
     also have "... < 2 * (norm t + norm t^2) * e'" using mn z t_nz
       by (intro mult_strict_left_mono N mult_pos_pos add_pos_pos) simp_all
     also from e''_pos have "... = e * ((cmod t + (cmod t)\<^sup>2) / e'')"
       by (simp add: e'_def field_simps power2_eq_square)
     also from e''[OF t] e''_pos e
       have "\<dots> \<le> e * 1" by (intro mult_left_mono) (simp_all add: field_simps)
     finally show "norm (ln_Gamma_series t m - ln_Gamma_series t n) < e" by simp
   qed
 qed
 
 end
 
 lemma ln_Gamma_series_complex_converges':
   assumes z: "(z :: complex) \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows "\<exists>d>0. uniformly_convergent_on (ball z d) (\<lambda>n z. ln_Gamma_series z n)"
 proof -
   define d' where "d' = Re z"
   define d where "d = (if d' > 0 then d' / 2 else norm (z - of_int (round d')) / 2)"
   have "of_int (round d') \<in> \<int>\<^sub>\<le>\<^sub>0" if "d' \<le> 0" using that
     by (intro nonpos_Ints_of_int) (simp_all add: round_def)
   with assms have d_pos: "d > 0" unfolding d_def by (force simp: not_less)
 
   have "d < cmod (z - of_int n)" if "n \<in> \<int>\<^sub>\<le>\<^sub>0" for n
   proof (cases "Re z > 0")
     case True
     from nonpos_Ints_nonpos[OF that] have n: "n \<le> 0" by simp
     from True have "d = Re z/2" by (simp add: d_def d'_def)
     also from n True have "\<dots> < Re (z - of_int n)" by simp
     also have "\<dots> \<le> norm (z - of_int n)" by (rule complex_Re_le_cmod)
     finally show ?thesis .
   next
     case False
     with assms nonpos_Ints_of_int[of "round (Re z)"]
       have "z \<noteq> of_int (round d')" by (auto simp: not_less)
     with False have "d < norm (z - of_int (round d'))" by (simp add: d_def d'_def)
     also have "\<dots> \<le> norm (z - of_int n)" unfolding d'_def by (rule round_Re_minimises_norm)
     finally show ?thesis .
   qed
   hence conv: "uniformly_convergent_on (ball z d) (\<lambda>n z. ln_Gamma_series z n)"
     by (intro ln_Gamma_series_complex_converges d_pos z) simp_all
   from d_pos conv show ?thesis by blast
 qed
 
 lemma ln_Gamma_series_complex_converges'': "(z :: complex) \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> convergent (ln_Gamma_series z)"
   by (drule ln_Gamma_series_complex_converges') (auto intro: uniformly_convergent_imp_convergent)
 
 theorem ln_Gamma_complex_LIMSEQ: "(z :: complex) \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> ln_Gamma_series z \<longlonglongrightarrow> ln_Gamma z"
   using ln_Gamma_series_complex_converges'' by (simp add: convergent_LIMSEQ_iff ln_Gamma_def)
 
 lemma exp_ln_Gamma_series_complex:
   assumes "n > 0" "z \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "exp (ln_Gamma_series z n :: complex) = Gamma_series z n"
 proof -
   from assms obtain m where m: "n = Suc m" by (cases n) blast
   from assms have "z \<noteq> 0" by (intro notI) auto
   with assms have "exp (ln_Gamma_series z n) =
           (of_nat n) powr z / (z * (\<Prod>k=1..n. exp (Ln (z / of_nat k + 1))))"
     unfolding ln_Gamma_series_def powr_def by (simp add: exp_diff exp_sum)
   also from assms have "(\<Prod>k=1..n. exp (Ln (z / of_nat k + 1))) = (\<Prod>k=1..n. z / of_nat k + 1)"
     by (intro prod.cong[OF refl], subst exp_Ln) (auto simp: field_simps plus_of_nat_eq_0_imp)
   also have "... = (\<Prod>k=1..n. z + k) / fact n"
     by (simp add: fact_prod)
     (subst prod_dividef [symmetric], simp_all add: field_simps)
   also from m have "z * ... = (\<Prod>k=0..n. z + k) / fact n"
     by (simp add: prod.atLeast0_atMost_Suc_shift prod.atLeast_Suc_atMost_Suc_shift del: prod.cl_ivl_Suc)
   also have "(\<Prod>k=0..n. z + k) = pochhammer z (Suc n)"
     unfolding pochhammer_prod
     by (simp add: prod.atLeast0_atMost_Suc atLeastLessThanSuc_atLeastAtMost)
   also have "of_nat n powr z / (pochhammer z (Suc n) / fact n) = Gamma_series z n"
     unfolding Gamma_series_def using assms by (simp add: field_split_simps powr_def)
   finally show ?thesis .
 qed
 
 
 lemma ln_Gamma_series'_aux:
   assumes "(z::complex) \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "(\<lambda>k. z / of_nat (Suc k) - ln (1 + z / of_nat (Suc k))) sums
               (ln_Gamma z + euler_mascheroni * z + ln z)" (is "?f sums ?s")
 unfolding sums_def
 proof (rule Lim_transform)
   show "(\<lambda>n. ln_Gamma_series z n + of_real (harm n - ln (of_nat n)) * z + ln z) \<longlonglongrightarrow> ?s"
     (is "?g \<longlonglongrightarrow> _")
     by (intro tendsto_intros ln_Gamma_complex_LIMSEQ euler_mascheroni_LIMSEQ_of_real assms)
 
   have A: "eventually (\<lambda>n. (\<Sum>k<n. ?f k) - ?g n = 0) sequentially"
     using eventually_gt_at_top[of "0::nat"]
   proof eventually_elim
     fix n :: nat assume n: "n > 0"
     have "(\<Sum>k<n. ?f k) = (\<Sum>k=1..n. z / of_nat k - ln (1 + z / of_nat k))"
       by (subst atLeast0LessThan [symmetric], subst sum.shift_bounds_Suc_ivl [symmetric],
           subst atLeastLessThanSuc_atLeastAtMost) simp_all
     also have "\<dots> = z * of_real (harm n) - (\<Sum>k=1..n. ln (1 + z / of_nat k))"
       by (simp add: harm_def sum_subtractf sum_distrib_left divide_inverse)
     also from n have "\<dots> - ?g n = 0"
       by (simp add: ln_Gamma_series_def sum_subtractf algebra_simps)
     finally show "(\<Sum>k<n. ?f k) - ?g n = 0" .
   qed
   show "(\<lambda>n. (\<Sum>k<n. ?f k) - ?g n) \<longlonglongrightarrow> 0" by (subst tendsto_cong[OF A]) simp_all
 qed
 
 
 lemma uniformly_summable_deriv_ln_Gamma:
   assumes z: "(z :: 'a :: {real_normed_field,banach}) \<noteq> 0" and d: "d > 0" "d \<le> norm z/2"
   shows "uniformly_convergent_on (ball z d)
             (\<lambda>k z. \<Sum>i<k. inverse (of_nat (Suc i)) - inverse (z + of_nat (Suc i)))"
            (is "uniformly_convergent_on _ (\<lambda>k z. \<Sum>i<k. ?f i z)")
 proof (rule Weierstrass_m_test'_ev)
   {
     fix t assume t: "t \<in> ball z d"
     have "norm z = norm (t + (z - t))" by simp
     have "norm (t + (z - t)) \<le> norm t + norm (z - t)" by (rule norm_triangle_ineq)
     also from t d have "norm (z - t) < norm z / 2" by (simp add: dist_norm)
     finally have A: "norm t > norm z / 2" using z by (simp add: field_simps)
 
     have "norm t = norm (z + (t - z))" by simp
     also have "\<dots> \<le> norm z + norm (t - z)" by (rule norm_triangle_ineq)
     also from t d have "norm (t - z) \<le> norm z / 2" by (simp add: dist_norm norm_minus_commute)
     also from z have "\<dots> < norm z" by simp
     finally have B: "norm t < 2 * norm z" by simp
     note A B
   } note ball = this
 
   show "eventually (\<lambda>n. \<forall>t\<in>ball z d. norm (?f n t) \<le> 4 * norm z * inverse (of_nat (Suc n)^2)) sequentially"
     using eventually_gt_at_top apply eventually_elim
   proof safe
     fix t :: 'a assume t: "t \<in> ball z d"
     from z ball[OF t] have t_nz: "t \<noteq> 0" by auto
     fix n :: nat assume n: "n > nat \<lceil>4 * norm z\<rceil>"
     from ball[OF t] t_nz have "4 * norm z > 2 * norm t" by simp
     also from n have "\<dots>  < of_nat n" by linarith
     finally have n: "of_nat n > 2 * norm t" .
     hence "of_nat n > norm t" by simp
     hence t': "t \<noteq> -of_nat (Suc n)" by (intro notI) (simp del: of_nat_Suc)
 
     with t_nz have "?f n t = 1 / (of_nat (Suc n) * (1 + of_nat (Suc n)/t))"
       by (simp add: field_split_simps eq_neg_iff_add_eq_0 del: of_nat_Suc)
     also have "norm \<dots> = inverse (of_nat (Suc n)) * inverse (norm (of_nat (Suc n)/t + 1))"
       by (simp add: norm_divide norm_mult field_split_simps del: of_nat_Suc)
     also {
       from z t_nz ball[OF t] have "of_nat (Suc n) / (4 * norm z) \<le> of_nat (Suc n) / (2 * norm t)"
         by (intro divide_left_mono mult_pos_pos) simp_all
       also have "\<dots> < norm (of_nat (Suc n) / t) - norm (1 :: 'a)"
         using t_nz n by (simp add: field_simps norm_divide del: of_nat_Suc)
       also have "\<dots> \<le> norm (of_nat (Suc n)/t + 1)" by (rule norm_diff_ineq)
       finally have "inverse (norm (of_nat (Suc n)/t + 1)) \<le> 4 * norm z / of_nat (Suc n)"
         using z by (simp add: field_split_simps norm_divide mult_ac del: of_nat_Suc)
     }
     also have "inverse (real_of_nat (Suc n)) * (4 * norm z / real_of_nat (Suc n)) =
                  4 * norm z * inverse (of_nat (Suc n)^2)"
                  by (simp add: field_split_simps power2_eq_square del: of_nat_Suc)
     finally show "norm (?f n t) \<le> 4 * norm z * inverse (of_nat (Suc n)^2)"
       by (simp del: of_nat_Suc)
   qed
 next
   show "summable (\<lambda>n. 4 * norm z * inverse ((of_nat (Suc n))^2))"
     by (subst summable_Suc_iff) (simp add: summable_mult inverse_power_summable)
 qed
 
 
 subsection \<open>The Polygamma functions\<close>
 
 lemma summable_deriv_ln_Gamma:
   "z \<noteq> (0 :: 'a :: {real_normed_field,banach}) \<Longrightarrow>
      summable (\<lambda>n. inverse (of_nat (Suc n)) - inverse (z + of_nat (Suc n)))"
   unfolding summable_iff_convergent
   by (rule uniformly_convergent_imp_convergent,
       rule uniformly_summable_deriv_ln_Gamma[of z "norm z/2"]) simp_all
 
 definition\<^marker>\<open>tag important\<close> Polygamma :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a" where
   "Polygamma n z = (if n = 0 then
       (\<Sum>k. inverse (of_nat (Suc k)) - inverse (z + of_nat k)) - euler_mascheroni else
       (-1)^Suc n * fact n * (\<Sum>k. inverse ((z + of_nat k)^Suc n)))"
 
 abbreviation\<^marker>\<open>tag important\<close> Digamma :: "('a :: {real_normed_field,banach}) \<Rightarrow> 'a" where
   "Digamma \<equiv> Polygamma 0"
 
 lemma Digamma_def:
   "Digamma z = (\<Sum>k. inverse (of_nat (Suc k)) - inverse (z + of_nat k)) - euler_mascheroni"
   by (simp add: Polygamma_def)
 
 
 lemma summable_Digamma:
   assumes "(z :: 'a :: {real_normed_field,banach}) \<noteq> 0"
   shows   "summable (\<lambda>n. inverse (of_nat (Suc n)) - inverse (z + of_nat n))"
 proof -
   have sums: "(\<lambda>n. inverse (z + of_nat (Suc n)) - inverse (z + of_nat n)) sums
                        (0 - inverse (z + of_nat 0))"
     by (intro telescope_sums filterlim_compose[OF tendsto_inverse_0]
               tendsto_add_filterlim_at_infinity[OF tendsto_const] tendsto_of_nat)
   from summable_add[OF summable_deriv_ln_Gamma[OF assms] sums_summable[OF sums]]
     show "summable (\<lambda>n. inverse (of_nat (Suc n)) - inverse (z + of_nat n))" by simp
 qed
 
 lemma summable_offset:
   assumes "summable (\<lambda>n. f (n + k) :: 'a :: real_normed_vector)"
   shows   "summable f"
 proof -
   from assms have "convergent (\<lambda>m. \<Sum>n<m. f (n + k))"
     using summable_iff_convergent by blast
   hence "convergent (\<lambda>m. (\<Sum>n<k. f n) + (\<Sum>n<m. f (n + k)))"
     by (intro convergent_add convergent_const)
   also have "(\<lambda>m. (\<Sum>n<k. f n) + (\<Sum>n<m. f (n + k))) = (\<lambda>m. \<Sum>n<m+k. f n)"
   proof
     fix m :: nat
     have "{..<m+k} = {..<k} \<union> {k..<m+k}" by auto
     also have "(\<Sum>n\<in>\<dots>. f n) = (\<Sum>n<k. f n) + (\<Sum>n=k..<m+k. f n)"
       by (rule sum.union_disjoint) auto
     also have "(\<Sum>n=k..<m+k. f n) = (\<Sum>n=0..<m+k-k. f (n + k))"
       using sum.shift_bounds_nat_ivl [of f 0 k m] by simp
     finally show "(\<Sum>n<k. f n) + (\<Sum>n<m. f (n + k)) = (\<Sum>n<m+k. f n)" by (simp add: atLeast0LessThan)
   qed
   finally have "(\<lambda>a. sum f {..<a}) \<longlonglongrightarrow> lim (\<lambda>m. sum f {..<m + k})"
     by (auto simp: convergent_LIMSEQ_iff dest: LIMSEQ_offset)
   thus ?thesis by (auto simp: summable_iff_convergent convergent_def)
 qed
 
 lemma Polygamma_converges:
   fixes z :: "'a :: {real_normed_field,banach}"
   assumes z: "z \<noteq> 0" and n: "n \<ge> 2"
   shows "uniformly_convergent_on (ball z d) (\<lambda>k z. \<Sum>i<k. inverse ((z + of_nat i)^n))"
 proof (rule Weierstrass_m_test'_ev)
   define e where "e = (1 + d / norm z)"
   define m where "m = nat \<lceil>norm z * e\<rceil>"
   {
     fix t assume t: "t \<in> ball z d"
     have "norm t = norm (z + (t - z))" by simp
     also have "\<dots> \<le> norm z + norm (t - z)" by (rule norm_triangle_ineq)
     also from t have "norm (t - z) < d" by (simp add: dist_norm norm_minus_commute)
     finally have "norm t < norm z * e" using z by (simp add: divide_simps e_def)
   } note ball = this
 
   show "eventually (\<lambda>k. \<forall>t\<in>ball z d. norm (inverse ((t + of_nat k)^n)) \<le>
             inverse (of_nat (k - m)^n)) sequentially"
     using eventually_gt_at_top[of m] apply eventually_elim
   proof (intro ballI)
     fix k :: nat and t :: 'a assume k: "k > m" and t: "t \<in> ball z d"
     from k have "real_of_nat (k - m) = of_nat k - of_nat m" by (simp add: of_nat_diff)
     also have "\<dots> \<le> norm (of_nat k :: 'a) - norm z * e"
       unfolding m_def by (subst norm_of_nat) linarith
     also from ball[OF t] have "\<dots> \<le> norm (of_nat k :: 'a) - norm t" by simp
     also have "\<dots> \<le> norm (of_nat k + t)" by (rule norm_diff_ineq)
     finally have "inverse ((norm (t + of_nat k))^n) \<le> inverse (real_of_nat (k - m)^n)" using k n
       by (intro le_imp_inverse_le power_mono) (simp_all add: add_ac del: of_nat_Suc)
     thus "norm (inverse ((t + of_nat k)^n)) \<le> inverse (of_nat (k - m)^n)"
       by (simp add: norm_inverse norm_power power_inverse)
   qed
 
   have "summable (\<lambda>k. inverse ((real_of_nat k)^n))"
     using inverse_power_summable[of n] n by simp
   hence "summable (\<lambda>k. inverse ((real_of_nat (k + m - m))^n))" by simp
   thus "summable (\<lambda>k. inverse ((real_of_nat (k - m))^n))" by (rule summable_offset)
 qed
 
 lemma Polygamma_converges':
   fixes z :: "'a :: {real_normed_field,banach}"
   assumes z: "z \<noteq> 0" and n: "n \<ge> 2"
   shows "summable (\<lambda>k. inverse ((z + of_nat k)^n))"
   using uniformly_convergent_imp_convergent[OF Polygamma_converges[OF assms, of 1], of z]
   by (simp add: summable_iff_convergent)
 
 theorem Digamma_LIMSEQ:
   fixes z :: "'a :: {banach,real_normed_field}"
   assumes z: "z \<noteq> 0"
   shows   "(\<lambda>m. of_real (ln (real m)) - (\<Sum>n<m. inverse (z + of_nat n))) \<longlonglongrightarrow> Digamma z"
 proof -
   have "(\<lambda>n. of_real (ln (real n / (real (Suc n))))) \<longlonglongrightarrow> (of_real (ln 1) :: 'a)"
     by (intro tendsto_intros LIMSEQ_n_over_Suc_n) simp_all
   hence "(\<lambda>n. of_real (ln (real n / (real n + 1)))) \<longlonglongrightarrow> (0 :: 'a)" by (simp add: add_ac)
   hence lim: "(\<lambda>n. of_real (ln (real n)) - of_real (ln (real n + 1))) \<longlonglongrightarrow> (0::'a)"
   proof (rule Lim_transform_eventually)
     show "eventually (\<lambda>n. of_real (ln (real n / (real n + 1))) =
             of_real (ln (real n)) - (of_real (ln (real n + 1)) :: 'a)) at_top"
       using eventually_gt_at_top[of "0::nat"] by eventually_elim (simp add: ln_div)
   qed
 
   from summable_Digamma[OF z]
     have "(\<lambda>n. inverse (of_nat (n+1)) - inverse (z + of_nat n))
               sums (Digamma z + euler_mascheroni)"
     by (simp add: Digamma_def summable_sums)
   from sums_diff[OF this euler_mascheroni_sum]
     have "(\<lambda>n. of_real (ln (real (Suc n) + 1)) - of_real (ln (real n + 1)) - inverse (z + of_nat n))
             sums Digamma z" by (simp add: add_ac)
   hence "(\<lambda>m. (\<Sum>n<m. of_real (ln (real (Suc n) + 1)) - of_real (ln (real n + 1))) -
               (\<Sum>n<m. inverse (z + of_nat n))) \<longlonglongrightarrow> Digamma z"
     by (simp add: sums_def sum_subtractf)
   also have "(\<lambda>m. (\<Sum>n<m. of_real (ln (real (Suc n) + 1)) - of_real (ln (real n + 1)))) =
                  (\<lambda>m. of_real (ln (m + 1)) :: 'a)"
     by (subst sum_lessThan_telescope) simp_all
   finally show ?thesis by (rule Lim_transform) (insert lim, simp)
 qed
 
 theorem Polygamma_LIMSEQ:
   fixes z :: "'a :: {banach,real_normed_field}"
   assumes "z \<noteq> 0" and "n > 0"
   shows   "(\<lambda>k. inverse ((z + of_nat k)^Suc n)) sums ((-1) ^ Suc n * Polygamma n z / fact n)"
   using Polygamma_converges'[OF assms(1), of "Suc n"] assms(2)
   by (simp add: sums_iff Polygamma_def)
 
 theorem has_field_derivative_ln_Gamma_complex [derivative_intros]:
   fixes z :: complex
   assumes z: "z \<notin> \<real>\<^sub>\<le>\<^sub>0"
   shows   "(ln_Gamma has_field_derivative Digamma z) (at z)"
 proof -
   have not_nonpos_Int [simp]: "t \<notin> \<int>\<^sub>\<le>\<^sub>0" if "Re t > 0" for t
     using that by (auto elim!: nonpos_Ints_cases')
   from z have z': "z \<notin> \<int>\<^sub>\<le>\<^sub>0" and z'': "z \<noteq> 0" using nonpos_Ints_subset_nonpos_Reals nonpos_Reals_zero_I
      by blast+
   let ?f' = "\<lambda>z k. inverse (of_nat (Suc k)) - inverse (z + of_nat (Suc k))"
   let ?f = "\<lambda>z k. z / of_nat (Suc k) - ln (1 + z / of_nat (Suc k))" and ?F' = "\<lambda>z. \<Sum>n. ?f' z n"
   define d where "d = min (norm z/2) (if Im z = 0 then Re z / 2 else abs (Im z) / 2)"
   from z have d: "d > 0" "norm z/2 \<ge> d" by (auto simp add: complex_nonpos_Reals_iff d_def)
   have ball: "Im t = 0 \<longrightarrow> Re t > 0" if "dist z t < d" for t
     using no_nonpos_Real_in_ball[OF z, of t] that unfolding d_def by (force simp add: complex_nonpos_Reals_iff)
   have sums: "(\<lambda>n. inverse (z + of_nat (Suc n)) - inverse (z + of_nat n)) sums
                        (0 - inverse (z + of_nat 0))"
     by (intro telescope_sums filterlim_compose[OF tendsto_inverse_0]
               tendsto_add_filterlim_at_infinity[OF tendsto_const] tendsto_of_nat)
 
   have "((\<lambda>z. \<Sum>n. ?f z n) has_field_derivative ?F' z) (at z)"
     using d z ln_Gamma_series'_aux[OF z']
     apply (intro has_field_derivative_series'(2)[of "ball z d" _ _ z] uniformly_summable_deriv_ln_Gamma)
     apply (auto intro!: derivative_eq_intros add_pos_pos mult_pos_pos dest!: ball
              simp: field_simps sums_iff nonpos_Reals_divide_of_nat_iff
              simp del: of_nat_Suc)
     apply (auto simp add: complex_nonpos_Reals_iff)
     done
   with z have "((\<lambda>z. (\<Sum>k. ?f z k) - euler_mascheroni * z - Ln z) has_field_derivative
                    ?F' z - euler_mascheroni - inverse z) (at z)"
     by (force intro!: derivative_eq_intros simp: Digamma_def)
   also have "?F' z - euler_mascheroni - inverse z = (?F' z + -inverse z) - euler_mascheroni" by simp
   also from sums have "-inverse z = (\<Sum>n. inverse (z + of_nat (Suc n)) - inverse (z + of_nat n))"
     by (simp add: sums_iff)
   also from sums summable_deriv_ln_Gamma[OF z'']
     have "?F' z + \<dots> =  (\<Sum>n. inverse (of_nat (Suc n)) - inverse (z + of_nat n))"
     by (subst suminf_add) (simp_all add: add_ac sums_iff)
   also have "\<dots> - euler_mascheroni = Digamma z" by (simp add: Digamma_def)
   finally have "((\<lambda>z. (\<Sum>k. ?f z k) - euler_mascheroni * z - Ln z)
                     has_field_derivative Digamma z) (at z)" .
   moreover from eventually_nhds_ball[OF d(1), of z]
     have "eventually (\<lambda>z. ln_Gamma z = (\<Sum>k. ?f z k) - euler_mascheroni * z - Ln z) (nhds z)"
   proof eventually_elim
     fix t assume "t \<in> ball z d"
     hence "t \<notin> \<int>\<^sub>\<le>\<^sub>0" by (auto dest!: ball elim!: nonpos_Ints_cases)
     from ln_Gamma_series'_aux[OF this]
       show "ln_Gamma t = (\<Sum>k. ?f t k) - euler_mascheroni * t - Ln t" by (simp add: sums_iff)
   qed
   ultimately show ?thesis by (subst DERIV_cong_ev[OF refl _ refl])
 qed
 
 declare has_field_derivative_ln_Gamma_complex[THEN DERIV_chain2, derivative_intros]
 
 
 lemma Digamma_1 [simp]: "Digamma (1 :: 'a :: {real_normed_field,banach}) = - euler_mascheroni"
   by (simp add: Digamma_def)
 
 lemma Digamma_plus1:
   assumes "z \<noteq> 0"
   shows   "Digamma (z+1) = Digamma z + 1/z"
 proof -
   have sums: "(\<lambda>k. inverse (z + of_nat k) - inverse (z + of_nat (Suc k)))
                   sums (inverse (z + of_nat 0) - 0)"
     by (intro telescope_sums'[OF filterlim_compose[OF tendsto_inverse_0]]
               tendsto_add_filterlim_at_infinity[OF tendsto_const] tendsto_of_nat)
   have "Digamma (z+1) = (\<Sum>k. inverse (of_nat (Suc k)) - inverse (z + of_nat (Suc k))) -
           euler_mascheroni" (is "_ = suminf ?f - _") by (simp add: Digamma_def add_ac)
   also have "suminf ?f = (\<Sum>k. inverse (of_nat (Suc k)) - inverse (z + of_nat k)) +
                          (\<Sum>k. inverse (z + of_nat k) - inverse (z + of_nat (Suc k)))"
     using summable_Digamma[OF assms] sums by (subst suminf_add) (simp_all add: add_ac sums_iff)
   also have "(\<Sum>k. inverse (z + of_nat k) - inverse (z + of_nat (Suc k))) = 1/z"
     using sums by (simp add: sums_iff inverse_eq_divide)
   finally show ?thesis by (simp add: Digamma_def[of z])
 qed
 
 theorem Polygamma_plus1:
   assumes "z \<noteq> 0"
   shows   "Polygamma n (z + 1) = Polygamma n z + (-1)^n * fact n / (z ^ Suc n)"
 proof (cases "n = 0")
   assume n: "n \<noteq> 0"
   let ?f = "\<lambda>k. inverse ((z + of_nat k) ^ Suc n)"
   have "Polygamma n (z + 1) = (-1) ^ Suc n * fact n * (\<Sum>k. ?f (k+1))"
     using n by (simp add: Polygamma_def add_ac)
   also have "(\<Sum>k. ?f (k+1)) + (\<Sum>k<1. ?f k) = (\<Sum>k. ?f k)"
     using Polygamma_converges'[OF assms, of "Suc n"] n
     by (subst suminf_split_initial_segment [symmetric]) simp_all
   hence "(\<Sum>k. ?f (k+1)) = (\<Sum>k. ?f k) - inverse (z ^ Suc n)" by (simp add: algebra_simps)
   also have "(-1) ^ Suc n * fact n * ((\<Sum>k. ?f k) - inverse (z ^ Suc n)) =
                Polygamma n z + (-1)^n * fact n / (z ^ Suc n)" using n
     by (simp add: inverse_eq_divide algebra_simps Polygamma_def)
   finally show ?thesis .
 qed (insert assms, simp add: Digamma_plus1 inverse_eq_divide)
 
 theorem Digamma_of_nat:
   "Digamma (of_nat (Suc n) :: 'a :: {real_normed_field,banach}) = harm n - euler_mascheroni"
 proof (induction n)
   case (Suc n)
   have "Digamma (of_nat (Suc (Suc n)) :: 'a) = Digamma (of_nat (Suc n) + 1)" by simp
   also have "\<dots> = Digamma (of_nat (Suc n)) + inverse (of_nat (Suc n))"
     by (subst Digamma_plus1) (simp_all add: inverse_eq_divide del: of_nat_Suc)
   also have "Digamma (of_nat (Suc n) :: 'a) = harm n - euler_mascheroni " by (rule Suc)
   also have "\<dots> + inverse (of_nat (Suc n)) = harm (Suc n) - euler_mascheroni"
     by (simp add: harm_Suc)
   finally show ?case .
 qed (simp add: harm_def)
 
 lemma Digamma_numeral: "Digamma (numeral n) = harm (pred_numeral n) - euler_mascheroni"
   by (subst of_nat_numeral[symmetric], subst numeral_eq_Suc, subst Digamma_of_nat) (rule refl)
 
 lemma Polygamma_of_real: "x \<noteq> 0 \<Longrightarrow> Polygamma n (of_real x) = of_real (Polygamma n x)"
   unfolding Polygamma_def using summable_Digamma[of x] Polygamma_converges'[of x "Suc n"]
   by (simp_all add: suminf_of_real)
 
 lemma Polygamma_Real: "z \<in> \<real> \<Longrightarrow> z \<noteq> 0 \<Longrightarrow> Polygamma n z \<in> \<real>"
   by (elim Reals_cases, hypsubst, subst Polygamma_of_real) simp_all
 
 lemma Digamma_half_integer:
   "Digamma (of_nat n + 1/2 :: 'a :: {real_normed_field,banach}) =
       (\<Sum>k<n. 2 / (of_nat (2*k+1))) - euler_mascheroni - of_real (2 * ln 2)"
 proof (induction n)
   case 0
   have "Digamma (1/2 :: 'a) = of_real (Digamma (1/2))" by (simp add: Polygamma_of_real [symmetric])
   also have "Digamma (1/2::real) =
                (\<Sum>k. inverse (of_nat (Suc k)) - inverse (of_nat k + 1/2)) - euler_mascheroni"
     by (simp add: Digamma_def add_ac)
   also have "(\<Sum>k. inverse (of_nat (Suc k) :: real) - inverse (of_nat k + 1/2)) =
              (\<Sum>k. inverse (1/2) * (inverse (2 * of_nat (Suc k)) - inverse (2 * of_nat k + 1)))"
     by (simp_all add: add_ac inverse_mult_distrib[symmetric] ring_distribs del: inverse_divide)
   also have "\<dots> = - 2 * ln 2" using sums_minus[OF alternating_harmonic_series_sums']
     by (subst suminf_mult) (simp_all add: algebra_simps sums_iff)
   finally show ?case by simp
 next
   case (Suc n)
   have nz: "2 * of_nat n + (1:: 'a) \<noteq> 0"
      using of_nat_neq_0[of "2*n"] by (simp only: of_nat_Suc) (simp add: add_ac)
   hence nz': "of_nat n + (1/2::'a) \<noteq> 0" by (simp add: field_simps)
   have "Digamma (of_nat (Suc n) + 1/2 :: 'a) = Digamma (of_nat n + 1/2 + 1)" by simp
   also from nz' have "\<dots> = Digamma (of_nat n + 1/2) + 1 / (of_nat n + 1/2)"
     by (rule Digamma_plus1)
   also from nz nz' have "1 / (of_nat n + 1/2 :: 'a) = 2 / (2 * of_nat n + 1)"
     by (subst divide_eq_eq) simp_all
   also note Suc
   finally show ?case by (simp add: add_ac)
 qed
 
 lemma Digamma_one_half: "Digamma (1/2) = - euler_mascheroni - of_real (2 * ln 2)"
   using Digamma_half_integer[of 0] by simp
 
 lemma Digamma_real_three_halves_pos: "Digamma (3/2 :: real) > 0"
 proof -
   have "-Digamma (3/2 :: real) = -Digamma (of_nat 1 + 1/2)" by simp
   also have "\<dots> = 2 * ln 2 + euler_mascheroni - 2" by (subst Digamma_half_integer) simp
   also note euler_mascheroni_less_13_over_22
   also note ln2_le_25_over_36
   finally show ?thesis by simp
 qed
 
 
 theorem has_field_derivative_Polygamma [derivative_intros]:
   fixes z :: "'a :: {real_normed_field,euclidean_space}"
   assumes z: "z \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows "(Polygamma n has_field_derivative Polygamma (Suc n) z) (at z within A)"
 proof (rule has_field_derivative_at_within, cases "n = 0")
   assume n: "n = 0"
   let ?f = "\<lambda>k z. inverse (of_nat (Suc k)) - inverse (z + of_nat k)"
   let ?F = "\<lambda>z. \<Sum>k. ?f k z" and ?f' = "\<lambda>k z. inverse ((z + of_nat k)\<^sup>2)"
-  from no_nonpos_Int_in_ball'[OF z] guess d . note d = this
+  from no_nonpos_Int_in_ball'[OF z] obtain d where d: "0 < d" "\<And>t. t \<in> ball z d \<Longrightarrow> t \<notin> \<int>\<^sub>\<le>\<^sub>0"
+    by auto
   from z have summable: "summable (\<lambda>k. inverse (of_nat (Suc k)) - inverse (z + of_nat k))"
     by (intro summable_Digamma) force
   from z have conv: "uniformly_convergent_on (ball z d) (\<lambda>k z. \<Sum>i<k. inverse ((z + of_nat i)\<^sup>2))"
     by (intro Polygamma_converges) auto
   with d have "summable (\<lambda>k. inverse ((z + of_nat k)\<^sup>2))" unfolding summable_iff_convergent
     by (auto dest!: uniformly_convergent_imp_convergent simp: summable_iff_convergent )
 
   have "(?F has_field_derivative (\<Sum>k. ?f' k z)) (at z)"
   proof (rule has_field_derivative_series'[of "ball z d" _ _ z])
     fix k :: nat and t :: 'a assume t: "t \<in> ball z d"
     from t d(2)[of t] show "((\<lambda>z. ?f k z) has_field_derivative ?f' k t) (at t within ball z d)"
       by (auto intro!: derivative_eq_intros simp: power2_eq_square simp del: of_nat_Suc
                dest!: plus_of_nat_eq_0_imp elim!: nonpos_Ints_cases)
   qed (insert d(1) summable conv, (assumption|simp)+)
   with z show "(Polygamma n has_field_derivative Polygamma (Suc n) z) (at z)"
     unfolding Digamma_def [abs_def] Polygamma_def [abs_def] using n
     by (force simp: power2_eq_square intro!: derivative_eq_intros)
 next
   assume n: "n \<noteq> 0"
   from z have z': "z \<noteq> 0" by auto
-  from no_nonpos_Int_in_ball'[OF z] guess d . note d = this
+  from no_nonpos_Int_in_ball'[OF z] obtain d where d: "0 < d" "\<And>t. t \<in> ball z d \<Longrightarrow> t \<notin> \<int>\<^sub>\<le>\<^sub>0"
+    by auto
   define n' where "n' = Suc n"
   from n have n': "n' \<ge> 2" by (simp add: n'_def)
   have "((\<lambda>z. \<Sum>k. inverse ((z + of_nat k) ^ n')) has_field_derivative
                 (\<Sum>k. - of_nat n' * inverse ((z + of_nat k) ^ (n'+1)))) (at z)"
   proof (rule has_field_derivative_series'[of "ball z d" _ _ z])
     fix k :: nat and t :: 'a assume t: "t \<in> ball z d"
     with d have t': "t \<notin> \<int>\<^sub>\<le>\<^sub>0" "t \<noteq> 0" by auto
     show "((\<lambda>a. inverse ((a + of_nat k) ^ n')) has_field_derivative
                 - of_nat n' * inverse ((t + of_nat k) ^ (n'+1))) (at t within ball z d)" using t'
       by (fastforce intro!: derivative_eq_intros simp: divide_simps power_diff dest: plus_of_nat_eq_0_imp)
   next
     have "uniformly_convergent_on (ball z d)
               (\<lambda>k z. (- of_nat n' :: 'a) * (\<Sum>i<k. inverse ((z + of_nat i) ^ (n'+1))))"
       using z' n by (intro uniformly_convergent_mult Polygamma_converges) (simp_all add: n'_def)
     thus "uniformly_convergent_on (ball z d)
               (\<lambda>k z. \<Sum>i<k. - of_nat n' * inverse ((z + of_nat i :: 'a) ^ (n'+1)))"
       by (subst (asm) sum_distrib_left) simp
   qed (insert Polygamma_converges'[OF z' n'] d, simp_all)
   also have "(\<Sum>k. - of_nat n' * inverse ((z + of_nat k) ^ (n' + 1))) =
                (- of_nat n') * (\<Sum>k. inverse ((z + of_nat k) ^ (n' + 1)))"
     using Polygamma_converges'[OF z', of "n'+1"] n' by (subst suminf_mult) simp_all
   finally have "((\<lambda>z. \<Sum>k. inverse ((z + of_nat k) ^ n')) has_field_derivative
                     - of_nat n' * (\<Sum>k. inverse ((z + of_nat k) ^ (n' + 1)))) (at z)" .
   from DERIV_cmult[OF this, of "(-1)^Suc n * fact n :: 'a"]
     show "(Polygamma n has_field_derivative Polygamma (Suc n) z) (at z)"
     unfolding n'_def Polygamma_def[abs_def] using n by (simp add: algebra_simps)
 qed
 
 declare has_field_derivative_Polygamma[THEN DERIV_chain2, derivative_intros]
 
 lemma isCont_Polygamma [continuous_intros]:
   fixes f :: "_ \<Rightarrow> 'a :: {real_normed_field,euclidean_space}"
   shows "isCont f z \<Longrightarrow> f z \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> isCont (\<lambda>x. Polygamma n (f x)) z"
   by (rule isCont_o2[OF _  DERIV_isCont[OF has_field_derivative_Polygamma]])
 
 lemma continuous_on_Polygamma:
   "A \<inter> \<int>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> continuous_on A (Polygamma n :: _ \<Rightarrow> 'a :: {real_normed_field,euclidean_space})"
   by (intro continuous_at_imp_continuous_on isCont_Polygamma[OF continuous_ident] ballI) blast
 
 lemma isCont_ln_Gamma_complex [continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> complex"
   shows "isCont f z \<Longrightarrow> f z \<notin> \<real>\<^sub>\<le>\<^sub>0 \<Longrightarrow> isCont (\<lambda>z. ln_Gamma (f z)) z"
   by (rule isCont_o2[OF _  DERIV_isCont[OF has_field_derivative_ln_Gamma_complex]])
 
 lemma continuous_on_ln_Gamma_complex [continuous_intros]:
   fixes A :: "complex set"
   shows "A \<inter> \<real>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> continuous_on A ln_Gamma"
   by (intro continuous_at_imp_continuous_on ballI isCont_ln_Gamma_complex[OF continuous_ident])
      fastforce
 
 lemma deriv_Polygamma:
   assumes "z \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "deriv (Polygamma m) z =
              Polygamma (Suc m) (z :: 'a :: {real_normed_field,euclidean_space})"
   by (intro DERIV_imp_deriv has_field_derivative_Polygamma assms)
     thm has_field_derivative_Polygamma
 
 lemma higher_deriv_Polygamma:
   assumes "z \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "(deriv ^^ n) (Polygamma m) z =
              Polygamma (m + n) (z :: 'a :: {real_normed_field,euclidean_space})"
 proof -
   have "eventually (\<lambda>u. (deriv ^^ n) (Polygamma m) u = Polygamma (m + n) u) (nhds z)"
   proof (induction n)
     case (Suc n)
     from Suc.IH have "eventually (\<lambda>z. eventually (\<lambda>u. (deriv ^^ n) (Polygamma m) u = Polygamma (m + n) u) (nhds z)) (nhds z)"
       by (simp add: eventually_eventually)
     hence "eventually (\<lambda>z. deriv ((deriv ^^ n) (Polygamma m)) z =
              deriv (Polygamma (m + n)) z) (nhds z)"
       by eventually_elim (intro deriv_cong_ev refl)
     moreover have "eventually (\<lambda>z. z \<in> UNIV - \<int>\<^sub>\<le>\<^sub>0) (nhds z)" using assms
       by (intro eventually_nhds_in_open open_Diff open_UNIV) auto
     ultimately show ?case by eventually_elim (simp_all add: deriv_Polygamma)
   qed simp_all
   thus ?thesis by (rule eventually_nhds_x_imp_x)
 qed
 
 lemma deriv_ln_Gamma_complex:
   assumes "z \<notin> \<real>\<^sub>\<le>\<^sub>0"
   shows   "deriv ln_Gamma z = Digamma (z :: complex)"
   by (intro DERIV_imp_deriv has_field_derivative_ln_Gamma_complex assms)
 
 
 lemma higher_deriv_ln_Gamma_complex:
   assumes "(x::complex) \<notin> \<real>\<^sub>\<le>\<^sub>0"
   shows   "(deriv ^^ j) ln_Gamma x = (if j = 0 then ln_Gamma x else Polygamma (j - 1) x)"
 proof (cases j)
   case (Suc j')
   have "(deriv ^^ j') (deriv ln_Gamma) x = (deriv ^^ j') Digamma x"
     using eventually_nhds_in_open[of "UNIV - \<real>\<^sub>\<le>\<^sub>0" x] assms
     by (intro higher_deriv_cong_ev refl)
        (auto elim!: eventually_mono simp: open_Diff deriv_ln_Gamma_complex)
   also have "\<dots> = Polygamma j' x" using assms
     by (subst higher_deriv_Polygamma)
        (auto elim!: nonpos_Ints_cases simp: complex_nonpos_Reals_iff)
   finally show ?thesis using Suc by (simp del: funpow.simps add: funpow_Suc_right)
 qed simp_all
 
 
 text \<open>
   We define a type class that captures all the fundamental properties of the inverse of the Gamma function
   and defines the Gamma function upon that. This allows us to instantiate the type class both for
   the reals and for the complex numbers with a minimal amount of proof duplication.
 \<close>
 
 class\<^marker>\<open>tag unimportant\<close> Gamma = real_normed_field + complete_space +
   fixes rGamma :: "'a \<Rightarrow> 'a"
   assumes rGamma_eq_zero_iff_aux: "rGamma z = 0 \<longleftrightarrow> (\<exists>n. z = - of_nat n)"
   assumes differentiable_rGamma_aux1:
     "(\<And>n. z \<noteq> - of_nat n) \<Longrightarrow>
      let d = (THE d. (\<lambda>n. \<Sum>k<n. inverse (of_nat (Suc k)) - inverse (z + of_nat k))
                \<longlonglongrightarrow> d) - scaleR euler_mascheroni 1
      in  filterlim (\<lambda>y. (rGamma y - rGamma z + rGamma z * d * (y - z)) /\<^sub>R
                         norm (y - z)) (nhds 0) (at z)"
   assumes differentiable_rGamma_aux2:
     "let z = - of_nat n
      in  filterlim (\<lambda>y. (rGamma y - rGamma z - (-1)^n * (prod of_nat {1..n}) * (y - z)) /\<^sub>R
                         norm (y - z)) (nhds 0) (at z)"
   assumes rGamma_series_aux: "(\<And>n. z \<noteq> - of_nat n) \<Longrightarrow>
              let fact' = (\<lambda>n. prod of_nat {1..n});
                  exp = (\<lambda>x. THE e. (\<lambda>n. \<Sum>k<n. x^k /\<^sub>R fact k) \<longlonglongrightarrow> e);
                  pochhammer' = (\<lambda>a n. (\<Prod>n = 0..n. a + of_nat n))
              in  filterlim (\<lambda>n. pochhammer' z n / (fact' n * exp (z * (ln (of_nat n) *\<^sub>R 1))))
                      (nhds (rGamma z)) sequentially"
 begin
 subclass banach ..
 end
 
 definition "Gamma z = inverse (rGamma z)"
 
 
 subsection \<open>Basic properties\<close>
 
 lemma Gamma_nonpos_Int: "z \<in> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> Gamma z = 0"
   and rGamma_nonpos_Int: "z \<in> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> rGamma z = 0"
   using rGamma_eq_zero_iff_aux[of z] unfolding Gamma_def by (auto elim!: nonpos_Ints_cases')
 
 lemma Gamma_nonzero: "z \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> Gamma z \<noteq> 0"
   and rGamma_nonzero: "z \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> rGamma z \<noteq> 0"
   using rGamma_eq_zero_iff_aux[of z] unfolding Gamma_def by (auto elim!: nonpos_Ints_cases')
 
 lemma Gamma_eq_zero_iff: "Gamma z = 0 \<longleftrightarrow> z \<in> \<int>\<^sub>\<le>\<^sub>0"
   and rGamma_eq_zero_iff: "rGamma z = 0 \<longleftrightarrow> z \<in> \<int>\<^sub>\<le>\<^sub>0"
   using rGamma_eq_zero_iff_aux[of z] unfolding Gamma_def by (auto elim!: nonpos_Ints_cases')
 
 lemma rGamma_inverse_Gamma: "rGamma z = inverse (Gamma z)"
   unfolding Gamma_def by simp
 
 lemma rGamma_series_LIMSEQ [tendsto_intros]:
   "rGamma_series z \<longlonglongrightarrow> rGamma z"
 proof (cases "z \<in> \<int>\<^sub>\<le>\<^sub>0")
   case False
   hence "z \<noteq> - of_nat n" for n by auto
   from rGamma_series_aux[OF this] show ?thesis
     by (simp add: rGamma_series_def[abs_def] fact_prod pochhammer_Suc_prod
                   exp_def of_real_def[symmetric] suminf_def sums_def[abs_def] atLeast0AtMost)
 qed (insert rGamma_eq_zero_iff[of z], simp_all add: rGamma_series_nonpos_Ints_LIMSEQ)
 
 theorem Gamma_series_LIMSEQ [tendsto_intros]:
   "Gamma_series z \<longlonglongrightarrow> Gamma z"
 proof (cases "z \<in> \<int>\<^sub>\<le>\<^sub>0")
   case False
   hence "(\<lambda>n. inverse (rGamma_series z n)) \<longlonglongrightarrow> inverse (rGamma z)"
     by (intro tendsto_intros) (simp_all add: rGamma_eq_zero_iff)
   also have "(\<lambda>n. inverse (rGamma_series z n)) = Gamma_series z"
     by (simp add: rGamma_series_def Gamma_series_def[abs_def])
   finally show ?thesis by (simp add: Gamma_def)
 qed (insert Gamma_eq_zero_iff[of z], simp_all add: Gamma_series_nonpos_Ints_LIMSEQ)
 
 lemma Gamma_altdef: "Gamma z = lim (Gamma_series z)"
   using Gamma_series_LIMSEQ[of z] by (simp add: limI)
 
 lemma rGamma_1 [simp]: "rGamma 1 = 1"
 proof -
   have A: "eventually (\<lambda>n. rGamma_series 1 n = of_nat (Suc n) / of_nat n) sequentially"
     using eventually_gt_at_top[of "0::nat"]
     by (force elim!: eventually_mono simp: rGamma_series_def exp_of_real pochhammer_fact
                     field_split_simps pochhammer_rec' dest!: pochhammer_eq_0_imp_nonpos_Int)
   have "rGamma_series 1 \<longlonglongrightarrow> 1" by (subst tendsto_cong[OF A]) (rule LIMSEQ_Suc_n_over_n)
   moreover have "rGamma_series 1 \<longlonglongrightarrow> rGamma 1" by (rule tendsto_intros)
   ultimately show ?thesis by (intro LIMSEQ_unique)
 qed
 
 lemma rGamma_plus1: "z * rGamma (z + 1) = rGamma z"
 proof -
   let ?f = "\<lambda>n. (z + 1) * inverse (of_nat n) + 1"
   have "eventually (\<lambda>n. ?f n * rGamma_series z n = z * rGamma_series (z + 1) n) sequentially"
     using eventually_gt_at_top[of "0::nat"]
   proof eventually_elim
     fix n :: nat assume n: "n > 0"
     hence "z * rGamma_series (z + 1) n = inverse (of_nat n) *
              pochhammer z (Suc (Suc n)) / (fact n * exp (z * of_real (ln (of_nat n))))"
       by (subst pochhammer_rec) (simp add: rGamma_series_def field_simps exp_add exp_of_real)
     also from n have "\<dots> = ?f n * rGamma_series z n"
       by (subst pochhammer_rec') (simp_all add: field_split_simps rGamma_series_def)
     finally show "?f n * rGamma_series z n = z * rGamma_series (z + 1) n" ..
   qed
   moreover have "(\<lambda>n. ?f n * rGamma_series z n) \<longlonglongrightarrow> ((z+1) * 0 + 1) * rGamma z"
     by (intro tendsto_intros lim_inverse_n)
   hence "(\<lambda>n. ?f n * rGamma_series z n) \<longlonglongrightarrow> rGamma z" by simp
   ultimately have "(\<lambda>n. z * rGamma_series (z + 1) n) \<longlonglongrightarrow> rGamma z"
     by (blast intro: Lim_transform_eventually)
   moreover have "(\<lambda>n. z * rGamma_series (z + 1) n) \<longlonglongrightarrow> z * rGamma (z + 1)"
     by (intro tendsto_intros)
   ultimately show "z * rGamma (z + 1) = rGamma z" using LIMSEQ_unique by blast
 qed
 
 
 lemma pochhammer_rGamma: "rGamma z = pochhammer z n * rGamma (z + of_nat n)"
 proof (induction n arbitrary: z)
   case (Suc n z)
   have "rGamma z = pochhammer z n * rGamma (z + of_nat n)" by (rule Suc.IH)
   also note rGamma_plus1 [symmetric]
   finally show ?case by (simp add: add_ac pochhammer_rec')
 qed simp_all
 
 theorem Gamma_plus1: "z \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> Gamma (z + 1) = z * Gamma z"
   using rGamma_plus1[of z] by (simp add: rGamma_inverse_Gamma field_simps Gamma_eq_zero_iff)
 
 theorem pochhammer_Gamma: "z \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> pochhammer z n = Gamma (z + of_nat n) / Gamma z"
   using pochhammer_rGamma[of z]
   by (simp add: rGamma_inverse_Gamma Gamma_eq_zero_iff field_simps)
 
 lemma Gamma_0 [simp]: "Gamma 0 = 0"
   and rGamma_0 [simp]: "rGamma 0 = 0"
   and Gamma_neg_1 [simp]: "Gamma (- 1) = 0"
   and rGamma_neg_1 [simp]: "rGamma (- 1) = 0"
   and Gamma_neg_numeral [simp]: "Gamma (- numeral n) = 0"
   and rGamma_neg_numeral [simp]: "rGamma (- numeral n) = 0"
   and Gamma_neg_of_nat [simp]: "Gamma (- of_nat m) = 0"
   and rGamma_neg_of_nat [simp]: "rGamma (- of_nat m) = 0"
   by (simp_all add: rGamma_eq_zero_iff Gamma_eq_zero_iff)
 
 lemma Gamma_1 [simp]: "Gamma 1 = 1" unfolding Gamma_def by simp
 
 theorem Gamma_fact: "Gamma (1 + of_nat n) = fact n"
   by (simp add: pochhammer_fact pochhammer_Gamma of_nat_in_nonpos_Ints_iff flip: of_nat_Suc)
 
 lemma Gamma_numeral: "Gamma (numeral n) = fact (pred_numeral n)"
   by (subst of_nat_numeral[symmetric], subst numeral_eq_Suc,
       subst of_nat_Suc, subst Gamma_fact) (rule refl)
 
 lemma Gamma_of_int: "Gamma (of_int n) = (if n > 0 then fact (nat (n - 1)) else 0)"
 proof (cases "n > 0")
   case True
   hence "Gamma (of_int n) = Gamma (of_nat (Suc (nat (n - 1))))" by (subst of_nat_Suc) simp_all
   with True show ?thesis by (subst (asm) of_nat_Suc, subst (asm) Gamma_fact) simp
 qed (simp_all add: Gamma_eq_zero_iff nonpos_Ints_of_int)
 
 lemma rGamma_of_int: "rGamma (of_int n) = (if n > 0 then inverse (fact (nat (n - 1))) else 0)"
   by (simp add: Gamma_of_int rGamma_inverse_Gamma)
 
 lemma Gamma_seriesI:
   assumes "(\<lambda>n. g n / Gamma_series z n) \<longlonglongrightarrow> 1"
   shows   "g \<longlonglongrightarrow> Gamma z"
 proof (rule Lim_transform_eventually)
   have "1/2 > (0::real)" by simp
   from tendstoD[OF assms, OF this]
     show "eventually (\<lambda>n. g n / Gamma_series z n * Gamma_series z n = g n) sequentially"
     by (force elim!: eventually_mono simp: dist_real_def)
   from assms have "(\<lambda>n. g n / Gamma_series z n * Gamma_series z n) \<longlonglongrightarrow> 1 * Gamma z"
     by (intro tendsto_intros)
   thus "(\<lambda>n. g n / Gamma_series z n * Gamma_series z n) \<longlonglongrightarrow> Gamma z" by simp
 qed
 
 lemma Gamma_seriesI':
   assumes "f \<longlonglongrightarrow> rGamma z"
   assumes "(\<lambda>n. g n * f n) \<longlonglongrightarrow> 1"
   assumes "z \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "g \<longlonglongrightarrow> Gamma z"
 proof (rule Lim_transform_eventually)
   have "1/2 > (0::real)" by simp
   from tendstoD[OF assms(2), OF this] show "eventually (\<lambda>n. g n * f n / f n = g n) sequentially"
     by (force elim!: eventually_mono simp: dist_real_def)
   from assms have "(\<lambda>n. g n * f n / f n) \<longlonglongrightarrow> 1 / rGamma z"
     by (intro tendsto_divide assms) (simp_all add: rGamma_eq_zero_iff)
   thus "(\<lambda>n. g n * f n / f n) \<longlonglongrightarrow> Gamma z" by (simp add: Gamma_def divide_inverse)
 qed
 
 lemma Gamma_series'_LIMSEQ: "Gamma_series' z \<longlonglongrightarrow> Gamma z"
   by (cases "z \<in> \<int>\<^sub>\<le>\<^sub>0") (simp_all add: Gamma_nonpos_Int Gamma_seriesI[OF Gamma_series_Gamma_series']
                                       Gamma_series'_nonpos_Ints_LIMSEQ[of z])
 
 
 subsection \<open>Differentiability\<close>
 
 lemma has_field_derivative_rGamma_no_nonpos_int:
   assumes "z \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "(rGamma has_field_derivative -rGamma z * Digamma z) (at z within A)"
 proof (rule has_field_derivative_at_within)
   from assms have "z \<noteq> - of_nat n" for n by auto
   from differentiable_rGamma_aux1[OF this]
     show "(rGamma has_field_derivative -rGamma z * Digamma z) (at z)"
          unfolding Digamma_def suminf_def sums_def[abs_def]
                    has_field_derivative_def has_derivative_def netlimit_at
     by (simp add: Let_def bounded_linear_mult_right mult_ac of_real_def [symmetric])
 qed
 
 lemma has_field_derivative_rGamma_nonpos_int:
   "(rGamma has_field_derivative (-1)^n * fact n) (at (- of_nat n) within A)"
   apply (rule has_field_derivative_at_within)
   using differentiable_rGamma_aux2[of n]
   unfolding Let_def has_field_derivative_def has_derivative_def netlimit_at
   by (simp only: bounded_linear_mult_right mult_ac of_real_def [symmetric] fact_prod) simp
 
 lemma has_field_derivative_rGamma [derivative_intros]:
   "(rGamma has_field_derivative (if z \<in> \<int>\<^sub>\<le>\<^sub>0 then (-1)^(nat \<lfloor>norm z\<rfloor>) * fact (nat \<lfloor>norm z\<rfloor>)
       else -rGamma z * Digamma z)) (at z within A)"
 using has_field_derivative_rGamma_no_nonpos_int[of z A]
       has_field_derivative_rGamma_nonpos_int[of "nat \<lfloor>norm z\<rfloor>" A]
   by (auto elim!: nonpos_Ints_cases')
 
 declare has_field_derivative_rGamma_no_nonpos_int [THEN DERIV_chain2, derivative_intros]
 declare has_field_derivative_rGamma [THEN DERIV_chain2, derivative_intros]
 declare has_field_derivative_rGamma_nonpos_int [derivative_intros]
 declare has_field_derivative_rGamma_no_nonpos_int [derivative_intros]
 declare has_field_derivative_rGamma [derivative_intros]
 
 theorem has_field_derivative_Gamma [derivative_intros]:
   "z \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> (Gamma has_field_derivative Gamma z * Digamma z) (at z within A)"
   unfolding Gamma_def [abs_def]
   by (fastforce intro!: derivative_eq_intros simp: rGamma_eq_zero_iff)
 
 declare has_field_derivative_Gamma[THEN DERIV_chain2, derivative_intros]
 
 (* TODO: Hide ugly facts properly *)
 hide_fact rGamma_eq_zero_iff_aux differentiable_rGamma_aux1 differentiable_rGamma_aux2
           differentiable_rGamma_aux2 rGamma_series_aux Gamma_class.rGamma_eq_zero_iff_aux
 
 lemma continuous_on_rGamma [continuous_intros]: "continuous_on A rGamma"
   by (rule DERIV_continuous_on has_field_derivative_rGamma)+
 
 lemma continuous_on_Gamma [continuous_intros]: "A \<inter> \<int>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> continuous_on A Gamma"
   by (rule DERIV_continuous_on has_field_derivative_Gamma)+ blast
 
 lemma isCont_rGamma [continuous_intros]:
   "isCont f z \<Longrightarrow> isCont (\<lambda>x. rGamma (f x)) z"
   by (rule isCont_o2[OF _  DERIV_isCont[OF has_field_derivative_rGamma]])
 
 lemma isCont_Gamma [continuous_intros]:
   "isCont f z \<Longrightarrow> f z \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> isCont (\<lambda>x. Gamma (f x)) z"
   by (rule isCont_o2[OF _  DERIV_isCont[OF has_field_derivative_Gamma]])
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>The complex Gamma function\<close>
 
 instantiation\<^marker>\<open>tag unimportant\<close> complex :: Gamma
 begin
 
 definition\<^marker>\<open>tag unimportant\<close> rGamma_complex :: "complex \<Rightarrow> complex" where
   "rGamma_complex z = lim (rGamma_series z)"
 
 lemma rGamma_series_complex_converges:
         "convergent (rGamma_series (z :: complex))" (is "?thesis1")
   and rGamma_complex_altdef:
         "rGamma z = (if z \<in> \<int>\<^sub>\<le>\<^sub>0 then 0 else exp (-ln_Gamma z))" (is "?thesis2")
 proof -
   have "?thesis1 \<and> ?thesis2"
   proof (cases "z \<in> \<int>\<^sub>\<le>\<^sub>0")
     case False
     have "rGamma_series z \<longlonglongrightarrow> exp (- ln_Gamma z)"
     proof (rule Lim_transform_eventually)
-      from ln_Gamma_series_complex_converges'[OF False] guess d by (elim exE conjE)
+      from ln_Gamma_series_complex_converges'[OF False]
+      obtain d where "0 < d" "uniformly_convergent_on (ball z d) (\<lambda>n z. ln_Gamma_series z n)"
+        by auto
       from this(1) uniformly_convergent_imp_convergent[OF this(2), of z]
         have "ln_Gamma_series z \<longlonglongrightarrow> lim (ln_Gamma_series z)" by (simp add: convergent_LIMSEQ_iff)
       thus "(\<lambda>n. exp (-ln_Gamma_series z n)) \<longlonglongrightarrow> exp (- ln_Gamma z)"
         unfolding convergent_def ln_Gamma_def by (intro tendsto_exp tendsto_minus)
       from eventually_gt_at_top[of "0::nat"] exp_ln_Gamma_series_complex False
         show "eventually (\<lambda>n. exp (-ln_Gamma_series z n) = rGamma_series z n) sequentially"
         by (force elim!: eventually_mono simp: exp_minus Gamma_series_def rGamma_series_def)
     qed
     with False show ?thesis
       by (auto simp: convergent_def rGamma_complex_def intro!: limI)
   next
     case True
     then obtain k where "z = - of_nat k" by (erule nonpos_Ints_cases')
     also have "rGamma_series \<dots> \<longlonglongrightarrow> 0"
       by (subst tendsto_cong[OF rGamma_series_minus_of_nat]) (simp_all add: convergent_const)
     finally show ?thesis using True
       by (auto simp: rGamma_complex_def convergent_def intro!: limI)
   qed
   thus "?thesis1" "?thesis2" by blast+
 qed
 
 context\<^marker>\<open>tag unimportant\<close>
 begin
 
 (* TODO: duplication *)
 private lemma rGamma_complex_plus1: "z * rGamma (z + 1) = rGamma (z :: complex)"
 proof -
   let ?f = "\<lambda>n. (z + 1) * inverse (of_nat n) + 1"
   have "eventually (\<lambda>n. ?f n * rGamma_series z n = z * rGamma_series (z + 1) n) sequentially"
     using eventually_gt_at_top[of "0::nat"]
   proof eventually_elim
     fix n :: nat assume n: "n > 0"
     hence "z * rGamma_series (z + 1) n = inverse (of_nat n) *
              pochhammer z (Suc (Suc n)) / (fact n * exp (z * of_real (ln (of_nat n))))"
       by (subst pochhammer_rec) (simp add: rGamma_series_def field_simps exp_add exp_of_real)
     also from n have "\<dots> = ?f n * rGamma_series z n"
       by (subst pochhammer_rec') (simp_all add: field_split_simps rGamma_series_def add_ac)
     finally show "?f n * rGamma_series z n = z * rGamma_series (z + 1) n" ..
   qed
   moreover have "(\<lambda>n. ?f n * rGamma_series z n) \<longlonglongrightarrow> ((z+1) * 0 + 1) * rGamma z"
     using rGamma_series_complex_converges
     by (intro tendsto_intros lim_inverse_n)
        (simp_all add: convergent_LIMSEQ_iff rGamma_complex_def)
   hence "(\<lambda>n. ?f n * rGamma_series z n) \<longlonglongrightarrow> rGamma z" by simp
   ultimately have "(\<lambda>n. z * rGamma_series (z + 1) n) \<longlonglongrightarrow> rGamma z"
     by (blast intro: Lim_transform_eventually)
   moreover have "(\<lambda>n. z * rGamma_series (z + 1) n) \<longlonglongrightarrow> z * rGamma (z + 1)"
     using rGamma_series_complex_converges
     by (auto intro!: tendsto_mult simp: rGamma_complex_def convergent_LIMSEQ_iff)
   ultimately show "z * rGamma (z + 1) = rGamma z" using LIMSEQ_unique by blast
 qed
 
 private lemma has_field_derivative_rGamma_complex_no_nonpos_Int:
   assumes "(z :: complex) \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "(rGamma has_field_derivative - rGamma z * Digamma z) (at z)"
 proof -
   have diff: "(rGamma has_field_derivative - rGamma z * Digamma z) (at z)" if "Re z > 0" for z
   proof (subst DERIV_cong_ev[OF refl _ refl])
     from that have "eventually (\<lambda>t. t \<in> ball z (Re z/2)) (nhds z)"
       by (intro eventually_nhds_in_nhd) simp_all
     thus "eventually (\<lambda>t. rGamma t = exp (- ln_Gamma t)) (nhds z)"
       using no_nonpos_Int_in_ball_complex[OF that]
       by (auto elim!: eventually_mono simp: rGamma_complex_altdef)
   next
     have "z \<notin> \<real>\<^sub>\<le>\<^sub>0" using that by (simp add: complex_nonpos_Reals_iff)
     with that show "((\<lambda>t. exp (- ln_Gamma t)) has_field_derivative (-rGamma z * Digamma z)) (at z)"
      by (force elim!: nonpos_Ints_cases intro!: derivative_eq_intros simp: rGamma_complex_altdef)
   qed
 
   from assms show "(rGamma has_field_derivative - rGamma z * Digamma z) (at z)"
   proof (induction "nat \<lfloor>1 - Re z\<rfloor>" arbitrary: z)
     case (Suc n z)
     from Suc.prems have z: "z \<noteq> 0" by auto
     from Suc.hyps have "n = nat \<lfloor>- Re z\<rfloor>" by linarith
     hence A: "n = nat \<lfloor>1 - Re (z + 1)\<rfloor>" by simp
     from Suc.prems have B: "z + 1 \<notin> \<int>\<^sub>\<le>\<^sub>0" by (force dest: plus_one_in_nonpos_Ints_imp)
 
     have "((\<lambda>z. z * (rGamma \<circ> (\<lambda>z. z + 1)) z) has_field_derivative
       -rGamma (z + 1) * (Digamma (z + 1) * z - 1)) (at z)"
       by (rule derivative_eq_intros DERIV_chain Suc refl A B)+ (simp add: algebra_simps)
     also have "(\<lambda>z. z * (rGamma \<circ> (\<lambda>z. z + 1 :: complex)) z) = rGamma"
       by (simp add: rGamma_complex_plus1)
     also from z have "Digamma (z + 1) * z - 1 = z * Digamma z"
       by (subst Digamma_plus1) (simp_all add: field_simps)
     also have "-rGamma (z + 1) * (z * Digamma z) = -rGamma z * Digamma z"
       by (simp add: rGamma_complex_plus1[of z, symmetric])
     finally show ?case .
   qed (intro diff, simp)
 qed
 
 private lemma rGamma_complex_1: "rGamma (1 :: complex) = 1"
 proof -
   have A: "eventually (\<lambda>n. rGamma_series 1 n = of_nat (Suc n) / of_nat n) sequentially"
     using eventually_gt_at_top[of "0::nat"]
     by (force elim!: eventually_mono simp: rGamma_series_def exp_of_real pochhammer_fact
                     field_split_simps pochhammer_rec' dest!: pochhammer_eq_0_imp_nonpos_Int)
   have "rGamma_series 1 \<longlonglongrightarrow> 1" by (subst tendsto_cong[OF A]) (rule LIMSEQ_Suc_n_over_n)
   thus "rGamma 1 = (1 :: complex)" unfolding rGamma_complex_def by (rule limI)
 qed
 
 private lemma has_field_derivative_rGamma_complex_nonpos_Int:
   "(rGamma has_field_derivative (-1)^n * fact n) (at (- of_nat n :: complex))"
 proof (induction n)
   case 0
   have A: "(0::complex) + 1 \<notin> \<int>\<^sub>\<le>\<^sub>0" by simp
   have "((\<lambda>z. z * (rGamma \<circ> (\<lambda>z. z + 1 :: complex)) z) has_field_derivative 1) (at 0)"
     by (rule derivative_eq_intros DERIV_chain refl
              has_field_derivative_rGamma_complex_no_nonpos_Int A)+ (simp add: rGamma_complex_1)
     thus ?case by (simp add: rGamma_complex_plus1)
 next
   case (Suc n)
   hence A: "(rGamma has_field_derivative (-1)^n * fact n)
                 (at (- of_nat (Suc n) + 1 :: complex))" by simp
    have "((\<lambda>z. z * (rGamma \<circ> (\<lambda>z. z + 1 :: complex)) z) has_field_derivative
              (- 1) ^ Suc n * fact (Suc n)) (at (- of_nat (Suc n)))"
      by (rule derivative_eq_intros refl A DERIV_chain)+
         (simp add: algebra_simps rGamma_complex_altdef)
   thus ?case by (simp add: rGamma_complex_plus1)
 qed
 
 instance proof
   fix z :: complex show "(rGamma z = 0) \<longleftrightarrow> (\<exists>n. z = - of_nat n)"
     by (auto simp: rGamma_complex_altdef elim!: nonpos_Ints_cases')
 next
   fix z :: complex assume "\<And>n. z \<noteq> - of_nat n"
   hence "z \<notin> \<int>\<^sub>\<le>\<^sub>0" by (auto elim!: nonpos_Ints_cases')
   from has_field_derivative_rGamma_complex_no_nonpos_Int[OF this]
     show "let d = (THE d. (\<lambda>n. \<Sum>k<n. inverse (of_nat (Suc k)) - inverse (z + of_nat k))
                        \<longlonglongrightarrow> d) - euler_mascheroni *\<^sub>R 1 in  (\<lambda>y. (rGamma y - rGamma z +
               rGamma z * d * (y - z)) /\<^sub>R  cmod (y - z)) \<midarrow>z\<rightarrow> 0"
       by (simp add: has_field_derivative_def has_derivative_def Digamma_def sums_def [abs_def]
                     of_real_def[symmetric] suminf_def)
 next
   fix n :: nat
   from has_field_derivative_rGamma_complex_nonpos_Int[of n]
   show "let z = - of_nat n in (\<lambda>y. (rGamma y - rGamma z - (- 1) ^ n * prod of_nat {1..n} *
                   (y - z)) /\<^sub>R cmod (y - z)) \<midarrow>z\<rightarrow> 0"
     by (simp add: has_field_derivative_def has_derivative_def fact_prod Let_def)
 next
   fix z :: complex
   from rGamma_series_complex_converges[of z] have "rGamma_series z \<longlonglongrightarrow> rGamma z"
     by (simp add: convergent_LIMSEQ_iff rGamma_complex_def)
   thus "let fact' = \<lambda>n. prod of_nat {1..n};
             exp = \<lambda>x. THE e. (\<lambda>n. \<Sum>k<n. x ^ k /\<^sub>R fact k) \<longlonglongrightarrow> e;
             pochhammer' = \<lambda>a n. \<Prod>n = 0..n. a + of_nat n
         in  (\<lambda>n. pochhammer' z n / (fact' n * exp (z * ln (real_of_nat n) *\<^sub>R 1))) \<longlonglongrightarrow> rGamma z"
     by (simp add: fact_prod pochhammer_Suc_prod rGamma_series_def [abs_def] exp_def
                   of_real_def [symmetric] suminf_def sums_def [abs_def] atLeast0AtMost)
 qed
 
 end
 end
 
 
 lemma Gamma_complex_altdef:
   "Gamma z = (if z \<in> \<int>\<^sub>\<le>\<^sub>0 then 0 else exp (ln_Gamma (z :: complex)))"
   unfolding Gamma_def rGamma_complex_altdef by (simp add: exp_minus)
 
 lemma cnj_rGamma: "cnj (rGamma z) = rGamma (cnj z)"
 proof -
   have "rGamma_series (cnj z) = (\<lambda>n. cnj (rGamma_series z n))"
     by (intro ext) (simp_all add: rGamma_series_def exp_cnj)
   also have "... \<longlonglongrightarrow> cnj (rGamma z)" by (intro tendsto_cnj tendsto_intros)
   finally show ?thesis unfolding rGamma_complex_def by (intro sym[OF limI])
 qed
 
 lemma cnj_Gamma: "cnj (Gamma z) = Gamma (cnj z)"
   unfolding Gamma_def by (simp add: cnj_rGamma)
 
 lemma Gamma_complex_real:
   "z \<in> \<real> \<Longrightarrow> Gamma z \<in> (\<real> :: complex set)" and rGamma_complex_real: "z \<in> \<real> \<Longrightarrow> rGamma z \<in> \<real>"
   by (simp_all add: Reals_cnj_iff cnj_Gamma cnj_rGamma)
 
 lemma field_differentiable_rGamma: "rGamma field_differentiable (at z within A)"
   using has_field_derivative_rGamma[of z] unfolding field_differentiable_def by blast
 
 lemma holomorphic_rGamma [holomorphic_intros]: "rGamma holomorphic_on A"
   unfolding holomorphic_on_def by (auto intro!: field_differentiable_rGamma)
 
 lemma holomorphic_rGamma' [holomorphic_intros]: 
   assumes "f holomorphic_on A"
   shows   "(\<lambda>x. rGamma (f x)) holomorphic_on A"
 proof -
   have "rGamma \<circ> f holomorphic_on A" using assms
     by (intro holomorphic_on_compose assms holomorphic_rGamma)
   thus ?thesis by (simp only: o_def)
 qed
 
 lemma analytic_rGamma: "rGamma analytic_on A"
   unfolding analytic_on_def by (auto intro!: exI[of _ 1] holomorphic_rGamma)
 
 
 lemma field_differentiable_Gamma: "z \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> Gamma field_differentiable (at z within A)"
   using has_field_derivative_Gamma[of z] unfolding field_differentiable_def by auto
 
 lemma holomorphic_Gamma [holomorphic_intros]: "A \<inter> \<int>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> Gamma holomorphic_on A"
   unfolding holomorphic_on_def by (auto intro!: field_differentiable_Gamma)
 
 lemma holomorphic_Gamma' [holomorphic_intros]: 
   assumes "f holomorphic_on A" and "\<And>x. x \<in> A \<Longrightarrow> f x \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "(\<lambda>x. Gamma (f x)) holomorphic_on A"
 proof -
   have "Gamma \<circ> f holomorphic_on A" using assms
     by (intro holomorphic_on_compose assms holomorphic_Gamma) auto
   thus ?thesis by (simp only: o_def)
 qed
 
 lemma analytic_Gamma: "A \<inter> \<int>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> Gamma analytic_on A"
   by (rule analytic_on_subset[of _ "UNIV - \<int>\<^sub>\<le>\<^sub>0"], subst analytic_on_open)
      (auto intro!: holomorphic_Gamma)
 
 
 lemma field_differentiable_ln_Gamma_complex:
   "z \<notin> \<real>\<^sub>\<le>\<^sub>0 \<Longrightarrow> ln_Gamma field_differentiable (at (z::complex) within A)"
   by (rule field_differentiable_within_subset[of _ _ UNIV])
      (force simp: field_differentiable_def intro!: derivative_intros)+
 
 lemma holomorphic_ln_Gamma [holomorphic_intros]: "A \<inter> \<real>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> ln_Gamma holomorphic_on A"
   unfolding holomorphic_on_def by (auto intro!: field_differentiable_ln_Gamma_complex)
 
 lemma analytic_ln_Gamma: "A \<inter> \<real>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> ln_Gamma analytic_on A"
   by (rule analytic_on_subset[of _ "UNIV - \<real>\<^sub>\<le>\<^sub>0"], subst analytic_on_open)
      (auto intro!: holomorphic_ln_Gamma)
 
 
 lemma has_field_derivative_rGamma_complex' [derivative_intros]:
   "(rGamma has_field_derivative (if z \<in> \<int>\<^sub>\<le>\<^sub>0 then (-1)^(nat \<lfloor>-Re z\<rfloor>) * fact (nat \<lfloor>-Re z\<rfloor>) else
         -rGamma z * Digamma z)) (at z within A)"
   using has_field_derivative_rGamma[of z] by (auto elim!: nonpos_Ints_cases')
 
 declare has_field_derivative_rGamma_complex'[THEN DERIV_chain2, derivative_intros]
 
 
 lemma field_differentiable_Polygamma:
   fixes z :: complex
   shows
   "z \<notin> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> Polygamma n field_differentiable (at z within A)"
   using has_field_derivative_Polygamma[of z n] unfolding field_differentiable_def by auto
 
 lemma holomorphic_on_Polygamma [holomorphic_intros]: "A \<inter> \<int>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> Polygamma n holomorphic_on A"
   unfolding holomorphic_on_def by (auto intro!: field_differentiable_Polygamma)
 
 lemma analytic_on_Polygamma: "A \<inter> \<int>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> Polygamma n analytic_on A"
   by (rule analytic_on_subset[of _ "UNIV - \<int>\<^sub>\<le>\<^sub>0"], subst analytic_on_open)
      (auto intro!: holomorphic_on_Polygamma)
 
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>The real Gamma function\<close>
 
 lemma rGamma_series_real:
   "eventually (\<lambda>n. rGamma_series x n = Re (rGamma_series (of_real x) n)) sequentially"
   using eventually_gt_at_top[of "0 :: nat"]
 proof eventually_elim
   fix n :: nat assume n: "n > 0"
   have "Re (rGamma_series (of_real x) n) =
           Re (of_real (pochhammer x (Suc n)) / (fact n * exp (of_real (x * ln (real_of_nat n)))))"
     using n by (simp add: rGamma_series_def powr_def pochhammer_of_real)
   also from n have "\<dots> = Re (of_real ((pochhammer x (Suc n)) /
                               (fact n * (exp (x * ln (real_of_nat n))))))"
     by (subst exp_of_real) simp
   also from n have "\<dots> = rGamma_series x n"
     by (subst Re_complex_of_real) (simp add: rGamma_series_def powr_def)
   finally show "rGamma_series x n = Re (rGamma_series (of_real x) n)" ..
 qed
 
 instantiation\<^marker>\<open>tag unimportant\<close> real :: Gamma
 begin
 
 definition "rGamma_real x = Re (rGamma (of_real x :: complex))"
 
 instance proof
   fix x :: real
   have "rGamma x = Re (rGamma (of_real x))" by (simp add: rGamma_real_def)
   also have "of_real \<dots> = rGamma (of_real x :: complex)"
     by (intro of_real_Re rGamma_complex_real) simp_all
   also have "\<dots> = 0 \<longleftrightarrow> x \<in> \<int>\<^sub>\<le>\<^sub>0" by (simp add: rGamma_eq_zero_iff of_real_in_nonpos_Ints_iff)
   also have "\<dots> \<longleftrightarrow> (\<exists>n. x = - of_nat n)" by (auto elim!: nonpos_Ints_cases')
   finally show "(rGamma x) = 0 \<longleftrightarrow> (\<exists>n. x = - real_of_nat n)" by simp
 next
   fix x :: real assume "\<And>n. x \<noteq> - of_nat n"
   hence x: "complex_of_real x \<notin> \<int>\<^sub>\<le>\<^sub>0"
     by (subst of_real_in_nonpos_Ints_iff) (auto elim!: nonpos_Ints_cases')
   then have "x \<noteq> 0" by auto
   with x have "(rGamma has_field_derivative - rGamma x * Digamma x) (at x)"
     by (fastforce intro!: derivative_eq_intros has_vector_derivative_real_field
                   simp: Polygamma_of_real rGamma_real_def [abs_def])
   thus "let d = (THE d. (\<lambda>n. \<Sum>k<n. inverse (of_nat (Suc k)) - inverse (x + of_nat k))
                        \<longlonglongrightarrow> d) - euler_mascheroni *\<^sub>R 1 in  (\<lambda>y. (rGamma y - rGamma x +
               rGamma x * d * (y - x)) /\<^sub>R  norm (y - x)) \<midarrow>x\<rightarrow> 0"
       by (simp add: has_field_derivative_def has_derivative_def Digamma_def sums_def [abs_def]
                     of_real_def[symmetric] suminf_def)
 next
   fix n :: nat
   have "(rGamma has_field_derivative (-1)^n * fact n) (at (- of_nat n :: real))"
     by (fastforce intro!: derivative_eq_intros has_vector_derivative_real_field
                   simp: Polygamma_of_real rGamma_real_def [abs_def])
   thus "let x = - of_nat n in (\<lambda>y. (rGamma y - rGamma x - (- 1) ^ n * prod of_nat {1..n} *
                   (y - x)) /\<^sub>R norm (y - x)) \<midarrow>x::real\<rightarrow> 0"
     by (simp add: has_field_derivative_def has_derivative_def fact_prod Let_def)
 next
   fix x :: real
   have "rGamma_series x \<longlonglongrightarrow> rGamma x"
   proof (rule Lim_transform_eventually)
     show "(\<lambda>n. Re (rGamma_series (of_real x) n)) \<longlonglongrightarrow> rGamma x" unfolding rGamma_real_def
       by (intro tendsto_intros)
   qed (insert rGamma_series_real, simp add: eq_commute)
   thus "let fact' = \<lambda>n. prod of_nat {1..n};
             exp = \<lambda>x. THE e. (\<lambda>n. \<Sum>k<n. x ^ k /\<^sub>R fact k) \<longlonglongrightarrow> e;
             pochhammer' = \<lambda>a n. \<Prod>n = 0..n. a + of_nat n
         in  (\<lambda>n. pochhammer' x n / (fact' n * exp (x * ln (real_of_nat n) *\<^sub>R 1))) \<longlonglongrightarrow> rGamma x"
     by (simp add: fact_prod pochhammer_Suc_prod rGamma_series_def [abs_def] exp_def
                   of_real_def [symmetric] suminf_def sums_def [abs_def] atLeast0AtMost)
 qed
 
 end
 
 
 lemma rGamma_complex_of_real: "rGamma (complex_of_real x) = complex_of_real (rGamma x)"
   unfolding rGamma_real_def using rGamma_complex_real by simp
 
 lemma Gamma_complex_of_real: "Gamma (complex_of_real x) = complex_of_real (Gamma x)"
   unfolding Gamma_def by (simp add: rGamma_complex_of_real)
 
 lemma rGamma_real_altdef: "rGamma x = lim (rGamma_series (x :: real))"
   by (rule sym, rule limI, rule tendsto_intros)
 
 lemma Gamma_real_altdef1: "Gamma x = lim (Gamma_series (x :: real))"
   by (rule sym, rule limI, rule tendsto_intros)
 
 lemma Gamma_real_altdef2: "Gamma x = Re (Gamma (of_real x))"
   using rGamma_complex_real[OF Reals_of_real[of x]]
   by (elim Reals_cases)
      (simp only: Gamma_def rGamma_real_def of_real_inverse[symmetric] Re_complex_of_real)
 
 lemma ln_Gamma_series_complex_of_real:
   "x > 0 \<Longrightarrow> n > 0 \<Longrightarrow> ln_Gamma_series (complex_of_real x) n = of_real (ln_Gamma_series x n)"
 proof -
   assume xn: "x > 0" "n > 0"
   have "Ln (complex_of_real x / of_nat k + 1) = of_real (ln (x / of_nat k + 1))" if "k \<ge> 1" for k
     using that xn by (subst Ln_of_real [symmetric]) (auto intro!: add_nonneg_pos simp: field_simps)
   with xn show ?thesis by (simp add: ln_Gamma_series_def Ln_of_real)
 qed
 
 lemma ln_Gamma_real_converges:
   assumes "(x::real) > 0"
   shows   "convergent (ln_Gamma_series x)"
 proof -
   have "(\<lambda>n. ln_Gamma_series (complex_of_real x) n) \<longlonglongrightarrow> ln_Gamma (of_real x)" using assms
     by (intro ln_Gamma_complex_LIMSEQ) (auto simp: of_real_in_nonpos_Ints_iff)
   moreover from eventually_gt_at_top[of "0::nat"]
     have "eventually (\<lambda>n. complex_of_real (ln_Gamma_series x n) =
             ln_Gamma_series (complex_of_real x) n) sequentially"
     by eventually_elim (simp add: ln_Gamma_series_complex_of_real assms)
   ultimately have "(\<lambda>n. complex_of_real (ln_Gamma_series x n)) \<longlonglongrightarrow> ln_Gamma (of_real x)"
     by (subst tendsto_cong) assumption+
   from tendsto_Re[OF this] show ?thesis by (auto simp: convergent_def)
 qed
 
 lemma ln_Gamma_real_LIMSEQ: "(x::real) > 0 \<Longrightarrow> ln_Gamma_series x \<longlonglongrightarrow> ln_Gamma x"
   using ln_Gamma_real_converges[of x] unfolding ln_Gamma_def by (simp add: convergent_LIMSEQ_iff)
 
 lemma ln_Gamma_complex_of_real: "x > 0 \<Longrightarrow> ln_Gamma (complex_of_real x) = of_real (ln_Gamma x)"
 proof (unfold ln_Gamma_def, rule limI, rule Lim_transform_eventually)
   assume x: "x > 0"
   show "eventually (\<lambda>n. of_real (ln_Gamma_series x n) =
             ln_Gamma_series (complex_of_real x) n) sequentially"
     using eventually_gt_at_top[of "0::nat"]
     by eventually_elim (simp add: ln_Gamma_series_complex_of_real x)
 qed (intro tendsto_of_real, insert ln_Gamma_real_LIMSEQ[of x], simp add: ln_Gamma_def)
 
 lemma Gamma_real_pos_exp: "x > (0 :: real) \<Longrightarrow> Gamma x = exp (ln_Gamma x)"
   by (auto simp: Gamma_real_altdef2 Gamma_complex_altdef of_real_in_nonpos_Ints_iff
                  ln_Gamma_complex_of_real exp_of_real)
 
 lemma ln_Gamma_real_pos: "x > 0 \<Longrightarrow> ln_Gamma x = ln (Gamma x :: real)"
   unfolding Gamma_real_pos_exp by simp
 
 lemma ln_Gamma_complex_conv_fact: "n > 0 \<Longrightarrow> ln_Gamma (of_nat n :: complex) = ln (fact (n - 1))"
   using ln_Gamma_complex_of_real[of "real n"] Gamma_fact[of "n - 1", where 'a = real]
   by (simp add: ln_Gamma_real_pos of_nat_diff Ln_of_real [symmetric])
 
 lemma ln_Gamma_real_conv_fact: "n > 0 \<Longrightarrow> ln_Gamma (real n) = ln (fact (n - 1))"
   using Gamma_fact[of "n - 1", where 'a = real]
   by (simp add: ln_Gamma_real_pos of_nat_diff Ln_of_real [symmetric])
 
 lemma Gamma_real_pos [simp, intro]: "x > (0::real) \<Longrightarrow> Gamma x > 0"
   by (simp add: Gamma_real_pos_exp)
 
 lemma Gamma_real_nonneg [simp, intro]: "x > (0::real) \<Longrightarrow> Gamma x \<ge> 0"
   by (simp add: Gamma_real_pos_exp)
 
 lemma has_field_derivative_ln_Gamma_real [derivative_intros]:
   assumes x: "x > (0::real)"
   shows "(ln_Gamma has_field_derivative Digamma x) (at x)"
 proof (subst DERIV_cong_ev[OF refl _ refl])
   from assms show "((Re \<circ> ln_Gamma \<circ> complex_of_real) has_field_derivative Digamma x) (at x)"
     by (auto intro!: derivative_eq_intros has_vector_derivative_real_field
              simp: Polygamma_of_real o_def)
   from eventually_nhds_in_nhd[of x "{0<..}"] assms
     show "eventually (\<lambda>y. ln_Gamma y = (Re \<circ> ln_Gamma \<circ> of_real) y) (nhds x)"
     by (auto elim!: eventually_mono simp: ln_Gamma_complex_of_real interior_open)
 qed
 
 lemma field_differentiable_ln_Gamma_real:
   "x > 0 \<Longrightarrow> ln_Gamma field_differentiable (at (x::real) within A)"
   by (rule field_differentiable_within_subset[of _ _ UNIV])
      (auto simp: field_differentiable_def intro!: derivative_intros)+
 
 declare has_field_derivative_ln_Gamma_real[THEN DERIV_chain2, derivative_intros]
 
 lemma deriv_ln_Gamma_real:
   assumes "z > 0"
   shows   "deriv ln_Gamma z = Digamma (z :: real)"
   by (intro DERIV_imp_deriv has_field_derivative_ln_Gamma_real assms)
 
 lemma higher_deriv_ln_Gamma_real:
   assumes "(x::real) > 0"
   shows   "(deriv ^^ j) ln_Gamma x = (if j = 0 then ln_Gamma x else Polygamma (j - 1) x)"
 proof (cases j)
   case (Suc j')
   have "(deriv ^^ j') (deriv ln_Gamma) x = (deriv ^^ j') Digamma x"
     using eventually_nhds_in_open[of "{0<..}" x] assms
     by (intro higher_deriv_cong_ev refl)
        (auto elim!: eventually_mono simp: open_Diff deriv_ln_Gamma_real)
   also have "\<dots> = Polygamma j' x" using assms
     by (subst higher_deriv_Polygamma)
        (auto elim!: nonpos_Ints_cases simp: complex_nonpos_Reals_iff)
   finally show ?thesis using Suc by (simp del: funpow.simps add: funpow_Suc_right)
 qed simp_all
   
 lemma higher_deriv_ln_Gamma_complex_of_real:
   assumes "(x :: real) > 0"
   shows   "(deriv ^^ j) ln_Gamma (complex_of_real x) = of_real ((deriv ^^ j) ln_Gamma x)"
     using assms
     by (auto simp: higher_deriv_ln_Gamma_real higher_deriv_ln_Gamma_complex
                    ln_Gamma_complex_of_real Polygamma_of_real)
 
 lemma has_field_derivative_rGamma_real' [derivative_intros]:
   "(rGamma has_field_derivative (if x \<in> \<int>\<^sub>\<le>\<^sub>0 then (-1)^(nat \<lfloor>-x\<rfloor>) * fact (nat \<lfloor>-x\<rfloor>) else
         -rGamma x * Digamma x)) (at x within A)"
   using has_field_derivative_rGamma[of x] by (force elim!: nonpos_Ints_cases')
 
 declare has_field_derivative_rGamma_real'[THEN DERIV_chain2, derivative_intros]
 
 lemma Polygamma_real_odd_pos:
   assumes "(x::real) \<notin> \<int>\<^sub>\<le>\<^sub>0" "odd n"
   shows   "Polygamma n x > 0"
 proof -
   from assms have "x \<noteq> 0" by auto
   with assms show ?thesis
     unfolding Polygamma_def using Polygamma_converges'[of x "Suc n"]
     by (auto simp: zero_less_power_eq simp del: power_Suc
              dest: plus_of_nat_eq_0_imp intro!: mult_pos_pos suminf_pos)
 qed
 
 lemma Polygamma_real_even_neg:
   assumes "(x::real) > 0" "n > 0" "even n"
   shows   "Polygamma n x < 0"
   using assms unfolding Polygamma_def using Polygamma_converges'[of x "Suc n"]
   by (auto intro!: mult_pos_pos suminf_pos)
 
 lemma Polygamma_real_strict_mono:
   assumes "x > 0" "x < (y::real)" "even n"
   shows   "Polygamma n x < Polygamma n y"
 proof -
   have "\<exists>\<xi>. x < \<xi> \<and> \<xi> < y \<and> Polygamma n y - Polygamma n x = (y - x) * Polygamma (Suc n) \<xi>"
     using assms by (intro MVT2 derivative_intros impI allI) (auto elim!: nonpos_Ints_cases)
-  then guess \<xi> by (elim exE conjE) note \<xi> = this
-  note \<xi>(3)
-  also from \<xi>(1,2) assms have "(y - x) * Polygamma (Suc n) \<xi> > 0"
+  then obtain \<xi>
+    where \<xi>: "x < \<xi>" "\<xi> < y"
+      and Polygamma: "Polygamma n y - Polygamma n x = (y - x) * Polygamma (Suc n) \<xi>"
+    by auto
+  note Polygamma
+  also from \<xi> assms have "(y - x) * Polygamma (Suc n) \<xi> > 0"
     by (intro mult_pos_pos Polygamma_real_odd_pos) (auto elim!: nonpos_Ints_cases)
   finally show ?thesis by simp
 qed
 
 lemma Polygamma_real_strict_antimono:
   assumes "x > 0" "x < (y::real)" "odd n"
   shows   "Polygamma n x > Polygamma n y"
 proof -
   have "\<exists>\<xi>. x < \<xi> \<and> \<xi> < y \<and> Polygamma n y - Polygamma n x = (y - x) * Polygamma (Suc n) \<xi>"
     using assms by (intro MVT2 derivative_intros impI allI) (auto elim!: nonpos_Ints_cases)
-  then guess \<xi> by (elim exE conjE) note \<xi> = this
-  note \<xi>(3)
-  also from \<xi>(1,2) assms have "(y - x) * Polygamma (Suc n) \<xi> < 0"
+  then obtain \<xi>
+    where \<xi>: "x < \<xi>" "\<xi> < y"
+      and Polygamma: "Polygamma n y - Polygamma n x = (y - x) * Polygamma (Suc n) \<xi>"
+    by auto
+  note Polygamma
+  also from \<xi> assms have "(y - x) * Polygamma (Suc n) \<xi> < 0"
     by (intro mult_pos_neg Polygamma_real_even_neg) simp_all
   finally show ?thesis by simp
 qed
 
 lemma Polygamma_real_mono:
   assumes "x > 0" "x \<le> (y::real)" "even n"
   shows   "Polygamma n x \<le> Polygamma n y"
   using Polygamma_real_strict_mono[OF assms(1) _ assms(3), of y] assms(2)
   by (cases "x = y") simp_all
 
 lemma Digamma_real_strict_mono: "(0::real) < x \<Longrightarrow> x < y \<Longrightarrow> Digamma x < Digamma y"
   by (rule Polygamma_real_strict_mono) simp_all
 
 lemma Digamma_real_mono: "(0::real) < x \<Longrightarrow> x \<le> y \<Longrightarrow> Digamma x \<le> Digamma y"
   by (rule Polygamma_real_mono) simp_all
 
 lemma Digamma_real_ge_three_halves_pos:
   assumes "x \<ge> 3/2"
   shows   "Digamma (x :: real) > 0"
 proof -
   have "0 < Digamma (3/2 :: real)" by (fact Digamma_real_three_halves_pos)
   also from assms have "\<dots> \<le> Digamma x" by (intro Polygamma_real_mono) simp_all
   finally show ?thesis .
 qed
 
 lemma ln_Gamma_real_strict_mono:
   assumes "x \<ge> 3/2" "x < y"
   shows   "ln_Gamma (x :: real) < ln_Gamma y"
 proof -
   have "\<exists>\<xi>. x < \<xi> \<and> \<xi> < y \<and> ln_Gamma y - ln_Gamma x = (y - x) * Digamma \<xi>"
     using assms by (intro MVT2 derivative_intros impI allI) (auto elim!: nonpos_Ints_cases)
-  then guess \<xi> by (elim exE conjE) note \<xi> = this
-  note \<xi>(3)
-  also from \<xi>(1,2) assms have "(y - x) * Digamma \<xi> > 0"
+  then obtain \<xi> where \<xi>: "x < \<xi>" "\<xi> < y"
+    and ln_Gamma: "ln_Gamma y - ln_Gamma x = (y - x) * Digamma \<xi>"
+    by auto
+  note ln_Gamma
+  also from \<xi> assms have "(y - x) * Digamma \<xi> > 0"
     by (intro mult_pos_pos Digamma_real_ge_three_halves_pos) simp_all
   finally show ?thesis by simp
 qed
 
 lemma Gamma_real_strict_mono:
   assumes "x \<ge> 3/2" "x < y"
   shows   "Gamma (x :: real) < Gamma y"
 proof -
   from Gamma_real_pos_exp[of x] assms have "Gamma x = exp (ln_Gamma x)" by simp
   also have "\<dots> < exp (ln_Gamma y)" by (intro exp_less_mono ln_Gamma_real_strict_mono assms)
   also from Gamma_real_pos_exp[of y] assms have "\<dots> = Gamma y" by simp
   finally show ?thesis .
 qed
 
 theorem log_convex_Gamma_real: "convex_on {0<..} (ln \<circ> Gamma :: real \<Rightarrow> real)"
   by (rule convex_on_realI[of _ _ Digamma])
      (auto intro!: derivative_eq_intros Polygamma_real_mono Gamma_real_pos
            simp: o_def Gamma_eq_zero_iff elim!: nonpos_Ints_cases')
 
 
 subsection \<open>The uniqueness of the real Gamma function\<close>
 
 text \<open>
   The following is a proof of the Bohr--Mollerup theorem, which states that
   any log-convex function \<open>G\<close> on the positive reals that fulfils \<open>G(1) = 1\<close> and
   satisfies the functional equation \<open>G(x + 1) = x G(x)\<close> must be equal to the
   Gamma function.
   In principle, if \<open>G\<close> is a holomorphic complex function, one could then extend
   this from the positive reals to the entire complex plane (minus the non-positive
   integers, where the Gamma function is not defined).
 \<close>
 
 context\<^marker>\<open>tag unimportant\<close>
   fixes G :: "real \<Rightarrow> real"
   assumes G_1: "G 1 = 1"
   assumes G_plus1: "x > 0 \<Longrightarrow> G (x + 1) = x * G x"
   assumes G_pos: "x > 0 \<Longrightarrow> G x > 0"
   assumes log_convex_G: "convex_on {0<..} (ln \<circ> G)"
 begin
 
 private lemma G_fact: "G (of_nat n + 1) = fact n"
   using G_plus1[of "real n + 1" for n]
   by (induction n) (simp_all add: G_1 G_plus1)
 
 private definition S :: "real \<Rightarrow> real \<Rightarrow> real" where
   "S x y = (ln (G y) - ln (G x)) / (y - x)"
 
 private lemma S_eq:
   "n \<ge> 2 \<Longrightarrow> S (of_nat n) (of_nat n + x) = (ln (G (real n + x)) - ln (fact (n - 1))) / x"
   by (subst G_fact [symmetric]) (simp add: S_def add_ac of_nat_diff)
 
 private lemma G_lower:
   assumes x: "x > 0" and n: "n \<ge> 1"
   shows  "Gamma_series x n \<le> G x"
 proof -
   have "(ln \<circ> G) (real (Suc n)) \<le> ((ln \<circ> G) (real (Suc n) + x) -
           (ln \<circ> G) (real (Suc n) - 1)) / (real (Suc n) + x - (real (Suc n) - 1)) *
            (real (Suc n) - (real (Suc n) - 1)) + (ln \<circ> G) (real (Suc n) - 1)"
     using x n by (intro convex_onD_Icc' convex_on_subset[OF log_convex_G]) auto
   hence "S (of_nat n) (of_nat (Suc n)) \<le> S (of_nat (Suc n)) (of_nat (Suc n) + x)"
     unfolding S_def using x by (simp add: field_simps)
   also have "S (of_nat n) (of_nat (Suc n)) = ln (fact n) - ln (fact (n-1))"
     unfolding S_def using n
     by (subst (1 2) G_fact [symmetric]) (simp_all add: add_ac of_nat_diff)
   also have "\<dots> = ln (fact n / fact (n-1))" by (subst ln_div) simp_all
   also from n have "fact n / fact (n - 1) = n" by (cases n) simp_all
   finally have "x * ln (real n) + ln (fact n) \<le> ln (G (real (Suc n) + x))"
     using x n by (subst (asm) S_eq) (simp_all add: field_simps)
   also have "x * ln (real n) + ln (fact n) = ln (exp (x * ln (real n)) * fact n)"
     using x by (simp add: ln_mult)
   finally have "exp (x * ln (real n)) * fact n \<le> G (real (Suc n) + x)" using x
     by (subst (asm) ln_le_cancel_iff) (simp_all add: G_pos)
   also have "G (real (Suc n) + x) = pochhammer x (Suc n) * G x"
     using G_plus1[of "real (Suc n) + x" for n] G_plus1[of x] x
     by (induction n) (simp_all add: pochhammer_Suc add_ac)
   finally show "Gamma_series x n \<le> G x"
     using x by (simp add: field_simps pochhammer_pos Gamma_series_def)
 qed
 
 private lemma G_upper:
   assumes x: "x > 0" "x \<le> 1" and n: "n \<ge> 2"
   shows  "G x \<le> Gamma_series x n * (1 + x / real n)"
 proof -
   have "(ln \<circ> G) (real n + x) \<le> ((ln \<circ> G) (real n + 1) -
           (ln \<circ> G) (real n)) / (real n + 1 - (real n)) *
            ((real n + x) - real n) + (ln \<circ> G) (real n)"
     using x n by (intro convex_onD_Icc' convex_on_subset[OF log_convex_G]) auto
   hence "S (of_nat n) (of_nat n + x) \<le> S (of_nat n) (of_nat n + 1)"
     unfolding S_def using x by (simp add: field_simps)
   also from n have "S (of_nat n) (of_nat n + 1) = ln (fact n) - ln (fact (n-1))"
     by (subst (1 2) G_fact [symmetric]) (simp add: S_def add_ac of_nat_diff)
   also have "\<dots> = ln (fact n / (fact (n-1)))" using n by (subst ln_div) simp_all
   also from n have "fact n / fact (n - 1) = n" by (cases n) simp_all
   finally have "ln (G (real n + x)) \<le> x * ln (real n) + ln (fact (n - 1))"
     using x n by (subst (asm) S_eq) (simp_all add: field_simps)
   also have "\<dots> = ln (exp (x * ln (real n)) * fact (n - 1))" using x
     by (simp add: ln_mult)
   finally have "G (real n + x) \<le> exp (x * ln (real n)) * fact (n - 1)" using x
     by (subst (asm) ln_le_cancel_iff) (simp_all add: G_pos)
   also have "G (real n + x) = pochhammer x n * G x"
     using G_plus1[of "real n + x" for n] x
     by (induction n) (simp_all add: pochhammer_Suc add_ac)
   finally have "G x \<le> exp (x * ln (real n)) * fact (n- 1) / pochhammer x n"
     using x by (simp add: field_simps pochhammer_pos)
   also from n have "fact (n - 1) = fact n / n" by (cases n) simp_all
   also have "exp (x * ln (real n)) * \<dots> / pochhammer x n =
                Gamma_series x n * (1 + x / real n)" using n x
     by (simp add: Gamma_series_def divide_simps pochhammer_Suc)
   finally show ?thesis .
 qed
 
 private lemma G_eq_Gamma_aux:
   assumes x: "x > 0" "x \<le> 1"
   shows   "G x = Gamma x"
 proof (rule antisym)
   show "G x \<ge> Gamma x"
   proof (rule tendsto_upperbound)
     from G_lower[of x] show "eventually (\<lambda>n. Gamma_series x n \<le> G x) sequentially"
       using  x by (auto intro: eventually_mono[OF eventually_ge_at_top[of "1::nat"]])
   qed (simp_all add: Gamma_series_LIMSEQ)
 next
   show "G x \<le> Gamma x"
   proof (rule tendsto_lowerbound)
     have "(\<lambda>n. Gamma_series x n * (1 + x / real n)) \<longlonglongrightarrow> Gamma x * (1 + 0)"
       by (rule tendsto_intros real_tendsto_divide_at_top
                Gamma_series_LIMSEQ filterlim_real_sequentially)+
     thus "(\<lambda>n. Gamma_series x n * (1 + x / real n)) \<longlonglongrightarrow> Gamma x" by simp
   next
     from G_upper[of x] show "eventually (\<lambda>n. Gamma_series x n * (1 + x / real n) \<ge> G x) sequentially"
       using x by (auto intro: eventually_mono[OF eventually_ge_at_top[of "2::nat"]])
   qed simp_all
 qed
 
 theorem Gamma_pos_real_unique:
   assumes x: "x > 0"
   shows   "G x = Gamma x"
 proof -
   have G_eq: "G (real n + x) = Gamma (real n + x)" if "x \<in> {0<..1}" for n x using that
   proof (induction n)
     case (Suc n)
     from Suc have "x + real n > 0" by simp
     hence "x + real n \<notin> \<int>\<^sub>\<le>\<^sub>0" by auto
     with Suc show ?case using G_plus1[of "real n + x"] Gamma_plus1[of "real n + x"]
       by (auto simp: add_ac)
   qed (simp_all add: G_eq_Gamma_aux)
 
   show ?thesis
   proof (cases "frac x = 0")
     case True
     hence "x = of_int (floor x)" by (simp add: frac_def)
     with x have x_eq: "x = of_nat (nat (floor x) - 1) + 1" by simp
     show ?thesis by (subst (1 2) x_eq, rule G_eq) simp_all
   next
     case False
     from assms have x_eq: "x = of_nat (nat (floor x)) + frac x"
       by (simp add: frac_def)
     have frac_le_1: "frac x \<le> 1" unfolding frac_def by linarith
     show ?thesis
       by (subst (1 2) x_eq, rule G_eq, insert False frac_le_1) simp_all
   qed
 qed
 
 end
 
 
 subsection \<open>The Beta function\<close>
 
 definition Beta where "Beta a b = Gamma a * Gamma b / Gamma (a + b)"
 
 lemma Beta_altdef: "Beta a b = Gamma a * Gamma b * rGamma (a + b)"
   by (simp add: inverse_eq_divide Beta_def Gamma_def)
 
 lemma Beta_commute: "Beta a b = Beta b a"
   unfolding Beta_def by (simp add: ac_simps)
 
 lemma has_field_derivative_Beta1 [derivative_intros]:
   assumes "x \<notin> \<int>\<^sub>\<le>\<^sub>0" "x + y \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "((\<lambda>x. Beta x y) has_field_derivative (Beta x y * (Digamma x - Digamma (x + y))))
                (at x within A)" unfolding Beta_altdef
   by (rule DERIV_cong, (rule derivative_intros assms)+) (simp add: algebra_simps)
 
 lemma Beta_pole1: "x \<in> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> Beta x y = 0"
   by (auto simp add: Beta_def elim!: nonpos_Ints_cases')
 
 lemma Beta_pole2: "y \<in> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> Beta x y = 0"
   by (auto simp add: Beta_def elim!: nonpos_Ints_cases')
 
 lemma Beta_zero: "x + y \<in> \<int>\<^sub>\<le>\<^sub>0 \<Longrightarrow> Beta x y = 0"
   by (auto simp add: Beta_def elim!: nonpos_Ints_cases')
 
 lemma has_field_derivative_Beta2 [derivative_intros]:
   assumes "y \<notin> \<int>\<^sub>\<le>\<^sub>0" "x + y \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "((\<lambda>y. Beta x y) has_field_derivative (Beta x y * (Digamma y - Digamma (x + y))))
                (at y within A)"
   using has_field_derivative_Beta1[of y x A] assms by (simp add: Beta_commute add_ac)
 
 theorem Beta_plus1_plus1:
   assumes "x \<notin> \<int>\<^sub>\<le>\<^sub>0" "y \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "Beta (x + 1) y + Beta x (y + 1) = Beta x y"
 proof -
   have "Beta (x + 1) y + Beta x (y + 1) =
             (Gamma (x + 1) * Gamma y + Gamma x * Gamma (y + 1)) * rGamma ((x + y) + 1)"
     by (simp add: Beta_altdef add_divide_distrib algebra_simps)
   also have "\<dots> = (Gamma x * Gamma y) * ((x + y) * rGamma ((x + y) + 1))"
     by (subst assms[THEN Gamma_plus1])+ (simp add: algebra_simps)
   also from assms have "\<dots> = Beta x y" unfolding Beta_altdef by (subst rGamma_plus1) simp
   finally show ?thesis .
 qed
 
 theorem Beta_plus1_left:
   assumes "x \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "(x + y) * Beta (x + 1) y = x * Beta x y"
 proof -
   have "(x + y) * Beta (x + 1) y = Gamma (x + 1) * Gamma y * ((x + y) * rGamma ((x + y) + 1))"
     unfolding Beta_altdef by (simp only: ac_simps)
   also have "\<dots> = x * Beta x y" unfolding Beta_altdef
      by (subst assms[THEN Gamma_plus1] rGamma_plus1)+ (simp only: ac_simps)
   finally show ?thesis .
 qed
 
 theorem Beta_plus1_right:
   assumes "y \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "(x + y) * Beta x (y + 1) = y * Beta x y"
   using Beta_plus1_left[of y x] assms by (simp_all add: Beta_commute add.commute)
 
 lemma Gamma_Gamma_Beta:
   assumes "x + y \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "Gamma x * Gamma y = Beta x y * Gamma (x + y)"
   unfolding Beta_altdef using assms Gamma_eq_zero_iff[of "x+y"]
   by (simp add: rGamma_inverse_Gamma)
 
 
 
 subsection \<open>Legendre duplication theorem\<close>
 
 context
 begin
 
 private lemma Gamma_legendre_duplication_aux:
   fixes z :: "'a :: Gamma"
   assumes "z \<notin> \<int>\<^sub>\<le>\<^sub>0" "z + 1/2 \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows "Gamma z * Gamma (z + 1/2) = exp ((1 - 2*z) * of_real (ln 2)) * Gamma (1/2) * Gamma (2*z)"
 proof -
   let ?powr = "\<lambda>b a. exp (a * of_real (ln (of_nat b)))"
   let ?h = "\<lambda>n. (fact (n-1))\<^sup>2 / fact (2*n-1) * of_nat (2^(2*n)) *
                 exp (1/2 * of_real (ln (real_of_nat n)))"
   {
     fix z :: 'a assume z: "z \<notin> \<int>\<^sub>\<le>\<^sub>0" "z + 1/2 \<notin> \<int>\<^sub>\<le>\<^sub>0"
     let ?g = "\<lambda>n. ?powr 2 (2*z) * Gamma_series' z n * Gamma_series' (z + 1/2) n /
                       Gamma_series' (2*z) (2*n)"
     have "eventually (\<lambda>n. ?g n = ?h n) sequentially" using eventually_gt_at_top
     proof eventually_elim
       fix n :: nat assume n: "n > 0"
       let ?f = "fact (n - 1) :: 'a" and ?f' = "fact (2*n - 1) :: 'a"
       have A: "exp t * exp t = exp (2*t :: 'a)" for t by (subst exp_add [symmetric]) simp
       have A: "Gamma_series' z n * Gamma_series' (z + 1/2) n = ?f^2 * ?powr n (2*z + 1/2) /
                 (pochhammer z n * pochhammer (z + 1/2) n)"
         by (simp add: Gamma_series'_def exp_add ring_distribs power2_eq_square A mult_ac)
       have B: "Gamma_series' (2*z) (2*n) =
                        ?f' * ?powr 2 (2*z) * ?powr n (2*z) /
                        (of_nat (2^(2*n)) * pochhammer z n * pochhammer (z+1/2) n)" using n
         by (simp add: Gamma_series'_def ln_mult exp_add ring_distribs pochhammer_double)
       from z have "pochhammer z n \<noteq> 0" by (auto dest: pochhammer_eq_0_imp_nonpos_Int)
       moreover from z have "pochhammer (z + 1/2) n \<noteq> 0" by (auto dest: pochhammer_eq_0_imp_nonpos_Int)
       ultimately have "?powr 2 (2*z) * (Gamma_series' z n * Gamma_series' (z + 1/2) n) / Gamma_series' (2*z) (2*n) =
          ?f^2 / ?f' * of_nat (2^(2*n)) * (?powr n ((4*z + 1)/2) * ?powr n (-2*z))"
         using n unfolding A B by (simp add: field_split_simps exp_minus)
       also have "?powr n ((4*z + 1)/2) * ?powr n (-2*z) = ?powr n (1/2)"
         by (simp add: algebra_simps exp_add[symmetric] add_divide_distrib)
       finally show "?g n = ?h n" by (simp only: mult_ac)
     qed
 
     moreover from z double_in_nonpos_Ints_imp[of z] have "2 * z \<notin> \<int>\<^sub>\<le>\<^sub>0" by auto
     hence "?g \<longlonglongrightarrow> ?powr 2 (2*z) * Gamma z * Gamma (z+1/2) / Gamma (2*z)"
       using LIMSEQ_subseq_LIMSEQ[OF Gamma_series'_LIMSEQ, of "(*)2" "2*z"]
       by (intro tendsto_intros Gamma_series'_LIMSEQ)
          (simp_all add: o_def strict_mono_def Gamma_eq_zero_iff)
     ultimately have "?h \<longlonglongrightarrow> ?powr 2 (2*z) * Gamma z * Gamma (z+1/2) / Gamma (2*z)"
       by (blast intro: Lim_transform_eventually)
   } note lim = this
 
   from assms double_in_nonpos_Ints_imp[of z] have z': "2 * z \<notin> \<int>\<^sub>\<le>\<^sub>0" by auto
   from fraction_not_in_ints[of 2 1] have "(1/2 :: 'a) \<notin> \<int>\<^sub>\<le>\<^sub>0"
     by (intro not_in_Ints_imp_not_in_nonpos_Ints) simp_all
   with lim[of "1/2 :: 'a"] have "?h \<longlonglongrightarrow> 2 * Gamma (1/2 :: 'a)" by (simp add: exp_of_real)
   from LIMSEQ_unique[OF this lim[OF assms]] z' show ?thesis
     by (simp add: field_split_simps Gamma_eq_zero_iff ring_distribs exp_diff exp_of_real)
 qed
 
 text \<open>
   The following lemma is somewhat annoying. With a little bit of complex analysis
   (Cauchy's integral theorem, to be exact), this would be completely trivial. However,
   we want to avoid depending on the complex analysis session at this point, so we prove it
   the hard way.
 \<close>
 private lemma Gamma_reflection_aux:
   defines "h \<equiv> \<lambda>z::complex. if z \<in> \<int> then 0 else
                  (of_real pi * cot (of_real pi*z) + Digamma z - Digamma (1 - z))"
   defines "a \<equiv> complex_of_real pi"
   obtains h' where "continuous_on UNIV h'" "\<And>z. (h has_field_derivative (h' z)) (at z)"
 proof -
   define f where "f n = a * of_real (cos_coeff (n+1) - sin_coeff (n+2))" for n
   define F where "F z = (if z = 0 then 0 else (cos (a*z) - sin (a*z)/(a*z)) / z)" for z
   define g where "g n = complex_of_real (sin_coeff (n+1))" for n
   define G where "G z = (if z = 0 then 1 else sin (a*z)/(a*z))" for z
   have a_nz: "a \<noteq> 0" unfolding a_def by simp
 
   have "(\<lambda>n. f n * (a*z)^n) sums (F z) \<and> (\<lambda>n. g n * (a*z)^n) sums (G z)"
     if "abs (Re z) < 1" for z
   proof (cases "z = 0"; rule conjI)
     assume "z \<noteq> 0"
     note z = this that
 
     from z have sin_nz: "sin (a*z) \<noteq> 0" unfolding a_def by (auto simp: sin_eq_0)
     have "(\<lambda>n. of_real (sin_coeff n) * (a*z)^n) sums (sin (a*z))" using sin_converges[of "a*z"]
       by (simp add: scaleR_conv_of_real)
     from sums_split_initial_segment[OF this, of 1]
       have "(\<lambda>n. (a*z) * of_real (sin_coeff (n+1)) * (a*z)^n) sums (sin (a*z))" by (simp add: mult_ac)
     from sums_mult[OF this, of "inverse (a*z)"] z a_nz
       have A: "(\<lambda>n. g n * (a*z)^n) sums (sin (a*z)/(a*z))"
       by (simp add: field_simps g_def)
     with z show "(\<lambda>n. g n * (a*z)^n) sums (G z)" by (simp add: G_def)
     from A z a_nz sin_nz have g_nz: "(\<Sum>n. g n * (a*z)^n) \<noteq> 0" by (simp add: sums_iff g_def)
 
     have [simp]: "sin_coeff (Suc 0) = 1" by (simp add: sin_coeff_def)
     from sums_split_initial_segment[OF sums_diff[OF cos_converges[of "a*z"] A], of 1]
     have "(\<lambda>n. z * f n * (a*z)^n) sums (cos (a*z) - sin (a*z) / (a*z))"
       by (simp add: mult_ac scaleR_conv_of_real ring_distribs f_def g_def)
     from sums_mult[OF this, of "inverse z"] z assms
       show "(\<lambda>n. f n * (a*z)^n) sums (F z)" by (simp add: divide_simps mult_ac f_def F_def)
   next
     assume z: "z = 0"
     have "(\<lambda>n. f n * (a * z) ^ n) sums f 0" using powser_sums_zero[of f] z by simp
     with z show "(\<lambda>n. f n * (a * z) ^ n) sums (F z)"
       by (simp add: f_def F_def sin_coeff_def cos_coeff_def)
     have "(\<lambda>n. g n * (a * z) ^ n) sums g 0" using powser_sums_zero[of g] z by simp
     with z show "(\<lambda>n. g n * (a * z) ^ n) sums (G z)"
       by (simp add: g_def G_def sin_coeff_def cos_coeff_def)
   qed
   note sums = conjunct1[OF this] conjunct2[OF this]
 
   define h2 where [abs_def]:
     "h2 z = (\<Sum>n. f n * (a*z)^n) / (\<Sum>n. g n * (a*z)^n) + Digamma (1 + z) - Digamma (1 - z)" for z
   define POWSER where [abs_def]: "POWSER f z = (\<Sum>n. f n * (z^n :: complex))" for f z
   define POWSER' where [abs_def]: "POWSER' f z = (\<Sum>n. diffs f n * (z^n))" for f and z :: complex
   define h2' where [abs_def]:
     "h2' z = a * (POWSER g (a*z) * POWSER' f (a*z) - POWSER f (a*z) * POWSER' g (a*z)) /
       (POWSER g (a*z))^2 + Polygamma 1 (1 + z) + Polygamma 1 (1 - z)" for z
 
   have h_eq: "h t = h2 t" if "abs (Re t) < 1" for t
   proof -
     from that have t: "t \<in> \<int> \<longleftrightarrow> t = 0" by (auto elim!: Ints_cases)
     hence "h t = a*cot (a*t) - 1/t + Digamma (1 + t) - Digamma (1 - t)"
       unfolding h_def using Digamma_plus1[of t] by (force simp: field_simps a_def)
     also have "a*cot (a*t) - 1/t = (F t) / (G t)"
       using t by (auto simp add: divide_simps sin_eq_0 cot_def a_def F_def G_def)
     also have "\<dots> = (\<Sum>n. f n * (a*t)^n) / (\<Sum>n. g n * (a*t)^n)"
       using sums[of t] that by (simp add: sums_iff)
     finally show "h t = h2 t" by (simp only: h2_def)
   qed
 
   let ?A = "{z. abs (Re z) < 1}"
   have "open ({z. Re z < 1} \<inter> {z. Re z > -1})"
     using open_halfspace_Re_gt open_halfspace_Re_lt by auto
   also have "({z. Re z < 1} \<inter> {z. Re z > -1}) = {z. abs (Re z) < 1}" by auto
   finally have open_A: "open ?A" .
   hence [simp]: "interior ?A = ?A" by (simp add: interior_open)
 
   have summable_f: "summable (\<lambda>n. f n * z^n)" for z
     by (rule powser_inside, rule sums_summable, rule sums[of "\<i> * of_real (norm z + 1) / a"])
        (simp_all add: norm_mult a_def del: of_real_add)
   have summable_g: "summable (\<lambda>n. g n * z^n)" for z
     by (rule powser_inside, rule sums_summable, rule sums[of "\<i> * of_real (norm z + 1) / a"])
        (simp_all add: norm_mult a_def del: of_real_add)
   have summable_fg': "summable (\<lambda>n. diffs f n * z^n)" "summable (\<lambda>n. diffs g n * z^n)" for z
     by (intro termdiff_converges_all summable_f summable_g)+
   have "(POWSER f has_field_derivative (POWSER' f z)) (at z)"
                "(POWSER g has_field_derivative (POWSER' g z)) (at z)" for z
     unfolding POWSER_def POWSER'_def
     by (intro termdiffs_strong_converges_everywhere summable_f summable_g)+
   note derivs = this[THEN DERIV_chain2[OF _ DERIV_cmult[OF DERIV_ident]], unfolded POWSER_def]
   have "isCont (POWSER f) z" "isCont (POWSER g) z" "isCont (POWSER' f) z" "isCont (POWSER' g) z"
     for z unfolding POWSER_def POWSER'_def
     by (intro isCont_powser_converges_everywhere summable_f summable_g summable_fg')+
   note cont = this[THEN isCont_o2[rotated], unfolded POWSER_def POWSER'_def]
 
   {
     fix z :: complex assume z: "abs (Re z) < 1"
     define d where "d = \<i> * of_real (norm z + 1)"
     have d: "abs (Re d) < 1" "norm z < norm d" by (simp_all add: d_def norm_mult del: of_real_add)
     have "eventually (\<lambda>z. h z = h2 z) (nhds z)"
       using eventually_nhds_in_nhd[of z ?A] using h_eq z
       by (auto elim!: eventually_mono)
 
     moreover from sums(2)[OF z] z have nz: "(\<Sum>n. g n * (a * z) ^ n) \<noteq> 0"
       unfolding G_def by (auto simp: sums_iff sin_eq_0 a_def)
     have A: "z \<in> \<int> \<longleftrightarrow> z = 0" using z by (auto elim!: Ints_cases)
     have no_int: "1 + z \<in> \<int> \<longleftrightarrow> z = 0" using z Ints_diff[of "1+z" 1] A
       by (auto elim!: nonpos_Ints_cases)
     have no_int': "1 - z \<in> \<int> \<longleftrightarrow> z = 0" using z Ints_diff[of 1 "1-z"] A
       by (auto elim!: nonpos_Ints_cases)
     from no_int no_int' have no_int: "1 - z \<notin> \<int>\<^sub>\<le>\<^sub>0" "1 + z \<notin> \<int>\<^sub>\<le>\<^sub>0" by auto
     have "(h2 has_field_derivative h2' z) (at z)" unfolding h2_def
       by (rule DERIV_cong, (rule derivative_intros refl derivs[unfolded POWSER_def] nz no_int)+)
          (auto simp: h2'_def POWSER_def field_simps power2_eq_square)
     ultimately have deriv: "(h has_field_derivative h2' z) (at z)"
       by (subst DERIV_cong_ev[OF refl _ refl])
 
     from sums(2)[OF z] z have "(\<Sum>n. g n * (a * z) ^ n) \<noteq> 0"
       unfolding G_def by (auto simp: sums_iff a_def sin_eq_0)
     hence "isCont h2' z" using no_int unfolding h2'_def[abs_def] POWSER_def POWSER'_def
       by (intro continuous_intros cont
             continuous_on_compose2[OF _ continuous_on_Polygamma[of "{z. Re z > 0}"]]) auto
     note deriv and this
   } note A = this
 
   interpret h: periodic_fun_simple' h
   proof
     fix z :: complex
     show "h (z + 1) = h z"
     proof (cases "z \<in> \<int>")
       assume z: "z \<notin> \<int>"
       hence A: "z + 1 \<notin> \<int>" "z \<noteq> 0" using Ints_diff[of "z+1" 1] by auto
       hence "Digamma (z + 1) - Digamma (-z) = Digamma z - Digamma (-z + 1)"
         by (subst (1 2) Digamma_plus1) simp_all
       with A z show "h (z + 1) = h z"
         by (simp add: h_def sin_plus_pi cos_plus_pi ring_distribs cot_def)
     qed (simp add: h_def)
   qed
 
   have h2'_eq: "h2' (z - 1) = h2' z" if z: "Re z > 0" "Re z < 1" for z
   proof -
     have "((\<lambda>z. h (z - 1)) has_field_derivative h2' (z - 1)) (at z)"
       by (rule DERIV_cong, rule DERIV_chain'[OF _ A(1)])
          (insert z, auto intro!: derivative_eq_intros)
     hence "(h has_field_derivative h2' (z - 1)) (at z)" by (subst (asm) h.minus_1)
     moreover from z have "(h has_field_derivative h2' z) (at z)" by (intro A) simp_all
     ultimately show "h2' (z - 1) = h2' z" by (rule DERIV_unique)
   qed
 
   define h2'' where "h2'' z = h2' (z - of_int \<lfloor>Re z\<rfloor>)" for z
   have deriv: "(h has_field_derivative h2'' z) (at z)" for z
   proof -
     fix z :: complex
     have B: "\<bar>Re z - real_of_int \<lfloor>Re z\<rfloor>\<bar> < 1" by linarith
     have "((\<lambda>t. h (t - of_int \<lfloor>Re z\<rfloor>)) has_field_derivative h2'' z) (at z)"
       unfolding h2''_def by (rule DERIV_cong, rule DERIV_chain'[OF _ A(1)])
                             (insert B, auto intro!: derivative_intros)
     thus "(h has_field_derivative h2'' z) (at z)" by (simp add: h.minus_of_int)
   qed
 
   have cont: "continuous_on UNIV h2''"
   proof (intro continuous_at_imp_continuous_on ballI)
     fix z :: complex
     define r where "r = \<lfloor>Re z\<rfloor>"
     define A where "A = {t. of_int r - 1 < Re t \<and> Re t < of_int r + 1}"
     have "continuous_on A (\<lambda>t. h2' (t - of_int r))" unfolding A_def
       by (intro continuous_at_imp_continuous_on isCont_o2[OF _ A(2)] ballI continuous_intros)
          (simp_all add: abs_real_def)
     moreover have "h2'' t = h2' (t - of_int r)" if t: "t \<in> A" for t
     proof (cases "Re t \<ge> of_int r")
       case True
       from t have "of_int r - 1 < Re t" "Re t < of_int r + 1" by (simp_all add: A_def)
       with True have "\<lfloor>Re t\<rfloor> = \<lfloor>Re z\<rfloor>" unfolding r_def by linarith
       thus ?thesis by (auto simp: r_def h2''_def)
     next
       case False
       from t have t: "of_int r - 1 < Re t" "Re t < of_int r + 1" by (simp_all add: A_def)
       with False have t': "\<lfloor>Re t\<rfloor> = \<lfloor>Re z\<rfloor> - 1" unfolding r_def by linarith
       moreover from t False have "h2' (t - of_int r + 1 - 1) = h2' (t - of_int r + 1)"
         by (intro h2'_eq) simp_all
       ultimately show ?thesis by (auto simp: r_def h2''_def algebra_simps t')
     qed
     ultimately have "continuous_on A h2''" by (subst continuous_on_cong[OF refl])
     moreover {
       have "open ({t. of_int r - 1 < Re t} \<inter> {t. of_int r + 1 > Re t})"
         by (intro open_Int open_halfspace_Re_gt open_halfspace_Re_lt)
       also have "{t. of_int r - 1 < Re t} \<inter> {t. of_int r + 1 > Re t} = A"
         unfolding A_def by blast
       finally have "open A" .
     }
     ultimately have C: "isCont h2'' t" if "t \<in> A" for t using that
       by (subst (asm) continuous_on_eq_continuous_at) auto
     have "of_int r - 1 < Re z" "Re z  < of_int r + 1" unfolding r_def by linarith+
     thus "isCont h2'' z" by (intro C) (simp_all add: A_def)
   qed
 
   from that[OF cont deriv] show ?thesis .
 qed
 
 lemma Gamma_reflection_complex:
   fixes z :: complex
   shows "Gamma z * Gamma (1 - z) = of_real pi / sin (of_real pi * z)"
 proof -
   let ?g = "\<lambda>z::complex. Gamma z * Gamma (1 - z) * sin (of_real pi * z)"
   define g where [abs_def]: "g z = (if z \<in> \<int> then of_real pi else ?g z)" for z :: complex
   let ?h = "\<lambda>z::complex. (of_real pi * cot (of_real pi*z) + Digamma z - Digamma (1 - z))"
   define h where [abs_def]: "h z = (if z \<in> \<int> then 0 else ?h z)" for z :: complex
 
   \<comment> \<open>@{term g} is periodic with period 1.\<close>
   interpret g: periodic_fun_simple' g
   proof
     fix z :: complex
     show "g (z + 1) = g z"
     proof (cases "z \<in> \<int>")
       case False
       hence "z * g z = z * Beta z (- z + 1) * sin (of_real pi * z)" by (simp add: g_def Beta_def)
       also have "z * Beta z (- z + 1) = (z + 1 + -z) * Beta (z + 1) (- z + 1)"
         using False Ints_diff[of 1 "1 - z"] nonpos_Ints_subset_Ints
         by (subst Beta_plus1_left [symmetric]) auto
       also have "\<dots> * sin (of_real pi * z) = z * (Beta (z + 1) (-z) * sin (of_real pi * (z + 1)))"
         using False Ints_diff[of "z+1" 1] Ints_minus[of "-z"] nonpos_Ints_subset_Ints
         by (subst Beta_plus1_right) (auto simp: ring_distribs sin_plus_pi)
       also from False have "Beta (z + 1) (-z) * sin (of_real pi * (z + 1)) = g (z + 1)"
         using Ints_diff[of "z+1" 1] by (auto simp: g_def Beta_def)
       finally show "g (z + 1) = g z" using False by (subst (asm) mult_left_cancel) auto
     qed (simp add: g_def)
   qed
 
   \<comment> \<open>@{term g} is entire.\<close>
   have g_g': "(g has_field_derivative (h z * g z)) (at z)" for z :: complex
   proof (cases "z \<in> \<int>")
     let ?h' = "\<lambda>z. Beta z (1 - z) * ((Digamma z - Digamma (1 - z)) * sin (z * of_real pi) +
                      of_real pi * cos (z * of_real pi))"
     case False
     from False have "eventually (\<lambda>t. t \<in> UNIV - \<int>) (nhds z)"
       by (intro eventually_nhds_in_open) (auto simp: open_Diff)
     hence "eventually (\<lambda>t. g t = ?g t) (nhds z)" by eventually_elim (simp add: g_def)
     moreover {
       from False Ints_diff[of 1 "1-z"] have "1 - z \<notin> \<int>" by auto
       hence "(?g has_field_derivative ?h' z) (at z)" using nonpos_Ints_subset_Ints
         by (auto intro!: derivative_eq_intros simp: algebra_simps Beta_def)
       also from False have "sin (of_real pi * z) \<noteq> 0" by (subst sin_eq_0) auto
       hence "?h' z = h z * g z"
         using False unfolding g_def h_def cot_def by (simp add: field_simps Beta_def)
       finally have "(?g has_field_derivative (h z * g z)) (at z)" .
     }
     ultimately show ?thesis by (subst DERIV_cong_ev[OF refl _ refl])
   next
     case True
     then obtain n where z: "z = of_int n" by (auto elim!: Ints_cases)
     let ?t = "(\<lambda>z::complex. if z = 0 then 1 else sin z / z) \<circ> (\<lambda>z. of_real pi * z)"
     have deriv_0: "(g has_field_derivative 0) (at 0)"
     proof (subst DERIV_cong_ev[OF refl _ refl])
       show "eventually (\<lambda>z. g z = of_real pi * Gamma (1 + z) * Gamma (1 - z) * ?t z) (nhds 0)"
         using eventually_nhds_ball[OF zero_less_one, of "0::complex"]
       proof eventually_elim
         fix z :: complex assume z: "z \<in> ball 0 1"
         show "g z = of_real pi * Gamma (1 + z) * Gamma (1 - z) * ?t z"
         proof (cases "z = 0")
           assume z': "z \<noteq> 0"
           with z have z'': "z \<notin> \<int>\<^sub>\<le>\<^sub>0" "z \<notin> \<int>" by (auto elim!: Ints_cases)
           from Gamma_plus1[OF this(1)] have "Gamma z = Gamma (z + 1) / z" by simp
           with z'' z' show ?thesis by (simp add: g_def ac_simps)
         qed (simp add: g_def)
       qed
       have "(?t has_field_derivative (0 * of_real pi)) (at 0)"
         using has_field_derivative_sin_z_over_z[of "UNIV :: complex set"]
         by (intro DERIV_chain) simp_all
       thus "((\<lambda>z. of_real pi * Gamma (1 + z) * Gamma (1 - z) * ?t z) has_field_derivative 0) (at 0)"
         by (auto intro!: derivative_eq_intros simp: o_def)
     qed
 
     have "((g \<circ> (\<lambda>x. x - of_int n)) has_field_derivative 0 * 1) (at (of_int n))"
       using deriv_0 by (intro DERIV_chain) (auto intro!: derivative_eq_intros)
     also have "g \<circ> (\<lambda>x. x - of_int n) = g" by (intro ext) (simp add: g.minus_of_int)
     finally show "(g has_field_derivative (h z * g z)) (at z)" by (simp add: z h_def)
   qed
 
   have g_eq: "g (z/2) * g ((z+1)/2) = Gamma (1/2)^2 * g z" if "Re z > -1" "Re z < 2" for z
   proof (cases "z \<in> \<int>")
     case True
     with that have "z = 0 \<or> z = 1" by (force elim!: Ints_cases)
     moreover have "g 0 * g (1/2) = Gamma (1/2)^2 * g 0"
       using fraction_not_in_ints[where 'a = complex, of 2 1] by (simp add: g_def power2_eq_square)
     moreover have "g (1/2) * g 1 = Gamma (1/2)^2 * g 1"
         using fraction_not_in_ints[where 'a = complex, of 2 1]
         by (simp add: g_def power2_eq_square Beta_def algebra_simps)
     ultimately show ?thesis by force
   next
     case False
     hence z: "z/2 \<notin> \<int>" "(z+1)/2 \<notin> \<int>" using Ints_diff[of "z+1" 1] by (auto elim!: Ints_cases)
     hence z': "z/2 \<notin> \<int>\<^sub>\<le>\<^sub>0" "(z+1)/2 \<notin> \<int>\<^sub>\<le>\<^sub>0" by (auto elim!: nonpos_Ints_cases)
     from z have "1-z/2 \<notin> \<int>" "1-((z+1)/2) \<notin> \<int>"
       using Ints_diff[of 1 "1-z/2"] Ints_diff[of 1 "1-((z+1)/2)"] by auto
     hence z'': "1-z/2 \<notin> \<int>\<^sub>\<le>\<^sub>0" "1-((z+1)/2) \<notin> \<int>\<^sub>\<le>\<^sub>0" by (auto elim!: nonpos_Ints_cases)
     from z have "g (z/2) * g ((z+1)/2) =
       (Gamma (z/2) * Gamma ((z+1)/2)) * (Gamma (1-z/2) * Gamma (1-((z+1)/2))) *
       (sin (of_real pi * z/2) * sin (of_real pi * (z+1)/2))"
       by (simp add: g_def)
     also from z' Gamma_legendre_duplication_aux[of "z/2"]
       have "Gamma (z/2) * Gamma ((z+1)/2) = exp ((1-z) * of_real (ln 2)) * Gamma (1/2) * Gamma z"
       by (simp add: add_divide_distrib)
     also from z'' Gamma_legendre_duplication_aux[of "1-(z+1)/2"]
       have "Gamma (1-z/2) * Gamma (1-(z+1)/2) =
               Gamma (1-z) * Gamma (1/2) * exp (z * of_real (ln 2))"
       by (simp add: add_divide_distrib ac_simps)
     finally have "g (z/2) * g ((z+1)/2) = Gamma (1/2)^2 * (Gamma z * Gamma (1-z) *
                     (2 * (sin (of_real pi*z/2) * sin (of_real pi*(z+1)/2))))"
       by (simp add: add_ac power2_eq_square exp_add ring_distribs exp_diff exp_of_real)
     also have "sin (of_real pi*(z+1)/2) = cos (of_real pi*z/2)"
       using cos_sin_eq[of "- of_real pi * z/2", symmetric]
       by (simp add: ring_distribs add_divide_distrib ac_simps)
     also have "2 * (sin (of_real pi*z/2) * cos (of_real pi*z/2)) = sin (of_real pi * z)"
       by (subst sin_times_cos) (simp add: field_simps)
     also have "Gamma z * Gamma (1 - z) * sin (complex_of_real pi * z) = g z"
       using \<open>z \<notin> \<int>\<close> by (simp add: g_def)
     finally show ?thesis .
   qed
   have g_eq: "g (z/2) * g ((z+1)/2) = Gamma (1/2)^2 * g z" for z
   proof -
     define r where "r = \<lfloor>Re z / 2\<rfloor>"
     have "Gamma (1/2)^2 * g z = Gamma (1/2)^2 * g (z - of_int (2*r))" by (simp only: g.minus_of_int)
     also have "of_int (2*r) = 2 * of_int r" by simp
     also have "Re z - 2 * of_int r > -1" "Re z - 2 * of_int r < 2" unfolding r_def by linarith+
     hence "Gamma (1/2)^2 * g (z - 2 * of_int r) =
                    g ((z - 2 * of_int r)/2) * g ((z - 2 * of_int r + 1)/2)"
       unfolding r_def by (intro g_eq[symmetric]) simp_all
     also have "(z - 2 * of_int r) / 2 = z/2 - of_int r" by simp
     also have "g \<dots> = g (z/2)" by (rule g.minus_of_int)
     also have "(z - 2 * of_int r + 1) / 2 = (z + 1)/2 - of_int r" by simp
     also have "g \<dots> = g ((z+1)/2)" by (rule g.minus_of_int)
     finally show ?thesis ..
   qed
 
   have g_nz [simp]: "g z \<noteq> 0" for z :: complex
   unfolding g_def using Ints_diff[of 1 "1 - z"]
     by (auto simp: Gamma_eq_zero_iff sin_eq_0 dest!: nonpos_Ints_Int)
 
   have h_eq: "h z = (h (z/2) + h ((z+1)/2)) / 2" for z
   proof -
     have "((\<lambda>t. g (t/2) * g ((t+1)/2)) has_field_derivative
                        (g (z/2) * g ((z+1)/2)) * ((h (z/2) + h ((z+1)/2)) / 2)) (at z)"
       by (auto intro!: derivative_eq_intros g_g'[THEN DERIV_chain2] simp: field_simps)
     hence "((\<lambda>t. Gamma (1/2)^2 * g t) has_field_derivative
               Gamma (1/2)^2 * g z * ((h (z/2) + h ((z+1)/2)) / 2)) (at z)"
       by (subst (1 2) g_eq[symmetric]) simp
     from DERIV_cmult[OF this, of "inverse ((Gamma (1/2))^2)"]
       have "(g has_field_derivative (g z * ((h (z/2) + h ((z+1)/2))/2))) (at z)"
       using fraction_not_in_ints[where 'a = complex, of 2 1]
       by (simp add: divide_simps Gamma_eq_zero_iff not_in_Ints_imp_not_in_nonpos_Ints)
     moreover have "(g has_field_derivative (g z * h z)) (at z)"
       using g_g'[of z] by (simp add: ac_simps)
     ultimately have "g z * h z = g z * ((h (z/2) + h ((z+1)/2))/2)"
       by (intro DERIV_unique)
     thus "h z = (h (z/2) + h ((z+1)/2)) / 2" by simp
   qed
 
   obtain h' where h'_cont: "continuous_on UNIV h'" and
                   h_h': "\<And>z. (h has_field_derivative h' z) (at z)"
      unfolding h_def by (erule Gamma_reflection_aux)
 
   have h'_eq: "h' z = (h' (z/2) + h' ((z+1)/2)) / 4" for z
   proof -
     have "((\<lambda>t. (h (t/2) + h ((t+1)/2)) / 2) has_field_derivative
                        ((h' (z/2) + h' ((z+1)/2)) / 4)) (at z)"
       by (fastforce intro!: derivative_eq_intros h_h'[THEN DERIV_chain2])
     hence "(h has_field_derivative ((h' (z/2) + h' ((z+1)/2))/4)) (at z)"
       by (subst (asm) h_eq[symmetric])
     from h_h' and this show "h' z = (h' (z/2) + h' ((z+1)/2)) / 4" by (rule DERIV_unique)
   qed
 
   have h'_zero: "h' z = 0" for z
   proof -
     define m where "m = max 1 \<bar>Re z\<bar>"
     define B where "B = {t. abs (Re t) \<le> m \<and> abs (Im t) \<le> abs (Im z)}"
     have "closed ({t. Re t \<ge> -m} \<inter> {t. Re t \<le> m} \<inter>
                   {t. Im t \<ge> -\<bar>Im z\<bar>} \<inter> {t. Im t \<le> \<bar>Im z\<bar>})"
       (is "closed ?B") by (intro closed_Int closed_halfspace_Re_ge closed_halfspace_Re_le
                                  closed_halfspace_Im_ge closed_halfspace_Im_le)
     also have "?B = B" unfolding B_def by fastforce
     finally have "closed B" .
     moreover have "bounded B" unfolding bounded_iff
     proof (intro ballI exI)
       fix t assume t: "t \<in> B"
       have "norm t \<le> \<bar>Re t\<bar> + \<bar>Im t\<bar>" by (rule cmod_le)
       also from t have "\<bar>Re t\<bar> \<le> m" unfolding B_def by blast
       also from t have "\<bar>Im t\<bar> \<le> \<bar>Im z\<bar>" unfolding B_def by blast
       finally show "norm t \<le> m + \<bar>Im z\<bar>" by - simp
     qed
     ultimately have compact: "compact B" by (subst compact_eq_bounded_closed) blast
 
     define M where "M = (SUP z\<in>B. norm (h' z))"
     have "compact (h' ` B)"
       by (intro compact_continuous_image continuous_on_subset[OF h'_cont] compact) blast+
     hence bdd: "bdd_above ((\<lambda>z. norm (h' z)) ` B)"
       using bdd_above_norm[of "h' ` B"] by (simp add: image_comp o_def compact_imp_bounded)
     have "norm (h' z) \<le> M" unfolding M_def by (intro cSUP_upper bdd) (simp_all add: B_def m_def)
     also have "M \<le> M/2"
     proof (subst M_def, subst cSUP_le_iff)
       have "z \<in> B" unfolding B_def m_def by simp
       thus "B \<noteq> {}" by auto
     next
       show "\<forall>z\<in>B. norm (h' z) \<le> M/2"
       proof
         fix t :: complex assume t: "t \<in> B"
         from h'_eq[of t] t have "h' t = (h' (t/2) + h' ((t+1)/2)) / 4" by (simp)
         also have "norm \<dots> = norm (h' (t/2) + h' ((t+1)/2)) / 4" by simp
         also have "norm (h' (t/2) + h' ((t+1)/2)) \<le> norm (h' (t/2)) + norm (h' ((t+1)/2))"
           by (rule norm_triangle_ineq)
         also from t have "abs (Re ((t + 1)/2)) \<le> m" unfolding m_def B_def by auto
         with t have "t/2 \<in> B" "(t+1)/2 \<in> B" unfolding B_def by auto
         hence "norm (h' (t/2)) + norm (h' ((t+1)/2)) \<le> M + M" unfolding M_def
           by (intro add_mono cSUP_upper bdd) (auto simp: B_def)
         also have "(M + M) / 4 = M / 2" by simp
         finally show "norm (h' t) \<le> M/2" by - simp_all
       qed
     qed (insert bdd, auto)
     hence "M \<le> 0" by simp
     finally show "h' z = 0" by simp
   qed
   have h_h'_2: "(h has_field_derivative 0) (at z)" for z
     using h_h'[of z] h'_zero[of z] by simp
 
   have g_real: "g z \<in> \<real>" if "z \<in> \<real>" for z
     unfolding g_def using that by (auto intro!: Reals_mult Gamma_complex_real)
   have h_real: "h z \<in> \<real>" if "z \<in> \<real>" for z
     unfolding h_def using that by (auto intro!: Reals_mult Reals_add Reals_diff Polygamma_Real)
   have g_nz: "g z \<noteq> 0" for z unfolding g_def using Ints_diff[of 1 "1-z"]
     by (auto simp: Gamma_eq_zero_iff sin_eq_0)
 
   from h'_zero h_h'_2 have "\<exists>c. \<forall>z\<in>UNIV. h z = c"
     by (intro has_field_derivative_zero_constant) (simp_all add: dist_0_norm)
   then obtain c where c: "\<And>z. h z = c" by auto
   have "\<exists>u. u \<in> closed_segment 0 1 \<and> Re (g 1) - Re (g 0) = Re (h u * g u * (1 - 0))"
     by (intro complex_mvt_line g_g')
   then obtain u where u: "u \<in> closed_segment 0 1" "Re (g 1) - Re (g 0) = Re (h u * g u)"
     by auto
   from u(1) have u': "u \<in> \<real>" unfolding closed_segment_def
     by (auto simp: scaleR_conv_of_real)
   from u' g_real[of u] g_nz[of u] have "Re (g u) \<noteq> 0" by (auto elim!: Reals_cases)
   with u(2) c[of u] g_real[of u] g_nz[of u] u'
     have "Re c = 0" by (simp add: complex_is_Real_iff g.of_1)
   with h_real[of 0] c[of 0] have "c = 0" by (auto elim!: Reals_cases)
   with c have A: "h z * g z = 0" for z by simp
   hence "(g has_field_derivative 0) (at z)" for z using g_g'[of z] by simp
   hence "\<exists>c'. \<forall>z\<in>UNIV. g z = c'" by (intro has_field_derivative_zero_constant) simp_all
   then obtain c' where c: "\<And>z. g z = c'" by (force)
   from this[of 0] have "c' = pi" unfolding g_def by simp
   with c have "g z = pi" by simp
 
   show ?thesis
   proof (cases "z \<in> \<int>")
     case False
     with \<open>g z = pi\<close> show ?thesis by (auto simp: g_def divide_simps)
   next
     case True
     then obtain n where n: "z = of_int n" by (elim Ints_cases)
     with sin_eq_0[of "of_real pi * z"] have "sin (of_real pi * z) = 0" by force
     moreover have "of_int (1 - n) \<in> \<int>\<^sub>\<le>\<^sub>0" if "n > 0" using that by (intro nonpos_Ints_of_int) simp
     ultimately show ?thesis using n
       by (cases "n \<le> 0") (auto simp: Gamma_eq_zero_iff nonpos_Ints_of_int)
   qed
 qed
 
 lemma rGamma_reflection_complex:
   "rGamma z * rGamma (1 - z :: complex) = sin (of_real pi * z) / of_real pi"
   using Gamma_reflection_complex[of z]
     by (simp add: Gamma_def field_split_simps split: if_split_asm)
 
 lemma rGamma_reflection_complex':
   "rGamma z * rGamma (- z :: complex) = -z * sin (of_real pi * z) / of_real pi"
 proof -
   have "rGamma z * rGamma (-z) = -z * (rGamma z * rGamma (1 - z))"
     using rGamma_plus1[of "-z", symmetric] by simp
   also have "rGamma z * rGamma (1 - z) = sin (of_real pi * z) / of_real pi"
     by (rule rGamma_reflection_complex)
   finally show ?thesis by simp
 qed
 
 lemma Gamma_reflection_complex':
   "Gamma z * Gamma (- z :: complex) = - of_real pi / (z * sin (of_real pi * z))"
   using rGamma_reflection_complex'[of z] by (force simp add: Gamma_def field_split_simps)
 
 
 
 lemma Gamma_one_half_real: "Gamma (1/2 :: real) = sqrt pi"
 proof -
   from Gamma_reflection_complex[of "1/2"] fraction_not_in_ints[where 'a = complex, of 2 1]
     have "Gamma (1/2 :: complex)^2 = of_real pi" by (simp add: power2_eq_square)
   hence "of_real pi = Gamma (complex_of_real (1/2))^2" by simp
   also have "\<dots> = of_real ((Gamma (1/2))^2)" by (subst Gamma_complex_of_real) simp_all
   finally have "Gamma (1/2)^2 = pi" by (subst (asm) of_real_eq_iff) simp_all
   moreover have "Gamma (1/2 :: real) \<ge> 0" using Gamma_real_pos[of "1/2"] by simp
   ultimately show ?thesis by (rule real_sqrt_unique [symmetric])
 qed
 
 lemma Gamma_one_half_complex: "Gamma (1/2 :: complex) = of_real (sqrt pi)"
 proof -
   have "Gamma (1/2 :: complex) = Gamma (of_real (1/2))" by simp
   also have "\<dots> = of_real (sqrt pi)" by (simp only: Gamma_complex_of_real Gamma_one_half_real)
   finally show ?thesis .
 qed
 
 theorem Gamma_legendre_duplication:
   fixes z :: complex
   assumes "z \<notin> \<int>\<^sub>\<le>\<^sub>0" "z + 1/2 \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows "Gamma z * Gamma (z + 1/2) =
              exp ((1 - 2*z) * of_real (ln 2)) * of_real (sqrt pi) * Gamma (2*z)"
   using Gamma_legendre_duplication_aux[OF assms] by (simp add: Gamma_one_half_complex)
 
 end
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Limits and residues\<close>
 
 text \<open>
   The inverse of the Gamma function has simple zeros:
 \<close>
 
 lemma rGamma_zeros:
   "(\<lambda>z. rGamma z / (z + of_nat n)) \<midarrow> (- of_nat n) \<rightarrow> ((-1)^n * fact n :: 'a :: Gamma)"
 proof (subst tendsto_cong)
   let ?f = "\<lambda>z. pochhammer z n * rGamma (z + of_nat (Suc n)) :: 'a"
   from eventually_at_ball'[OF zero_less_one, of "- of_nat n :: 'a" UNIV]
     show "eventually (\<lambda>z. rGamma z / (z + of_nat n) = ?f z) (at (- of_nat n))"
     by (subst pochhammer_rGamma[of _ "Suc n"])
        (auto elim!: eventually_mono simp: field_split_simps pochhammer_rec' eq_neg_iff_add_eq_0)
   have "isCont ?f (- of_nat n)" by (intro continuous_intros)
   thus "?f \<midarrow> (- of_nat n) \<rightarrow> (- 1) ^ n * fact n" unfolding isCont_def
     by (simp add: pochhammer_same)
 qed
 
 
 text \<open>
   The simple zeros of the inverse of the Gamma function correspond to simple poles of the Gamma function,
   and their residues can easily be computed from the limit we have just proven:
 \<close>
 
 lemma Gamma_poles: "filterlim Gamma at_infinity (at (- of_nat n :: 'a :: Gamma))"
 proof -
   from eventually_at_ball'[OF zero_less_one, of "- of_nat n :: 'a" UNIV]
     have "eventually (\<lambda>z. rGamma z \<noteq> (0 :: 'a)) (at (- of_nat n))"
     by (auto elim!: eventually_mono nonpos_Ints_cases'
              simp: rGamma_eq_zero_iff dist_of_nat dist_minus)
   with isCont_rGamma[of "- of_nat n :: 'a", OF continuous_ident]
     have "filterlim (\<lambda>z. inverse (rGamma z) :: 'a) at_infinity (at (- of_nat n))"
     unfolding isCont_def by (intro filterlim_compose[OF filterlim_inverse_at_infinity])
                             (simp_all add: filterlim_at)
   moreover have "(\<lambda>z. inverse (rGamma z) :: 'a) = Gamma"
     by (intro ext) (simp add: rGamma_inverse_Gamma)
   ultimately show ?thesis by (simp only: )
 qed
 
 lemma Gamma_residues:
   "(\<lambda>z. Gamma z * (z + of_nat n)) \<midarrow> (- of_nat n) \<rightarrow> ((-1)^n / fact n :: 'a :: Gamma)"
 proof (subst tendsto_cong)
   let ?c = "(- 1) ^ n / fact n :: 'a"
   from eventually_at_ball'[OF zero_less_one, of "- of_nat n :: 'a" UNIV]
     show "eventually (\<lambda>z. Gamma z * (z + of_nat n) = inverse (rGamma z / (z + of_nat n)))
             (at (- of_nat n))"
     by (auto elim!: eventually_mono simp: field_split_simps rGamma_inverse_Gamma)
   have "(\<lambda>z. inverse (rGamma z / (z + of_nat n))) \<midarrow> (- of_nat n) \<rightarrow>
           inverse ((- 1) ^ n * fact n :: 'a)"
     by (intro tendsto_intros rGamma_zeros) simp_all
   also have "inverse ((- 1) ^ n * fact n) = ?c"
     by (simp_all add: field_simps flip: power_mult_distrib)
   finally show "(\<lambda>z. inverse (rGamma z / (z + of_nat n))) \<midarrow> (- of_nat n) \<rightarrow> ?c" .
 qed
 
 
 subsection \<open>Alternative definitions\<close>
 
 
 subsubsection \<open>Variant of the Euler form\<close>
 
 
 definition Gamma_series_euler' where
   "Gamma_series_euler' z n =
      inverse z * (\<Prod>k=1..n. exp (z * of_real (ln (1 + inverse (of_nat k)))) / (1 + z / of_nat k))"
 
 context
 begin
 private lemma Gamma_euler'_aux1:
   fixes z :: "'a :: {real_normed_field,banach}"
   assumes n: "n > 0"
   shows "exp (z * of_real (ln (of_nat n + 1))) = (\<Prod>k=1..n. exp (z * of_real (ln (1 + 1 / of_nat k))))"
 proof -
   have "(\<Prod>k=1..n. exp (z * of_real (ln (1 + 1 / of_nat k)))) =
           exp (z * of_real (\<Sum>k = 1..n. ln (1 + 1 / real_of_nat k)))"
     by (subst exp_sum [symmetric]) (simp_all add: sum_distrib_left)
   also have "(\<Sum>k=1..n. ln (1 + 1 / of_nat k) :: real) = ln (\<Prod>k=1..n. 1 + 1 / real_of_nat k)"
     by (subst ln_prod [symmetric]) (auto intro!: add_pos_nonneg)
   also have "(\<Prod>k=1..n. 1 + 1 / of_nat k :: real) = (\<Prod>k=1..n. (of_nat k + 1) / of_nat k)"
     by (intro prod.cong) (simp_all add: field_split_simps)
   also have "(\<Prod>k=1..n. (of_nat k + 1) / of_nat k :: real) = of_nat n + 1"
     by (induction n) (simp_all add: prod.nat_ivl_Suc' field_split_simps)
   finally show ?thesis ..
 qed
 
 theorem Gamma_series_euler':
   assumes z: "(z :: 'a :: Gamma) \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows "(\<lambda>n. Gamma_series_euler' z n) \<longlonglongrightarrow> Gamma z"
 proof (rule Gamma_seriesI, rule Lim_transform_eventually)
   let ?f = "\<lambda>n. fact n * exp (z * of_real (ln (of_nat n + 1))) / pochhammer z (n + 1)"
   let ?r = "\<lambda>n. ?f n / Gamma_series z n"
   let ?r' = "\<lambda>n. exp (z * of_real (ln (of_nat (Suc n) / of_nat n)))"
   from z have z': "z \<noteq> 0" by auto
 
   have "eventually (\<lambda>n. ?r' n = ?r n) sequentially"
     using z by (auto simp: field_split_simps Gamma_series_def ring_distribs exp_diff ln_div
                      intro: eventually_mono eventually_gt_at_top[of "0::nat"] dest: pochhammer_eq_0_imp_nonpos_Int)
   moreover have "?r' \<longlonglongrightarrow> exp (z * of_real (ln 1))"
     by (intro tendsto_intros LIMSEQ_Suc_n_over_n) simp_all
   ultimately show "?r \<longlonglongrightarrow> 1" by (force intro: Lim_transform_eventually)
 
   from eventually_gt_at_top[of "0::nat"]
     show "eventually (\<lambda>n. ?r n = Gamma_series_euler' z n / Gamma_series z n) sequentially"
   proof eventually_elim
     fix n :: nat assume n: "n > 0"
     from n z' have "Gamma_series_euler' z n =
       exp (z * of_real (ln (of_nat n + 1))) / (z * (\<Prod>k=1..n. (1 + z / of_nat k)))"
       by (subst Gamma_euler'_aux1)
          (simp_all add: Gamma_series_euler'_def prod.distrib
                         prod_inversef[symmetric] divide_inverse)
     also have "(\<Prod>k=1..n. (1 + z / of_nat k)) = pochhammer (z + 1) n / fact n"
     proof (cases n)
       case (Suc n')
       then show ?thesis
         unfolding pochhammer_prod fact_prod
         by (simp add:  atLeastLessThanSuc_atLeastAtMost field_simps prod_dividef 
                   prod.atLeast_Suc_atMost_Suc_shift del: prod.cl_ivl_Suc)
     qed auto
     also have "z * \<dots> = pochhammer z (Suc n) / fact n" by (simp add: pochhammer_rec)
     finally show "?r n = Gamma_series_euler' z n / Gamma_series z n" by simp
   qed
 qed
 
 end
 
 
 
 subsubsection \<open>Weierstrass form\<close>
 
 definition Gamma_series_Weierstrass :: "'a :: {banach,real_normed_field} \<Rightarrow> nat \<Rightarrow> 'a" where
   "Gamma_series_Weierstrass z n =
      exp (-euler_mascheroni * z) / z * (\<Prod>k=1..n. exp (z / of_nat k) / (1 + z / of_nat k))"
 
 definition\<^marker>\<open>tag unimportant\<close>
   rGamma_series_Weierstrass :: "'a :: {banach,real_normed_field} \<Rightarrow> nat \<Rightarrow> 'a" where
   "rGamma_series_Weierstrass z n =
      exp (euler_mascheroni * z) * z * (\<Prod>k=1..n. (1 + z / of_nat k) * exp (-z / of_nat k))"
 
 lemma Gamma_series_Weierstrass_nonpos_Ints:
   "eventually (\<lambda>k. Gamma_series_Weierstrass (- of_nat n) k = 0) sequentially"
   using eventually_ge_at_top[of n] by eventually_elim (auto simp: Gamma_series_Weierstrass_def)
 
 lemma rGamma_series_Weierstrass_nonpos_Ints:
   "eventually (\<lambda>k. rGamma_series_Weierstrass (- of_nat n) k = 0) sequentially"
   using eventually_ge_at_top[of n] by eventually_elim (auto simp: rGamma_series_Weierstrass_def)
 
 theorem Gamma_Weierstrass_complex: "Gamma_series_Weierstrass z \<longlonglongrightarrow> Gamma (z :: complex)"
 proof (cases "z \<in> \<int>\<^sub>\<le>\<^sub>0")
   case True
   then obtain n where "z = - of_nat n" by (elim nonpos_Ints_cases')
   also from True have "Gamma_series_Weierstrass \<dots> \<longlonglongrightarrow> Gamma z"
     by (simp add: tendsto_cong[OF Gamma_series_Weierstrass_nonpos_Ints] Gamma_nonpos_Int)
   finally show ?thesis .
 next
   case False
   hence z: "z \<noteq> 0" by auto
   let ?f = "(\<lambda>x. \<Prod>x = Suc 0..x. exp (z / of_nat x) / (1 + z / of_nat x))"
   have A: "exp (ln (1 + z / of_nat n)) = (1 + z / of_nat n)" if "n \<ge> 1" for n :: nat
     using False that by (subst exp_Ln) (auto simp: field_simps dest!: plus_of_nat_eq_0_imp)
   have "(\<lambda>n. \<Sum>k=1..n. z / of_nat k - ln (1 + z / of_nat k)) \<longlonglongrightarrow> ln_Gamma z + euler_mascheroni * z + ln z"
     using ln_Gamma_series'_aux[OF False]
     by (simp only: atLeastLessThanSuc_atLeastAtMost [symmetric] One_nat_def
                    sum.shift_bounds_Suc_ivl sums_def atLeast0LessThan)
   from tendsto_exp[OF this] False z have "?f \<longlonglongrightarrow> z * exp (euler_mascheroni * z) * Gamma z"
     by (simp add: exp_add exp_sum exp_diff mult_ac Gamma_complex_altdef A)
   from tendsto_mult[OF tendsto_const[of "exp (-euler_mascheroni * z) / z"] this] z
     show "Gamma_series_Weierstrass z \<longlonglongrightarrow> Gamma z"
     by (simp add: exp_minus field_split_simps Gamma_series_Weierstrass_def [abs_def])
 qed
 
 lemma tendsto_complex_of_real_iff: "((\<lambda>x. complex_of_real (f x)) \<longlongrightarrow> of_real c) F = (f \<longlongrightarrow> c) F"
   by (rule tendsto_of_real_iff)
 
 lemma Gamma_Weierstrass_real: "Gamma_series_Weierstrass x \<longlonglongrightarrow> Gamma (x :: real)"
   using Gamma_Weierstrass_complex[of "of_real x"] unfolding Gamma_series_Weierstrass_def[abs_def]
   by (subst tendsto_complex_of_real_iff [symmetric])
      (simp_all add: exp_of_real[symmetric] Gamma_complex_of_real)
 
 lemma rGamma_Weierstrass_complex: "rGamma_series_Weierstrass z \<longlonglongrightarrow> rGamma (z :: complex)"
 proof (cases "z \<in> \<int>\<^sub>\<le>\<^sub>0")
   case True
   then obtain n where "z = - of_nat n" by (elim nonpos_Ints_cases')
   also from True have "rGamma_series_Weierstrass \<dots> \<longlonglongrightarrow> rGamma z"
     by (simp add: tendsto_cong[OF rGamma_series_Weierstrass_nonpos_Ints] rGamma_nonpos_Int)
   finally show ?thesis .
 next
   case False
   have "rGamma_series_Weierstrass z = (\<lambda>n. inverse (Gamma_series_Weierstrass z n))"
     by (simp add: rGamma_series_Weierstrass_def[abs_def] Gamma_series_Weierstrass_def
                   exp_minus divide_inverse prod_inversef[symmetric] mult_ac)
   also from False have "\<dots> \<longlonglongrightarrow> inverse (Gamma z)"
     by (intro tendsto_intros Gamma_Weierstrass_complex) (simp add: Gamma_eq_zero_iff)
   finally show ?thesis by (simp add: Gamma_def)
 qed
 
 subsubsection \<open>Binomial coefficient form\<close>
 
 lemma Gamma_gbinomial:
   "(\<lambda>n. ((z + of_nat n) gchoose n) * exp (-z * of_real (ln (of_nat n)))) \<longlonglongrightarrow> rGamma (z+1)"
 proof (cases "z = 0")
   case False
   show ?thesis
   proof (rule Lim_transform_eventually)
     let ?powr = "\<lambda>a b. exp (b * of_real (ln (of_nat a)))"
     show "eventually (\<lambda>n. rGamma_series z n / z =
             ((z + of_nat n) gchoose n) * ?powr n (-z)) sequentially"
     proof (intro always_eventually allI)
       fix n :: nat
       from False have "((z + of_nat n) gchoose n) = pochhammer z (Suc n) / z / fact n"
         by (simp add: gbinomial_pochhammer' pochhammer_rec)
       also have "pochhammer z (Suc n) / z / fact n * ?powr n (-z) = rGamma_series z n / z"
         by (simp add: rGamma_series_def field_split_simps exp_minus)
       finally show "rGamma_series z n / z = ((z + of_nat n) gchoose n) * ?powr n (-z)" ..
     qed
 
     from False have "(\<lambda>n. rGamma_series z n / z) \<longlonglongrightarrow> rGamma z / z" by (intro tendsto_intros)
     also from False have "rGamma z / z = rGamma (z + 1)" using rGamma_plus1[of z]
       by (simp add: field_simps)
     finally show "(\<lambda>n. rGamma_series z n / z) \<longlonglongrightarrow> rGamma (z+1)" .
   qed
 qed (simp_all add: binomial_gbinomial [symmetric])
 
 lemma gbinomial_minus': "(a + of_nat b) gchoose b = (- 1) ^ b * (- (a + 1) gchoose b)"
   by (subst gbinomial_minus) (simp add: power_mult_distrib [symmetric])
 
 lemma gbinomial_asymptotic:
   fixes z :: "'a :: Gamma"
   shows "(\<lambda>n. (z gchoose n) / ((-1)^n / exp ((z+1) * of_real (ln (real n))))) \<longlonglongrightarrow>
            inverse (Gamma (- z))"
   unfolding rGamma_inverse_Gamma [symmetric] using Gamma_gbinomial[of "-z-1"]
   by (subst (asm) gbinomial_minus')
      (simp add: add_ac mult_ac divide_inverse power_inverse [symmetric])
 
 lemma fact_binomial_limit:
   "(\<lambda>n. of_nat ((k + n) choose n) / of_nat (n ^ k) :: 'a :: Gamma) \<longlonglongrightarrow> 1 / fact k"
 proof (rule Lim_transform_eventually)
   have "(\<lambda>n. of_nat ((k + n) choose n) / of_real (exp (of_nat k * ln (real_of_nat n))))
             \<longlonglongrightarrow> 1 / Gamma (of_nat (Suc k) :: 'a)" (is "?f \<longlonglongrightarrow> _")
     using Gamma_gbinomial[of "of_nat k :: 'a"]
     by (simp add: binomial_gbinomial Gamma_def field_split_simps exp_of_real [symmetric] exp_minus)
   also have "Gamma (of_nat (Suc k)) = fact k" by (simp add: Gamma_fact)
   finally show "?f \<longlonglongrightarrow> 1 / fact k" .
 
   show "eventually (\<lambda>n. ?f n = of_nat ((k + n) choose n) / of_nat (n ^ k)) sequentially"
     using eventually_gt_at_top[of "0::nat"]
   proof eventually_elim
     fix n :: nat assume n: "n > 0"
     from n have "exp (real_of_nat k * ln (real_of_nat n)) = real_of_nat (n^k)"
       by (simp add: exp_of_nat_mult)
     thus "?f n = of_nat ((k + n) choose n) / of_nat (n ^ k)" by simp
   qed
 qed
 
 lemma binomial_asymptotic':
   "(\<lambda>n. of_nat ((k + n) choose n) / (of_nat (n ^ k) / fact k) :: 'a :: Gamma) \<longlonglongrightarrow> 1"
   using tendsto_mult[OF fact_binomial_limit[of k] tendsto_const[of "fact k :: 'a"]] by simp
 
 lemma gbinomial_Beta:
   assumes "z + 1 \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "((z::'a::Gamma) gchoose n) = inverse ((z + 1) * Beta (z - of_nat n + 1) (of_nat n + 1))"
 using assms
 proof (induction n arbitrary: z)
   case 0
   hence "z + 2 \<notin> \<int>\<^sub>\<le>\<^sub>0"
     using plus_one_in_nonpos_Ints_imp[of "z+1"] by (auto simp: add.commute)
   with 0 show ?case
     by (auto simp: Beta_def Gamma_eq_zero_iff Gamma_plus1 [symmetric] add.commute)
 next
   case (Suc n z)
   show ?case
   proof (cases "z \<in> \<int>\<^sub>\<le>\<^sub>0")
     case True
     with Suc.prems have "z = 0"
       by (auto elim!: nonpos_Ints_cases simp: algebra_simps one_plus_of_int_in_nonpos_Ints_iff)
     show ?thesis
     proof (cases "n = 0")
       case True
       with \<open>z = 0\<close> show ?thesis
         by (simp add: Beta_def Gamma_eq_zero_iff Gamma_plus1 [symmetric])
     next
       case False
       with \<open>z = 0\<close> show ?thesis
         by (simp_all add: Beta_pole1 one_minus_of_nat_in_nonpos_Ints_iff)
     qed
   next
     case False
     have "(z gchoose (Suc n)) = ((z - 1 + 1) gchoose (Suc n))" by simp
     also have "\<dots> = (z - 1 gchoose n) * ((z - 1) + 1) / of_nat (Suc n)"
       by (subst gbinomial_factors) (simp add: field_simps)
     also from False have "\<dots> = inverse (of_nat (Suc n) * Beta (z - of_nat n) (of_nat (Suc n)))"
       (is "_ = inverse ?x") by (subst Suc.IH) (simp_all add: field_simps Beta_pole1)
     also have "of_nat (Suc n) \<notin> (\<int>\<^sub>\<le>\<^sub>0 :: 'a set)" by (subst of_nat_in_nonpos_Ints_iff) simp_all
     hence "?x = (z + 1) * Beta (z - of_nat (Suc n) + 1) (of_nat (Suc n) + 1)"
       by (subst Beta_plus1_right [symmetric]) simp_all
     finally show ?thesis .
   qed
 qed
 
 theorem gbinomial_Gamma:
   assumes "z + 1 \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "(z gchoose n) = Gamma (z + 1) / (fact n * Gamma (z - of_nat n + 1))"
 proof -
   have "(z gchoose n) = Gamma (z + 2) / (z + 1) / (fact n * Gamma (z - of_nat n + 1))"
     by (subst gbinomial_Beta[OF assms]) (simp_all add: Beta_def Gamma_fact [symmetric] add_ac)
   also from assms have "Gamma (z + 2) / (z + 1) = Gamma (z + 1)"
     using Gamma_plus1[of "z+1"] by (auto simp add: field_split_simps)
   finally show ?thesis .
 qed
 
 
 subsubsection \<open>Integral form\<close>
 
 lemma integrable_on_powr_from_0':
   assumes a: "a > (-1::real)" and c: "c \<ge> 0"
   shows   "(\<lambda>x. x powr a) integrable_on {0<..c}"
 proof -
   from c have *: "{0<..c} - {0..c} = {}" "{0..c} - {0<..c} = {0}" by auto
   show ?thesis
   by (rule integrable_spike_set [OF integrable_on_powr_from_0[OF a c]]) (simp_all add: *)
 qed
 
 lemma absolutely_integrable_Gamma_integral:
   assumes "Re z > 0" "a > 0"
   shows   "(\<lambda>t. complex_of_real t powr (z - 1) / of_real (exp (a * t))) 
              absolutely_integrable_on {0<..}" (is "?f absolutely_integrable_on _")
 proof -
   have "((\<lambda>x. (Re z - 1) * (ln x / x)) \<longlongrightarrow> (Re z - 1) * 0) at_top"
     by (intro tendsto_intros ln_x_over_x_tendsto_0)
   hence "((\<lambda>x. ((Re z - 1) * ln x) / x) \<longlongrightarrow> 0) at_top" by simp
   from order_tendstoD(2)[OF this, of "a/2"] and \<open>a > 0\<close>
     have "eventually (\<lambda>x. (Re z - 1) * ln x / x < a/2) at_top" by simp
   from eventually_conj[OF this eventually_gt_at_top[of 0]]
     obtain x0 where "\<forall>x\<ge>x0. (Re z - 1) * ln x / x < a/2 \<and> x > 0"
       by (auto simp: eventually_at_top_linorder)
   hence "x0 > 0" by simp
   have "x powr (Re z - 1) / exp (a * x) < exp (-(a/2) * x)" if "x \<ge> x0" for x
   proof -
     from that and \<open>\<forall>x\<ge>x0. _\<close> have x: "(Re z - 1) * ln x / x < a / 2" "x > 0" by auto
     have "x powr (Re z - 1) = exp ((Re z - 1) * ln x)"
       using \<open>x > 0\<close> by (simp add: powr_def)
     also from x have "(Re z - 1) * ln x < (a * x) / 2" by (simp add: field_simps)
     finally show ?thesis by (simp add: field_simps exp_add [symmetric])
   qed
   note x0 = \<open>x0 > 0\<close> this
 
   have "?f absolutely_integrable_on ({0<..x0} \<union> {x0..})"
   proof (rule set_integrable_Un)
     show "?f absolutely_integrable_on {0<..x0}"
       unfolding set_integrable_def
     proof (rule Bochner_Integration.integrable_bound [OF _ _ AE_I2])
       show "integrable lebesgue (\<lambda>x. indicat_real {0<..x0} x *\<^sub>R x powr (Re z - 1))"         
         using x0(1) assms
         by (intro nonnegative_absolutely_integrable_1 [unfolded set_integrable_def] integrable_on_powr_from_0') auto
       show "(\<lambda>x. indicat_real {0<..x0} x *\<^sub>R (x powr (z - 1) / exp (a * x))) \<in> borel_measurable lebesgue"
         by (intro measurable_completion)
            (auto intro!: borel_measurable_continuous_on_indicator continuous_intros)
       fix x :: real 
       have "x powr (Re z - 1) / exp (a * x) \<le> x powr (Re z - 1) / 1" if "x \<ge> 0"
         using that assms by (intro divide_left_mono) auto
       thus "norm (indicator {0<..x0} x *\<^sub>R ?f x) \<le> 
                norm (indicator {0<..x0} x *\<^sub>R x powr (Re z - 1))"
         by (simp_all add: norm_divide norm_powr_real_powr indicator_def)
     qed
   next
     show "?f absolutely_integrable_on {x0..}"
       unfolding set_integrable_def
     proof (rule Bochner_Integration.integrable_bound [OF _ _ AE_I2])
       show "integrable lebesgue (\<lambda>x. indicat_real {x0..} x *\<^sub>R exp (- (a / 2) * x))" using assms
         by (intro nonnegative_absolutely_integrable_1 [unfolded set_integrable_def] integrable_on_exp_minus_to_infinity) auto
       show "(\<lambda>x. indicat_real {x0..} x *\<^sub>R (x powr (z - 1) / exp (a * x))) \<in> borel_measurable lebesgue" using x0(1)
         by (intro measurable_completion)
            (auto intro!: borel_measurable_continuous_on_indicator continuous_intros)
       fix x :: real 
       show "norm (indicator {x0..} x *\<^sub>R ?f x) \<le> 
                norm (indicator {x0..} x *\<^sub>R exp (-(a/2) * x))" using x0
         by (auto simp: norm_divide norm_powr_real_powr indicator_def less_imp_le)
     qed
   qed auto
   also have "{0<..x0} \<union> {x0..} = {0<..}" using x0(1) by auto
   finally show ?thesis .
 qed
 
 lemma integrable_Gamma_integral_bound:
   fixes a c :: real
   assumes a: "a > -1" and c: "c \<ge> 0"
   defines "f \<equiv> \<lambda>x. if x \<in> {0..c} then x powr a else exp (-x/2)"
   shows   "f integrable_on {0..}"
 proof -
   have "f integrable_on {0..c}"
     by (rule integrable_spike_finite[of "{}", OF _ _ integrable_on_powr_from_0[of a c]])
        (insert a c, simp_all add: f_def)
   moreover have A: "(\<lambda>x. exp (-x/2)) integrable_on {c..}"
     using integrable_on_exp_minus_to_infinity[of "1/2"] by simp
   have "f integrable_on {c..}"
     by (rule integrable_spike_finite[of "{c}", OF _ _ A]) (simp_all add: f_def)
   ultimately show "f integrable_on {0..}"
     by (rule integrable_Un') (insert c, auto simp: max_def)
 qed
 
 theorem Gamma_integral_complex:
   assumes z: "Re z > 0"
   shows   "((\<lambda>t. of_real t powr (z - 1) / of_real (exp t)) has_integral Gamma z) {0..}"
 proof -
   have A: "((\<lambda>t. (of_real t) powr (z - 1) * of_real ((1 - t) ^ n))
           has_integral (fact n / pochhammer z (n+1))) {0..1}"
     if "Re z > 0" for n z using that
   proof (induction n arbitrary: z)
     case 0
     have "((\<lambda>t. complex_of_real t powr (z - 1)) has_integral
             (of_real 1 powr z / z - of_real 0 powr z / z)) {0..1}" using 0
       by (intro fundamental_theorem_of_calculus_interior)
          (auto intro!: continuous_intros derivative_eq_intros has_vector_derivative_real_field)
     thus ?case by simp
   next
     case (Suc n)
     let ?f = "\<lambda>t. complex_of_real t powr z / z"
     let ?f' = "\<lambda>t. complex_of_real t powr (z - 1)"
     let ?g = "\<lambda>t. (1 - complex_of_real t) ^ Suc n"
     let ?g' = "\<lambda>t. - ((1 - complex_of_real t) ^ n) * of_nat (Suc n)"
     have "((\<lambda>t. ?f' t * ?g t) has_integral
             (of_nat (Suc n)) * fact n / pochhammer z (n+2)) {0..1}"
       (is "(_ has_integral ?I) _")
     proof (rule integration_by_parts_interior[where f' = ?f' and g = ?g])
       from Suc.prems show "continuous_on {0..1} ?f" "continuous_on {0..1} ?g"
         by (auto intro!: continuous_intros)
     next
       fix t :: real assume t: "t \<in> {0<..<1}"
       show "(?f has_vector_derivative ?f' t) (at t)" using t Suc.prems
         by (auto intro!: derivative_eq_intros has_vector_derivative_real_field)
       show "(?g has_vector_derivative ?g' t) (at t)"
         by (rule has_vector_derivative_real_field derivative_eq_intros refl)+ simp_all
     next
       from Suc.prems have [simp]: "z \<noteq> 0" by auto
       from Suc.prems have A: "Re (z + of_nat n) > 0" for n by simp
       have [simp]: "z + of_nat n \<noteq> 0" "z + 1 + of_nat n \<noteq> 0" for n
         using A[of n] A[of "Suc n"] by (auto simp add: add.assoc simp del: plus_complex.sel)
       have "((\<lambda>x. of_real x powr z * of_real ((1 - x) ^ n) * (- of_nat (Suc n) / z)) has_integral
               fact n / pochhammer (z+1) (n+1) * (- of_nat (Suc n) / z)) {0..1}"
         (is "(?A has_integral ?B) _")
         using Suc.IH[of "z+1"] Suc.prems by (intro has_integral_mult_left) (simp_all add: add_ac pochhammer_rec)
       also have "?A = (\<lambda>t. ?f t * ?g' t)" by (intro ext) (simp_all add: field_simps)
       also have "?B = - (of_nat (Suc n) * fact n / pochhammer z (n+2))"
         by (simp add: field_split_simps pochhammer_rec
               prod.shift_bounds_cl_Suc_ivl del: of_nat_Suc)
       finally show "((\<lambda>t. ?f t * ?g' t) has_integral (?f 1 * ?g 1 - ?f 0 * ?g 0 - ?I)) {0..1}"
         by simp
     qed (simp_all add: bounded_bilinear_mult)
     thus ?case by simp
   qed
 
   have B: "((\<lambda>t. if t \<in> {0..of_nat n} then
              of_real t powr (z - 1) * (1 - of_real t / of_nat n) ^ n else 0)
            has_integral (of_nat n powr z * fact n / pochhammer z (n+1))) {0..}" for n
   proof (cases "n > 0")
     case [simp]: True
     hence [simp]: "n \<noteq> 0" by auto
     with has_integral_affinity01[OF A[OF z, of n], of "inverse (of_nat n)" 0]
       have "((\<lambda>x. (of_nat n - of_real x) ^ n * (of_real x / of_nat n) powr (z - 1) / of_nat n ^ n)
               has_integral fact n * of_nat n / pochhammer z (n+1)) ((\<lambda>x. real n * x)`{0..1})"
       (is "(?f has_integral ?I) ?ivl") by (simp add: field_simps scaleR_conv_of_real)
     also from True have "((\<lambda>x. real n*x)`{0..1}) = {0..real n}"
       by (subst image_mult_atLeastAtMost) simp_all
     also have "?f = (\<lambda>x. (of_real x / of_nat n) powr (z - 1) * (1 - of_real x / of_nat n) ^ n)"
       using True by (intro ext) (simp add: field_simps)
     finally have "((\<lambda>x. (of_real x / of_nat n) powr (z - 1) * (1 - of_real x / of_nat n) ^ n)
                     has_integral ?I) {0..real n}" (is ?P) .
     also have "?P \<longleftrightarrow> ((\<lambda>x. exp ((z - 1) * of_real (ln (x / of_nat n))) * (1 - of_real x / of_nat n) ^ n)
                         has_integral ?I) {0..real n}"
       by (intro has_integral_spike_finite_eq[of "{0}"]) (auto simp: powr_def Ln_of_real [symmetric])
     also have "\<dots> \<longleftrightarrow> ((\<lambda>x. exp ((z - 1) * of_real (ln x - ln (of_nat n))) * (1 - of_real x / of_nat n) ^ n)
                         has_integral ?I) {0..real n}"
       by (intro has_integral_spike_finite_eq[of "{0}"]) (simp_all add: ln_div)
     finally have \<dots> .
     note B = has_integral_mult_right[OF this, of "exp ((z - 1) * ln (of_nat n))"]
     have "((\<lambda>x. exp ((z - 1) * of_real (ln x)) * (1 - of_real x / of_nat n) ^ n)
             has_integral (?I * exp ((z - 1) * ln (of_nat n)))) {0..real n}" (is ?P)
       by (insert B, subst (asm) mult.assoc [symmetric], subst (asm) exp_add [symmetric])
          (simp add: algebra_simps)
     also have "?P \<longleftrightarrow> ((\<lambda>x. of_real x powr (z - 1) * (1 - of_real x / of_nat n) ^ n)
             has_integral (?I * exp ((z - 1) * ln (of_nat n)))) {0..real n}"
       by (intro has_integral_spike_finite_eq[of "{0}"]) (simp_all add: powr_def Ln_of_real)
     also have "fact n * of_nat n / pochhammer z (n+1) * exp ((z - 1) * Ln (of_nat n)) =
                  (of_nat n powr z * fact n / pochhammer z (n+1))"
       by (auto simp add: powr_def algebra_simps exp_diff exp_of_real)
     finally show ?thesis by (subst has_integral_restrict) simp_all
   next
     case False
     thus ?thesis by (subst has_integral_restrict) (simp_all add: has_integral_refl)
   qed
 
   have "eventually (\<lambda>n. Gamma_series z n =
           of_nat n powr z * fact n / pochhammer z (n+1)) sequentially"
     using eventually_gt_at_top[of "0::nat"]
     by eventually_elim (simp add: powr_def algebra_simps Gamma_series_def)
   from this and Gamma_series_LIMSEQ[of z]
     have C: "(\<lambda>k. of_nat k powr z * fact k / pochhammer z (k+1)) \<longlonglongrightarrow> Gamma z"
     by (blast intro: Lim_transform_eventually)
   {
     fix x :: real assume x: "x \<ge> 0"
     have lim_exp: "(\<lambda>k. (1 - x / real k) ^ k) \<longlonglongrightarrow> exp (-x)"
       using tendsto_exp_limit_sequentially[of "-x"] by simp
     have "(\<lambda>k. of_real x powr (z - 1) * of_real ((1 - x / of_nat k) ^ k))
             \<longlonglongrightarrow> of_real x powr (z - 1) * of_real (exp (-x))" (is ?P)
       by (intro tendsto_intros lim_exp)
     also from eventually_gt_at_top[of "nat \<lceil>x\<rceil>"]
       have "eventually (\<lambda>k. of_nat k > x) sequentially" by eventually_elim linarith
     hence "?P \<longleftrightarrow> (\<lambda>k. if x \<le> of_nat k then
                  of_real x powr (z - 1) * of_real ((1 - x / of_nat k) ^ k) else 0)
                    \<longlonglongrightarrow> of_real x powr (z - 1) * of_real (exp (-x))"
       by (intro tendsto_cong) (auto elim!: eventually_mono)
     finally have \<dots> .
   }
   hence D: "\<forall>x\<in>{0..}. (\<lambda>k. if x \<in> {0..real k} then
               of_real x powr (z - 1) * (1 - of_real x / of_nat k) ^ k else 0)
              \<longlonglongrightarrow> of_real x powr (z - 1) / of_real (exp x)"
     by (simp add: exp_minus field_simps cong: if_cong)
 
   have "((\<lambda>x. (Re z - 1) * (ln x / x)) \<longlongrightarrow> (Re z - 1) * 0) at_top"
     by (intro tendsto_intros ln_x_over_x_tendsto_0)
   hence "((\<lambda>x. ((Re z - 1) * ln x) / x) \<longlongrightarrow> 0) at_top" by simp
   from order_tendstoD(2)[OF this, of "1/2"]
     have "eventually (\<lambda>x. (Re z - 1) * ln x / x < 1/2) at_top" by simp
   from eventually_conj[OF this eventually_gt_at_top[of 0]]
     obtain x0 where "\<forall>x\<ge>x0. (Re z - 1) * ln x / x < 1/2 \<and> x > 0"
     by (auto simp: eventually_at_top_linorder)
   hence x0: "x0 > 0" "\<And>x. x \<ge> x0 \<Longrightarrow> (Re z - 1) * ln x < x / 2" by auto
 
   define h where "h = (\<lambda>x. if x \<in> {0..x0} then x powr (Re z - 1) else exp (-x/2))"
   have le_h: "x powr (Re z - 1) * exp (-x) \<le> h x" if x: "x \<ge> 0" for x
   proof (cases "x > x0")
     case True
     from True x0(1) have "x powr (Re z - 1) * exp (-x) = exp ((Re z - 1) * ln x - x)"
       by (simp add: powr_def exp_diff exp_minus field_simps exp_add)
     also from x0(2)[of x] True have "\<dots> < exp (-x/2)"
       by (simp add: field_simps)
     finally show ?thesis using True by (auto simp add: h_def)
   next
     case False
     from x have "x powr (Re z - 1) * exp (- x) \<le> x powr (Re z - 1) * 1"
       by (intro mult_left_mono) simp_all
     with False show ?thesis by (auto simp add: h_def)
   qed
 
   have E: "\<forall>x\<in>{0..}. cmod (if x \<in> {0..real k} then of_real x powr (z - 1) *
                    (1 - complex_of_real x / of_nat k) ^ k else 0) \<le> h x"
     (is "\<forall>x\<in>_. ?f x \<le> _") for k
   proof safe
     fix x :: real assume x: "x \<ge> 0"
     {
       fix x :: real and n :: nat assume x: "x \<le> of_nat n"
       have "(1 - complex_of_real x / of_nat n) = complex_of_real ((1 - x / of_nat n))" by simp
       also have "norm \<dots> = \<bar>(1 - x / real n)\<bar>" by (subst norm_of_real) (rule refl)
       also from x have "\<dots> = (1 - x / real n)" by (intro abs_of_nonneg) (simp_all add: field_split_simps)
       finally have "cmod (1 - complex_of_real x / of_nat n) = 1 - x / real n" .
     } note D = this
     from D[of x k] x
       have "?f x \<le> (if of_nat k \<ge> x \<and> k > 0 then x powr (Re z - 1) * (1 - x / real k) ^ k else 0)"
       by (auto simp: norm_mult norm_powr_real_powr norm_power intro!: mult_nonneg_nonneg)
     also have "\<dots> \<le> x powr (Re z - 1) * exp  (-x)"
       by (auto intro!: mult_left_mono exp_ge_one_minus_x_over_n_power_n)
     also from x have "\<dots> \<le> h x" by (rule le_h)
     finally show "?f x \<le> h x" .
   qed
 
   have F: "h integrable_on {0..}" unfolding h_def
     by (rule integrable_Gamma_integral_bound) (insert assms x0(1), simp_all)
   show ?thesis
     by (rule has_integral_dominated_convergence[OF B F E D C])
 qed
 
 lemma Gamma_integral_real:
   assumes x: "x > (0 :: real)"
   shows   "((\<lambda>t. t powr (x - 1) / exp t) has_integral Gamma x) {0..}"
 proof -
   have A: "((\<lambda>t. complex_of_real t powr (complex_of_real x - 1) /
           complex_of_real (exp t)) has_integral complex_of_real (Gamma x)) {0..}"
     using Gamma_integral_complex[of x] assms by (simp_all add: Gamma_complex_of_real powr_of_real)
   have "((\<lambda>t. complex_of_real (t powr (x - 1) / exp t)) has_integral of_real (Gamma x)) {0..}"
     by (rule has_integral_eq[OF _ A]) (simp_all add: powr_of_real [symmetric])
   from has_integral_linear[OF this bounded_linear_Re] show ?thesis by (simp add: o_def)
 qed
 
 lemma absolutely_integrable_Gamma_integral':
   assumes "Re z > 0"
   shows   "(\<lambda>t. complex_of_real t powr (z - 1) / of_real (exp t)) absolutely_integrable_on {0<..}"
   using absolutely_integrable_Gamma_integral [OF assms zero_less_one] by simp
 
 lemma Gamma_integral_complex':
   assumes z: "Re z > 0"
   shows   "((\<lambda>t. of_real t powr (z - 1) / of_real (exp t)) has_integral Gamma z) {0<..}"
 proof -
   have "((\<lambda>t. of_real t powr (z - 1) / of_real (exp t)) has_integral Gamma z) {0..}"
     by (rule Gamma_integral_complex) fact+
   hence "((\<lambda>t. if t \<in> {0<..} then of_real t powr (z - 1) / of_real (exp t) else 0) 
            has_integral Gamma z) {0..}"
     by (rule has_integral_spike [of "{0}", rotated 2]) auto
   also have "?this = ?thesis"
     by (subst has_integral_restrict) auto
   finally show ?thesis .
 qed
 
 lemma Gamma_conv_nn_integral_real:
   assumes "s > (0::real)"
   shows   "Gamma s = nn_integral lborel (\<lambda>t. ennreal (indicator {0..} t * t powr (s - 1) / exp t))"
   using nn_integral_has_integral_lebesgue[OF _ Gamma_integral_real[OF assms]] by simp
 
 lemma integrable_Beta:
   assumes "a > 0" "b > (0::real)"
   shows   "set_integrable lborel {0..1} (\<lambda>t. t powr (a - 1) * (1 - t) powr (b - 1))"
 proof -
   define C where "C = max 1 ((1/2) powr (b - 1))"
   define D where "D = max 1 ((1/2) powr (a - 1))"
   have C: "(1 - x) powr (b - 1) \<le> C" if "x \<in> {0..1/2}" for x
   proof (cases "b < 1")
     case False
     with that have "(1 - x) powr (b - 1) \<le> (1 powr (b - 1))" by (intro powr_mono2) auto
     thus ?thesis by (auto simp: C_def)
   qed (insert that, auto simp: max.coboundedI1 max.coboundedI2 powr_mono2' powr_mono2 C_def)
   have D: "x powr (a - 1) \<le> D" if "x \<in> {1/2..1}" for x
   proof (cases "a < 1")
     case False
     with that have "x powr (a - 1) \<le> (1 powr (a - 1))" by (intro powr_mono2) auto
     thus ?thesis by (auto simp: D_def)
   next
     case True
   qed (insert that, auto simp: max.coboundedI1 max.coboundedI2 powr_mono2' powr_mono2 D_def)
   have [simp]: "C \<ge> 0" "D \<ge> 0" by (simp_all add: C_def D_def)
 
   have I1: "set_integrable lborel {0..1/2} (\<lambda>t. t powr (a - 1) * (1 - t) powr (b - 1))"
     unfolding set_integrable_def
   proof (rule Bochner_Integration.integrable_bound[OF _ _ AE_I2])
     have "(\<lambda>t. t powr (a - 1)) integrable_on {0..1/2}"
       by (rule integrable_on_powr_from_0) (use assms in auto)
     hence "(\<lambda>t. t powr (a - 1)) absolutely_integrable_on {0..1/2}"
       by (subst absolutely_integrable_on_iff_nonneg) auto
     from integrable_mult_right[OF this [unfolded set_integrable_def], of C]
     show "integrable lborel (\<lambda>x. indicat_real {0..1/2} x *\<^sub>R (C * x powr (a - 1)))"
       by (subst (asm) integrable_completion) (auto simp: mult_ac)
   next
     fix x :: real
     have "x powr (a - 1) * (1 - x) powr (b - 1) \<le> x powr (a - 1) * C" if "x \<in> {0..1/2}"
       using that by (intro mult_left_mono powr_mono2 C) auto
     thus "norm (indicator {0..1/2} x *\<^sub>R (x powr (a - 1) * (1 - x) powr (b - 1))) \<le>
             norm (indicator {0..1/2} x *\<^sub>R (C * x powr (a - 1)))"
       by (auto simp: indicator_def abs_mult mult_ac)
   qed (auto intro!: AE_I2 simp: indicator_def)
 
   have I2: "set_integrable lborel {1/2..1} (\<lambda>t. t powr (a - 1) * (1 - t) powr (b - 1))"
     unfolding set_integrable_def
   proof (rule Bochner_Integration.integrable_bound[OF _ _ AE_I2])
     have "(\<lambda>t. t powr (b - 1)) integrable_on {0..1/2}"
       by (rule integrable_on_powr_from_0) (use assms in auto)
     hence "(\<lambda>t. t powr (b - 1)) integrable_on (cbox 0 (1/2))" by simp
     from integrable_affinity[OF this, of "-1" 1]
       have "(\<lambda>t. (1 - t) powr (b - 1)) integrable_on {1/2..1}" by simp
     hence "(\<lambda>t. (1 - t) powr (b - 1)) absolutely_integrable_on {1/2..1}"
       by (subst absolutely_integrable_on_iff_nonneg) auto
     from integrable_mult_right[OF this [unfolded set_integrable_def], of D]
     show "integrable lborel (\<lambda>x. indicat_real {1/2..1} x *\<^sub>R (D * (1 - x) powr (b - 1)))"
       by (subst (asm) integrable_completion) (auto simp: mult_ac)
   next
     fix x :: real
     have "x powr (a - 1) * (1 - x) powr (b - 1) \<le> D * (1 - x) powr (b - 1)" if "x \<in> {1/2..1}"
       using that by (intro mult_right_mono powr_mono2 D) auto
     thus "norm (indicator {1/2..1} x *\<^sub>R (x powr (a - 1) * (1 - x) powr (b - 1))) \<le>
             norm (indicator {1/2..1} x *\<^sub>R (D * (1 - x) powr (b - 1)))"
       by (auto simp: indicator_def abs_mult mult_ac)
   qed (auto intro!: AE_I2 simp: indicator_def)
 
   have "set_integrable lborel ({0..1/2} \<union> {1/2..1}) (\<lambda>t. t powr (a - 1) * (1 - t) powr (b - 1))"
     by (intro set_integrable_Un I1 I2) auto
   also have "{0..1/2} \<union> {1/2..1} = {0..(1::real)}" by auto
   finally show ?thesis .
 qed
 
 lemma integrable_Beta':
   assumes "a > 0" "b > (0::real)"
   shows   "(\<lambda>t. t powr (a - 1) * (1 - t) powr (b - 1)) integrable_on {0..1}"
   using integrable_Beta[OF assms] by (rule set_borel_integral_eq_integral)
 
 theorem has_integral_Beta_real:
   assumes a: "a > 0" and b: "b > (0 :: real)"
   shows "((\<lambda>t. t powr (a - 1) * (1 - t) powr (b - 1)) has_integral Beta a b) {0..1}"
 proof -
   define B where "B = integral {0..1} (\<lambda>x. x powr (a - 1) * (1 - x) powr (b - 1))"
   have [simp]: "B \<ge> 0" unfolding B_def using a b
     by (intro integral_nonneg integrable_Beta') auto
   from a b have "ennreal (Gamma a * Gamma b) =
     (\<integral>\<^sup>+ t. ennreal (indicator {0..} t * t powr (a - 1) / exp t) \<partial>lborel) *
     (\<integral>\<^sup>+ t. ennreal (indicator {0..} t * t powr (b - 1) / exp t) \<partial>lborel)"
     by (subst ennreal_mult') (simp_all add: Gamma_conv_nn_integral_real)
   also have "\<dots> = (\<integral>\<^sup>+t. \<integral>\<^sup>+u. ennreal (indicator {0..} t * t powr (a - 1) / exp t) *
                             ennreal (indicator {0..} u * u powr (b - 1) / exp u) \<partial>lborel \<partial>lborel)"
     by (simp add: nn_integral_cmult nn_integral_multc)
   also have "\<dots> = (\<integral>\<^sup>+t. \<integral>\<^sup>+u. ennreal (indicator ({0..}\<times>{0..}) (t,u) * t powr (a - 1) * u powr (b - 1)
                             / exp (t + u)) \<partial>lborel \<partial>lborel)"
     by (intro nn_integral_cong)
        (auto simp: indicator_def divide_ennreal ennreal_mult' [symmetric] exp_add)
   also have "\<dots> = (\<integral>\<^sup>+t. \<integral>\<^sup>+u. ennreal (indicator ({0..}\<times>{t..}) (t,u) * t powr (a - 1) * 
                               (u - t) powr (b - 1) / exp u) \<partial>lborel \<partial>lborel)"
   proof (rule nn_integral_cong, goal_cases)
     case (1 t)
     have "(\<integral>\<^sup>+u. ennreal (indicator ({0..}\<times>{0..}) (t,u) * t powr (a - 1) * 
                               u powr (b - 1) / exp (t + u)) \<partial>distr lborel borel ((+) (-t))) =
                (\<integral>\<^sup>+u. ennreal (indicator ({0..}\<times>{t..}) (t,u) * t powr (a - 1) * 
                               (u - t) powr (b - 1) / exp u) \<partial>lborel)"
       by (subst nn_integral_distr) (auto intro!: nn_integral_cong simp: indicator_def)
     thus ?case by (subst (asm) lborel_distr_plus)
   qed
   also have "\<dots> = (\<integral>\<^sup>+u. \<integral>\<^sup>+t. ennreal (indicator ({0..}\<times>{t..}) (t,u) * t powr (a - 1) * 
                               (u - t) powr (b - 1) / exp u) \<partial>lborel \<partial>lborel)"
     by (subst lborel_pair.Fubini')
        (auto simp: case_prod_unfold indicator_def cong: measurable_cong_sets)
   also have "\<dots> = (\<integral>\<^sup>+u. \<integral>\<^sup>+t. ennreal (indicator {0..u} t * t powr (a - 1) * (u - t) powr (b - 1)) *
                               ennreal (indicator {0..} u / exp u) \<partial>lborel \<partial>lborel)"
     by (intro nn_integral_cong) (auto simp: indicator_def ennreal_mult' [symmetric])
   also have "\<dots> = (\<integral>\<^sup>+u. (\<integral>\<^sup>+t. ennreal (indicator {0..u} t * t powr (a - 1) * (u - t) powr (b - 1)) 
                           \<partial>lborel) * ennreal (indicator {0..} u / exp u) \<partial>lborel)"
     by (subst nn_integral_multc [symmetric]) auto 
   also have "\<dots> = (\<integral>\<^sup>+u. (\<integral>\<^sup>+t. ennreal (indicator {0..u} t * t powr (a - 1) * (u - t) powr (b - 1)) 
                           \<partial>lborel) * ennreal (indicator {0<..} u / exp u) \<partial>lborel)"
     by (intro nn_integral_cong_AE eventually_mono[OF AE_lborel_singleton[of 0]]) 
        (auto simp: indicator_def)
   also have "\<dots> = (\<integral>\<^sup>+u. ennreal B * ennreal (indicator {0..} u / exp u * u powr (a + b - 1)) \<partial>lborel)"
   proof (intro nn_integral_cong, goal_cases)
     case (1 u)
     show ?case
     proof (cases "u > 0")
       case True
       have "(\<integral>\<^sup>+t. ennreal (indicator {0..u} t * t powr (a - 1) * (u - t) powr (b - 1)) \<partial>lborel) = 
               (\<integral>\<^sup>+t. ennreal (indicator {0..1} t * (u * t) powr (a - 1) * (u - u * t) powr (b - 1)) 
                 \<partial>distr lborel borel ((*) (1 / u)))" (is "_ = nn_integral _ ?f")
         using True
         by (subst nn_integral_distr) (auto simp: indicator_def field_simps intro!: nn_integral_cong)
       also have "distr lborel borel ((*) (1 / u)) = density lborel (\<lambda>_. u)"
         using \<open>u > 0\<close> by (subst lborel_distr_mult) auto
       also have "nn_integral \<dots> ?f = (\<integral>\<^sup>+x. ennreal (indicator {0..1} x * (u * (u * x) powr (a - 1) *
                                               (u * (1 - x)) powr (b - 1))) \<partial>lborel)" using \<open>u > 0\<close>
         by (subst nn_integral_density) (auto simp: ennreal_mult' [symmetric] algebra_simps)
       also have "\<dots> = (\<integral>\<^sup>+x. ennreal (u powr (a + b - 1)) * 
                             ennreal (indicator {0..1} x * x powr (a - 1) *
                                        (1 - x) powr (b - 1)) \<partial>lborel)" using \<open>u > 0\<close> a b
         by (intro nn_integral_cong)
            (auto simp: indicator_def powr_mult powr_add powr_diff mult_ac ennreal_mult' [symmetric])
       also have "\<dots> = ennreal (u powr (a + b - 1)) * 
                         (\<integral>\<^sup>+x. ennreal (indicator {0..1} x * x powr (a - 1) *
                                          (1 - x) powr (b - 1)) \<partial>lborel)"
         by (subst nn_integral_cmult) auto
       also have "((\<lambda>x. x powr (a - 1) * (1 - x) powr (b - 1)) has_integral 
                    integral {0..1} (\<lambda>x. x powr (a - 1) * (1 - x) powr (b - 1))) {0..1}"
         using a b by (intro integrable_integral integrable_Beta')
       from nn_integral_has_integral_lebesgue[OF _ this] a b
         have "(\<integral>\<^sup>+x. ennreal (indicator {0..1} x * x powr (a - 1) *
                          (1 - x) powr (b - 1)) \<partial>lborel) = B" by (simp add: mult_ac B_def)
       finally show ?thesis using \<open>u > 0\<close> by (simp add: ennreal_mult' [symmetric] mult_ac)
     qed auto
   qed
   also have "\<dots> = ennreal B * ennreal (Gamma (a + b))"
     using a b by (subst nn_integral_cmult) (auto simp: Gamma_conv_nn_integral_real)
   also have "\<dots> = ennreal (B * Gamma (a + b))"
     by (subst (1 2) mult.commute, intro ennreal_mult' [symmetric]) (use a b in auto)
   finally have "B = Beta a b" using a b Gamma_real_pos[of "a + b"]
     by (subst (asm) ennreal_inj) (auto simp: field_simps Beta_def Gamma_eq_zero_iff)
   moreover have "(\<lambda>t. t powr (a - 1) * (1 - t) powr (b - 1)) integrable_on {0..1}"
     by (intro integrable_Beta' a b)
   ultimately show ?thesis by (simp add: has_integral_iff B_def)
 qed
 
 
 subsection \<open>The Weierstra{\ss} product formula for the sine\<close>
 
 theorem sin_product_formula_complex:
   fixes z :: complex
   shows "(\<lambda>n. of_real pi * z * (\<Prod>k=1..n. 1 - z^2 / of_nat k^2)) \<longlonglongrightarrow> sin (of_real pi * z)"
 proof -
   let ?f = "rGamma_series_Weierstrass"
   have "(\<lambda>n. (- of_real pi * inverse z) * (?f z n * ?f (- z) n))
             \<longlonglongrightarrow> (- of_real pi * inverse z) * (rGamma z * rGamma (- z))"
     by (intro tendsto_intros rGamma_Weierstrass_complex)
   also have "(\<lambda>n. (- of_real pi * inverse z) * (?f z n * ?f (-z) n)) =
                     (\<lambda>n. of_real pi * z * (\<Prod>k=1..n. 1 - z^2 / of_nat k ^ 2))"
   proof
     fix n :: nat
     have "(- of_real pi * inverse z) * (?f z n * ?f (-z) n) =
               of_real pi * z * (\<Prod>k=1..n. (of_nat k - z) * (of_nat k + z) / of_nat k ^ 2)"
       by (simp add: rGamma_series_Weierstrass_def mult_ac exp_minus
                     divide_simps prod.distrib[symmetric] power2_eq_square)
     also have "(\<Prod>k=1..n. (of_nat k - z) * (of_nat k + z) / of_nat k ^ 2) =
                  (\<Prod>k=1..n. 1 - z^2 / of_nat k ^ 2)"
       by (intro prod.cong) (simp_all add: power2_eq_square field_simps)
     finally show "(- of_real pi * inverse z) * (?f z n * ?f (-z) n) = of_real pi * z * \<dots>"
       by (simp add: field_split_simps)
   qed
   also have "(- of_real pi * inverse z) * (rGamma z * rGamma (- z)) = sin (of_real pi * z)"
     by (subst rGamma_reflection_complex') (simp add: field_split_simps)
   finally show ?thesis .
 qed
 
 lemma sin_product_formula_real:
   "(\<lambda>n. pi * (x::real) * (\<Prod>k=1..n. 1 - x^2 / of_nat k^2)) \<longlonglongrightarrow> sin (pi * x)"
 proof -
   from sin_product_formula_complex[of "of_real x"]
     have "(\<lambda>n. of_real pi * of_real x * (\<Prod>k=1..n. 1 - (of_real x)^2 / (of_nat k)^2))
               \<longlonglongrightarrow> sin (of_real pi * of_real x :: complex)" (is "?f \<longlonglongrightarrow> ?y") .
   also have "?f = (\<lambda>n. of_real (pi * x * (\<Prod>k=1..n. 1 - x^2 / (of_nat k^2))))" by simp
   also have "?y = of_real (sin (pi * x))" by (simp only: sin_of_real [symmetric] of_real_mult)
   finally show ?thesis by (subst (asm) tendsto_of_real_iff)
 qed
 
 lemma sin_product_formula_real':
   assumes "x \<noteq> (0::real)"
   shows   "(\<lambda>n. (\<Prod>k=1..n. 1 - x^2 / of_nat k^2)) \<longlonglongrightarrow> sin (pi * x) / (pi * x)"
   using tendsto_divide[OF sin_product_formula_real[of x] tendsto_const[of "pi * x"]] assms
   by simp
 
 theorem wallis: "(\<lambda>n. \<Prod>k=1..n. (4*real k^2) / (4*real k^2 - 1)) \<longlonglongrightarrow> pi / 2"
 proof -
   from tendsto_inverse[OF tendsto_mult[OF
          sin_product_formula_real[of "1/2"] tendsto_const[of "2/pi"]]]
     have "(\<lambda>n. (\<Prod>k=1..n. inverse (1 - (1/2)\<^sup>2 / (real k)\<^sup>2))) \<longlonglongrightarrow> pi/2"
     by (simp add: prod_inversef [symmetric])
   also have "(\<lambda>n. (\<Prod>k=1..n. inverse (1 - (1/2)\<^sup>2 / (real k)\<^sup>2))) =
                (\<lambda>n. (\<Prod>k=1..n. (4*real k^2)/(4*real k^2 - 1)))"
     by (intro ext prod.cong refl) (simp add: field_split_simps)
   finally show ?thesis .
 qed
 
 
 subsection \<open>The Solution to the Basel problem\<close>
 
 theorem inverse_squares_sums: "(\<lambda>n. 1 / (n + 1)\<^sup>2) sums (pi\<^sup>2 / 6)"
 proof -
   define P where "P x n = (\<Prod>k=1..n. 1 - x^2 / of_nat k^2)" for x :: real and n
   define K where "K = (\<Sum>n. inverse (real_of_nat (Suc n))^2)"
   define f where [abs_def]: "f x = (\<Sum>n. P x n / of_nat (Suc n)^2)" for x
   define g where [abs_def]: "g x = (1 - sin (pi * x) / (pi * x))" for x
 
   have sums: "(\<lambda>n. P x n / of_nat (Suc n)^2) sums (if x = 0 then K else g x / x^2)" for x
   proof (cases "x = 0")
     assume x: "x = 0"
     have "summable (\<lambda>n. inverse ((real_of_nat (Suc n))\<^sup>2))"
       using inverse_power_summable[of 2] by (subst summable_Suc_iff) simp
     thus ?thesis by (simp add: x g_def P_def K_def inverse_eq_divide power_divide summable_sums)
   next
     assume x: "x \<noteq> 0"
     have "(\<lambda>n. P x n - P x (Suc n)) sums (P x 0 - sin (pi * x) / (pi * x))"
       unfolding P_def using x by (intro telescope_sums' sin_product_formula_real')
     also have "(\<lambda>n. P x n - P x (Suc n)) = (\<lambda>n. (x^2 / of_nat (Suc n)^2) * P x n)"
       unfolding P_def by (simp add: prod.nat_ivl_Suc' algebra_simps)
     also have "P x 0 = 1" by (simp add: P_def)
     finally have "(\<lambda>n. x\<^sup>2 / (of_nat (Suc n))\<^sup>2 * P x n) sums (1 - sin (pi * x) / (pi * x))" .
     from sums_divide[OF this, of "x^2"] x show ?thesis unfolding g_def by simp
   qed
 
   have "continuous_on (ball 0 1) f"
   proof (rule uniform_limit_theorem; (intro always_eventually allI)?)
     show "uniform_limit (ball 0 1) (\<lambda>n x. \<Sum>k<n. P x k / of_nat (Suc k)^2) f sequentially"
     proof (unfold f_def, rule Weierstrass_m_test)
       fix n :: nat and x :: real assume x: "x \<in> ball 0 1"
       {
         fix k :: nat assume k: "k \<ge> 1"
         from x have "x^2 < 1" by (auto simp: abs_square_less_1)
         also from k have "\<dots> \<le> of_nat k^2" by simp
         finally have "(1 - x^2 / of_nat k^2) \<in> {0..1}" using k
           by (simp_all add: field_simps del: of_nat_Suc)
       }
       hence "(\<Prod>k=1..n. abs (1 - x^2 / of_nat k^2)) \<le> (\<Prod>k=1..n. 1)" by (intro prod_mono) simp
       thus "norm (P x n / (of_nat (Suc n)^2)) \<le> 1 / of_nat (Suc n)^2"
         unfolding P_def by (simp add: field_simps abs_prod del: of_nat_Suc)
     qed (subst summable_Suc_iff, insert inverse_power_summable[of 2], simp add: inverse_eq_divide)
   qed (auto simp: P_def intro!: continuous_intros)
   hence "isCont f 0" by (subst (asm) continuous_on_eq_continuous_at) simp_all
   hence "(f \<midarrow> 0 \<rightarrow> f 0)" by (simp add: isCont_def)
   also have "f 0 = K" unfolding f_def P_def K_def by (simp add: inverse_eq_divide power_divide)
   finally have "f \<midarrow> 0 \<rightarrow> K" .
 
   moreover have "f \<midarrow> 0 \<rightarrow> pi^2 / 6"
   proof (rule Lim_transform_eventually)
     define f' where [abs_def]: "f' x = (\<Sum>n. - sin_coeff (n+3) * pi ^ (n+2) * x^n)" for x
     have "eventually (\<lambda>x. x \<noteq> (0::real)) (at 0)"
       by (auto simp add: eventually_at intro!: exI[of _ 1])
     thus "eventually (\<lambda>x. f' x = f x) (at 0)"
     proof eventually_elim
       fix x :: real assume x: "x \<noteq> 0"
       have "sin_coeff 1 = (1 :: real)" "sin_coeff 2 = (0::real)" by (simp_all add: sin_coeff_def)
       with sums_split_initial_segment[OF sums_minus[OF sin_converges], of 3 "pi*x"]
       have "(\<lambda>n. - (sin_coeff (n+3) * (pi*x)^(n+3))) sums (pi * x - sin (pi*x))"
         by (simp add: eval_nat_numeral)
       from sums_divide[OF this, of "x^3 * pi"] x
         have "(\<lambda>n. - (sin_coeff (n+3) * pi^(n+2) * x^n)) sums ((1 - sin (pi*x) / (pi*x)) / x^2)"
         by (simp add: field_split_simps eval_nat_numeral)
       with x have "(\<lambda>n. - (sin_coeff (n+3) * pi^(n+2) * x^n)) sums (g x / x^2)"
         by (simp add: g_def)
       hence "f' x = g x / x^2" by (simp add: sums_iff f'_def)
       also have "\<dots> = f x" using sums[of x] x by (simp add: sums_iff g_def f_def)
       finally show "f' x = f x" .
     qed
 
     have "isCont f' 0" unfolding f'_def
     proof (intro isCont_powser_converges_everywhere)
       fix x :: real show "summable (\<lambda>n. -sin_coeff (n+3) * pi^(n+2) * x^n)"
       proof (cases "x = 0")
         assume x: "x \<noteq> 0"
         from summable_divide[OF sums_summable[OF sums_split_initial_segment[OF
                sin_converges[of "pi*x"]], of 3], of "-pi*x^3"] x
           show ?thesis by (simp add: field_split_simps eval_nat_numeral)
       qed (simp only: summable_0_powser)
     qed
     hence "f' \<midarrow> 0 \<rightarrow> f' 0" by (simp add: isCont_def)
     also have "f' 0 = pi * pi / fact 3" unfolding f'_def
       by (subst powser_zero) (simp add: sin_coeff_def)
     finally show "f' \<midarrow> 0 \<rightarrow> pi^2 / 6" by (simp add: eval_nat_numeral)
   qed
 
   ultimately have "K = pi^2 / 6" by (rule LIM_unique)
   moreover from inverse_power_summable[of 2]
     have "summable (\<lambda>n. (inverse (real_of_nat (Suc n)))\<^sup>2)"
     by (subst summable_Suc_iff) (simp add: power_inverse)
   ultimately show ?thesis unfolding K_def
     by (auto simp add: sums_iff power_divide inverse_eq_divide)
 qed
 
 end
diff --git a/src/HOL/Analysis/Interval_Integral.thy b/src/HOL/Analysis/Interval_Integral.thy
--- a/src/HOL/Analysis/Interval_Integral.thy
+++ b/src/HOL/Analysis/Interval_Integral.thy
@@ -1,1107 +1,1129 @@
 (*  Title:      HOL/Analysis/Interval_Integral.thy
     Author:     Jeremy Avigad (CMU), Johannes Hölzl (TUM), Luke Serafin (CMU)
 
 Lebesgue integral over an interval (with endpoints possibly +-\<infinity>)
 *)
 
 theory Interval_Integral (*FIX ME rename? Lebesgue  *)
   imports Equivalence_Lebesgue_Henstock_Integration
 begin
 
 definition "einterval a b = {x. a < ereal x \<and> ereal x < b}"
 
 lemma einterval_eq[simp]:
   shows einterval_eq_Icc: "einterval (ereal a) (ereal b) = {a <..< b}"
     and einterval_eq_Ici: "einterval (ereal a) \<infinity> = {a <..}"
     and einterval_eq_Iic: "einterval (- \<infinity>) (ereal b) = {..< b}"
     and einterval_eq_UNIV: "einterval (- \<infinity>) \<infinity> = UNIV"
   by (auto simp: einterval_def)
 
 lemma einterval_same: "einterval a a = {}"
   by (auto simp: einterval_def)
 
 lemma einterval_iff: "x \<in> einterval a b \<longleftrightarrow> a < ereal x \<and> ereal x < b"
   by (simp add: einterval_def)
 
 lemma einterval_nonempty: "a < b \<Longrightarrow> \<exists>c. c \<in> einterval a b"
   by (cases a b rule: ereal2_cases, auto simp: einterval_def intro!: dense gt_ex lt_ex)
 
 lemma open_einterval[simp]: "open (einterval a b)"
   by (cases a b rule: ereal2_cases)
      (auto simp: einterval_def intro!: open_Collect_conj open_Collect_less continuous_intros)
 
 lemma borel_einterval[measurable]: "einterval a b \<in> sets borel"
   unfolding einterval_def by measurable
 
 subsection \<open>Approximating a (possibly infinite) interval\<close>
 
 lemma filterlim_sup1: "(LIM x F. f x :> G1) \<Longrightarrow> (LIM x F. f x :> (sup G1 G2))"
  unfolding filterlim_def by (auto intro: le_supI1)
 
 lemma ereal_incseq_approx:
   fixes a b :: ereal
   assumes "a < b"
   obtains X :: "nat \<Rightarrow> real" where "incseq X" "\<And>i. a < X i" "\<And>i. X i < b" "X \<longlonglongrightarrow> b"
 proof (cases b)
   case PInf
   with \<open>a < b\<close> have "a = -\<infinity> \<or> (\<exists>r. a = ereal r)"
     by (cases a) auto
   moreover have "(\<lambda>x. ereal (real (Suc x))) \<longlonglongrightarrow> \<infinity>"
     by (simp add: Lim_PInfty filterlim_sequentially_Suc) (metis le_SucI of_nat_Suc of_nat_mono order_trans real_arch_simple)
   moreover have "\<And>r. (\<lambda>x. ereal (r + real (Suc x))) \<longlonglongrightarrow> \<infinity>"
     by (simp add: filterlim_sequentially_Suc Lim_PInfty) (metis add.commute diff_le_eq nat_ceiling_le_eq)
   ultimately show thesis
     by (intro that[of "\<lambda>i. real_of_ereal a + Suc i"])
        (auto simp: incseq_def PInf)
 next
   case (real b')
   define d where "d = b' - (if a = -\<infinity> then b' - 1 else real_of_ereal a)"
   with \<open>a < b\<close> have a': "0 < d"
     by (cases a) (auto simp: real)
   moreover
   have "\<And>i r. r < b' \<Longrightarrow> (b' - r) * 1 < (b' - r) * real (Suc (Suc i))"
     by (intro mult_strict_left_mono) auto
   with \<open>a < b\<close> a' have "\<And>i. a < ereal (b' - d / real (Suc (Suc i)))"
     by (cases a) (auto simp: real d_def field_simps)
   moreover
   have "(\<lambda>i. b' - d / real i) \<longlonglongrightarrow> b'"
     by (force intro: tendsto_eq_intros tendsto_divide_0[OF tendsto_const] filterlim_sup1
               simp: at_infinity_eq_at_top_bot filterlim_real_sequentially)
   then have "(\<lambda>i. b' - d / Suc (Suc i)) \<longlonglongrightarrow> b'"
     by (blast intro: dest: filterlim_sequentially_Suc [THEN iffD2])
   ultimately show thesis
     by (intro that[of "\<lambda>i. b' - d / Suc (Suc i)"])
        (auto simp: real incseq_def intro!: divide_left_mono)
-qed (insert \<open>a < b\<close>, auto)
+qed (use \<open>a < b\<close> in auto)
 
 lemma ereal_decseq_approx:
   fixes a b :: ereal
   assumes "a < b"
   obtains X :: "nat \<Rightarrow> real" where
     "decseq X" "\<And>i. a < X i" "\<And>i. X i < b" "X \<longlonglongrightarrow> a"
 proof -
   have "-b < -a" using \<open>a < b\<close> by simp
-  from ereal_incseq_approx[OF this] guess X .
+  from ereal_incseq_approx[OF this] obtain X where
+    "incseq X"
+    "\<And>i. - b < ereal (X i)"
+    "\<And>i. ereal (X i) < - a"
+    "(\<lambda>x. ereal (X x)) \<longlonglongrightarrow> - a"
+    by auto
   then show thesis
     apply (intro that[of "\<lambda>i. - X i"])
     apply (auto simp: decseq_def incseq_def simp flip: uminus_ereal.simps)
     apply (metis ereal_minus_less_minus ereal_uminus_uminus ereal_Lim_uminus)+
     done
 qed
 
 proposition einterval_Icc_approximation:
   fixes a b :: ereal
   assumes "a < b"
   obtains u l :: "nat \<Rightarrow> real" where
     "einterval a b = (\<Union>i. {l i .. u i})"
     "incseq u" "decseq l" "\<And>i. l i < u i" "\<And>i. a < l i" "\<And>i. u i < b"
     "l \<longlonglongrightarrow> a" "u \<longlonglongrightarrow> b"
 proof -
   from dense[OF \<open>a < b\<close>] obtain c where "a < c" "c < b" by safe
-  from ereal_incseq_approx[OF \<open>c < b\<close>] guess u . note u = this
-  from ereal_decseq_approx[OF \<open>a < c\<close>] guess l . note l = this
+  from ereal_incseq_approx[OF \<open>c < b\<close>] obtain u where u:
+    "incseq u"
+    "\<And>i. c < ereal (u i)"
+    "\<And>i. ereal (u i) < b"
+    "(\<lambda>x. ereal (u x)) \<longlonglongrightarrow> b"
+    by auto
+  from ereal_decseq_approx[OF \<open>a < c\<close>] obtain l where l:
+    "decseq l"
+    "\<And>i. a < ereal (l i)"
+    "\<And>i. ereal (l i) < c"
+    "(\<lambda>x. ereal (l x)) \<longlonglongrightarrow> a"
+    by auto
   { fix i from less_trans[OF \<open>l i < c\<close> \<open>c < u i\<close>] have "l i < u i" by simp }
   have "einterval a b = (\<Union>i. {l i .. u i})"
   proof (auto simp: einterval_iff)
     fix x assume "a < ereal x" "ereal x < b"
     have "eventually (\<lambda>i. ereal (l i) < ereal x) sequentially"
       using l(4) \<open>a < ereal x\<close> by (rule order_tendstoD)
     moreover
     have "eventually (\<lambda>i. ereal x < ereal (u i)) sequentially"
       using u(4) \<open>ereal x< b\<close> by (rule order_tendstoD)
     ultimately have "eventually (\<lambda>i. l i < x \<and> x < u i) sequentially"
       by eventually_elim auto
     then show "\<exists>i. l i \<le> x \<and> x \<le> u i"
       by (auto intro: less_imp_le simp: eventually_sequentially)
   next
     fix x i assume "l i \<le> x" "x \<le> u i"
     with \<open>a < ereal (l i)\<close> \<open>ereal (u i) < b\<close>
     show "a < ereal x" "ereal x < b"
       by (auto simp flip: ereal_less_eq(3))
   qed
   show thesis
     by (intro that) fact+
 qed
 
 (* TODO: in this definition, it would be more natural if einterval a b included a and b when
    they are real. *)
 definition\<^marker>\<open>tag important\<close> interval_lebesgue_integral :: "real measure \<Rightarrow> ereal \<Rightarrow> ereal \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> 'a::{banach, second_countable_topology}" where
   "interval_lebesgue_integral M a b f =
     (if a \<le> b then (LINT x:einterval a b|M. f x) else - (LINT x:einterval b a|M. f x))"
 
 syntax
   "_ascii_interval_lebesgue_integral" :: "pttrn \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real measure \<Rightarrow> real \<Rightarrow> real"
   ("(5LINT _=_.._|_. _)" [0,60,60,61,100] 60)
 
 translations
   "LINT x=a..b|M. f" == "CONST interval_lebesgue_integral M a b (\<lambda>x. f)"
 
 definition\<^marker>\<open>tag important\<close> interval_lebesgue_integrable :: "real measure \<Rightarrow> ereal \<Rightarrow> ereal \<Rightarrow> (real \<Rightarrow> 'a::{banach, second_countable_topology}) \<Rightarrow> bool" where
   "interval_lebesgue_integrable M a b f =
     (if a \<le> b then set_integrable M (einterval a b) f else set_integrable M (einterval b a) f)"
 
 syntax
   "_ascii_interval_lebesgue_borel_integral" :: "pttrn \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real"
   ("(4LBINT _=_.._. _)" [0,60,60,61] 60)
 
 translations
   "LBINT x=a..b. f" == "CONST interval_lebesgue_integral CONST lborel a b (\<lambda>x. f)"
 
 subsection\<open>Basic properties of integration over an interval\<close>
 
 lemma interval_lebesgue_integral_cong:
   "a \<le> b \<Longrightarrow> (\<And>x. x \<in> einterval a b \<Longrightarrow> f x = g x) \<Longrightarrow> einterval a b \<in> sets M \<Longrightarrow>
     interval_lebesgue_integral M a b f = interval_lebesgue_integral M a b g"
   by (auto intro: set_lebesgue_integral_cong simp: interval_lebesgue_integral_def)
 
 lemma interval_lebesgue_integral_cong_AE:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow>
     a \<le> b \<Longrightarrow> AE x \<in> einterval a b in M. f x = g x \<Longrightarrow> einterval a b \<in> sets M \<Longrightarrow>
     interval_lebesgue_integral M a b f = interval_lebesgue_integral M a b g"
   by (auto intro: set_lebesgue_integral_cong_AE simp: interval_lebesgue_integral_def)
 
 lemma interval_integrable_mirror:
   shows "interval_lebesgue_integrable lborel a b (\<lambda>x. f (-x)) \<longleftrightarrow>
     interval_lebesgue_integrable lborel (-b) (-a) f"
 proof -
   have *: "indicator (einterval a b) (- x) = (indicator (einterval (-b) (-a)) x :: real)"
     for a b :: ereal and x :: real
     by (cases a b rule: ereal2_cases) (auto simp: einterval_def split: split_indicator)
   show ?thesis
     unfolding interval_lebesgue_integrable_def
     using lborel_integrable_real_affine_iff[symmetric, of "-1" "\<lambda>x. indicator (einterval _ _) x *\<^sub>R f x" 0]
     by (simp add: * set_integrable_def)
 qed
 
 lemma interval_lebesgue_integral_add [intro, simp]:
   fixes M a b f
   assumes "interval_lebesgue_integrable M a b f" "interval_lebesgue_integrable M a b g"
   shows "interval_lebesgue_integrable M a b (\<lambda>x. f x + g x)" and
     "interval_lebesgue_integral M a b (\<lambda>x. f x + g x) =
    interval_lebesgue_integral M a b f + interval_lebesgue_integral M a b g"
 using assms by (auto simp: interval_lebesgue_integral_def interval_lebesgue_integrable_def
     field_simps)
 
 lemma interval_lebesgue_integral_diff [intro, simp]:
   fixes M a b f
   assumes "interval_lebesgue_integrable M a b f"
     "interval_lebesgue_integrable M a b g"
   shows "interval_lebesgue_integrable M a b (\<lambda>x. f x - g x)" and
     "interval_lebesgue_integral M a b (\<lambda>x. f x - g x) =
    interval_lebesgue_integral M a b f - interval_lebesgue_integral M a b g"
 using assms by (auto simp: interval_lebesgue_integral_def interval_lebesgue_integrable_def
     field_simps)
 
 lemma interval_lebesgue_integrable_mult_right [intro, simp]:
   fixes M a b c and f :: "real \<Rightarrow> 'a::{banach, real_normed_field, second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> interval_lebesgue_integrable M a b f) \<Longrightarrow>
     interval_lebesgue_integrable M a b (\<lambda>x. c * f x)"
   by (simp add: interval_lebesgue_integrable_def)
 
 lemma interval_lebesgue_integrable_mult_left [intro, simp]:
   fixes M a b c and f :: "real \<Rightarrow> 'a::{banach, real_normed_field, second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> interval_lebesgue_integrable M a b f) \<Longrightarrow>
     interval_lebesgue_integrable M a b (\<lambda>x. f x * c)"
   by (simp add: interval_lebesgue_integrable_def)
 
 lemma interval_lebesgue_integrable_divide [intro, simp]:
   fixes M a b c and f :: "real \<Rightarrow> 'a::{banach, real_normed_field, field, second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> interval_lebesgue_integrable M a b f) \<Longrightarrow>
     interval_lebesgue_integrable M a b (\<lambda>x. f x / c)"
   by (simp add: interval_lebesgue_integrable_def)
 
 lemma interval_lebesgue_integral_mult_right [simp]:
   fixes M a b c and f :: "real \<Rightarrow> 'a::{banach, real_normed_field, second_countable_topology}"
   shows "interval_lebesgue_integral M a b (\<lambda>x. c * f x) =
     c * interval_lebesgue_integral M a b f"
   by (simp add: interval_lebesgue_integral_def)
 
 lemma interval_lebesgue_integral_mult_left [simp]:
   fixes M a b c and f :: "real \<Rightarrow> 'a::{banach, real_normed_field, second_countable_topology}"
   shows "interval_lebesgue_integral M a b (\<lambda>x. f x * c) =
     interval_lebesgue_integral M a b f * c"
   by (simp add: interval_lebesgue_integral_def)
 
 lemma interval_lebesgue_integral_divide [simp]:
   fixes M a b c and f :: "real \<Rightarrow> 'a::{banach, real_normed_field, field, second_countable_topology}"
   shows "interval_lebesgue_integral M a b (\<lambda>x. f x / c) =
     interval_lebesgue_integral M a b f / c"
   by (simp add: interval_lebesgue_integral_def)
 
 lemma interval_lebesgue_integral_uminus:
   "interval_lebesgue_integral M a b (\<lambda>x. - f x) = - interval_lebesgue_integral M a b f"
   by (auto simp: interval_lebesgue_integral_def interval_lebesgue_integrable_def set_lebesgue_integral_def)
 
 lemma interval_lebesgue_integral_of_real:
   "interval_lebesgue_integral M a b (\<lambda>x. complex_of_real (f x)) =
     of_real (interval_lebesgue_integral M a b f)"
   unfolding interval_lebesgue_integral_def
   by (auto simp: interval_lebesgue_integral_def set_integral_complex_of_real)
 
 lemma interval_lebesgue_integral_le_eq:
   fixes a b f
   assumes "a \<le> b"
   shows "interval_lebesgue_integral M a b f = (LINT x : einterval a b | M. f x)"
   using assms by (auto simp: interval_lebesgue_integral_def)
 
 lemma interval_lebesgue_integral_gt_eq:
   fixes a b f
   assumes "a > b"
   shows "interval_lebesgue_integral M a b f = -(LINT x : einterval b a | M. f x)"
 using assms by (auto simp: interval_lebesgue_integral_def less_imp_le einterval_def)
 
 lemma interval_lebesgue_integral_gt_eq':
   fixes a b f
   assumes "a > b"
   shows "interval_lebesgue_integral M a b f = - interval_lebesgue_integral M b a f"
 using assms by (auto simp: interval_lebesgue_integral_def less_imp_le einterval_def)
 
 lemma interval_integral_endpoints_same [simp]: "(LBINT x=a..a. f x) = 0"
   by (simp add: interval_lebesgue_integral_def set_lebesgue_integral_def einterval_same)
 
 lemma interval_integral_endpoints_reverse: "(LBINT x=a..b. f x) = -(LBINT x=b..a. f x)"
   by (cases a b rule: linorder_cases) (auto simp: interval_lebesgue_integral_def set_lebesgue_integral_def einterval_same)
 
 lemma interval_integrable_endpoints_reverse:
   "interval_lebesgue_integrable lborel a b f \<longleftrightarrow>
     interval_lebesgue_integrable lborel b a f"
   by (cases a b rule: linorder_cases) (auto simp: interval_lebesgue_integrable_def einterval_same)
 
 lemma interval_integral_reflect:
   "(LBINT x=a..b. f x) = (LBINT x=-b..-a. f (-x))"
 proof (induct a b rule: linorder_wlog)
   case (sym a b) then show ?case
     by (auto simp: interval_lebesgue_integral_def interval_integrable_endpoints_reverse
              split: if_split_asm)
 next
   case (le a b) 
   have "LBINT x:{x. - x \<in> einterval a b}. f (- x) = LBINT x:einterval (- b) (- a). f (- x)"
     unfolding interval_lebesgue_integrable_def set_lebesgue_integral_def
     apply (rule Bochner_Integration.integral_cong [OF refl])
     by (auto simp: einterval_iff ereal_uminus_le_reorder ereal_uminus_less_reorder not_less
              simp flip: uminus_ereal.simps
              split: split_indicator)
   then show ?case
     unfolding interval_lebesgue_integral_def 
     by (subst set_integral_reflect) (simp add: le)
 qed
 
 lemma interval_lebesgue_integral_0_infty:
   "interval_lebesgue_integrable M 0 \<infinity> f \<longleftrightarrow> set_integrable M {0<..} f"
   "interval_lebesgue_integral M 0 \<infinity> f = (LINT x:{0<..}|M. f x)"
   unfolding zero_ereal_def
   by (auto simp: interval_lebesgue_integral_le_eq interval_lebesgue_integrable_def)
 
 lemma interval_integral_to_infinity_eq: "(LINT x=ereal a..\<infinity> | M. f x) = (LINT x : {a<..} | M. f x)"
   unfolding interval_lebesgue_integral_def by auto
 
 proposition interval_integrable_to_infinity_eq: "(interval_lebesgue_integrable M a \<infinity> f) =
   (set_integrable M {a<..} f)"
   unfolding interval_lebesgue_integrable_def by auto
 
 subsection\<open>Basic properties of integration over an interval wrt lebesgue measure\<close>
 
 lemma interval_integral_zero [simp]:
   fixes a b :: ereal
   shows "LBINT x=a..b. 0 = 0"
 unfolding interval_lebesgue_integral_def set_lebesgue_integral_def einterval_eq
 by simp
 
 lemma interval_integral_const [intro, simp]:
   fixes a b c :: real
   shows "interval_lebesgue_integrable lborel a b (\<lambda>x. c)" and "LBINT x=a..b. c = c * (b - a)"
   unfolding interval_lebesgue_integral_def interval_lebesgue_integrable_def einterval_eq
   by (auto simp: less_imp_le field_simps measure_def set_integrable_def set_lebesgue_integral_def)
 
 lemma interval_integral_cong_AE:
   assumes [measurable]: "f \<in> borel_measurable borel" "g \<in> borel_measurable borel"
   assumes "AE x \<in> einterval (min a b) (max a b) in lborel. f x = g x"
   shows "interval_lebesgue_integral lborel a b f = interval_lebesgue_integral lborel a b g"
   using assms
 proof (induct a b rule: linorder_wlog)
   case (sym a b) then show ?case
     by (simp add: min.commute max.commute interval_integral_endpoints_reverse[of a b])
 next
   case (le a b) then show ?case
     by (auto simp: interval_lebesgue_integral_def max_def min_def
              intro!: set_lebesgue_integral_cong_AE)
 qed
 
 lemma interval_integral_cong:
   assumes "\<And>x. x \<in> einterval (min a b) (max a b) \<Longrightarrow> f x = g x"
   shows "interval_lebesgue_integral lborel a b f = interval_lebesgue_integral lborel a b g"
   using assms
 proof (induct a b rule: linorder_wlog)
   case (sym a b) then show ?case
     by (simp add: min.commute max.commute interval_integral_endpoints_reverse[of a b])
 next
   case (le a b) then show ?case
     by (auto simp: interval_lebesgue_integral_def max_def min_def
              intro!: set_lebesgue_integral_cong)
 qed
 
 lemma interval_lebesgue_integrable_cong_AE:
     "f \<in> borel_measurable lborel \<Longrightarrow> g \<in> borel_measurable lborel \<Longrightarrow>
     AE x \<in> einterval (min a b) (max a b) in lborel. f x = g x \<Longrightarrow>
     interval_lebesgue_integrable lborel a b f = interval_lebesgue_integrable lborel a b g"
   apply (simp add: interval_lebesgue_integrable_def)
   apply (intro conjI impI set_integrable_cong_AE)
   apply (auto simp: min_def max_def)
   done
 
 lemma interval_integrable_abs_iff:
   fixes f :: "real \<Rightarrow> real"
   shows  "f \<in> borel_measurable lborel \<Longrightarrow>
     interval_lebesgue_integrable lborel a b (\<lambda>x. \<bar>f x\<bar>) = interval_lebesgue_integrable lborel a b f"
   unfolding interval_lebesgue_integrable_def
   by (subst (1 2) set_integrable_abs_iff') simp_all
 
 lemma interval_integral_Icc:
   fixes a b :: real
   shows "a \<le> b \<Longrightarrow> (LBINT x=a..b. f x) = (LBINT x : {a..b}. f x)"
   by (auto intro!: set_integral_discrete_difference[where X="{a, b}"]
            simp add: interval_lebesgue_integral_def)
 
 lemma interval_integral_Icc':
   "a \<le> b \<Longrightarrow> (LBINT x=a..b. f x) = (LBINT x : {x. a \<le> ereal x \<and> ereal x \<le> b}. f x)"
   by (auto intro!: set_integral_discrete_difference[where X="{real_of_ereal a, real_of_ereal b}"]
            simp add: interval_lebesgue_integral_def einterval_iff)
 
 lemma interval_integral_Ioc:
   "a \<le> b \<Longrightarrow> (LBINT x=a..b. f x) = (LBINT x : {a<..b}. f x)"
   by (auto intro!: set_integral_discrete_difference[where X="{a, b}"]
            simp add: interval_lebesgue_integral_def einterval_iff)
 
 (* TODO: other versions as well? *) (* Yes: I need the Icc' version. *)
 lemma interval_integral_Ioc':
   "a \<le> b \<Longrightarrow> (LBINT x=a..b. f x) = (LBINT x : {x. a < ereal x \<and> ereal x \<le> b}. f x)"
   by (auto intro!: set_integral_discrete_difference[where X="{real_of_ereal a, real_of_ereal b}"]
            simp add: interval_lebesgue_integral_def einterval_iff)
 
 lemma interval_integral_Ico:
   "a \<le> b \<Longrightarrow> (LBINT x=a..b. f x) = (LBINT x : {a..<b}. f x)"
   by (auto intro!: set_integral_discrete_difference[where X="{a, b}"]
            simp add: interval_lebesgue_integral_def einterval_iff)
 
 lemma interval_integral_Ioi:
   "\<bar>a\<bar> < \<infinity> \<Longrightarrow> (LBINT x=a..\<infinity>. f x) = (LBINT x : {real_of_ereal a <..}. f x)"
   by (auto simp: interval_lebesgue_integral_def einterval_iff)
 
 lemma interval_integral_Ioo:
   "a \<le> b \<Longrightarrow> \<bar>a\<bar> < \<infinity> ==> \<bar>b\<bar> < \<infinity> \<Longrightarrow> (LBINT x=a..b. f x) = (LBINT x : {real_of_ereal a <..< real_of_ereal b}. f x)"
   by (auto simp: interval_lebesgue_integral_def einterval_iff)
 
 lemma interval_integral_discrete_difference:
   fixes f :: "real \<Rightarrow> 'b::{banach, second_countable_topology}" and a b :: ereal
   assumes "countable X"
   and eq: "\<And>x. a \<le> b \<Longrightarrow> a < x \<Longrightarrow> x < b \<Longrightarrow> x \<notin> X \<Longrightarrow> f x = g x"
   and anti_eq: "\<And>x. b \<le> a \<Longrightarrow> b < x \<Longrightarrow> x < a \<Longrightarrow> x \<notin> X \<Longrightarrow> f x = g x"
   assumes "\<And>x. x \<in> X \<Longrightarrow> emeasure M {x} = 0" "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M"
   shows "interval_lebesgue_integral M a b f = interval_lebesgue_integral M a b g"
   unfolding interval_lebesgue_integral_def set_lebesgue_integral_def
   apply (intro if_cong refl arg_cong[where f="\<lambda>x. - x"] integral_discrete_difference[of X] assms)
   apply (auto simp: eq anti_eq einterval_iff split: split_indicator)
   done
 
 lemma interval_integral_sum:
   fixes a b c :: ereal
   assumes integrable: "interval_lebesgue_integrable lborel (min a (min b c)) (max a (max b c)) f"
   shows "(LBINT x=a..b. f x) + (LBINT x=b..c. f x) = (LBINT x=a..c. f x)"
 proof -
   let ?I = "\<lambda>a b. LBINT x=a..b. f x"
   { fix a b c :: ereal assume "interval_lebesgue_integrable lborel a c f" "a \<le> b" "b \<le> c"
     then have ord: "a \<le> b" "b \<le> c" "a \<le> c" and f': "set_integrable lborel (einterval a c) f"
       by (auto simp: interval_lebesgue_integrable_def)
     then have f: "set_borel_measurable borel (einterval a c) f"
       unfolding set_integrable_def set_borel_measurable_def
       by (drule_tac borel_measurable_integrable) simp
     have "(LBINT x:einterval a c. f x) = (LBINT x:einterval a b \<union> einterval b c. f x)"
     proof (rule set_integral_cong_set)
       show "AE x in lborel. (x \<in> einterval a b \<union> einterval b c) = (x \<in> einterval a c)"
         using AE_lborel_singleton[of "real_of_ereal b"] ord
         by (cases a b c rule: ereal3_cases) (auto simp: einterval_iff)
       show "set_borel_measurable lborel (einterval a c) f" "set_borel_measurable lborel (einterval a b \<union> einterval b c) f"
         unfolding set_borel_measurable_def
         using ord by (auto simp: einterval_iff intro!: set_borel_measurable_subset[OF f, unfolded set_borel_measurable_def])
     qed
     also have "\<dots> = (LBINT x:einterval a b. f x) + (LBINT x:einterval b c. f x)"
       using ord
       by (intro set_integral_Un_AE) (auto intro!: set_integrable_subset[OF f'] simp: einterval_iff not_less)
     finally have "?I a b + ?I b c = ?I a c"
       using ord by (simp add: interval_lebesgue_integral_def)
   } note 1 = this
   { fix a b c :: ereal assume "interval_lebesgue_integrable lborel a c f" "a \<le> b" "b \<le> c"
     from 1[OF this] have "?I b c + ?I a b = ?I a c"
       by (metis add.commute)
   } note 2 = this
   have 3: "\<And>a b. b \<le> a \<Longrightarrow> (LBINT x=a..b. f x) = - (LBINT x=b..a. f x)"
     by (rule interval_integral_endpoints_reverse)
   show ?thesis
     using integrable
     apply (cases a b b c a c rule: linorder_le_cases[case_product linorder_le_cases linorder_cases])
     apply simp_all (* remove some looping cases *)
     by (simp_all add: min_absorb1 min_absorb2 max_absorb1 max_absorb2 field_simps 1 2 3)
 qed
 
 lemma interval_integrable_isCont:
   fixes a b and f :: "real \<Rightarrow> 'a::{banach, second_countable_topology}"
   shows "(\<And>x. min a b \<le> x \<Longrightarrow> x \<le> max a b \<Longrightarrow> isCont f x) \<Longrightarrow>
     interval_lebesgue_integrable lborel a b f"
 proof (induct a b rule: linorder_wlog)
   case (le a b) then show ?case
     unfolding interval_lebesgue_integrable_def set_integrable_def
     by (auto simp: interval_lebesgue_integrable_def
         intro!: set_integrable_subset[unfolded set_integrable_def, OF borel_integrable_compact[of "{a .. b}"]]
         continuous_at_imp_continuous_on)
 qed (auto intro: interval_integrable_endpoints_reverse[THEN iffD1])
 
 lemma interval_integrable_continuous_on:
   fixes a b :: real and f
   assumes "a \<le> b" and "continuous_on {a..b} f"
   shows "interval_lebesgue_integrable lborel a b f"
 using assms unfolding interval_lebesgue_integrable_def apply simp
   by (rule set_integrable_subset, rule borel_integrable_atLeastAtMost' [of a b], auto)
 
 lemma interval_integral_eq_integral:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   shows "a \<le> b \<Longrightarrow> set_integrable lborel {a..b} f \<Longrightarrow> LBINT x=a..b. f x = integral {a..b} f"
   by (subst interval_integral_Icc, simp) (rule set_borel_integral_eq_integral)
 
 lemma interval_integral_eq_integral':
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   shows "a \<le> b \<Longrightarrow> set_integrable lborel (einterval a b) f \<Longrightarrow> LBINT x=a..b. f x = integral (einterval a b) f"
   by (subst interval_lebesgue_integral_le_eq, simp) (rule set_borel_integral_eq_integral)
 
 
 subsection\<open>General limit approximation arguments\<close>
 
 proposition interval_integral_Icc_approx_nonneg:
   fixes a b :: ereal
   assumes "a < b"
   fixes u l :: "nat \<Rightarrow> real"
   assumes  approx: "einterval a b = (\<Union>i. {l i .. u i})"
     "incseq u" "decseq l" "\<And>i. l i < u i" "\<And>i. a < l i" "\<And>i. u i < b"
     "l \<longlonglongrightarrow> a" "u \<longlonglongrightarrow> b"
   fixes f :: "real \<Rightarrow> real"
   assumes f_integrable: "\<And>i. set_integrable lborel {l i..u i} f"
   assumes f_nonneg: "AE x in lborel. a < ereal x \<longrightarrow> ereal x < b \<longrightarrow> 0 \<le> f x"
   assumes f_measurable: "set_borel_measurable lborel (einterval a b) f"
   assumes lbint_lim: "(\<lambda>i. LBINT x=l i.. u i. f x) \<longlonglongrightarrow> C"
   shows
     "set_integrable lborel (einterval a b) f"
     "(LBINT x=a..b. f x) = C"
 proof -
   have 1 [unfolded set_integrable_def]: "\<And>i. set_integrable lborel {l i..u i} f" by (rule f_integrable)
   have 2: "AE x in lborel. mono (\<lambda>n. indicator {l n..u n} x *\<^sub>R f x)"
   proof -
      from f_nonneg have "AE x in lborel. \<forall>i. l i \<le> x \<longrightarrow> x \<le> u i \<longrightarrow> 0 \<le> f x"
       by eventually_elim
          (metis approx(5) approx(6) dual_order.strict_trans1 ereal_less_eq(3) le_less_trans)
     then show ?thesis
       apply eventually_elim
       apply (auto simp: mono_def split: split_indicator)
       apply (metis approx(3) decseqD order_trans)
       apply (metis approx(2) incseqD order_trans)
       done
   qed
   have 3: "AE x in lborel. (\<lambda>i. indicator {l i..u i} x *\<^sub>R f x) \<longlonglongrightarrow> indicator (einterval a b) x *\<^sub>R f x"
   proof -
     { fix x i assume "l i \<le> x" "x \<le> u i"
       then have "eventually (\<lambda>i. l i \<le> x \<and> x \<le> u i) sequentially"
         apply (auto simp: eventually_sequentially intro!: exI[of _ i])
         apply (metis approx(3) decseqD order_trans)
         apply (metis approx(2) incseqD order_trans)
         done
       then have "eventually (\<lambda>i. f x * indicator {l i..u i} x = f x) sequentially"
         by eventually_elim auto }
     then show ?thesis
       unfolding approx(1) by (auto intro!: AE_I2 tendsto_eventually split: split_indicator)
   qed
   have 4: "(\<lambda>i. \<integral> x. indicator {l i..u i} x *\<^sub>R f x \<partial>lborel) \<longlonglongrightarrow> C"
     using lbint_lim by (simp add: interval_integral_Icc [unfolded set_lebesgue_integral_def] approx less_imp_le)
   have 5: "(\<lambda>x. indicat_real (einterval a b) x *\<^sub>R f x) \<in> borel_measurable lborel"
     using f_measurable set_borel_measurable_def by blast
   have "(LBINT x=a..b. f x) = lebesgue_integral lborel (\<lambda>x. indicator (einterval a b) x *\<^sub>R f x)"
     using assms by (simp add: interval_lebesgue_integral_def set_lebesgue_integral_def less_imp_le)
   also have "\<dots> = C"
     by (rule integral_monotone_convergence [OF 1 2 3 4 5])
   finally show "(LBINT x=a..b. f x) = C" .
   show "set_integrable lborel (einterval a b) f"
     unfolding set_integrable_def
     by (rule integrable_monotone_convergence[OF 1 2 3 4 5])
 qed
 
 proposition interval_integral_Icc_approx_integrable:
   fixes u l :: "nat \<Rightarrow> real" and a b :: ereal
   fixes f :: "real \<Rightarrow> 'a::{banach, second_countable_topology}"
   assumes "a < b"
   assumes  approx: "einterval a b = (\<Union>i. {l i .. u i})"
     "incseq u" "decseq l" "\<And>i. l i < u i" "\<And>i. a < l i" "\<And>i. u i < b"
     "l \<longlonglongrightarrow> a" "u \<longlonglongrightarrow> b"
   assumes f_integrable: "set_integrable lborel (einterval a b) f"
   shows "(\<lambda>i. LBINT x=l i.. u i. f x) \<longlonglongrightarrow> (LBINT x=a..b. f x)"
 proof -
   have "(\<lambda>i. LBINT x:{l i.. u i}. f x) \<longlonglongrightarrow> (LBINT x:einterval a b. f x)"
     unfolding set_lebesgue_integral_def
   proof (rule integral_dominated_convergence)
     show "integrable lborel (\<lambda>x. norm (indicator (einterval a b) x *\<^sub>R f x))"
       using f_integrable integrable_norm set_integrable_def by blast
     show "(\<lambda>x. indicat_real (einterval a b) x *\<^sub>R f x) \<in> borel_measurable lborel"
       using f_integrable by (simp add: set_integrable_def)
     then show "\<And>i. (\<lambda>x. indicat_real {l i..u i} x *\<^sub>R f x) \<in> borel_measurable lborel"
       by (rule set_borel_measurable_subset [unfolded set_borel_measurable_def]) (auto simp: approx)
     show "\<And>i. AE x in lborel. norm (indicator {l i..u i} x *\<^sub>R f x) \<le> norm (indicator (einterval a b) x *\<^sub>R f x)"
       by (intro AE_I2) (auto simp: approx split: split_indicator)
     show "AE x in lborel. (\<lambda>i. indicator {l i..u i} x *\<^sub>R f x) \<longlonglongrightarrow> indicator (einterval a b) x *\<^sub>R f x"
     proof (intro AE_I2 tendsto_intros tendsto_eventually)
       fix x
       { fix i assume "l i \<le> x" "x \<le> u i"
         with \<open>incseq u\<close>[THEN incseqD, of i] \<open>decseq l\<close>[THEN decseqD, of i]
         have "eventually (\<lambda>i. l i \<le> x \<and> x \<le> u i) sequentially"
           by (auto simp: eventually_sequentially decseq_def incseq_def intro: order_trans) }
       then show "eventually (\<lambda>xa. indicator {l xa..u xa} x = (indicator (einterval a b) x::real)) sequentially"
         using approx order_tendstoD(2)[OF \<open>l \<longlonglongrightarrow> a\<close>, of x] order_tendstoD(1)[OF \<open>u \<longlonglongrightarrow> b\<close>, of x]
         by (auto split: split_indicator)
     qed
   qed
   with \<open>a < b\<close> \<open>\<And>i. l i < u i\<close> show ?thesis
     by (simp add: interval_lebesgue_integral_le_eq[symmetric] interval_integral_Icc less_imp_le)
 qed
 
 subsection\<open>A slightly stronger Fundamental Theorem of Calculus\<close>
 
 text\<open>Three versions: first, for finite intervals, and then two versions for
     arbitrary intervals.\<close>
 
 (*
   TODO: make the older versions corollaries of these (using continuous_at_imp_continuous_on, etc.)
 *)
 
 lemma interval_integral_FTC_finite:
   fixes f F :: "real \<Rightarrow> 'a::euclidean_space" and a b :: real
   assumes f: "continuous_on {min a b..max a b} f"
   assumes F: "\<And>x. min a b \<le> x \<Longrightarrow> x \<le> max a b \<Longrightarrow> (F has_vector_derivative (f x)) (at x within
     {min a b..max a b})"
   shows "(LBINT x=a..b. f x) = F b - F a"
 proof (cases "a \<le> b")
   case True
   have "(LBINT x=a..b. f x) = (LBINT x. indicat_real {a..b} x *\<^sub>R f x)"
     by (simp add: True interval_integral_Icc set_lebesgue_integral_def)
   also have "\<dots> = F b - F a"
   proof (rule integral_FTC_atLeastAtMost [OF True])
     show "continuous_on {a..b} f"
       using True f by linarith
     show "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> (F has_vector_derivative f x) (at x within {a..b})"
       by (metis F True max.commute max_absorb1 min_def)
   qed
   finally show ?thesis .
 next
   case False
   then have "b \<le> a"
     by simp
   have "- interval_lebesgue_integral lborel (ereal b) (ereal a) f = - (LBINT x. indicat_real {b..a} x *\<^sub>R f x)"
     by (simp add: \<open>b \<le> a\<close> interval_integral_Icc set_lebesgue_integral_def)
   also have "\<dots> = F b - F a"
   proof (subst integral_FTC_atLeastAtMost [OF \<open>b \<le> a\<close>])
     show "continuous_on {b..a} f"
       using False f by linarith
     show "\<And>x. \<lbrakk>b \<le> x; x \<le> a\<rbrakk>
          \<Longrightarrow> (F has_vector_derivative f x) (at x within {b..a})"
       by (metis F False max_def min_def)
   qed auto
   finally show ?thesis
     by (metis interval_integral_endpoints_reverse)
 qed
 
 
 lemma interval_integral_FTC_nonneg:
   fixes f F :: "real \<Rightarrow> real" and a b :: ereal
   assumes "a < b"
   assumes F: "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> DERIV F x :> f x"
   assumes f: "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> isCont f x"
   assumes f_nonneg: "AE x in lborel. a < ereal x \<longrightarrow> ereal x < b \<longrightarrow> 0 \<le> f x"
   assumes A: "((F \<circ> real_of_ereal) \<longlongrightarrow> A) (at_right a)"
   assumes B: "((F \<circ> real_of_ereal) \<longlongrightarrow> B) (at_left b)"
   shows
     "set_integrable lborel (einterval a b) f"
     "(LBINT x=a..b. f x) = B - A"
 proof -
   obtain u l where approx:
     "einterval a b = (\<Union>i. {l i .. u i})"
     "incseq u" "decseq l" "\<And>i. l i < u i" "\<And>i. a < l i" "\<And>i. u i < b"
     "l \<longlonglongrightarrow> a" "u \<longlonglongrightarrow> b" 
     by (blast intro: einterval_Icc_approximation[OF \<open>a < b\<close>])
   have [simp]: "\<And>x i. l i \<le> x \<Longrightarrow> a < ereal x"
     by (rule order_less_le_trans, rule approx, force)
   have [simp]: "\<And>x i. x \<le> u i \<Longrightarrow> ereal x < b"
     by (rule order_le_less_trans, subst ereal_less_eq(3), assumption, rule approx)
   have FTCi: "\<And>i. (LBINT x=l i..u i. f x) = F (u i) - F (l i)"
     using assms approx apply (intro interval_integral_FTC_finite)
     apply (auto simp: less_imp_le min_def max_def
       has_field_derivative_iff_has_vector_derivative[symmetric])
     apply (rule continuous_at_imp_continuous_on, auto intro!: f)
     by (rule DERIV_subset [OF F], auto)
   have 1: "\<And>i. set_integrable lborel {l i..u i} f"
   proof -
     fix i show "set_integrable lborel {l i .. u i} f"
       using \<open>a < l i\<close> \<open>u i < b\<close> unfolding set_integrable_def
       by (intro borel_integrable_compact f continuous_at_imp_continuous_on compact_Icc ballI)
          (auto simp flip: ereal_less_eq)
   qed
   have 2: "set_borel_measurable lborel (einterval a b) f"
     unfolding set_borel_measurable_def
     by (auto simp del: real_scaleR_def intro!: borel_measurable_continuous_on_indicator
              simp: continuous_on_eq_continuous_at einterval_iff f)
   have 3: "(\<lambda>i. LBINT x=l i..u i. f x) \<longlonglongrightarrow> B - A"
     apply (subst FTCi)
     apply (intro tendsto_intros)
     using B approx unfolding tendsto_at_iff_sequentially comp_def
     using tendsto_at_iff_sequentially[where 'a=real]
     apply (elim allE[of _ "\<lambda>i. ereal (u i)"], auto)
     using A approx unfolding tendsto_at_iff_sequentially comp_def
     by (elim allE[of _ "\<lambda>i. ereal (l i)"], auto)
   show "(LBINT x=a..b. f x) = B - A"
     by (rule interval_integral_Icc_approx_nonneg [OF \<open>a < b\<close> approx 1 f_nonneg 2 3])
   show "set_integrable lborel (einterval a b) f"
     by (rule interval_integral_Icc_approx_nonneg [OF \<open>a < b\<close> approx 1 f_nonneg 2 3])
 qed
 
 theorem interval_integral_FTC_integrable:
   fixes f F :: "real \<Rightarrow> 'a::euclidean_space" and a b :: ereal
   assumes "a < b"
   assumes F: "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> (F has_vector_derivative f x) (at x)"
   assumes f: "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> isCont f x"
   assumes f_integrable: "set_integrable lborel (einterval a b) f"
   assumes A: "((F \<circ> real_of_ereal) \<longlongrightarrow> A) (at_right a)"
   assumes B: "((F \<circ> real_of_ereal) \<longlongrightarrow> B) (at_left b)"
   shows "(LBINT x=a..b. f x) = B - A"
 proof -
   obtain u l where approx:
     "einterval a b = (\<Union>i. {l i .. u i})"
     "incseq u" "decseq l" "\<And>i. l i < u i" "\<And>i. a < l i" "\<And>i. u i < b"
     "l \<longlonglongrightarrow> a" "u \<longlonglongrightarrow> b" 
     by (blast intro: einterval_Icc_approximation[OF \<open>a < b\<close>])
   have [simp]: "\<And>x i. l i \<le> x \<Longrightarrow> a < ereal x"
     by (rule order_less_le_trans, rule approx, force)
   have [simp]: "\<And>x i. x \<le> u i \<Longrightarrow> ereal x < b"
     by (rule order_le_less_trans, subst ereal_less_eq(3), assumption, rule approx)
   have FTCi: "\<And>i. (LBINT x=l i..u i. f x) = F (u i) - F (l i)"
     using assms approx
     by (auto simp: less_imp_le min_def max_def
              intro!: f continuous_at_imp_continuous_on interval_integral_FTC_finite
              intro: has_vector_derivative_at_within)
   have "(\<lambda>i. LBINT x=l i..u i. f x) \<longlonglongrightarrow> B - A"
     unfolding FTCi
   proof (intro tendsto_intros)
     show "(\<lambda>x. F (l x)) \<longlonglongrightarrow> A"
       using A approx unfolding tendsto_at_iff_sequentially comp_def
       by (elim allE[of _ "\<lambda>i. ereal (l i)"], auto)
     show "(\<lambda>x. F (u x)) \<longlonglongrightarrow> B"
       using B approx unfolding tendsto_at_iff_sequentially comp_def
       by (elim allE[of _ "\<lambda>i. ereal (u i)"], auto)
   qed
   moreover have "(\<lambda>i. LBINT x=l i..u i. f x) \<longlonglongrightarrow> (LBINT x=a..b. f x)"
     by (rule interval_integral_Icc_approx_integrable [OF \<open>a < b\<close> approx f_integrable])
   ultimately show ?thesis
     by (elim LIMSEQ_unique)
 qed
 
 (*
   The second Fundamental Theorem of Calculus and existence of antiderivatives on an
   einterval.
 *)
 
 theorem interval_integral_FTC2:
   fixes a b c :: real and f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "a \<le> c" "c \<le> b"
   and contf: "continuous_on {a..b} f"
   fixes x :: real
   assumes "a \<le> x" and "x \<le> b"
   shows "((\<lambda>u. LBINT y=c..u. f y) has_vector_derivative (f x)) (at x within {a..b})"
 proof -
   let ?F = "(\<lambda>u. LBINT y=a..u. f y)"
   have intf: "set_integrable lborel {a..b} f"
     by (rule borel_integrable_atLeastAtMost', rule contf)
   have "((\<lambda>u. integral {a..u} f) has_vector_derivative f x) (at x within {a..b})"
     using \<open>a \<le> x\<close> \<open>x \<le> b\<close> 
     by (auto intro: integral_has_vector_derivative continuous_on_subset [OF contf])
   then have "((\<lambda>u. integral {a..u} f) has_vector_derivative (f x)) (at x within {a..b})"
     by simp
   then have "(?F has_vector_derivative (f x)) (at x within {a..b})"
     by (rule has_vector_derivative_weaken)
        (auto intro!: assms interval_integral_eq_integral[symmetric] set_integrable_subset [OF intf])
   then have "((\<lambda>x. (LBINT y=c..a. f y) + ?F x) has_vector_derivative (f x)) (at x within {a..b})"
     by (auto intro!: derivative_eq_intros)
   then show ?thesis
   proof (rule has_vector_derivative_weaken)
     fix u assume "u \<in> {a .. b}"
     then show "(LBINT y=c..a. f y) + (LBINT y=a..u. f y) = (LBINT y=c..u. f y)"
       using assms
       apply (intro interval_integral_sum)
       apply (auto simp: interval_lebesgue_integrable_def simp del: real_scaleR_def)
       by (rule set_integrable_subset [OF intf], auto simp: min_def max_def)
   qed (insert assms, auto)
 qed
 
 proposition einterval_antiderivative:
   fixes a b :: ereal and f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "a < b" and contf: "\<And>x :: real. a < x \<Longrightarrow> x < b \<Longrightarrow> isCont f x"
   shows "\<exists>F. \<forall>x :: real. a < x \<longrightarrow> x < b \<longrightarrow> (F has_vector_derivative f x) (at x)"
 proof -
   from einterval_nonempty [OF \<open>a < b\<close>] obtain c :: real where [simp]: "a < c" "c < b"
     by (auto simp: einterval_def)
   let ?F = "(\<lambda>u. LBINT y=c..u. f y)"
   show ?thesis
   proof (rule exI, clarsimp)
     fix x :: real
     assume [simp]: "a < x" "x < b"
     have 1: "a < min c x" by simp
     from einterval_nonempty [OF 1] obtain d :: real where [simp]: "a < d" "d < c" "d < x"
       by (auto simp: einterval_def)
     have 2: "max c x < b" by simp
     from einterval_nonempty [OF 2] obtain e :: real where [simp]: "c < e" "x < e" "e < b"
       by (auto simp: einterval_def)
     have "(?F has_vector_derivative f x) (at x within {d<..<e})"
     proof (rule has_vector_derivative_within_subset [of _ _ _ "{d..e}"])
       have "continuous_on {d..e} f"
       proof (intro continuous_at_imp_continuous_on ballI contf; clarsimp)
         show "\<And>x. \<lbrakk>d \<le> x; x \<le> e\<rbrakk> \<Longrightarrow> a < ereal x"
           using \<open>a < ereal d\<close> ereal_less_ereal_Ex by auto
         show "\<And>x. \<lbrakk>d \<le> x; x \<le> e\<rbrakk> \<Longrightarrow> ereal x < b"
           using \<open>ereal e < b\<close> ereal_less_eq(3) le_less_trans by blast
       qed
       then show "(?F has_vector_derivative f x) (at x within {d..e})"
         by (intro interval_integral_FTC2) (use \<open>d < c\<close> \<open>c < e\<close> \<open>d < x\<close> \<open>x < e\<close> in \<open>linarith+\<close>)
     qed auto
     then show "(?F has_vector_derivative f x) (at x)"
       by (force simp: has_vector_derivative_within_open [of _ "{d<..<e}"])
   qed
 qed
 
 subsection\<open>The substitution theorem\<close>
 
 text\<open>Once again, three versions: first, for finite intervals, and then two versions for
     arbitrary intervals.\<close>
 
 theorem interval_integral_substitution_finite:
   fixes a b :: real and f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "a \<le> b"
   and derivg: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> (g has_real_derivative (g' x)) (at x within {a..b})"
   and contf : "continuous_on (g ` {a..b}) f"
   and contg': "continuous_on {a..b} g'"
   shows "LBINT x=a..b. g' x *\<^sub>R f (g x) = LBINT y=g a..g b. f y"
 proof-
   have v_derivg: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> (g has_vector_derivative (g' x)) (at x within {a..b})"
     using derivg unfolding has_field_derivative_iff_has_vector_derivative .
   then have contg [simp]: "continuous_on {a..b} g"
     by (rule continuous_on_vector_derivative) auto
   have 1: "\<exists>x\<in>{a..b}. u = g x" if "min (g a) (g b) \<le> u" "u \<le> max (g a) (g b)" for u
     by (cases "g a \<le> g b") (use that assms IVT' [of g a u b]  IVT2' [of g b u a]  in \<open>auto simp: min_def max_def\<close>)
   obtain c d where g_im: "g ` {a..b} = {c..d}" and "c \<le> d"
     by (metis continuous_image_closed_interval contg \<open>a \<le> b\<close>)
   obtain F where derivF:
          "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> (F has_vector_derivative (f (g x))) (at (g x) within (g ` {a..b}))" 
     using continuous_on_subset [OF contf] g_im
       by (metis antiderivative_continuous atLeastAtMost_iff image_subset_iff set_eq_subset)
   have contfg: "continuous_on {a..b} (\<lambda>x. f (g x))"
     by (blast intro: continuous_on_compose2 contf contg)
   have "LBINT x. indicat_real {a..b} x *\<^sub>R g' x *\<^sub>R f (g x) = F (g b) - F (g a)"
     apply (rule integral_FTC_atLeastAtMost
                 [OF \<open>a \<le> b\<close> vector_diff_chain_within[OF v_derivg derivF, unfolded comp_def]])
     apply (auto intro!: continuous_on_scaleR contg' contfg)
     done
   then have "LBINT x=a..b. g' x *\<^sub>R f (g x) = F (g b) - F (g a)"
     by (simp add: assms interval_integral_Icc set_lebesgue_integral_def)
   moreover have "LBINT y=(g a)..(g b). f y = F (g b) - F (g a)"
   proof (rule interval_integral_FTC_finite)
     show "continuous_on {min (g a) (g b)..max (g a) (g b)} f"
       by (rule continuous_on_subset [OF contf]) (auto simp: image_def 1)
     show "(F has_vector_derivative f y) (at y within {min (g a) (g b)..max (g a) (g b)})" 
       if y: "min (g a) (g b) \<le> y" "y \<le> max (g a) (g b)" for y
     proof -
       obtain x where "a \<le> x" "x \<le> b" "y = g x"
         using 1 y by force
       then show ?thesis
         by (auto simp: image_def intro!: 1  has_vector_derivative_within_subset [OF derivF])
     qed
   qed
   ultimately show ?thesis by simp
 qed
 
 (* TODO: is it possible to lift the assumption here that g' is nonnegative? *)
 
 theorem interval_integral_substitution_integrable:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space" and a b u v :: ereal
   assumes "a < b"
   and deriv_g: "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> DERIV g x :> g' x"
   and contf: "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> isCont f (g x)"
   and contg': "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> isCont g' x"
   and g'_nonneg: "\<And>x. a \<le> ereal x \<Longrightarrow> ereal x \<le> b \<Longrightarrow> 0 \<le> g' x"
   and A: "((ereal \<circ> g \<circ> real_of_ereal) \<longlongrightarrow> A) (at_right a)"
   and B: "((ereal \<circ> g \<circ> real_of_ereal) \<longlongrightarrow> B) (at_left b)"
   and integrable: "set_integrable lborel (einterval a b) (\<lambda>x. g' x *\<^sub>R f (g x))"
   and integrable2: "set_integrable lborel (einterval A B) (\<lambda>x. f x)"
   shows "(LBINT x=A..B. f x) = (LBINT x=a..b. g' x *\<^sub>R f (g x))"
 proof -
   obtain u l where approx [simp]:
     "einterval a b = (\<Union>i. {l i .. u i})"
     "incseq u" "decseq l" "\<And>i. l i < u i" "\<And>i. a < l i" "\<And>i. u i < b"
     "l \<longlonglongrightarrow> a" "u \<longlonglongrightarrow> b" 
     by (blast intro: einterval_Icc_approximation[OF \<open>a < b\<close>])
   note less_imp_le [simp]
   have [simp]: "\<And>x i. l i \<le> x \<Longrightarrow> a < ereal x"
     by (rule order_less_le_trans, rule approx, force)
   have [simp]: "\<And>x i. x \<le> u i \<Longrightarrow> ereal x < b"
     by (rule order_le_less_trans, subst ereal_less_eq(3), assumption, rule approx)
   then have lessb[simp]: "\<And>i. l i < b"
     using approx(4) less_eq_real_def by blast
   have [simp]: "\<And>i. a < u i"
     by (rule order_less_trans, rule approx, auto, rule approx)
   have lle[simp]: "\<And>i j. i \<le> j \<Longrightarrow> l j \<le> l i" by (rule decseqD, rule approx)
   have [simp]: "\<And>i j. i \<le> j \<Longrightarrow> u i \<le> u j" by (rule incseqD, rule approx)
   have g_nondec [simp]: "g x \<le> g y" if "a < x" "x \<le> y" "y < b" for x y
   proof (rule DERIV_nonneg_imp_nondecreasing [OF \<open>x \<le> y\<close>], intro exI conjI)
     show "\<And>u. x \<le> u \<Longrightarrow> u \<le> y \<Longrightarrow> (g has_real_derivative g' u) (at u)"
       by (meson deriv_g ereal_less_eq(3) le_less_trans less_le_trans that)
     show "\<And>u. x \<le> u \<Longrightarrow> u \<le> y \<Longrightarrow> 0 \<le> g' u"
       by (meson assms(5) dual_order.trans le_ereal_le less_imp_le order_refl that)
   qed
   have "A \<le> B" and un: "einterval A B = (\<Union>i. {g(l i)<..<g(u i)})"
   proof -
     have A2: "(\<lambda>i. g (l i)) \<longlonglongrightarrow> A"
       using A apply (auto simp: einterval_def tendsto_at_iff_sequentially comp_def)
       by (drule_tac x = "\<lambda>i. ereal (l i)" in spec, auto)
     hence A3: "\<And>i. g (l i) \<ge> A"
       by (intro decseq_ge, auto simp: decseq_def)
     have B2: "(\<lambda>i. g (u i)) \<longlonglongrightarrow> B"
       using B apply (auto simp: einterval_def tendsto_at_iff_sequentially comp_def)
       by (drule_tac x = "\<lambda>i. ereal (u i)" in spec, auto)
     hence B3: "\<And>i. g (u i) \<le> B"
       by (intro incseq_le, auto simp: incseq_def)
     have "ereal (g (l 0)) \<le> ereal (g (u 0))"
       by auto
     then show "A \<le> B"
       by (meson A3 B3 order.trans)
     { fix x :: real
       assume "A < x" and "x < B"
       then have "eventually (\<lambda>i. ereal (g (l i)) < x \<and> x < ereal (g (u i))) sequentially"
         by (fast intro: eventually_conj order_tendstoD A2 B2)
       hence "\<exists>i. g (l i) < x \<and> x < g (u i)"
         by (simp add: eventually_sequentially, auto)
     } note AB = this
     show "einterval A B = (\<Union>i. {g(l i)<..<g(u i)})"
     proof
       show "einterval A B \<subseteq> (\<Union>i. {g(l i)<..<g(u i)})"
         by (auto simp: einterval_def AB)
       show "(\<Union>i. {g(l i)<..<g(u i)}) \<subseteq> einterval A B"
       proof (clarsimp simp add: einterval_def, intro conjI)
         show "\<And>x i. \<lbrakk>g (l i) < x; x < g (u i)\<rbrakk> \<Longrightarrow> A < ereal x"
           using A3 le_ereal_less by blast
         show "\<And>x i. \<lbrakk>g (l i) < x; x < g (u i)\<rbrakk> \<Longrightarrow> ereal x < B"
           using B3 ereal_le_less by blast
       qed
     qed
   qed
   (* finally, the main argument *)
   have eq1: "(LBINT x=l i.. u i. g' x *\<^sub>R f (g x)) = (LBINT y=g (l i)..g (u i). f y)" for i
     apply (rule interval_integral_substitution_finite [OF _ DERIV_subset [OF deriv_g]])
     unfolding has_field_derivative_iff_has_vector_derivative[symmetric]
          apply (auto intro!: continuous_at_imp_continuous_on contf contg')
     done
   have "(\<lambda>i. LBINT x=l i..u i. g' x *\<^sub>R f (g x)) \<longlonglongrightarrow> (LBINT x=a..b. g' x *\<^sub>R f (g x))"
     apply (rule interval_integral_Icc_approx_integrable [OF \<open>a < b\<close> approx])
     by (rule assms)
   hence 2: "(\<lambda>i. (LBINT y=g (l i)..g (u i). f y)) \<longlonglongrightarrow> (LBINT x=a..b. g' x *\<^sub>R f (g x))"
     by (simp add: eq1)
   have incseq: "incseq (\<lambda>i. {g (l i)<..<g (u i)})"
     apply (auto simp: incseq_def)
     using lessb lle approx(5) g_nondec le_less_trans apply blast
     by (force intro: less_le_trans)
   have "(\<lambda>i. set_lebesgue_integral lborel {g (l i)<..<g (u i)} f)
         \<longlonglongrightarrow> set_lebesgue_integral lborel (einterval A B) f"
     unfolding un  by (rule set_integral_cont_up) (use incseq  integrable2 un in auto)
   then have "(\<lambda>i. (LBINT y=g (l i)..g (u i). f y)) \<longlonglongrightarrow> (LBINT x = A..B. f x)"
     by (simp add: interval_lebesgue_integral_le_eq \<open>A \<le> B\<close>)
   thus ?thesis by (intro LIMSEQ_unique [OF _ 2])
 qed
 
 (* TODO: the last two proofs are only slightly different. Factor out common part?
    An alternative: make the second one the main one, and then have another lemma
    that says that if f is nonnegative and all the other hypotheses hold, then it is integrable. *)
 
 theorem interval_integral_substitution_nonneg:
   fixes f g g':: "real \<Rightarrow> real" and a b u v :: ereal
   assumes "a < b"
   and deriv_g: "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> DERIV g x :> g' x"
   and contf: "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> isCont f (g x)"
   and contg': "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> isCont g' x"
   and f_nonneg: "\<And>x. a < ereal x \<Longrightarrow> ereal x < b \<Longrightarrow> 0 \<le> f (g x)" (* TODO: make this AE? *)
   and g'_nonneg: "\<And>x. a \<le> ereal x \<Longrightarrow> ereal x \<le> b \<Longrightarrow> 0 \<le> g' x"
   and A: "((ereal \<circ> g \<circ> real_of_ereal) \<longlongrightarrow> A) (at_right a)"
   and B: "((ereal \<circ> g \<circ> real_of_ereal) \<longlongrightarrow> B) (at_left b)"
   and integrable_fg: "set_integrable lborel (einterval a b) (\<lambda>x. f (g x) * g' x)"
   shows
     "set_integrable lborel (einterval A B) f"
     "(LBINT x=A..B. f x) = (LBINT x=a..b. (f (g x) * g' x))"
 proof -
-  from einterval_Icc_approximation[OF \<open>a < b\<close>] guess u l . note approx [simp] = this
-  note less_imp_le [simp]
+  from einterval_Icc_approximation[OF \<open>a < b\<close>] obtain u l where approx [simp]:
+    "einterval a b = (\<Union>i. {l i..u i})"
+    "incseq u"
+    "decseq l"
+    "\<And>i. l i < u i"
+    "\<And>i. a < ereal (l i)"
+    "\<And>i. ereal (u i) < b"
+    "(\<lambda>x. ereal (l x)) \<longlonglongrightarrow> a"
+    "(\<lambda>x. ereal (u x)) \<longlonglongrightarrow> b" by this auto
   have aless[simp]: "\<And>x i. l i \<le> x \<Longrightarrow> a < ereal x"
     by (rule order_less_le_trans, rule approx, force)
   have lessb[simp]: "\<And>x i. x \<le> u i \<Longrightarrow> ereal x < b"
     by (rule order_le_less_trans, subst ereal_less_eq(3), assumption, rule approx)
   have llb[simp]: "\<And>i. l i < b"
     using lessb approx(4) less_eq_real_def by blast
   have alu[simp]: "\<And>i. a < u i"
     by (rule order_less_trans, rule approx, auto, rule approx)
   have [simp]: "\<And>i j. i \<le> j \<Longrightarrow> l j \<le> l i" by (rule decseqD, rule approx)
   have uleu[simp]: "\<And>i j. i \<le> j \<Longrightarrow> u i \<le> u j" by (rule incseqD, rule approx)
   have g_nondec [simp]: "g x \<le> g y" if "a < x" "x \<le> y" "y < b" for x y
   proof (rule DERIV_nonneg_imp_nondecreasing [OF \<open>x \<le> y\<close>], intro exI conjI)
     show "\<And>u. x \<le> u \<Longrightarrow> u \<le> y \<Longrightarrow> (g has_real_derivative g' u) (at u)"
       by (meson deriv_g ereal_less_eq(3) le_less_trans less_le_trans that)
     show "\<And>u. x \<le> u \<Longrightarrow> u \<le> y \<Longrightarrow> 0 \<le> g' u"
       by (meson g'_nonneg less_ereal.simps(1) less_trans not_less that)
   qed
   have "A \<le> B" and un: "einterval A B = (\<Union>i. {g(l i)<..<g(u i)})"
   proof -
     have A2: "(\<lambda>i. g (l i)) \<longlonglongrightarrow> A"
       using A apply (auto simp: einterval_def tendsto_at_iff_sequentially comp_def)
       by (drule_tac x = "\<lambda>i. ereal (l i)" in spec, auto)
     hence A3: "\<And>i. g (l i) \<ge> A"
       by (intro decseq_ge, auto simp: decseq_def)
     have B2: "(\<lambda>i. g (u i)) \<longlonglongrightarrow> B"
       using B apply (auto simp: einterval_def tendsto_at_iff_sequentially comp_def)
       by (drule_tac x = "\<lambda>i. ereal (u i)" in spec, auto)
     hence B3: "\<And>i. g (u i) \<le> B"
       by (intro incseq_le, auto simp: incseq_def)
     have "ereal (g (l 0)) \<le> ereal (g (u 0))"
-      by auto
+      by (auto simp: less_imp_le)
     then show "A \<le> B"
       by (meson A3 B3 order.trans)
     { fix x :: real
       assume "A < x" and "x < B"
       then have "eventually (\<lambda>i. ereal (g (l i)) < x \<and> x < ereal (g (u i))) sequentially"
         by (fast intro: eventually_conj order_tendstoD A2 B2)
       hence "\<exists>i. g (l i) < x \<and> x < g (u i)"
         by (simp add: eventually_sequentially, auto)
     } note AB = this
     show "einterval A B = (\<Union>i. {g(l i)<..<g(u i)})"
     proof
       show "einterval A B \<subseteq> (\<Union>i. {g (l i)<..<g (u i)})"
         by (auto simp: einterval_def AB)
       show "(\<Union>i. {g (l i)<..<g (u i)}) \<subseteq> einterval A B"
         apply (clarsimp simp: einterval_def, intro conjI)
         using A3 le_ereal_less apply blast
         using B3 ereal_le_less by blast
     qed
   qed
     (* finally, the main argument *)
   have eq1: "(LBINT x=l i.. u i. (f (g x) * g' x)) = (LBINT y=g (l i)..g (u i). f y)" for i
   proof -
     have "(LBINT x=l i.. u i. g' x *\<^sub>R f (g x)) = (LBINT y=g (l i)..g (u i). f y)"
       apply (rule interval_integral_substitution_finite [OF _ DERIV_subset [OF deriv_g]])
       unfolding has_field_derivative_iff_has_vector_derivative[symmetric]
-           apply (auto intro!: continuous_at_imp_continuous_on contf contg')
+           apply (auto simp: less_imp_le intro!: continuous_at_imp_continuous_on contf contg')
       done
     then show ?thesis
       by (simp add: ac_simps)
   qed
   have incseq: "incseq (\<lambda>i. {g (l i)<..<g (u i)})"
     apply (clarsimp simp add: incseq_def, intro conjI)
     apply (meson llb antimono_def approx(3) approx(5) g_nondec le_less_trans)
     using alu uleu approx(6) g_nondec less_le_trans by blast
   have img: "\<exists>c \<ge> l i. c \<le> u i \<and> x = g c" if "g (l i) \<le> x" "x \<le> g (u i)" for x i
   proof -
     have "continuous_on {l i..u i} g"
       by (force intro!: DERIV_isCont deriv_g continuous_at_imp_continuous_on)
     with that show ?thesis
       using IVT' [of g] approx(4) dual_order.strict_implies_order by blast
   qed
   have "continuous_on {g (l i)..g (u i)} f" for i
     apply (intro continuous_intros continuous_at_imp_continuous_on)
     using contf img by force
   then have int_f: "\<And>i. set_integrable lborel {g (l i)<..<g (u i)} f"
     by (rule set_integrable_subset [OF borel_integrable_atLeastAtMost']) (auto intro: less_imp_le)
   have integrable: "set_integrable lborel (\<Union>i. {g (l i)<..<g (u i)}) f"
   proof (intro pos_integrable_to_top incseq int_f)
     let ?l = "(LBINT x=a..b. f (g x) * g' x)"
     have "(\<lambda>i. LBINT x=l i..u i. f (g x) * g' x) \<longlonglongrightarrow> ?l"
       by (intro assms interval_integral_Icc_approx_integrable [OF \<open>a < b\<close> approx])
     hence "(\<lambda>i. (LBINT y=g (l i)..g (u i). f y)) \<longlonglongrightarrow> ?l"
       by (simp add: eq1)
     then show "(\<lambda>i. set_lebesgue_integral lborel {g (l i)<..<g (u i)} f) \<longlonglongrightarrow> ?l"
-      unfolding interval_lebesgue_integral_def by auto
+      unfolding interval_lebesgue_integral_def by (auto simp: less_imp_le)
     have "\<And>x i. g (l i) \<le> x \<Longrightarrow> x \<le> g (u i) \<Longrightarrow> 0 \<le> f x"
       using aless f_nonneg img lessb by blast
     then show "\<And>x i. x \<in> {g (l i)<..<g (u i)} \<Longrightarrow> 0 \<le> f x"
       using less_eq_real_def by auto
   qed (auto simp: greaterThanLessThan_borel)
   thus "set_integrable lborel (einterval A B) f"
     by (simp add: un)
 
   have "(LBINT x=A..B. f x) = (LBINT x=a..b. g' x *\<^sub>R f (g x))"
   proof (rule interval_integral_substitution_integrable)
     show "set_integrable lborel (einterval a b) (\<lambda>x. g' x *\<^sub>R f (g x))"
       using integrable_fg by (simp add: ac_simps)
   qed fact+
   then show "(LBINT x=A..B. f x) = (LBINT x=a..b. (f (g x) * g' x))"
     by (simp add: ac_simps)
 qed
 
 
 syntax "_complex_lebesgue_borel_integral" :: "pttrn \<Rightarrow> real \<Rightarrow> complex"
   ("(2CLBINT _. _)" [0,60] 60)
 
 translations "CLBINT x. f" == "CONST complex_lebesgue_integral CONST lborel (\<lambda>x. f)"
 
 syntax "_complex_set_lebesgue_borel_integral" :: "pttrn \<Rightarrow> real set \<Rightarrow> real \<Rightarrow> complex"
   ("(3CLBINT _:_. _)" [0,60,61] 60)
 
 translations
   "CLBINT x:A. f" == "CONST complex_set_lebesgue_integral CONST lborel A (\<lambda>x. f)"
 
 abbreviation complex_interval_lebesgue_integral ::
     "real measure \<Rightarrow> ereal \<Rightarrow> ereal \<Rightarrow> (real \<Rightarrow> complex) \<Rightarrow> complex" where
   "complex_interval_lebesgue_integral M a b f \<equiv> interval_lebesgue_integral M a b f"
 
 abbreviation complex_interval_lebesgue_integrable ::
   "real measure \<Rightarrow> ereal \<Rightarrow> ereal \<Rightarrow> (real \<Rightarrow> complex) \<Rightarrow> bool" where
   "complex_interval_lebesgue_integrable M a b f \<equiv> interval_lebesgue_integrable M a b f"
 
 syntax
   "_ascii_complex_interval_lebesgue_borel_integral" :: "pttrn \<Rightarrow> ereal \<Rightarrow> ereal \<Rightarrow> real \<Rightarrow> complex"
   ("(4CLBINT _=_.._. _)" [0,60,60,61] 60)
 
 translations
   "CLBINT x=a..b. f" == "CONST complex_interval_lebesgue_integral CONST lborel a b (\<lambda>x. f)"
 
 proposition interval_integral_norm:
   fixes f :: "real \<Rightarrow> 'a :: {banach, second_countable_topology}"
   shows "interval_lebesgue_integrable lborel a b f \<Longrightarrow> a \<le> b \<Longrightarrow>
     norm (LBINT t=a..b. f t) \<le> LBINT t=a..b. norm (f t)"
   using integral_norm_bound[of lborel "\<lambda>x. indicator (einterval a b) x *\<^sub>R f x"]
   by (auto simp: interval_lebesgue_integral_def interval_lebesgue_integrable_def set_lebesgue_integral_def)
 
 proposition interval_integral_norm2:
   "interval_lebesgue_integrable lborel a b f \<Longrightarrow>
     norm (LBINT t=a..b. f t) \<le> \<bar>LBINT t=a..b. norm (f t)\<bar>"
 proof (induct a b rule: linorder_wlog)
   case (sym a b) then show ?case
     by (simp add: interval_integral_endpoints_reverse[of a b] interval_integrable_endpoints_reverse[of a b])
 next
   case (le a b)
   then have "\<bar>LBINT t=a..b. norm (f t)\<bar> = LBINT t=a..b. norm (f t)"
     using integrable_norm[of lborel "\<lambda>x. indicator (einterval a b) x *\<^sub>R f x"]
     by (auto simp: interval_lebesgue_integral_def interval_lebesgue_integrable_def set_lebesgue_integral_def
              intro!: integral_nonneg_AE abs_of_nonneg)
   then show ?case
     using le by (simp add: interval_integral_norm)
 qed
 
 (* TODO: should we have a library of facts like these? *)
 lemma integral_cos: "t \<noteq> 0 \<Longrightarrow> LBINT x=a..b. cos (t * x) = sin (t * b) / t - sin (t * a) / t"
   apply (intro interval_integral_FTC_finite continuous_intros)
   by (auto intro!: derivative_eq_intros simp: has_field_derivative_iff_has_vector_derivative[symmetric])
 
 end
diff --git a/src/HOL/Analysis/Measure_Space.thy b/src/HOL/Analysis/Measure_Space.thy
--- a/src/HOL/Analysis/Measure_Space.thy
+++ b/src/HOL/Analysis/Measure_Space.thy
@@ -1,3884 +1,3892 @@
 (*  Title:      HOL/Analysis/Measure_Space.thy
     Author:     Lawrence C Paulson
     Author:     Johannes Hölzl, TU München
     Author:     Armin Heller, TU München
 *)
 
 section \<open>Measure Spaces\<close>
 
 theory Measure_Space
 imports
   Measurable "HOL-Library.Extended_Nonnegative_Real"
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> "Relate extended reals and the indicator function"
 
 lemma suminf_cmult_indicator:
   fixes f :: "nat \<Rightarrow> ennreal"
   assumes "disjoint_family A" "x \<in> A i"
   shows "(\<Sum>n. f n * indicator (A n) x) = f i"
 proof -
   have **: "\<And>n. f n * indicator (A n) x = (if n = i then f n else 0 :: ennreal)"
     using \<open>x \<in> A i\<close> assms unfolding disjoint_family_on_def indicator_def by auto
   then have "\<And>n. (\<Sum>j<n. f j * indicator (A j) x) = (if i < n then f i else 0 :: ennreal)"
     by (auto simp: sum.If_cases)
   moreover have "(SUP n. if i < n then f i else 0) = (f i :: ennreal)"
   proof (rule SUP_eqI)
     fix y :: ennreal assume "\<And>n. n \<in> UNIV \<Longrightarrow> (if i < n then f i else 0) \<le> y"
     from this[of "Suc i"] show "f i \<le> y" by auto
   qed (insert assms, simp)
   ultimately show ?thesis using assms
     by (subst suminf_eq_SUP) (auto simp: indicator_def)
 qed
 
 lemma suminf_indicator:
   assumes "disjoint_family A"
   shows "(\<Sum>n. indicator (A n) x :: ennreal) = indicator (\<Union>i. A i) x"
 proof cases
   assume *: "x \<in> (\<Union>i. A i)"
   then obtain i where "x \<in> A i" by auto
   from suminf_cmult_indicator[OF assms(1), OF \<open>x \<in> A i\<close>, of "\<lambda>k. 1"]
   show ?thesis using * by simp
 qed simp
 
 lemma sum_indicator_disjoint_family:
   fixes f :: "'d \<Rightarrow> 'e::semiring_1"
   assumes d: "disjoint_family_on A P" and "x \<in> A j" and "finite P" and "j \<in> P"
   shows "(\<Sum>i\<in>P. f i * indicator (A i) x) = f j"
 proof -
   have "P \<inter> {i. x \<in> A i} = {j}"
     using d \<open>x \<in> A j\<close> \<open>j \<in> P\<close> unfolding disjoint_family_on_def
     by auto
   with \<open>finite P\<close> show ?thesis
     by (simp add: indicator_def)
 qed
 
 text \<open>
   The type for emeasure spaces is already defined in \<^theory>\<open>HOL-Analysis.Sigma_Algebra\<close>, as it
   is also used to represent sigma algebras (with an arbitrary emeasure).
 \<close>
 
 subsection\<^marker>\<open>tag unimportant\<close> "Extend binary sets"
 
 lemma LIMSEQ_binaryset:
   assumes f: "f {} = 0"
   shows  "(\<lambda>n. \<Sum>i<n. f (binaryset A B i)) \<longlonglongrightarrow> f A + f B"
 proof -
   have "(\<lambda>n. \<Sum>i < Suc (Suc n). f (binaryset A B i)) = (\<lambda>n. f A + f B)"
     proof
       fix n
       show "(\<Sum>i < Suc (Suc n). f (binaryset A B i)) = f A + f B"
         by (induct n)  (auto simp add: binaryset_def f)
     qed
   moreover
   have "... \<longlonglongrightarrow> f A + f B" by (rule tendsto_const)
   ultimately
   have "(\<lambda>n. \<Sum>i< Suc (Suc n). f (binaryset A B i)) \<longlonglongrightarrow> f A + f B"
     by metis
   hence "(\<lambda>n. \<Sum>i< n+2. f (binaryset A B i)) \<longlonglongrightarrow> f A + f B"
     by simp
   thus ?thesis by (rule LIMSEQ_offset [where k=2])
 qed
 
 lemma binaryset_sums:
   assumes f: "f {} = 0"
   shows  "(\<lambda>n. f (binaryset A B n)) sums (f A + f B)"
     by (simp add: sums_def LIMSEQ_binaryset [where f=f, OF f] atLeast0LessThan)
 
 lemma suminf_binaryset_eq:
   fixes f :: "'a set \<Rightarrow> 'b::{comm_monoid_add, t2_space}"
   shows "f {} = 0 \<Longrightarrow> (\<Sum>n. f (binaryset A B n)) = f A + f B"
   by (metis binaryset_sums sums_unique)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Properties of a premeasure \<^term>\<open>\<mu>\<close>\<close>
 
 text \<open>
   The definitions for \<^const>\<open>positive\<close> and \<^const>\<open>countably_additive\<close> should be here, by they are
   necessary to define \<^typ>\<open>'a measure\<close> in \<^theory>\<open>HOL-Analysis.Sigma_Algebra\<close>.
 \<close>
 
 definition subadditive where
   "subadditive M f \<longleftrightarrow> (\<forall>x\<in>M. \<forall>y\<in>M. x \<inter> y = {} \<longrightarrow> f (x \<union> y) \<le> f x + f y)"
 
 lemma subadditiveD: "subadditive M f \<Longrightarrow> x \<inter> y = {} \<Longrightarrow> x \<in> M \<Longrightarrow> y \<in> M \<Longrightarrow> f (x \<union> y) \<le> f x + f y"
   by (auto simp add: subadditive_def)
 
 definition countably_subadditive where
   "countably_subadditive M f \<longleftrightarrow>
     (\<forall>A. range A \<subseteq> M \<longrightarrow> disjoint_family A \<longrightarrow> (\<Union>i. A i) \<in> M \<longrightarrow> (f (\<Union>i. A i) \<le> (\<Sum>i. f (A i))))"
 
 lemma (in ring_of_sets) countably_subadditive_subadditive:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" and cs: "countably_subadditive M f"
   shows  "subadditive M f"
 proof (auto simp add: subadditive_def)
   fix x y
   assume x: "x \<in> M" and y: "y \<in> M" and "x \<inter> y = {}"
   hence "disjoint_family (binaryset x y)"
     by (auto simp add: disjoint_family_on_def binaryset_def)
   hence "range (binaryset x y) \<subseteq> M \<longrightarrow>
          (\<Union>i. binaryset x y i) \<in> M \<longrightarrow>
          f (\<Union>i. binaryset x y i) \<le> (\<Sum> n. f (binaryset x y n))"
     using cs by (auto simp add: countably_subadditive_def)
   hence "{x,y,{}} \<subseteq> M \<longrightarrow> x \<union> y \<in> M \<longrightarrow>
          f (x \<union> y) \<le> (\<Sum> n. f (binaryset x y n))"
     by (simp add: range_binaryset_eq UN_binaryset_eq)
   thus "f (x \<union> y) \<le>  f x + f y" using f x y
     by (auto simp add: Un o_def suminf_binaryset_eq positive_def)
 qed
 
 definition additive where
   "additive M \<mu> \<longleftrightarrow> (\<forall>x\<in>M. \<forall>y\<in>M. x \<inter> y = {} \<longrightarrow> \<mu> (x \<union> y) = \<mu> x + \<mu> y)"
 
 definition increasing where
   "increasing M \<mu> \<longleftrightarrow> (\<forall>x\<in>M. \<forall>y\<in>M. x \<subseteq> y \<longrightarrow> \<mu> x \<le> \<mu> y)"
 
 lemma positiveD1: "positive M f \<Longrightarrow> f {} = 0" by (auto simp: positive_def)
 
 lemma positiveD_empty:
   "positive M f \<Longrightarrow> f {} = 0"
   by (auto simp add: positive_def)
 
 lemma additiveD:
   "additive M f \<Longrightarrow> x \<inter> y = {} \<Longrightarrow> x \<in> M \<Longrightarrow> y \<in> M \<Longrightarrow> f (x \<union> y) = f x + f y"
   by (auto simp add: additive_def)
 
 lemma increasingD:
   "increasing M f \<Longrightarrow> x \<subseteq> y \<Longrightarrow> x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> f x \<le> f y"
   by (auto simp add: increasing_def)
 
 lemma countably_additiveI[case_names countably]:
   "(\<And>A. range A \<subseteq> M \<Longrightarrow> disjoint_family A \<Longrightarrow> (\<Union>i. A i) \<in> M \<Longrightarrow> (\<Sum>i. f (A i)) = f (\<Union>i. A i))
   \<Longrightarrow> countably_additive M f"
   by (simp add: countably_additive_def)
 
 lemma (in ring_of_sets) disjointed_additive:
   assumes f: "positive M f" "additive M f" and A: "range A \<subseteq> M" "incseq A"
   shows "(\<Sum>i\<le>n. f (disjointed A i)) = f (A n)"
 proof (induct n)
   case (Suc n)
   then have "(\<Sum>i\<le>Suc n. f (disjointed A i)) = f (A n) + f (disjointed A (Suc n))"
     by simp
   also have "\<dots> = f (A n \<union> disjointed A (Suc n))"
     using A by (subst f(2)[THEN additiveD]) (auto simp: disjointed_mono)
   also have "A n \<union> disjointed A (Suc n) = A (Suc n)"
     using \<open>incseq A\<close> by (auto dest: incseq_SucD simp: disjointed_mono)
   finally show ?case .
 qed simp
 
 lemma (in ring_of_sets) additive_sum:
   fixes A:: "'i \<Rightarrow> 'a set"
   assumes f: "positive M f" and ad: "additive M f" and "finite S"
       and A: "A`S \<subseteq> M"
       and disj: "disjoint_family_on A S"
   shows  "(\<Sum>i\<in>S. f (A i)) = f (\<Union>i\<in>S. A i)"
   using \<open>finite S\<close> disj A
 proof induct
   case empty show ?case using f by (simp add: positive_def)
 next
   case (insert s S)
   then have "A s \<inter> (\<Union>i\<in>S. A i) = {}"
     by (auto simp add: disjoint_family_on_def neq_iff)
   moreover
   have "A s \<in> M" using insert by blast
   moreover have "(\<Union>i\<in>S. A i) \<in> M"
     using insert \<open>finite S\<close> by auto
   ultimately have "f (A s \<union> (\<Union>i\<in>S. A i)) = f (A s) + f(\<Union>i\<in>S. A i)"
     using ad UNION_in_sets A by (auto simp add: additive_def)
   with insert show ?case using ad disjoint_family_on_mono[of S "insert s S" A]
     by (auto simp add: additive_def subset_insertI)
 qed
 
 lemma (in ring_of_sets) additive_increasing:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes posf: "positive M f" and addf: "additive M f"
   shows "increasing M f"
 proof (auto simp add: increasing_def)
   fix x y
   assume xy: "x \<in> M" "y \<in> M" "x \<subseteq> y"
   then have "y - x \<in> M" by auto
   then have "f x + 0 \<le> f x + f (y-x)" by (intro add_left_mono zero_le)
   also have "... = f (x \<union> (y-x))" using addf
     by (auto simp add: additive_def) (metis Diff_disjoint Un_Diff_cancel Diff xy(1,2))
   also have "... = f y"
     by (metis Un_Diff_cancel Un_absorb1 xy(3))
   finally show "f x \<le> f y" by simp
 qed
 
 lemma (in ring_of_sets) subadditive:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" "additive M f" and A: "A`S \<subseteq> M" and S: "finite S"
   shows "f (\<Union>i\<in>S. A i) \<le> (\<Sum>i\<in>S. f (A i))"
 using S A
 proof (induct S)
   case empty thus ?case using f by (auto simp: positive_def)
 next
   case (insert x F)
   hence in_M: "A x \<in> M" "(\<Union>i\<in>F. A i) \<in> M" "(\<Union>i\<in>F. A i) - A x \<in> M" using A by force+
   have subs: "(\<Union>i\<in>F. A i) - A x \<subseteq> (\<Union>i\<in>F. A i)" by auto
   have "(\<Union>i\<in>(insert x F). A i) = A x \<union> ((\<Union>i\<in>F. A i) - A x)" by auto
   hence "f (\<Union>i\<in>(insert x F). A i) = f (A x \<union> ((\<Union>i\<in>F. A i) - A x))"
     by simp
   also have "\<dots> = f (A x) + f ((\<Union>i\<in>F. A i) - A x)"
     using f(2) by (rule additiveD) (insert in_M, auto)
   also have "\<dots> \<le> f (A x) + f (\<Union>i\<in>F. A i)"
     using additive_increasing[OF f] in_M subs by (auto simp: increasing_def intro: add_left_mono)
   also have "\<dots> \<le> f (A x) + (\<Sum>i\<in>F. f (A i))" using insert by (auto intro: add_left_mono)
   finally show "f (\<Union>i\<in>(insert x F). A i) \<le> (\<Sum>i\<in>(insert x F). f (A i))" using insert by simp
 qed
 
 lemma (in ring_of_sets) countably_additive_additive:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes posf: "positive M f" and ca: "countably_additive M f"
   shows "additive M f"
 proof (auto simp add: additive_def)
   fix x y
   assume x: "x \<in> M" and y: "y \<in> M" and "x \<inter> y = {}"
   hence "disjoint_family (binaryset x y)"
     by (auto simp add: disjoint_family_on_def binaryset_def)
   hence "range (binaryset x y) \<subseteq> M \<longrightarrow>
          (\<Union>i. binaryset x y i) \<in> M \<longrightarrow>
          f (\<Union>i. binaryset x y i) = (\<Sum> n. f (binaryset x y n))"
     using ca
     by (simp add: countably_additive_def)
   hence "{x,y,{}} \<subseteq> M \<longrightarrow> x \<union> y \<in> M \<longrightarrow>
          f (x \<union> y) = (\<Sum>n. f (binaryset x y n))"
     by (simp add: range_binaryset_eq UN_binaryset_eq)
   thus "f (x \<union> y) = f x + f y" using posf x y
     by (auto simp add: Un suminf_binaryset_eq positive_def)
 qed
 
 lemma (in algebra) increasing_additive_bound:
   fixes A:: "nat \<Rightarrow> 'a set" and  f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" and ad: "additive M f"
       and inc: "increasing M f"
       and A: "range A \<subseteq> M"
       and disj: "disjoint_family A"
   shows  "(\<Sum>i. f (A i)) \<le> f \<Omega>"
 proof (safe intro!: suminf_le_const)
   fix N
   note disj_N = disjoint_family_on_mono[OF _ disj, of "{..<N}"]
   have "(\<Sum>i<N. f (A i)) = f (\<Union>i\<in>{..<N}. A i)"
     using A by (intro additive_sum [OF f ad _ _]) (auto simp: disj_N)
   also have "... \<le> f \<Omega>" using space_closed A
     by (intro increasingD[OF inc] finite_UN) auto
   finally show "(\<Sum>i<N. f (A i)) \<le> f \<Omega>" by simp
 qed (insert f A, auto simp: positive_def)
 
 lemma (in ring_of_sets) countably_additiveI_finite:
   fixes \<mu> :: "'a set \<Rightarrow> ennreal"
   assumes "finite \<Omega>" "positive M \<mu>" "additive M \<mu>"
   shows "countably_additive M \<mu>"
 proof (rule countably_additiveI)
   fix F :: "nat \<Rightarrow> 'a set" assume F: "range F \<subseteq> M" "(\<Union>i. F i) \<in> M" and disj: "disjoint_family F"
 
   have "\<forall>i\<in>{i. F i \<noteq> {}}. \<exists>x. x \<in> F i" by auto
   from bchoice[OF this] obtain f where f: "\<And>i. F i \<noteq> {} \<Longrightarrow> f i \<in> F i" by auto
 
   have inj_f: "inj_on f {i. F i \<noteq> {}}"
   proof (rule inj_onI, simp)
     fix i j a b assume *: "f i = f j" "F i \<noteq> {}" "F j \<noteq> {}"
     then have "f i \<in> F i" "f j \<in> F j" using f by force+
     with disj * show "i = j" by (auto simp: disjoint_family_on_def)
   qed
   have "finite (\<Union>i. F i)"
     by (metis F(2) assms(1) infinite_super sets_into_space)
 
   have F_subset: "{i. \<mu> (F i) \<noteq> 0} \<subseteq> {i. F i \<noteq> {}}"
     by (auto simp: positiveD_empty[OF \<open>positive M \<mu>\<close>])
   moreover have fin_not_empty: "finite {i. F i \<noteq> {}}"
   proof (rule finite_imageD)
     from f have "f`{i. F i \<noteq> {}} \<subseteq> (\<Union>i. F i)" by auto
     then show "finite (f`{i. F i \<noteq> {}})"
       by (rule finite_subset) fact
   qed fact
   ultimately have fin_not_0: "finite {i. \<mu> (F i) \<noteq> 0}"
     by (rule finite_subset)
 
   have disj_not_empty: "disjoint_family_on F {i. F i \<noteq> {}}"
     using disj by (auto simp: disjoint_family_on_def)
 
   from fin_not_0 have "(\<Sum>i. \<mu> (F i)) = (\<Sum>i | \<mu> (F i) \<noteq> 0. \<mu> (F i))"
     by (rule suminf_finite) auto
   also have "\<dots> = (\<Sum>i | F i \<noteq> {}. \<mu> (F i))"
     using fin_not_empty F_subset by (rule sum.mono_neutral_left) auto
   also have "\<dots> = \<mu> (\<Union>i\<in>{i. F i \<noteq> {}}. F i)"
     using \<open>positive M \<mu>\<close> \<open>additive M \<mu>\<close> fin_not_empty disj_not_empty F by (intro additive_sum) auto
   also have "\<dots> = \<mu> (\<Union>i. F i)"
     by (rule arg_cong[where f=\<mu>]) auto
   finally show "(\<Sum>i. \<mu> (F i)) = \<mu> (\<Union>i. F i)" .
 qed
 
 lemma (in ring_of_sets) countably_additive_iff_continuous_from_below:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" "additive M f"
   shows "countably_additive M f \<longleftrightarrow>
     (\<forall>A. range A \<subseteq> M \<longrightarrow> incseq A \<longrightarrow> (\<Union>i. A i) \<in> M \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Union>i. A i))"
   unfolding countably_additive_def
 proof safe
   assume count_sum: "\<forall>A. range A \<subseteq> M \<longrightarrow> disjoint_family A \<longrightarrow> \<Union>(A ` UNIV) \<in> M \<longrightarrow> (\<Sum>i. f (A i)) = f (\<Union>(A ` UNIV))"
   fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> M" "incseq A" "(\<Union>i. A i) \<in> M"
   then have dA: "range (disjointed A) \<subseteq> M" by (auto simp: range_disjointed_sets)
   with count_sum[THEN spec, of "disjointed A"] A(3)
   have f_UN: "(\<Sum>i. f (disjointed A i)) = f (\<Union>i. A i)"
     by (auto simp: UN_disjointed_eq disjoint_family_disjointed)
   moreover have "(\<lambda>n. (\<Sum>i<n. f (disjointed A i))) \<longlonglongrightarrow> (\<Sum>i. f (disjointed A i))"
     using f(1)[unfolded positive_def] dA
     by (auto intro!: summable_LIMSEQ)
   from LIMSEQ_Suc[OF this]
   have "(\<lambda>n. (\<Sum>i\<le>n. f (disjointed A i))) \<longlonglongrightarrow> (\<Sum>i. f (disjointed A i))"
     unfolding lessThan_Suc_atMost .
   moreover have "\<And>n. (\<Sum>i\<le>n. f (disjointed A i)) = f (A n)"
     using disjointed_additive[OF f A(1,2)] .
   ultimately show "(\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Union>i. A i)" by simp
 next
   assume cont: "\<forall>A. range A \<subseteq> M \<longrightarrow> incseq A \<longrightarrow> (\<Union>i. A i) \<in> M \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Union>i. A i)"
   fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> M" "disjoint_family A" "(\<Union>i. A i) \<in> M"
   have *: "(\<Union>n. (\<Union>i<n. A i)) = (\<Union>i. A i)" by auto
   have "(\<lambda>n. f (\<Union>i<n. A i)) \<longlonglongrightarrow> f (\<Union>i. A i)"
   proof (unfold *[symmetric], intro cont[rule_format])
     show "range (\<lambda>i. \<Union>i<i. A i) \<subseteq> M" "(\<Union>i. \<Union>i<i. A i) \<in> M"
       using A * by auto
   qed (force intro!: incseq_SucI)
   moreover have "\<And>n. f (\<Union>i<n. A i) = (\<Sum>i<n. f (A i))"
     using A
     by (intro additive_sum[OF f, of _ A, symmetric])
        (auto intro: disjoint_family_on_mono[where B=UNIV])
   ultimately
   have "(\<lambda>i. f (A i)) sums f (\<Union>i. A i)"
     unfolding sums_def by simp
   from sums_unique[OF this]
   show "(\<Sum>i. f (A i)) = f (\<Union>i. A i)" by simp
 qed
 
 lemma (in ring_of_sets) continuous_from_above_iff_empty_continuous:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" "additive M f"
   shows "(\<forall>A. range A \<subseteq> M \<longrightarrow> decseq A \<longrightarrow> (\<Inter>i. A i) \<in> M \<longrightarrow> (\<forall>i. f (A i) \<noteq> \<infinity>) \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Inter>i. A i))
      \<longleftrightarrow> (\<forall>A. range A \<subseteq> M \<longrightarrow> decseq A \<longrightarrow> (\<Inter>i. A i) = {} \<longrightarrow> (\<forall>i. f (A i) \<noteq> \<infinity>) \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> 0)"
 proof safe
   assume cont: "(\<forall>A. range A \<subseteq> M \<longrightarrow> decseq A \<longrightarrow> (\<Inter>i. A i) \<in> M \<longrightarrow> (\<forall>i. f (A i) \<noteq> \<infinity>) \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Inter>i. A i))"
   fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> M" "decseq A" "(\<Inter>i. A i) = {}" "\<forall>i. f (A i) \<noteq> \<infinity>"
   with cont[THEN spec, of A] show "(\<lambda>i. f (A i)) \<longlonglongrightarrow> 0"
     using \<open>positive M f\<close>[unfolded positive_def] by auto
 next
   assume cont: "\<forall>A. range A \<subseteq> M \<longrightarrow> decseq A \<longrightarrow> (\<Inter>i. A i) = {} \<longrightarrow> (\<forall>i. f (A i) \<noteq> \<infinity>) \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> 0"
   fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> M" "decseq A" "(\<Inter>i. A i) \<in> M" "\<forall>i. f (A i) \<noteq> \<infinity>"
 
   have f_mono: "\<And>a b. a \<in> M \<Longrightarrow> b \<in> M \<Longrightarrow> a \<subseteq> b \<Longrightarrow> f a \<le> f b"
     using additive_increasing[OF f] unfolding increasing_def by simp
 
   have decseq_fA: "decseq (\<lambda>i. f (A i))"
     using A by (auto simp: decseq_def intro!: f_mono)
   have decseq: "decseq (\<lambda>i. A i - (\<Inter>i. A i))"
     using A by (auto simp: decseq_def)
   then have decseq_f: "decseq (\<lambda>i. f (A i - (\<Inter>i. A i)))"
     using A unfolding decseq_def by (auto intro!: f_mono Diff)
   have "f (\<Inter>x. A x) \<le> f (A 0)"
     using A by (auto intro!: f_mono)
   then have f_Int_fin: "f (\<Inter>x. A x) \<noteq> \<infinity>"
     using A by (auto simp: top_unique)
   { fix i
     have "f (A i - (\<Inter>i. A i)) \<le> f (A i)" using A by (auto intro!: f_mono)
     then have "f (A i - (\<Inter>i. A i)) \<noteq> \<infinity>"
       using A by (auto simp: top_unique) }
   note f_fin = this
   have "(\<lambda>i. f (A i - (\<Inter>i. A i))) \<longlonglongrightarrow> 0"
   proof (intro cont[rule_format, OF _ decseq _ f_fin])
     show "range (\<lambda>i. A i - (\<Inter>i. A i)) \<subseteq> M" "(\<Inter>i. A i - (\<Inter>i. A i)) = {}"
       using A by auto
   qed
   from INF_Lim[OF decseq_f this]
   have "(INF n. f (A n - (\<Inter>i. A i))) = 0" .
   moreover have "(INF n. f (\<Inter>i. A i)) = f (\<Inter>i. A i)"
     by auto
   ultimately have "(INF n. f (A n - (\<Inter>i. A i)) + f (\<Inter>i. A i)) = 0 + f (\<Inter>i. A i)"
     using A(4) f_fin f_Int_fin
     by (subst INF_ennreal_add_const) (auto simp: decseq_f)
   moreover {
     fix n
     have "f (A n - (\<Inter>i. A i)) + f (\<Inter>i. A i) = f ((A n - (\<Inter>i. A i)) \<union> (\<Inter>i. A i))"
       using A by (subst f(2)[THEN additiveD]) auto
     also have "(A n - (\<Inter>i. A i)) \<union> (\<Inter>i. A i) = A n"
       by auto
     finally have "f (A n - (\<Inter>i. A i)) + f (\<Inter>i. A i) = f (A n)" . }
   ultimately have "(INF n. f (A n)) = f (\<Inter>i. A i)"
     by simp
   with LIMSEQ_INF[OF decseq_fA]
   show "(\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Inter>i. A i)" by simp
 qed
 
 lemma (in ring_of_sets) empty_continuous_imp_continuous_from_below:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" "additive M f" "\<forall>A\<in>M. f A \<noteq> \<infinity>"
   assumes cont: "\<forall>A. range A \<subseteq> M \<longrightarrow> decseq A \<longrightarrow> (\<Inter>i. A i) = {} \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> 0"
   assumes A: "range A \<subseteq> M" "incseq A" "(\<Union>i. A i) \<in> M"
   shows "(\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Union>i. A i)"
 proof -
   from A have "(\<lambda>i. f ((\<Union>i. A i) - A i)) \<longlonglongrightarrow> 0"
     by (intro cont[rule_format]) (auto simp: decseq_def incseq_def)
   moreover
   { fix i
     have "f ((\<Union>i. A i) - A i \<union> A i) = f ((\<Union>i. A i) - A i) + f (A i)"
       using A by (intro f(2)[THEN additiveD]) auto
     also have "((\<Union>i. A i) - A i) \<union> A i = (\<Union>i. A i)"
       by auto
     finally have "f ((\<Union>i. A i) - A i) = f (\<Union>i. A i) - f (A i)"
       using f(3)[rule_format, of "A i"] A by (auto simp: ennreal_add_diff_cancel subset_eq) }
   moreover have "\<forall>\<^sub>F i in sequentially. f (A i) \<le> f (\<Union>i. A i)"
     using increasingD[OF additive_increasing[OF f(1, 2)], of "A _" "\<Union>i. A i"] A
     by (auto intro!: always_eventually simp: subset_eq)
   ultimately show "(\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Union>i. A i)"
     by (auto intro: ennreal_tendsto_const_minus)
 qed
 
 lemma (in ring_of_sets) empty_continuous_imp_countably_additive:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" "additive M f" and fin: "\<forall>A\<in>M. f A \<noteq> \<infinity>"
   assumes cont: "\<And>A. range A \<subseteq> M \<Longrightarrow> decseq A \<Longrightarrow> (\<Inter>i. A i) = {} \<Longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> 0"
   shows "countably_additive M f"
   using countably_additive_iff_continuous_from_below[OF f]
   using empty_continuous_imp_continuous_from_below[OF f fin] cont
   by blast
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Properties of \<^const>\<open>emeasure\<close>\<close>
 
 lemma emeasure_positive: "positive (sets M) (emeasure M)"
   by (cases M) (auto simp: sets_def emeasure_def Abs_measure_inverse measure_space_def)
 
 lemma emeasure_empty[simp, intro]: "emeasure M {} = 0"
   using emeasure_positive[of M] by (simp add: positive_def)
 
 lemma emeasure_single_in_space: "emeasure M {x} \<noteq> 0 \<Longrightarrow> x \<in> space M"
   using emeasure_notin_sets[of "{x}" M] by (auto dest: sets.sets_into_space zero_less_iff_neq_zero[THEN iffD2])
 
 lemma emeasure_countably_additive: "countably_additive (sets M) (emeasure M)"
   by (cases M) (auto simp: sets_def emeasure_def Abs_measure_inverse measure_space_def)
 
 lemma suminf_emeasure:
   "range A \<subseteq> sets M \<Longrightarrow> disjoint_family A \<Longrightarrow> (\<Sum>i. emeasure M (A i)) = emeasure M (\<Union>i. A i)"
   using sets.countable_UN[of A UNIV M] emeasure_countably_additive[of M]
   by (simp add: countably_additive_def)
 
 lemma sums_emeasure:
   "disjoint_family F \<Longrightarrow> (\<And>i. F i \<in> sets M) \<Longrightarrow> (\<lambda>i. emeasure M (F i)) sums emeasure M (\<Union>i. F i)"
   unfolding sums_iff by (intro conjI suminf_emeasure) auto
 
 lemma emeasure_additive: "additive (sets M) (emeasure M)"
   by (metis sets.countably_additive_additive emeasure_positive emeasure_countably_additive)
 
 lemma plus_emeasure:
   "a \<in> sets M \<Longrightarrow> b \<in> sets M \<Longrightarrow> a \<inter> b = {} \<Longrightarrow> emeasure M a + emeasure M b = emeasure M (a \<union> b)"
   using additiveD[OF emeasure_additive] ..
 
 lemma emeasure_Un:
   "A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> emeasure M (A \<union> B) = emeasure M A + emeasure M (B - A)"
   using plus_emeasure[of A M "B - A"] by auto
 
 lemma emeasure_Un_Int:
   assumes "A \<in> sets M" "B \<in> sets M"
   shows "emeasure M A + emeasure M B = emeasure M (A \<union> B) + emeasure M (A \<inter> B)"
 proof -
   have "A = (A-B) \<union> (A \<inter> B)" by auto
   then have "emeasure M A = emeasure M (A-B) + emeasure M (A \<inter> B)"
     by (metis Diff_Diff_Int Diff_disjoint assms plus_emeasure sets.Diff)
   moreover have "A \<union> B = (A-B) \<union> B" by auto
   then have "emeasure M (A \<union> B) = emeasure M (A-B) + emeasure M B"
     by (metis Diff_disjoint Int_commute assms plus_emeasure sets.Diff)
   ultimately show ?thesis by (metis add.assoc add.commute)
 qed
 
 lemma sum_emeasure:
   "F`I \<subseteq> sets M \<Longrightarrow> disjoint_family_on F I \<Longrightarrow> finite I \<Longrightarrow>
     (\<Sum>i\<in>I. emeasure M (F i)) = emeasure M (\<Union>i\<in>I. F i)"
   by (metis sets.additive_sum emeasure_positive emeasure_additive)
 
 lemma emeasure_mono:
   "a \<subseteq> b \<Longrightarrow> b \<in> sets M \<Longrightarrow> emeasure M a \<le> emeasure M b"
   by (metis zero_le sets.additive_increasing emeasure_additive emeasure_notin_sets emeasure_positive increasingD)
 
 lemma emeasure_space:
   "emeasure M A \<le> emeasure M (space M)"
   by (metis emeasure_mono emeasure_notin_sets sets.sets_into_space sets.top zero_le)
 
 lemma emeasure_Diff:
   assumes finite: "emeasure M B \<noteq> \<infinity>"
   and [measurable]: "A \<in> sets M" "B \<in> sets M" and "B \<subseteq> A"
   shows "emeasure M (A - B) = emeasure M A - emeasure M B"
 proof -
   have "(A - B) \<union> B = A" using \<open>B \<subseteq> A\<close> by auto
   then have "emeasure M A = emeasure M ((A - B) \<union> B)" by simp
   also have "\<dots> = emeasure M (A - B) + emeasure M B"
     by (subst plus_emeasure[symmetric]) auto
   finally show "emeasure M (A - B) = emeasure M A - emeasure M B"
     using finite by simp
 qed
 
 lemma emeasure_compl:
   "s \<in> sets M \<Longrightarrow> emeasure M s \<noteq> \<infinity> \<Longrightarrow> emeasure M (space M - s) = emeasure M (space M) - emeasure M s"
   by (rule emeasure_Diff) (auto dest: sets.sets_into_space)
 
 lemma Lim_emeasure_incseq:
   "range A \<subseteq> sets M \<Longrightarrow> incseq A \<Longrightarrow> (\<lambda>i. (emeasure M (A i))) \<longlonglongrightarrow> emeasure M (\<Union>i. A i)"
   using emeasure_countably_additive
   by (auto simp add: sets.countably_additive_iff_continuous_from_below emeasure_positive
     emeasure_additive)
 
 lemma incseq_emeasure:
   assumes "range B \<subseteq> sets M" "incseq B"
   shows "incseq (\<lambda>i. emeasure M (B i))"
   using assms by (auto simp: incseq_def intro!: emeasure_mono)
 
 lemma SUP_emeasure_incseq:
   assumes A: "range A \<subseteq> sets M" "incseq A"
   shows "(SUP n. emeasure M (A n)) = emeasure M (\<Union>i. A i)"
   using LIMSEQ_SUP[OF incseq_emeasure, OF A] Lim_emeasure_incseq[OF A]
   by (simp add: LIMSEQ_unique)
 
 lemma decseq_emeasure:
   assumes "range B \<subseteq> sets M" "decseq B"
   shows "decseq (\<lambda>i. emeasure M (B i))"
   using assms by (auto simp: decseq_def intro!: emeasure_mono)
 
 lemma INF_emeasure_decseq:
   assumes A: "range A \<subseteq> sets M" and "decseq A"
   and finite: "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
   shows "(INF n. emeasure M (A n)) = emeasure M (\<Inter>i. A i)"
 proof -
   have le_MI: "emeasure M (\<Inter>i. A i) \<le> emeasure M (A 0)"
     using A by (auto intro!: emeasure_mono)
   hence *: "emeasure M (\<Inter>i. A i) \<noteq> \<infinity>" using finite[of 0] by (auto simp: top_unique)
 
   have "emeasure M (A 0) - (INF n. emeasure M (A n)) = (SUP n. emeasure M (A 0) - emeasure M (A n))"
     by (simp add: ennreal_INF_const_minus)
   also have "\<dots> = (SUP n. emeasure M (A 0 - A n))"
     using A finite \<open>decseq A\<close>[unfolded decseq_def] by (subst emeasure_Diff) auto
   also have "\<dots> = emeasure M (\<Union>i. A 0 - A i)"
   proof (rule SUP_emeasure_incseq)
     show "range (\<lambda>n. A 0 - A n) \<subseteq> sets M"
       using A by auto
     show "incseq (\<lambda>n. A 0 - A n)"
       using \<open>decseq A\<close> by (auto simp add: incseq_def decseq_def)
   qed
   also have "\<dots> = emeasure M (A 0) - emeasure M (\<Inter>i. A i)"
     using A finite * by (simp, subst emeasure_Diff) auto
   finally show ?thesis
     by (rule ennreal_minus_cancel[rotated 3])
        (insert finite A, auto intro: INF_lower emeasure_mono)
 qed
 
 lemma INF_emeasure_decseq':
   assumes A: "\<And>i. A i \<in> sets M" and "decseq A"
   and finite: "\<exists>i. emeasure M (A i) \<noteq> \<infinity>"
   shows "(INF n. emeasure M (A n)) = emeasure M (\<Inter>i. A i)"
 proof -
   from finite obtain i where i: "emeasure M (A i) < \<infinity>"
     by (auto simp: less_top)
   have fin: "i \<le> j \<Longrightarrow> emeasure M (A j) < \<infinity>" for j
     by (rule le_less_trans[OF emeasure_mono i]) (auto intro!: decseqD[OF \<open>decseq A\<close>] A)
 
   have "(INF n. emeasure M (A n)) = (INF n. emeasure M (A (n + i)))"
   proof (rule INF_eq)
     show "\<exists>j\<in>UNIV. emeasure M (A (j + i)) \<le> emeasure M (A i')" for i'
       by (intro bexI[of _ i'] emeasure_mono decseqD[OF \<open>decseq A\<close>] A) auto
   qed auto
   also have "\<dots> = emeasure M (INF n. (A (n + i)))"
     using A \<open>decseq A\<close> fin by (intro INF_emeasure_decseq) (auto simp: decseq_def less_top)
   also have "(INF n. (A (n + i))) = (INF n. A n)"
     by (meson INF_eq UNIV_I assms(2) decseqD le_add1)
   finally show ?thesis .
 qed
 
 lemma emeasure_INT_decseq_subset:
   fixes F :: "nat \<Rightarrow> 'a set"
   assumes I: "I \<noteq> {}" and F: "\<And>i j. i \<in> I \<Longrightarrow> j \<in> I \<Longrightarrow> i \<le> j \<Longrightarrow> F j \<subseteq> F i"
   assumes F_sets[measurable]: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M"
     and fin: "\<And>i. i \<in> I \<Longrightarrow> emeasure M (F i) \<noteq> \<infinity>"
   shows "emeasure M (\<Inter>i\<in>I. F i) = (INF i\<in>I. emeasure M (F i))"
 proof cases
   assume "finite I"
   have "(\<Inter>i\<in>I. F i) = F (Max I)"
     using I \<open>finite I\<close> by (intro antisym INF_lower INF_greatest F) auto
   moreover have "(INF i\<in>I. emeasure M (F i)) = emeasure M (F (Max I))"
     using I \<open>finite I\<close> by (intro antisym INF_lower INF_greatest F emeasure_mono) auto
   ultimately show ?thesis
     by simp
 next
   assume "infinite I"
   define L where "L n = (LEAST i. i \<in> I \<and> i \<ge> n)" for n
   have L: "L n \<in> I \<and> n \<le> L n" for n
     unfolding L_def
   proof (rule LeastI_ex)
     show "\<exists>x. x \<in> I \<and> n \<le> x"
       using \<open>infinite I\<close> finite_subset[of I "{..< n}"]
       by (rule_tac ccontr) (auto simp: not_le)
   qed
   have L_eq[simp]: "i \<in> I \<Longrightarrow> L i = i" for i
     unfolding L_def by (intro Least_equality) auto
   have L_mono: "i \<le> j \<Longrightarrow> L i \<le> L j" for i j
     using L[of j] unfolding L_def by (intro Least_le) (auto simp: L_def)
 
   have "emeasure M (\<Inter>i. F (L i)) = (INF i. emeasure M (F (L i)))"
   proof (intro INF_emeasure_decseq[symmetric])
     show "decseq (\<lambda>i. F (L i))"
       using L by (intro antimonoI F L_mono) auto
   qed (insert L fin, auto)
   also have "\<dots> = (INF i\<in>I. emeasure M (F i))"
   proof (intro antisym INF_greatest)
     show "i \<in> I \<Longrightarrow> (INF i. emeasure M (F (L i))) \<le> emeasure M (F i)" for i
       by (intro INF_lower2[of i]) auto
   qed (insert L, auto intro: INF_lower)
   also have "(\<Inter>i. F (L i)) = (\<Inter>i\<in>I. F i)"
   proof (intro antisym INF_greatest)
     show "i \<in> I \<Longrightarrow> (\<Inter>i. F (L i)) \<subseteq> F i" for i
       by (intro INF_lower2[of i]) auto
   qed (insert L, auto)
   finally show ?thesis .
 qed
 
 lemma Lim_emeasure_decseq:
   assumes A: "range A \<subseteq> sets M" "decseq A" and fin: "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
   shows "(\<lambda>i. emeasure M (A i)) \<longlonglongrightarrow> emeasure M (\<Inter>i. A i)"
   using LIMSEQ_INF[OF decseq_emeasure, OF A]
   using INF_emeasure_decseq[OF A fin] by simp
 
 lemma emeasure_lfp'[consumes 1, case_names cont measurable]:
   assumes "P M"
   assumes cont: "sup_continuous F"
   assumes *: "\<And>M A. P M \<Longrightarrow> (\<And>N. P N \<Longrightarrow> Measurable.pred N A) \<Longrightarrow> Measurable.pred M (F A)"
   shows "emeasure M {x\<in>space M. lfp F x} = (SUP i. emeasure M {x\<in>space M. (F ^^ i) (\<lambda>x. False) x})"
 proof -
   have "emeasure M {x\<in>space M. lfp F x} = emeasure M (\<Union>i. {x\<in>space M. (F ^^ i) (\<lambda>x. False) x})"
     using sup_continuous_lfp[OF cont] by (auto simp add: bot_fun_def intro!: arg_cong2[where f=emeasure])
   moreover { fix i from \<open>P M\<close> have "{x\<in>space M. (F ^^ i) (\<lambda>x. False) x} \<in> sets M"
     by (induct i arbitrary: M) (auto simp add: pred_def[symmetric] intro: *) }
   moreover have "incseq (\<lambda>i. {x\<in>space M. (F ^^ i) (\<lambda>x. False) x})"
   proof (rule incseq_SucI)
     fix i
     have "(F ^^ i) (\<lambda>x. False) \<le> (F ^^ (Suc i)) (\<lambda>x. False)"
     proof (induct i)
       case 0 show ?case by (simp add: le_fun_def)
     next
       case Suc thus ?case using monoD[OF sup_continuous_mono[OF cont] Suc] by auto
     qed
     then show "{x \<in> space M. (F ^^ i) (\<lambda>x. False) x} \<subseteq> {x \<in> space M. (F ^^ Suc i) (\<lambda>x. False) x}"
       by auto
   qed
   ultimately show ?thesis
     by (subst SUP_emeasure_incseq) auto
 qed
 
 lemma emeasure_lfp:
   assumes [simp]: "\<And>s. sets (M s) = sets N"
   assumes cont: "sup_continuous F" "sup_continuous f"
   assumes meas: "\<And>P. Measurable.pred N P \<Longrightarrow> Measurable.pred N (F P)"
   assumes iter: "\<And>P s. Measurable.pred N P \<Longrightarrow> P \<le> lfp F \<Longrightarrow> emeasure (M s) {x\<in>space N. F P x} = f (\<lambda>s. emeasure (M s) {x\<in>space N. P x}) s"
   shows "emeasure (M s) {x\<in>space N. lfp F x} = lfp f s"
 proof (subst lfp_transfer_bounded[where \<alpha>="\<lambda>F s. emeasure (M s) {x\<in>space N. F x}" and g=f and f=F and P="Measurable.pred N", symmetric])
   fix C assume "incseq C" "\<And>i. Measurable.pred N (C i)"
   then show "(\<lambda>s. emeasure (M s) {x \<in> space N. (SUP i. C i) x}) = (SUP i. (\<lambda>s. emeasure (M s) {x \<in> space N. C i x}))"
     unfolding SUP_apply[abs_def]
     by (subst SUP_emeasure_incseq) (auto simp: mono_def fun_eq_iff intro!: arg_cong2[where f=emeasure])
 qed (auto simp add: iter le_fun_def SUP_apply[abs_def] intro!: meas cont)
 
 lemma emeasure_subadditive_finite:
   "finite I \<Longrightarrow> A ` I \<subseteq> sets M \<Longrightarrow> emeasure M (\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. emeasure M (A i))"
   by (rule sets.subadditive[OF emeasure_positive emeasure_additive]) auto
 
 lemma emeasure_subadditive:
   "A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> emeasure M (A \<union> B) \<le> emeasure M A + emeasure M B"
   using emeasure_subadditive_finite[of "{True, False}" "\<lambda>True \<Rightarrow> A | False \<Rightarrow> B" M] by simp
 
 lemma emeasure_subadditive_countably:
   assumes "range f \<subseteq> sets M"
   shows "emeasure M (\<Union>i. f i) \<le> (\<Sum>i. emeasure M (f i))"
 proof -
   have "emeasure M (\<Union>i. f i) = emeasure M (\<Union>i. disjointed f i)"
     unfolding UN_disjointed_eq ..
   also have "\<dots> = (\<Sum>i. emeasure M (disjointed f i))"
     using sets.range_disjointed_sets[OF assms] suminf_emeasure[of "disjointed f"]
     by (simp add:  disjoint_family_disjointed comp_def)
   also have "\<dots> \<le> (\<Sum>i. emeasure M (f i))"
     using sets.range_disjointed_sets[OF assms] assms
     by (auto intro!: suminf_le emeasure_mono disjointed_subset)
   finally show ?thesis .
 qed
 
 lemma emeasure_insert:
   assumes sets: "{x} \<in> sets M" "A \<in> sets M" and "x \<notin> A"
   shows "emeasure M (insert x A) = emeasure M {x} + emeasure M A"
 proof -
   have "{x} \<inter> A = {}" using \<open>x \<notin> A\<close> by auto
   from plus_emeasure[OF sets this] show ?thesis by simp
 qed
 
 lemma emeasure_insert_ne:
   "A \<noteq> {} \<Longrightarrow> {x} \<in> sets M \<Longrightarrow> A \<in> sets M \<Longrightarrow> x \<notin> A \<Longrightarrow> emeasure M (insert x A) = emeasure M {x} + emeasure M A"
   by (rule emeasure_insert)
 
 lemma emeasure_eq_sum_singleton:
   assumes "finite S" "\<And>x. x \<in> S \<Longrightarrow> {x} \<in> sets M"
   shows "emeasure M S = (\<Sum>x\<in>S. emeasure M {x})"
   using sum_emeasure[of "\<lambda>x. {x}" S M] assms
   by (auto simp: disjoint_family_on_def subset_eq)
 
 lemma sum_emeasure_cover:
   assumes "finite S" and "A \<in> sets M" and br_in_M: "B ` S \<subseteq> sets M"
   assumes A: "A \<subseteq> (\<Union>i\<in>S. B i)"
   assumes disj: "disjoint_family_on B S"
   shows "emeasure M A = (\<Sum>i\<in>S. emeasure M (A \<inter> (B i)))"
 proof -
   have "(\<Sum>i\<in>S. emeasure M (A \<inter> (B i))) = emeasure M (\<Union>i\<in>S. A \<inter> (B i))"
   proof (rule sum_emeasure)
     show "disjoint_family_on (\<lambda>i. A \<inter> B i) S"
       using \<open>disjoint_family_on B S\<close>
       unfolding disjoint_family_on_def by auto
   qed (insert assms, auto)
   also have "(\<Union>i\<in>S. A \<inter> (B i)) = A"
     using A by auto
   finally show ?thesis by simp
 qed
 
 lemma emeasure_eq_0:
   "N \<in> sets M \<Longrightarrow> emeasure M N = 0 \<Longrightarrow> K \<subseteq> N \<Longrightarrow> emeasure M K = 0"
   by (metis emeasure_mono order_eq_iff zero_le)
 
 lemma emeasure_UN_eq_0:
   assumes "\<And>i::nat. emeasure M (N i) = 0" and "range N \<subseteq> sets M"
   shows "emeasure M (\<Union>i. N i) = 0"
 proof -
   have "emeasure M (\<Union>i. N i) \<le> 0"
     using emeasure_subadditive_countably[OF assms(2)] assms(1) by simp
   then show ?thesis
     by (auto intro: antisym zero_le)
 qed
 
 lemma measure_eqI_finite:
   assumes [simp]: "sets M = Pow A" "sets N = Pow A" and "finite A"
   assumes eq: "\<And>a. a \<in> A \<Longrightarrow> emeasure M {a} = emeasure N {a}"
   shows "M = N"
 proof (rule measure_eqI)
   fix X assume "X \<in> sets M"
   then have X: "X \<subseteq> A" by auto
   then have "emeasure M X = (\<Sum>a\<in>X. emeasure M {a})"
     using \<open>finite A\<close> by (subst emeasure_eq_sum_singleton) (auto dest: finite_subset)
   also have "\<dots> = (\<Sum>a\<in>X. emeasure N {a})"
     using X eq by (auto intro!: sum.cong)
   also have "\<dots> = emeasure N X"
     using X \<open>finite A\<close> by (subst emeasure_eq_sum_singleton) (auto dest: finite_subset)
   finally show "emeasure M X = emeasure N X" .
 qed simp
 
 lemma measure_eqI_generator_eq:
   fixes M N :: "'a measure" and E :: "'a set set" and A :: "nat \<Rightarrow> 'a set"
   assumes "Int_stable E" "E \<subseteq> Pow \<Omega>"
   and eq: "\<And>X. X \<in> E \<Longrightarrow> emeasure M X = emeasure N X"
   and M: "sets M = sigma_sets \<Omega> E"
   and N: "sets N = sigma_sets \<Omega> E"
   and A: "range A \<subseteq> E" "(\<Union>i. A i) = \<Omega>" "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
   shows "M = N"
 proof -
   let ?\<mu>  = "emeasure M" and ?\<nu> = "emeasure N"
   interpret S: sigma_algebra \<Omega> "sigma_sets \<Omega> E" by (rule sigma_algebra_sigma_sets) fact
   have "space M = \<Omega>"
     using sets.top[of M] sets.space_closed[of M] S.top S.space_closed \<open>sets M = sigma_sets \<Omega> E\<close>
     by blast
 
   { fix F D assume "F \<in> E" and "?\<mu> F \<noteq> \<infinity>"
     then have [intro]: "F \<in> sigma_sets \<Omega> E" by auto
     have "?\<nu> F \<noteq> \<infinity>" using \<open>?\<mu> F \<noteq> \<infinity>\<close> \<open>F \<in> E\<close> eq by simp
     assume "D \<in> sets M"
     with \<open>Int_stable E\<close> \<open>E \<subseteq> Pow \<Omega>\<close> have "emeasure M (F \<inter> D) = emeasure N (F \<inter> D)"
       unfolding M
     proof (induct rule: sigma_sets_induct_disjoint)
       case (basic A)
       then have "F \<inter> A \<in> E" using \<open>Int_stable E\<close> \<open>F \<in> E\<close> by (auto simp: Int_stable_def)
       then show ?case using eq by auto
     next
       case empty then show ?case by simp
     next
       case (compl A)
       then have **: "F \<inter> (\<Omega> - A) = F - (F \<inter> A)"
         and [intro]: "F \<inter> A \<in> sigma_sets \<Omega> E"
         using \<open>F \<in> E\<close> S.sets_into_space by (auto simp: M)
       have "?\<nu> (F \<inter> A) \<le> ?\<nu> F" by (auto intro!: emeasure_mono simp: M N)
       then have "?\<nu> (F \<inter> A) \<noteq> \<infinity>" using \<open>?\<nu> F \<noteq> \<infinity>\<close> by (auto simp: top_unique)
       have "?\<mu> (F \<inter> A) \<le> ?\<mu> F" by (auto intro!: emeasure_mono simp: M N)
       then have "?\<mu> (F \<inter> A) \<noteq> \<infinity>" using \<open>?\<mu> F \<noteq> \<infinity>\<close> by (auto simp: top_unique)
       then have "?\<mu> (F \<inter> (\<Omega> - A)) = ?\<mu> F - ?\<mu> (F \<inter> A)" unfolding **
         using \<open>F \<inter> A \<in> sigma_sets \<Omega> E\<close> by (auto intro!: emeasure_Diff simp: M N)
       also have "\<dots> = ?\<nu> F - ?\<nu> (F \<inter> A)" using eq \<open>F \<in> E\<close> compl by simp
       also have "\<dots> = ?\<nu> (F \<inter> (\<Omega> - A))" unfolding **
         using \<open>F \<inter> A \<in> sigma_sets \<Omega> E\<close> \<open>?\<nu> (F \<inter> A) \<noteq> \<infinity>\<close>
         by (auto intro!: emeasure_Diff[symmetric] simp: M N)
       finally show ?case
         using \<open>space M = \<Omega>\<close> by auto
     next
       case (union A)
       then have "?\<mu> (\<Union>x. F \<inter> A x) = ?\<nu> (\<Union>x. F \<inter> A x)"
         by (subst (1 2) suminf_emeasure[symmetric]) (auto simp: disjoint_family_on_def subset_eq M N)
       with A show ?case
         by auto
     qed }
   note * = this
   show "M = N"
   proof (rule measure_eqI)
     show "sets M = sets N"
       using M N by simp
     have [simp, intro]: "\<And>i. A i \<in> sets M"
       using A(1) by (auto simp: subset_eq M)
     fix F assume "F \<in> sets M"
     let ?D = "disjointed (\<lambda>i. F \<inter> A i)"
     from \<open>space M = \<Omega>\<close> have F_eq: "F = (\<Union>i. ?D i)"
       using \<open>F \<in> sets M\<close>[THEN sets.sets_into_space] A(2)[symmetric] by (auto simp: UN_disjointed_eq)
     have [simp, intro]: "\<And>i. ?D i \<in> sets M"
       using sets.range_disjointed_sets[of "\<lambda>i. F \<inter> A i" M] \<open>F \<in> sets M\<close>
       by (auto simp: subset_eq)
     have "disjoint_family ?D"
       by (auto simp: disjoint_family_disjointed)
     moreover
     have "(\<Sum>i. emeasure M (?D i)) = (\<Sum>i. emeasure N (?D i))"
     proof (intro arg_cong[where f=suminf] ext)
       fix i
       have "A i \<inter> ?D i = ?D i"
         by (auto simp: disjointed_def)
       then show "emeasure M (?D i) = emeasure N (?D i)"
         using *[of "A i" "?D i", OF _ A(3)] A(1) by auto
     qed
     ultimately show "emeasure M F = emeasure N F"
       by (simp add: image_subset_iff \<open>sets M = sets N\<close>[symmetric] F_eq[symmetric] suminf_emeasure)
   qed
 qed
 
 lemma space_empty: "space M = {} \<Longrightarrow> M = count_space {}"
   by (rule measure_eqI) (simp_all add: space_empty_iff)
 
 lemma measure_eqI_generator_eq_countable:
   fixes M N :: "'a measure" and E :: "'a set set" and A :: "'a set set"
   assumes E: "Int_stable E" "E \<subseteq> Pow \<Omega>" "\<And>X. X \<in> E \<Longrightarrow> emeasure M X = emeasure N X"
     and sets: "sets M = sigma_sets \<Omega> E" "sets N = sigma_sets \<Omega> E"
   and A: "A \<subseteq> E" "(\<Union>A) = \<Omega>" "countable A" "\<And>a. a \<in> A \<Longrightarrow> emeasure M a \<noteq> \<infinity>"
   shows "M = N"
 proof cases
   assume "\<Omega> = {}"
   have *: "sigma_sets \<Omega> E = sets (sigma \<Omega> E)"
     using E(2) by simp
   have "space M = \<Omega>" "space N = \<Omega>"
     using sets E(2) unfolding * by (auto dest: sets_eq_imp_space_eq simp del: sets_measure_of)
   then show "M = N"
     unfolding \<open>\<Omega> = {}\<close> by (auto dest: space_empty)
 next
   assume "\<Omega> \<noteq> {}" with \<open>\<Union>A = \<Omega>\<close> have "A \<noteq> {}" by auto
   from this \<open>countable A\<close> have rng: "range (from_nat_into A) = A"
     by (rule range_from_nat_into)
   show "M = N"
   proof (rule measure_eqI_generator_eq[OF E sets])
     show "range (from_nat_into A) \<subseteq> E"
       unfolding rng using \<open>A \<subseteq> E\<close> .
     show "(\<Union>i. from_nat_into A i) = \<Omega>"
       unfolding rng using \<open>\<Union>A = \<Omega>\<close> .
     show "emeasure M (from_nat_into A i) \<noteq> \<infinity>" for i
       using rng by (intro A) auto
   qed
 qed
 
 lemma measure_of_of_measure: "measure_of (space M) (sets M) (emeasure M) = M"
 proof (intro measure_eqI emeasure_measure_of_sigma)
   show "sigma_algebra (space M) (sets M)" ..
   show "positive (sets M) (emeasure M)"
     by (simp add: positive_def)
   show "countably_additive (sets M) (emeasure M)"
     by (simp add: emeasure_countably_additive)
 qed simp_all
 
 subsection \<open>\<open>\<mu>\<close>-null sets\<close>
 
 definition\<^marker>\<open>tag important\<close> null_sets :: "'a measure \<Rightarrow> 'a set set" where
   "null_sets M = {N\<in>sets M. emeasure M N = 0}"
 
 lemma null_setsD1[dest]: "A \<in> null_sets M \<Longrightarrow> emeasure M A = 0"
   by (simp add: null_sets_def)
 
 lemma null_setsD2[dest]: "A \<in> null_sets M \<Longrightarrow> A \<in> sets M"
   unfolding null_sets_def by simp
 
 lemma null_setsI[intro]: "emeasure M A = 0 \<Longrightarrow> A \<in> sets M \<Longrightarrow> A \<in> null_sets M"
   unfolding null_sets_def by simp
 
 interpretation null_sets: ring_of_sets "space M" "null_sets M" for M
 proof (rule ring_of_setsI)
   show "null_sets M \<subseteq> Pow (space M)"
     using sets.sets_into_space by auto
   show "{} \<in> null_sets M"
     by auto
   fix A B assume null_sets: "A \<in> null_sets M" "B \<in> null_sets M"
   then have sets: "A \<in> sets M" "B \<in> sets M"
     by auto
   then have *: "emeasure M (A \<union> B) \<le> emeasure M A + emeasure M B"
     "emeasure M (A - B) \<le> emeasure M A"
     by (auto intro!: emeasure_subadditive emeasure_mono)
   then have "emeasure M B = 0" "emeasure M A = 0"
     using null_sets by auto
   with sets * show "A - B \<in> null_sets M" "A \<union> B \<in> null_sets M"
     by (auto intro!: antisym zero_le)
 qed
 
 lemma UN_from_nat_into:
   assumes I: "countable I" "I \<noteq> {}"
   shows "(\<Union>i\<in>I. N i) = (\<Union>i. N (from_nat_into I i))"
 proof -
   have "(\<Union>i\<in>I. N i) = \<Union>(N ` range (from_nat_into I))"
     using I by simp
   also have "\<dots> = (\<Union>i. (N \<circ> from_nat_into I) i)"
     by simp
   finally show ?thesis by simp
 qed
 
 lemma null_sets_UN':
   assumes "countable I"
   assumes "\<And>i. i \<in> I \<Longrightarrow> N i \<in> null_sets M"
   shows "(\<Union>i\<in>I. N i) \<in> null_sets M"
 proof cases
   assume "I = {}" then show ?thesis by simp
 next
   assume "I \<noteq> {}"
   show ?thesis
   proof (intro conjI CollectI null_setsI)
     show "(\<Union>i\<in>I. N i) \<in> sets M"
       using assms by (intro sets.countable_UN') auto
     have "emeasure M (\<Union>i\<in>I. N i) \<le> (\<Sum>n. emeasure M (N (from_nat_into I n)))"
       unfolding UN_from_nat_into[OF \<open>countable I\<close> \<open>I \<noteq> {}\<close>]
       using assms \<open>I \<noteq> {}\<close> by (intro emeasure_subadditive_countably) (auto intro: from_nat_into)
     also have "(\<lambda>n. emeasure M (N (from_nat_into I n))) = (\<lambda>_. 0)"
       using assms \<open>I \<noteq> {}\<close> by (auto intro: from_nat_into)
     finally show "emeasure M (\<Union>i\<in>I. N i) = 0"
       by (intro antisym zero_le) simp
   qed
 qed
 
 lemma null_sets_UN[intro]:
   "(\<And>i::'i::countable. N i \<in> null_sets M) \<Longrightarrow> (\<Union>i. N i) \<in> null_sets M"
   by (rule null_sets_UN') auto
 
 lemma null_set_Int1:
   assumes "B \<in> null_sets M" "A \<in> sets M" shows "A \<inter> B \<in> null_sets M"
 proof (intro CollectI conjI null_setsI)
   show "emeasure M (A \<inter> B) = 0" using assms
     by (intro emeasure_eq_0[of B _ "A \<inter> B"]) auto
 qed (insert assms, auto)
 
 lemma null_set_Int2:
   assumes "B \<in> null_sets M" "A \<in> sets M" shows "B \<inter> A \<in> null_sets M"
   using assms by (subst Int_commute) (rule null_set_Int1)
 
 lemma emeasure_Diff_null_set:
   assumes "B \<in> null_sets M" "A \<in> sets M"
   shows "emeasure M (A - B) = emeasure M A"
 proof -
   have *: "A - B = (A - (A \<inter> B))" by auto
   have "A \<inter> B \<in> null_sets M" using assms by (rule null_set_Int1)
   then show ?thesis
     unfolding * using assms
     by (subst emeasure_Diff) auto
 qed
 
 lemma null_set_Diff:
   assumes "B \<in> null_sets M" "A \<in> sets M" shows "B - A \<in> null_sets M"
 proof (intro CollectI conjI null_setsI)
   show "emeasure M (B - A) = 0" using assms by (intro emeasure_eq_0[of B _ "B - A"]) auto
 qed (insert assms, auto)
 
 lemma emeasure_Un_null_set:
   assumes "A \<in> sets M" "B \<in> null_sets M"
   shows "emeasure M (A \<union> B) = emeasure M A"
 proof -
   have *: "A \<union> B = A \<union> (B - A)" by auto
   have "B - A \<in> null_sets M" using assms(2,1) by (rule null_set_Diff)
   then show ?thesis
     unfolding * using assms
     by (subst plus_emeasure[symmetric]) auto
 qed
 
 lemma emeasure_Un':
   assumes "A \<in> sets M" "B \<in> sets M" "A \<inter> B \<in> null_sets M"
   shows   "emeasure M (A \<union> B) = emeasure M A + emeasure M B"
 proof -
   have "A \<union> B = A \<union> (B - A \<inter> B)" by blast
   also have "emeasure M \<dots> = emeasure M A + emeasure M (B - A \<inter> B)"
     using assms by (subst plus_emeasure) auto
   also have "emeasure M (B - A \<inter> B) = emeasure M B"
     using assms by (intro emeasure_Diff_null_set) auto
   finally show ?thesis .
 qed
 
 subsection \<open>The almost everywhere filter (i.e.\ quantifier)\<close>
 
 definition\<^marker>\<open>tag important\<close> ae_filter :: "'a measure \<Rightarrow> 'a filter" where
   "ae_filter M = (INF N\<in>null_sets M. principal (space M - N))"
 
 abbreviation almost_everywhere :: "'a measure \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool" where
   "almost_everywhere M P \<equiv> eventually P (ae_filter M)"
 
 syntax
   "_almost_everywhere" :: "pttrn \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> bool" ("AE _ in _. _" [0,0,10] 10)
 
 translations
   "AE x in M. P" \<rightleftharpoons> "CONST almost_everywhere M (\<lambda>x. P)"
 
 abbreviation
   "set_almost_everywhere A M P \<equiv> AE x in M. x \<in> A \<longrightarrow> P x"
 
 syntax
   "_set_almost_everywhere" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> bool"
   ("AE _\<in>_ in _./ _" [0,0,0,10] 10)
 
 translations
   "AE x\<in>A in M. P" \<rightleftharpoons> "CONST set_almost_everywhere A M (\<lambda>x. P)"
 
 lemma eventually_ae_filter: "eventually P (ae_filter M) \<longleftrightarrow> (\<exists>N\<in>null_sets M. {x \<in> space M. \<not> P x} \<subseteq> N)"
   unfolding ae_filter_def by (subst eventually_INF_base) (auto simp: eventually_principal subset_eq)
 
 lemma AE_I':
   "N \<in> null_sets M \<Longrightarrow> {x\<in>space M. \<not> P x} \<subseteq> N \<Longrightarrow> (AE x in M. P x)"
   unfolding eventually_ae_filter by auto
 
 lemma AE_iff_null:
   assumes "{x\<in>space M. \<not> P x} \<in> sets M" (is "?P \<in> sets M")
   shows "(AE x in M. P x) \<longleftrightarrow> {x\<in>space M. \<not> P x} \<in> null_sets M"
 proof
   assume "AE x in M. P x" then obtain N where N: "N \<in> sets M" "?P \<subseteq> N" "emeasure M N = 0"
     unfolding eventually_ae_filter by auto
   have "emeasure M ?P \<le> emeasure M N"
     using assms N(1,2) by (auto intro: emeasure_mono)
   then have "emeasure M ?P = 0"
     unfolding \<open>emeasure M N = 0\<close> by auto
   then show "?P \<in> null_sets M" using assms by auto
 next
   assume "?P \<in> null_sets M" with assms show "AE x in M. P x" by (auto intro: AE_I')
 qed
 
 lemma AE_iff_null_sets:
   "N \<in> sets M \<Longrightarrow> N \<in> null_sets M \<longleftrightarrow> (AE x in M. x \<notin> N)"
   using Int_absorb1[OF sets.sets_into_space, of N M]
   by (subst AE_iff_null) (auto simp: Int_def[symmetric])
 
 lemma AE_not_in:
   "N \<in> null_sets M \<Longrightarrow> AE x in M. x \<notin> N"
   by (metis AE_iff_null_sets null_setsD2)
 
 lemma AE_iff_measurable:
   "N \<in> sets M \<Longrightarrow> {x\<in>space M. \<not> P x} = N \<Longrightarrow> (AE x in M. P x) \<longleftrightarrow> emeasure M N = 0"
   using AE_iff_null[of _ P] by auto
 
 lemma AE_E[consumes 1]:
   assumes "AE x in M. P x"
   obtains N where "{x \<in> space M. \<not> P x} \<subseteq> N" "emeasure M N = 0" "N \<in> sets M"
   using assms unfolding eventually_ae_filter by auto
 
 lemma AE_E2:
   assumes "AE x in M. P x" "{x\<in>space M. P x} \<in> sets M"
   shows "emeasure M {x\<in>space M. \<not> P x} = 0" (is "emeasure M ?P = 0")
 proof -
   have "{x\<in>space M. \<not> P x} = space M - {x\<in>space M. P x}" by auto
   with AE_iff_null[of M P] assms show ?thesis by auto
 qed
 
 lemma AE_E3:
   assumes "AE x in M. P x"
   obtains N where "\<And>x. x \<in> space M - N \<Longrightarrow> P x" "N \<in> null_sets M"
 using assms unfolding eventually_ae_filter by auto
 
 lemma AE_I:
   assumes "{x \<in> space M. \<not> P x} \<subseteq> N" "emeasure M N = 0" "N \<in> sets M"
   shows "AE x in M. P x"
   using assms unfolding eventually_ae_filter by auto
 
 lemma AE_mp[elim!]:
   assumes AE_P: "AE x in M. P x" and AE_imp: "AE x in M. P x \<longrightarrow> Q x"
   shows "AE x in M. Q x"
 proof -
   from AE_P obtain A where P: "{x\<in>space M. \<not> P x} \<subseteq> A"
     and A: "A \<in> sets M" "emeasure M A = 0"
     by (auto elim!: AE_E)
 
   from AE_imp obtain B where imp: "{x\<in>space M. P x \<and> \<not> Q x} \<subseteq> B"
     and B: "B \<in> sets M" "emeasure M B = 0"
     by (auto elim!: AE_E)
 
   show ?thesis
   proof (intro AE_I)
     have "emeasure M (A \<union> B) \<le> 0"
       using emeasure_subadditive[of A M B] A B by auto
     then show "A \<union> B \<in> sets M" "emeasure M (A \<union> B) = 0"
       using A B by auto
     show "{x\<in>space M. \<not> Q x} \<subseteq> A \<union> B"
       using P imp by auto
   qed
 qed
 
 text \<open>The next lemma is convenient to combine with a lemma whose conclusion is of the
 form \<open>AE x in M. P x = Q x\<close>: for such a lemma, there is no \<open>[symmetric]\<close> variant,
 but using \<open>AE_symmetric[OF...]\<close> will replace it.\<close>
 
 (* depricated replace by laws about eventually *)
 lemma
   shows AE_iffI: "AE x in M. P x \<Longrightarrow> AE x in M. P x \<longleftrightarrow> Q x \<Longrightarrow> AE x in M. Q x"
     and AE_disjI1: "AE x in M. P x \<Longrightarrow> AE x in M. P x \<or> Q x"
     and AE_disjI2: "AE x in M. Q x \<Longrightarrow> AE x in M. P x \<or> Q x"
     and AE_conjI: "AE x in M. P x \<Longrightarrow> AE x in M. Q x \<Longrightarrow> AE x in M. P x \<and> Q x"
     and AE_conj_iff[simp]: "(AE x in M. P x \<and> Q x) \<longleftrightarrow> (AE x in M. P x) \<and> (AE x in M. Q x)"
   by auto
 
 lemma AE_symmetric:
   assumes "AE x in M. P x = Q x"
   shows "AE x in M. Q x = P x"
   using assms by auto
 
 lemma AE_impI:
   "(P \<Longrightarrow> AE x in M. Q x) \<Longrightarrow> AE x in M. P \<longrightarrow> Q x"
   by fastforce
 
 lemma AE_measure:
   assumes AE: "AE x in M. P x" and sets: "{x\<in>space M. P x} \<in> sets M" (is "?P \<in> sets M")
   shows "emeasure M {x\<in>space M. P x} = emeasure M (space M)"
 proof -
-  from AE_E[OF AE] guess N . note N = this
+  from AE_E[OF AE] obtain N
+    where N: "{x \<in> space M. \<not> P x} \<subseteq> N" "emeasure M N = 0" "N \<in> sets M"
+    by auto
   with sets have "emeasure M (space M) \<le> emeasure M (?P \<union> N)"
     by (intro emeasure_mono) auto
   also have "\<dots> \<le> emeasure M ?P + emeasure M N"
     using sets N by (intro emeasure_subadditive) auto
   also have "\<dots> = emeasure M ?P" using N by simp
   finally show "emeasure M ?P = emeasure M (space M)"
     using emeasure_space[of M "?P"] by auto
 qed
 
 lemma AE_space: "AE x in M. x \<in> space M"
   by (rule AE_I[where N="{}"]) auto
 
 lemma AE_I2[simp, intro]:
   "(\<And>x. x \<in> space M \<Longrightarrow> P x) \<Longrightarrow> AE x in M. P x"
   using AE_space by force
 
 lemma AE_Ball_mp:
   "\<forall>x\<in>space M. P x \<Longrightarrow> AE x in M. P x \<longrightarrow> Q x \<Longrightarrow> AE x in M. Q x"
   by auto
 
 lemma AE_cong[cong]:
   "(\<And>x. x \<in> space M \<Longrightarrow> P x \<longleftrightarrow> Q x) \<Longrightarrow> (AE x in M. P x) \<longleftrightarrow> (AE x in M. Q x)"
   by auto
 
 lemma AE_cong_simp: "M = N \<Longrightarrow> (\<And>x. x \<in> space N =simp=> P x = Q x) \<Longrightarrow> (AE x in M. P x) \<longleftrightarrow> (AE x in N. Q x)"
   by (auto simp: simp_implies_def)
 
 lemma AE_all_countable:
   "(AE x in M. \<forall>i. P i x) \<longleftrightarrow> (\<forall>i::'i::countable. AE x in M. P i x)"
 proof
   assume "\<forall>i. AE x in M. P i x"
   from this[unfolded eventually_ae_filter Bex_def, THEN choice]
   obtain N where N: "\<And>i. N i \<in> null_sets M" "\<And>i. {x\<in>space M. \<not> P i x} \<subseteq> N i" by auto
   have "{x\<in>space M. \<not> (\<forall>i. P i x)} \<subseteq> (\<Union>i. {x\<in>space M. \<not> P i x})" by auto
   also have "\<dots> \<subseteq> (\<Union>i. N i)" using N by auto
   finally have "{x\<in>space M. \<not> (\<forall>i. P i x)} \<subseteq> (\<Union>i. N i)" .
   moreover from N have "(\<Union>i. N i) \<in> null_sets M"
     by (intro null_sets_UN) auto
   ultimately show "AE x in M. \<forall>i. P i x"
     unfolding eventually_ae_filter by auto
 qed auto
 
 lemma AE_ball_countable:
   assumes [intro]: "countable X"
   shows "(AE x in M. \<forall>y\<in>X. P x y) \<longleftrightarrow> (\<forall>y\<in>X. AE x in M. P x y)"
 proof
   assume "\<forall>y\<in>X. AE x in M. P x y"
   from this[unfolded eventually_ae_filter Bex_def, THEN bchoice]
   obtain N where N: "\<And>y. y \<in> X \<Longrightarrow> N y \<in> null_sets M" "\<And>y. y \<in> X \<Longrightarrow> {x\<in>space M. \<not> P x y} \<subseteq> N y"
     by auto
   have "{x\<in>space M. \<not> (\<forall>y\<in>X. P x y)} \<subseteq> (\<Union>y\<in>X. {x\<in>space M. \<not> P x y})"
     by auto
   also have "\<dots> \<subseteq> (\<Union>y\<in>X. N y)"
     using N by auto
   finally have "{x\<in>space M. \<not> (\<forall>y\<in>X. P x y)} \<subseteq> (\<Union>y\<in>X. N y)" .
   moreover from N have "(\<Union>y\<in>X. N y) \<in> null_sets M"
     by (intro null_sets_UN') auto
   ultimately show "AE x in M. \<forall>y\<in>X. P x y"
     unfolding eventually_ae_filter by auto
 qed auto
 
 lemma AE_ball_countable':
   "(\<And>N. N \<in> I \<Longrightarrow> AE x in M. P N x) \<Longrightarrow> countable I \<Longrightarrow> AE x in M. \<forall>N \<in> I. P N x"
   unfolding AE_ball_countable by simp
 
 lemma AE_pairwise: "countable F \<Longrightarrow> pairwise (\<lambda>A B. AE x in M. R x A B) F \<longleftrightarrow> (AE x in M. pairwise (R x) F)"
   unfolding pairwise_alt by (simp add: AE_ball_countable)
 
 lemma AE_discrete_difference:
   assumes X: "countable X"
   assumes null: "\<And>x. x \<in> X \<Longrightarrow> emeasure M {x} = 0"
   assumes sets: "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M"
   shows "AE x in M. x \<notin> X"
 proof -
   have "(\<Union>x\<in>X. {x}) \<in> null_sets M"
     using assms by (intro null_sets_UN') auto
   from AE_not_in[OF this] show "AE x in M. x \<notin> X"
     by auto
 qed
 
 lemma AE_finite_all:
   assumes f: "finite S" shows "(AE x in M. \<forall>i\<in>S. P i x) \<longleftrightarrow> (\<forall>i\<in>S. AE x in M. P i x)"
   using f by induct auto
 
 lemma AE_finite_allI:
   assumes "finite S"
   shows "(\<And>s. s \<in> S \<Longrightarrow> AE x in M. Q s x) \<Longrightarrow> AE x in M. \<forall>s\<in>S. Q s x"
   using AE_finite_all[OF \<open>finite S\<close>] by auto
 
 lemma emeasure_mono_AE:
   assumes imp: "AE x in M. x \<in> A \<longrightarrow> x \<in> B"
     and B: "B \<in> sets M"
   shows "emeasure M A \<le> emeasure M B"
 proof cases
   assume A: "A \<in> sets M"
   from imp obtain N where N: "{x\<in>space M. \<not> (x \<in> A \<longrightarrow> x \<in> B)} \<subseteq> N" "N \<in> null_sets M"
     by (auto simp: eventually_ae_filter)
   have "emeasure M A = emeasure M (A - N)"
     using N A by (subst emeasure_Diff_null_set) auto
   also have "emeasure M (A - N) \<le> emeasure M (B - N)"
     using N A B sets.sets_into_space by (auto intro!: emeasure_mono)
   also have "emeasure M (B - N) = emeasure M B"
     using N B by (subst emeasure_Diff_null_set) auto
   finally show ?thesis .
 qed (simp add: emeasure_notin_sets)
 
 lemma emeasure_eq_AE:
   assumes iff: "AE x in M. x \<in> A \<longleftrightarrow> x \<in> B"
   assumes A: "A \<in> sets M" and B: "B \<in> sets M"
   shows "emeasure M A = emeasure M B"
   using assms by (safe intro!: antisym emeasure_mono_AE) auto
 
 lemma emeasure_Collect_eq_AE:
   "AE x in M. P x \<longleftrightarrow> Q x \<Longrightarrow> Measurable.pred M Q \<Longrightarrow> Measurable.pred M P \<Longrightarrow>
    emeasure M {x\<in>space M. P x} = emeasure M {x\<in>space M. Q x}"
    by (intro emeasure_eq_AE) auto
 
 lemma emeasure_eq_0_AE: "AE x in M. \<not> P x \<Longrightarrow> emeasure M {x\<in>space M. P x} = 0"
   using AE_iff_measurable[OF _ refl, of M "\<lambda>x. \<not> P x"]
   by (cases "{x\<in>space M. P x} \<in> sets M") (simp_all add: emeasure_notin_sets)
 
 lemma emeasure_0_AE:
   assumes "emeasure M (space M) = 0"
   shows "AE x in M. P x"
 using eventually_ae_filter assms by blast
 
 lemma emeasure_add_AE:
   assumes [measurable]: "A \<in> sets M" "B \<in> sets M" "C \<in> sets M"
   assumes 1: "AE x in M. x \<in> C \<longleftrightarrow> x \<in> A \<or> x \<in> B"
   assumes 2: "AE x in M. \<not> (x \<in> A \<and> x \<in> B)"
   shows "emeasure M C = emeasure M A + emeasure M B"
 proof -
   have "emeasure M C = emeasure M (A \<union> B)"
     by (rule emeasure_eq_AE) (insert 1, auto)
   also have "\<dots> = emeasure M A + emeasure M (B - A)"
     by (subst plus_emeasure) auto
   also have "emeasure M (B - A) = emeasure M B"
     by (rule emeasure_eq_AE) (insert 2, auto)
   finally show ?thesis .
 qed
 
 subsection \<open>\<open>\<sigma>\<close>-finite Measures\<close>
 
 locale\<^marker>\<open>tag important\<close> sigma_finite_measure =
   fixes M :: "'a measure"
   assumes sigma_finite_countable:
     "\<exists>A::'a set set. countable A \<and> A \<subseteq> sets M \<and> (\<Union>A) = space M \<and> (\<forall>a\<in>A. emeasure M a \<noteq> \<infinity>)"
 
 lemma (in sigma_finite_measure) sigma_finite:
   obtains A :: "nat \<Rightarrow> 'a set"
   where "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
 proof -
   obtain A :: "'a set set" where
     [simp]: "countable A" and
     A: "A \<subseteq> sets M" "(\<Union>A) = space M" "\<And>a. a \<in> A \<Longrightarrow> emeasure M a \<noteq> \<infinity>"
     using sigma_finite_countable by metis
   show thesis
   proof cases
     assume "A = {}" with \<open>(\<Union>A) = space M\<close> show thesis
       by (intro that[of "\<lambda>_. {}"]) auto
   next
     assume "A \<noteq> {}"
     show thesis
     proof
       show "range (from_nat_into A) \<subseteq> sets M"
         using \<open>A \<noteq> {}\<close> A by auto
       have "(\<Union>i. from_nat_into A i) = \<Union>A"
         using range_from_nat_into[OF \<open>A \<noteq> {}\<close> \<open>countable A\<close>] by auto
       with A show "(\<Union>i. from_nat_into A i) = space M"
         by auto
     qed (intro A from_nat_into \<open>A \<noteq> {}\<close>)
   qed
 qed
 
 lemma (in sigma_finite_measure) sigma_finite_disjoint:
   obtains A :: "nat \<Rightarrow> 'a set"
   where "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>" "disjoint_family A"
 proof -
   obtain A :: "nat \<Rightarrow> 'a set" where
     range: "range A \<subseteq> sets M" and
     space: "(\<Union>i. A i) = space M" and
     measure: "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
     using sigma_finite by blast
   show thesis
   proof (rule that[of "disjointed A"])
     show "range (disjointed A) \<subseteq> sets M"
       by (rule sets.range_disjointed_sets[OF range])
     show "(\<Union>i. disjointed A i) = space M"
       and "disjoint_family (disjointed A)"
       using disjoint_family_disjointed UN_disjointed_eq[of A] space range
       by auto
     show "emeasure M (disjointed A i) \<noteq> \<infinity>" for i
     proof -
       have "emeasure M (disjointed A i) \<le> emeasure M (A i)"
         using range disjointed_subset[of A i] by (auto intro!: emeasure_mono)
       then show ?thesis using measure[of i] by (auto simp: top_unique)
     qed
   qed
 qed
 
 lemma (in sigma_finite_measure) sigma_finite_incseq:
   obtains A :: "nat \<Rightarrow> 'a set"
   where "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>" "incseq A"
 proof -
   obtain F :: "nat \<Rightarrow> 'a set" where
     F: "range F \<subseteq> sets M" "(\<Union>i. F i) = space M" "\<And>i. emeasure M (F i) \<noteq> \<infinity>"
     using sigma_finite by blast
   show thesis
   proof (rule that[of "\<lambda>n. \<Union>i\<le>n. F i"])
     show "range (\<lambda>n. \<Union>i\<le>n. F i) \<subseteq> sets M"
       using F by (force simp: incseq_def)
     show "(\<Union>n. \<Union>i\<le>n. F i) = space M"
     proof -
       from F have "\<And>x. x \<in> space M \<Longrightarrow> \<exists>i. x \<in> F i" by auto
       with F show ?thesis by fastforce
     qed
     show "emeasure M (\<Union>i\<le>n. F i) \<noteq> \<infinity>" for n
     proof -
       have "emeasure M (\<Union>i\<le>n. F i) \<le> (\<Sum>i\<le>n. emeasure M (F i))"
         using F by (auto intro!: emeasure_subadditive_finite)
       also have "\<dots> < \<infinity>"
         using F by (auto simp: sum_Pinfty less_top)
       finally show ?thesis by simp
     qed
     show "incseq (\<lambda>n. \<Union>i\<le>n. F i)"
       by (force simp: incseq_def)
   qed
 qed
 
 lemma (in sigma_finite_measure) approx_PInf_emeasure_with_finite:
   fixes C::real
   assumes W_meas: "W \<in> sets M"
       and W_inf: "emeasure M W = \<infinity>"
   obtains Z where "Z \<in> sets M" "Z \<subseteq> W" "emeasure M Z < \<infinity>" "emeasure M Z > C"
 proof -
   obtain A :: "nat \<Rightarrow> 'a set"
     where A: "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>" "incseq A"
     using sigma_finite_incseq by blast
   define B where "B = (\<lambda>i. W \<inter> A i)"
   have B_meas: "\<And>i. B i \<in> sets M" using W_meas \<open>range A \<subseteq> sets M\<close> B_def by blast
   have b: "\<And>i. B i \<subseteq> W" using B_def by blast
 
   { fix i
     have "emeasure M (B i) \<le> emeasure M (A i)"
       using A by (intro emeasure_mono) (auto simp: B_def)
     also have "emeasure M (A i) < \<infinity>"
       using \<open>\<And>i. emeasure M (A i) \<noteq> \<infinity>\<close> by (simp add: less_top)
     finally have "emeasure M (B i) < \<infinity>" . }
   note c = this
 
   have "W = (\<Union>i. B i)" using B_def \<open>(\<Union>i. A i) = space M\<close> W_meas by auto
   moreover have "incseq B" using B_def \<open>incseq A\<close> by (simp add: incseq_def subset_eq)
   ultimately have "(\<lambda>i. emeasure M (B i)) \<longlonglongrightarrow> emeasure M W" using W_meas B_meas
     by (simp add: B_meas Lim_emeasure_incseq image_subset_iff)
   then have "(\<lambda>i. emeasure M (B i)) \<longlonglongrightarrow> \<infinity>" using W_inf by simp
   from order_tendstoD(1)[OF this, of C]
   obtain i where d: "emeasure M (B i) > C"
     by (auto simp: eventually_sequentially)
   have "B i \<in> sets M" "B i \<subseteq> W" "emeasure M (B i) < \<infinity>" "emeasure M (B i) > C"
     using B_meas b c d by auto
   then show ?thesis using that by blast
 qed
 
 subsection \<open>Measure space induced by distribution of \<^const>\<open>measurable\<close>-functions\<close>
 
 definition\<^marker>\<open>tag important\<close> distr :: "'a measure \<Rightarrow> 'b measure \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b measure" where
 "distr M N f =
   measure_of (space N) (sets N) (\<lambda>A. emeasure M (f -` A \<inter> space M))"
 
 lemma
   shows sets_distr[simp, measurable_cong]: "sets (distr M N f) = sets N"
     and space_distr[simp]: "space (distr M N f) = space N"
   by (auto simp: distr_def)
 
 lemma
   shows measurable_distr_eq1[simp]: "measurable (distr Mf Nf f) Mf' = measurable Nf Mf'"
     and measurable_distr_eq2[simp]: "measurable Mg' (distr Mg Ng g) = measurable Mg' Ng"
   by (auto simp: measurable_def)
 
 lemma distr_cong:
   "M = K \<Longrightarrow> sets N = sets L \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> f x = g x) \<Longrightarrow> distr M N f = distr K L g"
   using sets_eq_imp_space_eq[of N L] by (simp add: distr_def Int_def cong: rev_conj_cong)
 
 lemma emeasure_distr:
   fixes f :: "'a \<Rightarrow> 'b"
   assumes f: "f \<in> measurable M N" and A: "A \<in> sets N"
   shows "emeasure (distr M N f) A = emeasure M (f -` A \<inter> space M)" (is "_ = ?\<mu> A")
   unfolding distr_def
 proof (rule emeasure_measure_of_sigma)
   show "positive (sets N) ?\<mu>"
     by (auto simp: positive_def)
 
   show "countably_additive (sets N) ?\<mu>"
   proof (intro countably_additiveI)
     fix A :: "nat \<Rightarrow> 'b set" assume "range A \<subseteq> sets N" "disjoint_family A"
     then have A: "\<And>i. A i \<in> sets N" "(\<Union>i. A i) \<in> sets N" by auto
     then have *: "range (\<lambda>i. f -` (A i) \<inter> space M) \<subseteq> sets M"
       using f by (auto simp: measurable_def)
     moreover have "(\<Union>i. f -`  A i \<inter> space M) \<in> sets M"
       using * by blast
     moreover have **: "disjoint_family (\<lambda>i. f -` A i \<inter> space M)"
       using \<open>disjoint_family A\<close> by (auto simp: disjoint_family_on_def)
     ultimately show "(\<Sum>i. ?\<mu> (A i)) = ?\<mu> (\<Union>i. A i)"
       using suminf_emeasure[OF _ **] A f
       by (auto simp: comp_def vimage_UN)
   qed
   show "sigma_algebra (space N) (sets N)" ..
 qed fact
 
 lemma emeasure_Collect_distr:
   assumes X[measurable]: "X \<in> measurable M N" "Measurable.pred N P"
   shows "emeasure (distr M N X) {x\<in>space N. P x} = emeasure M {x\<in>space M. P (X x)}"
   by (subst emeasure_distr)
      (auto intro!: arg_cong2[where f=emeasure] X(1)[THEN measurable_space])
 
 lemma emeasure_lfp2[consumes 1, case_names cont f measurable]:
   assumes "P M"
   assumes cont: "sup_continuous F"
   assumes f: "\<And>M. P M \<Longrightarrow> f \<in> measurable M' M"
   assumes *: "\<And>M A. P M \<Longrightarrow> (\<And>N. P N \<Longrightarrow> Measurable.pred N A) \<Longrightarrow> Measurable.pred M (F A)"
   shows "emeasure M' {x\<in>space M'. lfp F (f x)} = (SUP i. emeasure M' {x\<in>space M'. (F ^^ i) (\<lambda>x. False) (f x)})"
 proof (subst (1 2) emeasure_Collect_distr[symmetric, where X=f])
   show "f \<in> measurable M' M"  "f \<in> measurable M' M"
     using f[OF \<open>P M\<close>] by auto
   { fix i show "Measurable.pred M ((F ^^ i) (\<lambda>x. False))"
     using \<open>P M\<close> by (induction i arbitrary: M) (auto intro!: *) }
   show "Measurable.pred M (lfp F)"
     using \<open>P M\<close> cont * by (rule measurable_lfp_coinduct[of P])
 
   have "emeasure (distr M' M f) {x \<in> space (distr M' M f). lfp F x} =
     (SUP i. emeasure (distr M' M f) {x \<in> space (distr M' M f). (F ^^ i) (\<lambda>x. False) x})"
     using \<open>P M\<close>
   proof (coinduction arbitrary: M rule: emeasure_lfp')
     case (measurable A N) then have "\<And>N. P N \<Longrightarrow> Measurable.pred (distr M' N f) A"
       by metis
     then have "\<And>N. P N \<Longrightarrow> Measurable.pred N A"
       by simp
     with \<open>P N\<close>[THEN *] show ?case
       by auto
   qed fact
   then show "emeasure (distr M' M f) {x \<in> space M. lfp F x} =
     (SUP i. emeasure (distr M' M f) {x \<in> space M. (F ^^ i) (\<lambda>x. False) x})"
    by simp
 qed
 
 lemma distr_id[simp]: "distr N N (\<lambda>x. x) = N"
   by (rule measure_eqI) (auto simp: emeasure_distr)
 
 lemma distr_id2: "sets M = sets N \<Longrightarrow> distr N M (\<lambda>x. x) = N"
   by (rule measure_eqI) (auto simp: emeasure_distr)
 
 lemma measure_distr:
   "f \<in> measurable M N \<Longrightarrow> S \<in> sets N \<Longrightarrow> measure (distr M N f) S = measure M (f -` S \<inter> space M)"
   by (simp add: emeasure_distr measure_def)
 
 lemma distr_cong_AE:
   assumes 1: "M = K" "sets N = sets L" and
     2: "(AE x in M. f x = g x)" and "f \<in> measurable M N" and "g \<in> measurable K L"
   shows "distr M N f = distr K L g"
 proof (rule measure_eqI)
   fix A assume "A \<in> sets (distr M N f)"
   with assms show "emeasure (distr M N f) A = emeasure (distr K L g) A"
     by (auto simp add: emeasure_distr intro!: emeasure_eq_AE measurable_sets)
 qed (insert 1, simp)
 
 lemma AE_distrD:
   assumes f: "f \<in> measurable M M'"
     and AE: "AE x in distr M M' f. P x"
   shows "AE x in M. P (f x)"
 proof -
-  from AE[THEN AE_E] guess N .
+  from AE[THEN AE_E] obtain N
+    where "{x \<in> space (distr M M' f). \<not> P x} \<subseteq> N"
+      "emeasure (distr M M' f) N = 0"
+      "N \<in> sets (distr M M' f)"
+    by auto
   with f show ?thesis
-    unfolding eventually_ae_filter
-    by (intro bexI[of _ "f -` N \<inter> space M"])
+    by (simp add: eventually_ae_filter, intro bexI[of _ "f -` N \<inter> space M"])
        (auto simp: emeasure_distr measurable_def)
 qed
 
 lemma AE_distr_iff:
   assumes f[measurable]: "f \<in> measurable M N" and P[measurable]: "{x \<in> space N. P x} \<in> sets N"
   shows "(AE x in distr M N f. P x) \<longleftrightarrow> (AE x in M. P (f x))"
 proof (subst (1 2) AE_iff_measurable[OF _ refl])
   have "f -` {x\<in>space N. \<not> P x} \<inter> space M = {x \<in> space M. \<not> P (f x)}"
     using f[THEN measurable_space] by auto
   then show "(emeasure (distr M N f) {x \<in> space (distr M N f). \<not> P x} = 0) =
     (emeasure M {x \<in> space M. \<not> P (f x)} = 0)"
     by (simp add: emeasure_distr)
 qed auto
 
 lemma null_sets_distr_iff:
   "f \<in> measurable M N \<Longrightarrow> A \<in> null_sets (distr M N f) \<longleftrightarrow> f -` A \<inter> space M \<in> null_sets M \<and> A \<in> sets N"
   by (auto simp add: null_sets_def emeasure_distr)
 
 proposition distr_distr:
   "g \<in> measurable N L \<Longrightarrow> f \<in> measurable M N \<Longrightarrow> distr (distr M N f) L g = distr M L (g \<circ> f)"
   by (auto simp add: emeasure_distr measurable_space
            intro!: arg_cong[where f="emeasure M"] measure_eqI)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Real measure values\<close>
 
 lemma ring_of_finite_sets: "ring_of_sets (space M) {A\<in>sets M. emeasure M A \<noteq> top}"
 proof (rule ring_of_setsI)
   show "a \<in> {A \<in> sets M. emeasure M A \<noteq> top} \<Longrightarrow> b \<in> {A \<in> sets M. emeasure M A \<noteq> top} \<Longrightarrow>
     a \<union> b \<in> {A \<in> sets M. emeasure M A \<noteq> top}" for a b
     using emeasure_subadditive[of a M b] by (auto simp: top_unique)
 
   show "a \<in> {A \<in> sets M. emeasure M A \<noteq> top} \<Longrightarrow> b \<in> {A \<in> sets M. emeasure M A \<noteq> top} \<Longrightarrow>
     a - b \<in> {A \<in> sets M. emeasure M A \<noteq> top}" for a b
     using emeasure_mono[of "a - b" a M] by (auto simp: top_unique)
 qed (auto dest: sets.sets_into_space)
 
 lemma measure_nonneg[simp]: "0 \<le> measure M A"
   unfolding measure_def by auto
 
 lemma measure_nonneg' [simp]: "\<not> measure M A < 0"
   using measure_nonneg not_le by blast
 
 lemma zero_less_measure_iff: "0 < measure M A \<longleftrightarrow> measure M A \<noteq> 0"
   using measure_nonneg[of M A] by (auto simp add: le_less)
 
 lemma measure_le_0_iff: "measure M X \<le> 0 \<longleftrightarrow> measure M X = 0"
   using measure_nonneg[of M X] by linarith
 
 lemma measure_empty[simp]: "measure M {} = 0"
   unfolding measure_def by (simp add: zero_ennreal.rep_eq)
 
 lemma emeasure_eq_ennreal_measure:
   "emeasure M A \<noteq> top \<Longrightarrow> emeasure M A = ennreal (measure M A)"
   by (cases "emeasure M A" rule: ennreal_cases) (auto simp: measure_def)
 
 lemma measure_zero_top: "emeasure M A = top \<Longrightarrow> measure M A = 0"
   by (simp add: measure_def)
 
 lemma measure_eq_emeasure_eq_ennreal: "0 \<le> x \<Longrightarrow> emeasure M A = ennreal x \<Longrightarrow> measure M A = x"
   using emeasure_eq_ennreal_measure[of M A]
   by (cases "A \<in> M") (auto simp: measure_notin_sets emeasure_notin_sets)
 
 lemma enn2real_plus:"a < top \<Longrightarrow> b < top \<Longrightarrow> enn2real (a + b) = enn2real a + enn2real b"
   by (simp add: enn2real_def plus_ennreal.rep_eq real_of_ereal_add less_top
            del: real_of_ereal_enn2ereal)
 
 lemma enn2real_sum:"(\<And>i. i \<in> I \<Longrightarrow> f i < top) \<Longrightarrow> enn2real (sum f I) = sum (enn2real \<circ> f) I"
   by (induction I rule: infinite_finite_induct) (auto simp: enn2real_plus)
 
 lemma measure_eq_AE:
   assumes iff: "AE x in M. x \<in> A \<longleftrightarrow> x \<in> B"
   assumes A: "A \<in> sets M" and B: "B \<in> sets M"
   shows "measure M A = measure M B"
   using assms emeasure_eq_AE[OF assms] by (simp add: measure_def)
 
 lemma measure_Union:
   "emeasure M A \<noteq> \<infinity> \<Longrightarrow> emeasure M B \<noteq> \<infinity> \<Longrightarrow> A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> A \<inter> B = {} \<Longrightarrow>
     measure M (A \<union> B) = measure M A + measure M B"
   by (simp add: measure_def plus_emeasure[symmetric] enn2real_plus less_top)
 
 lemma disjoint_family_on_insert:
   "i \<notin> I \<Longrightarrow> disjoint_family_on A (insert i I) \<longleftrightarrow> A i \<inter> (\<Union>i\<in>I. A i) = {} \<and> disjoint_family_on A I"
   by (fastforce simp: disjoint_family_on_def)
 
 lemma measure_finite_Union:
   "finite S \<Longrightarrow> A`S \<subseteq> sets M \<Longrightarrow> disjoint_family_on A S \<Longrightarrow> (\<And>i. i \<in> S \<Longrightarrow> emeasure M (A i) \<noteq> \<infinity>) \<Longrightarrow>
     measure M (\<Union>i\<in>S. A i) = (\<Sum>i\<in>S. measure M (A i))"
   by (induction S rule: finite_induct)
      (auto simp: disjoint_family_on_insert measure_Union sum_emeasure[symmetric] sets.countable_UN'[OF countable_finite])
 
 lemma measure_Diff:
   assumes finite: "emeasure M A \<noteq> \<infinity>"
   and measurable: "A \<in> sets M" "B \<in> sets M" "B \<subseteq> A"
   shows "measure M (A - B) = measure M A - measure M B"
 proof -
   have "emeasure M (A - B) \<le> emeasure M A" "emeasure M B \<le> emeasure M A"
     using measurable by (auto intro!: emeasure_mono)
   hence "measure M ((A - B) \<union> B) = measure M (A - B) + measure M B"
     using measurable finite by (rule_tac measure_Union) (auto simp: top_unique)
   thus ?thesis using \<open>B \<subseteq> A\<close> by (auto simp: Un_absorb2)
 qed
 
 lemma measure_UNION:
   assumes measurable: "range A \<subseteq> sets M" "disjoint_family A"
   assumes finite: "emeasure M (\<Union>i. A i) \<noteq> \<infinity>"
   shows "(\<lambda>i. measure M (A i)) sums (measure M (\<Union>i. A i))"
 proof -
   have "(\<lambda>i. emeasure M (A i)) sums (emeasure M (\<Union>i. A i))"
     unfolding suminf_emeasure[OF measurable, symmetric] by (simp add: summable_sums)
   moreover
   { fix i
     have "emeasure M (A i) \<le> emeasure M (\<Union>i. A i)"
       using measurable by (auto intro!: emeasure_mono)
     then have "emeasure M (A i) = ennreal ((measure M (A i)))"
       using finite by (intro emeasure_eq_ennreal_measure) (auto simp: top_unique) }
   ultimately show ?thesis using finite
     by (subst (asm) (2) emeasure_eq_ennreal_measure) simp_all
 qed
 
 lemma measure_subadditive:
   assumes measurable: "A \<in> sets M" "B \<in> sets M"
   and fin: "emeasure M A \<noteq> \<infinity>" "emeasure M B \<noteq> \<infinity>"
   shows "measure M (A \<union> B) \<le> measure M A + measure M B"
 proof -
   have "emeasure M (A \<union> B) \<noteq> \<infinity>"
     using emeasure_subadditive[OF measurable] fin by (auto simp: top_unique)
   then show "(measure M (A \<union> B)) \<le> (measure M A) + (measure M B)"
     using emeasure_subadditive[OF measurable] fin
     apply simp
     apply (subst (asm) (2 3 4) emeasure_eq_ennreal_measure)
     apply (auto simp flip: ennreal_plus)
     done
 qed
 
 lemma measure_subadditive_finite:
   assumes A: "finite I" "A`I \<subseteq> sets M" and fin: "\<And>i. i \<in> I \<Longrightarrow> emeasure M (A i) \<noteq> \<infinity>"
   shows "measure M (\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. measure M (A i))"
 proof -
   { have "emeasure M (\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. emeasure M (A i))"
       using emeasure_subadditive_finite[OF A] .
     also have "\<dots> < \<infinity>"
       using fin by (simp add: less_top A)
     finally have "emeasure M (\<Union>i\<in>I. A i) \<noteq> top" by simp }
   note * = this
   show ?thesis
     using emeasure_subadditive_finite[OF A] fin
     unfolding emeasure_eq_ennreal_measure[OF *]
     by (simp_all add: sum_nonneg emeasure_eq_ennreal_measure)
 qed
 
 lemma measure_subadditive_countably:
   assumes A: "range A \<subseteq> sets M" and fin: "(\<Sum>i. emeasure M (A i)) \<noteq> \<infinity>"
   shows "measure M (\<Union>i. A i) \<le> (\<Sum>i. measure M (A i))"
 proof -
   from fin have **: "\<And>i. emeasure M (A i) \<noteq> top"
     using ennreal_suminf_lessD[of "\<lambda>i. emeasure M (A i)"] by (simp add: less_top)
   { have "emeasure M (\<Union>i. A i) \<le> (\<Sum>i. emeasure M (A i))"
       using emeasure_subadditive_countably[OF A] .
     also have "\<dots> < \<infinity>"
       using fin by (simp add: less_top)
     finally have "emeasure M (\<Union>i. A i) \<noteq> top" by simp }
   then have "ennreal (measure M (\<Union>i. A i)) = emeasure M (\<Union>i. A i)"
     by (rule emeasure_eq_ennreal_measure[symmetric])
   also have "\<dots> \<le> (\<Sum>i. emeasure M (A i))"
     using emeasure_subadditive_countably[OF A] .
   also have "\<dots> = ennreal (\<Sum>i. measure M (A i))"
     using fin unfolding emeasure_eq_ennreal_measure[OF **]
     by (subst suminf_ennreal) (auto simp: **)
   finally show ?thesis
     apply (rule ennreal_le_iff[THEN iffD1, rotated])
     apply (intro suminf_nonneg allI measure_nonneg summable_suminf_not_top)
     using fin
     apply (simp add: emeasure_eq_ennreal_measure[OF **])
     done
 qed
 
 lemma measure_Un_null_set: "A \<in> sets M \<Longrightarrow> B \<in> null_sets M \<Longrightarrow> measure M (A \<union> B) = measure M A"
   by (simp add: measure_def emeasure_Un_null_set)
 
 lemma measure_Diff_null_set: "A \<in> sets M \<Longrightarrow> B \<in> null_sets M \<Longrightarrow> measure M (A - B) = measure M A"
   by (simp add: measure_def emeasure_Diff_null_set)
 
 lemma measure_eq_sum_singleton:
   "finite S \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> {x} \<in> sets M) \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> emeasure M {x} \<noteq> \<infinity>) \<Longrightarrow>
     measure M S = (\<Sum>x\<in>S. measure M {x})"
   using emeasure_eq_sum_singleton[of S M]
   by (intro measure_eq_emeasure_eq_ennreal) (auto simp: sum_nonneg emeasure_eq_ennreal_measure)
 
 lemma Lim_measure_incseq:
   assumes A: "range A \<subseteq> sets M" "incseq A" and fin: "emeasure M (\<Union>i. A i) \<noteq> \<infinity>"
   shows "(\<lambda>i. measure M (A i)) \<longlonglongrightarrow> measure M (\<Union>i. A i)"
 proof (rule tendsto_ennrealD)
   have "ennreal (measure M (\<Union>i. A i)) = emeasure M (\<Union>i. A i)"
     using fin by (auto simp: emeasure_eq_ennreal_measure)
   moreover have "ennreal (measure M (A i)) = emeasure M (A i)" for i
     using assms emeasure_mono[of "A _" "\<Union>i. A i" M]
     by (intro emeasure_eq_ennreal_measure[symmetric]) (auto simp: less_top UN_upper intro: le_less_trans)
   ultimately show "(\<lambda>x. ennreal (measure M (A x))) \<longlonglongrightarrow> ennreal (measure M (\<Union>i. A i))"
     using A by (auto intro!: Lim_emeasure_incseq)
 qed auto
 
 lemma Lim_measure_decseq:
   assumes A: "range A \<subseteq> sets M" "decseq A" and fin: "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
   shows "(\<lambda>n. measure M (A n)) \<longlonglongrightarrow> measure M (\<Inter>i. A i)"
 proof (rule tendsto_ennrealD)
   have "ennreal (measure M (\<Inter>i. A i)) = emeasure M (\<Inter>i. A i)"
     using fin[of 0] A emeasure_mono[of "\<Inter>i. A i" "A 0" M]
     by (auto intro!: emeasure_eq_ennreal_measure[symmetric] simp: INT_lower less_top intro: le_less_trans)
   moreover have "ennreal (measure M (A i)) = emeasure M (A i)" for i
     using A fin[of i] by (intro emeasure_eq_ennreal_measure[symmetric]) auto
   ultimately show "(\<lambda>x. ennreal (measure M (A x))) \<longlonglongrightarrow> ennreal (measure M (\<Inter>i. A i))"
     using fin A by (auto intro!: Lim_emeasure_decseq)
 qed auto
 
 subsection \<open>Set of measurable sets with finite measure\<close>
 
 definition\<^marker>\<open>tag important\<close> fmeasurable :: "'a measure \<Rightarrow> 'a set set" where
 "fmeasurable M = {A\<in>sets M. emeasure M A < \<infinity>}"
 
 lemma fmeasurableD[dest, measurable_dest]: "A \<in> fmeasurable M \<Longrightarrow> A \<in> sets M"
   by (auto simp: fmeasurable_def)
 
 lemma fmeasurableD2: "A \<in> fmeasurable M \<Longrightarrow> emeasure M A \<noteq> top"
   by (auto simp: fmeasurable_def)
 
 lemma fmeasurableI: "A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow> A \<in> fmeasurable M"
   by (auto simp: fmeasurable_def)
 
 lemma fmeasurableI_null_sets: "A \<in> null_sets M \<Longrightarrow> A \<in> fmeasurable M"
   by (auto simp: fmeasurable_def)
 
 lemma fmeasurableI2: "A \<in> fmeasurable M \<Longrightarrow> B \<subseteq> A \<Longrightarrow> B \<in> sets M \<Longrightarrow> B \<in> fmeasurable M"
   using emeasure_mono[of B A M] by (auto simp: fmeasurable_def)
 
 lemma measure_mono_fmeasurable:
   "A \<subseteq> B \<Longrightarrow> A \<in> sets M \<Longrightarrow> B \<in> fmeasurable M \<Longrightarrow> measure M A \<le> measure M B"
   by (auto simp: measure_def fmeasurable_def intro!: emeasure_mono enn2real_mono)
 
 lemma emeasure_eq_measure2: "A \<in> fmeasurable M \<Longrightarrow> emeasure M A = measure M A"
   by (simp add: emeasure_eq_ennreal_measure fmeasurable_def less_top)
 
 interpretation fmeasurable: ring_of_sets "space M" "fmeasurable M"
 proof (rule ring_of_setsI)
   show "fmeasurable M \<subseteq> Pow (space M)" "{} \<in> fmeasurable M"
     by (auto simp: fmeasurable_def dest: sets.sets_into_space)
   fix a b assume *: "a \<in> fmeasurable M" "b \<in> fmeasurable M"
   then have "emeasure M (a \<union> b) \<le> emeasure M a + emeasure M b"
     by (intro emeasure_subadditive) auto
   also have "\<dots> < top"
     using * by (auto simp: fmeasurable_def)
   finally show  "a \<union> b \<in> fmeasurable M"
     using * by (auto intro: fmeasurableI)
   show "a - b \<in> fmeasurable M"
     using emeasure_mono[of "a - b" a M] * by (auto simp: fmeasurable_def)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Measurable sets formed by unions and intersections\<close>
 
 lemma fmeasurable_Diff: "A \<in> fmeasurable M \<Longrightarrow> B \<in> sets M \<Longrightarrow> A - B \<in> fmeasurable M"
   using fmeasurableI2[of A M "A - B"] by auto
 
 lemma fmeasurable_Int_fmeasurable:
    "\<lbrakk>S \<in> fmeasurable M; T \<in> sets M\<rbrakk> \<Longrightarrow> (S \<inter> T) \<in> fmeasurable M"
   by (meson fmeasurableD fmeasurableI2 inf_le1 sets.Int)
 
 lemma fmeasurable_UN:
   assumes "countable I" "\<And>i. i \<in> I \<Longrightarrow> F i \<subseteq> A" "\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M" "A \<in> fmeasurable M"
   shows "(\<Union>i\<in>I. F i) \<in> fmeasurable M"
 proof (rule fmeasurableI2)
   show "A \<in> fmeasurable M" "(\<Union>i\<in>I. F i) \<subseteq> A" using assms by auto
   show "(\<Union>i\<in>I. F i) \<in> sets M"
     using assms by (intro sets.countable_UN') auto
 qed
 
 lemma fmeasurable_INT:
   assumes "countable I" "i \<in> I" "\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M" "F i \<in> fmeasurable M"
   shows "(\<Inter>i\<in>I. F i) \<in> fmeasurable M"
 proof (rule fmeasurableI2)
   show "F i \<in> fmeasurable M" "(\<Inter>i\<in>I. F i) \<subseteq> F i"
     using assms by auto
   show "(\<Inter>i\<in>I. F i) \<in> sets M"
     using assms by (intro sets.countable_INT') auto
 qed
 
 lemma measurable_measure_Diff:
   assumes "A \<in> fmeasurable M" "B \<in> sets M" "B \<subseteq> A"
   shows "measure M (A - B) = measure M A - measure M B"
   by (simp add: assms fmeasurableD fmeasurableD2 measure_Diff)
 
 lemma measurable_Un_null_set:
   assumes "B \<in> null_sets M"
   shows "(A \<union> B \<in> fmeasurable M \<and> A \<in> sets M) \<longleftrightarrow> A \<in> fmeasurable M"
   using assms  by (fastforce simp add: fmeasurable.Un fmeasurableI_null_sets intro: fmeasurableI2)
 
 lemma measurable_Diff_null_set:
   assumes "B \<in> null_sets M"
   shows "(A - B) \<in> fmeasurable M \<and> A \<in> sets M \<longleftrightarrow> A \<in> fmeasurable M"
   using assms
   by (metis Un_Diff_cancel2 fmeasurable.Diff fmeasurableD fmeasurableI_null_sets measurable_Un_null_set)
 
 lemma fmeasurable_Diff_D:
     assumes m: "T - S \<in> fmeasurable M" "S \<in> fmeasurable M" and sub: "S \<subseteq> T"
     shows "T \<in> fmeasurable M"
 proof -
   have "T = S \<union> (T - S)"
     using assms by blast
   then show ?thesis
     by (metis m fmeasurable.Un)
 qed
 
 lemma measure_Un2:
   "A \<in> fmeasurable M \<Longrightarrow> B \<in> fmeasurable M \<Longrightarrow> measure M (A \<union> B) = measure M A + measure M (B - A)"
   using measure_Union[of M A "B - A"] by (auto simp: fmeasurableD2 fmeasurable.Diff)
 
 lemma measure_Un3:
   assumes "A \<in> fmeasurable M" "B \<in> fmeasurable M"
   shows "measure M (A \<union> B) = measure M A + measure M B - measure M (A \<inter> B)"
 proof -
   have "measure M (A \<union> B) = measure M A + measure M (B - A)"
     using assms by (rule measure_Un2)
   also have "B - A = B - (A \<inter> B)"
     by auto
   also have "measure M (B - (A \<inter> B)) = measure M B - measure M (A \<inter> B)"
     using assms by (intro measure_Diff) (auto simp: fmeasurable_def)
   finally show ?thesis
     by simp
 qed
 
 lemma measure_Un_AE:
   "AE x in M. x \<notin> A \<or> x \<notin> B \<Longrightarrow> A \<in> fmeasurable M \<Longrightarrow> B \<in> fmeasurable M \<Longrightarrow>
   measure M (A \<union> B) = measure M A + measure M B"
   by (subst measure_Un2) (auto intro!: measure_eq_AE)
 
 lemma measure_UNION_AE:
   assumes I: "finite I"
   shows "(\<And>i. i \<in> I \<Longrightarrow> F i \<in> fmeasurable M) \<Longrightarrow> pairwise (\<lambda>i j. AE x in M. x \<notin> F i \<or> x \<notin> F j) I \<Longrightarrow>
     measure M (\<Union>i\<in>I. F i) = (\<Sum>i\<in>I. measure M (F i))"
   unfolding AE_pairwise[OF countable_finite, OF I]
   using I
 proof (induction I rule: finite_induct)
   case (insert x I)
   have "measure M (F x \<union> \<Union>(F ` I)) = measure M (F x) + measure M (\<Union>(F ` I))"
     by (rule measure_Un_AE) (use insert in \<open>auto simp: pairwise_insert\<close>)
     with insert show ?case
       by (simp add: pairwise_insert )
 qed simp
 
 lemma measure_UNION':
   "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> F i \<in> fmeasurable M) \<Longrightarrow> pairwise (\<lambda>i j. disjnt (F i) (F j)) I \<Longrightarrow>
     measure M (\<Union>i\<in>I. F i) = (\<Sum>i\<in>I. measure M (F i))"
   by (intro measure_UNION_AE) (auto simp: disjnt_def elim!: pairwise_mono intro!: always_eventually)
 
 lemma measure_Union_AE:
   "finite F \<Longrightarrow> (\<And>S. S \<in> F \<Longrightarrow> S \<in> fmeasurable M) \<Longrightarrow> pairwise (\<lambda>S T. AE x in M. x \<notin> S \<or> x \<notin> T) F \<Longrightarrow>
     measure M (\<Union>F) = (\<Sum>S\<in>F. measure M S)"
   using measure_UNION_AE[of F "\<lambda>x. x" M] by simp
 
 lemma measure_Union':
   "finite F \<Longrightarrow> (\<And>S. S \<in> F \<Longrightarrow> S \<in> fmeasurable M) \<Longrightarrow> pairwise disjnt F \<Longrightarrow> measure M (\<Union>F) = (\<Sum>S\<in>F. measure M S)"
   using measure_UNION'[of F "\<lambda>x. x" M] by simp
 
 lemma measure_Un_le:
   assumes "A \<in> sets M" "B \<in> sets M" shows "measure M (A \<union> B) \<le> measure M A + measure M B"
 proof cases
   assume "A \<in> fmeasurable M \<and> B \<in> fmeasurable M"
   with measure_subadditive[of A M B] assms show ?thesis
     by (auto simp: fmeasurableD2)
 next
   assume "\<not> (A \<in> fmeasurable M \<and> B \<in> fmeasurable M)"
   then have "A \<union> B \<notin> fmeasurable M"
     using fmeasurableI2[of "A \<union> B" M A] fmeasurableI2[of "A \<union> B" M B] assms by auto
   with assms show ?thesis
     by (auto simp: fmeasurable_def measure_def less_top[symmetric])
 qed
 
 lemma measure_UNION_le:
   "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M) \<Longrightarrow> measure M (\<Union>i\<in>I. F i) \<le> (\<Sum>i\<in>I. measure M (F i))"
 proof (induction I rule: finite_induct)
   case (insert i I)
   then have "measure M (\<Union>i\<in>insert i I. F i) = measure M (F i \<union> \<Union> (F ` I))"
     by simp
   also from insert have "measure M (F i \<union> \<Union> (F ` I)) \<le> measure M (F i) + measure M (\<Union> (F ` I))"
     by (intro measure_Un_le sets.finite_Union) auto
   also have "measure M (\<Union>i\<in>I. F i) \<le> (\<Sum>i\<in>I. measure M (F i))"
     using insert by auto
   finally show ?case
     using insert by simp
 qed simp
 
 lemma measure_Union_le:
   "finite F \<Longrightarrow> (\<And>S. S \<in> F \<Longrightarrow> S \<in> sets M) \<Longrightarrow> measure M (\<Union>F) \<le> (\<Sum>S\<in>F. measure M S)"
   using measure_UNION_le[of F "\<lambda>x. x" M] by simp
 
 text\<open>Version for indexed union over a countable set\<close>
 lemma
   assumes "countable I" and I: "\<And>i. i \<in> I \<Longrightarrow> A i \<in> fmeasurable M"
     and bound: "\<And>I'. I' \<subseteq> I \<Longrightarrow> finite I' \<Longrightarrow> measure M (\<Union>i\<in>I'. A i) \<le> B"
   shows fmeasurable_UN_bound: "(\<Union>i\<in>I. A i) \<in> fmeasurable M" (is ?fm)
     and measure_UN_bound: "measure M (\<Union>i\<in>I. A i) \<le> B" (is ?m)
 proof -
   have "B \<ge> 0"
     using bound by force
   have "?fm \<and> ?m"
   proof cases
     assume "I = {}"
     with \<open>B \<ge> 0\<close> show ?thesis
       by simp
   next
     assume "I \<noteq> {}"
     have "(\<Union>i\<in>I. A i) = (\<Union>i. (\<Union>n\<le>i. A (from_nat_into I n)))"
       by (subst range_from_nat_into[symmetric, OF \<open>I \<noteq> {}\<close> \<open>countable I\<close>]) auto
     then have "emeasure M (\<Union>i\<in>I. A i) = emeasure M (\<Union>i. (\<Union>n\<le>i. A (from_nat_into I n)))" by simp
     also have "\<dots> = (SUP i. emeasure M (\<Union>n\<le>i. A (from_nat_into I n)))"
       using I \<open>I \<noteq> {}\<close>[THEN from_nat_into] by (intro SUP_emeasure_incseq[symmetric]) (fastforce simp: incseq_Suc_iff)+
     also have "\<dots> \<le> B"
     proof (intro SUP_least)
       fix i :: nat
       have "emeasure M (\<Union>n\<le>i. A (from_nat_into I n)) = measure M (\<Union>n\<le>i. A (from_nat_into I n))"
         using I \<open>I \<noteq> {}\<close>[THEN from_nat_into] by (intro emeasure_eq_measure2 fmeasurable.finite_UN) auto
       also have "\<dots> = measure M (\<Union>n\<in>from_nat_into I ` {..i}. A n)"
         by simp
       also have "\<dots> \<le> B"
         by (intro ennreal_leI bound) (auto intro:  from_nat_into[OF \<open>I \<noteq> {}\<close>])
       finally show "emeasure M (\<Union>n\<le>i. A (from_nat_into I n)) \<le> ennreal B" .
     qed
     finally have *: "emeasure M (\<Union>i\<in>I. A i) \<le> B" .
     then have ?fm
       using I \<open>countable I\<close> by (intro fmeasurableI conjI) (auto simp: less_top[symmetric] top_unique)
     with * \<open>0\<le>B\<close> show ?thesis
       by (simp add: emeasure_eq_measure2)
   qed
   then show ?fm ?m by auto
 qed
 
 text\<open>Version for big union of a countable set\<close>
 lemma
   assumes "countable \<D>"
     and meas: "\<And>D. D \<in> \<D> \<Longrightarrow> D \<in> fmeasurable M"
     and bound:  "\<And>\<E>. \<lbrakk>\<E> \<subseteq> \<D>; finite \<E>\<rbrakk> \<Longrightarrow> measure M (\<Union>\<E>) \<le> B"
  shows fmeasurable_Union_bound: "\<Union>\<D> \<in> fmeasurable M"  (is ?fm)
     and measure_Union_bound: "measure M (\<Union>\<D>) \<le> B"     (is ?m)
 proof -
   have "B \<ge> 0"
     using bound by force
   have "?fm \<and> ?m"
   proof (cases "\<D> = {}")
     case True
     with \<open>B \<ge> 0\<close> show ?thesis
       by auto
   next
     case False
     then obtain D :: "nat \<Rightarrow> 'a set" where D: "\<D> = range D"
       using \<open>countable \<D>\<close> uncountable_def by force
       have 1: "\<And>i. D i \<in> fmeasurable M"
         by (simp add: D meas)
       have 2: "\<And>I'. finite I' \<Longrightarrow> measure M (\<Union>x\<in>I'. D x) \<le> B"
         by (simp add: D bound image_subset_iff)
       show ?thesis
         unfolding D
         by (intro conjI fmeasurable_UN_bound [OF _ 1 2] measure_UN_bound [OF _ 1 2]) auto
     qed
     then show ?fm ?m by auto
 qed
 
 text\<open>Version for indexed union over the type of naturals\<close>
 lemma
   fixes S :: "nat \<Rightarrow> 'a set"
   assumes S: "\<And>i. S i \<in> fmeasurable M" and B: "\<And>n. measure M (\<Union>i\<le>n. S i) \<le> B"
   shows fmeasurable_countable_Union: "(\<Union>i. S i) \<in> fmeasurable M"
     and measure_countable_Union_le: "measure M (\<Union>i. S i) \<le> B"
 proof -
   have mB: "measure M (\<Union>i\<in>I. S i) \<le> B" if "finite I" for I
   proof -
     have "(\<Union>i\<in>I. S i) \<subseteq> (\<Union>i\<le>Max I. S i)"
       using Max_ge that by force
     then have "measure M (\<Union>i\<in>I. S i) \<le> measure M (\<Union>i \<le> Max I. S i)"
       by (rule measure_mono_fmeasurable) (use S in \<open>blast+\<close>)
     then show ?thesis
       using B order_trans by blast
   qed
   show "(\<Union>i. S i) \<in> fmeasurable M"
     by (auto intro: fmeasurable_UN_bound [OF _ S mB])
   show "measure M (\<Union>n. S n) \<le> B"
     by (auto intro: measure_UN_bound [OF _ S mB])
 qed
 
 lemma measure_diff_le_measure_setdiff:
   assumes "S \<in> fmeasurable M" "T \<in> fmeasurable M"
   shows "measure M S - measure M T \<le> measure M (S - T)"
 proof -
   have "measure M S \<le> measure M ((S - T) \<union> T)"
     by (simp add: assms fmeasurable.Un fmeasurableD measure_mono_fmeasurable)
   also have "\<dots> \<le> measure M (S - T) + measure M T"
     using assms by (blast intro: measure_Un_le)
   finally show ?thesis
     by (simp add: algebra_simps)
 qed
 
 lemma suminf_exist_split2:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector"
   assumes "summable f"
   shows "(\<lambda>n. (\<Sum>k. f(k+n))) \<longlonglongrightarrow> 0"
 by (subst lim_sequentially, auto simp add: dist_norm suminf_exist_split[OF _ assms])
 
 lemma emeasure_union_summable:
   assumes [measurable]: "\<And>n. A n \<in> sets M"
     and "\<And>n. emeasure M (A n) < \<infinity>" "summable (\<lambda>n. measure M (A n))"
   shows "emeasure M (\<Union>n. A n) < \<infinity>" "emeasure M (\<Union>n. A n) \<le> (\<Sum>n. measure M (A n))"
 proof -
   define B where "B = (\<lambda>N. (\<Union>n\<in>{..<N}. A n))"
   have [measurable]: "B N \<in> sets M" for N unfolding B_def by auto
   have "(\<lambda>N. emeasure M (B N)) \<longlonglongrightarrow> emeasure M (\<Union>N. B N)"
     apply (rule Lim_emeasure_incseq) unfolding B_def by (auto simp add: SUP_subset_mono incseq_def)
   moreover have "emeasure M (B N) \<le> ennreal (\<Sum>n. measure M (A n))" for N
   proof -
     have *: "(\<Sum>n\<in>{..<N}. measure M (A n)) \<le> (\<Sum>n. measure M (A n))"
       using assms(3) measure_nonneg sum_le_suminf by blast
 
     have "emeasure M (B N) \<le> (\<Sum>n\<in>{..<N}. emeasure M (A n))"
       unfolding B_def by (rule emeasure_subadditive_finite, auto)
     also have "... = (\<Sum>n\<in>{..<N}. ennreal(measure M (A n)))"
       using assms(2) by (simp add: emeasure_eq_ennreal_measure less_top)
     also have "... = ennreal (\<Sum>n\<in>{..<N}. measure M (A n))"
       by auto
     also have "... \<le> ennreal (\<Sum>n. measure M (A n))"
       using * by (auto simp: ennreal_leI)
     finally show ?thesis by simp
   qed
   ultimately have "emeasure M (\<Union>N. B N) \<le> ennreal (\<Sum>n. measure M (A n))"
     by (simp add: Lim_bounded)
   then show "emeasure M (\<Union>n. A n) \<le> (\<Sum>n. measure M (A n))"
     unfolding B_def by (metis UN_UN_flatten UN_lessThan_UNIV)
   then show "emeasure M (\<Union>n. A n) < \<infinity>"
     by (auto simp: less_top[symmetric] top_unique)
 qed
 
 lemma borel_cantelli_limsup1:
   assumes [measurable]: "\<And>n. A n \<in> sets M"
     and "\<And>n. emeasure M (A n) < \<infinity>" "summable (\<lambda>n. measure M (A n))"
   shows "limsup A \<in> null_sets M"
 proof -
   have "emeasure M (limsup A) \<le> 0"
   proof (rule LIMSEQ_le_const)
     have "(\<lambda>n. (\<Sum>k. measure M (A (k+n)))) \<longlonglongrightarrow> 0" by (rule suminf_exist_split2[OF assms(3)])
     then show "(\<lambda>n. ennreal (\<Sum>k. measure M (A (k+n)))) \<longlonglongrightarrow> 0"
       unfolding ennreal_0[symmetric] by (intro tendsto_ennrealI)
     have "emeasure M (limsup A) \<le> (\<Sum>k. measure M (A (k+n)))" for n
     proof -
       have I: "(\<Union>k\<in>{n..}. A k) = (\<Union>k. A (k+n))" by (auto, metis le_add_diff_inverse2, fastforce)
       have "emeasure M (limsup A) \<le> emeasure M (\<Union>k\<in>{n..}. A k)"
         by (rule emeasure_mono, auto simp add: limsup_INF_SUP)
       also have "... = emeasure M (\<Union>k. A (k+n))"
         using I by auto
       also have "... \<le> (\<Sum>k. measure M (A (k+n)))"
         apply (rule emeasure_union_summable)
         using assms summable_ignore_initial_segment[OF assms(3), of n] by auto
       finally show ?thesis by simp
     qed
     then show "\<exists>N. \<forall>n\<ge>N. emeasure M (limsup A) \<le> (\<Sum>k. measure M (A (k+n)))"
       by auto
   qed
   then show ?thesis using assms(1) measurable_limsup by auto
 qed
 
 lemma borel_cantelli_AE1:
   assumes [measurable]: "\<And>n. A n \<in> sets M"
     and "\<And>n. emeasure M (A n) < \<infinity>" "summable (\<lambda>n. measure M (A n))"
   shows "AE x in M. eventually (\<lambda>n. x \<in> space M - A n) sequentially"
 proof -
   have "AE x in M. x \<notin> limsup A"
     using borel_cantelli_limsup1[OF assms] unfolding eventually_ae_filter by auto
   moreover
   {
     fix x assume "x \<notin> limsup A"
     then obtain N where "x \<notin> (\<Union>n\<in>{N..}. A n)" unfolding limsup_INF_SUP by blast
     then have "eventually (\<lambda>n. x \<notin> A n) sequentially" using eventually_sequentially by auto
   }
   ultimately show ?thesis by auto
 qed
 
 subsection \<open>Measure spaces with \<^term>\<open>emeasure M (space M) < \<infinity>\<close>\<close>
 
 locale\<^marker>\<open>tag important\<close> finite_measure = sigma_finite_measure M for M +
   assumes finite_emeasure_space: "emeasure M (space M) \<noteq> top"
 
 lemma finite_measureI[Pure.intro!]:
   "emeasure M (space M) \<noteq> \<infinity> \<Longrightarrow> finite_measure M"
   proof qed (auto intro!: exI[of _ "{space M}"])
 
 lemma (in finite_measure) emeasure_finite[simp, intro]: "emeasure M A \<noteq> top"
   using finite_emeasure_space emeasure_space[of M A] by (auto simp: top_unique)
 
 lemma (in finite_measure) fmeasurable_eq_sets: "fmeasurable M = sets M"
   by (auto simp: fmeasurable_def less_top[symmetric])
 
 lemma (in finite_measure) emeasure_eq_measure: "emeasure M A = ennreal (measure M A)"
   by (intro emeasure_eq_ennreal_measure) simp
 
 lemma (in finite_measure) emeasure_real: "\<exists>r. 0 \<le> r \<and> emeasure M A = ennreal r"
   using emeasure_finite[of A] by (cases "emeasure M A" rule: ennreal_cases) auto
 
 lemma (in finite_measure) bounded_measure: "measure M A \<le> measure M (space M)"
   using emeasure_space[of M A] emeasure_real[of A] emeasure_real[of "space M"] by (auto simp: measure_def)
 
 lemma (in finite_measure) finite_measure_Diff:
   assumes sets: "A \<in> sets M" "B \<in> sets M" and "B \<subseteq> A"
   shows "measure M (A - B) = measure M A - measure M B"
   using measure_Diff[OF _ assms] by simp
 
 lemma (in finite_measure) finite_measure_Union:
   assumes sets: "A \<in> sets M" "B \<in> sets M" and "A \<inter> B = {}"
   shows "measure M (A \<union> B) = measure M A + measure M B"
   using measure_Union[OF _ _ assms] by simp
 
 lemma (in finite_measure) finite_measure_finite_Union:
   assumes measurable: "finite S" "A`S \<subseteq> sets M" "disjoint_family_on A S"
   shows "measure M (\<Union>i\<in>S. A i) = (\<Sum>i\<in>S. measure M (A i))"
   using measure_finite_Union[OF assms] by simp
 
 lemma (in finite_measure) finite_measure_UNION:
   assumes A: "range A \<subseteq> sets M" "disjoint_family A"
   shows "(\<lambda>i. measure M (A i)) sums (measure M (\<Union>i. A i))"
   using measure_UNION[OF A] by simp
 
 lemma (in finite_measure) finite_measure_mono:
   assumes "A \<subseteq> B" "B \<in> sets M" shows "measure M A \<le> measure M B"
   using emeasure_mono[OF assms] emeasure_real[of A] emeasure_real[of B] by (auto simp: measure_def)
 
 lemma (in finite_measure) finite_measure_subadditive:
   assumes m: "A \<in> sets M" "B \<in> sets M"
   shows "measure M (A \<union> B) \<le> measure M A + measure M B"
   using measure_subadditive[OF m] by simp
 
 lemma (in finite_measure) finite_measure_subadditive_finite:
   assumes "finite I" "A`I \<subseteq> sets M" shows "measure M (\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. measure M (A i))"
   using measure_subadditive_finite[OF assms] by simp
 
 lemma (in finite_measure) finite_measure_subadditive_countably:
   "range A \<subseteq> sets M \<Longrightarrow> summable (\<lambda>i. measure M (A i)) \<Longrightarrow> measure M (\<Union>i. A i) \<le> (\<Sum>i. measure M (A i))"
   by (rule measure_subadditive_countably)
      (simp_all add: ennreal_suminf_neq_top emeasure_eq_measure)
 
 lemma (in finite_measure) finite_measure_eq_sum_singleton:
   assumes "finite S" and *: "\<And>x. x \<in> S \<Longrightarrow> {x} \<in> sets M"
   shows "measure M S = (\<Sum>x\<in>S. measure M {x})"
   using measure_eq_sum_singleton[OF assms] by simp
 
 lemma (in finite_measure) finite_Lim_measure_incseq:
   assumes A: "range A \<subseteq> sets M" "incseq A"
   shows "(\<lambda>i. measure M (A i)) \<longlonglongrightarrow> measure M (\<Union>i. A i)"
   using Lim_measure_incseq[OF A] by simp
 
 lemma (in finite_measure) finite_Lim_measure_decseq:
   assumes A: "range A \<subseteq> sets M" "decseq A"
   shows "(\<lambda>n. measure M (A n)) \<longlonglongrightarrow> measure M (\<Inter>i. A i)"
   using Lim_measure_decseq[OF A] by simp
 
 lemma (in finite_measure) finite_measure_compl:
   assumes S: "S \<in> sets M"
   shows "measure M (space M - S) = measure M (space M) - measure M S"
   using measure_Diff[OF _ sets.top S sets.sets_into_space] S by simp
 
 lemma (in finite_measure) finite_measure_mono_AE:
   assumes imp: "AE x in M. x \<in> A \<longrightarrow> x \<in> B" and B: "B \<in> sets M"
   shows "measure M A \<le> measure M B"
   using assms emeasure_mono_AE[OF imp B]
   by (simp add: emeasure_eq_measure)
 
 lemma (in finite_measure) finite_measure_eq_AE:
   assumes iff: "AE x in M. x \<in> A \<longleftrightarrow> x \<in> B"
   assumes A: "A \<in> sets M" and B: "B \<in> sets M"
   shows "measure M A = measure M B"
   using assms emeasure_eq_AE[OF assms] by (simp add: emeasure_eq_measure)
 
 lemma (in finite_measure) measure_increasing: "increasing M (measure M)"
   by (auto intro!: finite_measure_mono simp: increasing_def)
 
 lemma (in finite_measure) measure_zero_union:
   assumes "s \<in> sets M" "t \<in> sets M" "measure M t = 0"
   shows "measure M (s \<union> t) = measure M s"
 using assms
 proof -
   have "measure M (s \<union> t) \<le> measure M s"
     using finite_measure_subadditive[of s t] assms by auto
   moreover have "measure M (s \<union> t) \<ge> measure M s"
     using assms by (blast intro: finite_measure_mono)
   ultimately show ?thesis by simp
 qed
 
 lemma (in finite_measure) measure_eq_compl:
   assumes "s \<in> sets M" "t \<in> sets M"
   assumes "measure M (space M - s) = measure M (space M - t)"
   shows "measure M s = measure M t"
   using assms finite_measure_compl by auto
 
 lemma (in finite_measure) measure_eq_bigunion_image:
   assumes "range f \<subseteq> sets M" "range g \<subseteq> sets M"
   assumes "disjoint_family f" "disjoint_family g"
   assumes "\<And> n :: nat. measure M (f n) = measure M (g n)"
   shows "measure M (\<Union>i. f i) = measure M (\<Union>i. g i)"
 using assms
 proof -
   have a: "(\<lambda> i. measure M (f i)) sums (measure M (\<Union>i. f i))"
     by (rule finite_measure_UNION[OF assms(1,3)])
   have b: "(\<lambda> i. measure M (g i)) sums (measure M (\<Union>i. g i))"
     by (rule finite_measure_UNION[OF assms(2,4)])
   show ?thesis using sums_unique[OF b] sums_unique[OF a] assms by simp
 qed
 
 lemma (in finite_measure) measure_countably_zero:
   assumes "range c \<subseteq> sets M"
   assumes "\<And> i. measure M (c i) = 0"
   shows "measure M (\<Union>i :: nat. c i) = 0"
 proof (rule antisym)
   show "measure M (\<Union>i :: nat. c i) \<le> 0"
     using finite_measure_subadditive_countably[OF assms(1)] by (simp add: assms(2))
 qed simp
 
 lemma (in finite_measure) measure_space_inter:
   assumes events:"s \<in> sets M" "t \<in> sets M"
   assumes "measure M t = measure M (space M)"
   shows "measure M (s \<inter> t) = measure M s"
 proof -
   have "measure M ((space M - s) \<union> (space M - t)) = measure M (space M - s)"
     using events assms finite_measure_compl[of "t"] by (auto intro!: measure_zero_union)
   also have "(space M - s) \<union> (space M - t) = space M - (s \<inter> t)"
     by blast
   finally show "measure M (s \<inter> t) = measure M s"
     using events by (auto intro!: measure_eq_compl[of "s \<inter> t" s])
 qed
 
 lemma (in finite_measure) measure_equiprobable_finite_unions:
   assumes s: "finite s" "\<And>x. x \<in> s \<Longrightarrow> {x} \<in> sets M"
   assumes "\<And> x y. \<lbrakk>x \<in> s; y \<in> s\<rbrakk> \<Longrightarrow> measure M {x} = measure M {y}"
   shows "measure M s = real (card s) * measure M {SOME x. x \<in> s}"
 proof cases
   assume "s \<noteq> {}"
   then have "\<exists> x. x \<in> s" by blast
   from someI_ex[OF this] assms
   have prob_some: "\<And> x. x \<in> s \<Longrightarrow> measure M {x} = measure M {SOME y. y \<in> s}" by blast
   have "measure M s = (\<Sum> x \<in> s. measure M {x})"
     using finite_measure_eq_sum_singleton[OF s] by simp
   also have "\<dots> = (\<Sum> x \<in> s. measure M {SOME y. y \<in> s})" using prob_some by auto
   also have "\<dots> = real (card s) * measure M {(SOME x. x \<in> s)}"
     using sum_constant assms by simp
   finally show ?thesis by simp
 qed simp
 
 lemma (in finite_measure) measure_real_sum_image_fn:
   assumes "e \<in> sets M"
   assumes "\<And> x. x \<in> s \<Longrightarrow> e \<inter> f x \<in> sets M"
   assumes "finite s"
   assumes disjoint: "\<And> x y. \<lbrakk>x \<in> s ; y \<in> s ; x \<noteq> y\<rbrakk> \<Longrightarrow> f x \<inter> f y = {}"
   assumes upper: "space M \<subseteq> (\<Union>i \<in> s. f i)"
   shows "measure M e = (\<Sum> x \<in> s. measure M (e \<inter> f x))"
 proof -
   have "e \<subseteq> (\<Union>i\<in>s. f i)"
     using \<open>e \<in> sets M\<close> sets.sets_into_space upper by blast
   then have e: "e = (\<Union>i \<in> s. e \<inter> f i)"
     by auto
   hence "measure M e = measure M (\<Union>i \<in> s. e \<inter> f i)" by simp
   also have "\<dots> = (\<Sum> x \<in> s. measure M (e \<inter> f x))"
   proof (rule finite_measure_finite_Union)
     show "finite s" by fact
     show "(\<lambda>i. e \<inter> f i)`s \<subseteq> sets M" using assms(2) by auto
     show "disjoint_family_on (\<lambda>i. e \<inter> f i) s"
       using disjoint by (auto simp: disjoint_family_on_def)
   qed
   finally show ?thesis .
 qed
 
 lemma (in finite_measure) measure_exclude:
   assumes "A \<in> sets M" "B \<in> sets M"
   assumes "measure M A = measure M (space M)" "A \<inter> B = {}"
   shows "measure M B = 0"
   using measure_space_inter[of B A] assms by (auto simp: ac_simps)
 lemma (in finite_measure) finite_measure_distr:
   assumes f: "f \<in> measurable M M'"
   shows "finite_measure (distr M M' f)"
 proof (rule finite_measureI)
   have "f -` space M' \<inter> space M = space M" using f by (auto dest: measurable_space)
   with f show "emeasure (distr M M' f) (space (distr M M' f)) \<noteq> \<infinity>" by (auto simp: emeasure_distr)
 qed
 
 lemma emeasure_gfp[consumes 1, case_names cont measurable]:
   assumes sets[simp]: "\<And>s. sets (M s) = sets N"
   assumes "\<And>s. finite_measure (M s)"
   assumes cont: "inf_continuous F" "inf_continuous f"
   assumes meas: "\<And>P. Measurable.pred N P \<Longrightarrow> Measurable.pred N (F P)"
   assumes iter: "\<And>P s. Measurable.pred N P \<Longrightarrow> emeasure (M s) {x\<in>space N. F P x} = f (\<lambda>s. emeasure (M s) {x\<in>space N. P x}) s"
   assumes bound: "\<And>P. f P \<le> f (\<lambda>s. emeasure (M s) (space (M s)))"
   shows "emeasure (M s) {x\<in>space N. gfp F x} = gfp f s"
 proof (subst gfp_transfer_bounded[where \<alpha>="\<lambda>F s. emeasure (M s) {x\<in>space N. F x}" and g=f and f=F and
     P="Measurable.pred N", symmetric])
   interpret finite_measure "M s" for s by fact
   fix C assume "decseq C" "\<And>i. Measurable.pred N (C i)"
   then show "(\<lambda>s. emeasure (M s) {x \<in> space N. (INF i. C i) x}) = (INF i. (\<lambda>s. emeasure (M s) {x \<in> space N. C i x}))"
     unfolding INF_apply[abs_def]
     by (subst INF_emeasure_decseq) (auto simp: antimono_def fun_eq_iff intro!: arg_cong2[where f=emeasure])
 next
   show "f x \<le> (\<lambda>s. emeasure (M s) {x \<in> space N. F top x})" for x
     using bound[of x] sets_eq_imp_space_eq[OF sets] by (simp add: iter)
 qed (auto simp add: iter le_fun_def INF_apply[abs_def] intro!: meas cont)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Counting space\<close>
 
 lemma strict_monoI_Suc:
   assumes ord [simp]: "(\<And>n. f n < f (Suc n))" shows "strict_mono f"
   unfolding strict_mono_def
 proof safe
   fix n m :: nat assume "n < m" then show "f n < f m"
     by (induct m) (auto simp: less_Suc_eq intro: less_trans ord)
 qed
 
 lemma emeasure_count_space:
   assumes "X \<subseteq> A" shows "emeasure (count_space A) X = (if finite X then of_nat (card X) else \<infinity>)"
     (is "_ = ?M X")
   unfolding count_space_def
 proof (rule emeasure_measure_of_sigma)
   show "X \<in> Pow A" using \<open>X \<subseteq> A\<close> by auto
   show "sigma_algebra A (Pow A)" by (rule sigma_algebra_Pow)
   show positive: "positive (Pow A) ?M"
     by (auto simp: positive_def)
   have additive: "additive (Pow A) ?M"
     by (auto simp: card_Un_disjoint additive_def)
 
   interpret ring_of_sets A "Pow A"
     by (rule ring_of_setsI) auto
   show "countably_additive (Pow A) ?M"
     unfolding countably_additive_iff_continuous_from_below[OF positive additive]
   proof safe
     fix F :: "nat \<Rightarrow> 'a set" assume "incseq F"
     show "(\<lambda>i. ?M (F i)) \<longlonglongrightarrow> ?M (\<Union>i. F i)"
     proof cases
       assume "\<exists>i. \<forall>j\<ge>i. F i = F j"
-      then guess i .. note i = this
-      { fix j from i \<open>incseq F\<close> have "F j \<subseteq> F i"
-          by (cases "i \<le> j") (auto simp: incseq_def) }
+      then obtain i where i: "\<forall>j\<ge>i. F i = F j" ..
+      with \<open>incseq F\<close> have "F j \<subseteq> F i" for j
+        by (cases "i \<le> j") (auto simp: incseq_def)
       then have eq: "(\<Union>i. F i) = F i"
         by auto
       with i show ?thesis
         by (auto intro!: Lim_transform_eventually[OF tendsto_const] eventually_sequentiallyI[where c=i])
     next
       assume "\<not> (\<exists>i. \<forall>j\<ge>i. F i = F j)"
       then obtain f where f: "\<And>i. i \<le> f i" "\<And>i. F i \<noteq> F (f i)" by metis
       then have "\<And>i. F i \<subseteq> F (f i)" using \<open>incseq F\<close> by (auto simp: incseq_def)
       with f have *: "\<And>i. F i \<subset> F (f i)" by auto
 
       have "incseq (\<lambda>i. ?M (F i))"
         using \<open>incseq F\<close> unfolding incseq_def by (auto simp: card_mono dest: finite_subset)
       then have "(\<lambda>i. ?M (F i)) \<longlonglongrightarrow> (SUP n. ?M (F n))"
         by (rule LIMSEQ_SUP)
 
       moreover have "(SUP n. ?M (F n)) = top"
       proof (rule ennreal_SUP_eq_top)
         fix n :: nat show "\<exists>k::nat\<in>UNIV. of_nat n \<le> ?M (F k)"
         proof (induct n)
           case (Suc n)
-          then guess k .. note k = this
+          then obtain k where "of_nat n \<le> ?M (F k)" ..
           moreover have "finite (F k) \<Longrightarrow> finite (F (f k)) \<Longrightarrow> card (F k) < card (F (f k))"
             using \<open>F k \<subset> F (f k)\<close> by (simp add: psubset_card_mono)
           moreover have "finite (F (f k)) \<Longrightarrow> finite (F k)"
             using \<open>k \<le> f k\<close> \<open>incseq F\<close> by (auto simp: incseq_def dest: finite_subset)
           ultimately show ?case
             by (auto intro!: exI[of _ "f k"] simp del: of_nat_Suc)
         qed auto
       qed
 
       moreover
       have "inj (\<lambda>n. F ((f ^^ n) 0))"
         by (intro strict_mono_imp_inj_on strict_monoI_Suc) (simp add: *)
       then have 1: "infinite (range (\<lambda>i. F ((f ^^ i) 0)))"
         by (rule range_inj_infinite)
       have "infinite (Pow (\<Union>i. F i))"
         by (rule infinite_super[OF _ 1]) auto
       then have "infinite (\<Union>i. F i)"
         by auto
       ultimately show ?thesis by (simp only:) simp
          
     qed
   qed
 qed
 
 lemma distr_bij_count_space:
   assumes f: "bij_betw f A B"
   shows "distr (count_space A) (count_space B) f = count_space B"
 proof (rule measure_eqI)
   have f': "f \<in> measurable (count_space A) (count_space B)"
     using f unfolding Pi_def bij_betw_def by auto
   fix X assume "X \<in> sets (distr (count_space A) (count_space B) f)"
   then have X: "X \<in> sets (count_space B)" by auto
   moreover from X have "f -` X \<inter> A = the_inv_into A f ` X"
     using f by (auto simp: bij_betw_def subset_image_iff image_iff the_inv_into_f_f intro: the_inv_into_f_f[symmetric])
   moreover have "inj_on (the_inv_into A f) B"
     using X f by (auto simp: bij_betw_def inj_on_the_inv_into)
   with X have "inj_on (the_inv_into A f) X"
     by (auto intro: subset_inj_on)
   ultimately show "emeasure (distr (count_space A) (count_space B) f) X = emeasure (count_space B) X"
     using f unfolding emeasure_distr[OF f' X]
     by (subst (1 2) emeasure_count_space) (auto simp: card_image dest: finite_imageD)
 qed simp
 
 lemma emeasure_count_space_finite[simp]:
   "X \<subseteq> A \<Longrightarrow> finite X \<Longrightarrow> emeasure (count_space A) X = of_nat (card X)"
   using emeasure_count_space[of X A] by simp
 
 lemma emeasure_count_space_infinite[simp]:
   "X \<subseteq> A \<Longrightarrow> infinite X \<Longrightarrow> emeasure (count_space A) X = \<infinity>"
   using emeasure_count_space[of X A] by simp
 
 lemma measure_count_space: "measure (count_space A) X = (if X \<subseteq> A then of_nat (card X) else 0)"
   by (cases "finite X") (auto simp: measure_notin_sets ennreal_of_nat_eq_real_of_nat
                                     measure_zero_top measure_eq_emeasure_eq_ennreal)
 
 lemma emeasure_count_space_eq_0:
   "emeasure (count_space A) X = 0 \<longleftrightarrow> (X \<subseteq> A \<longrightarrow> X = {})"
 proof cases
   assume X: "X \<subseteq> A"
   then show ?thesis
   proof (intro iffI impI)
     assume "emeasure (count_space A) X = 0"
     with X show "X = {}"
       by (subst (asm) emeasure_count_space) (auto split: if_split_asm)
   qed simp
 qed (simp add: emeasure_notin_sets)
 
 lemma null_sets_count_space: "null_sets (count_space A) = { {} }"
   unfolding null_sets_def by (auto simp add: emeasure_count_space_eq_0)
 
 lemma AE_count_space: "(AE x in count_space A. P x) \<longleftrightarrow> (\<forall>x\<in>A. P x)"
   unfolding eventually_ae_filter by (auto simp add: null_sets_count_space)
 
 lemma sigma_finite_measure_count_space_countable:
   assumes A: "countable A"
   shows "sigma_finite_measure (count_space A)"
   proof qed (insert A, auto intro!: exI[of _ "(\<lambda>a. {a}) ` A"])
 
 lemma sigma_finite_measure_count_space:
   fixes A :: "'a::countable set" shows "sigma_finite_measure (count_space A)"
   by (rule sigma_finite_measure_count_space_countable) auto
 
 lemma finite_measure_count_space:
   assumes [simp]: "finite A"
   shows "finite_measure (count_space A)"
   by rule simp
 
 lemma sigma_finite_measure_count_space_finite:
   assumes A: "finite A" shows "sigma_finite_measure (count_space A)"
 proof -
   interpret finite_measure "count_space A" using A by (rule finite_measure_count_space)
   show "sigma_finite_measure (count_space A)" ..
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Measure restricted to space\<close>
 
 lemma emeasure_restrict_space:
   assumes "\<Omega> \<inter> space M \<in> sets M" "A \<subseteq> \<Omega>"
   shows "emeasure (restrict_space M \<Omega>) A = emeasure M A"
 proof (cases "A \<in> sets M")
   case True
   show ?thesis
   proof (rule emeasure_measure_of[OF restrict_space_def])
     show "(\<inter>) \<Omega> ` sets M \<subseteq> Pow (\<Omega> \<inter> space M)" "A \<in> sets (restrict_space M \<Omega>)"
       using \<open>A \<subseteq> \<Omega>\<close> \<open>A \<in> sets M\<close> sets.space_closed by (auto simp: sets_restrict_space)
     show "positive (sets (restrict_space M \<Omega>)) (emeasure M)"
       by (auto simp: positive_def)
     show "countably_additive (sets (restrict_space M \<Omega>)) (emeasure M)"
     proof (rule countably_additiveI)
       fix A :: "nat \<Rightarrow> _" assume "range A \<subseteq> sets (restrict_space M \<Omega>)" "disjoint_family A"
       with assms have "\<And>i. A i \<in> sets M" "\<And>i. A i \<subseteq> space M" "disjoint_family A"
         by (fastforce simp: sets_restrict_space_iff[OF assms(1)] image_subset_iff
                       dest: sets.sets_into_space)+
       then show "(\<Sum>i. emeasure M (A i)) = emeasure M (\<Union>i. A i)"
         by (subst suminf_emeasure) (auto simp: disjoint_family_subset)
     qed
   qed
 next
   case False
   with assms have "A \<notin> sets (restrict_space M \<Omega>)"
     by (simp add: sets_restrict_space_iff)
   with False show ?thesis
     by (simp add: emeasure_notin_sets)
 qed
 
 lemma measure_restrict_space:
   assumes "\<Omega> \<inter> space M \<in> sets M" "A \<subseteq> \<Omega>"
   shows "measure (restrict_space M \<Omega>) A = measure M A"
   using emeasure_restrict_space[OF assms] by (simp add: measure_def)
 
 lemma AE_restrict_space_iff:
   assumes "\<Omega> \<inter> space M \<in> sets M"
   shows "(AE x in restrict_space M \<Omega>. P x) \<longleftrightarrow> (AE x in M. x \<in> \<Omega> \<longrightarrow> P x)"
 proof -
   have ex_cong: "\<And>P Q f. (\<And>x. P x \<Longrightarrow> Q x) \<Longrightarrow> (\<And>x. Q x \<Longrightarrow> P (f x)) \<Longrightarrow> (\<exists>x. P x) \<longleftrightarrow> (\<exists>x. Q x)"
     by auto
   { fix X assume X: "X \<in> sets M" "emeasure M X = 0"
     then have "emeasure M (\<Omega> \<inter> space M \<inter> X) \<le> emeasure M X"
       by (intro emeasure_mono) auto
     then have "emeasure M (\<Omega> \<inter> space M \<inter> X) = 0"
       using X by (auto intro!: antisym) }
   with assms show ?thesis
     unfolding eventually_ae_filter
     by (auto simp add: space_restrict_space null_sets_def sets_restrict_space_iff
                        emeasure_restrict_space cong: conj_cong
              intro!: ex_cong[where f="\<lambda>X. (\<Omega> \<inter> space M) \<inter> X"])
 qed
 
 lemma restrict_restrict_space:
   assumes "A \<inter> space M \<in> sets M" "B \<inter> space M \<in> sets M"
   shows "restrict_space (restrict_space M A) B = restrict_space M (A \<inter> B)" (is "?l = ?r")
 proof (rule measure_eqI[symmetric])
   show "sets ?r = sets ?l"
     unfolding sets_restrict_space image_comp by (intro image_cong) auto
 next
   fix X assume "X \<in> sets (restrict_space M (A \<inter> B))"
   then obtain Y where "Y \<in> sets M" "X = Y \<inter> A \<inter> B"
     by (auto simp: sets_restrict_space)
   with assms sets.Int[OF assms] show "emeasure ?r X = emeasure ?l X"
     by (subst (1 2) emeasure_restrict_space)
        (auto simp: space_restrict_space sets_restrict_space_iff emeasure_restrict_space ac_simps)
 qed
 
 lemma restrict_count_space: "restrict_space (count_space B) A = count_space (A \<inter> B)"
 proof (rule measure_eqI)
   show "sets (restrict_space (count_space B) A) = sets (count_space (A \<inter> B))"
     by (subst sets_restrict_space) auto
   moreover fix X assume "X \<in> sets (restrict_space (count_space B) A)"
   ultimately have "X \<subseteq> A \<inter> B" by auto
   then show "emeasure (restrict_space (count_space B) A) X = emeasure (count_space (A \<inter> B)) X"
     by (cases "finite X") (auto simp add: emeasure_restrict_space)
 qed
 
 lemma sigma_finite_measure_restrict_space:
   assumes "sigma_finite_measure M"
   and A: "A \<in> sets M"
   shows "sigma_finite_measure (restrict_space M A)"
 proof -
   interpret sigma_finite_measure M by fact
   from sigma_finite_countable obtain C
     where C: "countable C" "C \<subseteq> sets M" "(\<Union>C) = space M" "\<forall>a\<in>C. emeasure M a \<noteq> \<infinity>"
     by blast
   let ?C = "(\<inter>) A ` C"
   from C have "countable ?C" "?C \<subseteq> sets (restrict_space M A)" "(\<Union>?C) = space (restrict_space M A)"
     by(auto simp add: sets_restrict_space space_restrict_space)
   moreover {
     fix a
     assume "a \<in> ?C"
     then obtain a' where "a = A \<inter> a'" "a' \<in> C" ..
     then have "emeasure (restrict_space M A) a \<le> emeasure M a'"
       using A C by(auto simp add: emeasure_restrict_space intro: emeasure_mono)
     also have "\<dots> < \<infinity>" using C(4)[rule_format, of a'] \<open>a' \<in> C\<close> by (simp add: less_top)
     finally have "emeasure (restrict_space M A) a \<noteq> \<infinity>" by simp }
   ultimately show ?thesis
     by unfold_locales (rule exI conjI|assumption|blast)+
 qed
 
 lemma finite_measure_restrict_space:
   assumes "finite_measure M"
   and A: "A \<in> sets M"
   shows "finite_measure (restrict_space M A)"
 proof -
   interpret finite_measure M by fact
   show ?thesis
     by(rule finite_measureI)(simp add: emeasure_restrict_space A space_restrict_space)
 qed
 
 lemma restrict_distr:
   assumes [measurable]: "f \<in> measurable M N"
   assumes [simp]: "\<Omega> \<inter> space N \<in> sets N" and restrict: "f \<in> space M \<rightarrow> \<Omega>"
   shows "restrict_space (distr M N f) \<Omega> = distr M (restrict_space N \<Omega>) f"
   (is "?l = ?r")
 proof (rule measure_eqI)
   fix A assume "A \<in> sets (restrict_space (distr M N f) \<Omega>)"
   with restrict show "emeasure ?l A = emeasure ?r A"
     by (subst emeasure_distr)
        (auto simp: sets_restrict_space_iff emeasure_restrict_space emeasure_distr
              intro!: measurable_restrict_space2)
 qed (simp add: sets_restrict_space)
 
 lemma measure_eqI_restrict_generator:
   assumes E: "Int_stable E" "E \<subseteq> Pow \<Omega>" "\<And>X. X \<in> E \<Longrightarrow> emeasure M X = emeasure N X"
   assumes sets_eq: "sets M = sets N" and \<Omega>: "\<Omega> \<in> sets M"
   assumes "sets (restrict_space M \<Omega>) = sigma_sets \<Omega> E"
   assumes "sets (restrict_space N \<Omega>) = sigma_sets \<Omega> E"
   assumes ae: "AE x in M. x \<in> \<Omega>" "AE x in N. x \<in> \<Omega>"
   assumes A: "countable A" "A \<noteq> {}" "A \<subseteq> E" "\<Union>A = \<Omega>" "\<And>a. a \<in> A \<Longrightarrow> emeasure M a \<noteq> \<infinity>"
   shows "M = N"
 proof (rule measure_eqI)
   fix X assume X: "X \<in> sets M"
   then have "emeasure M X = emeasure (restrict_space M \<Omega>) (X \<inter> \<Omega>)"
     using ae \<Omega> by (auto simp add: emeasure_restrict_space intro!: emeasure_eq_AE)
   also have "restrict_space M \<Omega> = restrict_space N \<Omega>"
   proof (rule measure_eqI_generator_eq)
     fix X assume "X \<in> E"
     then show "emeasure (restrict_space M \<Omega>) X = emeasure (restrict_space N \<Omega>) X"
       using E \<Omega> by (subst (1 2) emeasure_restrict_space) (auto simp: sets_eq sets_eq[THEN sets_eq_imp_space_eq])
   next
     show "range (from_nat_into A) \<subseteq> E" "(\<Union>i. from_nat_into A i) = \<Omega>"
       using A by (auto cong del: SUP_cong_simp)
   next
     fix i
     have "emeasure (restrict_space M \<Omega>) (from_nat_into A i) = emeasure M (from_nat_into A i)"
       using A \<Omega> by (subst emeasure_restrict_space)
                    (auto simp: sets_eq sets_eq[THEN sets_eq_imp_space_eq] intro: from_nat_into)
     with A show "emeasure (restrict_space M \<Omega>) (from_nat_into A i) \<noteq> \<infinity>"
       by (auto intro: from_nat_into)
   qed fact+
   also have "emeasure (restrict_space N \<Omega>) (X \<inter> \<Omega>) = emeasure N X"
     using X ae \<Omega> by (auto simp add: emeasure_restrict_space sets_eq intro!: emeasure_eq_AE)
   finally show "emeasure M X = emeasure N X" .
 qed fact
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Null measure\<close>
 
 definition null_measure :: "'a measure \<Rightarrow> 'a measure" where
 "null_measure M = sigma (space M) (sets M)"
 
 lemma space_null_measure[simp]: "space (null_measure M) = space M"
   by (simp add: null_measure_def)
 
 lemma sets_null_measure[simp, measurable_cong]: "sets (null_measure M) = sets M"
   by (simp add: null_measure_def)
 
 lemma emeasure_null_measure[simp]: "emeasure (null_measure M) X = 0"
   by (cases "X \<in> sets M", rule emeasure_measure_of)
      (auto simp: positive_def countably_additive_def emeasure_notin_sets null_measure_def
            dest: sets.sets_into_space)
 
 lemma measure_null_measure[simp]: "measure (null_measure M) X = 0"
   by (intro measure_eq_emeasure_eq_ennreal) auto
 
 lemma null_measure_idem [simp]: "null_measure (null_measure M) = null_measure M"
   by(rule measure_eqI) simp_all
 
 subsection \<open>Scaling a measure\<close>
 
 definition\<^marker>\<open>tag important\<close> scale_measure :: "ennreal \<Rightarrow> 'a measure \<Rightarrow> 'a measure" where
 "scale_measure r M = measure_of (space M) (sets M) (\<lambda>A. r * emeasure M A)"
 
 lemma space_scale_measure: "space (scale_measure r M) = space M"
   by (simp add: scale_measure_def)
 
 lemma sets_scale_measure [simp, measurable_cong]: "sets (scale_measure r M) = sets M"
   by (simp add: scale_measure_def)
 
 lemma emeasure_scale_measure [simp]:
   "emeasure (scale_measure r M) A = r * emeasure M A"
   (is "_ = ?\<mu> A")
 proof(cases "A \<in> sets M")
   case True
   show ?thesis unfolding scale_measure_def
   proof(rule emeasure_measure_of_sigma)
     show "sigma_algebra (space M) (sets M)" ..
     show "positive (sets M) ?\<mu>" by (simp add: positive_def)
     show "countably_additive (sets M) ?\<mu>"
     proof (rule countably_additiveI)
       fix A :: "nat \<Rightarrow> _"  assume *: "range A \<subseteq> sets M" "disjoint_family A"
       have "(\<Sum>i. ?\<mu> (A i)) = r * (\<Sum>i. emeasure M (A i))"
         by simp
       also have "\<dots> = ?\<mu> (\<Union>i. A i)" using * by(simp add: suminf_emeasure)
       finally show "(\<Sum>i. ?\<mu> (A i)) = ?\<mu> (\<Union>i. A i)" .
     qed
   qed(fact True)
 qed(simp add: emeasure_notin_sets)
 
 lemma scale_measure_1 [simp]: "scale_measure 1 M = M"
   by(rule measure_eqI) simp_all
 
 lemma scale_measure_0[simp]: "scale_measure 0 M = null_measure M"
   by(rule measure_eqI) simp_all
 
 lemma measure_scale_measure [simp]: "0 \<le> r \<Longrightarrow> measure (scale_measure r M) A = r * measure M A"
   using emeasure_scale_measure[of r M A]
     emeasure_eq_ennreal_measure[of M A]
     measure_eq_emeasure_eq_ennreal[of _ "scale_measure r M" A]
   by (cases "emeasure (scale_measure r M) A = top")
      (auto simp del: emeasure_scale_measure
            simp: ennreal_top_eq_mult_iff ennreal_mult_eq_top_iff measure_zero_top ennreal_mult[symmetric])
 
 lemma scale_scale_measure [simp]:
   "scale_measure r (scale_measure r' M) = scale_measure (r * r') M"
   by (rule measure_eqI) (simp_all add: max_def mult.assoc)
 
 lemma scale_null_measure [simp]: "scale_measure r (null_measure M) = null_measure M"
   by (rule measure_eqI) simp_all
 
 
 subsection \<open>Complete lattice structure on measures\<close>
 
 lemma (in finite_measure) finite_measure_Diff':
   "A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> measure M (A - B) = measure M A - measure M (A \<inter> B)"
   using finite_measure_Diff[of A "A \<inter> B"] by (auto simp: Diff_Int)
 
 lemma (in finite_measure) finite_measure_Union':
   "A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> measure M (A \<union> B) = measure M A + measure M (B - A)"
   using finite_measure_Union[of A "B - A"] by auto
 
 lemma finite_unsigned_Hahn_decomposition:
   assumes "finite_measure M" "finite_measure N" and [simp]: "sets N = sets M"
   shows "\<exists>Y\<in>sets M. (\<forall>X\<in>sets M. X \<subseteq> Y \<longrightarrow> N X \<le> M X) \<and> (\<forall>X\<in>sets M. X \<inter> Y = {} \<longrightarrow> M X \<le> N X)"
 proof -
   interpret M: finite_measure M by fact
   interpret N: finite_measure N by fact
 
   define d where "d X = measure M X - measure N X" for X
 
   have [intro]: "bdd_above (d`sets M)"
     using sets.sets_into_space[of _ M]
     by (intro bdd_aboveI[where M="measure M (space M)"])
        (auto simp: d_def field_simps subset_eq intro!: add_increasing M.finite_measure_mono)
 
   define \<gamma> where "\<gamma> = (SUP X\<in>sets M. d X)"
   have le_\<gamma>[intro]: "X \<in> sets M \<Longrightarrow> d X \<le> \<gamma>" for X
     by (auto simp: \<gamma>_def intro!: cSUP_upper)
 
   have "\<exists>f. \<forall>n. f n \<in> sets M \<and> d (f n) > \<gamma> - 1 / 2^n"
   proof (intro choice_iff[THEN iffD1] allI)
     fix n
     have "\<exists>X\<in>sets M. \<gamma> - 1 / 2^n < d X"
       unfolding \<gamma>_def by (intro less_cSUP_iff[THEN iffD1]) auto
     then show "\<exists>y. y \<in> sets M \<and> \<gamma> - 1 / 2 ^ n < d y"
       by auto
   qed
   then obtain E where [measurable]: "E n \<in> sets M" and E: "d (E n) > \<gamma> - 1 / 2^n" for n
     by auto
 
   define F where "F m n = (if m \<le> n then \<Inter>i\<in>{m..n}. E i else space M)" for m n
 
   have [measurable]: "m \<le> n \<Longrightarrow> F m n \<in> sets M" for m n
     by (auto simp: F_def)
 
   have 1: "\<gamma> - 2 / 2 ^ m + 1 / 2 ^ n \<le> d (F m n)" if "m \<le> n" for m n
     using that
   proof (induct rule: dec_induct)
     case base with E[of m] show ?case
       by (simp add: F_def field_simps)
   next
     case (step i)
     have F_Suc: "F m (Suc i) = F m i \<inter> E (Suc i)"
       using \<open>m \<le> i\<close> by (auto simp: F_def le_Suc_eq)
 
     have "\<gamma> + (\<gamma> - 2 / 2^m + 1 / 2 ^ Suc i) \<le> (\<gamma> - 1 / 2^Suc i) + (\<gamma> - 2 / 2^m + 1 / 2^i)"
       by (simp add: field_simps)
     also have "\<dots> \<le> d (E (Suc i)) + d (F m i)"
       using E[of "Suc i"] by (intro add_mono step) auto
     also have "\<dots> = d (E (Suc i)) + d (F m i - E (Suc i)) + d (F m (Suc i))"
       using \<open>m \<le> i\<close> by (simp add: d_def field_simps F_Suc M.finite_measure_Diff' N.finite_measure_Diff')
     also have "\<dots> = d (E (Suc i) \<union> F m i) + d (F m (Suc i))"
       using \<open>m \<le> i\<close> by (simp add: d_def field_simps M.finite_measure_Union' N.finite_measure_Union')
     also have "\<dots> \<le> \<gamma> + d (F m (Suc i))"
       using \<open>m \<le> i\<close> by auto
     finally show ?case
       by auto
   qed
 
   define F' where "F' m = (\<Inter>i\<in>{m..}. E i)" for m
   have F'_eq: "F' m = (\<Inter>i. F m (i + m))" for m
     by (fastforce simp: le_iff_add[of m] F'_def F_def)
 
   have [measurable]: "F' m \<in> sets M" for m
     by (auto simp: F'_def)
 
   have \<gamma>_le: "\<gamma> - 0 \<le> d (\<Union>m. F' m)"
   proof (rule LIMSEQ_le)
     show "(\<lambda>n. \<gamma> - 2 / 2 ^ n) \<longlonglongrightarrow> \<gamma> - 0"
       by (intro tendsto_intros LIMSEQ_divide_realpow_zero) auto
     have "incseq F'"
       by (auto simp: incseq_def F'_def)
     then show "(\<lambda>m. d (F' m)) \<longlonglongrightarrow> d (\<Union>m. F' m)"
       unfolding d_def
       by (intro tendsto_diff M.finite_Lim_measure_incseq N.finite_Lim_measure_incseq) auto
 
     have "\<gamma> - 2 / 2 ^ m + 0 \<le> d (F' m)" for m
     proof (rule LIMSEQ_le)
       have *: "decseq (\<lambda>n. F m (n + m))"
         by (auto simp: decseq_def F_def)
       show "(\<lambda>n. d (F m n)) \<longlonglongrightarrow> d (F' m)"
         unfolding d_def F'_eq
         by (rule LIMSEQ_offset[where k=m])
            (auto intro!: tendsto_diff M.finite_Lim_measure_decseq N.finite_Lim_measure_decseq *)
       show "(\<lambda>n. \<gamma> - 2 / 2 ^ m + 1 / 2 ^ n) \<longlonglongrightarrow> \<gamma> - 2 / 2 ^ m + 0"
         by (intro tendsto_add LIMSEQ_divide_realpow_zero tendsto_const) auto
       show "\<exists>N. \<forall>n\<ge>N. \<gamma> - 2 / 2 ^ m + 1 / 2 ^ n \<le> d (F m n)"
         using 1[of m] by (intro exI[of _ m]) auto
     qed
     then show "\<exists>N. \<forall>n\<ge>N. \<gamma> - 2 / 2 ^ n \<le> d (F' n)"
       by auto
   qed
 
   show ?thesis
   proof (safe intro!: bexI[of _ "\<Union>m. F' m"])
     fix X assume [measurable]: "X \<in> sets M" and X: "X \<subseteq> (\<Union>m. F' m)"
     have "d (\<Union>m. F' m) - d X = d ((\<Union>m. F' m) - X)"
       using X by (auto simp: d_def M.finite_measure_Diff N.finite_measure_Diff)
     also have "\<dots> \<le> \<gamma>"
       by auto
     finally have "0 \<le> d X"
       using \<gamma>_le by auto
     then show "emeasure N X \<le> emeasure M X"
       by (auto simp: d_def M.emeasure_eq_measure N.emeasure_eq_measure)
   next
     fix X assume [measurable]: "X \<in> sets M" and X: "X \<inter> (\<Union>m. F' m) = {}"
     then have "d (\<Union>m. F' m) + d X = d (X \<union> (\<Union>m. F' m))"
       by (auto simp: d_def M.finite_measure_Union N.finite_measure_Union)
     also have "\<dots> \<le> \<gamma>"
       by auto
     finally have "d X \<le> 0"
       using \<gamma>_le by auto
     then show "emeasure M X \<le> emeasure N X"
       by (auto simp: d_def M.emeasure_eq_measure N.emeasure_eq_measure)
   qed auto
 qed
 
 proposition unsigned_Hahn_decomposition:
   assumes [simp]: "sets N = sets M" and [measurable]: "A \<in> sets M"
     and [simp]: "emeasure M A \<noteq> top" "emeasure N A \<noteq> top"
   shows "\<exists>Y\<in>sets M. Y \<subseteq> A \<and> (\<forall>X\<in>sets M. X \<subseteq> Y \<longrightarrow> N X \<le> M X) \<and> (\<forall>X\<in>sets M. X \<subseteq> A \<longrightarrow> X \<inter> Y = {} \<longrightarrow> M X \<le> N X)"
 proof -
   have "\<exists>Y\<in>sets (restrict_space M A).
     (\<forall>X\<in>sets (restrict_space M A). X \<subseteq> Y \<longrightarrow> (restrict_space N A) X \<le> (restrict_space M A) X) \<and>
     (\<forall>X\<in>sets (restrict_space M A). X \<inter> Y = {} \<longrightarrow> (restrict_space M A) X \<le> (restrict_space N A) X)"
   proof (rule finite_unsigned_Hahn_decomposition)
     show "finite_measure (restrict_space M A)" "finite_measure (restrict_space N A)"
       by (auto simp: space_restrict_space emeasure_restrict_space less_top intro!: finite_measureI)
   qed (simp add: sets_restrict_space)
-  then guess Y ..
   then show ?thesis
-    apply (intro bexI[of _ Y] conjI ballI conjI)
-    apply (simp_all add: sets_restrict_space emeasure_restrict_space)
-    apply safe
-    subgoal for X Z
-      by (erule ballE[of _ _ X]) (auto simp add: Int_absorb1)
-    subgoal for X Z
-      by (erule ballE[of _ _ X])  (auto simp add: Int_absorb1 ac_simps)
-    apply auto
+    apply -
+    apply (erule bexE)
+    subgoal for Y
+      apply (intro bexI[of _ Y] conjI ballI conjI)
+         apply (simp_all add: sets_restrict_space emeasure_restrict_space)
+         apply safe
+      subgoal for X Z
+        by (erule ballE[of _ _ X]) (auto simp add: Int_absorb1)
+      subgoal for X Z
+        by (erule ballE[of _ _ X])  (auto simp add: Int_absorb1 ac_simps)
+      apply auto
+      done
     done
 qed
 
 text\<^marker>\<open>tag important\<close> \<open>
   Define a lexicographical order on \<^type>\<open>measure\<close>, in the order space, sets and measure. The parts
   of the lexicographical order are point-wise ordered.
 \<close>
 
 instantiation measure :: (type) order_bot
 begin
 
 inductive less_eq_measure :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> bool" where
   "space M \<subset> space N \<Longrightarrow> less_eq_measure M N"
 | "space M = space N \<Longrightarrow> sets M \<subset> sets N \<Longrightarrow> less_eq_measure M N"
 | "space M = space N \<Longrightarrow> sets M = sets N \<Longrightarrow> emeasure M \<le> emeasure N \<Longrightarrow> less_eq_measure M N"
 
 lemma le_measure_iff:
   "M \<le> N \<longleftrightarrow> (if space M = space N then
     if sets M = sets N then emeasure M \<le> emeasure N else sets M \<subseteq> sets N else space M \<subseteq> space N)"
   by (auto elim: less_eq_measure.cases intro: less_eq_measure.intros)
 
 definition\<^marker>\<open>tag important\<close> less_measure :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> bool" where
   "less_measure M N \<longleftrightarrow> (M \<le> N \<and> \<not> N \<le> M)"
 
 definition\<^marker>\<open>tag important\<close> bot_measure :: "'a measure" where
   "bot_measure = sigma {} {}"
 
 lemma
   shows space_bot[simp]: "space bot = {}"
     and sets_bot[simp]: "sets bot = {{}}"
     and emeasure_bot[simp]: "emeasure bot X = 0"
   by (auto simp: bot_measure_def sigma_sets_empty_eq emeasure_sigma)
 
 instance
 proof standard
   show "bot \<le> a" for a :: "'a measure"
     by (simp add: le_measure_iff bot_measure_def sigma_sets_empty_eq emeasure_sigma le_fun_def)
 qed (auto simp: le_measure_iff less_measure_def split: if_split_asm intro: measure_eqI)
 
 end
 
 proposition le_measure: "sets M = sets N \<Longrightarrow> M \<le> N \<longleftrightarrow> (\<forall>A\<in>sets M. emeasure M A \<le> emeasure N A)"
   apply -
   apply (auto simp: le_measure_iff le_fun_def dest: sets_eq_imp_space_eq)
   subgoal for X
     by (cases "X \<in> sets M") (auto simp: emeasure_notin_sets)
   done
 
 definition\<^marker>\<open>tag important\<close> sup_measure' :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> 'a measure" where
 "sup_measure' A B =
   measure_of (space A) (sets A)
     (\<lambda>X. SUP Y\<in>sets A. emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y))"
 
 lemma assumes [simp]: "sets B = sets A"
   shows space_sup_measure'[simp]: "space (sup_measure' A B) = space A"
     and sets_sup_measure'[simp]: "sets (sup_measure' A B) = sets A"
   using sets_eq_imp_space_eq[OF assms] by (simp_all add: sup_measure'_def)
 
 lemma emeasure_sup_measure':
   assumes sets_eq[simp]: "sets B = sets A" and [simp, intro]: "X \<in> sets A"
   shows "emeasure (sup_measure' A B) X = (SUP Y\<in>sets A. emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y))"
     (is "_ = ?S X")
 proof -
   note sets_eq_imp_space_eq[OF sets_eq, simp]
   show ?thesis
     using sup_measure'_def
   proof (rule emeasure_measure_of)
     let ?d = "\<lambda>X Y. emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y)"
     show "countably_additive (sets (sup_measure' A B)) (\<lambda>X. SUP Y \<in> sets A. emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y))"
     proof (rule countably_additiveI, goal_cases)
       case (1 X)
       then have [measurable]: "\<And>i. X i \<in> sets A" and "disjoint_family X"
         by auto
       have disjoint: "disjoint_family (\<lambda>i. X i \<inter> Y)" "disjoint_family (\<lambda>i. X i - Y)" for Y
         by (auto intro: disjoint_family_on_bisimulation [OF \<open>disjoint_family X\<close>, simplified])
       have "(\<Sum>i. ?S (X i)) = (SUP Y\<in>sets A. \<Sum>i. ?d (X i) Y)"
       proof (rule ennreal_suminf_SUP_eq_directed)
         fix J :: "nat set" and a b assume "finite J" and [measurable]: "a \<in> sets A" "b \<in> sets A"
         have "\<exists>c\<in>sets A. c \<subseteq> X i \<and> (\<forall>a\<in>sets A. ?d (X i) a \<le> ?d (X i) c)" for i
         proof cases
           assume "emeasure A (X i) = top \<or> emeasure B (X i) = top"
           then show ?thesis
           proof
             assume "emeasure A (X i) = top" then show ?thesis
               by (intro bexI[of _ "X i"]) auto
           next
             assume "emeasure B (X i) = top" then show ?thesis
               by (intro bexI[of _ "{}"]) auto
           qed
         next
           assume finite: "\<not> (emeasure A (X i) = top \<or> emeasure B (X i) = top)"
           then have "\<exists>Y\<in>sets A. Y \<subseteq> X i \<and> (\<forall>C\<in>sets A. C \<subseteq> Y \<longrightarrow> B C \<le> A C) \<and> (\<forall>C\<in>sets A. C \<subseteq> X i \<longrightarrow> C \<inter> Y = {} \<longrightarrow> A C \<le> B C)"
             using unsigned_Hahn_decomposition[of B A "X i"] by simp
           then obtain Y where [measurable]: "Y \<in> sets A" and [simp]: "Y \<subseteq> X i"
             and B_le_A: "\<And>C. C \<in> sets A \<Longrightarrow> C \<subseteq> Y \<Longrightarrow> B C \<le> A C"
             and A_le_B: "\<And>C. C \<in> sets A \<Longrightarrow> C \<subseteq> X i \<Longrightarrow> C \<inter> Y = {} \<Longrightarrow> A C \<le> B C"
             by auto
 
           show ?thesis
           proof (intro bexI[of _ Y] ballI conjI)
             fix a assume [measurable]: "a \<in> sets A"
             have *: "(X i \<inter> a \<inter> Y \<union> (X i \<inter> a - Y)) = X i \<inter> a" "(X i - a) \<inter> Y \<union> (X i - a - Y) = X i \<inter> - a"
               for a Y by auto
             then have "?d (X i) a =
               (A (X i \<inter> a \<inter> Y) + A (X i \<inter> a \<inter> - Y)) + (B (X i \<inter> - a \<inter> Y) + B (X i \<inter> - a \<inter> - Y))"
               by (subst (1 2) plus_emeasure) (auto simp: Diff_eq[symmetric])
             also have "\<dots> \<le> (A (X i \<inter> a \<inter> Y) + B (X i \<inter> a \<inter> - Y)) + (A (X i \<inter> - a \<inter> Y) + B (X i \<inter> - a \<inter> - Y))"
               by (intro add_mono order_refl B_le_A A_le_B) (auto simp: Diff_eq[symmetric])
             also have "\<dots> \<le> (A (X i \<inter> Y \<inter> a) + A (X i \<inter> Y \<inter> - a)) + (B (X i \<inter> - Y \<inter> a) + B (X i \<inter> - Y \<inter> - a))"
               by (simp add: ac_simps)
             also have "\<dots> \<le> A (X i \<inter> Y) + B (X i \<inter> - Y)"
               by (subst (1 2) plus_emeasure) (auto simp: Diff_eq[symmetric] *)
             finally show "?d (X i) a \<le> ?d (X i) Y" .
           qed auto
         qed
         then obtain C where [measurable]: "C i \<in> sets A" and "C i \<subseteq> X i"
           and C: "\<And>a. a \<in> sets A \<Longrightarrow> ?d (X i) a \<le> ?d (X i) (C i)" for i
           by metis
         have *: "X i \<inter> (\<Union>i. C i) = X i \<inter> C i" for i
         proof safe
           fix x j assume "x \<in> X i" "x \<in> C j"
           moreover have "i = j \<or> X i \<inter> X j = {}"
             using \<open>disjoint_family X\<close> by (auto simp: disjoint_family_on_def)
           ultimately show "x \<in> C i"
             using \<open>C i \<subseteq> X i\<close> \<open>C j \<subseteq> X j\<close> by auto
         qed auto
         have **: "X i \<inter> - (\<Union>i. C i) = X i \<inter> - C i" for i
         proof safe
           fix x j assume "x \<in> X i" "x \<notin> C i" "x \<in> C j"
           moreover have "i = j \<or> X i \<inter> X j = {}"
             using \<open>disjoint_family X\<close> by (auto simp: disjoint_family_on_def)
           ultimately show False
             using \<open>C i \<subseteq> X i\<close> \<open>C j \<subseteq> X j\<close> by auto
         qed auto
         show "\<exists>c\<in>sets A. \<forall>i\<in>J. ?d (X i) a \<le> ?d (X i) c \<and> ?d (X i) b \<le> ?d (X i) c"
           apply (intro bexI[of _ "\<Union>i. C i"])
           unfolding * **
           apply (intro C ballI conjI)
           apply auto
           done
       qed
       also have "\<dots> = ?S (\<Union>i. X i)"
         apply (simp only: UN_extend_simps(4))
         apply (rule arg_cong [of _ _ Sup])
         apply (rule image_cong)
          apply (fact refl)
         using disjoint
         apply (auto simp add: suminf_add [symmetric] Diff_eq [symmetric] image_subset_iff suminf_emeasure simp del: UN_simps)
         done
       finally show "(\<Sum>i. ?S (X i)) = ?S (\<Union>i. X i)" .
     qed
   qed (auto dest: sets.sets_into_space simp: positive_def intro!: SUP_const)
 qed
 
 lemma le_emeasure_sup_measure'1:
   assumes "sets B = sets A" "X \<in> sets A" shows "emeasure A X \<le> emeasure (sup_measure' A B) X"
   by (subst emeasure_sup_measure'[OF assms]) (auto intro!: SUP_upper2[of "X"] assms)
 
 lemma le_emeasure_sup_measure'2:
   assumes "sets B = sets A" "X \<in> sets A" shows "emeasure B X \<le> emeasure (sup_measure' A B) X"
   by (subst emeasure_sup_measure'[OF assms]) (auto intro!: SUP_upper2[of "{}"] assms)
 
 lemma emeasure_sup_measure'_le2:
   assumes [simp]: "sets B = sets C" "sets A = sets C" and [measurable]: "X \<in> sets C"
   assumes A: "\<And>Y. Y \<subseteq> X \<Longrightarrow> Y \<in> sets A \<Longrightarrow> emeasure A Y \<le> emeasure C Y"
   assumes B: "\<And>Y. Y \<subseteq> X \<Longrightarrow> Y \<in> sets A \<Longrightarrow> emeasure B Y \<le> emeasure C Y"
   shows "emeasure (sup_measure' A B) X \<le> emeasure C X"
 proof (subst emeasure_sup_measure')
   show "(SUP Y\<in>sets A. emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y)) \<le> emeasure C X"
     unfolding \<open>sets A = sets C\<close>
   proof (intro SUP_least)
     fix Y assume [measurable]: "Y \<in> sets C"
     have [simp]: "X \<inter> Y \<union> (X - Y) = X"
       by auto
     have "emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y) \<le> emeasure C (X \<inter> Y) + emeasure C (X \<inter> - Y)"
       by (intro add_mono A B) (auto simp: Diff_eq[symmetric])
     also have "\<dots> = emeasure C X"
       by (subst plus_emeasure) (auto simp: Diff_eq[symmetric])
     finally show "emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y) \<le> emeasure C X" .
   qed
 qed simp_all
 
 definition\<^marker>\<open>tag important\<close> sup_lexord :: "'a \<Rightarrow> 'a \<Rightarrow> ('a \<Rightarrow> 'b::order) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a" where
 "sup_lexord A B k s c =
   (if k A = k B then c else
    if \<not> k A \<le> k B \<and> \<not> k B \<le> k A then s else
    if k B \<le> k A then A else B)"
 
 lemma sup_lexord:
   "(k A < k B \<Longrightarrow> P B) \<Longrightarrow> (k B < k A \<Longrightarrow> P A) \<Longrightarrow> (k A = k B \<Longrightarrow> P c) \<Longrightarrow>
     (\<not> k B \<le> k A \<Longrightarrow> \<not> k A \<le> k B \<Longrightarrow> P s) \<Longrightarrow> P (sup_lexord A B k s c)"
   by (auto simp: sup_lexord_def)
 
 lemmas le_sup_lexord = sup_lexord[where P="\<lambda>a. c \<le> a" for c]
 
 lemma sup_lexord1: "k A = k B \<Longrightarrow> sup_lexord A B k s c = c"
   by (simp add: sup_lexord_def)
 
 lemma sup_lexord_commute: "sup_lexord A B k s c = sup_lexord B A k s c"
   by (auto simp: sup_lexord_def)
 
 lemma sigma_sets_le_sets_iff: "(sigma_sets (space x) \<A> \<subseteq> sets x) = (\<A> \<subseteq> sets x)"
   using sets.sigma_sets_subset[of \<A> x] by auto
 
 lemma sigma_le_iff: "\<A> \<subseteq> Pow \<Omega> \<Longrightarrow> sigma \<Omega> \<A> \<le> x \<longleftrightarrow> (\<Omega> \<subseteq> space x \<and> (space x = \<Omega> \<longrightarrow> \<A> \<subseteq> sets x))"
   by (cases "\<Omega> = space x")
      (simp_all add: eq_commute[of _ "sets x"] le_measure_iff emeasure_sigma le_fun_def
                     sigma_sets_superset_generator sigma_sets_le_sets_iff)
 
 instantiation measure :: (type) semilattice_sup
 begin
 
 definition\<^marker>\<open>tag important\<close> sup_measure :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> 'a measure" where
   "sup_measure A B =
     sup_lexord A B space (sigma (space A \<union> space B) {})
       (sup_lexord A B sets (sigma (space A) (sets A \<union> sets B)) (sup_measure' A B))"
 
 instance
 proof
   fix x y z :: "'a measure"
   show "x \<le> sup x y"
     unfolding sup_measure_def
   proof (intro le_sup_lexord)
     assume "space x = space y"
     then have *: "sets x \<union> sets y \<subseteq> Pow (space x)"
       using sets.space_closed by auto
     assume "\<not> sets y \<subseteq> sets x" "\<not> sets x \<subseteq> sets y"
     then have "sets x \<subset> sets x \<union> sets y"
       by auto
     also have "\<dots> \<le> sigma (space x) (sets x \<union> sets y)"
       by (subst sets_measure_of[OF *]) (rule sigma_sets_superset_generator)
     finally show "x \<le> sigma (space x) (sets x \<union> sets y)"
       by (simp add: space_measure_of[OF *] less_eq_measure.intros(2))
   next
     assume "\<not> space y \<subseteq> space x" "\<not> space x \<subseteq> space y"
     then show "x \<le> sigma (space x \<union> space y) {}"
       by (intro less_eq_measure.intros) auto
   next
     assume "sets x = sets y" then show "x \<le> sup_measure' x y"
       by (simp add: le_measure le_emeasure_sup_measure'1)
   qed (auto intro: less_eq_measure.intros)
   show "y \<le> sup x y"
     unfolding sup_measure_def
   proof (intro le_sup_lexord)
     assume **: "space x = space y"
     then have *: "sets x \<union> sets y \<subseteq> Pow (space y)"
       using sets.space_closed by auto
     assume "\<not> sets y \<subseteq> sets x" "\<not> sets x \<subseteq> sets y"
     then have "sets y \<subset> sets x \<union> sets y"
       by auto
     also have "\<dots> \<le> sigma (space y) (sets x \<union> sets y)"
       by (subst sets_measure_of[OF *]) (rule sigma_sets_superset_generator)
     finally show "y \<le> sigma (space x) (sets x \<union> sets y)"
       by (simp add: ** space_measure_of[OF *] less_eq_measure.intros(2))
   next
     assume "\<not> space y \<subseteq> space x" "\<not> space x \<subseteq> space y"
     then show "y \<le> sigma (space x \<union> space y) {}"
       by (intro less_eq_measure.intros) auto
   next
     assume "sets x = sets y" then show "y \<le> sup_measure' x y"
       by (simp add: le_measure le_emeasure_sup_measure'2)
   qed (auto intro: less_eq_measure.intros)
   show "x \<le> y \<Longrightarrow> z \<le> y \<Longrightarrow> sup x z \<le> y"
     unfolding sup_measure_def
   proof (intro sup_lexord[where P="\<lambda>x. x \<le> y"])
     assume "x \<le> y" "z \<le> y" and [simp]: "space x = space z" "sets x = sets z"
     from \<open>x \<le> y\<close> show "sup_measure' x z \<le> y"
     proof cases
       case 1 then show ?thesis
         by (intro less_eq_measure.intros(1)) simp
     next
       case 2 then show ?thesis
         by (intro less_eq_measure.intros(2)) simp_all
     next
       case 3 with \<open>z \<le> y\<close> \<open>x \<le> y\<close> show ?thesis
         by (auto simp add: le_measure intro!: emeasure_sup_measure'_le2)
     qed
   next
     assume **: "x \<le> y" "z \<le> y" "space x = space z" "\<not> sets z \<subseteq> sets x" "\<not> sets x \<subseteq> sets z"
     then have *: "sets x \<union> sets z \<subseteq> Pow (space x)"
       using sets.space_closed by auto
     show "sigma (space x) (sets x \<union> sets z) \<le> y"
       unfolding sigma_le_iff[OF *] using ** by (auto simp: le_measure_iff split: if_split_asm)
   next
     assume "x \<le> y" "z \<le> y" "\<not> space z \<subseteq> space x" "\<not> space x \<subseteq> space z"
     then have "space x \<subseteq> space y" "space z \<subseteq> space y"
       by (auto simp: le_measure_iff split: if_split_asm)
     then show "sigma (space x \<union> space z) {} \<le> y"
       by (simp add: sigma_le_iff)
   qed
 qed
 
 end
 
 lemma space_empty_eq_bot: "space a = {} \<longleftrightarrow> a = bot"
   using space_empty[of a] by (auto intro!: measure_eqI)
 
 lemma sets_eq_iff_bounded: "A \<le> B \<Longrightarrow> B \<le> C \<Longrightarrow> sets A = sets C \<Longrightarrow> sets B = sets A"
   by (auto dest: sets_eq_imp_space_eq simp add: le_measure_iff split: if_split_asm)
 
 lemma sets_sup: "sets A = sets M \<Longrightarrow> sets B = sets M \<Longrightarrow> sets (sup A B) = sets M"
   by (auto simp add: sup_measure_def sup_lexord_def dest: sets_eq_imp_space_eq)
 
 lemma le_measureD1: "A \<le> B \<Longrightarrow> space A \<le> space B"
   by (auto simp: le_measure_iff split: if_split_asm)
 
 lemma le_measureD2: "A \<le> B \<Longrightarrow> space A = space B \<Longrightarrow> sets A \<le> sets B"
   by (auto simp: le_measure_iff split: if_split_asm)
 
 lemma le_measureD3: "A \<le> B \<Longrightarrow> sets A = sets B \<Longrightarrow> emeasure A X \<le> emeasure B X"
   by (auto simp: le_measure_iff le_fun_def dest: sets_eq_imp_space_eq split: if_split_asm)
 
 lemma UN_space_closed: "\<Union>(sets ` S) \<subseteq> Pow (\<Union>(space ` S))"
   using sets.space_closed by auto
 
 definition\<^marker>\<open>tag important\<close>
   Sup_lexord :: "('a \<Rightarrow> 'b::complete_lattice) \<Rightarrow> ('a set \<Rightarrow> 'a) \<Rightarrow> ('a set \<Rightarrow> 'a) \<Rightarrow> 'a set \<Rightarrow> 'a"
 where
   "Sup_lexord k c s A =
   (let U = (SUP a\<in>A. k a)
    in if \<exists>a\<in>A. k a = U then c {a\<in>A. k a = U} else s A)"
 
 lemma Sup_lexord:
   "(\<And>a S. a \<in> A \<Longrightarrow> k a = (SUP a\<in>A. k a) \<Longrightarrow> S = {a'\<in>A. k a' = k a} \<Longrightarrow> P (c S)) \<Longrightarrow> ((\<And>a. a \<in> A \<Longrightarrow> k a \<noteq> (SUP a\<in>A. k a)) \<Longrightarrow> P (s A)) \<Longrightarrow>
     P (Sup_lexord k c s A)"
   by (auto simp: Sup_lexord_def Let_def)
 
 lemma Sup_lexord1:
   assumes A: "A \<noteq> {}" "(\<And>a. a \<in> A \<Longrightarrow> k a = (\<Union>a\<in>A. k a))" "P (c A)"
   shows "P (Sup_lexord k c s A)"
   unfolding Sup_lexord_def Let_def
 proof (clarsimp, safe)
   show "\<forall>a\<in>A. k a \<noteq> (\<Union>x\<in>A. k x) \<Longrightarrow> P (s A)"
     by (metis assms(1,2) ex_in_conv)
 next
   fix a assume "a \<in> A" "k a = (\<Union>x\<in>A. k x)"
   then have "{a \<in> A. k a = (\<Union>x\<in>A. k x)} = {a \<in> A. k a = k a}"
     by (metis A(2)[symmetric])
   then show "P (c {a \<in> A. k a = (\<Union>x\<in>A. k x)})"
     by (simp add: A(3))
 qed
 
 instantiation measure :: (type) complete_lattice
 begin
 
 interpretation sup_measure: comm_monoid_set sup "bot :: 'a measure"
   by standard (auto intro!: antisym)
 
 lemma sup_measure_F_mono':
   "finite J \<Longrightarrow> finite I \<Longrightarrow> sup_measure.F id I \<le> sup_measure.F id (I \<union> J)"
 proof (induction J rule: finite_induct)
   case empty then show ?case
     by simp
 next
   case (insert i J)
   show ?case
   proof cases
     assume "i \<in> I" with insert show ?thesis
       by (auto simp: insert_absorb)
   next
     assume "i \<notin> I"
     have "sup_measure.F id I \<le> sup_measure.F id (I \<union> J)"
       by (intro insert)
     also have "\<dots> \<le> sup_measure.F id (insert i (I \<union> J))"
       using insert \<open>i \<notin> I\<close> by (subst sup_measure.insert) auto
     finally show ?thesis
       by auto
   qed
 qed
 
 lemma sup_measure_F_mono: "finite I \<Longrightarrow> J \<subseteq> I \<Longrightarrow> sup_measure.F id J \<le> sup_measure.F id I"
   using sup_measure_F_mono'[of I J] by (auto simp: finite_subset Un_absorb1)
 
 lemma sets_sup_measure_F:
   "finite I \<Longrightarrow> I \<noteq> {} \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> sets i = sets M) \<Longrightarrow> sets (sup_measure.F id I) = sets M"
   by (induction I rule: finite_ne_induct) (simp_all add: sets_sup)
 
 definition\<^marker>\<open>tag important\<close> Sup_measure' :: "'a measure set \<Rightarrow> 'a measure" where
 "Sup_measure' M =
   measure_of (\<Union>a\<in>M. space a) (\<Union>a\<in>M. sets a)
     (\<lambda>X. (SUP P\<in>{P. finite P \<and> P \<subseteq> M }. sup_measure.F id P X))"
 
 lemma space_Sup_measure'2: "space (Sup_measure' M) = (\<Union>m\<in>M. space m)"
   unfolding Sup_measure'_def by (intro space_measure_of[OF UN_space_closed])
 
 lemma sets_Sup_measure'2: "sets (Sup_measure' M) = sigma_sets (\<Union>m\<in>M. space m) (\<Union>m\<in>M. sets m)"
   unfolding Sup_measure'_def by (intro sets_measure_of[OF UN_space_closed])
 
 lemma sets_Sup_measure':
   assumes sets_eq[simp]: "\<And>m. m \<in> M \<Longrightarrow> sets m = sets A" and "M \<noteq> {}"
   shows "sets (Sup_measure' M) = sets A"
   using sets_eq[THEN sets_eq_imp_space_eq, simp] \<open>M \<noteq> {}\<close> by (simp add: Sup_measure'_def)
 
 lemma space_Sup_measure':
   assumes sets_eq[simp]: "\<And>m. m \<in> M \<Longrightarrow> sets m = sets A" and "M \<noteq> {}"
   shows "space (Sup_measure' M) = space A"
   using sets_eq[THEN sets_eq_imp_space_eq, simp] \<open>M \<noteq> {}\<close>
   by (simp add: Sup_measure'_def )
 
 lemma emeasure_Sup_measure':
   assumes sets_eq[simp]: "\<And>m. m \<in> M \<Longrightarrow> sets m = sets A" and "X \<in> sets A" "M \<noteq> {}"
   shows "emeasure (Sup_measure' M) X = (SUP P\<in>{P. finite P \<and> P \<subseteq> M}. sup_measure.F id P X)"
     (is "_ = ?S X")
   using Sup_measure'_def
 proof (rule emeasure_measure_of)
   note sets_eq[THEN sets_eq_imp_space_eq, simp]
   have *: "sets (Sup_measure' M) = sets A" "space (Sup_measure' M) = space A"
     using \<open>M \<noteq> {}\<close> by (simp_all add: Sup_measure'_def)
   let ?\<mu> = "sup_measure.F id"
   show "countably_additive (sets (Sup_measure' M)) ?S"
   proof (rule countably_additiveI, goal_cases)
     case (1 F)
     then have **: "range F \<subseteq> sets A"
       by (auto simp: *)
     show "(\<Sum>i. ?S (F i)) = ?S (\<Union>i. F i)"
     proof (subst ennreal_suminf_SUP_eq_directed)
       fix i j and N :: "nat set" assume ij: "i \<in> {P. finite P \<and> P \<subseteq> M}" "j \<in> {P. finite P \<and> P \<subseteq> M}"
       have "(i \<noteq> {} \<longrightarrow> sets (?\<mu> i) = sets A) \<and> (j \<noteq> {} \<longrightarrow> sets (?\<mu> j) = sets A) \<and>
         (i \<noteq> {} \<or> j \<noteq> {} \<longrightarrow> sets (?\<mu> (i \<union> j)) = sets A)"
         using ij by (intro impI sets_sup_measure_F conjI) auto
       then have "?\<mu> j (F n) \<le> ?\<mu> (i \<union> j) (F n) \<and> ?\<mu> i (F n) \<le> ?\<mu> (i \<union> j) (F n)" for n
         using ij
         by (cases "i = {}"; cases "j = {}")
            (auto intro!: le_measureD3 sup_measure_F_mono simp: sets_sup_measure_F
                  simp del: id_apply)
       with ij show "\<exists>k\<in>{P. finite P \<and> P \<subseteq> M}. \<forall>n\<in>N. ?\<mu> i (F n) \<le> ?\<mu> k (F n) \<and> ?\<mu> j (F n) \<le> ?\<mu> k (F n)"
         by (safe intro!: bexI[of _ "i \<union> j"]) auto
     next
       show "(SUP P \<in> {P. finite P \<and> P \<subseteq> M}. \<Sum>n. ?\<mu> P (F n)) = (SUP P \<in> {P. finite P \<and> P \<subseteq> M}. ?\<mu> P (\<Union>(F ` UNIV)))"
       proof (intro arg_cong [of _ _ Sup] image_cong refl)
         fix i assume i: "i \<in> {P. finite P \<and> P \<subseteq> M}"
         show "(\<Sum>n. ?\<mu> i (F n)) = ?\<mu> i (\<Union>(F ` UNIV))"
         proof cases
           assume "i \<noteq> {}" with i ** show ?thesis
             apply (intro suminf_emeasure \<open>disjoint_family F\<close>)
             apply (subst sets_sup_measure_F[OF _ _ sets_eq])
             apply auto
             done
         qed simp
       qed
     qed
   qed
   show "positive (sets (Sup_measure' M)) ?S"
     by (auto simp: positive_def bot_ennreal[symmetric])
   show "X \<in> sets (Sup_measure' M)"
     using assms * by auto
 qed (rule UN_space_closed)
 
 definition\<^marker>\<open>tag important\<close> Sup_measure :: "'a measure set \<Rightarrow> 'a measure" where
 "Sup_measure =
   Sup_lexord space
     (Sup_lexord sets Sup_measure'
       (\<lambda>U. sigma (\<Union>u\<in>U. space u) (\<Union>u\<in>U. sets u)))
     (\<lambda>U. sigma (\<Union>u\<in>U. space u) {})"
 
 definition\<^marker>\<open>tag important\<close> Inf_measure :: "'a measure set \<Rightarrow> 'a measure" where
   "Inf_measure A = Sup {x. \<forall>a\<in>A. x \<le> a}"
 
 definition\<^marker>\<open>tag important\<close> inf_measure :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> 'a measure" where
   "inf_measure a b = Inf {a, b}"
 
 definition\<^marker>\<open>tag important\<close> top_measure :: "'a measure" where
   "top_measure = Inf {}"
 
 instance
 proof
   note UN_space_closed [simp]
   show upper: "x \<le> Sup A" if x: "x \<in> A" for x :: "'a measure" and A
     unfolding Sup_measure_def
   proof (intro Sup_lexord[where P="\<lambda>y. x \<le> y"])
     assume "\<And>a. a \<in> A \<Longrightarrow> space a \<noteq> (\<Union>a\<in>A. space a)"
     from this[OF \<open>x \<in> A\<close>] \<open>x \<in> A\<close> show "x \<le> sigma (\<Union>a\<in>A. space a) {}"
       by (intro less_eq_measure.intros) auto
   next
     fix a S assume "a \<in> A" and a: "space a = (\<Union>a\<in>A. space a)" and S: "S = {a' \<in> A. space a' = space a}"
       and neq: "\<And>aa. aa \<in> S \<Longrightarrow> sets aa \<noteq> (\<Union>a\<in>S. sets a)"
     have sp_a: "space a = (\<Union>(space ` S))"
       using \<open>a\<in>A\<close> by (auto simp: S)
     show "x \<le> sigma (\<Union>(space ` S)) (\<Union>(sets ` S))"
     proof cases
       assume [simp]: "space x = space a"
       have "sets x \<subset> (\<Union>a\<in>S. sets a)"
         using \<open>x\<in>A\<close> neq[of x] by (auto simp: S)
       also have "\<dots> \<subseteq> sigma_sets (\<Union>x\<in>S. space x) (\<Union>x\<in>S. sets x)"
         by (rule sigma_sets_superset_generator)
       finally show ?thesis
         by (intro less_eq_measure.intros(2)) (simp_all add: sp_a)
     next
       assume "space x \<noteq> space a"
       moreover have "space x \<le> space a"
         unfolding a using \<open>x\<in>A\<close> by auto
       ultimately show ?thesis
         by (intro less_eq_measure.intros) (simp add: less_le sp_a)
     qed
   next
     fix a b S S' assume "a \<in> A" and a: "space a = (\<Union>a\<in>A. space a)" and S: "S = {a' \<in> A. space a' = space a}"
       and "b \<in> S" and b: "sets b = (\<Union>a\<in>S. sets a)" and S': "S' = {a' \<in> S. sets a' = sets b}"
     then have "S' \<noteq> {}" "space b = space a"
       by auto
     have sets_eq: "\<And>x. x \<in> S' \<Longrightarrow> sets x = sets b"
       by (auto simp: S')
     note sets_eq[THEN sets_eq_imp_space_eq, simp]
     have *: "sets (Sup_measure' S') = sets b" "space (Sup_measure' S') = space b"
       using \<open>S' \<noteq> {}\<close> by (simp_all add: Sup_measure'_def sets_eq)
     show "x \<le> Sup_measure' S'"
     proof cases
       assume "x \<in> S"
       with \<open>b \<in> S\<close> have "space x = space b"
         by (simp add: S)
       show ?thesis
       proof cases
         assume "x \<in> S'"
         show "x \<le> Sup_measure' S'"
         proof (intro le_measure[THEN iffD2] ballI)
           show "sets x = sets (Sup_measure' S')"
             using \<open>x\<in>S'\<close> * by (simp add: S')
           fix X assume "X \<in> sets x"
           show "emeasure x X \<le> emeasure (Sup_measure' S') X"
           proof (subst emeasure_Sup_measure'[OF _ \<open>X \<in> sets x\<close>])
             show "emeasure x X \<le> (SUP P \<in> {P. finite P \<and> P \<subseteq> S'}. emeasure (sup_measure.F id P) X)"
               using \<open>x\<in>S'\<close> by (intro SUP_upper2[where i="{x}"]) auto
           qed (insert \<open>x\<in>S'\<close> S', auto)
         qed
       next
         assume "x \<notin> S'"
         then have "sets x \<noteq> sets b"
           using \<open>x\<in>S\<close> by (auto simp: S')
         moreover have "sets x \<le> sets b"
           using \<open>x\<in>S\<close> unfolding b by auto
         ultimately show ?thesis
           using * \<open>x \<in> S\<close>
           by (intro less_eq_measure.intros(2))
              (simp_all add: * \<open>space x = space b\<close> less_le)
       qed
     next
       assume "x \<notin> S"
       with \<open>x\<in>A\<close> \<open>x \<notin> S\<close> \<open>space b = space a\<close> show ?thesis
         by (intro less_eq_measure.intros)
            (simp_all add: * less_le a SUP_upper S)
     qed
   qed
   show least: "Sup A \<le> x" if x: "\<And>z. z \<in> A \<Longrightarrow> z \<le> x" for x :: "'a measure" and A
     unfolding Sup_measure_def
   proof (intro Sup_lexord[where P="\<lambda>y. y \<le> x"])
     assume "\<And>a. a \<in> A \<Longrightarrow> space a \<noteq> (\<Union>a\<in>A. space a)"
     show "sigma (\<Union>(space ` A)) {} \<le> x"
       using x[THEN le_measureD1] by (subst sigma_le_iff) auto
   next
     fix a S assume "a \<in> A" "space a = (\<Union>a\<in>A. space a)" and S: "S = {a' \<in> A. space a' = space a}"
       "\<And>a. a \<in> S \<Longrightarrow> sets a \<noteq> (\<Union>a\<in>S. sets a)"
     have "\<Union>(space ` S) \<subseteq> space x"
       using S le_measureD1[OF x] by auto
     moreover
     have "\<Union>(space ` S) = space a"
       using \<open>a\<in>A\<close> S by auto
     then have "space x = \<Union>(space ` S) \<Longrightarrow> \<Union>(sets ` S) \<subseteq> sets x"
       using \<open>a \<in> A\<close> le_measureD2[OF x] by (auto simp: S)
     ultimately show "sigma (\<Union>(space ` S)) (\<Union>(sets ` S)) \<le> x"
       by (subst sigma_le_iff) simp_all
   next
     fix a b S S' assume "a \<in> A" and a: "space a = (\<Union>a\<in>A. space a)" and S: "S = {a' \<in> A. space a' = space a}"
       and "b \<in> S" and b: "sets b = (\<Union>a\<in>S. sets a)" and S': "S' = {a' \<in> S. sets a' = sets b}"
     then have "S' \<noteq> {}" "space b = space a"
       by auto
     have sets_eq: "\<And>x. x \<in> S' \<Longrightarrow> sets x = sets b"
       by (auto simp: S')
     note sets_eq[THEN sets_eq_imp_space_eq, simp]
     have *: "sets (Sup_measure' S') = sets b" "space (Sup_measure' S') = space b"
       using \<open>S' \<noteq> {}\<close> by (simp_all add: Sup_measure'_def sets_eq)
     show "Sup_measure' S' \<le> x"
     proof cases
       assume "space x = space a"
       show ?thesis
       proof cases
         assume **: "sets x = sets b"
         show ?thesis
         proof (intro le_measure[THEN iffD2] ballI)
           show ***: "sets (Sup_measure' S') = sets x"
             by (simp add: * **)
           fix X assume "X \<in> sets (Sup_measure' S')"
           show "emeasure (Sup_measure' S') X \<le> emeasure x X"
             unfolding ***
           proof (subst emeasure_Sup_measure'[OF _ \<open>X \<in> sets (Sup_measure' S')\<close>])
             show "(SUP P \<in> {P. finite P \<and> P \<subseteq> S'}. emeasure (sup_measure.F id P) X) \<le> emeasure x X"
             proof (safe intro!: SUP_least)
               fix P assume P: "finite P" "P \<subseteq> S'"
               show "emeasure (sup_measure.F id P) X \<le> emeasure x X"
               proof cases
                 assume "P = {}" then show ?thesis
                   by auto
               next
                 assume "P \<noteq> {}"
                 from P have "finite P" "P \<subseteq> A"
                   unfolding S' S by (simp_all add: subset_eq)
                 then have "sup_measure.F id P \<le> x"
                   by (induction P) (auto simp: x)
                 moreover have "sets (sup_measure.F id P) = sets x"
                   using \<open>finite P\<close> \<open>P \<noteq> {}\<close> \<open>P \<subseteq> S'\<close> \<open>sets x = sets b\<close>
                   by (intro sets_sup_measure_F) (auto simp: S')
                 ultimately show "emeasure (sup_measure.F id P) X \<le> emeasure x X"
                   by (rule le_measureD3)
               qed
             qed
             show "m \<in> S' \<Longrightarrow> sets m = sets (Sup_measure' S')" for m
               unfolding * by (simp add: S')
           qed fact
         qed
       next
         assume "sets x \<noteq> sets b"
         moreover have "sets b \<le> sets x"
           unfolding b S using x[THEN le_measureD2] \<open>space x = space a\<close> by auto
         ultimately show "Sup_measure' S' \<le> x"
           using \<open>space x = space a\<close> \<open>b \<in> S\<close>
           by (intro less_eq_measure.intros(2)) (simp_all add: * S)
       qed
     next
       assume "space x \<noteq> space a"
       then have "space a < space x"
         using le_measureD1[OF x[OF \<open>a\<in>A\<close>]] by auto
       then show "Sup_measure' S' \<le> x"
         by (intro less_eq_measure.intros) (simp add: * \<open>space b = space a\<close>)
     qed
   qed
   show "Sup {} = (bot::'a measure)" "Inf {} = (top::'a measure)"
     by (auto intro!: antisym least simp: top_measure_def)
   show lower: "x \<in> A \<Longrightarrow> Inf A \<le> x" for x :: "'a measure" and A
     unfolding Inf_measure_def by (intro least) auto
   show greatest: "(\<And>z. z \<in> A \<Longrightarrow> x \<le> z) \<Longrightarrow> x \<le> Inf A" for x :: "'a measure" and A
     unfolding Inf_measure_def by (intro upper) auto
   show "inf x y \<le> x" "inf x y \<le> y" "x \<le> y \<Longrightarrow> x \<le> z \<Longrightarrow> x \<le> inf y z" for x y z :: "'a measure"
     by (auto simp: inf_measure_def intro!: lower greatest)
 qed
 
 end
 
 lemma sets_SUP:
   assumes "\<And>x. x \<in> I \<Longrightarrow> sets (M x) = sets N"
   shows "I \<noteq> {} \<Longrightarrow> sets (SUP i\<in>I. M i) = sets N"
   unfolding Sup_measure_def
   using assms assms[THEN sets_eq_imp_space_eq]
     sets_Sup_measure'[where A=N and M="M`I"]
   by (intro Sup_lexord1[where P="\<lambda>x. sets x = sets N"]) auto
 
 lemma emeasure_SUP:
   assumes sets: "\<And>i. i \<in> I \<Longrightarrow> sets (M i) = sets N" "X \<in> sets N" "I \<noteq> {}"
   shows "emeasure (SUP i\<in>I. M i) X = (SUP J\<in>{J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> I}. emeasure (SUP i\<in>J. M i) X)"
 proof -
   interpret sup_measure: comm_monoid_set sup "bot :: 'b measure"
     by standard (auto intro!: antisym)
   have eq: "finite J \<Longrightarrow> sup_measure.F id J = (SUP i\<in>J. i)" for J :: "'b measure set"
     by (induction J rule: finite_induct) auto
   have 1: "J \<noteq> {} \<Longrightarrow> J \<subseteq> I \<Longrightarrow> sets (SUP x\<in>J. M x) = sets N" for J
     by (intro sets_SUP sets) (auto )
   from \<open>I \<noteq> {}\<close> obtain i where "i\<in>I" by auto
   have "Sup_measure' (M`I) X = (SUP P\<in>{P. finite P \<and> P \<subseteq> M`I}. sup_measure.F id P X)"
     using sets by (intro emeasure_Sup_measure') auto
   also have "Sup_measure' (M`I) = (SUP i\<in>I. M i)"
     unfolding Sup_measure_def using \<open>I \<noteq> {}\<close> sets sets(1)[THEN sets_eq_imp_space_eq]
     by (intro Sup_lexord1[where P="\<lambda>x. _ = x"]) auto
   also have "(SUP P\<in>{P. finite P \<and> P \<subseteq> M`I}. sup_measure.F id P X) =
     (SUP J\<in>{J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> I}. (SUP i\<in>J. M i) X)"
   proof (intro SUP_eq)
     fix J assume "J \<in> {P. finite P \<and> P \<subseteq> M`I}"
     then obtain J' where J': "J' \<subseteq> I" "finite J'" and J: "J = M`J'" and "finite J"
       using finite_subset_image[of J M I] by auto
     show "\<exists>j\<in>{J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> I}. sup_measure.F id J X \<le> (SUP i\<in>j. M i) X"
     proof cases
       assume "J' = {}" with \<open>i \<in> I\<close> show ?thesis
         by (auto simp add: J)
     next
       assume "J' \<noteq> {}" with J J' show ?thesis
         by (intro bexI[of _ "J'"]) (auto simp add: eq simp del: id_apply)
     qed
   next
     fix J assume J: "J \<in> {P. P \<noteq> {} \<and> finite P \<and> P \<subseteq> I}"
     show "\<exists>J'\<in>{J. finite J \<and> J \<subseteq> M`I}. (SUP i\<in>J. M i) X \<le> sup_measure.F id J' X"
       using J by (intro bexI[of _ "M`J"]) (auto simp add: eq simp del: id_apply)
   qed
   finally show ?thesis .
 qed
 
 lemma emeasure_SUP_chain:
   assumes sets: "\<And>i. i \<in> A \<Longrightarrow> sets (M i) = sets N" "X \<in> sets N"
   assumes ch: "Complete_Partial_Order.chain (\<le>) (M ` A)" and "A \<noteq> {}"
   shows "emeasure (SUP i\<in>A. M i) X = (SUP i\<in>A. emeasure (M i) X)"
 proof (subst emeasure_SUP[OF sets \<open>A \<noteq> {}\<close>])
   show "(SUP J\<in>{J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> A}. emeasure (Sup (M ` J)) X) = (SUP i\<in>A. emeasure (M i) X)"
   proof (rule SUP_eq)
     fix J assume "J \<in> {J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> A}"
     then have J: "Complete_Partial_Order.chain (\<le>) (M ` J)" "finite J" "J \<noteq> {}" and "J \<subseteq> A"
       using ch[THEN chain_subset, of "M`J"] by auto
     with in_chain_finite[OF J(1)] obtain j where "j \<in> J" "(SUP j\<in>J. M j) = M j"
       by auto
     with \<open>J \<subseteq> A\<close> show "\<exists>j\<in>A. emeasure (Sup (M ` J)) X \<le> emeasure (M j) X"
       by auto
   next
     fix j assume "j\<in>A" then show "\<exists>i\<in>{J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> A}. emeasure (M j) X \<le> emeasure (Sup (M ` i)) X"
       by (intro bexI[of _ "{j}"]) auto
   qed
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Supremum of a set of \<open>\<sigma>\<close>-algebras\<close>
 
 lemma space_Sup_eq_UN: "space (Sup M) = (\<Union>x\<in>M. space x)"
   unfolding Sup_measure_def
   apply (intro Sup_lexord[where P="\<lambda>x. space x = _"])
   apply (subst space_Sup_measure'2)
   apply auto []
   apply (subst space_measure_of[OF UN_space_closed])
   apply auto
   done
 
 lemma sets_Sup_eq:
   assumes *: "\<And>m. m \<in> M \<Longrightarrow> space m = X" and "M \<noteq> {}"
   shows "sets (Sup M) = sigma_sets X (\<Union>x\<in>M. sets x)"
   unfolding Sup_measure_def
   apply (rule Sup_lexord1)
   apply fact
   apply (simp add: assms)
   apply (rule Sup_lexord)
   subgoal premises that for a S
     unfolding that(3) that(2)[symmetric]
     using that(1)
     apply (subst sets_Sup_measure'2)
     apply (intro arg_cong2[where f=sigma_sets])
     apply (auto simp: *)
     done
   apply (subst sets_measure_of[OF UN_space_closed])
   apply (simp add:  assms)
   done
 
 lemma in_sets_Sup: "(\<And>m. m \<in> M \<Longrightarrow> space m = X) \<Longrightarrow> m \<in> M \<Longrightarrow> A \<in> sets m \<Longrightarrow> A \<in> sets (Sup M)"
   by (subst sets_Sup_eq[where X=X]) auto
 
 lemma Sup_lexord_rel:
   assumes "\<And>i. i \<in> I \<Longrightarrow> k (A i) = k (B i)"
     "R (c (A ` {a \<in> I. k (B a) = (SUP x\<in>I. k (B x))})) (c (B ` {a \<in> I. k (B a) = (SUP x\<in>I. k (B x))}))"
     "R (s (A`I)) (s (B`I))"
   shows "R (Sup_lexord k c s (A`I)) (Sup_lexord k c s (B`I))"
 proof -
   have "A ` {a \<in> I. k (B a) = (SUP x\<in>I. k (B x))} =  {a \<in> A ` I. k a = (SUP x\<in>I. k (B x))}"
     using assms(1) by auto
   moreover have "B ` {a \<in> I. k (B a) = (SUP x\<in>I. k (B x))} =  {a \<in> B ` I. k a = (SUP x\<in>I. k (B x))}"
     by auto
   ultimately show ?thesis
     using assms by (auto simp: Sup_lexord_def Let_def image_comp)
 qed
 
 lemma sets_SUP_cong:
   assumes eq: "\<And>i. i \<in> I \<Longrightarrow> sets (M i) = sets (N i)" shows "sets (SUP i\<in>I. M i) = sets (SUP i\<in>I. N i)"
   unfolding Sup_measure_def
   using eq eq[THEN sets_eq_imp_space_eq]
   apply (intro Sup_lexord_rel[where R="\<lambda>x y. sets x = sets y"])
   apply simp
   apply simp
   apply (simp add: sets_Sup_measure'2)
   apply (intro arg_cong2[where f="\<lambda>x y. sets (sigma x y)"])
   apply auto
   done
 
 lemma sets_Sup_in_sets:
   assumes "M \<noteq> {}"
   assumes "\<And>m. m \<in> M \<Longrightarrow> space m = space N"
   assumes "\<And>m. m \<in> M \<Longrightarrow> sets m \<subseteq> sets N"
   shows "sets (Sup M) \<subseteq> sets N"
 proof -
   have *: "\<Union>(space ` M) = space N"
     using assms by auto
   show ?thesis
     unfolding * using assms by (subst sets_Sup_eq[of M "space N"]) (auto intro!: sets.sigma_sets_subset)
 qed
 
 lemma measurable_Sup1:
   assumes m: "m \<in> M" and f: "f \<in> measurable m N"
     and const_space: "\<And>m n. m \<in> M \<Longrightarrow> n \<in> M \<Longrightarrow> space m = space n"
   shows "f \<in> measurable (Sup M) N"
 proof -
   have "space (Sup M) = space m"
     using m by (auto simp add: space_Sup_eq_UN dest: const_space)
   then show ?thesis
     using m f unfolding measurable_def by (auto intro: in_sets_Sup[OF const_space])
 qed
 
 lemma measurable_Sup2:
   assumes M: "M \<noteq> {}"
   assumes f: "\<And>m. m \<in> M \<Longrightarrow> f \<in> measurable N m"
     and const_space: "\<And>m n. m \<in> M \<Longrightarrow> n \<in> M \<Longrightarrow> space m = space n"
   shows "f \<in> measurable N (Sup M)"
 proof -
   from M obtain m where "m \<in> M" by auto
   have space_eq: "\<And>n. n \<in> M \<Longrightarrow> space n = space m"
     by (intro const_space \<open>m \<in> M\<close>)
   have "f \<in> measurable N (sigma (\<Union>m\<in>M. space m) (\<Union>m\<in>M. sets m))"
   proof (rule measurable_measure_of)
     show "f \<in> space N \<rightarrow> \<Union>(space ` M)"
       using measurable_space[OF f] M by auto
   qed (auto intro: measurable_sets f dest: sets.sets_into_space)
   also have "measurable N (sigma (\<Union>m\<in>M. space m) (\<Union>m\<in>M. sets m)) = measurable N (Sup M)"
     apply (intro measurable_cong_sets refl)
     apply (subst sets_Sup_eq[OF space_eq M])
     apply simp
     apply (subst sets_measure_of[OF UN_space_closed])
     apply (simp add: space_eq M)
     done
   finally show ?thesis .
 qed
 
 lemma measurable_SUP2:
   "I \<noteq> {} \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> f \<in> measurable N (M i)) \<Longrightarrow>
     (\<And>i j. i \<in> I \<Longrightarrow> j \<in> I \<Longrightarrow> space (M i) = space (M j)) \<Longrightarrow> f \<in> measurable N (SUP i\<in>I. M i)"
   by (auto intro!: measurable_Sup2)
 
 lemma sets_Sup_sigma:
   assumes [simp]: "M \<noteq> {}" and M: "\<And>m. m \<in> M \<Longrightarrow> m \<subseteq> Pow \<Omega>"
   shows "sets (SUP m\<in>M. sigma \<Omega> m) = sets (sigma \<Omega> (\<Union>M))"
 proof -
   { fix a m assume "a \<in> sigma_sets \<Omega> m" "m \<in> M"
     then have "a \<in> sigma_sets \<Omega> (\<Union>M)"
      by induction (auto intro: sigma_sets.intros(2-)) }
   then show "sets (SUP m\<in>M. sigma \<Omega> m) = sets (sigma \<Omega> (\<Union>M))"
     apply (subst sets_Sup_eq[where X="\<Omega>"])
     apply (auto simp add: M) []
     apply auto []
     apply (simp add: space_measure_of_conv M Union_least)
     apply (rule sigma_sets_eqI)
     apply auto
     done
 qed
 
 lemma Sup_sigma:
   assumes [simp]: "M \<noteq> {}" and M: "\<And>m. m \<in> M \<Longrightarrow> m \<subseteq> Pow \<Omega>"
   shows "(SUP m\<in>M. sigma \<Omega> m) = (sigma \<Omega> (\<Union>M))"
 proof (intro antisym SUP_least)
   have *: "\<Union>M \<subseteq> Pow \<Omega>"
     using M by auto
   show "sigma \<Omega> (\<Union>M) \<le> (SUP m\<in>M. sigma \<Omega> m)"
   proof (intro less_eq_measure.intros(3))
     show "space (sigma \<Omega> (\<Union>M)) = space (SUP m\<in>M. sigma \<Omega> m)"
       "sets (sigma \<Omega> (\<Union>M)) = sets (SUP m\<in>M. sigma \<Omega> m)"
       using sets_Sup_sigma[OF assms] sets_Sup_sigma[OF assms, THEN sets_eq_imp_space_eq]
       by auto
   qed (simp add: emeasure_sigma le_fun_def)
   fix m assume "m \<in> M" then show "sigma \<Omega> m \<le> sigma \<Omega> (\<Union>M)"
     by (subst sigma_le_iff) (auto simp add: M *)
 qed
 
 lemma SUP_sigma_sigma:
   "M \<noteq> {} \<Longrightarrow> (\<And>m. m \<in> M \<Longrightarrow> f m \<subseteq> Pow \<Omega>) \<Longrightarrow> (SUP m\<in>M. sigma \<Omega> (f m)) = sigma \<Omega> (\<Union>m\<in>M. f m)"
   using Sup_sigma[of "f`M" \<Omega>] by (auto simp: image_comp)
 
 lemma sets_vimage_Sup_eq:
   assumes *: "M \<noteq> {}" "f \<in> X \<rightarrow> Y" "\<And>m. m \<in> M \<Longrightarrow> space m = Y"
   shows "sets (vimage_algebra X f (Sup M)) = sets (SUP m \<in> M. vimage_algebra X f m)"
   (is "?IS = ?SI")
 proof
   show "?IS \<subseteq> ?SI"
     apply (intro sets_image_in_sets measurable_Sup2)
     apply (simp add: space_Sup_eq_UN *)
     apply (simp add: *)
     apply (intro measurable_Sup1)
     apply (rule imageI)
     apply assumption
     apply (rule measurable_vimage_algebra1)
     apply (auto simp: *)
     done
   show "?SI \<subseteq> ?IS"
     apply (intro sets_Sup_in_sets)
     apply (auto simp: *) []
     apply (auto simp: *) []
     apply (elim imageE)
     apply simp
     apply (rule sets_image_in_sets)
     apply simp
     apply (simp add: measurable_def)
     apply (simp add: * space_Sup_eq_UN sets_vimage_algebra2)
     apply (auto intro: in_sets_Sup[OF *(3)])
     done
 qed
 
 lemma restrict_space_eq_vimage_algebra':
   "sets (restrict_space M \<Omega>) = sets (vimage_algebra (\<Omega> \<inter> space M) (\<lambda>x. x) M)"
 proof -
   have *: "{A \<inter> (\<Omega> \<inter> space M) |A. A \<in> sets M} = {A \<inter> \<Omega> |A. A \<in> sets M}"
     using sets.sets_into_space[of _ M] by blast
 
   show ?thesis
     unfolding restrict_space_def
     by (subst sets_measure_of)
        (auto simp add: image_subset_iff sets_vimage_algebra * dest: sets.sets_into_space intro!: arg_cong2[where f=sigma_sets])
 qed
 
 lemma sigma_le_sets:
   assumes [simp]: "A \<subseteq> Pow X" shows "sets (sigma X A) \<subseteq> sets N \<longleftrightarrow> X \<in> sets N \<and> A \<subseteq> sets N"
 proof
   have "X \<in> sigma_sets X A" "A \<subseteq> sigma_sets X A"
     by (auto intro: sigma_sets_top)
   moreover assume "sets (sigma X A) \<subseteq> sets N"
   ultimately show "X \<in> sets N \<and> A \<subseteq> sets N"
     by auto
 next
   assume *: "X \<in> sets N \<and> A \<subseteq> sets N"
   { fix Y assume "Y \<in> sigma_sets X A" from this * have "Y \<in> sets N"
       by induction auto }
   then show "sets (sigma X A) \<subseteq> sets N"
     by auto
 qed
 
 lemma measurable_iff_sets:
   "f \<in> measurable M N \<longleftrightarrow> (f \<in> space M \<rightarrow> space N \<and> sets (vimage_algebra (space M) f N) \<subseteq> sets M)"
 proof -
   have *: "{f -` A \<inter> space M |A. A \<in> sets N} \<subseteq> Pow (space M)"
     by auto
   show ?thesis
     unfolding measurable_def
     by (auto simp add: vimage_algebra_def sigma_le_sets[OF *])
 qed
 
 lemma sets_vimage_algebra_space: "X \<in> sets (vimage_algebra X f M)"
   using sets.top[of "vimage_algebra X f M"] by simp
 
 lemma measurable_mono:
   assumes N: "sets N' \<le> sets N" "space N = space N'"
   assumes M: "sets M \<le> sets M'" "space M = space M'"
   shows "measurable M N \<subseteq> measurable M' N'"
   unfolding measurable_def
 proof safe
   fix f A assume "f \<in> space M \<rightarrow> space N" "A \<in> sets N'"
   moreover assume "\<forall>y\<in>sets N. f -` y \<inter> space M \<in> sets M" note this[THEN bspec, of A]
   ultimately show "f -` A \<inter> space M' \<in> sets M'"
     using assms by auto
 qed (insert N M, auto)
 
 lemma measurable_Sup_measurable:
   assumes f: "f \<in> space N \<rightarrow> A"
   shows "f \<in> measurable N (Sup {M. space M = A \<and> f \<in> measurable N M})"
 proof (rule measurable_Sup2)
   show "{M. space M = A \<and> f \<in> measurable N M} \<noteq> {}"
     using f unfolding ex_in_conv[symmetric]
     by (intro exI[of _ "sigma A {}"]) (auto intro!: measurable_measure_of)
 qed auto
 
 lemma (in sigma_algebra) sigma_sets_subset':
   assumes a: "a \<subseteq> M" "\<Omega>' \<in> M"
   shows "sigma_sets \<Omega>' a \<subseteq> M"
 proof
   show "x \<in> M" if x: "x \<in> sigma_sets \<Omega>' a" for x
     using x by (induct rule: sigma_sets.induct) (insert a, auto)
 qed
 
 lemma in_sets_SUP: "i \<in> I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> space (M i) = Y) \<Longrightarrow> X \<in> sets (M i) \<Longrightarrow> X \<in> sets (SUP i\<in>I. M i)"
   by (intro in_sets_Sup[where X=Y]) auto
 
 lemma measurable_SUP1:
   "i \<in> I \<Longrightarrow> f \<in> measurable (M i) N \<Longrightarrow> (\<And>m n. m \<in> I \<Longrightarrow> n \<in> I \<Longrightarrow> space (M m) = space (M n)) \<Longrightarrow>
     f \<in> measurable (SUP i\<in>I. M i) N"
   by (auto intro: measurable_Sup1)
 
 lemma sets_image_in_sets':
   assumes X: "X \<in> sets N"
   assumes f: "\<And>A. A \<in> sets M \<Longrightarrow> f -` A \<inter> X \<in> sets N"
   shows "sets (vimage_algebra X f M) \<subseteq> sets N"
   unfolding sets_vimage_algebra
   by (rule sets.sigma_sets_subset') (auto intro!: measurable_sets X f)
 
 lemma mono_vimage_algebra:
   "sets M \<le> sets N \<Longrightarrow> sets (vimage_algebra X f M) \<subseteq> sets (vimage_algebra X f N)"
   using sets.top[of "sigma X {f -` A \<inter> X |A. A \<in> sets N}"]
   unfolding vimage_algebra_def
   apply (subst (asm) space_measure_of)
   apply auto []
   apply (subst sigma_le_sets)
   apply auto
   done
 
 lemma mono_restrict_space: "sets M \<le> sets N \<Longrightarrow> sets (restrict_space M X) \<subseteq> sets (restrict_space N X)"
   unfolding sets_restrict_space by (rule image_mono)
 
 lemma sets_eq_bot: "sets M = {{}} \<longleftrightarrow> M = bot"
   apply safe
   apply (intro measure_eqI)
   apply auto
   done
 
 lemma sets_eq_bot2: "{{}} = sets M \<longleftrightarrow> M = bot"
   using sets_eq_bot[of M] by blast
 
 
 lemma (in finite_measure) countable_support:
   "countable {x. measure M {x} \<noteq> 0}"
 proof cases
   assume "measure M (space M) = 0"
   with bounded_measure measure_le_0_iff have "{x. measure M {x} \<noteq> 0} = {}"
     by auto
   then show ?thesis
     by simp
 next
   let ?M = "measure M (space M)" and ?m = "\<lambda>x. measure M {x}"
   assume "?M \<noteq> 0"
   then have *: "{x. ?m x \<noteq> 0} = (\<Union>n. {x. ?M / Suc n < ?m x})"
     using reals_Archimedean[of "?m x / ?M" for x]
     by (auto simp: field_simps not_le[symmetric] divide_le_0_iff measure_le_0_iff)
   have **: "\<And>n. finite {x. ?M / Suc n < ?m x}"
   proof (rule ccontr)
     fix n assume "infinite {x. ?M / Suc n < ?m x}" (is "infinite ?X")
     then obtain X where "finite X" "card X = Suc (Suc n)" "X \<subseteq> ?X"
       by (metis infinite_arbitrarily_large)
     from this(3) have *: "\<And>x. x \<in> X \<Longrightarrow> ?M / Suc n \<le> ?m x"
       by auto
     { fix x assume "x \<in> X"
       from \<open>?M \<noteq> 0\<close> *[OF this] have "?m x \<noteq> 0" by (auto simp: field_simps measure_le_0_iff)
       then have "{x} \<in> sets M" by (auto dest: measure_notin_sets) }
     note singleton_sets = this
     have "?M < (\<Sum>x\<in>X. ?M / Suc n)"
       using \<open>?M \<noteq> 0\<close>
       by (simp add: \<open>card X = Suc (Suc n)\<close> field_simps less_le)
     also have "\<dots> \<le> (\<Sum>x\<in>X. ?m x)"
       by (rule sum_mono) fact
     also have "\<dots> = measure M (\<Union>x\<in>X. {x})"
       using singleton_sets \<open>finite X\<close>
       by (intro finite_measure_finite_Union[symmetric]) (auto simp: disjoint_family_on_def)
     finally have "?M < measure M (\<Union>x\<in>X. {x})" .
     moreover have "measure M (\<Union>x\<in>X. {x}) \<le> ?M"
       using singleton_sets[THEN sets.sets_into_space] by (intro finite_measure_mono) auto
     ultimately show False by simp
   qed
   show ?thesis
     unfolding * by (intro countable_UN countableI_type countable_finite[OF **])
 qed
 
 end
diff --git a/src/HOL/Analysis/Nonnegative_Lebesgue_Integration.thy b/src/HOL/Analysis/Nonnegative_Lebesgue_Integration.thy
--- a/src/HOL/Analysis/Nonnegative_Lebesgue_Integration.thy
+++ b/src/HOL/Analysis/Nonnegative_Lebesgue_Integration.thy
@@ -1,2633 +1,2647 @@
 (*  Title:      HOL/Analysis/Nonnegative_Lebesgue_Integration.thy
     Author:     Johannes Hölzl, TU München
     Author:     Armin Heller, TU München
 *)
 
 section \<open>Lebesgue Integration for Nonnegative Functions\<close>
 
 theory Nonnegative_Lebesgue_Integration
   imports Measure_Space Borel_Space
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Approximating functions\<close>
 
 lemma AE_upper_bound_inf_ennreal:
   fixes F G::"'a \<Rightarrow> ennreal"
   assumes "\<And>e. (e::real) > 0 \<Longrightarrow> AE x in M. F x \<le> G x + e"
   shows "AE x in M. F x \<le> G x"
 proof -
   have "AE x in M. \<forall>n::nat. F x \<le> G x + ennreal (1 / Suc n)"
     using assms by (auto simp: AE_all_countable)
   then show ?thesis
   proof (eventually_elim)
     fix x assume x: "\<forall>n::nat. F x \<le> G x + ennreal (1 / Suc n)"
     show "F x \<le> G x"
     proof (rule ennreal_le_epsilon)
       fix e :: real assume "0 < e"
       then obtain n where n: "1 / Suc n < e"
         by (blast elim: nat_approx_posE)
       have "F x \<le> G x + 1 / Suc n"
         using x by simp
       also have "\<dots> \<le> G x + e"
         using n by (intro add_mono ennreal_leI) auto
       finally show "F x \<le> G x + ennreal e" .
     qed
   qed
 qed
 
 lemma AE_upper_bound_inf:
   fixes F G::"'a \<Rightarrow> real"
   assumes "\<And>e. e > 0 \<Longrightarrow> AE x in M. F x \<le> G x + e"
   shows "AE x in M. F x \<le> G x"
 proof -
   have "AE x in M. F x \<le> G x + 1/real (n+1)" for n::nat
     by (rule assms, auto)
   then have "AE x in M. \<forall>n::nat \<in> UNIV. F x \<le> G x + 1/real (n+1)"
     by (rule AE_ball_countable', auto)
   moreover
   {
     fix x assume i: "\<forall>n::nat \<in> UNIV. F x \<le> G x + 1/real (n+1)"
     have "(\<lambda>n. G x + 1/real (n+1)) \<longlonglongrightarrow> G x + 0"
       by (rule tendsto_add, simp, rule LIMSEQ_ignore_initial_segment[OF lim_1_over_n, of 1])
     then have "F x \<le> G x" using i LIMSEQ_le_const by fastforce
   }
   ultimately show ?thesis by auto
 qed
 
 lemma not_AE_zero_ennreal_E:
   fixes f::"'a \<Rightarrow> ennreal"
   assumes "\<not> (AE x in M. f x = 0)" and [measurable]: "f \<in> borel_measurable M"
   shows "\<exists>A\<in>sets M. \<exists>e::real>0. emeasure M A > 0 \<and> (\<forall>x \<in> A. f x \<ge> e)"
 proof -
   { assume "\<not> (\<exists>e::real>0. {x \<in> space M. f x \<ge> e} \<notin> null_sets M)"
     then have "0 < e \<Longrightarrow> AE x in M. f x \<le> e" for e :: real
       by (auto simp: not_le less_imp_le dest!: AE_not_in)
     then have "AE x in M. f x \<le> 0"
       by (intro AE_upper_bound_inf_ennreal[where G="\<lambda>_. 0"]) simp
     then have False
       using assms by auto }
   then obtain e::real where e: "e > 0" "{x \<in> space M. f x \<ge> e} \<notin> null_sets M" by auto
   define A where "A = {x \<in> space M. f x \<ge> e}"
   have 1 [measurable]: "A \<in> sets M" unfolding A_def by auto
   have 2: "emeasure M A > 0"
     using e(2) A_def \<open>A \<in> sets M\<close> by auto
   have 3: "\<And>x. x \<in> A \<Longrightarrow> f x \<ge> e" unfolding A_def by auto
   show ?thesis using e(1) 1 2 3 by blast
 qed
 
 lemma not_AE_zero_E:
   fixes f::"'a \<Rightarrow> real"
   assumes "AE x in M. f x \<ge> 0"
           "\<not>(AE x in M. f x = 0)"
       and [measurable]: "f \<in> borel_measurable M"
   shows "\<exists>A e. A \<in> sets M \<and> e>0 \<and> emeasure M A > 0 \<and> (\<forall>x \<in> A. f x \<ge> e)"
 proof -
   have "\<exists>e. e > 0 \<and> {x \<in> space M. f x \<ge> e} \<notin> null_sets M"
   proof (rule ccontr)
     assume *: "\<not>(\<exists>e. e > 0 \<and> {x \<in> space M. f x \<ge> e} \<notin> null_sets M)"
     {
       fix e::real assume "e > 0"
       then have "{x \<in> space M. f x \<ge> e} \<in> null_sets M" using * by blast
       then have "AE x in M. x \<notin> {x \<in> space M. f x \<ge> e}" using AE_not_in by blast
       then have "AE x in M. f x \<le> e" by auto
     }
     then have "AE x in M. f x \<le> 0" by (rule AE_upper_bound_inf, auto)
     then have "AE x in M. f x = 0" using assms(1) by auto
     then show False using assms(2) by auto
   qed
   then obtain e where e: "e>0" "{x \<in> space M. f x \<ge> e} \<notin> null_sets M" by auto
   define A where "A = {x \<in> space M. f x \<ge> e}"
   have 1 [measurable]: "A \<in> sets M" unfolding A_def by auto
   have 2: "emeasure M A > 0"
     using e(2) A_def \<open>A \<in> sets M\<close> by auto
   have 3: "\<And>x. x \<in> A \<Longrightarrow> f x \<ge> e" unfolding A_def by auto
   show ?thesis
     using e(1) 1 2 3 by blast
 qed
 
 subsection "Simple function"
 
 text \<open>
 
 Our simple functions are not restricted to nonnegative real numbers. Instead
 they are just functions with a finite range and are measurable when singleton
 sets are measurable.
 
 \<close>
 
 definition\<^marker>\<open>tag important\<close> "simple_function M g \<longleftrightarrow>
     finite (g ` space M) \<and>
     (\<forall>x \<in> g ` space M. g -` {x} \<inter> space M \<in> sets M)"
 
 lemma simple_functionD:
   assumes "simple_function M g"
   shows "finite (g ` space M)" and "g -` X \<inter> space M \<in> sets M"
 proof -
   show "finite (g ` space M)"
     using assms unfolding simple_function_def by auto
   have "g -` X \<inter> space M = g -` (X \<inter> g`space M) \<inter> space M" by auto
   also have "\<dots> = (\<Union>x\<in>X \<inter> g`space M. g-`{x} \<inter> space M)" by auto
   finally show "g -` X \<inter> space M \<in> sets M" using assms
     by (auto simp del: UN_simps simp: simple_function_def)
 qed
 
 lemma measurable_simple_function[measurable_dest]:
   "simple_function M f \<Longrightarrow> f \<in> measurable M (count_space UNIV)"
   unfolding simple_function_def measurable_def
 proof safe
   fix A assume "finite (f ` space M)" "\<forall>x\<in>f ` space M. f -` {x} \<inter> space M \<in> sets M"
   then have "(\<Union>x\<in>f ` space M. if x \<in> A then f -` {x} \<inter> space M else {}) \<in> sets M"
     by (intro sets.finite_UN) auto
   also have "(\<Union>x\<in>f ` space M. if x \<in> A then f -` {x} \<inter> space M else {}) = f -` A \<inter> space M"
     by (auto split: if_split_asm)
   finally show "f -` A \<inter> space M \<in> sets M" .
 qed simp
 
 lemma borel_measurable_simple_function:
   "simple_function M f \<Longrightarrow> f \<in> borel_measurable M"
   by (auto dest!: measurable_simple_function simp: measurable_def)
 
 lemma simple_function_measurable2[intro]:
   assumes "simple_function M f" "simple_function M g"
   shows "f -` A \<inter> g -` B \<inter> space M \<in> sets M"
 proof -
   have "f -` A \<inter> g -` B \<inter> space M = (f -` A \<inter> space M) \<inter> (g -` B \<inter> space M)"
     by auto
   then show ?thesis using assms[THEN simple_functionD(2)] by auto
 qed
 
 lemma simple_function_indicator_representation:
   fixes f ::"'a \<Rightarrow> ennreal"
   assumes f: "simple_function M f" and x: "x \<in> space M"
   shows "f x = (\<Sum>y \<in> f ` space M. y * indicator (f -` {y} \<inter> space M) x)"
   (is "?l = ?r")
 proof -
   have "?r = (\<Sum>y \<in> f ` space M.
     (if y = f x then y * indicator (f -` {y} \<inter> space M) x else 0))"
     by (auto intro!: sum.cong)
   also have "... =  f x *  indicator (f -` {f x} \<inter> space M) x"
     using assms by (auto dest: simple_functionD)
   also have "... = f x" using x by (auto simp: indicator_def)
   finally show ?thesis by auto
 qed
 
 lemma simple_function_notspace:
   "simple_function M (\<lambda>x. h x * indicator (- space M) x::ennreal)" (is "simple_function M ?h")
 proof -
   have "?h ` space M \<subseteq> {0}" unfolding indicator_def by auto
   hence [simp, intro]: "finite (?h ` space M)" by (auto intro: finite_subset)
   have "?h -` {0} \<inter> space M = space M" by auto
   thus ?thesis unfolding simple_function_def by (auto simp add: image_constant_conv)
 qed
 
 lemma simple_function_cong:
   assumes "\<And>t. t \<in> space M \<Longrightarrow> f t = g t"
   shows "simple_function M f \<longleftrightarrow> simple_function M g"
 proof -
   have "\<And>x. f -` {x} \<inter> space M = g -` {x} \<inter> space M"
     using assms by auto
   with assms show ?thesis
     by (simp add: simple_function_def cong: image_cong)
 qed
 
 lemma simple_function_cong_algebra:
   assumes "sets N = sets M" "space N = space M"
   shows "simple_function M f \<longleftrightarrow> simple_function N f"
   unfolding simple_function_def assms ..
 
 lemma simple_function_borel_measurable:
   fixes f :: "'a \<Rightarrow> 'x::{t2_space}"
   assumes "f \<in> borel_measurable M" and "finite (f ` space M)"
   shows "simple_function M f"
   using assms unfolding simple_function_def
   by (auto intro: borel_measurable_vimage)
 
 lemma simple_function_iff_borel_measurable:
   fixes f :: "'a \<Rightarrow> 'x::{t2_space}"
   shows "simple_function M f \<longleftrightarrow> finite (f ` space M) \<and> f \<in> borel_measurable M"
   by (metis borel_measurable_simple_function simple_functionD(1) simple_function_borel_measurable)
 
 lemma simple_function_eq_measurable:
   "simple_function M f \<longleftrightarrow> finite (f`space M) \<and> f \<in> measurable M (count_space UNIV)"
   using measurable_simple_function[of M f] by (fastforce simp: simple_function_def)
 
 lemma simple_function_const[intro, simp]:
   "simple_function M (\<lambda>x. c)"
   by (auto intro: finite_subset simp: simple_function_def)
 lemma simple_function_compose[intro, simp]:
   assumes "simple_function M f"
   shows "simple_function M (g \<circ> f)"
   unfolding simple_function_def
 proof safe
   show "finite ((g \<circ> f) ` space M)"
     using assms unfolding simple_function_def image_comp [symmetric] by auto
 next
   fix x assume "x \<in> space M"
   let ?G = "g -` {g (f x)} \<inter> (f`space M)"
   have *: "(g \<circ> f) -` {(g \<circ> f) x} \<inter> space M =
     (\<Union>x\<in>?G. f -` {x} \<inter> space M)" by auto
   show "(g \<circ> f) -` {(g \<circ> f) x} \<inter> space M \<in> sets M"
     using assms unfolding simple_function_def *
     by (rule_tac sets.finite_UN) auto
 qed
 
 lemma simple_function_indicator[intro, simp]:
   assumes "A \<in> sets M"
   shows "simple_function M (indicator A)"
 proof -
   have "indicator A ` space M \<subseteq> {0, 1}" (is "?S \<subseteq> _")
     by (auto simp: indicator_def)
   hence "finite ?S" by (rule finite_subset) simp
   moreover have "- A \<inter> space M = space M - A" by auto
   ultimately show ?thesis unfolding simple_function_def
     using assms by (auto simp: indicator_def [abs_def])
 qed
 
 lemma simple_function_Pair[intro, simp]:
   assumes "simple_function M f"
   assumes "simple_function M g"
   shows "simple_function M (\<lambda>x. (f x, g x))" (is "simple_function M ?p")
   unfolding simple_function_def
 proof safe
   show "finite (?p ` space M)"
     using assms unfolding simple_function_def
     by (rule_tac finite_subset[of _ "f`space M \<times> g`space M"]) auto
 next
   fix x assume "x \<in> space M"
   have "(\<lambda>x. (f x, g x)) -` {(f x, g x)} \<inter> space M =
       (f -` {f x} \<inter> space M) \<inter> (g -` {g x} \<inter> space M)"
     by auto
   with \<open>x \<in> space M\<close> show "(\<lambda>x. (f x, g x)) -` {(f x, g x)} \<inter> space M \<in> sets M"
     using assms unfolding simple_function_def by auto
 qed
 
 lemma simple_function_compose1:
   assumes "simple_function M f"
   shows "simple_function M (\<lambda>x. g (f x))"
   using simple_function_compose[OF assms, of g]
   by (simp add: comp_def)
 
 lemma simple_function_compose2:
   assumes "simple_function M f" and "simple_function M g"
   shows "simple_function M (\<lambda>x. h (f x) (g x))"
 proof -
   have "simple_function M ((\<lambda>(x, y). h x y) \<circ> (\<lambda>x. (f x, g x)))"
     using assms by auto
   thus ?thesis by (simp_all add: comp_def)
 qed
 
 lemmas simple_function_add[intro, simp] = simple_function_compose2[where h="(+)"]
   and simple_function_diff[intro, simp] = simple_function_compose2[where h="(-)"]
   and simple_function_uminus[intro, simp] = simple_function_compose[where g="uminus"]
   and simple_function_mult[intro, simp] = simple_function_compose2[where h="(*)"]
   and simple_function_div[intro, simp] = simple_function_compose2[where h="(/)"]
   and simple_function_inverse[intro, simp] = simple_function_compose[where g="inverse"]
   and simple_function_max[intro, simp] = simple_function_compose2[where h=max]
 
 lemma simple_function_sum[intro, simp]:
   assumes "\<And>i. i \<in> P \<Longrightarrow> simple_function M (f i)"
   shows "simple_function M (\<lambda>x. \<Sum>i\<in>P. f i x)"
 proof cases
   assume "finite P" from this assms show ?thesis by induct auto
 qed auto
 
 lemma simple_function_ennreal[intro, simp]:
   fixes f g :: "'a \<Rightarrow> real" assumes sf: "simple_function M f"
   shows "simple_function M (\<lambda>x. ennreal (f x))"
   by (rule simple_function_compose1[OF sf])
 
 lemma simple_function_real_of_nat[intro, simp]:
   fixes f g :: "'a \<Rightarrow> nat" assumes sf: "simple_function M f"
   shows "simple_function M (\<lambda>x. real (f x))"
   by (rule simple_function_compose1[OF sf])
 
 lemma\<^marker>\<open>tag important\<close> borel_measurable_implies_simple_function_sequence:
   fixes u :: "'a \<Rightarrow> ennreal"
   assumes u[measurable]: "u \<in> borel_measurable M"
   shows "\<exists>f. incseq f \<and> (\<forall>i. (\<forall>x. f i x < top) \<and> simple_function M (f i)) \<and> u = (SUP i. f i)"
 proof -
   define f where [abs_def]:
     "f i x = real_of_int (floor (enn2real (min i (u x)) * 2^i)) / 2^i" for i x
 
   have [simp]: "0 \<le> f i x" for i x
     by (auto simp: f_def intro!: divide_nonneg_nonneg mult_nonneg_nonneg enn2real_nonneg)
 
   have *: "2^n * real_of_int x = real_of_int (2^n * x)" for n x
     by simp
 
   have "real_of_int \<lfloor>real i * 2 ^ i\<rfloor> = real_of_int \<lfloor>i * 2 ^ i\<rfloor>" for i
     by (intro arg_cong[where f=real_of_int]) simp
   then have [simp]: "real_of_int \<lfloor>real i * 2 ^ i\<rfloor> = i * 2 ^ i" for i
     unfolding floor_of_nat by simp
 
   have "incseq f"
   proof (intro monoI le_funI)
     fix m n :: nat and x assume "m \<le> n"
     moreover
     { fix d :: nat
       have "\<lfloor>2^d::real\<rfloor> * \<lfloor>2^m * enn2real (min (of_nat m) (u x))\<rfloor> \<le>
         \<lfloor>2^d * (2^m * enn2real (min (of_nat m) (u x)))\<rfloor>"
         by (rule le_mult_floor) (auto)
       also have "\<dots> \<le> \<lfloor>2^d * (2^m * enn2real (min (of_nat d + of_nat m) (u x)))\<rfloor>"
         by (intro floor_mono mult_mono enn2real_mono min.mono)
            (auto simp: min_less_iff_disj of_nat_less_top)
       finally have "f m x \<le> f (m + d) x"
         unfolding f_def
         by (auto simp: field_simps power_add * simp del: of_int_mult) }
     ultimately show "f m x \<le> f n x"
       by (auto simp add: le_iff_add)
   qed
   then have inc_f: "incseq (\<lambda>i. ennreal (f i x))" for x
     by (auto simp: incseq_def le_fun_def)
   then have "incseq (\<lambda>i x. ennreal (f i x))"
     by (auto simp: incseq_def le_fun_def)
   moreover
   have "simple_function M (f i)" for i
   proof (rule simple_function_borel_measurable)
     have "\<lfloor>enn2real (min (of_nat i) (u x)) * 2 ^ i\<rfloor> \<le> \<lfloor>int i * 2 ^ i\<rfloor>" for x
       by (cases "u x" rule: ennreal_cases)
          (auto split: split_min intro!: floor_mono)
     then have "f i ` space M \<subseteq> (\<lambda>n. real_of_int n / 2^i) ` {0 .. of_nat i * 2^i}"
       unfolding floor_of_int by (auto simp: f_def intro!: imageI)
     then show "finite (f i ` space M)"
       by (rule finite_subset) auto
     show "f i \<in> borel_measurable M"
       unfolding f_def enn2real_def by measurable
   qed
   moreover
   { fix x
     have "(SUP i. ennreal (f i x)) = u x"
     proof (cases "u x" rule: ennreal_cases)
       case top then show ?thesis
         by (simp add: f_def inf_min[symmetric] ennreal_of_nat_eq_real_of_nat[symmetric]
                       ennreal_SUP_of_nat_eq_top)
     next
       case (real r)
       obtain n where "r \<le> of_nat n" using real_arch_simple by auto
       then have min_eq_r: "\<forall>\<^sub>F x in sequentially. min (real x) r = r"
         by (auto simp: eventually_sequentially intro!: exI[of _ n] split: split_min)
 
       have "(\<lambda>i. real_of_int \<lfloor>min (real i) r * 2^i\<rfloor> / 2^i) \<longlonglongrightarrow> r"
       proof (rule tendsto_sandwich)
         show "(\<lambda>n. r - (1/2)^n) \<longlonglongrightarrow> r"
           by (auto intro!: tendsto_eq_intros LIMSEQ_power_zero)
         show "\<forall>\<^sub>F n in sequentially. real_of_int \<lfloor>min (real n) r * 2 ^ n\<rfloor> / 2 ^ n \<le> r"
           using min_eq_r by eventually_elim (auto simp: field_simps)
         have *: "r * (2 ^ n * 2 ^ n) \<le> 2^n + 2^n * real_of_int \<lfloor>r * 2 ^ n\<rfloor>" for n
           using real_of_int_floor_ge_diff_one[of "r * 2^n", THEN mult_left_mono, of "2^n"]
           by (auto simp: field_simps)
         show "\<forall>\<^sub>F n in sequentially. r - (1/2)^n \<le> real_of_int \<lfloor>min (real n) r * 2 ^ n\<rfloor> / 2 ^ n"
           using min_eq_r by eventually_elim (insert *, auto simp: field_simps)
       qed auto
       then have "(\<lambda>i. ennreal (f i x)) \<longlonglongrightarrow> ennreal r"
         by (simp add: real f_def ennreal_of_nat_eq_real_of_nat min_ennreal)
       from LIMSEQ_unique[OF LIMSEQ_SUP[OF inc_f] this]
       show ?thesis
         by (simp add: real)
     qed }
   ultimately show ?thesis
     by (intro exI [of _ "\<lambda>i x. ennreal (f i x)"]) (auto simp add: image_comp)
 qed
 
 lemma borel_measurable_implies_simple_function_sequence':
   fixes u :: "'a \<Rightarrow> ennreal"
   assumes u: "u \<in> borel_measurable M"
   obtains f where
     "\<And>i. simple_function M (f i)" "incseq f" "\<And>i x. f i x < top" "\<And>x. (SUP i. f i x) = u x"
   using borel_measurable_implies_simple_function_sequence [OF u]
   by (metis SUP_apply)
 
 lemma\<^marker>\<open>tag important\<close> simple_function_induct
     [consumes 1, case_names cong set mult add, induct set: simple_function]:
   fixes u :: "'a \<Rightarrow> ennreal"
   assumes u: "simple_function M u"
   assumes cong: "\<And>f g. simple_function M f \<Longrightarrow> simple_function M g \<Longrightarrow> (AE x in M. f x = g x) \<Longrightarrow> P f \<Longrightarrow> P g"
   assumes set: "\<And>A. A \<in> sets M \<Longrightarrow> P (indicator A)"
   assumes mult: "\<And>u c. P u \<Longrightarrow> P (\<lambda>x. c * u x)"
   assumes add: "\<And>u v. P u \<Longrightarrow> P v \<Longrightarrow> P (\<lambda>x. v x + u x)"
   shows "P u"
 proof (rule cong)
   from AE_space show "AE x in M. (\<Sum>y\<in>u ` space M. y * indicator (u -` {y} \<inter> space M) x) = u x"
   proof eventually_elim
     fix x assume x: "x \<in> space M"
     from simple_function_indicator_representation[OF u x]
     show "(\<Sum>y\<in>u ` space M. y * indicator (u -` {y} \<inter> space M) x) = u x" ..
   qed
 next
   from u have "finite (u ` space M)"
     unfolding simple_function_def by auto
   then show "P (\<lambda>x. \<Sum>y\<in>u ` space M. y * indicator (u -` {y} \<inter> space M) x)"
   proof induct
     case empty show ?case
       using set[of "{}"] by (simp add: indicator_def[abs_def])
   qed (auto intro!: add mult set simple_functionD u)
 next
   show "simple_function M (\<lambda>x. (\<Sum>y\<in>u ` space M. y * indicator (u -` {y} \<inter> space M) x))"
     apply (subst simple_function_cong)
     apply (rule simple_function_indicator_representation[symmetric])
     apply (auto intro: u)
     done
 qed fact
 
 lemma simple_function_induct_nn[consumes 1, case_names cong set mult add]:
   fixes u :: "'a \<Rightarrow> ennreal"
   assumes u: "simple_function M u"
   assumes cong: "\<And>f g. simple_function M f \<Longrightarrow> simple_function M g \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> f x = g x) \<Longrightarrow> P f \<Longrightarrow> P g"
   assumes set: "\<And>A. A \<in> sets M \<Longrightarrow> P (indicator A)"
   assumes mult: "\<And>u c. simple_function M u \<Longrightarrow> P u \<Longrightarrow> P (\<lambda>x. c * u x)"
   assumes add: "\<And>u v. simple_function M u \<Longrightarrow> P u \<Longrightarrow> simple_function M v \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> u x = 0 \<or> v x = 0) \<Longrightarrow> P v \<Longrightarrow> P (\<lambda>x. v x + u x)"
   shows "P u"
 proof -
   show ?thesis
   proof (rule cong)
     fix x assume x: "x \<in> space M"
     from simple_function_indicator_representation[OF u x]
     show "(\<Sum>y\<in>u ` space M. y * indicator (u -` {y} \<inter> space M) x) = u x" ..
   next
     show "simple_function M (\<lambda>x. (\<Sum>y\<in>u ` space M. y * indicator (u -` {y} \<inter> space M) x))"
       apply (subst simple_function_cong)
       apply (rule simple_function_indicator_representation[symmetric])
       apply (auto intro: u)
       done
   next
     from u have "finite (u ` space M)"
       unfolding simple_function_def by auto
     then show "P (\<lambda>x. \<Sum>y\<in>u ` space M. y * indicator (u -` {y} \<inter> space M) x)"
     proof induct
       case empty show ?case
         using set[of "{}"] by (simp add: indicator_def[abs_def])
     next
       case (insert x S)
       { fix z have "(\<Sum>y\<in>S. y * indicator (u -` {y} \<inter> space M) z) = 0 \<or>
           x * indicator (u -` {x} \<inter> space M) z = 0"
           using insert by (subst sum_eq_0_iff) (auto simp: indicator_def) }
       note disj = this
       from insert show ?case
         by (auto intro!: add mult set simple_functionD u simple_function_sum disj)
     qed
   qed fact
 qed
 
 lemma\<^marker>\<open>tag important\<close> borel_measurable_induct
     [consumes 1, case_names cong set mult add seq, induct set: borel_measurable]:
   fixes u :: "'a \<Rightarrow> ennreal"
   assumes u: "u \<in> borel_measurable M"
   assumes cong: "\<And>f g. f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> f x = g x) \<Longrightarrow> P g \<Longrightarrow> P f"
   assumes set: "\<And>A. A \<in> sets M \<Longrightarrow> P (indicator A)"
   assumes mult': "\<And>u c. c < top \<Longrightarrow> u \<in> borel_measurable M \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> u x < top) \<Longrightarrow> P u \<Longrightarrow> P (\<lambda>x. c * u x)"
   assumes add: "\<And>u v. u \<in> borel_measurable M\<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> u x < top) \<Longrightarrow> P u \<Longrightarrow> v \<in> borel_measurable M \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> v x < top) \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> u x = 0 \<or> v x = 0) \<Longrightarrow> P v \<Longrightarrow> P (\<lambda>x. v x + u x)"
   assumes seq: "\<And>U. (\<And>i. U i \<in> borel_measurable M) \<Longrightarrow> (\<And>i x. x \<in> space M \<Longrightarrow> U i x < top) \<Longrightarrow> (\<And>i. P (U i)) \<Longrightarrow> incseq U \<Longrightarrow> u = (SUP i. U i) \<Longrightarrow> P (SUP i. U i)"
   shows "P u"
   using u
 proof (induct rule: borel_measurable_implies_simple_function_sequence')
   fix U assume U: "\<And>i. simple_function M (U i)" "incseq U" "\<And>i x. U i x < top" and sup: "\<And>x. (SUP i. U i x) = u x"
   have u_eq: "u = (SUP i. U i)"
     using u by (auto simp add: image_comp sup)
 
   have not_inf: "\<And>x i. x \<in> space M \<Longrightarrow> U i x < top"
     using U by (auto simp: image_iff eq_commute)
 
   from U have "\<And>i. U i \<in> borel_measurable M"
     by (simp add: borel_measurable_simple_function)
 
   show "P u"
     unfolding u_eq
   proof (rule seq)
     fix i show "P (U i)"
       using \<open>simple_function M (U i)\<close> not_inf[of _ i]
     proof (induct rule: simple_function_induct_nn)
       case (mult u c)
       show ?case
       proof cases
         assume "c = 0 \<or> space M = {} \<or> (\<forall>x\<in>space M. u x = 0)"
         with mult(1) show ?thesis
           by (intro cong[of "\<lambda>x. c * u x" "indicator {}"] set)
              (auto dest!: borel_measurable_simple_function)
       next
         assume "\<not> (c = 0 \<or> space M = {} \<or> (\<forall>x\<in>space M. u x = 0))"
         then obtain x where "space M \<noteq> {}" and x: "x \<in> space M" "u x \<noteq> 0" "c \<noteq> 0"
           by auto
         with mult(3)[of x] have "c < top"
           by (auto simp: ennreal_mult_less_top)
         then have u_fin: "x' \<in> space M \<Longrightarrow> u x' < top" for x'
           using mult(3)[of x'] \<open>c \<noteq> 0\<close> by (auto simp: ennreal_mult_less_top)
         then have "P u"
           by (rule mult)
         with u_fin \<open>c < top\<close> mult(1) show ?thesis
           by (intro mult') (auto dest!: borel_measurable_simple_function)
       qed
     qed (auto intro: cong intro!: set add dest!: borel_measurable_simple_function)
   qed fact+
 qed
 
 lemma simple_function_If_set:
   assumes sf: "simple_function M f" "simple_function M g" and A: "A \<inter> space M \<in> sets M"
   shows "simple_function M (\<lambda>x. if x \<in> A then f x else g x)" (is "simple_function M ?IF")
 proof -
   define F where "F x = f -` {x} \<inter> space M" for x
   define G where "G x = g -` {x} \<inter> space M" for x
   show ?thesis unfolding simple_function_def
   proof safe
     have "?IF ` space M \<subseteq> f ` space M \<union> g ` space M" by auto
     from finite_subset[OF this] assms
     show "finite (?IF ` space M)" unfolding simple_function_def by auto
   next
     fix x assume "x \<in> space M"
     then have *: "?IF -` {?IF x} \<inter> space M = (if x \<in> A
       then ((F (f x) \<inter> (A \<inter> space M)) \<union> (G (f x) - (G (f x) \<inter> (A \<inter> space M))))
       else ((F (g x) \<inter> (A \<inter> space M)) \<union> (G (g x) - (G (g x) \<inter> (A \<inter> space M)))))"
       using sets.sets_into_space[OF A] by (auto split: if_split_asm simp: G_def F_def)
     have [intro]: "\<And>x. F x \<in> sets M" "\<And>x. G x \<in> sets M"
       unfolding F_def G_def using sf[THEN simple_functionD(2)] by auto
     show "?IF -` {?IF x} \<inter> space M \<in> sets M" unfolding * using A by auto
   qed
 qed
 
 lemma simple_function_If:
   assumes sf: "simple_function M f" "simple_function M g" and P: "{x\<in>space M. P x} \<in> sets M"
   shows "simple_function M (\<lambda>x. if P x then f x else g x)"
 proof -
   have "{x\<in>space M. P x} = {x. P x} \<inter> space M" by auto
   with simple_function_If_set[OF sf, of "{x. P x}"] P show ?thesis by simp
 qed
 
 lemma simple_function_subalgebra:
   assumes "simple_function N f"
   and N_subalgebra: "sets N \<subseteq> sets M" "space N = space M"
   shows "simple_function M f"
   using assms unfolding simple_function_def by auto
 
 lemma simple_function_comp:
   assumes T: "T \<in> measurable M M'"
     and f: "simple_function M' f"
   shows "simple_function M (\<lambda>x. f (T x))"
 proof (intro simple_function_def[THEN iffD2] conjI ballI)
   have "(\<lambda>x. f (T x)) ` space M \<subseteq> f ` space M'"
     using T unfolding measurable_def by auto
   then show "finite ((\<lambda>x. f (T x)) ` space M)"
     using f unfolding simple_function_def by (auto intro: finite_subset)
   fix i assume i: "i \<in> (\<lambda>x. f (T x)) ` space M"
   then have "i \<in> f ` space M'"
     using T unfolding measurable_def by auto
   then have "f -` {i} \<inter> space M' \<in> sets M'"
     using f unfolding simple_function_def by auto
   then have "T -` (f -` {i} \<inter> space M') \<inter> space M \<in> sets M"
     using T unfolding measurable_def by auto
   also have "T -` (f -` {i} \<inter> space M') \<inter> space M = (\<lambda>x. f (T x)) -` {i} \<inter> space M"
     using T unfolding measurable_def by auto
   finally show "(\<lambda>x. f (T x)) -` {i} \<inter> space M \<in> sets M" .
 qed
 
 subsection "Simple integral"
 
 definition\<^marker>\<open>tag important\<close> simple_integral :: "'a measure \<Rightarrow> ('a \<Rightarrow> ennreal) \<Rightarrow> ennreal" ("integral\<^sup>S") where
   "integral\<^sup>S M f = (\<Sum>x \<in> f ` space M. x * emeasure M (f -` {x} \<inter> space M))"
 
 syntax
   "_simple_integral" :: "pttrn \<Rightarrow> ennreal \<Rightarrow> 'a measure \<Rightarrow> ennreal" ("\<integral>\<^sup>S _. _ \<partial>_" [60,61] 110)
 
 translations
   "\<integral>\<^sup>S x. f \<partial>M" == "CONST simple_integral M (%x. f)"
 
 lemma simple_integral_cong:
   assumes "\<And>t. t \<in> space M \<Longrightarrow> f t = g t"
   shows "integral\<^sup>S M f = integral\<^sup>S M g"
 proof -
   have "f ` space M = g ` space M"
     "\<And>x. f -` {x} \<inter> space M = g -` {x} \<inter> space M"
     using assms by (auto intro!: image_eqI)
   thus ?thesis unfolding simple_integral_def by simp
 qed
 
 lemma simple_integral_const[simp]:
   "(\<integral>\<^sup>Sx. c \<partial>M) = c * (emeasure M) (space M)"
 proof (cases "space M = {}")
   case True thus ?thesis unfolding simple_integral_def by simp
 next
   case False hence "(\<lambda>x. c) ` space M = {c}" by auto
   thus ?thesis unfolding simple_integral_def by simp
 qed
 
 lemma simple_function_partition:
   assumes f: "simple_function M f" and g: "simple_function M g"
   assumes sub: "\<And>x y. x \<in> space M \<Longrightarrow> y \<in> space M \<Longrightarrow> g x = g y \<Longrightarrow> f x = f y"
   assumes v: "\<And>x. x \<in> space M \<Longrightarrow> f x = v (g x)"
   shows "integral\<^sup>S M f = (\<Sum>y\<in>g ` space M. v y * emeasure M {x\<in>space M. g x = y})"
     (is "_ = ?r")
 proof -
   from f g have [simp]: "finite (f`space M)" "finite (g`space M)"
     by (auto simp: simple_function_def)
   from f g have [measurable]: "f \<in> measurable M (count_space UNIV)" "g \<in> measurable M (count_space UNIV)"
     by (auto intro: measurable_simple_function)
 
   { fix y assume "y \<in> space M"
     then have "f ` space M \<inter> {i. \<exists>x\<in>space M. i = f x \<and> g y = g x} = {v (g y)}"
       by (auto cong: sub simp: v[symmetric]) }
   note eq = this
 
   have "integral\<^sup>S M f =
     (\<Sum>y\<in>f`space M. y * (\<Sum>z\<in>g`space M.
       if \<exists>x\<in>space M. y = f x \<and> z = g x then emeasure M {x\<in>space M. g x = z} else 0))"
     unfolding simple_integral_def
   proof (safe intro!: sum.cong ennreal_mult_left_cong)
     fix y assume y: "y \<in> space M" "f y \<noteq> 0"
     have [simp]: "g ` space M \<inter> {z. \<exists>x\<in>space M. f y = f x \<and> z = g x} =
         {z. \<exists>x\<in>space M. f y = f x \<and> z = g x}"
       by auto
     have eq:"(\<Union>i\<in>{z. \<exists>x\<in>space M. f y = f x \<and> z = g x}. {x \<in> space M. g x = i}) =
         f -` {f y} \<inter> space M"
       by (auto simp: eq_commute cong: sub rev_conj_cong)
     have "finite (g`space M)" by simp
     then have "finite {z. \<exists>x\<in>space M. f y = f x \<and> z = g x}"
       by (rule rev_finite_subset) auto
     then show "emeasure M (f -` {f y} \<inter> space M) =
       (\<Sum>z\<in>g ` space M. if \<exists>x\<in>space M. f y = f x \<and> z = g x then emeasure M {x \<in> space M. g x = z} else 0)"
       apply (simp add: sum.If_cases)
       apply (subst sum_emeasure)
       apply (auto simp: disjoint_family_on_def eq)
       done
   qed
   also have "\<dots> = (\<Sum>y\<in>f`space M. (\<Sum>z\<in>g`space M.
       if \<exists>x\<in>space M. y = f x \<and> z = g x then y * emeasure M {x\<in>space M. g x = z} else 0))"
     by (auto intro!: sum.cong simp: sum_distrib_left)
   also have "\<dots> = ?r"
     by (subst sum.swap)
        (auto intro!: sum.cong simp: sum.If_cases scaleR_sum_right[symmetric] eq)
   finally show "integral\<^sup>S M f = ?r" .
 qed
 
 lemma simple_integral_add[simp]:
   assumes f: "simple_function M f" and "\<And>x. 0 \<le> f x" and g: "simple_function M g" and "\<And>x. 0 \<le> g x"
   shows "(\<integral>\<^sup>Sx. f x + g x \<partial>M) = integral\<^sup>S M f + integral\<^sup>S M g"
 proof -
   have "(\<integral>\<^sup>Sx. f x + g x \<partial>M) =
     (\<Sum>y\<in>(\<lambda>x. (f x, g x))`space M. (fst y + snd y) * emeasure M {x\<in>space M. (f x, g x) = y})"
     by (intro simple_function_partition) (auto intro: f g)
   also have "\<dots> = (\<Sum>y\<in>(\<lambda>x. (f x, g x))`space M. fst y * emeasure M {x\<in>space M. (f x, g x) = y}) +
     (\<Sum>y\<in>(\<lambda>x. (f x, g x))`space M. snd y * emeasure M {x\<in>space M. (f x, g x) = y})"
     using assms(2,4) by (auto intro!: sum.cong distrib_right simp: sum.distrib[symmetric])
   also have "(\<Sum>y\<in>(\<lambda>x. (f x, g x))`space M. fst y * emeasure M {x\<in>space M. (f x, g x) = y}) = (\<integral>\<^sup>Sx. f x \<partial>M)"
     by (intro simple_function_partition[symmetric]) (auto intro: f g)
   also have "(\<Sum>y\<in>(\<lambda>x. (f x, g x))`space M. snd y * emeasure M {x\<in>space M. (f x, g x) = y}) = (\<integral>\<^sup>Sx. g x \<partial>M)"
     by (intro simple_function_partition[symmetric]) (auto intro: f g)
   finally show ?thesis .
 qed
 
 lemma simple_integral_sum[simp]:
   assumes "\<And>i x. i \<in> P \<Longrightarrow> 0 \<le> f i x"
   assumes "\<And>i. i \<in> P \<Longrightarrow> simple_function M (f i)"
   shows "(\<integral>\<^sup>Sx. (\<Sum>i\<in>P. f i x) \<partial>M) = (\<Sum>i\<in>P. integral\<^sup>S M (f i))"
 proof cases
   assume "finite P"
   from this assms show ?thesis
     by induct (auto)
 qed auto
 
 lemma simple_integral_mult[simp]:
   assumes f: "simple_function M f"
   shows "(\<integral>\<^sup>Sx. c * f x \<partial>M) = c * integral\<^sup>S M f"
 proof -
   have "(\<integral>\<^sup>Sx. c * f x \<partial>M) = (\<Sum>y\<in>f ` space M. (c * y) * emeasure M {x\<in>space M. f x = y})"
     using f by (intro simple_function_partition) auto
   also have "\<dots> = c * integral\<^sup>S M f"
     using f unfolding simple_integral_def
     by (subst sum_distrib_left) (auto simp: mult.assoc Int_def conj_commute)
   finally show ?thesis .
 qed
 
 lemma simple_integral_mono_AE:
   assumes f[measurable]: "simple_function M f" and g[measurable]: "simple_function M g"
   and mono: "AE x in M. f x \<le> g x"
   shows "integral\<^sup>S M f \<le> integral\<^sup>S M g"
 proof -
   let ?\<mu> = "\<lambda>P. emeasure M {x\<in>space M. P x}"
   have "integral\<^sup>S M f = (\<Sum>y\<in>(\<lambda>x. (f x, g x))`space M. fst y * ?\<mu> (\<lambda>x. (f x, g x) = y))"
     using f g by (intro simple_function_partition) auto
   also have "\<dots> \<le> (\<Sum>y\<in>(\<lambda>x. (f x, g x))`space M. snd y * ?\<mu> (\<lambda>x. (f x, g x) = y))"
   proof (clarsimp intro!: sum_mono)
     fix x assume "x \<in> space M"
     let ?M = "?\<mu> (\<lambda>y. f y = f x \<and> g y = g x)"
     show "f x * ?M \<le> g x * ?M"
     proof cases
       assume "?M \<noteq> 0"
       then have "0 < ?M"
         by (simp add: less_le)
       also have "\<dots> \<le> ?\<mu> (\<lambda>y. f x \<le> g x)"
         using mono by (intro emeasure_mono_AE) auto
       finally have "\<not> \<not> f x \<le> g x"
         by (intro notI) auto
       then show ?thesis
         by (intro mult_right_mono) auto
     qed simp
   qed
   also have "\<dots> = integral\<^sup>S M g"
     using f g by (intro simple_function_partition[symmetric]) auto
   finally show ?thesis .
 qed
 
 lemma simple_integral_mono:
   assumes "simple_function M f" and "simple_function M g"
   and mono: "\<And> x. x \<in> space M \<Longrightarrow> f x \<le> g x"
   shows "integral\<^sup>S M f \<le> integral\<^sup>S M g"
   using assms by (intro simple_integral_mono_AE) auto
 
 lemma simple_integral_cong_AE:
   assumes "simple_function M f" and "simple_function M g"
   and "AE x in M. f x = g x"
   shows "integral\<^sup>S M f = integral\<^sup>S M g"
   using assms by (auto simp: eq_iff intro!: simple_integral_mono_AE)
 
 lemma simple_integral_cong':
   assumes sf: "simple_function M f" "simple_function M g"
   and mea: "(emeasure M) {x\<in>space M. f x \<noteq> g x} = 0"
   shows "integral\<^sup>S M f = integral\<^sup>S M g"
 proof (intro simple_integral_cong_AE sf AE_I)
   show "(emeasure M) {x\<in>space M. f x \<noteq> g x} = 0" by fact
   show "{x \<in> space M. f x \<noteq> g x} \<in> sets M"
     using sf[THEN borel_measurable_simple_function] by auto
 qed simp
 
 lemma simple_integral_indicator:
   assumes A: "A \<in> sets M"
   assumes f: "simple_function M f"
   shows "(\<integral>\<^sup>Sx. f x * indicator A x \<partial>M) =
     (\<Sum>x \<in> f ` space M. x * emeasure M (f -` {x} \<inter> space M \<inter> A))"
 proof -
   have eq: "(\<lambda>x. (f x, indicator A x)) ` space M \<inter> {x. snd x = 1} = (\<lambda>x. (f x, 1::ennreal))`A"
     using A[THEN sets.sets_into_space] by (auto simp: indicator_def image_iff split: if_split_asm)
   have eq2: "\<And>x. f x \<notin> f ` A \<Longrightarrow> f -` {f x} \<inter> space M \<inter> A = {}"
     by (auto simp: image_iff)
 
   have "(\<integral>\<^sup>Sx. f x * indicator A x \<partial>M) =
     (\<Sum>y\<in>(\<lambda>x. (f x, indicator A x))`space M. (fst y * snd y) * emeasure M {x\<in>space M. (f x, indicator A x) = y})"
     using assms by (intro simple_function_partition) auto
   also have "\<dots> = (\<Sum>y\<in>(\<lambda>x. (f x, indicator A x::ennreal))`space M.
     if snd y = 1 then fst y * emeasure M (f -` {fst y} \<inter> space M \<inter> A) else 0)"
     by (auto simp: indicator_def split: if_split_asm intro!: arg_cong2[where f="(*)"] arg_cong2[where f=emeasure] sum.cong)
   also have "\<dots> = (\<Sum>y\<in>(\<lambda>x. (f x, 1::ennreal))`A. fst y * emeasure M (f -` {fst y} \<inter> space M \<inter> A))"
     using assms by (subst sum.If_cases) (auto intro!: simple_functionD(1) simp: eq)
   also have "\<dots> = (\<Sum>y\<in>fst`(\<lambda>x. (f x, 1::ennreal))`A. y * emeasure M (f -` {y} \<inter> space M \<inter> A))"
     by (subst sum.reindex [of fst]) (auto simp: inj_on_def)
   also have "\<dots> = (\<Sum>x \<in> f ` space M. x * emeasure M (f -` {x} \<inter> space M \<inter> A))"
     using A[THEN sets.sets_into_space]
     by (intro sum.mono_neutral_cong_left simple_functionD f) (auto simp: image_comp comp_def eq2)
   finally show ?thesis .
 qed
 
 lemma simple_integral_indicator_only[simp]:
   assumes "A \<in> sets M"
   shows "integral\<^sup>S M (indicator A) = emeasure M A"
   using simple_integral_indicator[OF assms, of "\<lambda>x. 1"] sets.sets_into_space[OF assms]
   by (simp_all add: image_constant_conv Int_absorb1 split: if_split_asm)
 
 lemma simple_integral_null_set:
   assumes "simple_function M u" "\<And>x. 0 \<le> u x" and "N \<in> null_sets M"
   shows "(\<integral>\<^sup>Sx. u x * indicator N x \<partial>M) = 0"
 proof -
   have "AE x in M. indicator N x = (0 :: ennreal)"
     using \<open>N \<in> null_sets M\<close> by (auto simp: indicator_def intro!: AE_I[of _ _ N])
   then have "(\<integral>\<^sup>Sx. u x * indicator N x \<partial>M) = (\<integral>\<^sup>Sx. 0 \<partial>M)"
     using assms apply (intro simple_integral_cong_AE) by auto
   then show ?thesis by simp
 qed
 
 lemma simple_integral_cong_AE_mult_indicator:
   assumes sf: "simple_function M f" and eq: "AE x in M. x \<in> S" and "S \<in> sets M"
   shows "integral\<^sup>S M f = (\<integral>\<^sup>Sx. f x * indicator S x \<partial>M)"
   using assms by (intro simple_integral_cong_AE) auto
 
 lemma simple_integral_cmult_indicator:
   assumes A: "A \<in> sets M"
   shows "(\<integral>\<^sup>Sx. c * indicator A x \<partial>M) = c * emeasure M A"
   using simple_integral_mult[OF simple_function_indicator[OF A]]
   unfolding simple_integral_indicator_only[OF A] by simp
 
 lemma simple_integral_nonneg:
   assumes f: "simple_function M f" and ae: "AE x in M. 0 \<le> f x"
   shows "0 \<le> integral\<^sup>S M f"
 proof -
   have "integral\<^sup>S M (\<lambda>x. 0) \<le> integral\<^sup>S M f"
     using simple_integral_mono_AE[OF _ f ae] by auto
   then show ?thesis by simp
 qed
 
 subsection \<open>Integral on nonnegative functions\<close>
 
 definition\<^marker>\<open>tag important\<close> nn_integral :: "'a measure \<Rightarrow> ('a \<Rightarrow> ennreal) \<Rightarrow> ennreal" ("integral\<^sup>N") where
   "integral\<^sup>N M f = (SUP g \<in> {g. simple_function M g \<and> g \<le> f}. integral\<^sup>S M g)"
 
 syntax
   "_nn_integral" :: "pttrn \<Rightarrow> ennreal \<Rightarrow> 'a measure \<Rightarrow> ennreal" ("\<integral>\<^sup>+((2 _./ _)/ \<partial>_)" [60,61] 110)
 
 translations
   "\<integral>\<^sup>+x. f \<partial>M" == "CONST nn_integral M (\<lambda>x. f)"
 
 lemma nn_integral_def_finite:
   "integral\<^sup>N M f = (SUP g \<in> {g. simple_function M g \<and> g \<le> f \<and> (\<forall>x. g x < top)}. integral\<^sup>S M g)"
     (is "_ = Sup (?A ` ?f)")
   unfolding nn_integral_def
 proof (safe intro!: antisym SUP_least)
   fix g assume g[measurable]: "simple_function M g" "g \<le> f"
 
   show "integral\<^sup>S M g \<le> Sup (?A ` ?f)"
   proof cases
     assume ae: "AE x in M. g x \<noteq> top"
     let ?G = "{x \<in> space M. g x \<noteq> top}"
     have "integral\<^sup>S M g = integral\<^sup>S M (\<lambda>x. g x * indicator ?G x)"
     proof (rule simple_integral_cong_AE)
       show "AE x in M. g x = g x * indicator ?G x"
         using ae AE_space by eventually_elim auto
     qed (insert g, auto)
     also have "\<dots> \<le> Sup (?A ` ?f)"
       using g by (intro SUP_upper) (auto simp: le_fun_def less_top split: split_indicator)
     finally show ?thesis .
   next
     assume nAE: "\<not> (AE x in M. g x \<noteq> top)"
     then have "emeasure M {x\<in>space M. g x = top} \<noteq> 0" (is "emeasure M ?G \<noteq> 0")
       by (subst (asm) AE_iff_measurable[OF _ refl]) auto
     then have "top = (SUP n. (\<integral>\<^sup>Sx. of_nat n * indicator ?G x \<partial>M))"
       by (simp add: ennreal_SUP_of_nat_eq_top ennreal_top_eq_mult_iff SUP_mult_right_ennreal[symmetric])
     also have "\<dots> \<le> Sup (?A ` ?f)"
       using g
       by (safe intro!: SUP_least SUP_upper)
          (auto simp: le_fun_def of_nat_less_top top_unique[symmetric] split: split_indicator
                intro: order_trans[of _ "g x" "f x" for x, OF order_trans[of _ top]])
     finally show ?thesis
       by (simp add: top_unique del: SUP_eq_top_iff Sup_eq_top_iff)
   qed
 qed (auto intro: SUP_upper)
 
 lemma nn_integral_mono_AE:
   assumes ae: "AE x in M. u x \<le> v x" shows "integral\<^sup>N M u \<le> integral\<^sup>N M v"
   unfolding nn_integral_def
 proof (safe intro!: SUP_mono)
   fix n assume n: "simple_function M n" "n \<le> u"
-  from ae[THEN AE_E] guess N . note N = this
+  from ae[THEN AE_E] obtain N
+    where N: "{x \<in> space M. \<not> u x \<le> v x} \<subseteq> N" "emeasure M N = 0" "N \<in> sets M"
+    by auto
   then have ae_N: "AE x in M. x \<notin> N" by (auto intro: AE_not_in)
   let ?n = "\<lambda>x. n x * indicator (space M - N) x"
   have "AE x in M. n x \<le> ?n x" "simple_function M ?n"
     using n N ae_N by auto
   moreover
   { fix x have "?n x \<le> v x"
     proof cases
       assume x: "x \<in> space M - N"
       with N have "u x \<le> v x" by auto
       with n(2)[THEN le_funD, of x] x show ?thesis
         by (auto simp: max_def split: if_split_asm)
     qed simp }
   then have "?n \<le> v" by (auto simp: le_funI)
   moreover have "integral\<^sup>S M n \<le> integral\<^sup>S M ?n"
     using ae_N N n by (auto intro!: simple_integral_mono_AE)
   ultimately show "\<exists>m\<in>{g. simple_function M g \<and> g \<le> v}. integral\<^sup>S M n \<le> integral\<^sup>S M m"
     by force
 qed
 
 lemma nn_integral_mono:
   "(\<And>x. x \<in> space M \<Longrightarrow> u x \<le> v x) \<Longrightarrow> integral\<^sup>N M u \<le> integral\<^sup>N M v"
   by (auto intro: nn_integral_mono_AE)
 
 lemma mono_nn_integral: "mono F \<Longrightarrow> mono (\<lambda>x. integral\<^sup>N M (F x))"
   by (auto simp add: mono_def le_fun_def intro!: nn_integral_mono)
 
 lemma nn_integral_cong_AE:
   "AE x in M. u x = v x \<Longrightarrow> integral\<^sup>N M u = integral\<^sup>N M v"
   by (auto simp: eq_iff intro!: nn_integral_mono_AE)
 
 lemma nn_integral_cong:
   "(\<And>x. x \<in> space M \<Longrightarrow> u x = v x) \<Longrightarrow> integral\<^sup>N M u = integral\<^sup>N M v"
   by (auto intro: nn_integral_cong_AE)
 
 lemma nn_integral_cong_simp:
   "(\<And>x. x \<in> space M =simp=> u x = v x) \<Longrightarrow> integral\<^sup>N M u = integral\<^sup>N M v"
   by (auto intro: nn_integral_cong simp: simp_implies_def)
 
 lemma incseq_nn_integral:
   assumes "incseq f" shows "incseq (\<lambda>i. integral\<^sup>N M (f i))"
 proof -
   have "\<And>i x. f i x \<le> f (Suc i) x"
     using assms by (auto dest!: incseq_SucD simp: le_fun_def)
   then show ?thesis
     by (auto intro!: incseq_SucI nn_integral_mono)
 qed
 
 lemma nn_integral_eq_simple_integral:
   assumes f: "simple_function M f" shows "integral\<^sup>N M f = integral\<^sup>S M f"
 proof -
   let ?f = "\<lambda>x. f x * indicator (space M) x"
   have f': "simple_function M ?f" using f by auto
   have "integral\<^sup>N M ?f \<le> integral\<^sup>S M ?f" using f'
     by (force intro!: SUP_least simple_integral_mono simp: le_fun_def nn_integral_def)
   moreover have "integral\<^sup>S M ?f \<le> integral\<^sup>N M ?f"
     unfolding nn_integral_def
     using f' by (auto intro!: SUP_upper)
   ultimately show ?thesis
     by (simp cong: nn_integral_cong simple_integral_cong)
 qed
 
 text \<open>Beppo-Levi monotone convergence theorem\<close>
 lemma nn_integral_monotone_convergence_SUP:
   assumes f: "incseq f" and [measurable]: "\<And>i. f i \<in> borel_measurable M"
   shows "(\<integral>\<^sup>+ x. (SUP i. f i x) \<partial>M) = (SUP i. integral\<^sup>N M (f i))"
 proof (rule antisym)
   show "(\<integral>\<^sup>+ x. (SUP i. f i x) \<partial>M) \<le> (SUP i. (\<integral>\<^sup>+ x. f i x \<partial>M))"
     unfolding nn_integral_def_finite[of _ "\<lambda>x. SUP i. f i x"]
   proof (safe intro!: SUP_least)
     fix u assume sf_u[simp]: "simple_function M u" and
       u: "u \<le> (\<lambda>x. SUP i. f i x)" and u_range: "\<forall>x. u x < top"
     note sf_u[THEN borel_measurable_simple_function, measurable]
     show "integral\<^sup>S M u \<le> (SUP j. \<integral>\<^sup>+x. f j x \<partial>M)"
     proof (rule ennreal_approx_unit)
       fix a :: ennreal assume "a < 1"
       let ?au = "\<lambda>x. a * u x"
 
       let ?B = "\<lambda>c i. {x\<in>space M. ?au x = c \<and> c \<le> f i x}"
       have "integral\<^sup>S M ?au = (\<Sum>c\<in>?au`space M. c * (SUP i. emeasure M (?B c i)))"
         unfolding simple_integral_def
       proof (intro sum.cong ennreal_mult_left_cong refl)
         fix c assume "c \<in> ?au ` space M" "c \<noteq> 0"
         { fix x' assume x': "x' \<in> space M" "?au x' = c"
           with \<open>c \<noteq> 0\<close> u_range have "?au x' < 1 * u x'"
             by (intro ennreal_mult_strict_right_mono \<open>a < 1\<close>) (auto simp: less_le)
           also have "\<dots> \<le> (SUP i. f i x')"
             using u by (auto simp: le_fun_def)
           finally have "\<exists>i. ?au x' \<le> f i x'"
             by (auto simp: less_SUP_iff intro: less_imp_le) }
         then have *: "?au -` {c} \<inter> space M = (\<Union>i. ?B c i)"
           by auto
         show "emeasure M (?au -` {c} \<inter> space M) = (SUP i. emeasure M (?B c i))"
           unfolding * using f
           by (intro SUP_emeasure_incseq[symmetric])
              (auto simp: incseq_def le_fun_def intro: order_trans)
       qed
       also have "\<dots> = (SUP i. \<Sum>c\<in>?au`space M. c * emeasure M (?B c i))"
         unfolding SUP_mult_left_ennreal using f
         by (intro ennreal_SUP_sum[symmetric])
            (auto intro!: mult_mono emeasure_mono simp: incseq_def le_fun_def intro: order_trans)
       also have "\<dots> \<le> (SUP i. integral\<^sup>N M (f i))"
       proof (intro SUP_subset_mono order_refl)
         fix i
         have "(\<Sum>c\<in>?au`space M. c * emeasure M (?B c i)) =
           (\<integral>\<^sup>Sx. (a * u x) * indicator {x\<in>space M. a * u x \<le> f i x} x \<partial>M)"
           by (subst simple_integral_indicator)
              (auto intro!: sum.cong ennreal_mult_left_cong arg_cong2[where f=emeasure])
         also have "\<dots> = (\<integral>\<^sup>+x. (a * u x) * indicator {x\<in>space M. a * u x \<le> f i x} x \<partial>M)"
           by (rule nn_integral_eq_simple_integral[symmetric]) simp
         also have "\<dots> \<le> (\<integral>\<^sup>+x. f i x \<partial>M)"
           by (intro nn_integral_mono) (auto split: split_indicator)
         finally show "(\<Sum>c\<in>?au`space M. c * emeasure M (?B c i)) \<le> (\<integral>\<^sup>+x. f i x \<partial>M)" .
       qed
       finally show "a * integral\<^sup>S M u \<le> (SUP i. integral\<^sup>N M (f i))"
         by simp
     qed
   qed
 qed (auto intro!: SUP_least SUP_upper nn_integral_mono)
 
 lemma sup_continuous_nn_integral[order_continuous_intros]:
   assumes f: "\<And>y. sup_continuous (f y)"
   assumes [measurable]: "\<And>x. (\<lambda>y. f y x) \<in> borel_measurable M"
   shows "sup_continuous (\<lambda>x. (\<integral>\<^sup>+y. f y x \<partial>M))"
   unfolding sup_continuous_def
 proof safe
   fix C :: "nat \<Rightarrow> 'b" assume C: "incseq C"
   with sup_continuous_mono[OF f] show "(\<integral>\<^sup>+ y. f y (Sup (C ` UNIV)) \<partial>M) = (SUP i. \<integral>\<^sup>+ y. f y (C i) \<partial>M)"
     unfolding sup_continuousD[OF f C]
     by (subst nn_integral_monotone_convergence_SUP) (auto simp: mono_def le_fun_def)
 qed
 
 theorem nn_integral_monotone_convergence_SUP_AE:
   assumes f: "\<And>i. AE x in M. f i x \<le> f (Suc i) x" "\<And>i. f i \<in> borel_measurable M"
   shows "(\<integral>\<^sup>+ x. (SUP i. f i x) \<partial>M) = (SUP i. integral\<^sup>N M (f i))"
 proof -
   from f have "AE x in M. \<forall>i. f i x \<le> f (Suc i) x"
     by (simp add: AE_all_countable)
-  from this[THEN AE_E] guess N . note N = this
+  from this[THEN AE_E] obtain N
+    where N: "{x \<in> space M. \<not> (\<forall>i. f i x \<le> f (Suc i) x)} \<subseteq> N" "emeasure M N = 0" "N \<in> sets M"
+    by auto
   let ?f = "\<lambda>i x. if x \<in> space M - N then f i x else 0"
   have f_eq: "AE x in M. \<forall>i. ?f i x = f i x" using N by (auto intro!: AE_I[of _ _ N])
   then have "(\<integral>\<^sup>+ x. (SUP i. f i x) \<partial>M) = (\<integral>\<^sup>+ x. (SUP i. ?f i x) \<partial>M)"
     by (auto intro!: nn_integral_cong_AE)
   also have "\<dots> = (SUP i. (\<integral>\<^sup>+ x. ?f i x \<partial>M))"
   proof (rule nn_integral_monotone_convergence_SUP)
     show "incseq ?f" using N(1) by (force intro!: incseq_SucI le_funI)
     { fix i show "(\<lambda>x. if x \<in> space M - N then f i x else 0) \<in> borel_measurable M"
         using f N(3) by (intro measurable_If_set) auto }
   qed
   also have "\<dots> = (SUP i. (\<integral>\<^sup>+ x. f i x \<partial>M))"
     using f_eq by (force intro!: arg_cong[where f = "\<lambda>f. Sup (range f)"] nn_integral_cong_AE ext)
   finally show ?thesis .
 qed
 
 lemma nn_integral_monotone_convergence_simple:
   "incseq f \<Longrightarrow> (\<And>i. simple_function M (f i)) \<Longrightarrow> (SUP i. \<integral>\<^sup>S x. f i x \<partial>M) = (\<integral>\<^sup>+x. (SUP i. f i x) \<partial>M)"
   using nn_integral_monotone_convergence_SUP[of f M]
   by (simp add: nn_integral_eq_simple_integral[symmetric] borel_measurable_simple_function)
 
 lemma SUP_simple_integral_sequences:
   assumes f: "incseq f" "\<And>i. simple_function M (f i)"
   and g: "incseq g" "\<And>i. simple_function M (g i)"
   and eq: "AE x in M. (SUP i. f i x) = (SUP i. g i x)"
   shows "(SUP i. integral\<^sup>S M (f i)) = (SUP i. integral\<^sup>S M (g i))"
     (is "Sup (?F ` _) = Sup (?G ` _)")
 proof -
   have "(SUP i. integral\<^sup>S M (f i)) = (\<integral>\<^sup>+x. (SUP i. f i x) \<partial>M)"
     using f by (rule nn_integral_monotone_convergence_simple)
   also have "\<dots> = (\<integral>\<^sup>+x. (SUP i. g i x) \<partial>M)"
     unfolding eq[THEN nn_integral_cong_AE] ..
   also have "\<dots> = (SUP i. ?G i)"
     using g by (rule nn_integral_monotone_convergence_simple[symmetric])
   finally show ?thesis by simp
 qed
 
 lemma nn_integral_const[simp]: "(\<integral>\<^sup>+ x. c \<partial>M) = c * emeasure M (space M)"
   by (subst nn_integral_eq_simple_integral) auto
 
 lemma nn_integral_linear:
   assumes f: "f \<in> borel_measurable M" and g: "g \<in> borel_measurable M"
   shows "(\<integral>\<^sup>+ x. a * f x + g x \<partial>M) = a * integral\<^sup>N M f + integral\<^sup>N M g"
     (is "integral\<^sup>N M ?L = _")
 proof -
-  from borel_measurable_implies_simple_function_sequence'[OF f(1)] guess u .
+  obtain u
+    where "\<And>i. simple_function M (u i)" "incseq u" "\<And>i x. u i x < top" "\<And>x. (SUP i. u i x) = f x"
+    using borel_measurable_implies_simple_function_sequence' f(1)
+    by auto
   note u = nn_integral_monotone_convergence_simple[OF this(2,1)] this
-  from borel_measurable_implies_simple_function_sequence'[OF g(1)] guess v .
+
+  obtain v where
+    "\<And>i. simple_function M (v i)" "incseq v" "\<And>i x. v i x < top" "\<And>x. (SUP i. v i x) = g x"
+    using borel_measurable_implies_simple_function_sequence' g(1)
+    by auto
   note v = nn_integral_monotone_convergence_simple[OF this(2,1)] this
+
   let ?L' = "\<lambda>i x. a * u i x + v i x"
 
   have "?L \<in> borel_measurable M" using assms by auto
-  from borel_measurable_implies_simple_function_sequence'[OF this] guess l .
+  from borel_measurable_implies_simple_function_sequence'[OF this]
+  obtain l where "\<And>i. simple_function M (l i)" "incseq l" "\<And>i x. l i x < top" "\<And>x. (SUP i. l i x) = a * f x + g x"
+    by auto
   note l = nn_integral_monotone_convergence_simple[OF this(2,1)] this
 
   have inc: "incseq (\<lambda>i. a * integral\<^sup>S M (u i))" "incseq (\<lambda>i. integral\<^sup>S M (v i))"
     using u v by (auto simp: incseq_Suc_iff le_fun_def intro!: add_mono mult_left_mono simple_integral_mono)
 
   have l': "(SUP i. integral\<^sup>S M (l i)) = (SUP i. integral\<^sup>S M (?L' i))"
   proof (rule SUP_simple_integral_sequences[OF l(3,2)])
     show "incseq ?L'" "\<And>i. simple_function M (?L' i)"
       using u v unfolding incseq_Suc_iff le_fun_def
       by (auto intro!: add_mono mult_left_mono)
     { fix x
       have "(SUP i. a * u i x + v i x) = a * (SUP i. u i x) + (SUP i. v i x)"
         using u(3) v(3) u(4)[of _ x] v(4)[of _ x] unfolding SUP_mult_left_ennreal
         by (auto intro!: ennreal_SUP_add simp: incseq_Suc_iff le_fun_def add_mono mult_left_mono) }
     then show "AE x in M. (SUP i. l i x) = (SUP i. ?L' i x)"
       unfolding l(5) using u(5) v(5) by (intro AE_I2) auto
   qed
   also have "\<dots> = (SUP i. a * integral\<^sup>S M (u i) + integral\<^sup>S M (v i))"
     using u(2) v(2) by auto
   finally show ?thesis
     unfolding l(5)[symmetric] l(1)[symmetric]
     by (simp add: ennreal_SUP_add[OF inc] v u SUP_mult_left_ennreal[symmetric])
 qed
 
 lemma nn_integral_cmult: "f \<in> borel_measurable M \<Longrightarrow> (\<integral>\<^sup>+ x. c * f x \<partial>M) = c * integral\<^sup>N M f"
   using nn_integral_linear[of f M "\<lambda>x. 0" c] by simp
 
 lemma nn_integral_multc: "f \<in> borel_measurable M \<Longrightarrow> (\<integral>\<^sup>+ x. f x * c \<partial>M) = integral\<^sup>N M f * c"
   unfolding mult.commute[of _ c] nn_integral_cmult by simp
 
 lemma nn_integral_divide: "f \<in> borel_measurable M \<Longrightarrow> (\<integral>\<^sup>+ x. f x / c \<partial>M) = (\<integral>\<^sup>+ x. f x \<partial>M) / c"
    unfolding divide_ennreal_def by (rule nn_integral_multc)
 
 lemma nn_integral_indicator[simp]: "A \<in> sets M \<Longrightarrow> (\<integral>\<^sup>+ x. indicator A x\<partial>M) = (emeasure M) A"
   by (subst nn_integral_eq_simple_integral) (auto simp: simple_integral_indicator)
 
 lemma nn_integral_cmult_indicator: "A \<in> sets M \<Longrightarrow> (\<integral>\<^sup>+ x. c * indicator A x \<partial>M) = c * emeasure M A"
   by (subst nn_integral_eq_simple_integral) (auto)
 
 lemma nn_integral_indicator':
   assumes [measurable]: "A \<inter> space M \<in> sets M"
   shows "(\<integral>\<^sup>+ x. indicator A x \<partial>M) = emeasure M (A \<inter> space M)"
 proof -
   have "(\<integral>\<^sup>+ x. indicator A x \<partial>M) = (\<integral>\<^sup>+ x. indicator (A \<inter> space M) x \<partial>M)"
     by (intro nn_integral_cong) (simp split: split_indicator)
   also have "\<dots> = emeasure M (A \<inter> space M)"
     by simp
   finally show ?thesis .
 qed
 
 lemma nn_integral_indicator_singleton[simp]:
   assumes [measurable]: "{y} \<in> sets M" shows "(\<integral>\<^sup>+x. f x * indicator {y} x \<partial>M) = f y * emeasure M {y}"
 proof -
   have "(\<integral>\<^sup>+x. f x * indicator {y} x \<partial>M) = (\<integral>\<^sup>+x. f y * indicator {y} x \<partial>M)"
     by (auto intro!: nn_integral_cong split: split_indicator)
   then show ?thesis
     by (simp add: nn_integral_cmult)
 qed
 
 lemma nn_integral_set_ennreal:
   "(\<integral>\<^sup>+x. ennreal (f x) * indicator A x \<partial>M) = (\<integral>\<^sup>+x. ennreal (f x * indicator A x) \<partial>M)"
   by (rule nn_integral_cong) (simp split: split_indicator)
 
 lemma nn_integral_indicator_singleton'[simp]:
   assumes [measurable]: "{y} \<in> sets M"
   shows "(\<integral>\<^sup>+x. ennreal (f x * indicator {y} x) \<partial>M) = f y * emeasure M {y}"
   by (subst nn_integral_set_ennreal[symmetric]) (simp)
 
 lemma nn_integral_add:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (\<integral>\<^sup>+ x. f x + g x \<partial>M) = integral\<^sup>N M f + integral\<^sup>N M g"
   using nn_integral_linear[of f M g 1] by simp
 
 lemma nn_integral_sum:
   "(\<And>i. i \<in> P \<Longrightarrow> f i \<in> borel_measurable M) \<Longrightarrow> (\<integral>\<^sup>+ x. (\<Sum>i\<in>P. f i x) \<partial>M) = (\<Sum>i\<in>P. integral\<^sup>N M (f i))"
   by (induction P rule: infinite_finite_induct) (auto simp: nn_integral_add)
 
 theorem nn_integral_suminf:
   assumes f: "\<And>i. f i \<in> borel_measurable M"
   shows "(\<integral>\<^sup>+ x. (\<Sum>i. f i x) \<partial>M) = (\<Sum>i. integral\<^sup>N M (f i))"
 proof -
   have all_pos: "AE x in M. \<forall>i. 0 \<le> f i x"
     using assms by (auto simp: AE_all_countable)
   have "(\<Sum>i. integral\<^sup>N M (f i)) = (SUP n. \<Sum>i<n. integral\<^sup>N M (f i))"
     by (rule suminf_eq_SUP)
   also have "\<dots> = (SUP n. \<integral>\<^sup>+x. (\<Sum>i<n. f i x) \<partial>M)"
     unfolding nn_integral_sum[OF f] ..
   also have "\<dots> = \<integral>\<^sup>+x. (SUP n. \<Sum>i<n. f i x) \<partial>M" using f all_pos
     by (intro nn_integral_monotone_convergence_SUP_AE[symmetric])
        (elim AE_mp, auto simp: sum_nonneg simp del: sum.lessThan_Suc intro!: AE_I2 sum_mono2)
   also have "\<dots> = \<integral>\<^sup>+x. (\<Sum>i. f i x) \<partial>M" using all_pos
     by (intro nn_integral_cong_AE) (auto simp: suminf_eq_SUP)
   finally show ?thesis by simp
 qed
 
 lemma nn_integral_bound_simple_function:
   assumes bnd: "\<And>x. x \<in> space M \<Longrightarrow> f x < \<infinity>"
   assumes f[measurable]: "simple_function M f"
   assumes supp: "emeasure M {x\<in>space M. f x \<noteq> 0} < \<infinity>"
   shows "nn_integral M f < \<infinity>"
 proof cases
   assume "space M = {}"
   then have "nn_integral M f = (\<integral>\<^sup>+x. 0 \<partial>M)"
     by (intro nn_integral_cong) auto
   then show ?thesis by simp
 next
   assume "space M \<noteq> {}"
   with simple_functionD(1)[OF f] bnd have bnd: "0 \<le> Max (f`space M) \<and> Max (f`space M) < \<infinity>"
     by (subst Max_less_iff) (auto simp: Max_ge_iff)
 
   have "nn_integral M f \<le> (\<integral>\<^sup>+x. Max (f`space M) * indicator {x\<in>space M. f x \<noteq> 0} x \<partial>M)"
   proof (rule nn_integral_mono)
     fix x assume "x \<in> space M"
     with f show "f x \<le> Max (f ` space M) * indicator {x \<in> space M. f x \<noteq> 0} x"
       by (auto split: split_indicator intro!: Max_ge simple_functionD)
   qed
   also have "\<dots> < \<infinity>"
     using bnd supp by (subst nn_integral_cmult) (auto simp: ennreal_mult_less_top)
   finally show ?thesis .
 qed
 
 theorem nn_integral_Markov_inequality:
   assumes u: "(\<lambda>x. u x * indicator A x) \<in> borel_measurable M" and "A \<in> sets M"
   shows "(emeasure M) ({x\<in>A. 1 \<le> c * u x}) \<le> c * (\<integral>\<^sup>+ x. u x * indicator A x \<partial>M)"
     (is "(emeasure M) ?A \<le> _ * ?PI")
 proof -
   define u' where "u' = (\<lambda>x. u x * indicator A x)"
   have [measurable]: "u' \<in> borel_measurable M"
     using u unfolding u'_def .
   have "{x\<in>space M. c * u' x \<ge> 1} \<in> sets M"
     by measurable
   also have "{x\<in>space M. c * u' x \<ge> 1} = ?A"
     using sets.sets_into_space[OF \<open>A \<in> sets M\<close>] by (auto simp: u'_def indicator_def)
   finally have "(emeasure M) ?A = (\<integral>\<^sup>+ x. indicator ?A x \<partial>M)"
     using nn_integral_indicator by simp
   also have "\<dots> \<le> (\<integral>\<^sup>+ x. c * (u x * indicator A x) \<partial>M)"
     using u by (auto intro!: nn_integral_mono_AE simp: indicator_def)
   also have "\<dots> = c * (\<integral>\<^sup>+ x. u x * indicator A x \<partial>M)"
     using assms by (auto intro!: nn_integral_cmult)
   finally show ?thesis .
 qed
 
 lemma Chernoff_ineq_nn_integral_ge:
   assumes s: "s > 0" and [measurable]: "A \<in> sets M"
   assumes [measurable]: "(\<lambda>x. f x * indicator A x) \<in> borel_measurable M"
   shows   "emeasure M {x\<in>A. f x \<ge> a} \<le>
            ennreal (exp (-s * a)) * nn_integral M (\<lambda>x. ennreal (exp (s * f x)) * indicator A x)"
 proof -
   define f' where "f' = (\<lambda>x. f x * indicator A x)"
   have [measurable]: "f' \<in> borel_measurable M"
     using assms(3) unfolding f'_def by assumption
   have "(\<lambda>x. ennreal (exp (s * f' x)) * indicator A x) \<in> borel_measurable M"
     by simp
   also have "(\<lambda>x. ennreal (exp (s * f' x)) * indicator A x) =
              (\<lambda>x. ennreal (exp (s * f x)) * indicator A x)"
     by (auto simp: f'_def indicator_def fun_eq_iff)
   finally have meas: "\<dots> \<in> borel_measurable M" .
 
   have "{x\<in>A. f x \<ge> a} = {x\<in>A. ennreal (exp (-s * a)) * ennreal (exp (s * f x)) \<ge> 1}"
     using s by (auto simp: exp_minus field_simps simp flip: ennreal_mult)
   also have "emeasure M \<dots> \<le> ennreal (exp (-s * a)) *
                (\<integral>\<^sup>+x. ennreal (exp (s * f x)) * indicator A x \<partial>M)"
     by (intro order.trans[OF nn_integral_Markov_inequality] meas) auto
   finally show ?thesis .
 qed
 
 lemma Chernoff_ineq_nn_integral_le:
   assumes s: "s > 0" and [measurable]: "A \<in> sets M"
   assumes [measurable]: "f \<in> borel_measurable M"
   shows   "emeasure M {x\<in>A. f x \<le> a} \<le>
            ennreal (exp (s * a)) * nn_integral M (\<lambda>x. ennreal (exp (-s * f x)) * indicator A x)"
   using Chernoff_ineq_nn_integral_ge[of s A M "\<lambda>x. -f x" "-a"] assms by simp
 
 lemma nn_integral_noteq_infinite:
   assumes g: "g \<in> borel_measurable M" and "integral\<^sup>N M g \<noteq> \<infinity>"
   shows "AE x in M. g x \<noteq> \<infinity>"
 proof (rule ccontr)
   assume c: "\<not> (AE x in M. g x \<noteq> \<infinity>)"
   have "(emeasure M) {x\<in>space M. g x = \<infinity>} \<noteq> 0"
     using c g by (auto simp add: AE_iff_null)
   then have "0 < (emeasure M) {x\<in>space M. g x = \<infinity>}"
     by (auto simp: zero_less_iff_neq_zero)
   then have "\<infinity> = \<infinity> * (emeasure M) {x\<in>space M. g x = \<infinity>}"
     by (auto simp: ennreal_top_eq_mult_iff)
   also have "\<dots> \<le> (\<integral>\<^sup>+x. \<infinity> * indicator {x\<in>space M. g x = \<infinity>} x \<partial>M)"
     using g by (subst nn_integral_cmult_indicator) auto
   also have "\<dots> \<le> integral\<^sup>N M g"
     using assms by (auto intro!: nn_integral_mono_AE simp: indicator_def)
   finally show False
     using \<open>integral\<^sup>N M g \<noteq> \<infinity>\<close> by (auto simp: top_unique)
 qed
 
 lemma nn_integral_PInf:
   assumes f: "f \<in> borel_measurable M" and not_Inf: "integral\<^sup>N M f \<noteq> \<infinity>"
   shows "emeasure M (f -` {\<infinity>} \<inter> space M) = 0"
 proof -
   have "\<infinity> * emeasure M (f -` {\<infinity>} \<inter> space M) = (\<integral>\<^sup>+ x. \<infinity> * indicator (f -` {\<infinity>} \<inter> space M) x \<partial>M)"
     using f by (subst nn_integral_cmult_indicator) (auto simp: measurable_sets)
   also have "\<dots> \<le> integral\<^sup>N M f"
     by (auto intro!: nn_integral_mono simp: indicator_def)
   finally have "\<infinity> * (emeasure M) (f -` {\<infinity>} \<inter> space M) \<le> integral\<^sup>N M f"
     by simp
   then show ?thesis
     using assms by (auto simp: ennreal_top_mult top_unique split: if_split_asm)
 qed
 
 lemma simple_integral_PInf:
   "simple_function M f \<Longrightarrow> integral\<^sup>S M f \<noteq> \<infinity> \<Longrightarrow> emeasure M (f -` {\<infinity>} \<inter> space M) = 0"
   by (rule nn_integral_PInf) (auto simp: nn_integral_eq_simple_integral borel_measurable_simple_function)
 
 lemma nn_integral_PInf_AE:
   assumes "f \<in> borel_measurable M" "integral\<^sup>N M f \<noteq> \<infinity>" shows "AE x in M. f x \<noteq> \<infinity>"
 proof (rule AE_I)
   show "(emeasure M) (f -` {\<infinity>} \<inter> space M) = 0"
     by (rule nn_integral_PInf[OF assms])
   show "f -` {\<infinity>} \<inter> space M \<in> sets M"
     using assms by (auto intro: borel_measurable_vimage)
 qed auto
 
 lemma nn_integral_diff:
   assumes f: "f \<in> borel_measurable M"
   and g: "g \<in> borel_measurable M"
   and fin: "integral\<^sup>N M g \<noteq> \<infinity>"
   and mono: "AE x in M. g x \<le> f x"
   shows "(\<integral>\<^sup>+ x. f x - g x \<partial>M) = integral\<^sup>N M f - integral\<^sup>N M g"
 proof -
   have diff: "(\<lambda>x. f x - g x) \<in> borel_measurable M"
     using assms by auto
   have "AE x in M. f x = f x - g x + g x"
     using diff_add_cancel_ennreal mono nn_integral_noteq_infinite[OF g fin] assms by auto
   then have **: "integral\<^sup>N M f = (\<integral>\<^sup>+x. f x - g x \<partial>M) + integral\<^sup>N M g"
     unfolding nn_integral_add[OF diff g, symmetric]
     by (rule nn_integral_cong_AE)
   show ?thesis unfolding **
     using fin
     by (cases rule: ennreal2_cases[of "\<integral>\<^sup>+ x. f x - g x \<partial>M" "integral\<^sup>N M g"]) auto
 qed
 
 lemma nn_integral_mult_bounded_inf:
   assumes f: "f \<in> borel_measurable M" "(\<integral>\<^sup>+x. f x \<partial>M) < \<infinity>" and c: "c \<noteq> \<infinity>" and ae: "AE x in M. g x \<le> c * f x"
   shows "(\<integral>\<^sup>+x. g x \<partial>M) < \<infinity>"
 proof -
   have "(\<integral>\<^sup>+x. g x \<partial>M) \<le> (\<integral>\<^sup>+x. c * f x \<partial>M)"
     by (intro nn_integral_mono_AE ae)
   also have "(\<integral>\<^sup>+x. c * f x \<partial>M) < \<infinity>"
     using c f by (subst nn_integral_cmult) (auto simp: ennreal_mult_less_top top_unique not_less)
   finally show ?thesis .
 qed
 
 text \<open>Fatou's lemma: convergence theorem on limes inferior\<close>
 
 lemma nn_integral_monotone_convergence_INF_AE':
   assumes f: "\<And>i. AE x in M. f (Suc i) x \<le> f i x" and [measurable]: "\<And>i. f i \<in> borel_measurable M"
     and *: "(\<integral>\<^sup>+ x. f 0 x \<partial>M) < \<infinity>"
   shows "(\<integral>\<^sup>+ x. (INF i. f i x) \<partial>M) = (INF i. integral\<^sup>N M (f i))"
 proof (rule ennreal_minus_cancel)
   have "integral\<^sup>N M (f 0) - (\<integral>\<^sup>+ x. (INF i. f i x) \<partial>M) = (\<integral>\<^sup>+x. f 0 x - (INF i. f i x) \<partial>M)"
   proof (rule nn_integral_diff[symmetric])
     have "(\<integral>\<^sup>+ x. (INF i. f i x) \<partial>M) \<le> (\<integral>\<^sup>+ x. f 0 x \<partial>M)"
       by (intro nn_integral_mono INF_lower) simp
     with * show "(\<integral>\<^sup>+ x. (INF i. f i x) \<partial>M) \<noteq> \<infinity>"
       by simp
   qed (auto intro: INF_lower)
   also have "\<dots> = (\<integral>\<^sup>+x. (SUP i. f 0 x - f i x) \<partial>M)"
     by (simp add: ennreal_INF_const_minus)
   also have "\<dots> = (SUP i. (\<integral>\<^sup>+x. f 0 x - f i x \<partial>M))"
   proof (intro nn_integral_monotone_convergence_SUP_AE)
     show "AE x in M. f 0 x - f i x \<le> f 0 x - f (Suc i) x" for i
       using f[of i] by eventually_elim (auto simp: ennreal_mono_minus)
   qed simp
   also have "\<dots> = (SUP i. nn_integral M (f 0) - (\<integral>\<^sup>+x. f i x \<partial>M))"
   proof (subst nn_integral_diff[symmetric])
     fix i
     have dec: "AE x in M. \<forall>i. f (Suc i) x \<le> f i x"
       unfolding AE_all_countable using f by auto
     then show "AE x in M. f i x \<le> f 0 x"
       using dec by eventually_elim (auto intro: lift_Suc_antimono_le[of "\<lambda>i. f i x" 0 i for x])
     then have "(\<integral>\<^sup>+ x. f i x \<partial>M) \<le> (\<integral>\<^sup>+ x. f 0 x \<partial>M)"
       by (rule nn_integral_mono_AE)
     with * show "(\<integral>\<^sup>+ x. f i x \<partial>M) \<noteq> \<infinity>"
       by simp
   qed (insert f, auto simp: decseq_def le_fun_def)
   finally show "integral\<^sup>N M (f 0) - (\<integral>\<^sup>+ x. (INF i. f i x) \<partial>M) =
     integral\<^sup>N M (f 0) - (INF i. \<integral>\<^sup>+ x. f i x \<partial>M)"
     by (simp add: ennreal_INF_const_minus)
 qed (insert *, auto intro!: nn_integral_mono intro: INF_lower)
 
 theorem nn_integral_monotone_convergence_INF_AE:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> ennreal"
   assumes f: "\<And>i. AE x in M. f (Suc i) x \<le> f i x"
     and [measurable]: "\<And>i. f i \<in> borel_measurable M"
     and fin: "(\<integral>\<^sup>+ x. f i x \<partial>M) < \<infinity>"
   shows "(\<integral>\<^sup>+ x. (INF i. f i x) \<partial>M) = (INF i. integral\<^sup>N M (f i))"
 proof -
   { fix f :: "nat \<Rightarrow> ennreal" and j assume "decseq f"
     then have "(INF i. f i) = (INF i. f (i + j))"
       apply (intro INF_eq)
       apply (rule_tac x="i" in bexI)
       apply (auto simp: decseq_def le_fun_def)
       done }
   note INF_shift = this
   have mono: "AE x in M. \<forall>i. f (Suc i) x \<le> f i x"
     using f by (auto simp: AE_all_countable)
   then have "AE x in M. (INF i. f i x) = (INF n. f (n + i) x)"
     by eventually_elim (auto intro!: decseq_SucI INF_shift)
   then have "(\<integral>\<^sup>+ x. (INF i. f i x) \<partial>M) = (\<integral>\<^sup>+ x. (INF n. f (n + i) x) \<partial>M)"
     by (rule nn_integral_cong_AE)
   also have "\<dots> = (INF n. (\<integral>\<^sup>+ x. f (n + i) x \<partial>M))"
     by (rule nn_integral_monotone_convergence_INF_AE') (insert assms, auto)
   also have "\<dots> = (INF n. (\<integral>\<^sup>+ x. f n x \<partial>M))"
     by (intro INF_shift[symmetric] decseq_SucI nn_integral_mono_AE f)
   finally show ?thesis .
 qed
 
 lemma nn_integral_monotone_convergence_INF_decseq:
   assumes f: "decseq f" and *: "\<And>i. f i \<in> borel_measurable M" "(\<integral>\<^sup>+ x. f i x \<partial>M) < \<infinity>"
   shows "(\<integral>\<^sup>+ x. (INF i. f i x) \<partial>M) = (INF i. integral\<^sup>N M (f i))"
   using nn_integral_monotone_convergence_INF_AE[of f M i, OF _ *] f by (auto simp: decseq_Suc_iff le_fun_def)
 
 theorem nn_integral_liminf:
   fixes u :: "nat \<Rightarrow> 'a \<Rightarrow> ennreal"
   assumes u: "\<And>i. u i \<in> borel_measurable M"
   shows "(\<integral>\<^sup>+ x. liminf (\<lambda>n. u n x) \<partial>M) \<le> liminf (\<lambda>n. integral\<^sup>N M (u n))"
 proof -
   have "(\<integral>\<^sup>+ x. liminf (\<lambda>n. u n x) \<partial>M) = (SUP n. \<integral>\<^sup>+ x. (INF i\<in>{n..}. u i x) \<partial>M)"
     unfolding liminf_SUP_INF using u
     by (intro nn_integral_monotone_convergence_SUP_AE)
        (auto intro!: AE_I2 intro: INF_greatest INF_superset_mono)
   also have "\<dots> \<le> liminf (\<lambda>n. integral\<^sup>N M (u n))"
     by (auto simp: liminf_SUP_INF intro!: SUP_mono INF_greatest nn_integral_mono INF_lower)
   finally show ?thesis .
 qed
 
 theorem nn_integral_limsup:
   fixes u :: "nat \<Rightarrow> 'a \<Rightarrow> ennreal"
   assumes [measurable]: "\<And>i. u i \<in> borel_measurable M" "w \<in> borel_measurable M"
   assumes bounds: "\<And>i. AE x in M. u i x \<le> w x" and w: "(\<integral>\<^sup>+x. w x \<partial>M) < \<infinity>"
   shows "limsup (\<lambda>n. integral\<^sup>N M (u n)) \<le> (\<integral>\<^sup>+ x. limsup (\<lambda>n. u n x) \<partial>M)"
 proof -
   have bnd: "AE x in M. \<forall>i. u i x \<le> w x"
     using bounds by (auto simp: AE_all_countable)
   then have "(\<integral>\<^sup>+ x. (SUP n. u n x) \<partial>M) \<le> (\<integral>\<^sup>+ x. w x \<partial>M)"
     by (auto intro!: nn_integral_mono_AE elim: eventually_mono intro: SUP_least)
   then have "(\<integral>\<^sup>+ x. limsup (\<lambda>n. u n x) \<partial>M) = (INF n. \<integral>\<^sup>+ x. (SUP i\<in>{n..}. u i x) \<partial>M)"
     unfolding limsup_INF_SUP using bnd w
     by (intro nn_integral_monotone_convergence_INF_AE')
        (auto intro!: AE_I2 intro: SUP_least SUP_subset_mono)
   also have "\<dots> \<ge> limsup (\<lambda>n. integral\<^sup>N M (u n))"
     by (auto simp: limsup_INF_SUP intro!: INF_mono SUP_least exI nn_integral_mono SUP_upper)
   finally (xtrans) show ?thesis .
 qed
 
 lemma nn_integral_LIMSEQ:
   assumes f: "incseq f" "\<And>i. f i \<in> borel_measurable M"
     and u: "\<And>x. (\<lambda>i. f i x) \<longlonglongrightarrow> u x"
   shows "(\<lambda>n. integral\<^sup>N M (f n)) \<longlonglongrightarrow> integral\<^sup>N M u"
 proof -
   have "(\<lambda>n. integral\<^sup>N M (f n)) \<longlonglongrightarrow> (SUP n. integral\<^sup>N M (f n))"
     using f by (intro LIMSEQ_SUP[of "\<lambda>n. integral\<^sup>N M (f n)"] incseq_nn_integral)
   also have "(SUP n. integral\<^sup>N M (f n)) = integral\<^sup>N M (\<lambda>x. SUP n. f n x)"
     using f by (intro nn_integral_monotone_convergence_SUP[symmetric])
   also have "integral\<^sup>N M (\<lambda>x. SUP n. f n x) = integral\<^sup>N M (\<lambda>x. u x)"
     using f by (subst LIMSEQ_SUP[THEN LIMSEQ_unique, OF _ u]) (auto simp: incseq_def le_fun_def)
   finally show ?thesis .
 qed
 
 theorem nn_integral_dominated_convergence:
   assumes [measurable]:
        "\<And>i. u i \<in> borel_measurable M" "u' \<in> borel_measurable M" "w \<in> borel_measurable M"
     and bound: "\<And>j. AE x in M. u j x \<le> w x"
     and w: "(\<integral>\<^sup>+x. w x \<partial>M) < \<infinity>"
     and u': "AE x in M. (\<lambda>i. u i x) \<longlonglongrightarrow> u' x"
   shows "(\<lambda>i. (\<integral>\<^sup>+x. u i x \<partial>M)) \<longlonglongrightarrow> (\<integral>\<^sup>+x. u' x \<partial>M)"
 proof -
   have "limsup (\<lambda>n. integral\<^sup>N M (u n)) \<le> (\<integral>\<^sup>+ x. limsup (\<lambda>n. u n x) \<partial>M)"
     by (intro nn_integral_limsup[OF _ _ bound w]) auto
   moreover have "(\<integral>\<^sup>+ x. limsup (\<lambda>n. u n x) \<partial>M) = (\<integral>\<^sup>+ x. u' x \<partial>M)"
     using u' by (intro nn_integral_cong_AE, eventually_elim) (metis tendsto_iff_Liminf_eq_Limsup sequentially_bot)
   moreover have "(\<integral>\<^sup>+ x. liminf (\<lambda>n. u n x) \<partial>M) = (\<integral>\<^sup>+ x. u' x \<partial>M)"
     using u' by (intro nn_integral_cong_AE, eventually_elim) (metis tendsto_iff_Liminf_eq_Limsup sequentially_bot)
   moreover have "(\<integral>\<^sup>+x. liminf (\<lambda>n. u n x) \<partial>M) \<le> liminf (\<lambda>n. integral\<^sup>N M (u n))"
     by (intro nn_integral_liminf) auto
   moreover have "liminf (\<lambda>n. integral\<^sup>N M (u n)) \<le> limsup (\<lambda>n. integral\<^sup>N M (u n))"
     by (intro Liminf_le_Limsup sequentially_bot)
   ultimately show ?thesis
     by (intro Liminf_eq_Limsup) auto
 qed
 
 lemma inf_continuous_nn_integral[order_continuous_intros]:
   assumes f: "\<And>y. inf_continuous (f y)"
   assumes [measurable]: "\<And>x. (\<lambda>y. f y x) \<in> borel_measurable M"
   assumes bnd: "\<And>x. (\<integral>\<^sup>+ y. f y x \<partial>M) \<noteq> \<infinity>"
   shows "inf_continuous (\<lambda>x. (\<integral>\<^sup>+y. f y x \<partial>M))"
   unfolding inf_continuous_def
 proof safe
   fix C :: "nat \<Rightarrow> 'b" assume C: "decseq C"
   then show "(\<integral>\<^sup>+ y. f y (Inf (C ` UNIV)) \<partial>M) = (INF i. \<integral>\<^sup>+ y. f y (C i) \<partial>M)"
     using inf_continuous_mono[OF f] bnd
     by (auto simp add: inf_continuousD[OF f C] fun_eq_iff antimono_def mono_def le_fun_def less_top
              intro!: nn_integral_monotone_convergence_INF_decseq)
 qed
 
 lemma nn_integral_null_set:
   assumes "N \<in> null_sets M" shows "(\<integral>\<^sup>+ x. u x * indicator N x \<partial>M) = 0"
 proof -
   have "(\<integral>\<^sup>+ x. u x * indicator N x \<partial>M) = (\<integral>\<^sup>+ x. 0 \<partial>M)"
   proof (intro nn_integral_cong_AE AE_I)
     show "{x \<in> space M. u x * indicator N x \<noteq> 0} \<subseteq> N"
       by (auto simp: indicator_def)
     show "(emeasure M) N = 0" "N \<in> sets M"
       using assms by auto
   qed
   then show ?thesis by simp
 qed
 
 lemma nn_integral_0_iff:
   assumes u [measurable]: "u \<in> borel_measurable M"
   shows "integral\<^sup>N M u = 0 \<longleftrightarrow> emeasure M {x\<in>space M. u x \<noteq> 0} = 0"
     (is "_ \<longleftrightarrow> (emeasure M) ?A = 0")
 proof -
   have u_eq: "(\<integral>\<^sup>+ x. u x * indicator ?A x \<partial>M) = integral\<^sup>N M u"
     by (auto intro!: nn_integral_cong simp: indicator_def)
   show ?thesis
   proof
     assume "(emeasure M) ?A = 0"
     with nn_integral_null_set[of ?A M u] u
     show "integral\<^sup>N M u = 0" by (simp add: u_eq null_sets_def)
   next
     assume *: "integral\<^sup>N M u = 0"
     let ?M = "\<lambda>n. {x \<in> space M. 1 \<le> real (n::nat) * u x}"
     have "0 = (SUP n. (emeasure M) (?M n \<inter> ?A))"
     proof -
       { fix n :: nat
         have "emeasure M {x \<in> ?A. 1 \<le> of_nat n * u x} \<le>
                 of_nat n * \<integral>\<^sup>+ x. u x * indicator ?A x \<partial>M"
           by (intro nn_integral_Markov_inequality) auto
         also have "{x \<in> ?A. 1 \<le> of_nat n * u x} = (?M n \<inter> ?A)"
           by (auto simp: ennreal_of_nat_eq_real_of_nat u_eq * )
         finally have "emeasure M (?M n \<inter> ?A) \<le> 0"
           by (simp add: ennreal_of_nat_eq_real_of_nat u_eq * )
         moreover have "0 \<le> (emeasure M) (?M n \<inter> ?A)" using u by auto
         ultimately have "(emeasure M) (?M n \<inter> ?A) = 0" by auto }
       thus ?thesis by simp
     qed
     also have "\<dots> = (emeasure M) (\<Union>n. ?M n \<inter> ?A)"
     proof (safe intro!: SUP_emeasure_incseq)
       fix n show "?M n \<inter> ?A \<in> sets M"
         using u by (auto intro!: sets.Int)
     next
       show "incseq (\<lambda>n. {x \<in> space M. 1 \<le> real n * u x} \<inter> {x \<in> space M. u x \<noteq> 0})"
       proof (safe intro!: incseq_SucI)
         fix n :: nat and x
         assume *: "1 \<le> real n * u x"
         also have "real n * u x \<le> real (Suc n) * u x"
           by (auto intro!: mult_right_mono)
         finally show "1 \<le> real (Suc n) * u x" by auto
       qed
     qed
     also have "\<dots> = (emeasure M) {x\<in>space M. 0 < u x}"
     proof (safe intro!: arg_cong[where f="(emeasure M)"])
       fix x assume "0 < u x" and [simp, intro]: "x \<in> space M"
       show "x \<in> (\<Union>n. ?M n \<inter> ?A)"
       proof (cases "u x" rule: ennreal_cases)
         case (real r) with \<open>0 < u x\<close> have "0 < r" by auto
         obtain j :: nat where "1 / r \<le> real j" using real_arch_simple ..
         hence "1 / r * r \<le> real j * r" unfolding mult_le_cancel_right using \<open>0 < r\<close> by auto
         hence "1 \<le> real j * r" using real \<open>0 < r\<close> by auto
         thus ?thesis using \<open>0 < r\<close> real
           by (auto simp: ennreal_of_nat_eq_real_of_nat ennreal_1[symmetric] ennreal_mult[symmetric]
                    simp del: ennreal_1)
       qed (insert \<open>0 < u x\<close>, auto simp: ennreal_mult_top)
     qed (auto simp: zero_less_iff_neq_zero)
     finally show "emeasure M ?A = 0"
       by (simp add: zero_less_iff_neq_zero)
   qed
 qed
 
 lemma nn_integral_0_iff_AE:
   assumes u: "u \<in> borel_measurable M"
   shows "integral\<^sup>N M u = 0 \<longleftrightarrow> (AE x in M. u x = 0)"
 proof -
   have sets: "{x\<in>space M. u x \<noteq> 0} \<in> sets M"
     using u by auto
   show "integral\<^sup>N M u = 0 \<longleftrightarrow> (AE x in M. u x = 0)"
     using nn_integral_0_iff[of u] AE_iff_null[OF sets] u by auto
 qed
 
 lemma AE_iff_nn_integral:
   "{x\<in>space M. P x} \<in> sets M \<Longrightarrow> (AE x in M. P x) \<longleftrightarrow> integral\<^sup>N M (indicator {x. \<not> P x}) = 0"
   by (subst nn_integral_0_iff_AE) (auto simp: indicator_def[abs_def])
 
 lemma nn_integral_less:
   assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   assumes f: "(\<integral>\<^sup>+x. f x \<partial>M) \<noteq> \<infinity>"
   assumes ord: "AE x in M. f x \<le> g x" "\<not> (AE x in M. g x \<le> f x)"
   shows "(\<integral>\<^sup>+x. f x \<partial>M) < (\<integral>\<^sup>+x. g x \<partial>M)"
 proof -
   have "0 < (\<integral>\<^sup>+x. g x - f x \<partial>M)"
   proof (intro order_le_neq_trans notI)
     assume "0 = (\<integral>\<^sup>+x. g x - f x \<partial>M)"
     then have "AE x in M. g x - f x = 0"
       using nn_integral_0_iff_AE[of "\<lambda>x. g x - f x" M] by simp
     with ord(1) have "AE x in M. g x \<le> f x"
       by eventually_elim (auto simp: ennreal_minus_eq_0)
     with ord show False
       by simp
   qed simp
   also have "\<dots> = (\<integral>\<^sup>+x. g x \<partial>M) - (\<integral>\<^sup>+x. f x \<partial>M)"
     using f by (subst nn_integral_diff) (auto simp: ord)
   finally show ?thesis
     using f by (auto dest!: ennreal_minus_pos_iff[rotated] simp: less_top)
 qed
 
 lemma nn_integral_subalgebra:
   assumes f: "f \<in> borel_measurable N"
   and N: "sets N \<subseteq> sets M" "space N = space M" "\<And>A. A \<in> sets N \<Longrightarrow> emeasure N A = emeasure M A"
   shows "integral\<^sup>N N f = integral\<^sup>N M f"
 proof -
   have [simp]: "\<And>f :: 'a \<Rightarrow> ennreal. f \<in> borel_measurable N \<Longrightarrow> f \<in> borel_measurable M"
     using N by (auto simp: measurable_def)
   have [simp]: "\<And>P. (AE x in N. P x) \<Longrightarrow> (AE x in M. P x)"
     using N by (auto simp add: eventually_ae_filter null_sets_def subset_eq)
   have [simp]: "\<And>A. A \<in> sets N \<Longrightarrow> A \<in> sets M"
     using N by auto
   from f show ?thesis
     apply induct
     apply (simp_all add: nn_integral_add nn_integral_cmult nn_integral_monotone_convergence_SUP N image_comp)
     apply (auto intro!: nn_integral_cong cong: nn_integral_cong simp: N(2)[symmetric])
     done
 qed
 
 lemma nn_integral_nat_function:
   fixes f :: "'a \<Rightarrow> nat"
   assumes "f \<in> measurable M (count_space UNIV)"
   shows "(\<integral>\<^sup>+x. of_nat (f x) \<partial>M) = (\<Sum>t. emeasure M {x\<in>space M. t < f x})"
 proof -
   define F where "F i = {x\<in>space M. i < f x}" for i
   with assms have [measurable]: "\<And>i. F i \<in> sets M"
     by auto
 
   { fix x assume "x \<in> space M"
     have "(\<lambda>i. if i < f x then 1 else 0) sums (of_nat (f x)::real)"
       using sums_If_finite[of "\<lambda>i. i < f x" "\<lambda>_. 1::real"] by simp
     then have "(\<lambda>i. ennreal (if i < f x then 1 else 0)) sums of_nat(f x)"
       unfolding ennreal_of_nat_eq_real_of_nat
       by (subst sums_ennreal) auto
     moreover have "\<And>i. ennreal (if i < f x then 1 else 0) = indicator (F i) x"
       using \<open>x \<in> space M\<close> by (simp add: one_ennreal_def F_def)
     ultimately have "of_nat (f x) = (\<Sum>i. indicator (F i) x :: ennreal)"
       by (simp add: sums_iff) }
   then have "(\<integral>\<^sup>+x. of_nat (f x) \<partial>M) = (\<integral>\<^sup>+x. (\<Sum>i. indicator (F i) x) \<partial>M)"
     by (simp cong: nn_integral_cong)
   also have "\<dots> = (\<Sum>i. emeasure M (F i))"
     by (simp add: nn_integral_suminf)
   finally show ?thesis
     by (simp add: F_def)
 qed
 
 theorem nn_integral_lfp:
   assumes sets[simp]: "\<And>s. sets (M s) = sets N"
   assumes f: "sup_continuous f"
   assumes g: "sup_continuous g"
   assumes meas: "\<And>F. F \<in> borel_measurable N \<Longrightarrow> f F \<in> borel_measurable N"
   assumes step: "\<And>F s. F \<in> borel_measurable N \<Longrightarrow> integral\<^sup>N (M s) (f F) = g (\<lambda>s. integral\<^sup>N (M s) F) s"
   shows "(\<integral>\<^sup>+\<omega>. lfp f \<omega> \<partial>M s) = lfp g s"
 proof (subst lfp_transfer_bounded[where \<alpha>="\<lambda>F s. \<integral>\<^sup>+x. F x \<partial>M s" and g=g and f=f and P="\<lambda>f. f \<in> borel_measurable N", symmetric])
   fix C :: "nat \<Rightarrow> 'b \<Rightarrow> ennreal" assume "incseq C" "\<And>i. C i \<in> borel_measurable N"
   then show "(\<lambda>s. \<integral>\<^sup>+x. (SUP i. C i) x \<partial>M s) = (SUP i. (\<lambda>s. \<integral>\<^sup>+x. C i x \<partial>M s))"
     unfolding SUP_apply[abs_def]
     by (subst nn_integral_monotone_convergence_SUP)
        (auto simp: mono_def fun_eq_iff intro!: arg_cong2[where f=emeasure] cong: measurable_cong_sets)
 qed (auto simp add: step le_fun_def SUP_apply[abs_def] bot_fun_def bot_ennreal intro!: meas f g)
 
 theorem nn_integral_gfp:
   assumes sets[simp]: "\<And>s. sets (M s) = sets N"
   assumes f: "inf_continuous f" and g: "inf_continuous g"
   assumes meas: "\<And>F. F \<in> borel_measurable N \<Longrightarrow> f F \<in> borel_measurable N"
   assumes bound: "\<And>F s. F \<in> borel_measurable N \<Longrightarrow> (\<integral>\<^sup>+x. f F x \<partial>M s) < \<infinity>"
   assumes non_zero: "\<And>s. emeasure (M s) (space (M s)) \<noteq> 0"
   assumes step: "\<And>F s. F \<in> borel_measurable N \<Longrightarrow> integral\<^sup>N (M s) (f F) = g (\<lambda>s. integral\<^sup>N (M s) F) s"
   shows "(\<integral>\<^sup>+\<omega>. gfp f \<omega> \<partial>M s) = gfp g s"
 proof (subst gfp_transfer_bounded[where \<alpha>="\<lambda>F s. \<integral>\<^sup>+x. F x \<partial>M s" and g=g and f=f
     and P="\<lambda>F. F \<in> borel_measurable N \<and> (\<forall>s. (\<integral>\<^sup>+x. F x \<partial>M s) < \<infinity>)", symmetric])
   fix C :: "nat \<Rightarrow> 'b \<Rightarrow> ennreal" assume "decseq C" "\<And>i. C i \<in> borel_measurable N \<and> (\<forall>s. integral\<^sup>N (M s) (C i) < \<infinity>)"
   then show "(\<lambda>s. \<integral>\<^sup>+x. (INF i. C i) x \<partial>M s) = (INF i. (\<lambda>s. \<integral>\<^sup>+x. C i x \<partial>M s))"
     unfolding INF_apply[abs_def]
     by (subst nn_integral_monotone_convergence_INF_decseq)
        (auto simp: mono_def fun_eq_iff intro!: arg_cong2[where f=emeasure] cong: measurable_cong_sets)
 next
   show "\<And>x. g x \<le> (\<lambda>s. integral\<^sup>N (M s) (f top))"
     by (subst step)
        (auto simp add: top_fun_def less_le non_zero le_fun_def ennreal_top_mult
              cong del: if_weak_cong intro!: monoD[OF inf_continuous_mono[OF g], THEN le_funD])
 next
   fix C assume "\<And>i::nat. C i \<in> borel_measurable N \<and> (\<forall>s. integral\<^sup>N (M s) (C i) < \<infinity>)" "decseq C"
   with bound show "Inf (C ` UNIV) \<in> borel_measurable N \<and> (\<forall>s. integral\<^sup>N (M s) (Inf (C ` UNIV)) < \<infinity>)"
     unfolding INF_apply[abs_def]
     by (subst nn_integral_monotone_convergence_INF_decseq)
        (auto simp: INF_less_iff cong: measurable_cong_sets intro!: borel_measurable_INF)
 next
   show "\<And>x. x \<in> borel_measurable N \<and> (\<forall>s. integral\<^sup>N (M s) x < \<infinity>) \<Longrightarrow>
          (\<lambda>s. integral\<^sup>N (M s) (f x)) = g (\<lambda>s. integral\<^sup>N (M s) x)"
     by (subst step) auto
 qed (insert bound, auto simp add: le_fun_def INF_apply[abs_def] top_fun_def intro!: meas f g)
 
 
 text \<open>Cauchy--Schwarz inequality for \<^const>\<open>nn_integral\<close>\<close>
 
 lemma sum_of_squares_ge_ennreal:
   fixes a b :: ennreal
   shows "2 * a * b \<le> a\<^sup>2 + b\<^sup>2"
 proof (cases a; cases b)
   fix x y
   assume xy: "x \<ge> 0" "y \<ge> 0" and [simp]: "a = ennreal x" "b = ennreal y"
   have "0 \<le> (x - y)\<^sup>2"
     by simp
   also have "\<dots> = x\<^sup>2 + y\<^sup>2 - 2 * x * y"
     by (simp add: algebra_simps power2_eq_square)
   finally have "2 * x * y \<le> x\<^sup>2 + y\<^sup>2"
     by simp
   hence "ennreal (2 * x * y) \<le> ennreal (x\<^sup>2 + y\<^sup>2)"
     by (intro ennreal_leI)
   thus ?thesis using xy
     by (simp add: ennreal_mult ennreal_power)
 qed auto
 
 lemma Cauchy_Schwarz_nn_integral:
   assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   shows "(\<integral>\<^sup>+x. f x * g x \<partial>M)\<^sup>2 \<le> (\<integral>\<^sup>+x. f x ^ 2 \<partial>M) * (\<integral>\<^sup>+x. g x ^ 2 \<partial>M)"
 proof (cases "(\<integral>\<^sup>+x. f x * g x \<partial>M) = 0")
   case False
   define F where "F = nn_integral M (\<lambda>x. f x ^ 2)"
   define G where "G = nn_integral M (\<lambda>x. g x ^ 2)"
   from False have "\<not>(AE x in M. f x = 0 \<or> g x = 0)"
     by (auto simp: nn_integral_0_iff_AE)
   hence "\<not>(AE x in M. f x = 0)" and "\<not>(AE x in M. g x = 0)"
     by (auto intro: AE_disjI1 AE_disjI2)
   hence nz: "F \<noteq> 0" "G \<noteq> 0"
     by (auto simp: nn_integral_0_iff_AE F_def G_def)
 
   show ?thesis
   proof (cases "F = \<infinity> \<or> G = \<infinity>")
     case True
     thus ?thesis using nz
       by (auto simp: F_def G_def)
   next
     case False
     define F' where "F' = ennreal (sqrt (enn2real F))"
     define G' where "G' = ennreal (sqrt (enn2real G))"
     from False have fin: "F < top" "G < top"
       by (simp_all add: top.not_eq_extremum)
     have F'_sqr: "F'\<^sup>2 = F"
       using False by (cases F) (auto simp: F'_def ennreal_power)
     have G'_sqr: "G'\<^sup>2 = G"
       using False by (cases G) (auto simp: G'_def ennreal_power)
     have nz': "F' \<noteq> 0" "G' \<noteq> 0" and fin': "F' \<noteq> \<infinity>" "G' \<noteq> \<infinity>"
       using F'_sqr G'_sqr nz fin by auto
     from fin' have fin'': "F' < top" "G' < top"
       by (auto simp: top.not_eq_extremum)
 
     have "2 * (F' / F') * (G' / G') * (\<integral>\<^sup>+x. f x * g x \<partial>M) =
           F' * G' * (\<integral>\<^sup>+x. 2 * (f x / F') * (g x / G') \<partial>M)"
       using nz' fin''
       by (simp add: divide_ennreal_def algebra_simps ennreal_inverse_mult flip: nn_integral_cmult)
     also have "F'/ F' = 1"
       using nz' fin'' by simp
     also have "G'/ G' = 1"
       using nz' fin'' by simp
     also have "2 * 1 * 1 = (2 :: ennreal)" by simp
     also have "F' * G' * (\<integral>\<^sup>+ x. 2 * (f x / F') * (g x / G') \<partial>M) \<le>
                F' * G' * (\<integral>\<^sup>+x. (f x / F')\<^sup>2 + (g x / G')\<^sup>2 \<partial>M)"
       by (intro mult_left_mono nn_integral_mono sum_of_squares_ge_ennreal) auto
     also have "\<dots> = F' * G' * (F / F'\<^sup>2 + G / G'\<^sup>2)" using nz
       by (auto simp: nn_integral_add algebra_simps nn_integral_divide F_def G_def)
     also have "F / F'\<^sup>2 = 1"
       using nz F'_sqr fin by simp
     also have "G / G'\<^sup>2 = 1"
       using nz G'_sqr fin by simp
     also have "F' * G' * (1 + 1) = 2 * (F' * G')"
       by (simp add: mult_ac)
     finally have "(\<integral>\<^sup>+x. f x * g x \<partial>M) \<le> F' * G'"
       by (subst (asm) ennreal_mult_le_mult_iff) auto
     hence "(\<integral>\<^sup>+x. f x * g x \<partial>M)\<^sup>2 \<le> (F' * G')\<^sup>2"
       by (intro power_mono_ennreal)
     also have "\<dots> = F * G"
       by (simp add: algebra_simps F'_sqr G'_sqr)
     finally show ?thesis
       by (simp add: F_def G_def)
   qed
 qed auto
 
 
 (* TODO: rename? *)
 subsection \<open>Integral under concrete measures\<close>
 
 lemma nn_integral_mono_measure:
   assumes "sets M = sets N" "M \<le> N" shows "nn_integral M f \<le> nn_integral N f"
   unfolding nn_integral_def
 proof (intro SUP_subset_mono)
   note \<open>sets M = sets N\<close>[simp]  \<open>sets M = sets N\<close>[THEN sets_eq_imp_space_eq, simp]
   show "{g. simple_function M g \<and> g \<le> f} \<subseteq> {g. simple_function N g \<and> g \<le> f}"
     by (simp add: simple_function_def)
   show "integral\<^sup>S M x \<le> integral\<^sup>S N x" for x
     using le_measureD3[OF \<open>M \<le> N\<close>]
     by (auto simp add: simple_integral_def intro!: sum_mono mult_mono)
 qed
 
 lemma nn_integral_empty:
   assumes "space M = {}"
   shows "nn_integral M f = 0"
 proof -
   have "(\<integral>\<^sup>+ x. f x \<partial>M) = (\<integral>\<^sup>+ x. 0 \<partial>M)"
     by(rule nn_integral_cong)(simp add: assms)
   thus ?thesis by simp
 qed
 
 lemma nn_integral_bot[simp]: "nn_integral bot f = 0"
   by (simp add: nn_integral_empty)
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Distributions\<close>
 
 lemma nn_integral_distr:
   assumes T: "T \<in> measurable M M'" and f: "f \<in> borel_measurable (distr M M' T)"
   shows "integral\<^sup>N (distr M M' T) f = (\<integral>\<^sup>+ x. f (T x) \<partial>M)"
   using f
 proof induct
   case (cong f g)
   with T show ?case
     apply (subst nn_integral_cong[of _ f g])
     apply simp
     apply (subst nn_integral_cong[of _ "\<lambda>x. f (T x)" "\<lambda>x. g (T x)"])
     apply (simp add: measurable_def Pi_iff)
     apply simp
     done
 next
   case (set A)
   then have eq: "\<And>x. x \<in> space M \<Longrightarrow> indicator A (T x) = indicator (T -` A \<inter> space M) x"
     by (auto simp: indicator_def)
   from set T show ?case
     by (subst nn_integral_cong[OF eq])
        (auto simp add: emeasure_distr intro!: nn_integral_indicator[symmetric] measurable_sets)
 qed (simp_all add: measurable_compose[OF T] T nn_integral_cmult nn_integral_add
                    nn_integral_monotone_convergence_SUP le_fun_def incseq_def image_comp)
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Counting space\<close>
 
 lemma simple_function_count_space[simp]:
   "simple_function (count_space A) f \<longleftrightarrow> finite (f ` A)"
   unfolding simple_function_def by simp
 
 lemma nn_integral_count_space:
   assumes A: "finite {a\<in>A. 0 < f a}"
   shows "integral\<^sup>N (count_space A) f = (\<Sum>a|a\<in>A \<and> 0 < f a. f a)"
 proof -
   have *: "(\<integral>\<^sup>+x. max 0 (f x) \<partial>count_space A) =
     (\<integral>\<^sup>+ x. (\<Sum>a|a\<in>A \<and> 0 < f a. f a * indicator {a} x) \<partial>count_space A)"
     by (auto intro!: nn_integral_cong
              simp add: indicator_def of_bool_def if_distrib sum.If_cases[OF A] max_def le_less)
   also have "\<dots> = (\<Sum>a|a\<in>A \<and> 0 < f a. \<integral>\<^sup>+ x. f a * indicator {a} x \<partial>count_space A)"
     by (subst nn_integral_sum) (simp_all add: AE_count_space  less_imp_le)
   also have "\<dots> = (\<Sum>a|a\<in>A \<and> 0 < f a. f a)"
     by (auto intro!: sum.cong simp: one_ennreal_def[symmetric] max_def)
   finally show ?thesis by (simp add: max.absorb2)
 qed
 
 lemma nn_integral_count_space_finite:
     "finite A \<Longrightarrow> (\<integral>\<^sup>+x. f x \<partial>count_space A) = (\<Sum>a\<in>A. f a)"
   by (auto intro!: sum.mono_neutral_left simp: nn_integral_count_space less_le)
 
 lemma nn_integral_count_space':
   assumes "finite A" "\<And>x. x \<in> B \<Longrightarrow> x \<notin> A \<Longrightarrow> f x = 0" "A \<subseteq> B"
   shows "(\<integral>\<^sup>+x. f x \<partial>count_space B) = (\<Sum>x\<in>A. f x)"
 proof -
   have "(\<integral>\<^sup>+x. f x \<partial>count_space B) = (\<Sum>a | a \<in> B \<and> 0 < f a. f a)"
     using assms(2,3)
     by (intro nn_integral_count_space finite_subset[OF _ \<open>finite A\<close>]) (auto simp: less_le)
   also have "\<dots> = (\<Sum>a\<in>A. f a)"
     using assms by (intro sum.mono_neutral_cong_left) (auto simp: less_le)
   finally show ?thesis .
 qed
 
 lemma nn_integral_bij_count_space:
   assumes g: "bij_betw g A B"
   shows "(\<integral>\<^sup>+x. f (g x) \<partial>count_space A) = (\<integral>\<^sup>+x. f x \<partial>count_space B)"
   using g[THEN bij_betw_imp_funcset]
   by (subst distr_bij_count_space[OF g, symmetric])
      (auto intro!: nn_integral_distr[symmetric])
 
 lemma nn_integral_indicator_finite:
   fixes f :: "'a \<Rightarrow> ennreal"
   assumes f: "finite A" and [measurable]: "\<And>a. a \<in> A \<Longrightarrow> {a} \<in> sets M"
   shows "(\<integral>\<^sup>+x. f x * indicator A x \<partial>M) = (\<Sum>x\<in>A. f x * emeasure M {x})"
 proof -
   from f have "(\<integral>\<^sup>+x. f x * indicator A x \<partial>M) = (\<integral>\<^sup>+x. (\<Sum>a\<in>A. f a * indicator {a} x) \<partial>M)"
     by (intro nn_integral_cong) (auto simp: indicator_def if_distrib[where f="\<lambda>a. x * a" for x] sum.If_cases)
   also have "\<dots> = (\<Sum>a\<in>A. f a * emeasure M {a})"
     by (subst nn_integral_sum) auto
   finally show ?thesis .
 qed
 
 lemma nn_integral_count_space_nat:
   fixes f :: "nat \<Rightarrow> ennreal"
   shows "(\<integral>\<^sup>+i. f i \<partial>count_space UNIV) = (\<Sum>i. f i)"
 proof -
   have "(\<integral>\<^sup>+i. f i \<partial>count_space UNIV) =
     (\<integral>\<^sup>+i. (\<Sum>j. f j * indicator {j} i) \<partial>count_space UNIV)"
   proof (intro nn_integral_cong)
     fix i
     have "f i = (\<Sum>j\<in>{i}. f j * indicator {j} i)"
       by simp
     also have "\<dots> = (\<Sum>j. f j * indicator {j} i)"
       by (rule suminf_finite[symmetric]) auto
     finally show "f i = (\<Sum>j. f j * indicator {j} i)" .
   qed
   also have "\<dots> = (\<Sum>j. (\<integral>\<^sup>+i. f j * indicator {j} i \<partial>count_space UNIV))"
     by (rule nn_integral_suminf) auto
   finally show ?thesis
     by simp
 qed
 
 lemma nn_integral_enat_function:
   assumes f: "f \<in> measurable M (count_space UNIV)"
   shows "(\<integral>\<^sup>+ x. ennreal_of_enat (f x) \<partial>M) = (\<Sum>t. emeasure M {x \<in> space M. t < f x})"
 proof -
   define F where "F i = {x\<in>space M. i < f x}" for i :: nat
   with assms have [measurable]: "\<And>i. F i \<in> sets M"
     by auto
 
   { fix x assume "x \<in> space M"
     have "(\<lambda>i::nat. if i < f x then 1 else 0) sums ennreal_of_enat (f x)"
       using sums_If_finite[of "\<lambda>r. r < f x" "\<lambda>_. 1 :: ennreal"]
       by (cases "f x") (simp_all add: sums_def of_nat_tendsto_top_ennreal)
     also have "(\<lambda>i. (if i < f x then 1 else 0)) = (\<lambda>i. indicator (F i) x)"
       using \<open>x \<in> space M\<close> by (simp add: one_ennreal_def F_def fun_eq_iff)
     finally have "ennreal_of_enat (f x) = (\<Sum>i. indicator (F i) x)"
       by (simp add: sums_iff) }
   then have "(\<integral>\<^sup>+x. ennreal_of_enat (f x) \<partial>M) = (\<integral>\<^sup>+x. (\<Sum>i. indicator (F i) x) \<partial>M)"
     by (simp cong: nn_integral_cong)
   also have "\<dots> = (\<Sum>i. emeasure M (F i))"
     by (simp add: nn_integral_suminf)
   finally show ?thesis
     by (simp add: F_def)
 qed
 
 lemma nn_integral_count_space_nn_integral:
   fixes f :: "'i \<Rightarrow> 'a \<Rightarrow> ennreal"
   assumes "countable I" and [measurable]: "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
   shows "(\<integral>\<^sup>+x. \<integral>\<^sup>+i. f i x \<partial>count_space I \<partial>M) = (\<integral>\<^sup>+i. \<integral>\<^sup>+x. f i x \<partial>M \<partial>count_space I)"
 proof cases
   assume "finite I" then show ?thesis
     by (simp add: nn_integral_count_space_finite nn_integral_sum)
 next
   assume "infinite I"
   then have [simp]: "I \<noteq> {}"
     by auto
   note * = bij_betw_from_nat_into[OF \<open>countable I\<close> \<open>infinite I\<close>]
   have **: "\<And>f. (\<And>i. 0 \<le> f i) \<Longrightarrow> (\<integral>\<^sup>+i. f i \<partial>count_space I) = (\<Sum>n. f (from_nat_into I n))"
     by (simp add: nn_integral_bij_count_space[symmetric, OF *] nn_integral_count_space_nat)
   show ?thesis
     by (simp add: ** nn_integral_suminf from_nat_into)
 qed
 
 lemma of_bool_Bex_eq_nn_integral:
   assumes unique: "\<And>x y. x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> P x \<Longrightarrow> P y \<Longrightarrow> x = y"
   shows "of_bool (\<exists>y\<in>X. P y) = (\<integral>\<^sup>+y. of_bool (P y) \<partial>count_space X)"
 proof cases
   assume "\<exists>y\<in>X. P y"
   then obtain y where "P y" "y \<in> X" by auto
   then show ?thesis
     by (subst nn_integral_count_space'[where A="{y}"]) (auto dest: unique)
 qed (auto cong: nn_integral_cong_simp)
 
 lemma emeasure_UN_countable:
   assumes sets[measurable]: "\<And>i. i \<in> I \<Longrightarrow> X i \<in> sets M" and I[simp]: "countable I"
   assumes disj: "disjoint_family_on X I"
   shows "emeasure M (\<Union>(X ` I)) = (\<integral>\<^sup>+i. emeasure M (X i) \<partial>count_space I)"
 proof -
   have eq: "\<And>x. indicator (\<Union>(X ` I)) x = \<integral>\<^sup>+ i. indicator (X i) x \<partial>count_space I"
   proof cases
     fix x assume x: "x \<in> \<Union>(X ` I)"
     then obtain j where j: "x \<in> X j" "j \<in> I"
       by auto
     with disj have "\<And>i. i \<in> I \<Longrightarrow> indicator (X i) x = (indicator {j} i::ennreal)"
       by (auto simp: disjoint_family_on_def split: split_indicator)
     with x j show "?thesis x"
       by (simp cong: nn_integral_cong_simp)
   qed (auto simp: nn_integral_0_iff_AE)
 
   note sets.countable_UN'[unfolded subset_eq, measurable]
   have "emeasure M (\<Union>(X ` I)) = (\<integral>\<^sup>+x. indicator (\<Union>(X ` I)) x \<partial>M)"
     by simp
   also have "\<dots> = (\<integral>\<^sup>+i. \<integral>\<^sup>+x. indicator (X i) x \<partial>M \<partial>count_space I)"
     by (simp add: eq nn_integral_count_space_nn_integral)
   finally show ?thesis
     by (simp cong: nn_integral_cong_simp)
 qed
 
 lemma emeasure_countable_singleton:
   assumes sets: "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M" and X: "countable X"
   shows "emeasure M X = (\<integral>\<^sup>+x. emeasure M {x} \<partial>count_space X)"
 proof -
   have "emeasure M (\<Union>i\<in>X. {i}) = (\<integral>\<^sup>+x. emeasure M {x} \<partial>count_space X)"
     using assms by (intro emeasure_UN_countable) (auto simp: disjoint_family_on_def)
   also have "(\<Union>i\<in>X. {i}) = X" by auto
   finally show ?thesis .
 qed
 
 lemma measure_eqI_countable:
   assumes [simp]: "sets M = Pow A" "sets N = Pow A" and A: "countable A"
   assumes eq: "\<And>a. a \<in> A \<Longrightarrow> emeasure M {a} = emeasure N {a}"
   shows "M = N"
 proof (rule measure_eqI)
   fix X assume "X \<in> sets M"
   then have X: "X \<subseteq> A" by auto
   moreover from A X have "countable X" by (auto dest: countable_subset)
   ultimately have
     "emeasure M X = (\<integral>\<^sup>+a. emeasure M {a} \<partial>count_space X)"
     "emeasure N X = (\<integral>\<^sup>+a. emeasure N {a} \<partial>count_space X)"
     by (auto intro!: emeasure_countable_singleton)
   moreover have "(\<integral>\<^sup>+a. emeasure M {a} \<partial>count_space X) = (\<integral>\<^sup>+a. emeasure N {a} \<partial>count_space X)"
     using X by (intro nn_integral_cong eq) auto
   ultimately show "emeasure M X = emeasure N X"
     by simp
 qed simp
 
 lemma measure_eqI_countable_AE:
   assumes [simp]: "sets M = UNIV" "sets N = UNIV"
   assumes ae: "AE x in M. x \<in> \<Omega>" "AE x in N. x \<in> \<Omega>" and [simp]: "countable \<Omega>"
   assumes eq: "\<And>x. x \<in> \<Omega> \<Longrightarrow> emeasure M {x} = emeasure N {x}"
   shows "M = N"
 proof (rule measure_eqI)
   fix A
   have "emeasure N A = emeasure N {x\<in>\<Omega>. x \<in> A}"
     using ae by (intro emeasure_eq_AE) auto
   also have "\<dots> = (\<integral>\<^sup>+x. emeasure N {x} \<partial>count_space {x\<in>\<Omega>. x \<in> A})"
     by (intro emeasure_countable_singleton) auto
   also have "\<dots> = (\<integral>\<^sup>+x. emeasure M {x} \<partial>count_space {x\<in>\<Omega>. x \<in> A})"
     by (intro nn_integral_cong eq[symmetric]) auto
   also have "\<dots> = emeasure M {x\<in>\<Omega>. x \<in> A}"
     by (intro emeasure_countable_singleton[symmetric]) auto
   also have "\<dots> = emeasure M A"
     using ae by (intro emeasure_eq_AE) auto
   finally show "emeasure M A = emeasure N A" ..
 qed simp
 
 lemma nn_integral_monotone_convergence_SUP_nat:
   fixes f :: "'a \<Rightarrow> nat \<Rightarrow> ennreal"
   assumes chain: "Complete_Partial_Order.chain (\<le>) (f ` Y)"
   and nonempty: "Y \<noteq> {}"
   shows "(\<integral>\<^sup>+ x. (SUP i\<in>Y. f i x) \<partial>count_space UNIV) = (SUP i\<in>Y. (\<integral>\<^sup>+ x. f i x \<partial>count_space UNIV))"
   (is "?lhs = ?rhs" is "integral\<^sup>N ?M _ = _")
 proof (rule order_class.order.antisym)
   show "?rhs \<le> ?lhs"
     by (auto intro!: SUP_least SUP_upper nn_integral_mono)
 next
   have "\<exists>g. incseq g \<and> range g \<subseteq> (\<lambda>i. f i x) ` Y \<and> (SUP i\<in>Y. f i x) = (SUP i. g i)" for x
     by (rule ennreal_Sup_countable_SUP) (simp add: nonempty)
   then obtain g where incseq: "\<And>x. incseq (g x)"
     and range: "\<And>x. range (g x) \<subseteq> (\<lambda>i. f i x) ` Y"
     and sup: "\<And>x. (SUP i\<in>Y. f i x) = (SUP i. g x i)" by moura
   from incseq have incseq': "incseq (\<lambda>i x. g x i)"
     by(blast intro: incseq_SucI le_funI dest: incseq_SucD)
 
   have "?lhs = \<integral>\<^sup>+ x. (SUP i. g x i) \<partial>?M" by(simp add: sup)
   also have "\<dots> = (SUP i. \<integral>\<^sup>+ x. g x i \<partial>?M)" using incseq'
     by(rule nn_integral_monotone_convergence_SUP) simp
   also have "\<dots> \<le> (SUP i\<in>Y. \<integral>\<^sup>+ x. f i x \<partial>?M)"
   proof(rule SUP_least)
     fix n
     have "\<And>x. \<exists>i. g x n = f i x \<and> i \<in> Y" using range by blast
     then obtain I where I: "\<And>x. g x n = f (I x) x" "\<And>x. I x \<in> Y" by moura
 
     have "(\<integral>\<^sup>+ x. g x n \<partial>count_space UNIV) = (\<Sum>x. g x n)"
       by(rule nn_integral_count_space_nat)
     also have "\<dots> = (SUP m. \<Sum>x<m. g x n)"
       by(rule suminf_eq_SUP)
     also have "\<dots> \<le> (SUP i\<in>Y. \<integral>\<^sup>+ x. f i x \<partial>?M)"
     proof(rule SUP_mono)
       fix m
       show "\<exists>m'\<in>Y. (\<Sum>x<m. g x n) \<le> (\<integral>\<^sup>+ x. f m' x \<partial>?M)"
       proof(cases "m > 0")
         case False
         thus ?thesis using nonempty by auto
       next
         case True
         let ?Y = "I ` {..<m}"
         have "f ` ?Y \<subseteq> f ` Y" using I by auto
         with chain have chain': "Complete_Partial_Order.chain (\<le>) (f ` ?Y)" by(rule chain_subset)
         hence "Sup (f ` ?Y) \<in> f ` ?Y"
           by(rule ccpo_class.in_chain_finite)(auto simp add: True lessThan_empty_iff)
         then obtain m' where "m' < m" and m': "(SUP i\<in>?Y. f i) = f (I m')" by auto
         have "I m' \<in> Y" using I by blast
         have "(\<Sum>x<m. g x n) \<le> (\<Sum>x<m. f (I m') x)"
         proof(rule sum_mono)
           fix x
           assume "x \<in> {..<m}"
           hence "x < m" by simp
           have "g x n = f (I x) x" by(simp add: I)
           also have "\<dots> \<le> (SUP i\<in>?Y. f i) x" unfolding Sup_fun_def image_image
             using \<open>x \<in> {..<m}\<close> by (rule Sup_upper [OF imageI])
           also have "\<dots> = f (I m') x" unfolding m' by simp
           finally show "g x n \<le> f (I m') x" .
         qed
         also have "\<dots> \<le> (SUP m. (\<Sum>x<m. f (I m') x))"
           by(rule SUP_upper) simp
         also have "\<dots> = (\<Sum>x. f (I m') x)"
           by(rule suminf_eq_SUP[symmetric])
         also have "\<dots> = (\<integral>\<^sup>+ x. f (I m') x \<partial>?M)"
           by(rule nn_integral_count_space_nat[symmetric])
         finally show ?thesis using \<open>I m' \<in> Y\<close> by blast
       qed
     qed
     finally show "(\<integral>\<^sup>+ x. g x n \<partial>count_space UNIV) \<le> \<dots>" .
   qed
   finally show "?lhs \<le> ?rhs" .
 qed
 
 lemma power_series_tendsto_at_left:
   assumes nonneg: "\<And>i. 0 \<le> f i" and summable: "\<And>z. 0 \<le> z \<Longrightarrow> z < 1 \<Longrightarrow> summable (\<lambda>n. f n * z^n)"
   shows "((\<lambda>z. ennreal (\<Sum>n. f n * z^n)) \<longlongrightarrow> (\<Sum>n. ennreal (f n))) (at_left (1::real))"
 proof (intro tendsto_at_left_sequentially)
   show "0 < (1::real)" by simp
   fix S :: "nat \<Rightarrow> real" assume S: "\<And>n. S n < 1" "\<And>n. 0 < S n" "S \<longlonglongrightarrow> 1" "incseq S"
   then have S_nonneg: "\<And>i. 0 \<le> S i" by (auto intro: less_imp_le)
 
   have "(\<lambda>i. (\<integral>\<^sup>+n. f n * S i^n \<partial>count_space UNIV)) \<longlonglongrightarrow> (\<integral>\<^sup>+n. ennreal (f n) \<partial>count_space UNIV)"
   proof (rule nn_integral_LIMSEQ)
     show "incseq (\<lambda>i n. ennreal (f n * S i^n))"
       using S by (auto intro!: mult_mono power_mono nonneg ennreal_leI
                        simp: incseq_def le_fun_def less_imp_le)
     fix n have "(\<lambda>i. ennreal (f n * S i^n)) \<longlonglongrightarrow> ennreal (f n * 1^n)"
       by (intro tendsto_intros tendsto_ennrealI S)
     then show "(\<lambda>i. ennreal (f n * S i^n)) \<longlonglongrightarrow> ennreal (f n)"
       by simp
   qed (auto simp: S_nonneg intro!: mult_nonneg_nonneg nonneg)
   also have "(\<lambda>i. (\<integral>\<^sup>+n. f n * S i^n \<partial>count_space UNIV)) = (\<lambda>i. \<Sum>n. f n * S i^n)"
     by (subst nn_integral_count_space_nat)
        (intro ext suminf_ennreal2 mult_nonneg_nonneg nonneg S_nonneg
               zero_le_power summable S)+
   also have "(\<integral>\<^sup>+n. ennreal (f n) \<partial>count_space UNIV) = (\<Sum>n. ennreal (f n))"
     by (simp add: nn_integral_count_space_nat nonneg)
   finally show "(\<lambda>n. ennreal (\<Sum>na. f na * S n ^ na)) \<longlonglongrightarrow> (\<Sum>n. ennreal (f n))" .
 qed
 
 subsubsection \<open>Measures with Restricted Space\<close>
 
 lemma simple_function_restrict_space_ennreal:
   fixes f :: "'a \<Rightarrow> ennreal"
   assumes "\<Omega> \<inter> space M \<in> sets M"
   shows "simple_function (restrict_space M \<Omega>) f \<longleftrightarrow> simple_function M (\<lambda>x. f x * indicator \<Omega> x)"
 proof -
   { assume "finite (f ` space (restrict_space M \<Omega>))"
     then have "finite (f ` space (restrict_space M \<Omega>) \<union> {0})" by simp
     then have "finite ((\<lambda>x. f x * indicator \<Omega> x) ` space M)"
       by (rule rev_finite_subset) (auto split: split_indicator simp: space_restrict_space) }
   moreover
   { assume "finite ((\<lambda>x. f x * indicator \<Omega> x) ` space M)"
     then have "finite (f ` space (restrict_space M \<Omega>))"
       by (rule rev_finite_subset) (auto split: split_indicator simp: space_restrict_space) }
   ultimately show ?thesis
     unfolding
       simple_function_iff_borel_measurable borel_measurable_restrict_space_iff_ennreal[OF assms]
     by auto
 qed
 
 lemma simple_function_restrict_space:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   assumes "\<Omega> \<inter> space M \<in> sets M"
   shows "simple_function (restrict_space M \<Omega>) f \<longleftrightarrow> simple_function M (\<lambda>x. indicator \<Omega> x *\<^sub>R f x)"
 proof -
   { assume "finite (f ` space (restrict_space M \<Omega>))"
     then have "finite (f ` space (restrict_space M \<Omega>) \<union> {0})" by simp
     then have "finite ((\<lambda>x. indicator \<Omega> x *\<^sub>R f x) ` space M)"
       by (rule rev_finite_subset) (auto split: split_indicator simp: space_restrict_space) }
   moreover
   { assume "finite ((\<lambda>x. indicator \<Omega> x *\<^sub>R f x) ` space M)"
     then have "finite (f ` space (restrict_space M \<Omega>))"
       by (rule rev_finite_subset) (auto split: split_indicator simp: space_restrict_space) }
   ultimately show ?thesis
     unfolding simple_function_iff_borel_measurable
       borel_measurable_restrict_space_iff[OF assms]
     by auto
 qed
 
 lemma simple_integral_restrict_space:
   assumes \<Omega>: "\<Omega> \<inter> space M \<in> sets M" "simple_function (restrict_space M \<Omega>) f"
   shows "simple_integral (restrict_space M \<Omega>) f = simple_integral M (\<lambda>x. f x * indicator \<Omega> x)"
   using simple_function_restrict_space_ennreal[THEN iffD1, OF \<Omega>, THEN simple_functionD(1)]
   by (auto simp add: space_restrict_space emeasure_restrict_space[OF \<Omega>(1)] le_infI2 simple_integral_def
            split: split_indicator split_indicator_asm
            intro!: sum.mono_neutral_cong_left ennreal_mult_left_cong arg_cong2[where f=emeasure])
 
 lemma nn_integral_restrict_space:
   assumes \<Omega>[simp]: "\<Omega> \<inter> space M \<in> sets M"
   shows "nn_integral (restrict_space M \<Omega>) f = nn_integral M (\<lambda>x. f x * indicator \<Omega> x)"
 proof -
   let ?R = "restrict_space M \<Omega>" and ?X = "\<lambda>M f. {s. simple_function M s \<and> s \<le> f \<and> (\<forall>x. s x < top)}"
   have "integral\<^sup>S ?R ` ?X ?R f = integral\<^sup>S M ` ?X M (\<lambda>x. f x * indicator \<Omega> x)"
   proof (safe intro!: image_eqI)
     fix s assume s: "simple_function ?R s" "s \<le> f" "\<forall>x. s x < top"
     from s show "integral\<^sup>S (restrict_space M \<Omega>) s = integral\<^sup>S M (\<lambda>x. s x * indicator \<Omega> x)"
       by (intro simple_integral_restrict_space) auto
     from s show "simple_function M (\<lambda>x. s x * indicator \<Omega> x)"
       by (simp add: simple_function_restrict_space_ennreal)
     from s show "(\<lambda>x. s x * indicator \<Omega> x) \<le> (\<lambda>x. f x * indicator \<Omega> x)"
       "\<And>x. s x * indicator \<Omega> x < top"
       by (auto split: split_indicator simp: le_fun_def image_subset_iff)
   next
     fix s assume s: "simple_function M s" "s \<le> (\<lambda>x. f x * indicator \<Omega> x)" "\<forall>x. s x < top"
     then have "simple_function M (\<lambda>x. s x * indicator (\<Omega> \<inter> space M) x)" (is ?s')
       by (intro simple_function_mult simple_function_indicator) auto
     also have "?s' \<longleftrightarrow> simple_function M (\<lambda>x. s x * indicator \<Omega> x)"
       by (rule simple_function_cong) (auto split: split_indicator)
     finally show sf: "simple_function (restrict_space M \<Omega>) s"
       by (simp add: simple_function_restrict_space_ennreal)
 
     from s have s_eq: "s = (\<lambda>x. s x * indicator \<Omega> x)"
       by (auto simp add: fun_eq_iff le_fun_def image_subset_iff
                   split: split_indicator split_indicator_asm
                   intro: antisym)
 
     show "integral\<^sup>S M s = integral\<^sup>S (restrict_space M \<Omega>) s"
       by (subst s_eq) (rule simple_integral_restrict_space[symmetric, OF \<Omega> sf])
     show "\<And>x. s x < top"
       using s by (auto simp: image_subset_iff)
     from s show "s \<le> f"
       by (subst s_eq) (auto simp: image_subset_iff le_fun_def split: split_indicator split_indicator_asm)
   qed
   then show ?thesis
     unfolding nn_integral_def_finite by (simp cong del: SUP_cong_simp)
 qed
 
 lemma nn_integral_count_space_indicator:
   assumes "NO_MATCH (UNIV::'a set) (X::'a set)"
   shows "(\<integral>\<^sup>+x. f x \<partial>count_space X) = (\<integral>\<^sup>+x. f x * indicator X x \<partial>count_space UNIV)"
   by (simp add: nn_integral_restrict_space[symmetric] restrict_count_space)
 
 lemma nn_integral_count_space_eq:
   "(\<And>x. x \<in> A - B \<Longrightarrow> f x = 0) \<Longrightarrow> (\<And>x. x \<in> B - A \<Longrightarrow> f x = 0) \<Longrightarrow>
     (\<integral>\<^sup>+x. f x \<partial>count_space A) = (\<integral>\<^sup>+x. f x \<partial>count_space B)"
   by (auto simp: nn_integral_count_space_indicator intro!: nn_integral_cong split: split_indicator)
 
 lemma nn_integral_ge_point:
   assumes "x \<in> A"
   shows "p x \<le> \<integral>\<^sup>+ x. p x \<partial>count_space A"
 proof -
   from assms have "p x \<le> \<integral>\<^sup>+ x. p x \<partial>count_space {x}"
     by(auto simp add: nn_integral_count_space_finite max_def)
   also have "\<dots> = \<integral>\<^sup>+ x'. p x' * indicator {x} x' \<partial>count_space A"
     using assms by(auto simp add: nn_integral_count_space_indicator indicator_def intro!: nn_integral_cong)
   also have "\<dots> \<le> \<integral>\<^sup>+ x. p x \<partial>count_space A"
     by(rule nn_integral_mono)(simp add: indicator_def)
   finally show ?thesis .
 qed
 
 subsubsection \<open>Measure spaces with an associated density\<close>
 
 definition\<^marker>\<open>tag important\<close> density :: "'a measure \<Rightarrow> ('a \<Rightarrow> ennreal) \<Rightarrow> 'a measure" where
   "density M f = measure_of (space M) (sets M) (\<lambda>A. \<integral>\<^sup>+ x. f x * indicator A x \<partial>M)"
 
 lemma
   shows sets_density[simp, measurable_cong]: "sets (density M f) = sets M"
     and space_density[simp]: "space (density M f) = space M"
   by (auto simp: density_def)
 
 (* FIXME: add conversion to simplify space, sets and measurable *)
 lemma space_density_imp[measurable_dest]:
   "\<And>x M f. x \<in> space (density M f) \<Longrightarrow> x \<in> space M" by auto
 
 lemma
   shows measurable_density_eq1[simp]: "g \<in> measurable (density Mg f) Mg' \<longleftrightarrow> g \<in> measurable Mg Mg'"
     and measurable_density_eq2[simp]: "h \<in> measurable Mh (density Mh' f) \<longleftrightarrow> h \<in> measurable Mh Mh'"
     and simple_function_density_eq[simp]: "simple_function (density Mu f) u \<longleftrightarrow> simple_function Mu u"
   unfolding measurable_def simple_function_def by simp_all
 
 lemma density_cong: "f \<in> borel_measurable M \<Longrightarrow> f' \<in> borel_measurable M \<Longrightarrow>
   (AE x in M. f x = f' x) \<Longrightarrow> density M f = density M f'"
   unfolding density_def by (auto intro!: measure_of_eq nn_integral_cong_AE sets.space_closed)
 
 lemma emeasure_density:
   assumes f[measurable]: "f \<in> borel_measurable M" and A[measurable]: "A \<in> sets M"
   shows "emeasure (density M f) A = (\<integral>\<^sup>+ x. f x * indicator A x \<partial>M)"
     (is "_ = ?\<mu> A")
   unfolding density_def
 proof (rule emeasure_measure_of_sigma)
   show "sigma_algebra (space M) (sets M)" ..
   show "positive (sets M) ?\<mu>"
     using f by (auto simp: positive_def)
   show "countably_additive (sets M) ?\<mu>"
   proof (intro countably_additiveI)
     fix A :: "nat \<Rightarrow> 'a set" assume "range A \<subseteq> sets M"
     then have "\<And>i. A i \<in> sets M" by auto
     then have *: "\<And>i. (\<lambda>x. f x * indicator (A i) x) \<in> borel_measurable M"
       by auto
     assume disj: "disjoint_family A"
     then have "(\<Sum>n. ?\<mu> (A n)) = (\<integral>\<^sup>+ x. (\<Sum>n. f x * indicator (A n) x) \<partial>M)"
        using f * by (subst nn_integral_suminf) auto
     also have "(\<integral>\<^sup>+ x. (\<Sum>n. f x * indicator (A n) x) \<partial>M) = (\<integral>\<^sup>+ x. f x * (\<Sum>n. indicator (A n) x) \<partial>M)"
       using f by (auto intro!: ennreal_suminf_cmult nn_integral_cong_AE)
     also have "\<dots> = (\<integral>\<^sup>+ x. f x * indicator (\<Union>n. A n) x \<partial>M)"
       unfolding suminf_indicator[OF disj] ..
     finally show "(\<Sum>i. \<integral>\<^sup>+ x. f x * indicator (A i) x \<partial>M) = \<integral>\<^sup>+ x. f x * indicator (\<Union>i. A i) x \<partial>M" .
   qed
 qed fact
 
 lemma null_sets_density_iff:
   assumes f: "f \<in> borel_measurable M"
   shows "A \<in> null_sets (density M f) \<longleftrightarrow> A \<in> sets M \<and> (AE x in M. x \<in> A \<longrightarrow> f x = 0)"
 proof -
   { assume "A \<in> sets M"
     have "(\<integral>\<^sup>+x. f x * indicator A x \<partial>M) = 0 \<longleftrightarrow> emeasure M {x \<in> space M. f x * indicator A x \<noteq> 0} = 0"
       using f \<open>A \<in> sets M\<close> by (intro nn_integral_0_iff) auto
     also have "\<dots> \<longleftrightarrow> (AE x in M. f x * indicator A x = 0)"
       using f \<open>A \<in> sets M\<close> by (intro AE_iff_measurable[OF _ refl, symmetric]) auto
     also have "(AE x in M. f x * indicator A x = 0) \<longleftrightarrow> (AE x in M. x \<in> A \<longrightarrow> f x \<le> 0)"
       by (auto simp add: indicator_def max_def split: if_split_asm)
     finally have "(\<integral>\<^sup>+x. f x * indicator A x \<partial>M) = 0 \<longleftrightarrow> (AE x in M. x \<in> A \<longrightarrow> f x \<le> 0)" . }
   with f show ?thesis
     by (simp add: null_sets_def emeasure_density cong: conj_cong)
 qed
 
 lemma AE_density:
   assumes f: "f \<in> borel_measurable M"
   shows "(AE x in density M f. P x) \<longleftrightarrow> (AE x in M. 0 < f x \<longrightarrow> P x)"
 proof
   assume "AE x in density M f. P x"
   with f obtain N where "{x \<in> space M. \<not> P x} \<subseteq> N" "N \<in> sets M" and ae: "AE x in M. x \<in> N \<longrightarrow> f x = 0"
     by (auto simp: eventually_ae_filter null_sets_density_iff)
   then have "AE x in M. x \<notin> N \<longrightarrow> P x" by auto
   with ae show "AE x in M. 0 < f x \<longrightarrow> P x"
     by (rule eventually_elim2) auto
 next
   fix N assume ae: "AE x in M. 0 < f x \<longrightarrow> P x"
   then obtain N where "{x \<in> space M. \<not> (0 < f x \<longrightarrow> P x)} \<subseteq> N" "N \<in> null_sets M"
     by (auto simp: eventually_ae_filter)
   then have *: "{x \<in> space (density M f). \<not> P x} \<subseteq> N \<union> {x\<in>space M. f x = 0}"
     "N \<union> {x\<in>space M. f x = 0} \<in> sets M" and ae2: "AE x in M. x \<notin> N"
     using f by (auto simp: subset_eq zero_less_iff_neq_zero intro!: AE_not_in)
   show "AE x in density M f. P x"
     using ae2
     unfolding eventually_ae_filter[of _ "density M f"] Bex_def null_sets_density_iff[OF f]
     by (intro exI[of _ "N \<union> {x\<in>space M. f x = 0}"] conjI *) (auto elim: eventually_elim2)
 qed
 
 lemma\<^marker>\<open>tag important\<close> nn_integral_density:
   assumes f: "f \<in> borel_measurable M"
   assumes g: "g \<in> borel_measurable M"
   shows "integral\<^sup>N (density M f) g = (\<integral>\<^sup>+ x. f x * g x \<partial>M)"
 using g proof induct
   case (cong u v)
   then show ?case
     apply (subst nn_integral_cong[OF cong(3)])
     apply (simp_all cong: nn_integral_cong)
     done
 next
   case (set A) then show ?case
     by (simp add: emeasure_density f)
 next
   case (mult u c)
   moreover have "\<And>x. f x * (c * u x) = c * (f x * u x)" by (simp add: field_simps)
   ultimately show ?case
     using f by (simp add: nn_integral_cmult)
 next
   case (add u v)
   then have "\<And>x. f x * (v x + u x) = f x * v x + f x * u x"
     by (simp add: distrib_left)
   with add f show ?case
     by (auto simp add: nn_integral_add intro!: nn_integral_add[symmetric])
 next
   case (seq U)
   have eq: "AE x in M. f x * (SUP i. U i x) = (SUP i. f x * U i x)"
     by eventually_elim (simp add: SUP_mult_left_ennreal seq)
   from seq f show ?case
     apply (simp add: nn_integral_monotone_convergence_SUP image_comp)
     apply (subst nn_integral_cong_AE[OF eq])
     apply (subst nn_integral_monotone_convergence_SUP_AE)
     apply (auto simp: incseq_def le_fun_def intro!: mult_left_mono)
     done
 qed
 
 lemma density_distr:
   assumes [measurable]: "f \<in> borel_measurable N" "X \<in> measurable M N"
   shows "density (distr M N X) f = distr (density M (\<lambda>x. f (X x))) N X"
   by (intro measure_eqI)
      (auto simp add: emeasure_density nn_integral_distr emeasure_distr
            split: split_indicator intro!: nn_integral_cong)
 
 lemma emeasure_restricted:
   assumes S: "S \<in> sets M" and X: "X \<in> sets M"
   shows "emeasure (density M (indicator S)) X = emeasure M (S \<inter> X)"
 proof -
   have "emeasure (density M (indicator S)) X = (\<integral>\<^sup>+x. indicator S x * indicator X x \<partial>M)"
     using S X by (simp add: emeasure_density)
   also have "\<dots> = (\<integral>\<^sup>+x. indicator (S \<inter> X) x \<partial>M)"
     by (auto intro!: nn_integral_cong simp: indicator_def)
   also have "\<dots> = emeasure M (S \<inter> X)"
     using S X by (simp add: sets.Int)
   finally show ?thesis .
 qed
 
 lemma measure_restricted:
   "S \<in> sets M \<Longrightarrow> X \<in> sets M \<Longrightarrow> measure (density M (indicator S)) X = measure M (S \<inter> X)"
   by (simp add: emeasure_restricted measure_def)
 
 lemma (in finite_measure) finite_measure_restricted:
   "S \<in> sets M \<Longrightarrow> finite_measure (density M (indicator S))"
   by standard (simp add: emeasure_restricted)
 
 lemma emeasure_density_const:
   "A \<in> sets M \<Longrightarrow> emeasure (density M (\<lambda>_. c)) A = c * emeasure M A"
   by (auto simp: nn_integral_cmult_indicator emeasure_density)
 
 lemma measure_density_const:
   "A \<in> sets M \<Longrightarrow> c \<noteq> \<infinity> \<Longrightarrow> measure (density M (\<lambda>_. c)) A = enn2real c * measure M A"
   by (auto simp: emeasure_density_const measure_def enn2real_mult)
 
 lemma density_density_eq:
    "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow>
    density (density M f) g = density M (\<lambda>x. f x * g x)"
   by (auto intro!: measure_eqI simp: emeasure_density nn_integral_density ac_simps)
 
 lemma distr_density_distr:
   assumes T: "T \<in> measurable M M'" and T': "T' \<in> measurable M' M"
     and inv: "\<forall>x\<in>space M. T' (T x) = x"
   assumes f: "f \<in> borel_measurable M'"
   shows "distr (density (distr M M' T) f) M T' = density M (f \<circ> T)" (is "?R = ?L")
 proof (rule measure_eqI)
   fix A assume A: "A \<in> sets ?R"
   { fix x assume "x \<in> space M"
     with sets.sets_into_space[OF A]
     have "indicator (T' -` A \<inter> space M') (T x) = (indicator A x :: ennreal)"
       using T inv by (auto simp: indicator_def measurable_space) }
   with A T T' f show "emeasure ?R A = emeasure ?L A"
     by (simp add: measurable_comp emeasure_density emeasure_distr
                   nn_integral_distr measurable_sets cong: nn_integral_cong)
 qed simp
 
 lemma density_density_divide:
   fixes f g :: "'a \<Rightarrow> real"
   assumes f: "f \<in> borel_measurable M" "AE x in M. 0 \<le> f x"
   assumes g: "g \<in> borel_measurable M" "AE x in M. 0 \<le> g x"
   assumes ac: "AE x in M. f x = 0 \<longrightarrow> g x = 0"
   shows "density (density M f) (\<lambda>x. g x / f x) = density M g"
 proof -
   have "density M g = density M (\<lambda>x. ennreal (f x) * ennreal (g x / f x))"
     using f g ac by (auto intro!: density_cong measurable_If simp: ennreal_mult[symmetric])
   then show ?thesis
     using f g by (subst density_density_eq) auto
 qed
 
 lemma density_1: "density M (\<lambda>_. 1) = M"
   by (intro measure_eqI) (auto simp: emeasure_density)
 
 lemma emeasure_density_add:
   assumes X: "X \<in> sets M"
   assumes Mf[measurable]: "f \<in> borel_measurable M"
   assumes Mg[measurable]: "g \<in> borel_measurable M"
   shows "emeasure (density M f) X + emeasure (density M g) X =
            emeasure (density M (\<lambda>x. f x + g x)) X"
   using assms
   apply (subst (1 2 3) emeasure_density, simp_all) []
   apply (subst nn_integral_add[symmetric], simp_all) []
   apply (intro nn_integral_cong, simp split: split_indicator)
   done
 
 subsubsection \<open>Point measure\<close>
 
 definition\<^marker>\<open>tag important\<close> point_measure :: "'a set \<Rightarrow> ('a \<Rightarrow> ennreal) \<Rightarrow> 'a measure" where
   "point_measure A f = density (count_space A) f"
 
 lemma
   shows space_point_measure: "space (point_measure A f) = A"
     and sets_point_measure: "sets (point_measure A f) = Pow A"
   by (auto simp: point_measure_def)
 
 lemma sets_point_measure_count_space[measurable_cong]: "sets (point_measure A f) = sets (count_space A)"
   by (simp add: sets_point_measure)
 
 lemma measurable_point_measure_eq1[simp]:
   "g \<in> measurable (point_measure A f) M \<longleftrightarrow> g \<in> A \<rightarrow> space M"
   unfolding point_measure_def by simp
 
 lemma measurable_point_measure_eq2_finite[simp]:
   "finite A \<Longrightarrow>
    g \<in> measurable M (point_measure A f) \<longleftrightarrow>
     (g \<in> space M \<rightarrow> A \<and> (\<forall>a\<in>A. g -` {a} \<inter> space M \<in> sets M))"
   unfolding point_measure_def by (simp add: measurable_count_space_eq2)
 
 lemma simple_function_point_measure[simp]:
   "simple_function (point_measure A f) g \<longleftrightarrow> finite (g ` A)"
   by (simp add: point_measure_def)
 
 lemma emeasure_point_measure:
   assumes A: "finite {a\<in>X. 0 < f a}" "X \<subseteq> A"
   shows "emeasure (point_measure A f) X = (\<Sum>a|a\<in>X \<and> 0 < f a. f a)"
 proof -
   have "{a. (a \<in> X \<longrightarrow> a \<in> A \<and> 0 < f a) \<and> a \<in> X} = {a\<in>X. 0 < f a}"
     using \<open>X \<subseteq> A\<close> by auto
   with A show ?thesis
     by (simp add: emeasure_density nn_integral_count_space point_measure_def indicator_def of_bool_def)
 qed
 
 lemma emeasure_point_measure_finite:
   "finite A \<Longrightarrow> X \<subseteq> A \<Longrightarrow> emeasure (point_measure A f) X = (\<Sum>a\<in>X. f a)"
   by (subst emeasure_point_measure) (auto dest: finite_subset intro!: sum.mono_neutral_left simp: less_le)
 
 lemma emeasure_point_measure_finite2:
   "X \<subseteq> A \<Longrightarrow> finite X \<Longrightarrow> emeasure (point_measure A f) X = (\<Sum>a\<in>X. f a)"
   by (subst emeasure_point_measure)
      (auto dest: finite_subset intro!: sum.mono_neutral_left simp: less_le)
 
 lemma null_sets_point_measure_iff:
   "X \<in> null_sets (point_measure A f) \<longleftrightarrow> X \<subseteq> A \<and> (\<forall>x\<in>X. f x = 0)"
  by (auto simp: AE_count_space null_sets_density_iff point_measure_def)
 
 lemma AE_point_measure:
   "(AE x in point_measure A f. P x) \<longleftrightarrow> (\<forall>x\<in>A. 0 < f x \<longrightarrow> P x)"
   unfolding point_measure_def
   by (subst AE_density) (auto simp: AE_density AE_count_space point_measure_def)
 
 lemma nn_integral_point_measure:
   "finite {a\<in>A. 0 < f a \<and> 0 < g a} \<Longrightarrow>
     integral\<^sup>N (point_measure A f) g = (\<Sum>a|a\<in>A \<and> 0 < f a \<and> 0 < g a. f a * g a)"
   unfolding point_measure_def
   by (subst nn_integral_density)
      (simp_all add: nn_integral_density nn_integral_count_space ennreal_zero_less_mult_iff)
 
 lemma nn_integral_point_measure_finite:
   "finite A \<Longrightarrow> integral\<^sup>N (point_measure A f) g = (\<Sum>a\<in>A. f a * g a)"
   by (subst nn_integral_point_measure) (auto intro!: sum.mono_neutral_left simp: less_le)
 
 subsubsection \<open>Uniform measure\<close>
 
 definition\<^marker>\<open>tag important\<close> "uniform_measure M A = density M (\<lambda>x. indicator A x / emeasure M A)"
 
 lemma
   shows sets_uniform_measure[simp, measurable_cong]: "sets (uniform_measure M A) = sets M"
     and space_uniform_measure[simp]: "space (uniform_measure M A) = space M"
   by (auto simp: uniform_measure_def)
 
 lemma emeasure_uniform_measure[simp]:
   assumes A: "A \<in> sets M" and B: "B \<in> sets M"
   shows "emeasure (uniform_measure M A) B = emeasure M (A \<inter> B) / emeasure M A"
 proof -
   from A B have "emeasure (uniform_measure M A) B = (\<integral>\<^sup>+x. (1 / emeasure M A) * indicator (A \<inter> B) x \<partial>M)"
     by (auto simp add: uniform_measure_def emeasure_density divide_ennreal_def split: split_indicator
              intro!: nn_integral_cong)
   also have "\<dots> = emeasure M (A \<inter> B) / emeasure M A"
     using A B
     by (subst nn_integral_cmult_indicator) (simp_all add: sets.Int divide_ennreal_def mult.commute)
   finally show ?thesis .
 qed
 
 lemma measure_uniform_measure[simp]:
   assumes A: "emeasure M A \<noteq> 0" "emeasure M A \<noteq> \<infinity>" and B: "B \<in> sets M"
   shows "measure (uniform_measure M A) B = measure M (A \<inter> B) / measure M A"
   using emeasure_uniform_measure[OF emeasure_neq_0_sets[OF A(1)] B] A
   by (cases "emeasure M A" "emeasure M (A \<inter> B)" rule: ennreal2_cases)
      (simp_all add: measure_def divide_ennreal top_ennreal.rep_eq top_ereal_def ennreal_top_divide)
 
 lemma AE_uniform_measureI:
   "A \<in> sets M \<Longrightarrow> (AE x in M. x \<in> A \<longrightarrow> P x) \<Longrightarrow> (AE x in uniform_measure M A. P x)"
   unfolding uniform_measure_def by (auto simp: AE_density divide_ennreal_def)
 
 lemma emeasure_uniform_measure_1:
   "emeasure M S \<noteq> 0 \<Longrightarrow> emeasure M S \<noteq> \<infinity> \<Longrightarrow> emeasure (uniform_measure M S) S = 1"
   by (subst emeasure_uniform_measure)
      (simp_all add: emeasure_neq_0_sets emeasure_eq_ennreal_measure divide_ennreal
                     zero_less_iff_neq_zero[symmetric])
 
 lemma nn_integral_uniform_measure:
   assumes f[measurable]: "f \<in> borel_measurable M" and S[measurable]: "S \<in> sets M"
   shows "(\<integral>\<^sup>+x. f x \<partial>uniform_measure M S) = (\<integral>\<^sup>+x. f x * indicator S x \<partial>M) / emeasure M S"
 proof -
   { assume "emeasure M S = \<infinity>"
     then have ?thesis
       by (simp add: uniform_measure_def nn_integral_density f) }
   moreover
   { assume [simp]: "emeasure M S = 0"
     then have ae: "AE x in M. x \<notin> S"
       using sets.sets_into_space[OF S]
       by (subst AE_iff_measurable[OF _ refl]) (simp_all add: subset_eq cong: rev_conj_cong)
     from ae have "(\<integral>\<^sup>+ x. indicator S x / 0 * f x \<partial>M) = 0"
       by (subst nn_integral_0_iff_AE) auto
     moreover from ae have "(\<integral>\<^sup>+ x. f x * indicator S x \<partial>M) = 0"
       by (subst nn_integral_0_iff_AE) auto
     ultimately have ?thesis
       by (simp add: uniform_measure_def nn_integral_density f) }
   moreover have "emeasure M S \<noteq> 0 \<Longrightarrow> emeasure M S \<noteq> \<infinity> \<Longrightarrow> ?thesis"
     unfolding uniform_measure_def
     by (subst nn_integral_density)
        (auto simp: ennreal_times_divide f nn_integral_divide[symmetric] mult.commute)
   ultimately show ?thesis by blast
 qed
 
 lemma AE_uniform_measure:
   assumes "emeasure M A \<noteq> 0" "emeasure M A < \<infinity>"
   shows "(AE x in uniform_measure M A. P x) \<longleftrightarrow> (AE x in M. x \<in> A \<longrightarrow> P x)"
 proof -
   have "A \<in> sets M"
     using \<open>emeasure M A \<noteq> 0\<close> by (metis emeasure_notin_sets)
   moreover have "\<And>x. 0 < indicator A x / emeasure M A \<longleftrightarrow> x \<in> A"
     using assms
     by (cases "emeasure M A") (auto split: split_indicator simp: ennreal_zero_less_divide)
   ultimately show ?thesis
     unfolding uniform_measure_def by (simp add: AE_density)
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Null measure\<close>
 
 lemma null_measure_eq_density: "null_measure M = density M (\<lambda>_. 0)"
   by (intro measure_eqI) (simp_all add: emeasure_density)
 
 lemma nn_integral_null_measure[simp]: "(\<integral>\<^sup>+x. f x \<partial>null_measure M) = 0"
   by (auto simp add: nn_integral_def simple_integral_def SUP_constant bot_ennreal_def le_fun_def
            intro!: exI[of _ "\<lambda>x. 0"])
 
 lemma density_null_measure[simp]: "density (null_measure M) f = null_measure M"
 proof (intro measure_eqI)
   fix A show "emeasure (density (null_measure M) f) A = emeasure (null_measure M) A"
     by (simp add: density_def) (simp only: null_measure_def[symmetric] emeasure_null_measure)
 qed simp
 
 subsubsection \<open>Uniform count measure\<close>
 
 definition\<^marker>\<open>tag important\<close> "uniform_count_measure A = point_measure A (\<lambda>x. 1 / card A)"
 
 lemma
   shows space_uniform_count_measure: "space (uniform_count_measure A) = A"
     and sets_uniform_count_measure: "sets (uniform_count_measure A) = Pow A"
     unfolding uniform_count_measure_def by (auto simp: space_point_measure sets_point_measure)
 
 lemma sets_uniform_count_measure_count_space[measurable_cong]:
   "sets (uniform_count_measure A) = sets (count_space A)"
   by (simp add: sets_uniform_count_measure)
 
 lemma emeasure_uniform_count_measure:
   "finite A \<Longrightarrow> X \<subseteq> A \<Longrightarrow> emeasure (uniform_count_measure A) X = card X / card A"
   by (simp add: emeasure_point_measure_finite uniform_count_measure_def divide_inverse ennreal_mult
                 ennreal_of_nat_eq_real_of_nat)
 
 lemma measure_uniform_count_measure:
   "finite A \<Longrightarrow> X \<subseteq> A \<Longrightarrow> measure (uniform_count_measure A) X = card X / card A"
   by (simp add: emeasure_point_measure_finite uniform_count_measure_def measure_def enn2real_mult)
 
 lemma space_uniform_count_measure_empty_iff [simp]:
   "space (uniform_count_measure X) = {} \<longleftrightarrow> X = {}"
 by(simp add: space_uniform_count_measure)
 
 lemma sets_uniform_count_measure_eq_UNIV [simp]:
   "sets (uniform_count_measure UNIV) = UNIV \<longleftrightarrow> True"
   "UNIV = sets (uniform_count_measure UNIV) \<longleftrightarrow> True"
 by(simp_all add: sets_uniform_count_measure)
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Scaled measure\<close>
 
 lemma nn_integral_scale_measure:
   assumes f: "f \<in> borel_measurable M"
   shows "nn_integral (scale_measure r M) f = r * nn_integral M f"
   using f
 proof induction
   case (cong f g)
   thus ?case
     by(simp add: cong.hyps space_scale_measure cong: nn_integral_cong_simp)
 next
   case (mult f c)
   thus ?case
     by(simp add: nn_integral_cmult max_def mult.assoc mult.left_commute)
 next
   case (add f g)
   thus ?case
     by(simp add: nn_integral_add distrib_left)
 next
   case (seq U)
   thus ?case
     by(simp add: nn_integral_monotone_convergence_SUP SUP_mult_left_ennreal image_comp)
 qed simp
 
 end
diff --git a/src/HOL/Analysis/Radon_Nikodym.thy b/src/HOL/Analysis/Radon_Nikodym.thy
--- a/src/HOL/Analysis/Radon_Nikodym.thy
+++ b/src/HOL/Analysis/Radon_Nikodym.thy
@@ -1,1120 +1,1129 @@
 (*  Title:      HOL/Analysis/Radon_Nikodym.thy
     Author:     Johannes Hölzl, TU München
 *)
 
 section \<open>Radon-Nikod{\'y}m Derivative\<close>
 
 theory Radon_Nikodym
 imports Bochner_Integration
 begin
 
 definition\<^marker>\<open>tag important\<close> diff_measure :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> 'a measure"
 where
   "diff_measure M N = measure_of (space M) (sets M) (\<lambda>A. emeasure M A - emeasure N A)"
 
 lemma
   shows space_diff_measure[simp]: "space (diff_measure M N) = space M"
     and sets_diff_measure[simp]: "sets (diff_measure M N) = sets M"
   by (auto simp: diff_measure_def)
 
 lemma emeasure_diff_measure:
   assumes fin: "finite_measure M" "finite_measure N" and sets_eq: "sets M = sets N"
   assumes pos: "\<And>A. A \<in> sets M \<Longrightarrow> emeasure N A \<le> emeasure M A" and A: "A \<in> sets M"
   shows "emeasure (diff_measure M N) A = emeasure M A - emeasure N A" (is "_ = ?\<mu> A")
   unfolding diff_measure_def
 proof (rule emeasure_measure_of_sigma)
   show "sigma_algebra (space M) (sets M)" ..
   show "positive (sets M) ?\<mu>"
     using pos by (simp add: positive_def)
   show "countably_additive (sets M) ?\<mu>"
   proof (rule countably_additiveI)
     fix A :: "nat \<Rightarrow> _"  assume A: "range A \<subseteq> sets M" and "disjoint_family A"
     then have suminf:
       "(\<Sum>i. emeasure M (A i)) = emeasure M (\<Union>i. A i)"
       "(\<Sum>i. emeasure N (A i)) = emeasure N (\<Union>i. A i)"
       by (simp_all add: suminf_emeasure sets_eq)
     with A have "(\<Sum>i. emeasure M (A i) - emeasure N (A i)) =
       (\<Sum>i. emeasure M (A i)) - (\<Sum>i. emeasure N (A i))"
       using fin pos[of "A _"]
       by (intro ennreal_suminf_minus)
          (auto simp: sets_eq finite_measure.emeasure_eq_measure suminf_emeasure)
     then show "(\<Sum>i. emeasure M (A i) - emeasure N (A i)) =
       emeasure M (\<Union>i. A i) - emeasure N (\<Union>i. A i) "
       by (simp add: suminf)
   qed
 qed fact
 
 text \<open>An equivalent characterization of sigma-finite spaces is the existence of integrable
 positive functions (or, still equivalently, the existence of a probability measure which is in
 the same measure class as the original measure).\<close>
 
 proposition (in sigma_finite_measure) obtain_positive_integrable_function:
   obtains f::"'a \<Rightarrow> real" where
     "f \<in> borel_measurable M"
     "\<And>x. f x > 0"
     "\<And>x. f x \<le> 1"
     "integrable M f"
 proof -
   obtain A :: "nat \<Rightarrow> 'a set" where "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
     using sigma_finite by auto
   then have [measurable]:"A n \<in> sets M" for n by auto
   define g where "g = (\<lambda>x. (\<Sum>n. (1/2)^(Suc n) * indicator (A n) x / (1+ measure M (A n))))"
   have [measurable]: "g \<in> borel_measurable M" unfolding g_def by auto
   have *: "summable (\<lambda>n. (1/2)^(Suc n) * indicator (A n) x / (1+ measure M (A n)))" for x
     apply (rule summable_comparison_test'[of "\<lambda>n. (1/2)^(Suc n)" 0])
     using power_half_series summable_def by (auto simp add: indicator_def divide_simps)
   have "g x \<le> (\<Sum>n. (1/2)^(Suc n))" for x unfolding g_def
     apply (rule suminf_le) using * power_half_series summable_def by (auto simp add: indicator_def divide_simps)
   then have g_le_1: "g x \<le> 1" for x using power_half_series sums_unique by fastforce
 
   have g_pos: "g x > 0" if "x \<in> space M" for x
   unfolding g_def proof (subst suminf_pos_iff[OF *[of x]], auto)
     obtain i where "x \<in> A i" using \<open>(\<Union>i. A i) = space M\<close> \<open>x \<in> space M\<close> by auto
     then have "0 < (1 / 2) ^ Suc i * indicator (A i) x / (1 + Sigma_Algebra.measure M (A i))"
       unfolding indicator_def apply (auto simp add: divide_simps) using measure_nonneg[of M "A i"]
       by (auto, meson add_nonneg_nonneg linorder_not_le mult_nonneg_nonneg zero_le_numeral zero_le_one zero_le_power)
     then show "\<exists>i. 0 < (1 / 2) ^ i * indicator (A i) x / (2 + 2 * Sigma_Algebra.measure M (A i))"
       by auto
   qed
 
   have "integrable M g"
   unfolding g_def proof (rule integrable_suminf)
     fix n
     show "integrable M (\<lambda>x. (1 / 2) ^ Suc n * indicator (A n) x / (1 + Sigma_Algebra.measure M (A n)))"
       using \<open>emeasure M (A n) \<noteq> \<infinity>\<close>
       by (auto intro!: integrable_mult_right integrable_divide_zero integrable_real_indicator simp add: top.not_eq_extremum)
   next
     show "AE x in M. summable (\<lambda>n. norm ((1 / 2) ^ Suc n * indicator (A n) x / (1 + Sigma_Algebra.measure M (A n))))"
       using * by auto
     show "summable (\<lambda>n. (\<integral>x. norm ((1 / 2) ^ Suc n * indicator (A n) x / (1 + Sigma_Algebra.measure M (A n))) \<partial>M))"
       apply (rule summable_comparison_test'[of "\<lambda>n. (1/2)^(Suc n)" 0], auto)
       using power_half_series summable_def apply auto[1]
       apply (auto simp add: field_split_simps) using measure_nonneg[of M] not_less by fastforce
   qed
 
   define f where "f = (\<lambda>x. if x \<in> space M then g x else 1)"
   have "f x > 0" for x unfolding f_def using g_pos by auto
   moreover have "f x \<le> 1" for x unfolding f_def using g_le_1 by auto
   moreover have [measurable]: "f \<in> borel_measurable M" unfolding f_def by auto
   moreover have "integrable M f"
     apply (subst integrable_cong[of _ _ _ g]) unfolding f_def using \<open>integrable M g\<close> by auto
   ultimately show "(\<And>f. f \<in> borel_measurable M \<Longrightarrow> (\<And>x. 0 < f x) \<Longrightarrow> (\<And>x. f x \<le> 1) \<Longrightarrow> integrable M f \<Longrightarrow> thesis) \<Longrightarrow> thesis"
     by (meson that)
 qed
 
 lemma (in sigma_finite_measure) Ex_finite_integrable_function:
   "\<exists>h\<in>borel_measurable M. integral\<^sup>N M h \<noteq> \<infinity> \<and> (\<forall>x\<in>space M. 0 < h x \<and> h x < \<infinity>)"
 proof -
   obtain A :: "nat \<Rightarrow> 'a set" where
     range[measurable]: "range A \<subseteq> sets M" and
     space: "(\<Union>i. A i) = space M" and
     measure: "\<And>i. emeasure M (A i) \<noteq> \<infinity>" and
     disjoint: "disjoint_family A"
     using sigma_finite_disjoint by blast
   let ?B = "\<lambda>i. 2^Suc i * emeasure M (A i)"
   have [measurable]: "\<And>i. A i \<in> sets M"
     using range by fastforce+
   have "\<forall>i. \<exists>x. 0 < x \<and> x < inverse (?B i)"
   proof
     fix i show "\<exists>x. 0 < x \<and> x < inverse (?B i)"
       using measure[of i]
       by (auto intro!: dense simp: ennreal_inverse_positive ennreal_mult_eq_top_iff power_eq_top_ennreal)
   qed
   from choice[OF this] obtain n where n: "\<And>i. 0 < n i"
     "\<And>i. n i < inverse (2^Suc i * emeasure M (A i))" by auto
   { fix i have "0 \<le> n i" using n(1)[of i] by auto } note pos = this
   let ?h = "\<lambda>x. \<Sum>i. n i * indicator (A i) x"
   show ?thesis
   proof (safe intro!: bexI[of _ ?h] del: notI)
     have "integral\<^sup>N M ?h = (\<Sum>i. n i * emeasure M (A i))" using pos
       by (simp add: nn_integral_suminf nn_integral_cmult_indicator)
     also have "\<dots> \<le> (\<Sum>i. ennreal ((1/2)^Suc i))"
     proof (intro suminf_le allI)
       fix N
       have "n N * emeasure M (A N) \<le> inverse (2^Suc N * emeasure M (A N)) * emeasure M (A N)"
         using n[of N] by (intro mult_right_mono) auto
       also have "\<dots> = (1/2)^Suc N * (inverse (emeasure M (A N)) * emeasure M (A N))"
         using measure[of N]
         by (simp add: ennreal_inverse_power divide_ennreal_def ennreal_inverse_mult
                       power_eq_top_ennreal less_top[symmetric] mult_ac
                  del: power_Suc)
       also have "\<dots> \<le> inverse (ennreal 2) ^ Suc N"
         using measure[of N]
         by (cases "emeasure M (A N)"; cases "emeasure M (A N) = 0")
            (auto simp: inverse_ennreal ennreal_mult[symmetric] divide_ennreal_def simp del: power_Suc)
       also have "\<dots> = ennreal (inverse 2 ^ Suc N)"
         by (subst ennreal_power[symmetric], simp) (simp add: inverse_ennreal)
       finally show "n N * emeasure M (A N) \<le> ennreal ((1/2)^Suc N)"
         by simp
     qed auto
     also have "\<dots> < top"
       unfolding less_top[symmetric]
       by (rule ennreal_suminf_neq_top)
          (auto simp: summable_geometric summable_Suc_iff simp del: power_Suc)
     finally show "integral\<^sup>N M ?h \<noteq> \<infinity>"
       by (auto simp: top_unique)
   next
     { fix x assume "x \<in> space M"
       then obtain i where "x \<in> A i" using space[symmetric] by auto
       with disjoint n have "?h x = n i"
         by (auto intro!: suminf_cmult_indicator intro: less_imp_le)
       then show "0 < ?h x" and "?h x < \<infinity>" using n[of i] by (auto simp: less_top[symmetric]) }
     note pos = this
   qed measurable
 qed
 
 subsection "Absolutely continuous"
 
 definition\<^marker>\<open>tag important\<close> absolutely_continuous :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> bool" where
   "absolutely_continuous M N \<longleftrightarrow> null_sets M \<subseteq> null_sets N"
 
 lemma absolutely_continuousI_count_space: "absolutely_continuous (count_space A) M"
   unfolding absolutely_continuous_def by (auto simp: null_sets_count_space)
 
 lemma absolutely_continuousI_density:
   "f \<in> borel_measurable M \<Longrightarrow> absolutely_continuous M (density M f)"
   by (force simp add: absolutely_continuous_def null_sets_density_iff dest: AE_not_in)
 
 lemma absolutely_continuousI_point_measure_finite:
   "(\<And>x. \<lbrakk> x \<in> A ; f x \<le> 0 \<rbrakk> \<Longrightarrow> g x \<le> 0) \<Longrightarrow> absolutely_continuous (point_measure A f) (point_measure A g)"
   unfolding absolutely_continuous_def by (force simp: null_sets_point_measure_iff)
 
 lemma absolutely_continuousD:
   "absolutely_continuous M N \<Longrightarrow> A \<in> sets M \<Longrightarrow> emeasure M A = 0 \<Longrightarrow> emeasure N A = 0"
   by (auto simp: absolutely_continuous_def null_sets_def)
 
 lemma absolutely_continuous_AE:
   assumes sets_eq: "sets M' = sets M"
     and "absolutely_continuous M M'" "AE x in M. P x"
    shows "AE x in M'. P x"
 proof -
   from \<open>AE x in M. P x\<close> obtain N where N: "N \<in> null_sets M" "{x\<in>space M. \<not> P x} \<subseteq> N"
     unfolding eventually_ae_filter by auto
   show "AE x in M'. P x"
   proof (rule AE_I')
     show "{x\<in>space M'. \<not> P x} \<subseteq> N" using sets_eq_imp_space_eq[OF sets_eq] N(2) by simp
     from \<open>absolutely_continuous M M'\<close> show "N \<in> null_sets M'"
       using N unfolding absolutely_continuous_def sets_eq null_sets_def by auto
   qed
 qed
 
 subsection "Existence of the Radon-Nikodym derivative"
 
 proposition
  (in finite_measure) Radon_Nikodym_finite_measure:
   assumes "finite_measure N" and sets_eq[simp]: "sets N = sets M"
   assumes "absolutely_continuous M N"
   shows "\<exists>f \<in> borel_measurable M. density M f = N"
 proof -
   interpret N: finite_measure N by fact
   define G where "G = {g \<in> borel_measurable M. \<forall>A\<in>sets M. (\<integral>\<^sup>+x. g x * indicator A x \<partial>M) \<le> N A}"
   have [measurable_dest]: "f \<in> G \<Longrightarrow> f \<in> borel_measurable M"
     and G_D: "\<And>A. f \<in> G \<Longrightarrow> A \<in> sets M \<Longrightarrow> (\<integral>\<^sup>+x. f x * indicator A x \<partial>M) \<le> N A" for f
     by (auto simp: G_def)
   note this[measurable_dest]
   have "(\<lambda>x. 0) \<in> G" unfolding G_def by auto
   hence "G \<noteq> {}" by auto
   { fix f g assume f[measurable]: "f \<in> G" and g[measurable]: "g \<in> G"
     have "(\<lambda>x. max (g x) (f x)) \<in> G" (is "?max \<in> G") unfolding G_def
     proof safe
       let ?A = "{x \<in> space M. f x \<le> g x}"
       have "?A \<in> sets M" using f g unfolding G_def by auto
       fix A assume [measurable]: "A \<in> sets M"
       have union: "((?A \<inter> A) \<union> ((space M - ?A) \<inter> A)) = A"
         using sets.sets_into_space[OF \<open>A \<in> sets M\<close>] by auto
       have "\<And>x. x \<in> space M \<Longrightarrow> max (g x) (f x) * indicator A x =
         g x * indicator (?A \<inter> A) x + f x * indicator ((space M - ?A) \<inter> A) x"
         by (auto simp: indicator_def max_def)
       hence "(\<integral>\<^sup>+x. max (g x) (f x) * indicator A x \<partial>M) =
         (\<integral>\<^sup>+x. g x * indicator (?A \<inter> A) x \<partial>M) +
         (\<integral>\<^sup>+x. f x * indicator ((space M - ?A) \<inter> A) x \<partial>M)"
         by (auto cong: nn_integral_cong intro!: nn_integral_add)
       also have "\<dots> \<le> N (?A \<inter> A) + N ((space M - ?A) \<inter> A)"
         using f g unfolding G_def by (auto intro!: add_mono)
       also have "\<dots> = N A"
         using union by (subst plus_emeasure) auto
       finally show "(\<integral>\<^sup>+x. max (g x) (f x) * indicator A x \<partial>M) \<le> N A" .
     qed auto }
   note max_in_G = this
   { fix f assume  "incseq f" and f: "\<And>i. f i \<in> G"
     then have [measurable]: "\<And>i. f i \<in> borel_measurable M" by (auto simp: G_def)
     have "(\<lambda>x. SUP i. f i x) \<in> G" unfolding G_def
     proof safe
       show "(\<lambda>x. SUP i. f i x) \<in> borel_measurable M" by measurable
     next
       fix A assume "A \<in> sets M"
       have "(\<integral>\<^sup>+x. (SUP i. f i x) * indicator A x \<partial>M) =
         (\<integral>\<^sup>+x. (SUP i. f i x * indicator A x) \<partial>M)"
         by (intro nn_integral_cong) (simp split: split_indicator)
       also have "\<dots> = (SUP i. (\<integral>\<^sup>+x. f i x * indicator A x \<partial>M))"
         using \<open>incseq f\<close> f \<open>A \<in> sets M\<close>
         by (intro nn_integral_monotone_convergence_SUP)
            (auto simp: G_def incseq_Suc_iff le_fun_def split: split_indicator)
       finally show "(\<integral>\<^sup>+x. (SUP i. f i x) * indicator A x \<partial>M) \<le> N A"
         using f \<open>A \<in> sets M\<close> by (auto intro!: SUP_least simp: G_D)
     qed }
   note SUP_in_G = this
   let ?y = "SUP g \<in> G. integral\<^sup>N M g"
   have y_le: "?y \<le> N (space M)" unfolding G_def
   proof (safe intro!: SUP_least)
     fix g assume "\<forall>A\<in>sets M. (\<integral>\<^sup>+x. g x * indicator A x \<partial>M) \<le> N A"
     from this[THEN bspec, OF sets.top] show "integral\<^sup>N M g \<le> N (space M)"
       by (simp cong: nn_integral_cong)
   qed
-  from ennreal_SUP_countable_SUP [OF \<open>G \<noteq> {}\<close>, of "integral\<^sup>N M"] guess ys .. note ys = this
+  from ennreal_SUP_countable_SUP [OF \<open>G \<noteq> {}\<close>, of "integral\<^sup>N M"]
+  obtain ys :: "nat \<Rightarrow> ennreal"
+    where ys: "range ys \<subseteq> integral\<^sup>N M ` G \<and> Sup (integral\<^sup>N M ` G) = Sup (range ys)"
+    by auto
   then have "\<forall>n. \<exists>g. g\<in>G \<and> integral\<^sup>N M g = ys n"
   proof safe
     fix n assume "range ys \<subseteq> integral\<^sup>N M ` G"
     hence "ys n \<in> integral\<^sup>N M ` G" by auto
     thus "\<exists>g. g\<in>G \<and> integral\<^sup>N M g = ys n" by auto
   qed
   from choice[OF this] obtain gs where "\<And>i. gs i \<in> G" "\<And>n. integral\<^sup>N M (gs n) = ys n" by auto
   hence y_eq: "?y = (SUP i. integral\<^sup>N M (gs i))" using ys by auto
   let ?g = "\<lambda>i x. Max ((\<lambda>n. gs n x) ` {..i})"
   define f where [abs_def]: "f x = (SUP i. ?g i x)" for x
   let ?F = "\<lambda>A x. f x * indicator A x"
   have gs_not_empty: "\<And>i x. (\<lambda>n. gs n x) ` {..i} \<noteq> {}" by auto
   { fix i have "?g i \<in> G"
     proof (induct i)
       case 0 thus ?case by simp fact
     next
       case (Suc i)
       with Suc gs_not_empty \<open>gs (Suc i) \<in> G\<close> show ?case
         by (auto simp add: atMost_Suc intro!: max_in_G)
     qed }
   note g_in_G = this
   have "incseq ?g" using gs_not_empty
     by (auto intro!: incseq_SucI le_funI simp add: atMost_Suc)
 
   from SUP_in_G[OF this g_in_G] have [measurable]: "f \<in> G" unfolding f_def .
   then have [measurable]: "f \<in> borel_measurable M" unfolding G_def by auto
 
   have "integral\<^sup>N M f = (SUP i. integral\<^sup>N M (?g i))" unfolding f_def
     using g_in_G \<open>incseq ?g\<close> by (auto intro!: nn_integral_monotone_convergence_SUP simp: G_def)
   also have "\<dots> = ?y"
   proof (rule antisym)
     show "(SUP i. integral\<^sup>N M (?g i)) \<le> ?y"
       using g_in_G by (auto intro: SUP_mono)
     show "?y \<le> (SUP i. integral\<^sup>N M (?g i))" unfolding y_eq
       by (auto intro!: SUP_mono nn_integral_mono Max_ge)
   qed
   finally have int_f_eq_y: "integral\<^sup>N M f = ?y" .
 
   have upper_bound: "\<forall>A\<in>sets M. N A \<le> density M f A"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     then obtain A where A[measurable]: "A \<in> sets M" and f_less_N: "density M f A < N A"
       by (auto simp: not_le)
     then have pos_A: "0 < M A"
       using \<open>absolutely_continuous M N\<close>[THEN absolutely_continuousD, OF A]
       by (auto simp: zero_less_iff_neq_zero)
 
     define b where "b = (N A - density M f A) / M A / 2"
     with f_less_N pos_A have "0 < b" "b \<noteq> top"
       by (auto intro!: diff_gr0_ennreal simp: zero_less_iff_neq_zero diff_eq_0_iff_ennreal ennreal_divide_eq_top_iff)
 
     let ?f = "\<lambda>x. f x + b"
     have "nn_integral M f \<noteq> top"
       using \<open>f \<in> G\<close>[THEN G_D, of "space M"] by (auto simp: top_unique cong: nn_integral_cong)
     with \<open>b \<noteq> top\<close> interpret Mf: finite_measure "density M ?f"
       by (intro finite_measureI)
          (auto simp: field_simps mult_indicator_subset ennreal_mult_eq_top_iff
                      emeasure_density nn_integral_cmult_indicator nn_integral_add
                cong: nn_integral_cong)
 
     from unsigned_Hahn_decomposition[of "density M ?f" N A]
     obtain Y where [measurable]: "Y \<in> sets M" and [simp]: "Y \<subseteq> A"
        and Y1: "\<And>C. C \<in> sets M \<Longrightarrow> C \<subseteq> Y \<Longrightarrow> density M ?f C \<le> N C"
        and Y2: "\<And>C. C \<in> sets M \<Longrightarrow> C \<subseteq> A \<Longrightarrow> C \<inter> Y = {} \<Longrightarrow> N C \<le> density M ?f C"
        by auto
 
     let ?f' = "\<lambda>x. f x + b * indicator Y x"
     have "M Y \<noteq> 0"
     proof
       assume "M Y = 0"
       then have "N Y = 0"
         using \<open>absolutely_continuous M N\<close>[THEN absolutely_continuousD, of Y] by auto
       then have "N A = N (A - Y)"
         by (subst emeasure_Diff) auto
       also have "\<dots> \<le> density M ?f (A - Y)"
         by (rule Y2) auto
       also have "\<dots> \<le> density M ?f A - density M ?f Y"
         by (subst emeasure_Diff) auto
       also have "\<dots> \<le> density M ?f A - 0"
         by (intro ennreal_minus_mono) auto
       also have "density M ?f A = b * M A + density M f A"
         by (simp add: emeasure_density field_simps mult_indicator_subset nn_integral_add nn_integral_cmult_indicator)
       also have "\<dots> < N A"
         using f_less_N pos_A
         by (cases "density M f A"; cases "M A"; cases "N A")
            (auto simp: b_def ennreal_less_iff ennreal_minus divide_ennreal ennreal_numeral[symmetric]
                        ennreal_plus[symmetric] ennreal_mult[symmetric] field_simps
                     simp del: ennreal_numeral ennreal_plus)
       finally show False
         by simp
     qed
     then have "nn_integral M f < nn_integral M ?f'"
       using \<open>0 < b\<close> \<open>nn_integral M f \<noteq> top\<close>
       by (simp add: nn_integral_add nn_integral_cmult_indicator ennreal_zero_less_mult_iff zero_less_iff_neq_zero)
     moreover
     have "?f' \<in> G"
       unfolding G_def
     proof safe
       fix X assume [measurable]: "X \<in> sets M"
       have "(\<integral>\<^sup>+ x. ?f' x * indicator X x \<partial>M) = density M f (X - Y) + density M ?f (X \<inter> Y)"
         by (auto simp add: emeasure_density nn_integral_add[symmetric] split: split_indicator intro!: nn_integral_cong)
       also have "\<dots> \<le> N (X - Y) + N (X \<inter> Y)"
         using G_D[OF \<open>f \<in> G\<close>] by (intro add_mono Y1) (auto simp: emeasure_density)
       also have "\<dots> = N X"
         by (subst plus_emeasure) (auto intro!: arg_cong2[where f=emeasure])
       finally show "(\<integral>\<^sup>+ x. ?f' x * indicator X x \<partial>M) \<le> N X" .
     qed simp
     then have "nn_integral M ?f' \<le> ?y"
       by (rule SUP_upper)
     ultimately show False
       by (simp add: int_f_eq_y)
   qed
   show ?thesis
   proof (intro bexI[of _ f] measure_eqI conjI antisym)
     fix A assume "A \<in> sets (density M f)" then show "emeasure (density M f) A \<le> emeasure N A"
       by (auto simp: emeasure_density intro!: G_D[OF \<open>f \<in> G\<close>])
   next
     fix A assume A: "A \<in> sets (density M f)" then show "emeasure N A \<le> emeasure (density M f) A"
       using upper_bound by auto
   qed auto
 qed
 
 lemma (in finite_measure) split_space_into_finite_sets_and_rest:
   assumes ac: "absolutely_continuous M N" and sets_eq[simp]: "sets N = sets M"
   shows "\<exists>B::nat\<Rightarrow>'a set. disjoint_family B \<and> range B \<subseteq> sets M \<and> (\<forall>i. N (B i) \<noteq> \<infinity>) \<and>
     (\<forall>A\<in>sets M. A \<inter> (\<Union>i. B i) = {} \<longrightarrow> (emeasure M A = 0 \<and> N A = 0) \<or> (emeasure M A > 0 \<and> N A = \<infinity>))"
 proof -
   let ?Q = "{Q\<in>sets M. N Q \<noteq> \<infinity>}"
   let ?a = "SUP Q\<in>?Q. emeasure M Q"
   have "{} \<in> ?Q" by auto
   then have Q_not_empty: "?Q \<noteq> {}" by blast
   have "?a \<le> emeasure M (space M)" using sets.sets_into_space
     by (auto intro!: SUP_least emeasure_mono)
   then have "?a \<noteq> \<infinity>"
     using finite_emeasure_space
     by (auto simp: less_top[symmetric] top_unique simp del: SUP_eq_top_iff Sup_eq_top_iff)
   from ennreal_SUP_countable_SUP [OF Q_not_empty, of "emeasure M"]
   obtain Q'' where "range Q'' \<subseteq> emeasure M ` ?Q" and a: "?a = (SUP i::nat. Q'' i)"
     by auto
   then have "\<forall>i. \<exists>Q'. Q'' i = emeasure M Q' \<and> Q' \<in> ?Q" by auto
   from choice[OF this] obtain Q' where Q': "\<And>i. Q'' i = emeasure M (Q' i)" "\<And>i. Q' i \<in> ?Q"
     by auto
   then have a_Lim: "?a = (SUP i. emeasure M (Q' i))" using a by simp
   let ?O = "\<lambda>n. \<Union>i\<le>n. Q' i"
   have Union: "(SUP i. emeasure M (?O i)) = emeasure M (\<Union>i. ?O i)"
   proof (rule SUP_emeasure_incseq[of ?O])
     show "range ?O \<subseteq> sets M" using Q' by auto
     show "incseq ?O" by (fastforce intro!: incseq_SucI)
   qed
   have Q'_sets[measurable]: "\<And>i. Q' i \<in> sets M" using Q' by auto
   have O_sets: "\<And>i. ?O i \<in> sets M" using Q' by auto
   then have O_in_G: "\<And>i. ?O i \<in> ?Q"
   proof (safe del: notI)
     fix i have "Q' ` {..i} \<subseteq> sets M" using Q' by auto
     then have "N (?O i) \<le> (\<Sum>i\<le>i. N (Q' i))"
       by (simp add: emeasure_subadditive_finite)
     also have "\<dots> < \<infinity>" using Q' by (simp add: less_top)
     finally show "N (?O i) \<noteq> \<infinity>" by simp
   qed auto
   have O_mono: "\<And>n. ?O n \<subseteq> ?O (Suc n)" by fastforce
   have a_eq: "?a = emeasure M (\<Union>i. ?O i)" unfolding Union[symmetric]
   proof (rule antisym)
     show "?a \<le> (SUP i. emeasure M (?O i))" unfolding a_Lim
       using Q' by (auto intro!: SUP_mono emeasure_mono)
     show "(SUP i. emeasure M (?O i)) \<le> ?a"
     proof (safe intro!: Sup_mono, unfold bex_simps)
       fix i
       have *: "(\<Union>(Q' ` {..i})) = ?O i" by auto
       then show "\<exists>x. (x \<in> sets M \<and> N x \<noteq> \<infinity>) \<and>
         emeasure M (\<Union>(Q' ` {..i})) \<le> emeasure M x"
         using O_in_G[of i] by (auto intro!: exI[of _ "?O i"])
     qed
   qed
   let ?O_0 = "(\<Union>i. ?O i)"
   have "?O_0 \<in> sets M" using Q' by auto
   have "disjointed Q' i \<in> sets M" for i
     using sets.range_disjointed_sets[of Q' M] using Q'_sets by (auto simp: subset_eq)
   note Q_sets = this
   show ?thesis
   proof (intro bexI exI conjI ballI impI allI)
     show "disjoint_family (disjointed Q')"
       by (rule disjoint_family_disjointed)
     show "range (disjointed Q') \<subseteq> sets M"
       using Q'_sets by (intro sets.range_disjointed_sets) auto
     { fix A assume A: "A \<in> sets M" "A \<inter> (\<Union>i. disjointed Q' i) = {}"
       then have A1: "A \<inter> (\<Union>i. Q' i) = {}"
         unfolding UN_disjointed_eq by auto
       show "emeasure M A = 0 \<and> N A = 0 \<or> 0 < emeasure M A \<and> N A = \<infinity>"
       proof (rule disjCI, simp)
         assume *: "emeasure M A = 0 \<or> N A \<noteq> top"
         show "emeasure M A = 0 \<and> N A = 0"
         proof (cases "emeasure M A = 0")
           case True
           with ac A have "N A = 0"
             unfolding absolutely_continuous_def by auto
           with True show ?thesis by simp
         next
           case False
           with * have "N A \<noteq> \<infinity>" by auto
           with A have "emeasure M ?O_0 + emeasure M A = emeasure M (?O_0 \<union> A)"
             using Q' A1 by (auto intro!: plus_emeasure simp: set_eq_iff)
           also have "\<dots> = (SUP i. emeasure M (?O i \<union> A))"
           proof (rule SUP_emeasure_incseq[of "\<lambda>i. ?O i \<union> A", symmetric, simplified])
             show "range (\<lambda>i. ?O i \<union> A) \<subseteq> sets M"
               using \<open>N A \<noteq> \<infinity>\<close> O_sets A by auto
           qed (fastforce intro!: incseq_SucI)
           also have "\<dots> \<le> ?a"
           proof (safe intro!: SUP_least)
             fix i have "?O i \<union> A \<in> ?Q"
             proof (safe del: notI)
               show "?O i \<union> A \<in> sets M" using O_sets A by auto
               from O_in_G[of i] have "N (?O i \<union> A) \<le> N (?O i) + N A"
                 using emeasure_subadditive[of "?O i" N A] A O_sets by auto
               with O_in_G[of i] show "N (?O i \<union> A) \<noteq> \<infinity>"
                 using \<open>N A \<noteq> \<infinity>\<close> by (auto simp: top_unique)
             qed
             then show "emeasure M (?O i \<union> A) \<le> ?a" by (rule SUP_upper)
           qed
           finally have "emeasure M A = 0"
             unfolding a_eq using measure_nonneg[of M A] by (simp add: emeasure_eq_measure)
           with \<open>emeasure M A \<noteq> 0\<close> show ?thesis by auto
         qed
       qed }
     { fix i
       have "N (disjointed Q' i) \<le> N (Q' i)"
         by (auto intro!: emeasure_mono simp: disjointed_def)
       then show "N (disjointed Q' i) \<noteq> \<infinity>"
         using Q'(2)[of i] by (auto simp: top_unique) }
   qed
 qed
 
 proposition (in finite_measure) Radon_Nikodym_finite_measure_infinite:
   assumes "absolutely_continuous M N" and sets_eq: "sets N = sets M"
   shows "\<exists>f\<in>borel_measurable M. density M f = N"
 proof -
   from split_space_into_finite_sets_and_rest[OF assms]
   obtain Q :: "nat \<Rightarrow> 'a set"
     where Q: "disjoint_family Q" "range Q \<subseteq> sets M"
     and in_Q0: "\<And>A. A \<in> sets M \<Longrightarrow> A \<inter> (\<Union>i. Q i) = {} \<Longrightarrow> emeasure M A = 0 \<and> N A = 0 \<or> 0 < emeasure M A \<and> N A = \<infinity>"
     and Q_fin: "\<And>i. N (Q i) \<noteq> \<infinity>" by force
   from Q have Q_sets: "\<And>i. Q i \<in> sets M" by auto
   let ?N = "\<lambda>i. density N (indicator (Q i))" and ?M = "\<lambda>i. density M (indicator (Q i))"
   have "\<forall>i. \<exists>f\<in>borel_measurable (?M i). density (?M i) f = ?N i"
   proof (intro allI finite_measure.Radon_Nikodym_finite_measure)
     fix i
     from Q show "finite_measure (?M i)"
       by (auto intro!: finite_measureI cong: nn_integral_cong
                simp add: emeasure_density subset_eq sets_eq)
     from Q have "emeasure (?N i) (space N) = emeasure N (Q i)"
       by (simp add: sets_eq[symmetric] emeasure_density subset_eq cong: nn_integral_cong)
     with Q_fin show "finite_measure (?N i)"
       by (auto intro!: finite_measureI)
     show "sets (?N i) = sets (?M i)" by (simp add: sets_eq)
     have [measurable]: "\<And>A. A \<in> sets M \<Longrightarrow> A \<in> sets N" by (simp add: sets_eq)
     show "absolutely_continuous (?M i) (?N i)"
       using \<open>absolutely_continuous M N\<close> \<open>Q i \<in> sets M\<close>
       by (auto simp: absolutely_continuous_def null_sets_density_iff sets_eq
                intro!: absolutely_continuous_AE[OF sets_eq])
   qed
   from choice[OF this[unfolded Bex_def]]
   obtain f where borel: "\<And>i. f i \<in> borel_measurable M" "\<And>i x. 0 \<le> f i x"
     and f_density: "\<And>i. density (?M i) (f i) = ?N i"
     by force
   { fix A i assume A: "A \<in> sets M"
     with Q borel have "(\<integral>\<^sup>+x. f i x * indicator (Q i \<inter> A) x \<partial>M) = emeasure (density (?M i) (f i)) A"
       by (auto simp add: emeasure_density nn_integral_density subset_eq
                intro!: nn_integral_cong split: split_indicator)
     also have "\<dots> = emeasure N (Q i \<inter> A)"
       using A Q by (simp add: f_density emeasure_restricted subset_eq sets_eq)
     finally have "emeasure N (Q i \<inter> A) = (\<integral>\<^sup>+x. f i x * indicator (Q i \<inter> A) x \<partial>M)" .. }
   note integral_eq = this
   let ?f = "\<lambda>x. (\<Sum>i. f i x * indicator (Q i) x) + \<infinity> * indicator (space M - (\<Union>i. Q i)) x"
   show ?thesis
   proof (safe intro!: bexI[of _ ?f])
     show "?f \<in> borel_measurable M" using borel Q_sets
       by (auto intro!: measurable_If)
     show "density M ?f = N"
     proof (rule measure_eqI)
       fix A assume "A \<in> sets (density M ?f)"
       then have "A \<in> sets M" by simp
       have Qi: "\<And>i. Q i \<in> sets M" using Q by auto
       have [intro,simp]: "\<And>i. (\<lambda>x. f i x * indicator (Q i \<inter> A) x) \<in> borel_measurable M"
         "\<And>i. AE x in M. 0 \<le> f i x * indicator (Q i \<inter> A) x"
         using borel Qi \<open>A \<in> sets M\<close> by auto
       have "(\<integral>\<^sup>+x. ?f x * indicator A x \<partial>M) = (\<integral>\<^sup>+x. (\<Sum>i. f i x * indicator (Q i \<inter> A) x) + \<infinity> * indicator ((space M - (\<Union>i. Q i)) \<inter> A) x \<partial>M)"
         using borel by (intro nn_integral_cong) (auto simp: indicator_def)
       also have "\<dots> = (\<integral>\<^sup>+x. (\<Sum>i. f i x * indicator (Q i \<inter> A) x) \<partial>M) + \<infinity> * emeasure M ((space M - (\<Union>i. Q i)) \<inter> A)"
         using borel Qi \<open>A \<in> sets M\<close>
         by (subst nn_integral_add)
            (auto simp add: nn_integral_cmult_indicator sets.Int intro!: suminf_0_le)
       also have "\<dots> = (\<Sum>i. N (Q i \<inter> A)) + \<infinity> * emeasure M ((space M - (\<Union>i. Q i)) \<inter> A)"
         by (subst integral_eq[OF \<open>A \<in> sets M\<close>], subst nn_integral_suminf) auto
       finally have "(\<integral>\<^sup>+x. ?f x * indicator A x \<partial>M) = (\<Sum>i. N (Q i \<inter> A)) + \<infinity> * emeasure M ((space M - (\<Union>i. Q i)) \<inter> A)" .
       moreover have "(\<Sum>i. N (Q i \<inter> A)) = N ((\<Union>i. Q i) \<inter> A)"
         using Q Q_sets \<open>A \<in> sets M\<close>
         by (subst suminf_emeasure) (auto simp: disjoint_family_on_def sets_eq)
       moreover
       have "(space M - (\<Union>x. Q x)) \<inter> A \<inter> (\<Union>x. Q x) = {}"
         by auto
       then have "\<infinity> * emeasure M ((space M - (\<Union>i. Q i)) \<inter> A) = N ((space M - (\<Union>i. Q i)) \<inter> A)"
         using in_Q0[of "(space M - (\<Union>i. Q i)) \<inter> A"] \<open>A \<in> sets M\<close> Q by (auto simp: ennreal_top_mult)
       moreover have "(space M - (\<Union>i. Q i)) \<inter> A \<in> sets M" "((\<Union>i. Q i) \<inter> A) \<in> sets M"
         using Q_sets \<open>A \<in> sets M\<close> by auto
       moreover have "((\<Union>i. Q i) \<inter> A) \<union> ((space M - (\<Union>i. Q i)) \<inter> A) = A" "((\<Union>i. Q i) \<inter> A) \<inter> ((space M - (\<Union>i. Q i)) \<inter> A) = {}"
         using \<open>A \<in> sets M\<close> sets.sets_into_space by auto
       ultimately have "N A = (\<integral>\<^sup>+x. ?f x * indicator A x \<partial>M)"
         using plus_emeasure[of "(\<Union>i. Q i) \<inter> A" N "(space M - (\<Union>i. Q i)) \<inter> A"] by (simp add: sets_eq)
       with \<open>A \<in> sets M\<close> borel Q show "emeasure (density M ?f) A = N A"
         by (auto simp: subset_eq emeasure_density)
     qed (simp add: sets_eq)
   qed
 qed
 
 theorem (in sigma_finite_measure) Radon_Nikodym:
   assumes ac: "absolutely_continuous M N" assumes sets_eq: "sets N = sets M"
   shows "\<exists>f \<in> borel_measurable M. density M f = N"
 proof -
   from Ex_finite_integrable_function
   obtain h where finite: "integral\<^sup>N M h \<noteq> \<infinity>" and
     borel: "h \<in> borel_measurable M" and
     nn: "\<And>x. 0 \<le> h x" and
     pos: "\<And>x. x \<in> space M \<Longrightarrow> 0 < h x" and
     "\<And>x. x \<in> space M \<Longrightarrow> h x < \<infinity>" by auto
   let ?T = "\<lambda>A. (\<integral>\<^sup>+x. h x * indicator A x \<partial>M)"
   let ?MT = "density M h"
   from borel finite nn interpret T: finite_measure ?MT
     by (auto intro!: finite_measureI cong: nn_integral_cong simp: emeasure_density)
   have "absolutely_continuous ?MT N" "sets N = sets ?MT"
   proof (unfold absolutely_continuous_def, safe)
     fix A assume "A \<in> null_sets ?MT"
     with borel have "A \<in> sets M" "AE x in M. x \<in> A \<longrightarrow> h x \<le> 0"
       by (auto simp add: null_sets_density_iff)
     with pos sets.sets_into_space have "AE x in M. x \<notin> A"
       by (elim eventually_mono) (auto simp: not_le[symmetric])
     then have "A \<in> null_sets M"
       using \<open>A \<in> sets M\<close> by (simp add: AE_iff_null_sets)
     with ac show "A \<in> null_sets N"
       by (auto simp: absolutely_continuous_def)
   qed (auto simp add: sets_eq)
   from T.Radon_Nikodym_finite_measure_infinite[OF this]
   obtain f where f_borel: "f \<in> borel_measurable M" "density ?MT f = N" by auto
   with nn borel show ?thesis
     by (auto intro!: bexI[of _ "\<lambda>x. h x * f x"] simp: density_density_eq)
 qed
 
 subsection \<open>Uniqueness of densities\<close>
 
 lemma finite_density_unique:
   assumes borel: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   assumes pos: "AE x in M. 0 \<le> f x" "AE x in M. 0 \<le> g x"
   and fin: "integral\<^sup>N M f \<noteq> \<infinity>"
   shows "density M f = density M g \<longleftrightarrow> (AE x in M. f x = g x)"
 proof (intro iffI ballI)
   fix A assume eq: "AE x in M. f x = g x"
   with borel show "density M f = density M g"
     by (auto intro: density_cong)
 next
   let ?P = "\<lambda>f A. \<integral>\<^sup>+ x. f x * indicator A x \<partial>M"
   assume "density M f = density M g"
   with borel have eq: "\<forall>A\<in>sets M. ?P f A = ?P g A"
     by (simp add: emeasure_density[symmetric])
   from this[THEN bspec, OF sets.top] fin
   have g_fin: "integral\<^sup>N M g \<noteq> \<infinity>" by (simp cong: nn_integral_cong)
   { fix f g assume borel: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
       and pos: "AE x in M. 0 \<le> f x" "AE x in M. 0 \<le> g x"
       and g_fin: "integral\<^sup>N M g \<noteq> \<infinity>" and eq: "\<forall>A\<in>sets M. ?P f A = ?P g A"
     let ?N = "{x\<in>space M. g x < f x}"
     have N: "?N \<in> sets M" using borel by simp
     have "?P g ?N \<le> integral\<^sup>N M g" using pos
       by (intro nn_integral_mono_AE) (auto split: split_indicator)
     then have Pg_fin: "?P g ?N \<noteq> \<infinity>" using g_fin by (auto simp: top_unique)
     have "?P (\<lambda>x. (f x - g x)) ?N = (\<integral>\<^sup>+x. f x * indicator ?N x - g x * indicator ?N x \<partial>M)"
       by (auto intro!: nn_integral_cong simp: indicator_def)
     also have "\<dots> = ?P f ?N - ?P g ?N"
     proof (rule nn_integral_diff)
       show "(\<lambda>x. f x * indicator ?N x) \<in> borel_measurable M" "(\<lambda>x. g x * indicator ?N x) \<in> borel_measurable M"
         using borel N by auto
       show "AE x in M. g x * indicator ?N x \<le> f x * indicator ?N x"
         using pos by (auto split: split_indicator)
     qed fact
     also have "\<dots> = 0"
       unfolding eq[THEN bspec, OF N] using Pg_fin by auto
     finally have "AE x in M. f x \<le> g x"
       using pos borel nn_integral_PInf_AE[OF borel(2) g_fin]
       by (subst (asm) nn_integral_0_iff_AE)
          (auto split: split_indicator simp: not_less ennreal_minus_eq_0) }
   from this[OF borel pos g_fin eq] this[OF borel(2,1) pos(2,1) fin] eq
   show "AE x in M. f x = g x" by auto
 qed
 
 lemma (in finite_measure) density_unique_finite_measure:
   assumes borel: "f \<in> borel_measurable M" "f' \<in> borel_measurable M"
   assumes pos: "AE x in M. 0 \<le> f x" "AE x in M. 0 \<le> f' x"
   assumes f: "\<And>A. A \<in> sets M \<Longrightarrow> (\<integral>\<^sup>+x. f x * indicator A x \<partial>M) = (\<integral>\<^sup>+x. f' x * indicator A x \<partial>M)"
     (is "\<And>A. A \<in> sets M \<Longrightarrow> ?P f A = ?P f' A")
   shows "AE x in M. f x = f' x"
 proof -
   let ?D = "\<lambda>f. density M f"
   let ?N = "\<lambda>A. ?P f A" and ?N' = "\<lambda>A. ?P f' A"
   let ?f = "\<lambda>A x. f x * indicator A x" and ?f' = "\<lambda>A x. f' x * indicator A x"
 
   have ac: "absolutely_continuous M (density M f)" "sets (density M f) = sets M"
     using borel by (auto intro!: absolutely_continuousI_density)
   from split_space_into_finite_sets_and_rest[OF this]
   obtain Q :: "nat \<Rightarrow> 'a set"
     where Q: "disjoint_family Q" "range Q \<subseteq> sets M"
     and in_Q0: "\<And>A. A \<in> sets M \<Longrightarrow> A \<inter> (\<Union>i. Q i) = {} \<Longrightarrow> emeasure M A = 0 \<and> ?D f A = 0 \<or> 0 < emeasure M A \<and> ?D f A = \<infinity>"
     and Q_fin: "\<And>i. ?D f (Q i) \<noteq> \<infinity>" by force
   with borel pos have in_Q0: "\<And>A. A \<in> sets M \<Longrightarrow> A \<inter> (\<Union>i. Q i) = {} \<Longrightarrow> emeasure M A = 0 \<and> ?N A = 0 \<or> 0 < emeasure M A \<and> ?N A = \<infinity>"
     and Q_fin: "\<And>i. ?N (Q i) \<noteq> \<infinity>" by (auto simp: emeasure_density subset_eq)
 
   from Q have Q_sets[measurable]: "\<And>i. Q i \<in> sets M" by auto
   let ?D = "{x\<in>space M. f x \<noteq> f' x}"
   have "?D \<in> sets M" using borel by auto
   have *: "\<And>i x A. \<And>y::ennreal. y * indicator (Q i) x * indicator A x = y * indicator (Q i \<inter> A) x"
     unfolding indicator_def by auto
   have "\<forall>i. AE x in M. ?f (Q i) x = ?f' (Q i) x" using borel Q_fin Q pos
     by (intro finite_density_unique[THEN iffD1] allI)
        (auto intro!: f measure_eqI simp: emeasure_density * subset_eq)
   moreover have "AE x in M. ?f (space M - (\<Union>i. Q i)) x = ?f' (space M - (\<Union>i. Q i)) x"
   proof (rule AE_I')
     { fix f :: "'a \<Rightarrow> ennreal" assume borel: "f \<in> borel_measurable M"
         and eq: "\<And>A. A \<in> sets M \<Longrightarrow> ?N A = (\<integral>\<^sup>+x. f x * indicator A x \<partial>M)"
       let ?A = "\<lambda>i. (space M - (\<Union>i. Q i)) \<inter> {x \<in> space M. f x < (i::nat)}"
       have "(\<Union>i. ?A i) \<in> null_sets M"
       proof (rule null_sets_UN)
         fix i ::nat have "?A i \<in> sets M"
           using borel by auto
         have "?N (?A i) \<le> (\<integral>\<^sup>+x. (i::ennreal) * indicator (?A i) x \<partial>M)"
           unfolding eq[OF \<open>?A i \<in> sets M\<close>]
           by (auto intro!: nn_integral_mono simp: indicator_def)
         also have "\<dots> = i * emeasure M (?A i)"
           using \<open>?A i \<in> sets M\<close> by (auto intro!: nn_integral_cmult_indicator)
         also have "\<dots> < \<infinity>" using emeasure_real[of "?A i"] by (auto simp: ennreal_mult_less_top of_nat_less_top)
         finally have "?N (?A i) \<noteq> \<infinity>" by simp
         then show "?A i \<in> null_sets M" using in_Q0[OF \<open>?A i \<in> sets M\<close>] \<open>?A i \<in> sets M\<close> by auto
       qed
       also have "(\<Union>i. ?A i) = (space M - (\<Union>i. Q i)) \<inter> {x\<in>space M. f x \<noteq> \<infinity>}"
         by (auto simp: ennreal_Ex_less_of_nat less_top[symmetric])
       finally have "(space M - (\<Union>i. Q i)) \<inter> {x\<in>space M. f x \<noteq> \<infinity>} \<in> null_sets M" by simp }
     from this[OF borel(1) refl] this[OF borel(2) f]
     have "(space M - (\<Union>i. Q i)) \<inter> {x\<in>space M. f x \<noteq> \<infinity>} \<in> null_sets M" "(space M - (\<Union>i. Q i)) \<inter> {x\<in>space M. f' x \<noteq> \<infinity>} \<in> null_sets M" by simp_all
     then show "((space M - (\<Union>i. Q i)) \<inter> {x\<in>space M. f x \<noteq> \<infinity>}) \<union> ((space M - (\<Union>i. Q i)) \<inter> {x\<in>space M. f' x \<noteq> \<infinity>}) \<in> null_sets M" by (rule null_sets.Un)
     show "{x \<in> space M. ?f (space M - (\<Union>i. Q i)) x \<noteq> ?f' (space M - (\<Union>i. Q i)) x} \<subseteq>
       ((space M - (\<Union>i. Q i)) \<inter> {x\<in>space M. f x \<noteq> \<infinity>}) \<union> ((space M - (\<Union>i. Q i)) \<inter> {x\<in>space M. f' x \<noteq> \<infinity>})" by (auto simp: indicator_def)
   qed
   moreover have "AE x in M. (?f (space M - (\<Union>i. Q i)) x = ?f' (space M - (\<Union>i. Q i)) x) \<longrightarrow> (\<forall>i. ?f (Q i) x = ?f' (Q i) x) \<longrightarrow>
     ?f (space M) x = ?f' (space M) x"
     by (auto simp: indicator_def)
   ultimately have "AE x in M. ?f (space M) x = ?f' (space M) x"
     unfolding AE_all_countable[symmetric]
     by eventually_elim (auto split: if_split_asm simp: indicator_def)
   then show "AE x in M. f x = f' x" by auto
 qed
 
 proposition (in sigma_finite_measure) density_unique:
   assumes f: "f \<in> borel_measurable M"
   assumes f': "f' \<in> borel_measurable M"
   assumes density_eq: "density M f = density M f'"
   shows "AE x in M. f x = f' x"
 proof -
   obtain h where h_borel: "h \<in> borel_measurable M"
     and fin: "integral\<^sup>N M h \<noteq> \<infinity>" and pos: "\<And>x. x \<in> space M \<Longrightarrow> 0 < h x \<and> h x < \<infinity>" "\<And>x. 0 \<le> h x"
     using Ex_finite_integrable_function by auto
   then have h_nn: "AE x in M. 0 \<le> h x" by auto
   let ?H = "density M h"
   interpret h: finite_measure ?H
     using fin h_borel pos
     by (intro finite_measureI) (simp cong: nn_integral_cong emeasure_density add: fin)
   let ?fM = "density M f"
   let ?f'M = "density M f'"
   { fix A assume "A \<in> sets M"
     then have "{x \<in> space M. h x * indicator A x \<noteq> 0} = A"
       using pos(1) sets.sets_into_space by (force simp: indicator_def)
     then have "(\<integral>\<^sup>+x. h x * indicator A x \<partial>M) = 0 \<longleftrightarrow> A \<in> null_sets M"
       using h_borel \<open>A \<in> sets M\<close> h_nn by (subst nn_integral_0_iff) auto }
   note h_null_sets = this
   { fix A assume "A \<in> sets M"
     have "(\<integral>\<^sup>+x. f x * (h x * indicator A x) \<partial>M) = (\<integral>\<^sup>+x. h x * indicator A x \<partial>?fM)"
       using \<open>A \<in> sets M\<close> h_borel h_nn f f'
       by (intro nn_integral_density[symmetric]) auto
     also have "\<dots> = (\<integral>\<^sup>+x. h x * indicator A x \<partial>?f'M)"
       by (simp_all add: density_eq)
     also have "\<dots> = (\<integral>\<^sup>+x. f' x * (h x * indicator A x) \<partial>M)"
       using \<open>A \<in> sets M\<close> h_borel h_nn f f'
       by (intro nn_integral_density) auto
     finally have "(\<integral>\<^sup>+x. h x * (f x * indicator A x) \<partial>M) = (\<integral>\<^sup>+x. h x * (f' x * indicator A x) \<partial>M)"
       by (simp add: ac_simps)
     then have "(\<integral>\<^sup>+x. (f x * indicator A x) \<partial>?H) = (\<integral>\<^sup>+x. (f' x * indicator A x) \<partial>?H)"
       using \<open>A \<in> sets M\<close> h_borel h_nn f f'
       by (subst (asm) (1 2) nn_integral_density[symmetric]) auto }
   then have "AE x in ?H. f x = f' x" using h_borel h_nn f f'
     by (intro h.density_unique_finite_measure absolutely_continuous_AE[of M]) auto
   with AE_space[of M] pos show "AE x in M. f x = f' x"
     unfolding AE_density[OF h_borel] by auto
 qed
 
 lemma (in sigma_finite_measure) density_unique_iff:
   assumes f: "f \<in> borel_measurable M" and f': "f' \<in> borel_measurable M"
   shows "density M f = density M f' \<longleftrightarrow> (AE x in M. f x = f' x)"
   using density_unique[OF assms] density_cong[OF f f'] by auto
 
 lemma sigma_finite_density_unique:
   assumes borel: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   and fin: "sigma_finite_measure (density M f)"
   shows "density M f = density M g \<longleftrightarrow> (AE x in M. f x = g x)"
 proof
   assume "AE x in M. f x = g x" with borel show "density M f = density M g"
     by (auto intro: density_cong)
 next
   assume eq: "density M f = density M g"
   interpret f: sigma_finite_measure "density M f" by fact
-  from f.sigma_finite_incseq guess A . note cover = this
-
+  from f.sigma_finite_incseq obtain A where cover: "range A \<subseteq> sets (density M f)"
+    "\<Union> (range A) = space (density M f)"
+    "\<And>i. emeasure (density M f) (A i) \<noteq> \<infinity>"
+    "incseq A"
+    by auto
   have "AE x in M. \<forall>i. x \<in> A i \<longrightarrow> f x = g x"
     unfolding AE_all_countable
   proof
     fix i
     have "density (density M f) (indicator (A i)) = density (density M g) (indicator (A i))"
       unfolding eq ..
     moreover have "(\<integral>\<^sup>+x. f x * indicator (A i) x \<partial>M) \<noteq> \<infinity>"
       using cover(1) cover(3)[of i] borel by (auto simp: emeasure_density subset_eq)
     ultimately have "AE x in M. f x * indicator (A i) x = g x * indicator (A i) x"
       using borel cover(1)
       by (intro finite_density_unique[THEN iffD1]) (auto simp: density_density_eq subset_eq)
     then show "AE x in M. x \<in> A i \<longrightarrow> f x = g x"
       by auto
   qed
   with AE_space show "AE x in M. f x = g x"
     apply eventually_elim
     using cover(2)[symmetric]
     apply auto
     done
 qed
 
 lemma (in sigma_finite_measure) sigma_finite_iff_density_finite':
   assumes f: "f \<in> borel_measurable M"
   shows "sigma_finite_measure (density M f) \<longleftrightarrow> (AE x in M. f x \<noteq> \<infinity>)"
     (is "sigma_finite_measure ?N \<longleftrightarrow> _")
 proof
   assume "sigma_finite_measure ?N"
   then interpret N: sigma_finite_measure ?N .
   from N.Ex_finite_integrable_function obtain h where
     h: "h \<in> borel_measurable M" "integral\<^sup>N ?N h \<noteq> \<infinity>" and
     fin: "\<forall>x\<in>space M. 0 < h x \<and> h x < \<infinity>"
     by auto
   have "AE x in M. f x * h x \<noteq> \<infinity>"
   proof (rule AE_I')
     have "integral\<^sup>N ?N h = (\<integral>\<^sup>+x. f x * h x \<partial>M)"
       using f h by (auto intro!: nn_integral_density)
     then have "(\<integral>\<^sup>+x. f x * h x \<partial>M) \<noteq> \<infinity>"
       using h(2) by simp
     then show "(\<lambda>x. f x * h x) -` {\<infinity>} \<inter> space M \<in> null_sets M"
       using f h(1) by (auto intro!: nn_integral_PInf[unfolded infinity_ennreal_def] borel_measurable_vimage)
   qed auto
   then show "AE x in M. f x \<noteq> \<infinity>"
     using fin by (auto elim!: AE_Ball_mp simp: less_top ennreal_mult_less_top)
 next
   assume AE: "AE x in M. f x \<noteq> \<infinity>"
-  from sigma_finite guess Q . note Q = this
+  from sigma_finite obtain Q :: "nat \<Rightarrow> 'a set"
+    where Q: "range Q \<subseteq> sets M" "\<Union> (range Q) = space M" "\<And>i. emeasure M (Q i) \<noteq> \<infinity>"
+    by auto
   define A where "A i =
     f -` (case i of 0 \<Rightarrow> {\<infinity>} | Suc n \<Rightarrow> {.. ennreal(of_nat (Suc n))}) \<inter> space M" for i
   { fix i j have "A i \<inter> Q j \<in> sets M"
     unfolding A_def using f Q
     apply (rule_tac sets.Int)
     by (cases i) (auto intro: measurable_sets[OF f(1)]) }
   note A_in_sets = this
 
   show "sigma_finite_measure ?N"
   proof (standard, intro exI conjI ballI)
     show "countable (range (\<lambda>(i, j). A i \<inter> Q j))"
       by auto
     show "range (\<lambda>(i, j). A i \<inter> Q j) \<subseteq> sets (density M f)"
       using A_in_sets by auto
   next
     have "\<Union>(range (\<lambda>(i, j). A i \<inter> Q j)) = (\<Union>i j. A i \<inter> Q j)"
       by auto
     also have "\<dots> = (\<Union>i. A i) \<inter> space M" using Q by auto
     also have "(\<Union>i. A i) = space M"
     proof safe
       fix x assume x: "x \<in> space M"
       show "x \<in> (\<Union>i. A i)"
       proof (cases "f x" rule: ennreal_cases)
         case top with x show ?thesis unfolding A_def by (auto intro: exI[of _ 0])
       next
         case (real r)
         with ennreal_Ex_less_of_nat[of "f x"] obtain n :: nat where "f x < n"
           by auto
         also have "n < (Suc n :: ennreal)"
           by simp
         finally show ?thesis
           using x real by (auto simp: A_def ennreal_of_nat_eq_real_of_nat intro!: exI[of _ "Suc n"])
       qed
     qed (auto simp: A_def)
     finally show "\<Union>(range (\<lambda>(i, j). A i \<inter> Q j)) = space ?N" by simp
   next
     fix X assume "X \<in> range (\<lambda>(i, j). A i \<inter> Q j)"
     then obtain i j where [simp]:"X = A i \<inter> Q j" by auto
     have "(\<integral>\<^sup>+x. f x * indicator (A i \<inter> Q j) x \<partial>M) \<noteq> \<infinity>"
     proof (cases i)
       case 0
       have "AE x in M. f x * indicator (A i \<inter> Q j) x = 0"
         using AE by (auto simp: A_def \<open>i = 0\<close>)
       from nn_integral_cong_AE[OF this] show ?thesis by simp
     next
       case (Suc n)
       then have "(\<integral>\<^sup>+x. f x * indicator (A i \<inter> Q j) x \<partial>M) \<le>
         (\<integral>\<^sup>+x. (Suc n :: ennreal) * indicator (Q j) x \<partial>M)"
         by (auto intro!: nn_integral_mono simp: indicator_def A_def ennreal_of_nat_eq_real_of_nat)
       also have "\<dots> = Suc n * emeasure M (Q j)"
         using Q by (auto intro!: nn_integral_cmult_indicator)
       also have "\<dots> < \<infinity>"
         using Q by (auto simp: ennreal_mult_less_top less_top of_nat_less_top)
       finally show ?thesis by simp
     qed
     then show "emeasure ?N X \<noteq> \<infinity>"
       using A_in_sets Q f by (auto simp: emeasure_density)
   qed
 qed
 
 lemma (in sigma_finite_measure) sigma_finite_iff_density_finite:
   "f \<in> borel_measurable M \<Longrightarrow> sigma_finite_measure (density M f) \<longleftrightarrow> (AE x in M. f x \<noteq> \<infinity>)"
   by (subst sigma_finite_iff_density_finite')
      (auto simp: max_def intro!: measurable_If)
 
 subsection \<open>Radon-Nikodym derivative\<close>
 
 definition\<^marker>\<open>tag important\<close> RN_deriv :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> 'a \<Rightarrow> ennreal" where
   "RN_deriv M N =
     (if \<exists>f. f \<in> borel_measurable M \<and> density M f = N
        then SOME f. f \<in> borel_measurable M \<and> density M f = N
        else (\<lambda>_. 0))"
 
 lemma RN_derivI:
   assumes "f \<in> borel_measurable M" "density M f = N"
   shows "density M (RN_deriv M N) = N"
 proof -
   have *: "\<exists>f. f \<in> borel_measurable M \<and> density M f = N"
     using assms by auto
   then have "density M (SOME f. f \<in> borel_measurable M \<and> density M f = N) = N"
     by (rule someI2_ex) auto
   with * show ?thesis
     by (auto simp: RN_deriv_def)
 qed
 
 lemma borel_measurable_RN_deriv[measurable]: "RN_deriv M N \<in> borel_measurable M"
 proof -
   { assume ex: "\<exists>f. f \<in> borel_measurable M \<and> density M f = N"
     have 1: "(SOME f. f \<in> borel_measurable M \<and> density M f = N) \<in> borel_measurable M"
       using ex by (rule someI2_ex) auto }
   from this show ?thesis
     by (auto simp: RN_deriv_def)
 qed
 
 lemma density_RN_deriv_density:
   assumes f: "f \<in> borel_measurable M"
   shows "density M (RN_deriv M (density M f)) = density M f"
   by (rule RN_derivI[OF f]) simp
 
 lemma (in sigma_finite_measure) density_RN_deriv:
   "absolutely_continuous M N \<Longrightarrow> sets N = sets M \<Longrightarrow> density M (RN_deriv M N) = N"
   by (metis RN_derivI Radon_Nikodym)
 
 lemma (in sigma_finite_measure) RN_deriv_nn_integral:
   assumes N: "absolutely_continuous M N" "sets N = sets M"
     and f: "f \<in> borel_measurable M"
   shows "integral\<^sup>N N f = (\<integral>\<^sup>+x. RN_deriv M N x * f x \<partial>M)"
 proof -
   have "integral\<^sup>N N f = integral\<^sup>N (density M (RN_deriv M N)) f"
     using N by (simp add: density_RN_deriv)
   also have "\<dots> = (\<integral>\<^sup>+x. RN_deriv M N x * f x \<partial>M)"
     using f by (simp add: nn_integral_density)
   finally show ?thesis by simp
 qed
 
 lemma (in sigma_finite_measure) RN_deriv_unique:
   assumes f: "f \<in> borel_measurable M"
   and eq: "density M f = N"
   shows "AE x in M. f x = RN_deriv M N x"
   unfolding eq[symmetric]
   by (intro density_unique_iff[THEN iffD1] f borel_measurable_RN_deriv
             density_RN_deriv_density[symmetric])
 
 lemma RN_deriv_unique_sigma_finite:
   assumes f: "f \<in> borel_measurable M"
   and eq: "density M f = N" and fin: "sigma_finite_measure N"
   shows "AE x in M. f x = RN_deriv M N x"
   using fin unfolding eq[symmetric]
   by (intro sigma_finite_density_unique[THEN iffD1] f borel_measurable_RN_deriv
             density_RN_deriv_density[symmetric])
 
 lemma (in sigma_finite_measure) RN_deriv_distr:
   fixes T :: "'a \<Rightarrow> 'b"
   assumes T: "T \<in> measurable M M'" and T': "T' \<in> measurable M' M"
     and inv: "\<forall>x\<in>space M. T' (T x) = x"
   and ac[simp]: "absolutely_continuous (distr M M' T) (distr N M' T)"
   and N: "sets N = sets M"
   shows "AE x in M. RN_deriv (distr M M' T) (distr N M' T) (T x) = RN_deriv M N x"
 proof (rule RN_deriv_unique)
   have [simp]: "sets N = sets M" by fact
   note sets_eq_imp_space_eq[OF N, simp]
   have measurable_N[simp]: "\<And>M'. measurable N M' = measurable M M'" by (auto simp: measurable_def)
   { fix A assume "A \<in> sets M"
     with inv T T' sets.sets_into_space[OF this]
     have "T -` T' -` A \<inter> T -` space M' \<inter> space M = A"
       by (auto simp: measurable_def) }
   note eq = this[simp]
   { fix A assume "A \<in> sets M"
     with inv T T' sets.sets_into_space[OF this]
     have "(T' \<circ> T) -` A \<inter> space M = A"
       by (auto simp: measurable_def) }
   note eq2 = this[simp]
   let ?M' = "distr M M' T" and ?N' = "distr N M' T"
   interpret M': sigma_finite_measure ?M'
   proof
-    from sigma_finite_countable guess F .. note F = this
+    from sigma_finite_countable obtain F
+      where F: "countable F \<and> F \<subseteq> sets M \<and> \<Union> F = space M \<and> (\<forall>a\<in>F. emeasure M a \<noteq> \<infinity>)" ..
     show "\<exists>A. countable A \<and> A \<subseteq> sets (distr M M' T) \<and> \<Union>A = space (distr M M' T) \<and> (\<forall>a\<in>A. emeasure (distr M M' T) a \<noteq> \<infinity>)"
     proof (intro exI conjI ballI)
       show *: "(\<lambda>A. T' -` A \<inter> space ?M') ` F \<subseteq> sets ?M'"
         using F T' by (auto simp: measurable_def)
       show "\<Union>((\<lambda>A. T' -` A \<inter> space ?M')`F) = space ?M'"
         using F T'[THEN measurable_space] by (auto simp: set_eq_iff)
     next
       fix X assume "X \<in> (\<lambda>A. T' -` A \<inter> space ?M')`F"
       then obtain A where [simp]: "X = T' -` A \<inter> space ?M'" and "A \<in> F" by auto
       have "X \<in> sets M'" using F T' \<open>A\<in>F\<close> by auto
       moreover
       have Fi: "A \<in> sets M" using F \<open>A\<in>F\<close> by auto
       ultimately show "emeasure ?M' X \<noteq> \<infinity>"
         using F T T' \<open>A\<in>F\<close> by (simp add: emeasure_distr)
-    qed (insert F, auto)
+    qed (use F in auto)
   qed
   have "(RN_deriv ?M' ?N') \<circ> T \<in> borel_measurable M"
     using T ac by measurable
   then show "(\<lambda>x. RN_deriv ?M' ?N' (T x)) \<in> borel_measurable M"
     by (simp add: comp_def)
 
   have "N = distr N M (T' \<circ> T)"
     by (subst measure_of_of_measure[of N, symmetric])
        (auto simp add: distr_def sets.sigma_sets_eq intro!: measure_of_eq sets.space_closed)
   also have "\<dots> = distr (distr N M' T) M T'"
     using T T' by (simp add: distr_distr)
   also have "\<dots> = distr (density (distr M M' T) (RN_deriv (distr M M' T) (distr N M' T))) M T'"
     using ac by (simp add: M'.density_RN_deriv)
   also have "\<dots> = density M (RN_deriv (distr M M' T) (distr N M' T) \<circ> T)"
     by (simp add: distr_density_distr[OF T T', OF inv])
   finally show "density M (\<lambda>x. RN_deriv (distr M M' T) (distr N M' T) (T x)) = N"
     by (simp add: comp_def)
 qed
 
 lemma (in sigma_finite_measure) RN_deriv_finite:
   assumes N: "sigma_finite_measure N" and ac: "absolutely_continuous M N" "sets N = sets M"
   shows "AE x in M. RN_deriv M N x \<noteq> \<infinity>"
 proof -
   interpret N: sigma_finite_measure N by fact
   from N show ?thesis
     using sigma_finite_iff_density_finite[OF borel_measurable_RN_deriv, of N] density_RN_deriv[OF ac]
     by simp
 qed
 
 lemma (in sigma_finite_measure)
   assumes N: "sigma_finite_measure N" and ac: "absolutely_continuous M N" "sets N = sets M"
     and f: "f \<in> borel_measurable M"
   shows RN_deriv_integrable: "integrable N f \<longleftrightarrow>
       integrable M (\<lambda>x. enn2real (RN_deriv M N x) * f x)" (is ?integrable)
     and RN_deriv_integral: "integral\<^sup>L N f = (\<integral>x. enn2real (RN_deriv M N x) * f x \<partial>M)" (is ?integral)
 proof -
   note ac(2)[simp] and sets_eq_imp_space_eq[OF ac(2), simp]
   interpret N: sigma_finite_measure N by fact
 
   have eq: "density M (RN_deriv M N) = density M (\<lambda>x. enn2real (RN_deriv M N x))"
   proof (rule density_cong)
     from RN_deriv_finite[OF assms(1,2,3)]
     show "AE x in M. RN_deriv M N x = ennreal (enn2real (RN_deriv M N x))"
       by eventually_elim (auto simp: less_top)
   qed (insert ac, auto)
 
   show ?integrable
     apply (subst density_RN_deriv[OF ac, symmetric])
     unfolding eq
     apply (intro integrable_real_density f AE_I2 enn2real_nonneg)
     apply (insert ac, auto)
     done
 
   show ?integral
     apply (subst density_RN_deriv[OF ac, symmetric])
     unfolding eq
     apply (intro integral_real_density f AE_I2 enn2real_nonneg)
     apply (insert ac, auto)
     done
 qed
 
 proposition (in sigma_finite_measure) real_RN_deriv:
   assumes "finite_measure N"
   assumes ac: "absolutely_continuous M N" "sets N = sets M"
   obtains D where "D \<in> borel_measurable M"
     and "AE x in M. RN_deriv M N x = ennreal (D x)"
     and "AE x in N. 0 < D x"
     and "\<And>x. 0 \<le> D x"
 proof
   interpret N: finite_measure N by fact
 
   note RN = borel_measurable_RN_deriv density_RN_deriv[OF ac]
 
   let ?RN = "\<lambda>t. {x \<in> space M. RN_deriv M N x = t}"
 
   show "(\<lambda>x. enn2real (RN_deriv M N x)) \<in> borel_measurable M"
     using RN by auto
 
   have "N (?RN \<infinity>) = (\<integral>\<^sup>+ x. RN_deriv M N x * indicator (?RN \<infinity>) x \<partial>M)"
     using RN(1) by (subst RN(2)[symmetric]) (auto simp: emeasure_density)
   also have "\<dots> = (\<integral>\<^sup>+ x. \<infinity> * indicator (?RN \<infinity>) x \<partial>M)"
     by (intro nn_integral_cong) (auto simp: indicator_def)
   also have "\<dots> = \<infinity> * emeasure M (?RN \<infinity>)"
     using RN by (intro nn_integral_cmult_indicator) auto
   finally have eq: "N (?RN \<infinity>) = \<infinity> * emeasure M (?RN \<infinity>)" .
   moreover
   have "emeasure M (?RN \<infinity>) = 0"
   proof (rule ccontr)
     assume "emeasure M {x \<in> space M. RN_deriv M N x = \<infinity>} \<noteq> 0"
     then have "0 < emeasure M {x \<in> space M. RN_deriv M N x = \<infinity>}"
       by (auto simp: zero_less_iff_neq_zero)
     with eq have "N (?RN \<infinity>) = \<infinity>" by (simp add: ennreal_mult_eq_top_iff)
     with N.emeasure_finite[of "?RN \<infinity>"] RN show False by auto
   qed
   ultimately have "AE x in M. RN_deriv M N x < \<infinity>"
     using RN by (intro AE_iff_measurable[THEN iffD2]) (auto simp: less_top[symmetric])
   then show "AE x in M. RN_deriv M N x = ennreal (enn2real (RN_deriv M N x))"
     by auto
   then have eq: "AE x in N. RN_deriv M N x = ennreal (enn2real (RN_deriv M N x))"
     using ac absolutely_continuous_AE by auto
 
 
   have "N (?RN 0) = (\<integral>\<^sup>+ x. RN_deriv M N x * indicator (?RN 0) x \<partial>M)"
     by (subst RN(2)[symmetric]) (auto simp: emeasure_density)
   also have "\<dots> = (\<integral>\<^sup>+ x. 0 \<partial>M)"
     by (intro nn_integral_cong) (auto simp: indicator_def)
   finally have "AE x in N. RN_deriv M N x \<noteq> 0"
     using RN by (subst AE_iff_measurable[OF _ refl]) (auto simp: ac cong: sets_eq_imp_space_eq)
   with eq show "AE x in N. 0 < enn2real (RN_deriv M N x)"
     by (auto simp: enn2real_positive_iff less_top[symmetric] zero_less_iff_neq_zero)
 qed (rule enn2real_nonneg)
 
 lemma (in sigma_finite_measure) RN_deriv_singleton:
   assumes ac: "absolutely_continuous M N" "sets N = sets M"
   and x: "{x} \<in> sets M"
   shows "N {x} = RN_deriv M N x * emeasure M {x}"
 proof -
   from \<open>{x} \<in> sets M\<close>
   have "density M (RN_deriv M N) {x} = (\<integral>\<^sup>+w. RN_deriv M N x * indicator {x} w \<partial>M)"
     by (auto simp: indicator_def emeasure_density intro!: nn_integral_cong)
   with x density_RN_deriv[OF ac] show ?thesis
     by (auto simp: max_def)
 qed
 
 end
diff --git a/src/HOL/Analysis/Regularity.thy b/src/HOL/Analysis/Regularity.thy
--- a/src/HOL/Analysis/Regularity.thy
+++ b/src/HOL/Analysis/Regularity.thy
@@ -1,391 +1,392 @@
 (*  Title:      HOL/Analysis/Regularity.thy
     Author:     Fabian Immler, TU München
 *)
 
 section \<open>Regularity of Measures\<close>
 
 theory Regularity (* FIX suggestion to rename  e.g. RegularityMeasures and/ or move as
 this theory consists of 1 result only  *)
 imports Measure_Space Borel_Space
 begin
 
 theorem
   fixes M::"'a::{second_countable_topology, complete_space} measure"
   assumes sb: "sets M = sets borel"
   assumes "emeasure M (space M) \<noteq> \<infinity>"
   assumes "B \<in> sets borel"
   shows inner_regular: "emeasure M B =
     (SUP K \<in> {K. K \<subseteq> B \<and> compact K}. emeasure M K)" (is "?inner B")
   and outer_regular: "emeasure M B =
     (INF U \<in> {U. B \<subseteq> U \<and> open U}. emeasure M U)" (is "?outer B")
 proof -
   have Us: "UNIV = space M" by (metis assms(1) sets_eq_imp_space_eq space_borel)
   hence sU: "space M = UNIV" by simp
   interpret finite_measure M by rule fact
   have approx_inner: "\<And>A. A \<in> sets M \<Longrightarrow>
     (\<And>e. e > 0 \<Longrightarrow> \<exists>K. K \<subseteq> A \<and> compact K \<and> emeasure M A \<le> emeasure M K + ennreal e) \<Longrightarrow> ?inner A"
     by (rule ennreal_approx_SUP)
       (force intro!: emeasure_mono simp: compact_imp_closed emeasure_eq_measure)+
   have approx_outer: "\<And>A. A \<in> sets M \<Longrightarrow>
     (\<And>e. e > 0 \<Longrightarrow> \<exists>B. A \<subseteq> B \<and> open B \<and> emeasure M B \<le> emeasure M A + ennreal e) \<Longrightarrow> ?outer A"
     by (rule ennreal_approx_INF)
        (force intro!: emeasure_mono simp: emeasure_eq_measure sb)+
-  from countable_dense_setE guess X::"'a set"  . note X = this
+  from countable_dense_setE obtain X :: "'a set"
+    where X: "countable X" "\<And>Y :: 'a set. open Y \<Longrightarrow> Y \<noteq> {} \<Longrightarrow> \<exists>d\<in>X. d \<in> Y"
+    by auto
   {
     fix r::real assume "r > 0" hence "\<And>y. open (ball y r)" "\<And>y. ball y r \<noteq> {}" by auto
     with X(2)[OF this]
     have x: "space M = (\<Union>x\<in>X. cball x r)"
       by (auto simp add: sU) (metis dist_commute order_less_imp_le)
     let ?U = "\<Union>k. (\<Union>n\<in>{0..k}. cball (from_nat_into X n) r)"
     have "(\<lambda>k. emeasure M (\<Union>n\<in>{0..k}. cball (from_nat_into X n) r)) \<longlonglongrightarrow> M ?U"
       by (rule Lim_emeasure_incseq) (auto intro!: borel_closed bexI simp: incseq_def Us sb)
     also have "?U = space M"
     proof safe
       fix x from X(2)[OF open_ball[of x r]] \<open>r > 0\<close> obtain d where d: "d\<in>X" "d \<in> ball x r" by auto
       show "x \<in> ?U"
         using X(1) d
         by simp (auto intro!: exI [where x = "to_nat_on X d"] simp: dist_commute Bex_def)
     qed (simp add: sU)
     finally have "(\<lambda>k. M (\<Union>n\<in>{0..k}. cball (from_nat_into X n) r)) \<longlonglongrightarrow> M (space M)" .
   } note M_space = this
   {
     fix e ::real and n :: nat assume "e > 0" "n > 0"
     hence "1/n > 0" "e * 2 powr - n > 0" by (auto)
     from M_space[OF \<open>1/n>0\<close>]
     have "(\<lambda>k. measure M (\<Union>i\<in>{0..k}. cball (from_nat_into X i) (1/real n))) \<longlonglongrightarrow> measure M (space M)"
       unfolding emeasure_eq_measure by (auto)
     from metric_LIMSEQ_D[OF this \<open>0 < e * 2 powr -n\<close>]
     obtain k where "dist (measure M (\<Union>i\<in>{0..k}. cball (from_nat_into X i) (1/real n))) (measure M (space M)) <
       e * 2 powr -n"
       by auto
     hence "measure M (\<Union>i\<in>{0..k}. cball (from_nat_into X i) (1/real n)) \<ge>
       measure M (space M) - e * 2 powr -real n"
       by (auto simp: dist_real_def)
     hence "\<exists>k. measure M (\<Union>i\<in>{0..k}. cball (from_nat_into X i) (1/real n)) \<ge>
       measure M (space M) - e * 2 powr - real n" ..
   } note k=this
   hence "\<forall>e\<in>{0<..}. \<forall>(n::nat)\<in>{0<..}. \<exists>k.
     measure M (\<Union>i\<in>{0..k}. cball (from_nat_into X i) (1/real n)) \<ge> measure M (space M) - e * 2 powr - real n"
     by blast
   then obtain k where k: "\<forall>e\<in>{0<..}. \<forall>n\<in>{0<..}. measure M (space M) - e * 2 powr - real (n::nat)
     \<le> measure M (\<Union>i\<in>{0..k e n}. cball (from_nat_into X i) (1 / n))"
     by metis
   hence k: "\<And>e n. e > 0 \<Longrightarrow> n > 0 \<Longrightarrow> measure M (space M) - e * 2 powr - n
     \<le> measure M (\<Union>i\<in>{0..k e n}. cball (from_nat_into X i) (1 / n))"
     unfolding Ball_def by blast
   have approx_space:
     "\<exists>K \<in> {K. K \<subseteq> space M \<and> compact K}. emeasure M (space M) \<le> emeasure M K + ennreal e"
     (is "?thesis e") if "0 < e" for e :: real
   proof -
     define B where [abs_def]:
       "B n = (\<Union>i\<in>{0..k e (Suc n)}. cball (from_nat_into X i) (1 / Suc n))" for n
     have "\<And>n. closed (B n)" by (auto simp: B_def)
     hence [simp]: "\<And>n. B n \<in> sets M" by (simp add: sb)
     from k[OF \<open>e > 0\<close> zero_less_Suc]
     have "\<And>n. measure M (space M) - measure M (B n) \<le> e * 2 powr - real (Suc n)"
       by (simp add: algebra_simps B_def finite_measure_compl)
     hence B_compl_le: "\<And>n::nat. measure M (space M - B n) \<le> e * 2 powr - real (Suc n)"
       by (simp add: finite_measure_compl)
     define K where "K = (\<Inter>n. B n)"
     from \<open>closed (B _)\<close> have "closed K" by (auto simp: K_def)
     hence [simp]: "K \<in> sets M" by (simp add: sb)
     have "measure M (space M) - measure M K = measure M (space M - K)"
       by (simp add: finite_measure_compl)
     also have "\<dots> = emeasure M (\<Union>n. space M - B n)" by (auto simp: K_def emeasure_eq_measure)
     also have "\<dots> \<le> (\<Sum>n. emeasure M (space M - B n))"
       by (rule emeasure_subadditive_countably) (auto simp: summable_def)
     also have "\<dots> \<le> (\<Sum>n. ennreal (e*2 powr - real (Suc n)))"
       using B_compl_le by (intro suminf_le) (simp_all add: emeasure_eq_measure ennreal_leI)
     also have "\<dots> \<le> (\<Sum>n. ennreal (e * (1 / 2) ^ Suc n))"
       by (simp add: powr_minus powr_realpow field_simps del: of_nat_Suc)
     also have "\<dots> = ennreal e * (\<Sum>n. ennreal ((1 / 2) ^ Suc n))"
       unfolding ennreal_power[symmetric]
       using \<open>0 < e\<close>
       by (simp add: ac_simps ennreal_mult' divide_ennreal[symmetric] divide_ennreal_def
                     ennreal_power[symmetric])
     also have "\<dots> = e"
       by (subst suminf_ennreal_eq[OF zero_le_power power_half_series]) auto
     finally have "measure M (space M) \<le> measure M K + e"
       using \<open>0 < e\<close> by simp
     hence "emeasure M (space M) \<le> emeasure M K + e"
       using \<open>0 < e\<close> by (simp add: emeasure_eq_measure flip: ennreal_plus)
     moreover have "compact K"
       unfolding compact_eq_totally_bounded
     proof safe
       show "complete K" using \<open>closed K\<close> by (simp add: complete_eq_closed)
       fix e'::real assume "0 < e'"
-      from nat_approx_posE[OF this] guess n . note n = this
+      then obtain n where n: "1 / real (Suc n) < e'" by (rule nat_approx_posE)
       let ?k = "from_nat_into X ` {0..k e (Suc n)}"
       have "finite ?k" by simp
       moreover have "K \<subseteq> (\<Union>x\<in>?k. ball x e')" unfolding K_def B_def using n by force
       ultimately show "\<exists>k. finite k \<and> K \<subseteq> (\<Union>x\<in>k. ball x e')" by blast
     qed
     ultimately
     show ?thesis by (auto simp: sU)
   qed
   { fix A::"'a set" assume "closed A" hence "A \<in> sets borel" by (simp add: compact_imp_closed)
     hence [simp]: "A \<in> sets M" by (simp add: sb)
     have "?inner A"
     proof (rule approx_inner)
       fix e::real assume "e > 0"
       from approx_space[OF this] obtain K where
         K: "K \<subseteq> space M" "compact K" "emeasure M (space M) \<le> emeasure M K + e"
         by (auto simp: emeasure_eq_measure)
       hence [simp]: "K \<in> sets M" by (simp add: sb compact_imp_closed)
       have "measure M A - measure M (A \<inter> K) = measure M (A - A \<inter> K)"
         by (subst finite_measure_Diff) auto
       also have "A - A \<inter> K = A \<union> K - K" by auto
       also have "measure M \<dots> = measure M (A \<union> K) - measure M K"
         by (subst finite_measure_Diff) auto
       also have "\<dots> \<le> measure M (space M) - measure M K"
         by (simp add: emeasure_eq_measure sU sb finite_measure_mono)
       also have "\<dots> \<le> e"
         using K \<open>0 < e\<close> by (simp add: emeasure_eq_measure flip: ennreal_plus)
       finally have "emeasure M A \<le> emeasure M (A \<inter> K) + ennreal e"
         using \<open>0<e\<close> by (simp add: emeasure_eq_measure algebra_simps flip: ennreal_plus)
       moreover have "A \<inter> K \<subseteq> A" "compact (A \<inter> K)" using \<open>closed A\<close> \<open>compact K\<close> by auto
       ultimately show "\<exists>K \<subseteq> A. compact K \<and> emeasure M A \<le> emeasure M K + ennreal e"
         by blast
     qed simp
     have "?outer A"
     proof cases
       assume "A \<noteq> {}"
       let ?G = "\<lambda>d. {x. infdist x A < d}"
       {
         fix d
         have "?G d = (\<lambda>x. infdist x A) -` {..<d}" by auto
         also have "open \<dots>"
           by (intro continuous_open_vimage) (auto intro!: continuous_infdist continuous_ident)
         finally have "open (?G d)" .
       } note open_G = this
       from in_closed_iff_infdist_zero[OF \<open>closed A\<close> \<open>A \<noteq> {}\<close>]
       have "A = {x. infdist x A = 0}" by auto
       also have "\<dots> = (\<Inter>i. ?G (1/real (Suc i)))"
       proof (auto simp del: of_nat_Suc, rule ccontr)
         fix x
         assume "infdist x A \<noteq> 0"
-        hence pos: "infdist x A > 0" using infdist_nonneg[of x A] by simp
-        from nat_approx_posE[OF this] guess n .
-        moreover
+        then have pos: "infdist x A > 0" using infdist_nonneg[of x A] by simp
+        then obtain n where n: "1 / real (Suc n) < infdist x A" by (rule nat_approx_posE)
         assume "\<forall>i. infdist x A < 1 / real (Suc i)"
-        hence "infdist x A < 1 / real (Suc n)" by auto
-        ultimately show False by simp
+        then have "infdist x A < 1 / real (Suc n)" by auto
+        with n show False by simp
       qed
       also have "M \<dots> = (INF n. emeasure M (?G (1 / real (Suc n))))"
       proof (rule INF_emeasure_decseq[symmetric], safe)
         fix i::nat
         from open_G[of "1 / real (Suc i)"]
         show "?G (1 / real (Suc i)) \<in> sets M" by (simp add: sb borel_open)
       next
         show "decseq (\<lambda>i. {x. infdist x A < 1 / real (Suc i)})"
           by (auto intro: less_trans intro!: divide_strict_left_mono
             simp: decseq_def le_eq_less_or_eq)
       qed simp
       finally
       have "emeasure M A = (INF n. emeasure M {x. infdist x A < 1 / real (Suc n)})" .
       moreover
       have "\<dots> \<ge> (INF U\<in>{U. A \<subseteq> U \<and> open U}. emeasure M U)"
       proof (intro INF_mono)
         fix m
         have "?G (1 / real (Suc m)) \<in> {U. A \<subseteq> U \<and> open U}" using open_G by auto
         moreover have "M (?G (1 / real (Suc m))) \<le> M (?G (1 / real (Suc m)))" by simp
         ultimately show "\<exists>U\<in>{U. A \<subseteq> U \<and> open U}.
           emeasure M U \<le> emeasure M {x. infdist x A < 1 / real (Suc m)}"
           by blast
       qed
       moreover
       have "emeasure M A \<le> (INF U\<in>{U. A \<subseteq> U \<and> open U}. emeasure M U)"
         by (rule INF_greatest) (auto intro!: emeasure_mono simp: sb)
       ultimately show ?thesis by simp
     qed (auto intro!: INF_eqI)
     note \<open>?inner A\<close> \<open>?outer A\<close> }
   note closed_in_D = this
   from \<open>B \<in> sets borel\<close>
   have "Int_stable (Collect closed)" "Collect closed \<subseteq> Pow UNIV" "B \<in> sigma_sets UNIV (Collect closed)"
     by (auto simp: Int_stable_def borel_eq_closed)
   then show "?inner B" "?outer B"
   proof (induct B rule: sigma_sets_induct_disjoint)
     case empty
     { case 1 show ?case by (intro SUP_eqI[symmetric]) auto }
     { case 2 show ?case by (intro INF_eqI[symmetric]) (auto elim!: meta_allE[of _ "{}"]) }
   next
     case (basic B)
     { case 1 from basic closed_in_D show ?case by auto }
     { case 2 from basic closed_in_D show ?case by auto }
   next
     case (compl B)
     note inner = compl(2) and outer = compl(3)
     from compl have [simp]: "B \<in> sets M" by (auto simp: sb borel_eq_closed)
     case 2
     have "M (space M - B) = M (space M) - emeasure M B" by (auto simp: emeasure_compl)
     also have "\<dots> = (INF K\<in>{K. K \<subseteq> B \<and> compact K}. M (space M) -  M K)"
       by (subst ennreal_SUP_const_minus) (auto simp: less_top[symmetric] inner)
     also have "\<dots> = (INF U\<in>{U. U \<subseteq> B \<and> compact U}. M (space M - U))"
       by (auto simp add: emeasure_compl sb compact_imp_closed)
     also have "\<dots> \<ge> (INF U\<in>{U. U \<subseteq> B \<and> closed U}. M (space M - U))"
       by (rule INF_superset_mono) (auto simp add: compact_imp_closed)
     also have "(INF U\<in>{U. U \<subseteq> B \<and> closed U}. M (space M - U)) =
         (INF U\<in>{U. space M - B \<subseteq> U \<and> open U}. emeasure M U)"
       apply (rule arg_cong [of _ _ Inf])
       using sU
       apply (auto simp add: image_iff)
       apply (rule exI [of _ "UNIV - y" for y])
       apply safe
         apply (auto simp add: double_diff)
       done
     finally have
       "(INF U\<in>{U. space M - B \<subseteq> U \<and> open U}. emeasure M U) \<le> emeasure M (space M - B)" .
     moreover have
       "(INF U\<in>{U. space M - B \<subseteq> U \<and> open U}. emeasure M U) \<ge> emeasure M (space M - B)"
       by (auto simp: sb sU intro!: INF_greatest emeasure_mono)
     ultimately show ?case by (auto intro!: antisym simp: sets_eq_imp_space_eq[OF sb])
 
     case 1
     have "M (space M - B) = M (space M) - emeasure M B" by (auto simp: emeasure_compl)
     also have "\<dots> = (SUP U\<in> {U. B \<subseteq> U \<and> open U}. M (space M) -  M U)"
       unfolding outer by (subst ennreal_INF_const_minus) auto
     also have "\<dots> = (SUP U\<in>{U. B \<subseteq> U \<and> open U}. M (space M - U))"
       by (auto simp add: emeasure_compl sb compact_imp_closed)
     also have "\<dots> = (SUP K\<in>{K. K \<subseteq> space M - B \<and> closed K}. emeasure M K)"
       unfolding SUP_image [of _ "\<lambda>u. space M - u" _, symmetric, unfolded comp_def]
       apply (rule arg_cong [of _ _ Sup])
       using sU apply (auto intro!: imageI)
       done
     also have "\<dots> = (SUP K\<in>{K. K \<subseteq> space M - B \<and> compact K}. emeasure M K)"
     proof (safe intro!: antisym SUP_least)
       fix K assume "closed K" "K \<subseteq> space M - B"
       from closed_in_D[OF \<open>closed K\<close>]
       have K_inner: "emeasure M K = (SUP K\<in>{Ka. Ka \<subseteq> K \<and> compact Ka}. emeasure M K)" by simp
       show "emeasure M K \<le> (SUP K\<in>{K. K \<subseteq> space M - B \<and> compact K}. emeasure M K)"
         unfolding K_inner using \<open>K \<subseteq> space M - B\<close>
         by (auto intro!: SUP_upper SUP_least)
     qed (fastforce intro!: SUP_least SUP_upper simp: compact_imp_closed)
     finally show ?case by (auto intro!: antisym simp: sets_eq_imp_space_eq[OF sb])
   next
     case (union D)
     then have "range D \<subseteq> sets M" by (auto simp: sb borel_eq_closed)
     with union have M[symmetric]: "(\<Sum>i. M (D i)) = M (\<Union>i. D i)" by (intro suminf_emeasure)
     also have "(\<lambda>n. \<Sum>i<n. M (D i)) \<longlonglongrightarrow> (\<Sum>i. M (D i))"
       by (intro summable_LIMSEQ) auto
     finally have measure_LIMSEQ: "(\<lambda>n. \<Sum>i<n. measure M (D i)) \<longlonglongrightarrow> measure M (\<Union>i. D i)"
       by (simp add: emeasure_eq_measure sum_nonneg)
     have "(\<Union>i. D i) \<in> sets M" using \<open>range D \<subseteq> sets M\<close> by auto
 
     case 1
     show ?case
     proof (rule approx_inner)
       fix e::real assume "e > 0"
       with measure_LIMSEQ
       have "\<exists>no. \<forall>n\<ge>no. \<bar>(\<Sum>i<n. measure M (D i)) -measure M (\<Union>x. D x)\<bar> < e/2"
         by (auto simp: lim_sequentially dist_real_def simp del: less_divide_eq_numeral1)
       hence "\<exists>n0. \<bar>(\<Sum>i<n0. measure M (D i)) - measure M (\<Union>x. D x)\<bar> < e/2" by auto
       then obtain n0 where n0: "\<bar>(\<Sum>i<n0. measure M (D i)) - measure M (\<Union>i. D i)\<bar> < e/2"
         unfolding choice_iff by blast
       have "ennreal (\<Sum>i<n0. measure M (D i)) = (\<Sum>i<n0. M (D i))"
         by (auto simp add: emeasure_eq_measure)
       also have "\<dots> \<le> (\<Sum>i. M (D i))" by (rule sum_le_suminf) auto
       also have "\<dots> = M (\<Union>i. D i)" by (simp add: M)
       also have "\<dots> = measure M (\<Union>i. D i)" by (simp add: emeasure_eq_measure)
       finally have n0: "measure M (\<Union>i. D i) - (\<Sum>i<n0. measure M (D i)) < e/2"
         using n0 by (auto simp: sum_nonneg)
       have "\<forall>i. \<exists>K. K \<subseteq> D i \<and> compact K \<and> emeasure M (D i) \<le> emeasure M K + e/(2*Suc n0)"
       proof
         fix i
         from \<open>0 < e\<close> have "0 < e/(2*Suc n0)" by simp
         have "emeasure M (D i) = (SUP K\<in>{K. K \<subseteq> (D i) \<and> compact K}. emeasure M K)"
           using union by blast
         from SUP_approx_ennreal[OF \<open>0 < e/(2*Suc n0)\<close> _ this]
         show "\<exists>K. K \<subseteq> D i \<and> compact K \<and> emeasure M (D i) \<le> emeasure M K + e/(2*Suc n0)"
           by (auto simp: emeasure_eq_measure intro: less_imp_le compact_empty)
       qed
       then obtain K where K: "\<And>i. K i \<subseteq> D i" "\<And>i. compact (K i)"
         "\<And>i. emeasure M (D i) \<le> emeasure M (K i) + e/(2*Suc n0)"
         unfolding choice_iff by blast
       let ?K = "\<Union>i\<in>{..<n0}. K i"
       have "disjoint_family_on K {..<n0}" using K \<open>disjoint_family D\<close>
         unfolding disjoint_family_on_def by blast
       hence mK: "measure M ?K = (\<Sum>i<n0. measure M (K i))" using K
         by (intro finite_measure_finite_Union) (auto simp: sb compact_imp_closed)
       have "measure M (\<Union>i. D i) < (\<Sum>i<n0. measure M (D i)) + e/2" using n0 by simp
       also have "(\<Sum>i<n0. measure M (D i)) \<le> (\<Sum>i<n0. measure M (K i) + e/(2*Suc n0))"
         using K \<open>0 < e\<close>
         by (auto intro: sum_mono simp: emeasure_eq_measure simp flip: ennreal_plus)
       also have "\<dots> = (\<Sum>i<n0. measure M (K i)) + (\<Sum>i<n0. e/(2*Suc n0))"
         by (simp add: sum.distrib)
       also have "\<dots> \<le> (\<Sum>i<n0. measure M (K i)) +  e / 2" using \<open>0 < e\<close>
         by (auto simp: field_simps intro!: mult_left_mono)
       finally
       have "measure M (\<Union>i. D i) < (\<Sum>i<n0. measure M (K i)) + e / 2 + e / 2"
         by auto
       hence "M (\<Union>i. D i) < M ?K + e"
         using \<open>0<e\<close> by (auto simp: mK emeasure_eq_measure sum_nonneg ennreal_less_iff simp flip: ennreal_plus)
       moreover
       have "?K \<subseteq> (\<Union>i. D i)" using K by auto
       moreover
       have "compact ?K" using K by auto
       ultimately
       have "?K\<subseteq>(\<Union>i. D i) \<and> compact ?K \<and> emeasure M (\<Union>i. D i) \<le> emeasure M ?K + ennreal e" by simp
       thus "\<exists>K\<subseteq>\<Union>i. D i. compact K \<and> emeasure M (\<Union>i. D i) \<le> emeasure M K + ennreal e" ..
     qed fact
     case 2
     show ?case
     proof (rule approx_outer[OF \<open>(\<Union>i. D i) \<in> sets M\<close>])
       fix e::real assume "e > 0"
       have "\<forall>i::nat. \<exists>U. D i \<subseteq> U \<and> open U \<and> e/(2 powr Suc i) > emeasure M U - emeasure M (D i)"
       proof
         fix i::nat
         from \<open>0 < e\<close> have "0 < e/(2 powr Suc i)" by simp
         have "emeasure M (D i) = (INF U\<in>{U. (D i) \<subseteq> U \<and> open U}. emeasure M U)"
           using union by blast
         from INF_approx_ennreal[OF \<open>0 < e/(2 powr Suc i)\<close> this]
         show "\<exists>U. D i \<subseteq> U \<and> open U \<and> e/(2 powr Suc i) > emeasure M U - emeasure M (D i)"
           using \<open>0<e\<close>
           by (auto simp: emeasure_eq_measure sum_nonneg ennreal_less_iff ennreal_minus
                          finite_measure_mono sb
                    simp flip: ennreal_plus)
       qed
       then obtain U where U: "\<And>i. D i \<subseteq> U i" "\<And>i. open (U i)"
         "\<And>i. e/(2 powr Suc i) > emeasure M (U i) - emeasure M (D i)"
         unfolding choice_iff by blast
       let ?U = "\<Union>i. U i"
       have "ennreal (measure M ?U - measure M (\<Union>i. D i)) = M ?U - M (\<Union>i. D i)"
         using U(1,2)
         by (subst ennreal_minus[symmetric])
            (auto intro!: finite_measure_mono simp: sb emeasure_eq_measure)
       also have "\<dots> = M (?U - (\<Union>i. D i))" using U  \<open>(\<Union>i. D i) \<in> sets M\<close>
         by (subst emeasure_Diff) (auto simp: sb)
       also have "\<dots> \<le> M (\<Union>i. U i - D i)" using U  \<open>range D \<subseteq> sets M\<close>
         by (intro emeasure_mono) (auto simp: sb intro!: sets.countable_nat_UN sets.Diff)
       also have "\<dots> \<le> (\<Sum>i. M (U i - D i))" using U  \<open>range D \<subseteq> sets M\<close>
         by (intro emeasure_subadditive_countably) (auto intro!: sets.Diff simp: sb)
       also have "\<dots> \<le> (\<Sum>i. ennreal e/(2 powr Suc i))" using U \<open>range D \<subseteq> sets M\<close>
         using \<open>0<e\<close>
         by (intro suminf_le, subst emeasure_Diff)
            (auto simp: emeasure_Diff emeasure_eq_measure sb ennreal_minus
                        finite_measure_mono divide_ennreal ennreal_less_iff
                  intro: less_imp_le)
       also have "\<dots> \<le> (\<Sum>n. ennreal (e * (1 / 2) ^ Suc n))"
         using \<open>0<e\<close>
         by (simp add: powr_minus powr_realpow field_simps divide_ennreal del: of_nat_Suc)
       also have "\<dots> = ennreal e * (\<Sum>n. ennreal ((1 / 2) ^  Suc n))"
         unfolding ennreal_power[symmetric]
         using \<open>0 < e\<close>
         by (simp add: ac_simps ennreal_mult' divide_ennreal[symmetric] divide_ennreal_def
                       ennreal_power[symmetric])
       also have "\<dots> = ennreal e"
         by (subst suminf_ennreal_eq[OF zero_le_power power_half_series]) auto
       finally have "emeasure M ?U \<le> emeasure M (\<Union>i. D i) + ennreal e"
         using \<open>0<e\<close> by (simp add: emeasure_eq_measure flip: ennreal_plus)
       moreover
       have "(\<Union>i. D i) \<subseteq> ?U" using U by auto
       moreover
       have "open ?U" using U by auto
       ultimately
       have "(\<Union>i. D i) \<subseteq> ?U \<and> open ?U \<and> emeasure M ?U \<le> emeasure M (\<Union>i. D i) + ennreal e" by simp
       thus "\<exists>B. (\<Union>i. D i) \<subseteq> B \<and> open B \<and> emeasure M B \<le> emeasure M (\<Union>i. D i) + ennreal e" ..
     qed
   qed
 qed
 
 end
 
diff --git a/src/HOL/Analysis/Set_Integral.thy b/src/HOL/Analysis/Set_Integral.thy
--- a/src/HOL/Analysis/Set_Integral.thy
+++ b/src/HOL/Analysis/Set_Integral.thy
@@ -1,1163 +1,1163 @@
 (*  Title:      HOL/Analysis/Set_Integral.thy
     Author:     Jeremy Avigad (CMU), Johannes Hölzl (TUM), Luke Serafin (CMU)
     Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
 
 Notation and useful facts for working with integrals over a set.
 
 TODO: keep all these? Need unicode translations as well.
 *)
 
 theory Set_Integral
   imports Radon_Nikodym
 begin
 
 (*
     Notation
 *)
 
 definition\<^marker>\<open>tag important\<close> "set_borel_measurable M A f \<equiv> (\<lambda>x. indicator A x *\<^sub>R f x) \<in> borel_measurable M"
 
 definition\<^marker>\<open>tag important\<close>  "set_integrable M A f \<equiv> integrable M (\<lambda>x. indicator A x *\<^sub>R f x)"
 
 definition\<^marker>\<open>tag important\<close>  "set_lebesgue_integral M A f \<equiv> lebesgue_integral M (\<lambda>x. indicator A x *\<^sub>R f x)"
 
 syntax
   "_ascii_set_lebesgue_integral" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'a measure \<Rightarrow> real \<Rightarrow> real"
   ("(4LINT (_):(_)/|(_)./ _)" [0,60,110,61] 60)
 
 translations
   "LINT x:A|M. f" == "CONST set_lebesgue_integral M A (\<lambda>x. f)"
 
 (*
     Notation for integration wrt lebesgue measure on the reals:
 
       LBINT x. f
       LBINT x : A. f
 
     TODO: keep all these? Need unicode.
 *)
 
 syntax
   "_lebesgue_borel_integral" :: "pttrn \<Rightarrow> real \<Rightarrow> real"
   ("(2LBINT _./ _)" [0,60] 60)
 
 syntax
   "_set_lebesgue_borel_integral" :: "pttrn \<Rightarrow> real set \<Rightarrow> real \<Rightarrow> real"
   ("(3LBINT _:_./ _)" [0,60,61] 60)
 
 (*
     Basic properties
 *)
 
 (*
 lemma indicator_abs_eq: "\<And>A x. \<bar>indicator A x\<bar> = ((indicator A x) :: real)"
   by (auto simp add: indicator_def)
 *)
 
 lemma set_integrable_cong:
   assumes "M = M'" "A = A'" "\<And>x. x \<in> A \<Longrightarrow> f x = f' x"
   shows   "set_integrable M A f = set_integrable M' A' f'"
 proof -
   have "(\<lambda>x. indicator A x *\<^sub>R f x) = (\<lambda>x. indicator A' x *\<^sub>R f' x)"
     using assms by (auto simp: indicator_def of_bool_def)
   thus ?thesis by (simp add: set_integrable_def assms)
 qed
 
 lemma set_borel_measurable_sets:
   fixes f :: "_ \<Rightarrow> _::real_normed_vector"
   assumes "set_borel_measurable M X f" "B \<in> sets borel" "X \<in> sets M"
   shows "f -` B \<inter> X \<in> sets M"
 proof -
   have "f \<in> borel_measurable (restrict_space M X)"
     using assms unfolding set_borel_measurable_def by (subst borel_measurable_restrict_space_iff) auto
   then have "f -` B \<inter> space (restrict_space M X) \<in> sets (restrict_space M X)"
     by (rule measurable_sets) fact
   with \<open>X \<in> sets M\<close> show ?thesis
     by (subst (asm) sets_restrict_space_iff) (auto simp: space_restrict_space)
 qed
 
 lemma set_lebesgue_integral_zero [simp]: "set_lebesgue_integral M A (\<lambda>x. 0) = 0"
   by (auto simp: set_lebesgue_integral_def)
 
 lemma set_lebesgue_integral_cong:
   assumes "A \<in> sets M" and "\<forall>x. x \<in> A \<longrightarrow> f x = g x"
   shows "(LINT x:A|M. f x) = (LINT x:A|M. g x)"
   unfolding set_lebesgue_integral_def
   using assms
   by (metis indicator_simps(2) real_vector.scale_zero_left)
 
 lemma set_lebesgue_integral_cong_AE:
   assumes [measurable]: "A \<in> sets M" "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   assumes "AE x \<in> A in M. f x = g x"
   shows "LINT x:A|M. f x = LINT x:A|M. g x"
 proof-
   have "AE x in M. indicator A x *\<^sub>R f x = indicator A x *\<^sub>R g x"
     using assms by auto
   thus ?thesis
   unfolding set_lebesgue_integral_def by (intro integral_cong_AE) auto
 qed
 
 lemma set_integrable_cong_AE:
     "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow>
     AE x \<in> A in M. f x = g x \<Longrightarrow> A \<in> sets M \<Longrightarrow>
     set_integrable M A f = set_integrable M A g"
   unfolding set_integrable_def
   by (rule integrable_cong_AE) auto
 
 lemma set_integrable_subset:
   fixes M A B and f :: "_ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes "set_integrable M A f" "B \<in> sets M" "B \<subseteq> A"
   shows "set_integrable M B f"
 proof -
   have "set_integrable M B (\<lambda>x. indicator A x *\<^sub>R f x)"
     using assms integrable_mult_indicator set_integrable_def by blast
   with \<open>B \<subseteq> A\<close> show ?thesis
     unfolding set_integrable_def
     by (simp add: indicator_inter_arith[symmetric] Int_absorb2)
 qed
 
 lemma set_integrable_restrict_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes f: "set_integrable M S f" and T: "T \<in> sets (restrict_space M S)"
   shows "set_integrable M T f"
 proof -
   obtain T' where T_eq: "T = S \<inter> T'" and "T' \<in> sets M" 
     using T by (auto simp: sets_restrict_space)
   have \<open>integrable M (\<lambda>x. indicator T' x *\<^sub>R (indicator S x *\<^sub>R f x))\<close>
     using \<open>T' \<in> sets M\<close> f integrable_mult_indicator set_integrable_def by blast
   then show ?thesis
     unfolding set_integrable_def
     unfolding T_eq indicator_inter_arith by (simp add: ac_simps)
 qed
 
 (* TODO: integral_cmul_indicator should be named set_integral_const *)
 (* TODO: borel_integrable_atLeastAtMost should be named something like set_integrable_Icc_isCont *)
 
 lemma set_integral_scaleR_right [simp]: "LINT t:A|M. a *\<^sub>R f t = a *\<^sub>R (LINT t:A|M. f t)"
   unfolding set_lebesgue_integral_def
   by (subst integral_scaleR_right[symmetric]) (auto intro!: Bochner_Integration.integral_cong)
 
 lemma set_integral_mult_right [simp]:
   fixes a :: "'a::{real_normed_field, second_countable_topology}"
   shows "LINT t:A|M. a * f t = a * (LINT t:A|M. f t)"
   unfolding set_lebesgue_integral_def
   by (subst integral_mult_right_zero[symmetric]) auto
 
 lemma set_integral_mult_left [simp]:
   fixes a :: "'a::{real_normed_field, second_countable_topology}"
   shows "LINT t:A|M. f t * a = (LINT t:A|M. f t) * a"
   unfolding set_lebesgue_integral_def
   by (subst integral_mult_left_zero[symmetric]) auto
 
 lemma set_integral_divide_zero [simp]:
   fixes a :: "'a::{real_normed_field, field, second_countable_topology}"
   shows "LINT t:A|M. f t / a = (LINT t:A|M. f t) / a"
   unfolding set_lebesgue_integral_def
   by (subst integral_divide_zero[symmetric], intro Bochner_Integration.integral_cong)
      (auto split: split_indicator)
 
 lemma set_integrable_scaleR_right [simp, intro]:
   shows "(a \<noteq> 0 \<Longrightarrow> set_integrable M A f) \<Longrightarrow> set_integrable M A (\<lambda>t. a *\<^sub>R f t)"
   unfolding set_integrable_def
   unfolding scaleR_left_commute by (rule integrable_scaleR_right)
 
 lemma set_integrable_scaleR_left [simp, intro]:
   fixes a :: "_ :: {banach, second_countable_topology}"
   shows "(a \<noteq> 0 \<Longrightarrow> set_integrable M A f) \<Longrightarrow> set_integrable M A (\<lambda>t. f t *\<^sub>R a)"
   unfolding set_integrable_def
   using integrable_scaleR_left[of a M "\<lambda>x. indicator A x *\<^sub>R f x"] by simp
 
 lemma set_integrable_mult_right [simp, intro]:
   fixes a :: "'a::{real_normed_field, second_countable_topology}"
   shows "(a \<noteq> 0 \<Longrightarrow> set_integrable M A f) \<Longrightarrow> set_integrable M A (\<lambda>t. a * f t)"
   unfolding set_integrable_def
   using integrable_mult_right[of a M "\<lambda>x. indicator A x *\<^sub>R f x"] by simp
 
 lemma set_integrable_mult_right_iff [simp]:
   fixes a :: "'a::{real_normed_field, second_countable_topology}"
   assumes "a \<noteq> 0"
   shows "set_integrable M A (\<lambda>t. a * f t) \<longleftrightarrow> set_integrable M A f"
 proof
   assume "set_integrable M A (\<lambda>t. a * f t)"
   then have "set_integrable M A (\<lambda>t. 1/a * (a * f t))"
     using set_integrable_mult_right by blast
   then show "set_integrable M A f"
     using assms by auto
 qed auto
 
 lemma set_integrable_mult_left [simp, intro]:
   fixes a :: "'a::{real_normed_field, second_countable_topology}"
   shows "(a \<noteq> 0 \<Longrightarrow> set_integrable M A f) \<Longrightarrow> set_integrable M A (\<lambda>t. f t * a)"
   unfolding set_integrable_def
   using integrable_mult_left[of a M "\<lambda>x. indicator A x *\<^sub>R f x"] by simp
 
 lemma set_integrable_mult_left_iff [simp]:
   fixes a :: "'a::{real_normed_field, second_countable_topology}"
   assumes "a \<noteq> 0"
   shows "set_integrable M A (\<lambda>t. f t * a) \<longleftrightarrow> set_integrable M A f"
   using assms by (subst set_integrable_mult_right_iff [symmetric]) (auto simp: mult.commute)
 
 lemma set_integrable_divide [simp, intro]:
   fixes a :: "'a::{real_normed_field, field, second_countable_topology}"
   assumes "a \<noteq> 0 \<Longrightarrow> set_integrable M A f"
   shows "set_integrable M A (\<lambda>t. f t / a)"
 proof -
   have "integrable M (\<lambda>x. indicator A x *\<^sub>R f x / a)"
     using assms unfolding set_integrable_def by (rule integrable_divide_zero)
   also have "(\<lambda>x. indicator A x *\<^sub>R f x / a) = (\<lambda>x. indicator A x *\<^sub>R (f x / a))"
     by (auto split: split_indicator)
   finally show ?thesis 
     unfolding set_integrable_def .
 qed
 
 lemma set_integrable_mult_divide_iff [simp]:
   fixes a :: "'a::{real_normed_field, second_countable_topology}"
   assumes "a \<noteq> 0"
   shows "set_integrable M A (\<lambda>t. f t / a) \<longleftrightarrow> set_integrable M A f"
   by (simp add: divide_inverse assms)
 
 lemma set_integral_add [simp, intro]:
   fixes f g :: "_ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes "set_integrable M A f" "set_integrable M A g"
   shows "set_integrable M A (\<lambda>x. f x + g x)"
     and "LINT x:A|M. f x + g x = (LINT x:A|M. f x) + (LINT x:A|M. g x)"
   using assms unfolding set_integrable_def set_lebesgue_integral_def by (simp_all add: scaleR_add_right)
 
 lemma set_integral_diff [simp, intro]:
   assumes "set_integrable M A f" "set_integrable M A g"
   shows "set_integrable M A (\<lambda>x. f x - g x)" and "LINT x:A|M. f x - g x =
     (LINT x:A|M. f x) - (LINT x:A|M. g x)"
   using assms unfolding set_integrable_def set_lebesgue_integral_def by (simp_all add: scaleR_diff_right)
 
 lemma set_integral_uminus: "set_integrable M A f \<Longrightarrow> LINT x:A|M. - f x = - (LINT x:A|M. f x)"
   unfolding set_integrable_def set_lebesgue_integral_def
   by (subst integral_minus[symmetric]) simp_all
 
 lemma set_integral_complex_of_real:
   "LINT x:A|M. complex_of_real (f x) = of_real (LINT x:A|M. f x)"
   unfolding set_lebesgue_integral_def
   by (subst integral_complex_of_real[symmetric])
      (auto intro!: Bochner_Integration.integral_cong split: split_indicator)
 
 lemma set_integral_mono:
   fixes f g :: "_ \<Rightarrow> real"
   assumes "set_integrable M A f" "set_integrable M A g"
     "\<And>x. x \<in> A \<Longrightarrow> f x \<le> g x"
   shows "(LINT x:A|M. f x) \<le> (LINT x:A|M. g x)"
   using assms unfolding set_integrable_def set_lebesgue_integral_def
   by (auto intro: integral_mono split: split_indicator)
 
 lemma set_integral_mono_AE:
   fixes f g :: "_ \<Rightarrow> real"
   assumes "set_integrable M A f" "set_integrable M A g"
     "AE x \<in> A in M. f x \<le> g x"
   shows "(LINT x:A|M. f x) \<le> (LINT x:A|M. g x)"
   using assms unfolding set_integrable_def set_lebesgue_integral_def
   by (auto intro: integral_mono_AE split: split_indicator)
 
 lemma set_integrable_abs: "set_integrable M A f \<Longrightarrow> set_integrable M A (\<lambda>x. \<bar>f x\<bar> :: real)"
   using integrable_abs[of M "\<lambda>x. f x * indicator A x"]unfolding set_integrable_def by (simp add: abs_mult ac_simps)
 
 lemma set_integrable_abs_iff:
   fixes f :: "_ \<Rightarrow> real"
   shows "set_borel_measurable M A f \<Longrightarrow> set_integrable M A (\<lambda>x. \<bar>f x\<bar>) = set_integrable M A f"
   unfolding set_integrable_def set_borel_measurable_def
   by (subst (2) integrable_abs_iff[symmetric]) (simp_all add: abs_mult ac_simps)
 
 lemma set_integrable_abs_iff':
   fixes f :: "_ \<Rightarrow> real"
   shows "f \<in> borel_measurable M \<Longrightarrow> A \<in> sets M \<Longrightarrow>
     set_integrable M A (\<lambda>x. \<bar>f x\<bar>) = set_integrable M A f"
   by (simp add: set_borel_measurable_def set_integrable_abs_iff)
 
 lemma set_integrable_discrete_difference:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes "countable X"
   assumes diff: "(A - B) \<union> (B - A) \<subseteq> X"
   assumes "\<And>x. x \<in> X \<Longrightarrow> emeasure M {x} = 0" "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M"
   shows "set_integrable M A f \<longleftrightarrow> set_integrable M B f"
   unfolding set_integrable_def
 proof (rule integrable_discrete_difference[where X=X])
   show "\<And>x. x \<in> space M \<Longrightarrow> x \<notin> X \<Longrightarrow> indicator A x *\<^sub>R f x = indicator B x *\<^sub>R f x"
     using diff by (auto split: split_indicator)
 qed fact+
 
 lemma set_integral_discrete_difference:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes "countable X"
   assumes diff: "(A - B) \<union> (B - A) \<subseteq> X"
   assumes "\<And>x. x \<in> X \<Longrightarrow> emeasure M {x} = 0" "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M"
   shows "set_lebesgue_integral M A f = set_lebesgue_integral M B f"
   unfolding set_lebesgue_integral_def
 proof (rule integral_discrete_difference[where X=X])
   show "\<And>x. x \<in> space M \<Longrightarrow> x \<notin> X \<Longrightarrow> indicator A x *\<^sub>R f x = indicator B x *\<^sub>R f x"
     using diff by (auto split: split_indicator)
 qed fact+
 
 lemma set_integrable_Un:
   fixes f g :: "_ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes f_A: "set_integrable M A f" and f_B:  "set_integrable M B f"
     and [measurable]: "A \<in> sets M" "B \<in> sets M"
   shows "set_integrable M (A \<union> B) f"
 proof -
   have "set_integrable M (A - B) f"
     using f_A by (rule set_integrable_subset) auto
   with f_B have "integrable M (\<lambda>x. indicator (A - B) x *\<^sub>R f x + indicator B x *\<^sub>R f x)"
     unfolding set_integrable_def using integrable_add by blast
   then show ?thesis
     unfolding set_integrable_def
     by (rule integrable_cong[THEN iffD1, rotated 2]) (auto split: split_indicator)
 qed
 
 lemma set_integrable_empty [simp]: "set_integrable M {} f"
   by (auto simp: set_integrable_def)
 
 lemma set_integrable_UN:
   fixes f :: "_ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes "finite I" "\<And>i. i\<in>I \<Longrightarrow> set_integrable M (A i) f"
     "\<And>i. i\<in>I \<Longrightarrow> A i \<in> sets M"
   shows "set_integrable M (\<Union>i\<in>I. A i) f"
   using assms
   by (induct I) (auto simp: set_integrable_Un sets.finite_UN)
 
 lemma set_integral_Un:
   fixes f :: "_ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes "A \<inter> B = {}"
   and "set_integrable M A f"
   and "set_integrable M B f"
 shows "LINT x:A\<union>B|M. f x = (LINT x:A|M. f x) + (LINT x:B|M. f x)"
   using assms
   unfolding set_integrable_def set_lebesgue_integral_def
   by (auto simp add: indicator_union_arith indicator_inter_arith[symmetric] scaleR_add_left)
 
 lemma set_integral_cong_set:
   fixes f :: "_ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes "set_borel_measurable M A f" "set_borel_measurable M B f"
     and ae: "AE x in M. x \<in> A \<longleftrightarrow> x \<in> B"
   shows "LINT x:B|M. f x = LINT x:A|M. f x"
   unfolding set_lebesgue_integral_def
 proof (rule integral_cong_AE)
   show "AE x in M. indicator B x *\<^sub>R f x = indicator A x *\<^sub>R f x"
     using ae by (auto simp: subset_eq split: split_indicator)
 qed (use assms in \<open>auto simp: set_borel_measurable_def\<close>)
 
 proposition set_borel_measurable_subset:
   fixes f :: "_ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes [measurable]: "set_borel_measurable M A f" "B \<in> sets M" and "B \<subseteq> A"
   shows "set_borel_measurable M B f"
 proof-
   have "set_borel_measurable M B (\<lambda>x. indicator A x *\<^sub>R f x)"
     using assms unfolding set_borel_measurable_def
     using borel_measurable_indicator borel_measurable_scaleR by blast 
   moreover have "(\<lambda>x. indicator B x *\<^sub>R indicator A x *\<^sub>R f x) = (\<lambda>x. indicator B x *\<^sub>R f x)"
     using \<open>B \<subseteq> A\<close> by (auto simp: fun_eq_iff split: split_indicator)
   ultimately show ?thesis 
     unfolding set_borel_measurable_def by simp
 qed
 
 lemma set_integral_Un_AE:
   fixes f :: "_ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes ae: "AE x in M. \<not> (x \<in> A \<and> x \<in> B)" and [measurable]: "A \<in> sets M" "B \<in> sets M"
   and "set_integrable M A f"
   and "set_integrable M B f"
   shows "LINT x:A\<union>B|M. f x = (LINT x:A|M. f x) + (LINT x:B|M. f x)"
 proof -
   have f: "set_integrable M (A \<union> B) f"
     by (intro set_integrable_Un assms)
   then have f': "set_borel_measurable M (A \<union> B) f"
     using integrable_iff_bounded set_borel_measurable_def set_integrable_def by blast
   have "LINT x:A\<union>B|M. f x = LINT x:(A - A \<inter> B) \<union> (B - A \<inter> B)|M. f x"
   proof (rule set_integral_cong_set)
     show "AE x in M. (x \<in> A - A \<inter> B \<union> (B - A \<inter> B)) = (x \<in> A \<union> B)"
       using ae by auto
     show "set_borel_measurable M (A - A \<inter> B \<union> (B - A \<inter> B)) f"
       using f' by (rule set_borel_measurable_subset) auto
   qed fact
   also have "\<dots> = (LINT x:(A - A \<inter> B)|M. f x) + (LINT x:(B - A \<inter> B)|M. f x)"
     by (auto intro!: set_integral_Un set_integrable_subset[OF f])
   also have "\<dots> = (LINT x:A|M. f x) + (LINT x:B|M. f x)"
     using ae
     by (intro arg_cong2[where f="(+)"] set_integral_cong_set)
        (auto intro!: set_borel_measurable_subset[OF f'])
   finally show ?thesis .
 qed
 
 lemma set_integral_finite_Union:
   fixes f :: "_ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes "finite I" "disjoint_family_on A I"
     and "\<And>i. i \<in> I \<Longrightarrow> set_integrable M (A i) f" "\<And>i. i \<in> I \<Longrightarrow> A i \<in> sets M"
   shows "(LINT x:(\<Union>i\<in>I. A i)|M. f x) = (\<Sum>i\<in>I. LINT x:A i|M. f x)"
   using assms
 proof induction
   case (insert x F)
   then have "A x \<inter> \<Union>(A ` F) = {}"
     by (meson disjoint_family_on_insert)
   with insert show ?case
     by (simp add: set_integral_Un set_integrable_Un set_integrable_UN disjoint_family_on_insert)
 qed (simp add: set_lebesgue_integral_def)
 
 (* TODO: find a better name? *)
 lemma pos_integrable_to_top:
   fixes l::real
   assumes "\<And>i. A i \<in> sets M" "mono A"
   assumes nneg: "\<And>x i. x \<in> A i \<Longrightarrow> 0 \<le> f x"
   and intgbl: "\<And>i::nat. set_integrable M (A i) f"
   and lim: "(\<lambda>i::nat. LINT x:A i|M. f x) \<longlonglongrightarrow> l"
 shows "set_integrable M (\<Union>i. A i) f"
     unfolding set_integrable_def
   apply (rule integrable_monotone_convergence[where f = "\<lambda>i::nat. \<lambda>x. indicator (A i) x *\<^sub>R f x" and x = l])
   apply (rule intgbl [unfolded set_integrable_def])
   prefer 3 apply (rule lim [unfolded set_lebesgue_integral_def])
   apply (rule AE_I2)
   using \<open>mono A\<close> apply (auto simp: mono_def nneg split: split_indicator) []
 proof (rule AE_I2)
   { fix x assume "x \<in> space M"
     show "(\<lambda>i. indicator (A i) x *\<^sub>R f x) \<longlonglongrightarrow> indicator (\<Union>i. A i) x *\<^sub>R f x"
     proof cases
       assume "\<exists>i. x \<in> A i"
-      then guess i ..
+      then obtain i where "x \<in> A i" ..
       then have *: "eventually (\<lambda>i. x \<in> A i) sequentially"
         using \<open>x \<in> A i\<close> \<open>mono A\<close> by (auto simp: eventually_sequentially mono_def)
       show ?thesis
         apply (intro tendsto_eventually)
         using *
         apply eventually_elim
         apply (auto split: split_indicator)
         done
     qed auto }
   then show "(\<lambda>x. indicator (\<Union>i. A i) x *\<^sub>R f x) \<in> borel_measurable M"
     apply (rule borel_measurable_LIMSEQ_real)
     apply assumption
     using intgbl set_integrable_def by blast
 qed
 
 (* Proof from Royden Real Analysis, p. 91. *)
 lemma lebesgue_integral_countable_add:
   fixes f :: "_ \<Rightarrow> 'a :: {banach, second_countable_topology}"
   assumes meas[intro]: "\<And>i::nat. A i \<in> sets M"
     and disj: "\<And>i j. i \<noteq> j \<Longrightarrow> A i \<inter> A j = {}"
     and intgbl: "set_integrable M (\<Union>i. A i) f"
   shows "LINT x:(\<Union>i. A i)|M. f x = (\<Sum>i. (LINT x:(A i)|M. f x))"
     unfolding set_lebesgue_integral_def
 proof (subst integral_suminf[symmetric])
   show int_A: "integrable M (\<lambda>x. indicat_real (A i) x *\<^sub>R f x)" for i
     using intgbl unfolding set_integrable_def [symmetric]
     by (rule set_integrable_subset) auto
   { fix x assume "x \<in> space M"
     have "(\<lambda>i. indicator (A i) x *\<^sub>R f x) sums (indicator (\<Union>i. A i) x *\<^sub>R f x)"
       by (intro sums_scaleR_left indicator_sums) fact }
   note sums = this
 
   have norm_f: "\<And>i. set_integrable M (A i) (\<lambda>x. norm (f x))"
     using int_A[THEN integrable_norm] unfolding set_integrable_def by auto
 
   show "AE x in M. summable (\<lambda>i. norm (indicator (A i) x *\<^sub>R f x))"
     using disj by (intro AE_I2) (auto intro!: summable_mult2 sums_summable[OF indicator_sums])
 
   show "summable (\<lambda>i. LINT x|M. norm (indicator (A i) x *\<^sub>R f x))"
   proof (rule summableI_nonneg_bounded)
     fix n
     show "0 \<le> LINT x|M. norm (indicator (A n) x *\<^sub>R f x)"
       using norm_f by (auto intro!: integral_nonneg_AE)
 
     have "(\<Sum>i<n. LINT x|M. norm (indicator (A i) x *\<^sub>R f x)) = (\<Sum>i<n. LINT x:A i|M. norm (f x))"
       by (simp add: abs_mult set_lebesgue_integral_def)
     also have "\<dots> = set_lebesgue_integral M (\<Union>i<n. A i) (\<lambda>x. norm (f x))"
       using norm_f
       by (subst set_integral_finite_Union) (auto simp: disjoint_family_on_def disj)
     also have "\<dots> \<le> set_lebesgue_integral M (\<Union>i. A i) (\<lambda>x. norm (f x))"
       using intgbl[unfolded set_integrable_def, THEN integrable_norm] norm_f
       unfolding set_lebesgue_integral_def set_integrable_def
       apply (intro integral_mono set_integrable_UN[of "{..<n}", unfolded set_integrable_def])
           apply (auto split: split_indicator)
       done
     finally show "(\<Sum>i<n. LINT x|M. norm (indicator (A i) x *\<^sub>R f x)) \<le>
       set_lebesgue_integral M (\<Union>i. A i) (\<lambda>x. norm (f x))"
       by simp
   qed
   show "LINT x|M. indicator (\<Union>(A ` UNIV)) x *\<^sub>R f x = LINT x|M. (\<Sum>i. indicator (A i) x *\<^sub>R f x)"
     apply (rule Bochner_Integration.integral_cong[OF refl])
     apply (subst suminf_scaleR_left[OF sums_summable[OF indicator_sums, OF disj], symmetric])
     using sums_unique[OF indicator_sums[OF disj]]
     apply auto
     done
 qed
 
 lemma set_integral_cont_up:
   fixes f :: "_ \<Rightarrow> 'a :: {banach, second_countable_topology}"
   assumes [measurable]: "\<And>i. A i \<in> sets M" and A: "incseq A"
   and intgbl: "set_integrable M (\<Union>i. A i) f"
 shows "(\<lambda>i. LINT x:(A i)|M. f x) \<longlonglongrightarrow> LINT x:(\<Union>i. A i)|M. f x"
   unfolding set_lebesgue_integral_def
 proof (intro integral_dominated_convergence[where w="\<lambda>x. indicator (\<Union>i. A i) x *\<^sub>R norm (f x)"])
   have int_A: "\<And>i. set_integrable M (A i) f"
     using intgbl by (rule set_integrable_subset) auto
   show "\<And>i. (\<lambda>x. indicator (A i) x *\<^sub>R f x) \<in> borel_measurable M"
     using int_A integrable_iff_bounded set_integrable_def by blast
   show "(\<lambda>x. indicator (\<Union>(A ` UNIV)) x *\<^sub>R f x) \<in> borel_measurable M"
     using integrable_iff_bounded intgbl set_integrable_def by blast
   show "integrable M (\<lambda>x. indicator (\<Union>i. A i) x *\<^sub>R norm (f x))"
     using int_A intgbl integrable_norm unfolding set_integrable_def 
     by fastforce
   { fix x i assume "x \<in> A i"
     with A have "(\<lambda>xa. indicator (A xa) x::real) \<longlonglongrightarrow> 1 \<longleftrightarrow> (\<lambda>xa. 1::real) \<longlonglongrightarrow> 1"
       by (intro filterlim_cong refl)
          (fastforce simp: eventually_sequentially incseq_def subset_eq intro!: exI[of _ i]) }
   then show "AE x in M. (\<lambda>i. indicator (A i) x *\<^sub>R f x) \<longlonglongrightarrow> indicator (\<Union>i. A i) x *\<^sub>R f x"
     by (intro AE_I2 tendsto_intros) (auto split: split_indicator)
 qed (auto split: split_indicator)
 
 (* Can the int0 hypothesis be dropped? *)
 lemma set_integral_cont_down:
   fixes f :: "_ \<Rightarrow> 'a :: {banach, second_countable_topology}"
   assumes [measurable]: "\<And>i. A i \<in> sets M" and A: "decseq A"
   and int0: "set_integrable M (A 0) f"
   shows "(\<lambda>i::nat. LINT x:(A i)|M. f x) \<longlonglongrightarrow> LINT x:(\<Inter>i. A i)|M. f x"
   unfolding set_lebesgue_integral_def
 proof (rule integral_dominated_convergence)
   have int_A: "\<And>i. set_integrable M (A i) f"
     using int0 by (rule set_integrable_subset) (insert A, auto simp: decseq_def)
   have "integrable M (\<lambda>c. norm (indicat_real (A 0) c *\<^sub>R f c))"
     by (metis (no_types) int0 integrable_norm set_integrable_def)
   then show "integrable M (\<lambda>x. indicator (A 0) x *\<^sub>R norm (f x))"
     by force
   have "set_integrable M (\<Inter>i. A i) f"
     using int0 by (rule set_integrable_subset) (insert A, auto simp: decseq_def)
   with int_A show "(\<lambda>x. indicat_real (\<Inter>(A ` UNIV)) x *\<^sub>R f x) \<in> borel_measurable M"
                   "\<And>i. (\<lambda>x. indicat_real (A i) x *\<^sub>R f x) \<in> borel_measurable M"
     by (auto simp: set_integrable_def)
   show "\<And>i. AE x in M. norm (indicator (A i) x *\<^sub>R f x) \<le> indicator (A 0) x *\<^sub>R norm (f x)"
     using A by (auto split: split_indicator simp: decseq_def)
   { fix x i assume "x \<in> space M" "x \<notin> A i"
     with A have "(\<lambda>i. indicator (A i) x::real) \<longlonglongrightarrow> 0 \<longleftrightarrow> (\<lambda>i. 0::real) \<longlonglongrightarrow> 0"
       by (intro filterlim_cong refl)
          (auto split: split_indicator simp: eventually_sequentially decseq_def intro!: exI[of _ i]) }
   then show "AE x in M. (\<lambda>i. indicator (A i) x *\<^sub>R f x) \<longlonglongrightarrow> indicator (\<Inter>i. A i) x *\<^sub>R f x"
     by (intro AE_I2 tendsto_intros) (auto split: split_indicator)
 qed
 
 lemma set_integral_at_point:
   fixes a :: real
   assumes "set_integrable M {a} f"
   and [simp]: "{a} \<in> sets M" and "(emeasure M) {a} \<noteq> \<infinity>"
   shows "(LINT x:{a} | M. f x) = f a * measure M {a}"
 proof-
   have "set_lebesgue_integral M {a} f = set_lebesgue_integral M {a} (%x. f a)"
     by (intro set_lebesgue_integral_cong) simp_all
   then show ?thesis using assms
     unfolding set_lebesgue_integral_def by simp
 qed
 
 
 abbreviation complex_integrable :: "'a measure \<Rightarrow> ('a \<Rightarrow> complex) \<Rightarrow> bool" where
   "complex_integrable M f \<equiv> integrable M f"
 
 abbreviation complex_lebesgue_integral :: "'a measure \<Rightarrow> ('a \<Rightarrow> complex) \<Rightarrow> complex" ("integral\<^sup>C") where
   "integral\<^sup>C M f == integral\<^sup>L M f"
 
 syntax
   "_complex_lebesgue_integral" :: "pttrn \<Rightarrow> complex \<Rightarrow> 'a measure \<Rightarrow> complex"
  ("\<integral>\<^sup>C _. _ \<partial>_" [60,61] 110)
 
 translations
   "\<integral>\<^sup>Cx. f \<partial>M" == "CONST complex_lebesgue_integral M (\<lambda>x. f)"
 
 syntax
   "_ascii_complex_lebesgue_integral" :: "pttrn \<Rightarrow> 'a measure \<Rightarrow> real \<Rightarrow> real"
   ("(3CLINT _|_. _)" [0,110,60] 60)
 
 translations
   "CLINT x|M. f" == "CONST complex_lebesgue_integral M (\<lambda>x. f)"
 
 lemma complex_integrable_cnj [simp]:
   "complex_integrable M (\<lambda>x. cnj (f x)) \<longleftrightarrow> complex_integrable M f"
 proof
   assume "complex_integrable M (\<lambda>x. cnj (f x))"
   then have "complex_integrable M (\<lambda>x. cnj (cnj (f x)))"
     by (rule integrable_cnj)
   then show "complex_integrable M f"
     by simp
 qed simp
 
 lemma complex_of_real_integrable_eq:
   "complex_integrable M (\<lambda>x. complex_of_real (f x)) \<longleftrightarrow> integrable M f"
 proof
   assume "complex_integrable M (\<lambda>x. complex_of_real (f x))"
   then have "integrable M (\<lambda>x. Re (complex_of_real (f x)))"
     by (rule integrable_Re)
   then show "integrable M f"
     by simp
 qed simp
 
 
 abbreviation complex_set_integrable :: "'a measure \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> complex) \<Rightarrow> bool" where
   "complex_set_integrable M A f \<equiv> set_integrable M A f"
 
 abbreviation complex_set_lebesgue_integral :: "'a measure \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> complex) \<Rightarrow> complex" where
   "complex_set_lebesgue_integral M A f \<equiv> set_lebesgue_integral M A f"
 
 syntax
 "_ascii_complex_set_lebesgue_integral" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'a measure \<Rightarrow> real \<Rightarrow> real"
 ("(4CLINT _:_|_. _)" [0,60,110,61] 60)
 
 translations
 "CLINT x:A|M. f" == "CONST complex_set_lebesgue_integral M A (\<lambda>x. f)"
 
 lemma set_measurable_continuous_on_ivl:
   assumes "continuous_on {a..b} (f :: real \<Rightarrow> real)"
   shows "set_borel_measurable borel {a..b} f"
   unfolding set_borel_measurable_def
   by (rule borel_measurable_continuous_on_indicator[OF _ assms]) simp
 
 
 text\<open>This notation is from Sébastien Gouëzel: His use is not directly in line with the
 notations in this file, they are more in line with sum, and more readable he thinks.\<close>
 
 abbreviation "set_nn_integral M A f \<equiv> nn_integral M (\<lambda>x. f x * indicator A x)"
 
 syntax
 "_set_nn_integral" :: "pttrn => 'a set => 'a measure => ereal => ereal"
 ("(\<integral>\<^sup>+((_)\<in>(_)./ _)/\<partial>_)" [0,60,110,61] 60)
 
 "_set_lebesgue_integral" :: "pttrn => 'a set => 'a measure => ereal => ereal"
 ("(\<integral>((_)\<in>(_)./ _)/\<partial>_)" [0,60,110,61] 60)
 
 translations
 "\<integral>\<^sup>+x \<in> A. f \<partial>M" == "CONST set_nn_integral M A (\<lambda>x. f)"
 "\<integral>x \<in> A. f \<partial>M" == "CONST set_lebesgue_integral M A (\<lambda>x. f)"
 
 lemma nn_integral_disjoint_pair:
   assumes [measurable]: "f \<in> borel_measurable M"
           "B \<in> sets M" "C \<in> sets M"
           "B \<inter> C = {}"
   shows "(\<integral>\<^sup>+x \<in> B \<union> C. f x \<partial>M) = (\<integral>\<^sup>+x \<in> B. f x \<partial>M) + (\<integral>\<^sup>+x \<in> C. f x \<partial>M)"
 proof -
   have mes: "\<And>D. D \<in> sets M \<Longrightarrow> (\<lambda>x. f x * indicator D x) \<in> borel_measurable M" by simp
   have pos: "\<And>D. AE x in M. f x * indicator D x \<ge> 0" using assms(2) by auto
   have "\<And>x. f x * indicator (B \<union> C) x = f x * indicator B x + f x * indicator C x" using assms(4)
     by (auto split: split_indicator)
   then have "(\<integral>\<^sup>+x. f x * indicator (B \<union> C) x \<partial>M) = (\<integral>\<^sup>+x. f x * indicator B x + f x * indicator C x \<partial>M)"
     by simp
   also have "... = (\<integral>\<^sup>+x. f x * indicator B x \<partial>M) + (\<integral>\<^sup>+x. f x * indicator C x \<partial>M)"
     by (rule nn_integral_add) (auto simp add: assms mes pos)
   finally show ?thesis by simp
 qed
 
 lemma nn_integral_disjoint_pair_countspace:
   assumes "B \<inter> C = {}"
   shows "(\<integral>\<^sup>+x \<in> B \<union> C. f x \<partial>count_space UNIV) = (\<integral>\<^sup>+x \<in> B. f x \<partial>count_space UNIV) + (\<integral>\<^sup>+x \<in> C. f x \<partial>count_space UNIV)"
 by (rule nn_integral_disjoint_pair) (simp_all add: assms)
 
 lemma nn_integral_null_delta:
   assumes "A \<in> sets M" "B \<in> sets M"
           "(A - B) \<union> (B - A) \<in> null_sets M"
   shows "(\<integral>\<^sup>+x \<in> A. f x \<partial>M) = (\<integral>\<^sup>+x \<in> B. f x \<partial>M)"
 proof (rule nn_integral_cong_AE)
   have *: "AE a in M. a \<notin> (A - B) \<union> (B - A)"
     using assms(3) AE_not_in by blast
   then show \<open>AE x in M. f x * indicator A x = f x * indicator B x\<close>
     by auto
 qed
 
 proposition nn_integral_disjoint_family:
   assumes [measurable]: "f \<in> borel_measurable M" "\<And>(n::nat). B n \<in> sets M"
       and "disjoint_family B"
   shows "(\<integral>\<^sup>+x \<in> (\<Union>n. B n). f x \<partial>M) = (\<Sum>n. (\<integral>\<^sup>+x \<in> B n. f x \<partial>M))"
 proof -
   have "(\<integral>\<^sup>+ x. (\<Sum>n. f x * indicator (B n) x) \<partial>M) = (\<Sum>n. (\<integral>\<^sup>+ x. f x * indicator (B n) x \<partial>M))"
     by (rule nn_integral_suminf) simp
   moreover have "(\<Sum>n. f x * indicator (B n) x) = f x * indicator (\<Union>n. B n) x" for x
   proof (cases)
     assume "x \<in> (\<Union>n. B n)"
     then obtain n where "x \<in> B n" by blast
     have a: "finite {n}" by simp
     have "\<And>i. i \<noteq> n \<Longrightarrow> x \<notin> B i" using \<open>x \<in> B n\<close> assms(3) disjoint_family_on_def
       by (metis IntI UNIV_I empty_iff)
     then have "\<And>i. i \<notin> {n} \<Longrightarrow> indicator (B i) x = (0::ennreal)" using indicator_def by simp
     then have b: "\<And>i. i \<notin> {n} \<Longrightarrow> f x * indicator (B i) x = (0::ennreal)" by simp
 
     define h where "h = (\<lambda>i. f x * indicator (B i) x)"
     then have "\<And>i. i \<notin> {n} \<Longrightarrow> h i = 0" using b by simp
     then have "(\<Sum>i. h i) = (\<Sum>i\<in>{n}. h i)"
       by (metis sums_unique[OF sums_finite[OF a]])
     then have "(\<Sum>i. h i) = h n" by simp
     then have "(\<Sum>n. f x * indicator (B n) x) = f x * indicator (B n) x" using h_def by simp
     then have "(\<Sum>n. f x * indicator (B n) x) = f x" using \<open>x \<in> B n\<close> indicator_def by simp
     then show ?thesis using \<open>x \<in> (\<Union>n. B n)\<close> by auto
   next
     assume "x \<notin> (\<Union>n. B n)"
     then have "\<And>n. f x * indicator (B n) x = 0" by simp
     have "(\<Sum>n. f x * indicator (B n) x) = 0"
       by (simp add: \<open>\<And>n. f x * indicator (B n) x = 0\<close>)
     then show ?thesis using \<open>x \<notin> (\<Union>n. B n)\<close> by auto
   qed
   ultimately show ?thesis by simp
 qed
 
 lemma nn_set_integral_add:
   assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
           "A \<in> sets M"
   shows "(\<integral>\<^sup>+x \<in> A. (f x + g x) \<partial>M) = (\<integral>\<^sup>+x \<in> A. f x \<partial>M) + (\<integral>\<^sup>+x \<in> A. g x \<partial>M)"
 proof -
   have "(\<integral>\<^sup>+x \<in> A. (f x + g x) \<partial>M) = (\<integral>\<^sup>+x. (f x * indicator A x + g x * indicator A x) \<partial>M)"
     by (auto simp add: indicator_def intro!: nn_integral_cong)
   also have "... = (\<integral>\<^sup>+x. f x * indicator A x \<partial>M) + (\<integral>\<^sup>+x. g x * indicator A x \<partial>M)"
     apply (rule nn_integral_add) using assms(1) assms(2) by auto
   finally show ?thesis by simp
 qed
 
 lemma nn_set_integral_cong:
   assumes "AE x in M. f x = g x"
   shows "(\<integral>\<^sup>+x \<in> A. f x \<partial>M) = (\<integral>\<^sup>+x \<in> A. g x \<partial>M)"
 apply (rule nn_integral_cong_AE) using assms(1) by auto
 
 lemma nn_set_integral_set_mono:
   "A \<subseteq> B \<Longrightarrow> (\<integral>\<^sup>+ x \<in> A. f x \<partial>M) \<le> (\<integral>\<^sup>+ x \<in> B. f x \<partial>M)"
 by (auto intro!: nn_integral_mono split: split_indicator)
 
 lemma nn_set_integral_mono:
   assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
           "A \<in> sets M"
       and "AE x\<in>A in M. f x \<le> g x"
   shows "(\<integral>\<^sup>+x \<in> A. f x \<partial>M) \<le> (\<integral>\<^sup>+x \<in> A. g x \<partial>M)"
 by (auto intro!: nn_integral_mono_AE split: split_indicator simp: assms)
 
 lemma nn_set_integral_space [simp]:
   shows "(\<integral>\<^sup>+ x \<in> space M. f x \<partial>M) = (\<integral>\<^sup>+x. f x \<partial>M)"
 by (metis (mono_tags, lifting) indicator_simps(1) mult.right_neutral nn_integral_cong)
 
 lemma nn_integral_count_compose_inj:
   assumes "inj_on g A"
   shows "(\<integral>\<^sup>+x \<in> A. f (g x) \<partial>count_space UNIV) = (\<integral>\<^sup>+y \<in> g`A. f y \<partial>count_space UNIV)"
 proof -
   have "(\<integral>\<^sup>+x \<in> A. f (g x) \<partial>count_space UNIV) = (\<integral>\<^sup>+x. f (g x) \<partial>count_space A)"
     by (auto simp add: nn_integral_count_space_indicator[symmetric])
   also have "... = (\<integral>\<^sup>+y. f y \<partial>count_space (g`A))"
     by (simp add: assms nn_integral_bij_count_space inj_on_imp_bij_betw)
   also have "... = (\<integral>\<^sup>+y \<in> g`A. f y \<partial>count_space UNIV)"
     by (auto simp add: nn_integral_count_space_indicator[symmetric])
   finally show ?thesis by simp
 qed
 
 lemma nn_integral_count_compose_bij:
   assumes "bij_betw g A B"
   shows "(\<integral>\<^sup>+x \<in> A. f (g x) \<partial>count_space UNIV) = (\<integral>\<^sup>+y \<in> B. f y \<partial>count_space UNIV)"
 proof -
   have "inj_on g A" using assms bij_betw_def by auto
   then have "(\<integral>\<^sup>+x \<in> A. f (g x) \<partial>count_space UNIV) = (\<integral>\<^sup>+y \<in> g`A. f y \<partial>count_space UNIV)"
     by (rule nn_integral_count_compose_inj)
   then show ?thesis using assms by (simp add: bij_betw_def)
 qed
 
 lemma set_integral_null_delta:
   fixes f::"_ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes [measurable]: "integrable M f" "A \<in> sets M" "B \<in> sets M"
     and null: "(A - B) \<union> (B - A) \<in> null_sets M"
   shows "(\<integral>x \<in> A. f x \<partial>M) = (\<integral>x \<in> B. f x \<partial>M)"
 proof (rule set_integral_cong_set)
   have *: "AE a in M. a \<notin> (A - B) \<union> (B - A)"
     using null AE_not_in by blast
   then show "AE x in M. (x \<in> B) = (x \<in> A)"
     by auto
 qed (simp_all add: set_borel_measurable_def)
 
 lemma set_integral_space:
   assumes "integrable M f"
   shows "(\<integral>x \<in> space M. f x \<partial>M) = (\<integral>x. f x \<partial>M)"
   by (metis (no_types, lifting) indicator_simps(1) integral_cong scaleR_one set_lebesgue_integral_def)
 
 lemma null_if_pos_func_has_zero_nn_int:
   fixes f::"'a \<Rightarrow> ennreal"
   assumes [measurable]: "f \<in> borel_measurable M" "A \<in> sets M"
     and "AE x\<in>A in M. f x > 0" "(\<integral>\<^sup>+x\<in>A. f x \<partial>M) = 0"
   shows "A \<in> null_sets M"
 proof -
   have "AE x in M. f x * indicator A x = 0"
     by (subst nn_integral_0_iff_AE[symmetric], auto simp add: assms(4))
   then have "AE x\<in>A in M. False" using assms(3) by auto
   then show "A \<in> null_sets M" using assms(2) by (simp add: AE_iff_null_sets)
 qed
 
 lemma null_if_pos_func_has_zero_int:
   assumes [measurable]: "integrable M f" "A \<in> sets M"
       and "AE x\<in>A in M. f x > 0" "(\<integral>x\<in>A. f x \<partial>M) = (0::real)"
   shows "A \<in> null_sets M"
 proof -
   have "AE x in M. indicator A x * f x = 0"
     apply (subst integral_nonneg_eq_0_iff_AE[symmetric])
     using assms integrable_mult_indicator[OF \<open>A \<in> sets M\<close> assms(1)]
     by (auto simp: set_lebesgue_integral_def)
   then have "AE x\<in>A in M. f x = 0" by auto
   then have "AE x\<in>A in M. False" using assms(3) by auto
   then show "A \<in> null_sets M" using assms(2) by (simp add: AE_iff_null_sets)
 qed
 
 text\<open>The next lemma is a variant of \<open>density_unique\<close>. Note that it uses the notation
 for nonnegative set integrals introduced earlier.\<close>
 
 lemma (in sigma_finite_measure) density_unique2:
   assumes [measurable]: "f \<in> borel_measurable M" "f' \<in> borel_measurable M"
   assumes density_eq: "\<And>A. A \<in> sets M \<Longrightarrow> (\<integral>\<^sup>+ x \<in> A. f x \<partial>M) = (\<integral>\<^sup>+ x \<in> A. f' x \<partial>M)"
   shows "AE x in M. f x = f' x"
 proof (rule density_unique)
   show "density M f = density M f'"
     by (intro measure_eqI) (auto simp: emeasure_density intro!: density_eq)
 qed (auto simp add: assms)
 
 
 text \<open>The next lemma implies the same statement for Banach-space valued functions
 using Hahn-Banach theorem and linear forms. Since they are not yet easily available, I
 only formulate it for real-valued functions.\<close>
 
 lemma density_unique_real:
   fixes f f'::"_ \<Rightarrow> real"
   assumes M[measurable]: "integrable M f" "integrable M f'"
   assumes density_eq: "\<And>A. A \<in> sets M \<Longrightarrow> (\<integral>x \<in> A. f x \<partial>M) = (\<integral>x \<in> A. f' x \<partial>M)"
   shows "AE x in M. f x = f' x"
 proof -
   define A where "A = {x \<in> space M. f x < f' x}"
   then have [measurable]: "A \<in> sets M" by simp
   have "(\<integral>x \<in> A. (f' x - f x) \<partial>M) = (\<integral>x \<in> A. f' x \<partial>M) - (\<integral>x \<in> A. f x \<partial>M)"
     using \<open>A \<in> sets M\<close> M integrable_mult_indicator set_integrable_def by blast
   then have "(\<integral>x \<in> A. (f' x - f x) \<partial>M) = 0" using assms(3) by simp
   then have "A \<in> null_sets M"
     using A_def null_if_pos_func_has_zero_int[where ?f = "\<lambda>x. f' x - f x" and ?A = A] assms by auto
   then have "AE x in M. x \<notin> A" by (simp add: AE_not_in)
   then have *: "AE x in M. f' x \<le> f x" unfolding A_def by auto
 
   define B where "B = {x \<in> space M. f' x < f x}"
   then have [measurable]: "B \<in> sets M" by simp
   have "(\<integral>x \<in> B. (f x - f' x) \<partial>M) = (\<integral>x \<in> B. f x \<partial>M) - (\<integral>x \<in> B. f' x \<partial>M)"
     using \<open>B \<in> sets M\<close> M integrable_mult_indicator set_integrable_def by blast
   then have "(\<integral>x \<in> B. (f x - f' x) \<partial>M) = 0" using assms(3) by simp
   then have "B \<in> null_sets M"
     using B_def null_if_pos_func_has_zero_int[where ?f = "\<lambda>x. f x - f' x" and ?A = B] assms by auto
   then have "AE x in M. x \<notin> B" by (simp add: AE_not_in)
   then have "AE x in M. f' x \<ge> f x" unfolding B_def by auto
   then show ?thesis using * by auto
 qed
 
 text \<open>The next lemma shows that \<open>L\<^sup>1\<close> convergence of a sequence of functions follows from almost
 everywhere convergence and the weaker condition of the convergence of the integrated norms (or even
 just the nontrivial inequality about them). Useful in a lot of contexts! This statement (or its
 variations) are known as Scheffe lemma.
 
 The formalization is more painful as one should jump back and forth between reals and ereals and justify
 all the time positivity or integrability (thankfully, measurability is handled more or less automatically).\<close>
 
 proposition Scheffe_lemma1:
   assumes "\<And>n. integrable M (F n)" "integrable M f"
           "AE x in M. (\<lambda>n. F n x) \<longlonglongrightarrow> f x"
           "limsup (\<lambda>n. \<integral>\<^sup>+ x. norm(F n x) \<partial>M) \<le> (\<integral>\<^sup>+ x. norm(f x) \<partial>M)"
   shows "(\<lambda>n. \<integral>\<^sup>+ x. norm(F n x - f x) \<partial>M) \<longlonglongrightarrow> 0"
 proof -
   have [measurable]: "\<And>n. F n \<in> borel_measurable M" "f \<in> borel_measurable M"
     using assms(1) assms(2) by simp_all
   define G where "G = (\<lambda>n x. norm(f x) + norm(F n x) - norm(F n x - f x))"
   have [measurable]: "\<And>n. G n \<in> borel_measurable M" unfolding G_def by simp
   have G_pos[simp]: "\<And>n x. G n x \<ge> 0"
     unfolding G_def by (metis ge_iff_diff_ge_0 norm_minus_commute norm_triangle_ineq4)
   have finint: "(\<integral>\<^sup>+ x. norm(f x) \<partial>M) \<noteq> \<infinity>"
     using has_bochner_integral_implies_finite_norm[OF has_bochner_integral_integrable[OF \<open>integrable M f\<close>]]
     by simp
   then have fin2: "2 * (\<integral>\<^sup>+ x. norm(f x) \<partial>M) \<noteq> \<infinity>"
     by (auto simp: ennreal_mult_eq_top_iff)
 
   {
     fix x assume *: "(\<lambda>n. F n x) \<longlonglongrightarrow> f x"
     then have "(\<lambda>n. norm(F n x)) \<longlonglongrightarrow> norm(f x)" using tendsto_norm by blast
     moreover have "(\<lambda>n. norm(F n x - f x)) \<longlonglongrightarrow> 0" using * Lim_null tendsto_norm_zero_iff by fastforce
     ultimately have a: "(\<lambda>n. norm(F n x) - norm(F n x - f x)) \<longlonglongrightarrow> norm(f x)" using tendsto_diff by fastforce
     have "(\<lambda>n. norm(f x) + (norm(F n x) - norm(F n x - f x))) \<longlonglongrightarrow> norm(f x) + norm(f x)"
       by (rule tendsto_add) (auto simp add: a)
     moreover have "\<And>n. G n x = norm(f x) + (norm(F n x) - norm(F n x - f x))" unfolding G_def by simp
     ultimately have "(\<lambda>n. G n x) \<longlonglongrightarrow> 2 * norm(f x)" by simp
     then have "(\<lambda>n. ennreal(G n x)) \<longlonglongrightarrow> ennreal(2 * norm(f x))" by simp
     then have "liminf (\<lambda>n. ennreal(G n x)) = ennreal(2 * norm(f x))"
       using sequentially_bot tendsto_iff_Liminf_eq_Limsup by blast
   }
   then have "AE x in M. liminf (\<lambda>n. ennreal(G n x)) = ennreal(2 * norm(f x))" using assms(3) by auto
   then have "(\<integral>\<^sup>+ x. liminf (\<lambda>n. ennreal (G n x)) \<partial>M) = (\<integral>\<^sup>+ x. 2 * ennreal(norm(f x)) \<partial>M)"
     by (simp add: nn_integral_cong_AE ennreal_mult)
   also have "... = 2 * (\<integral>\<^sup>+ x. norm(f x) \<partial>M)" by (rule nn_integral_cmult) auto
   finally have int_liminf: "(\<integral>\<^sup>+ x. liminf (\<lambda>n. ennreal (G n x)) \<partial>M) = 2 * (\<integral>\<^sup>+ x. norm(f x) \<partial>M)"
     by simp
 
   have "(\<integral>\<^sup>+x. ennreal(norm(f x)) + ennreal(norm(F n x)) \<partial>M) = (\<integral>\<^sup>+x. norm(f x) \<partial>M) + (\<integral>\<^sup>+x. norm(F n x) \<partial>M)" for n
     by (rule nn_integral_add) (auto simp add: assms)
   then have "limsup (\<lambda>n. (\<integral>\<^sup>+x. ennreal(norm(f x)) + ennreal(norm(F n x)) \<partial>M)) =
       limsup (\<lambda>n. (\<integral>\<^sup>+x. norm(f x) \<partial>M) + (\<integral>\<^sup>+x. norm(F n x) \<partial>M))"
     by simp
   also have "... = (\<integral>\<^sup>+x. norm(f x) \<partial>M) + limsup (\<lambda>n. (\<integral>\<^sup>+x. norm(F n x) \<partial>M))"
     by (rule Limsup_const_add, auto simp add: finint)
   also have "... \<le> (\<integral>\<^sup>+x. norm(f x) \<partial>M) + (\<integral>\<^sup>+x. norm(f x) \<partial>M)"
     using assms(4) by (simp add: add_left_mono)
   also have "... = 2 * (\<integral>\<^sup>+x. norm(f x) \<partial>M)"
     unfolding one_add_one[symmetric] distrib_right by simp
   ultimately have a: "limsup (\<lambda>n. (\<integral>\<^sup>+x. ennreal(norm(f x)) + ennreal(norm(F n x)) \<partial>M)) \<le>
     2 * (\<integral>\<^sup>+x. norm(f x) \<partial>M)" by simp
 
   have le: "ennreal (norm (F n x - f x)) \<le> ennreal (norm (f x)) + ennreal (norm (F n x))" for n x
     by (simp add: norm_minus_commute norm_triangle_ineq4 ennreal_minus flip: ennreal_plus)
   then have le2: "(\<integral>\<^sup>+ x. ennreal (norm (F n x - f x)) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (norm (f x)) + ennreal (norm (F n x)) \<partial>M)" for n
     by (rule nn_integral_mono)
 
   have "2 * (\<integral>\<^sup>+ x. norm(f x) \<partial>M) = (\<integral>\<^sup>+ x. liminf (\<lambda>n. ennreal (G n x)) \<partial>M)"
     by (simp add: int_liminf)
   also have "\<dots> \<le> liminf (\<lambda>n. (\<integral>\<^sup>+x. G n x \<partial>M))"
     by (rule nn_integral_liminf) auto
   also have "liminf (\<lambda>n. (\<integral>\<^sup>+x. G n x \<partial>M)) =
     liminf (\<lambda>n. (\<integral>\<^sup>+x. ennreal(norm(f x)) + ennreal(norm(F n x)) \<partial>M) - (\<integral>\<^sup>+x. norm(F n x - f x) \<partial>M))"
   proof (intro arg_cong[where f=liminf] ext)
     fix n
     have "\<And>x. ennreal(G n x) = ennreal(norm(f x)) + ennreal(norm(F n x)) - ennreal(norm(F n x - f x))"
       unfolding G_def by (simp add: ennreal_minus flip: ennreal_plus)
     moreover have "(\<integral>\<^sup>+x. ennreal(norm(f x)) + ennreal(norm(F n x)) - ennreal(norm(F n x - f x)) \<partial>M)
             = (\<integral>\<^sup>+x. ennreal(norm(f x)) + ennreal(norm(F n x)) \<partial>M) - (\<integral>\<^sup>+x. norm(F n x - f x) \<partial>M)"
     proof (rule nn_integral_diff)
       from le show "AE x in M. ennreal (norm (F n x - f x)) \<le> ennreal (norm (f x)) + ennreal (norm (F n x))"
         by simp
       from le2 have "(\<integral>\<^sup>+x. ennreal (norm (F n x - f x)) \<partial>M) < \<infinity>" using assms(1) assms(2)
         by (metis has_bochner_integral_implies_finite_norm integrable.simps Bochner_Integration.integrable_diff)
       then show "(\<integral>\<^sup>+x. ennreal (norm (F n x - f x)) \<partial>M) \<noteq> \<infinity>" by simp
     qed (auto simp add: assms)
     ultimately show "(\<integral>\<^sup>+x. G n x \<partial>M) = (\<integral>\<^sup>+x. ennreal(norm(f x)) + ennreal(norm(F n x)) \<partial>M) - (\<integral>\<^sup>+x. norm(F n x - f x) \<partial>M)"
       by simp
   qed
   finally have "2 * (\<integral>\<^sup>+ x. norm(f x) \<partial>M) + limsup (\<lambda>n. (\<integral>\<^sup>+x. norm(F n x - f x) \<partial>M)) \<le>
     liminf (\<lambda>n. (\<integral>\<^sup>+x. ennreal(norm(f x)) + ennreal(norm(F n x)) \<partial>M) - (\<integral>\<^sup>+x. norm(F n x - f x) \<partial>M)) +
     limsup (\<lambda>n. (\<integral>\<^sup>+x. norm(F n x - f x) \<partial>M))"
     by (intro add_mono) auto
   also have "\<dots> \<le> (limsup (\<lambda>n. \<integral>\<^sup>+x. ennreal(norm(f x)) + ennreal(norm(F n x)) \<partial>M) - limsup (\<lambda>n. \<integral>\<^sup>+x. norm (F n x - f x) \<partial>M)) +
     limsup (\<lambda>n. (\<integral>\<^sup>+x. norm(F n x - f x) \<partial>M))"
     by (intro add_mono liminf_minus_ennreal le2) auto
   also have "\<dots> = limsup (\<lambda>n. (\<integral>\<^sup>+x. ennreal(norm(f x)) + ennreal(norm(F n x)) \<partial>M))"
     by (intro diff_add_cancel_ennreal Limsup_mono always_eventually allI le2)
   also have "\<dots> \<le> 2 * (\<integral>\<^sup>+x. norm(f x) \<partial>M)"
     by fact
   finally have "limsup (\<lambda>n. (\<integral>\<^sup>+x. norm(F n x - f x) \<partial>M)) = 0"
     using fin2 by simp
   then show ?thesis
     by (rule tendsto_0_if_Limsup_eq_0_ennreal)
 qed
 
 proposition Scheffe_lemma2:
   fixes F::"nat \<Rightarrow> 'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes "\<And> n::nat. F n \<in> borel_measurable M" "integrable M f"
           "AE x in M. (\<lambda>n. F n x) \<longlonglongrightarrow> f x"
           "\<And>n. (\<integral>\<^sup>+ x. norm(F n x) \<partial>M) \<le> (\<integral>\<^sup>+ x. norm(f x) \<partial>M)"
   shows "(\<lambda>n. \<integral>\<^sup>+ x. norm(F n x - f x) \<partial>M) \<longlonglongrightarrow> 0"
 proof (rule Scheffe_lemma1)
   fix n::nat
   have "(\<integral>\<^sup>+ x. norm(f x) \<partial>M) < \<infinity>" using assms(2) by (metis has_bochner_integral_implies_finite_norm integrable.cases)
   then have "(\<integral>\<^sup>+ x. norm(F n x) \<partial>M) < \<infinity>" using assms(4)[of n] by auto
   then show "integrable M (F n)" by (subst integrable_iff_bounded, simp add: assms(1)[of n])
 qed (auto simp add: assms Limsup_bounded)
 
 lemma tendsto_set_lebesgue_integral_at_right:
   fixes a b :: real and f :: "real \<Rightarrow> 'a :: {banach,second_countable_topology}"
   assumes "a < b" and sets: "\<And>a'. a' \<in> {a<..b} \<Longrightarrow> {a'..b} \<in> sets M"
       and "set_integrable M {a<..b} f"
   shows   "((\<lambda>a'. set_lebesgue_integral M {a'..b} f) \<longlongrightarrow>
              set_lebesgue_integral M {a<..b} f) (at_right a)"
 proof (rule tendsto_at_right_sequentially[OF assms(1)], goal_cases)
   case (1 S)
   have eq: "(\<Union>n. {S n..b}) = {a<..b}"
   proof safe
     fix x n assume "x \<in> {S n..b}"
     with 1(1,2)[of n] show "x \<in> {a<..b}" by auto
   next
     fix x assume "x \<in> {a<..b}"
     with order_tendstoD[OF \<open>S \<longlonglongrightarrow> a\<close>, of x] show "x \<in> (\<Union>n. {S n..b})"
       by (force simp: eventually_at_top_linorder dest: less_imp_le)
   qed
   have "(\<lambda>n. set_lebesgue_integral M {S n..b} f) \<longlonglongrightarrow> set_lebesgue_integral M (\<Union>n. {S n..b}) f"
     by (rule set_integral_cont_up) (insert assms 1, auto simp: eq incseq_def decseq_def less_imp_le)
   with eq show ?case by simp
 qed
 
 
 text \<open>
   The next lemmas relate convergence of integrals over an interval to
   improper integrals.
 \<close>
 lemma tendsto_set_lebesgue_integral_at_left:
   fixes a b :: real and f :: "real \<Rightarrow> 'a :: {banach,second_countable_topology}"
   assumes "a < b" and sets: "\<And>b'. b' \<in> {a..<b} \<Longrightarrow> {a..b'} \<in> sets M"
       and "set_integrable M {a..<b} f"
   shows   "((\<lambda>b'. set_lebesgue_integral M {a..b'} f) \<longlongrightarrow>
              set_lebesgue_integral M {a..<b} f) (at_left b)"
 proof (rule tendsto_at_left_sequentially[OF assms(1)], goal_cases)
   case (1 S)
   have eq: "(\<Union>n. {a..S n}) = {a..<b}"
   proof safe
     fix x n assume "x \<in> {a..S n}"
     with 1(1,2)[of n] show "x \<in> {a..<b}" by auto
   next
     fix x assume "x \<in> {a..<b}"
     with order_tendstoD[OF \<open>S \<longlonglongrightarrow> b\<close>, of x] show "x \<in> (\<Union>n. {a..S n})"
       by (force simp: eventually_at_top_linorder dest: less_imp_le)
   qed
   have "(\<lambda>n. set_lebesgue_integral M {a..S n} f) \<longlonglongrightarrow> set_lebesgue_integral M (\<Union>n. {a..S n}) f"
     by (rule set_integral_cont_up) (insert assms 1, auto simp: eq incseq_def decseq_def less_imp_le)
   with eq show ?case by simp
 qed
 
 proposition tendsto_set_lebesgue_integral_at_top:
   fixes f :: "real \<Rightarrow> 'a::{banach, second_countable_topology}"
   assumes sets: "\<And>b. b \<ge> a \<Longrightarrow> {a..b} \<in> sets M"
       and int: "set_integrable M {a..} f"
   shows "((\<lambda>b. set_lebesgue_integral M {a..b} f) \<longlongrightarrow> set_lebesgue_integral M {a..} f) at_top"
 proof (rule tendsto_at_topI_sequentially)
   fix X :: "nat \<Rightarrow> real" assume "filterlim X at_top sequentially"
   show "(\<lambda>n. set_lebesgue_integral M {a..X n} f) \<longlonglongrightarrow> set_lebesgue_integral M {a..} f"
     unfolding set_lebesgue_integral_def
   proof (rule integral_dominated_convergence)
     show "integrable M (\<lambda>x. indicat_real {a..} x *\<^sub>R norm (f x))"
       using integrable_norm[OF int[unfolded set_integrable_def]] by simp
     show "AE x in M. (\<lambda>n. indicator {a..X n} x *\<^sub>R f x) \<longlonglongrightarrow> indicat_real {a..} x *\<^sub>R f x"
     proof
       fix x
       from \<open>filterlim X at_top sequentially\<close>
       have "eventually (\<lambda>n. x \<le> X n) sequentially"
         unfolding filterlim_at_top_ge[where c=x] by auto
       then show "(\<lambda>n. indicator {a..X n} x *\<^sub>R f x) \<longlonglongrightarrow> indicat_real {a..} x *\<^sub>R f x"
         by (intro tendsto_eventually) (auto split: split_indicator elim!: eventually_mono)
     qed
     fix n show "AE x in M. norm (indicator {a..X n} x *\<^sub>R f x) \<le> 
                              indicator {a..} x *\<^sub>R norm (f x)"
       by (auto split: split_indicator)
   next
     from int show "(\<lambda>x. indicat_real {a..} x *\<^sub>R f x) \<in> borel_measurable M"
       by (simp add: set_integrable_def)
   next
     fix n :: nat
     from sets have "{a..X n} \<in> sets M" by (cases "X n \<ge> a") auto
     with int have "set_integrable M {a..X n} f"
       by (rule set_integrable_subset) auto
     thus "(\<lambda>x. indicat_real {a..X n} x *\<^sub>R f x) \<in> borel_measurable M"
       by (simp add: set_integrable_def)
   qed
 qed
 
 proposition tendsto_set_lebesgue_integral_at_bot:
   fixes f :: "real \<Rightarrow> 'a::{banach, second_countable_topology}"
   assumes sets: "\<And>a. a \<le> b \<Longrightarrow> {a..b} \<in> sets M"
       and int: "set_integrable M {..b} f"
     shows "((\<lambda>a. set_lebesgue_integral M {a..b} f) \<longlongrightarrow> set_lebesgue_integral M {..b} f) at_bot"
 proof (rule tendsto_at_botI_sequentially)
   fix X :: "nat \<Rightarrow> real" assume "filterlim X at_bot sequentially"
   show "(\<lambda>n. set_lebesgue_integral M {X n..b} f) \<longlonglongrightarrow> set_lebesgue_integral M {..b} f"
     unfolding set_lebesgue_integral_def
   proof (rule integral_dominated_convergence)
     show "integrable M (\<lambda>x. indicat_real {..b} x *\<^sub>R norm (f x))"
       using integrable_norm[OF int[unfolded set_integrable_def]] by simp
     show "AE x in M. (\<lambda>n. indicator {X n..b} x *\<^sub>R f x) \<longlonglongrightarrow> indicat_real {..b} x *\<^sub>R f x"
     proof
       fix x
       from \<open>filterlim X at_bot sequentially\<close>
       have "eventually (\<lambda>n. x \<ge> X n) sequentially"
         unfolding filterlim_at_bot_le[where c=x] by auto
       then show "(\<lambda>n. indicator {X n..b} x *\<^sub>R f x) \<longlonglongrightarrow> indicat_real {..b} x *\<^sub>R f x"
         by (intro tendsto_eventually) (auto split: split_indicator elim!: eventually_mono)
     qed
     fix n show "AE x in M. norm (indicator {X n..b} x *\<^sub>R f x) \<le> 
                              indicator {..b} x *\<^sub>R norm (f x)"
       by (auto split: split_indicator)
   next
     from int show "(\<lambda>x. indicat_real {..b} x *\<^sub>R f x) \<in> borel_measurable M"
       by (simp add: set_integrable_def)
   next
     fix n :: nat
     from sets have "{X n..b} \<in> sets M" by (cases "X n \<le> b") auto
     with int have "set_integrable M {X n..b} f"
       by (rule set_integrable_subset) auto
     thus "(\<lambda>x. indicat_real {X n..b} x *\<^sub>R f x) \<in> borel_measurable M"
       by (simp add: set_integrable_def)
   qed
 qed
 
 
 
 theorem integral_Markov_inequality':
   fixes u :: "'a \<Rightarrow> real"
   assumes [measurable]: "set_integrable M A u" and "A \<in> sets M"
   assumes "AE x in M. x \<in> A \<longrightarrow> u x \<ge> 0" and "0 < (c::real)"
   shows "emeasure M {x\<in>A. u x \<ge> c} \<le> (1/c::real) * (\<integral>x\<in>A. u x \<partial>M)"
 proof -
   have "(\<lambda>x. u x * indicator A x) \<in> borel_measurable M" 
     using assms by (auto simp: set_integrable_def mult_ac)
   hence "(\<lambda>x. ennreal (u x * indicator A x)) \<in> borel_measurable M"
     by measurable
   also have "(\<lambda>x. ennreal (u x * indicator A x)) = (\<lambda>x. ennreal (u x) * indicator A x)"
     by (intro ext) (auto simp: indicator_def)
   finally have meas: "\<dots> \<in> borel_measurable M" .
   from assms(3) have AE: "AE x in M. 0 \<le> u x * indicator A x"
     by eventually_elim (auto simp: indicator_def)
   have nonneg: "set_lebesgue_integral M A u \<ge> 0"
     unfolding set_lebesgue_integral_def
     by (intro Bochner_Integration.integral_nonneg_AE eventually_mono[OF AE]) (auto simp: mult_ac)
 
   have A: "A \<subseteq> space M"
     using \<open>A \<in> sets M\<close> by (simp add: sets.sets_into_space)
   have "{x \<in> A. u x \<ge> c} = {x \<in> A. ennreal(1/c) * u x \<ge> 1}"
     using \<open>c>0\<close> A by (auto simp: ennreal_mult'[symmetric])
   then have "emeasure M {x \<in> A. u x \<ge> c} = emeasure M ({x \<in> A. ennreal(1/c) * u x \<ge> 1})"
     by simp
   also have "... \<le> ennreal(1/c) * (\<integral>\<^sup>+ x. ennreal(u x) * indicator A x \<partial>M)"
     by (intro nn_integral_Markov_inequality meas assms)
   also have "(\<integral>\<^sup>+ x. ennreal(u x) * indicator A x \<partial>M) = ennreal (set_lebesgue_integral M A u)"
     unfolding set_lebesgue_integral_def nn_integral_set_ennreal using assms AE
     by (subst nn_integral_eq_integral) (simp_all add: mult_ac set_integrable_def)
   finally show ?thesis
     using \<open>c > 0\<close> nonneg by (subst ennreal_mult) auto
 qed
 
 theorem integral_Markov_inequality'_measure:
   assumes [measurable]: "set_integrable M A u" and "A \<in> sets M" 
      and "AE x in M. x \<in> A \<longrightarrow> 0 \<le> u x" "0 < (c::real)"
   shows "measure M {x\<in>A. u x \<ge> c} \<le> (\<integral>x\<in>A. u x \<partial>M) / c"
 proof -
   have nonneg: "set_lebesgue_integral M A u \<ge> 0"
     unfolding set_lebesgue_integral_def
     by (intro Bochner_Integration.integral_nonneg_AE eventually_mono[OF assms(3)])
        (auto simp: mult_ac)
   have le: "emeasure M {x\<in>A. u x \<ge> c} \<le> ennreal ((1/c) * (\<integral>x\<in>A. u x \<partial>M))"
     by (rule integral_Markov_inequality') (use assms in auto)
   also have "\<dots> < top"
     by auto
   finally have "ennreal (measure M {x\<in>A. u x \<ge> c}) = emeasure M {x\<in>A. u x \<ge> c}"
     by (intro emeasure_eq_ennreal_measure [symmetric]) auto
   also note le
   finally show ?thesis using nonneg
     by (subst (asm) ennreal_le_iff)
        (auto intro!: divide_nonneg_pos Bochner_Integration.integral_nonneg_AE assms)
 qed
 
 theorem%important (in finite_measure) Chernoff_ineq_ge:
   assumes s: "s > 0"
   assumes integrable: "set_integrable M A (\<lambda>x. exp (s * f x))" and "A \<in> sets M"
   shows   "measure M {x\<in>A. f x \<ge> a} \<le> exp (-s * a) * (\<integral>x\<in>A. exp (s * f x) \<partial>M)"
 proof -
   have "{x\<in>A. f x \<ge> a} = {x\<in>A. exp (s * f x) \<ge> exp (s * a)}"
     using s by auto
   also have "measure M \<dots> \<le> set_lebesgue_integral M A (\<lambda>x. exp (s * f x)) / exp (s * a)"
     by (intro integral_Markov_inequality'_measure assms) auto
   finally show ?thesis 
     by (simp add: exp_minus field_simps)
 qed
 
 theorem%important (in finite_measure) Chernoff_ineq_le:
   assumes s: "s > 0"
   assumes integrable: "set_integrable M A (\<lambda>x. exp (-s * f x))" and "A \<in> sets M"
   shows   "measure M {x\<in>A. f x \<le> a} \<le> exp (s * a) * (\<integral>x\<in>A. exp (-s * f x) \<partial>M)"
 proof -
   have "{x\<in>A. f x \<le> a} = {x\<in>A. exp (-s * f x) \<ge> exp (-s * a)}"
     using s by auto
   also have "measure M \<dots> \<le> set_lebesgue_integral M A (\<lambda>x. exp (-s * f x)) / exp (-s * a)"
     by (intro integral_Markov_inequality'_measure assms) auto
   finally show ?thesis 
     by (simp add: exp_minus field_simps)
 qed
 
 end
diff --git a/src/HOL/Analysis/Sigma_Algebra.thy b/src/HOL/Analysis/Sigma_Algebra.thy
--- a/src/HOL/Analysis/Sigma_Algebra.thy
+++ b/src/HOL/Analysis/Sigma_Algebra.thy
@@ -1,2304 +1,2314 @@
 (*  Title:      HOL/Analysis/Sigma_Algebra.thy
     Author:     Stefan Richter, Markus Wenzel, TU München
     Author:     Johannes Hölzl, TU München
     Plus material from the Hurd/Coble measure theory development,
     translated by Lawrence Paulson.
 *)
 
 chapter \<open>Measure and Integration Theory\<close>
 
 theory Sigma_Algebra
 imports
   Complex_Main
   "HOL-Library.Countable_Set"
   "HOL-Library.FuncSet"
   "HOL-Library.Indicator_Function"
   "HOL-Library.Extended_Nonnegative_Real"
   "HOL-Library.Disjoint_Sets"
 begin
 
 
 section \<open>Sigma Algebra\<close>
 
 text \<open>Sigma algebras are an elementary concept in measure
   theory. To measure --- that is to integrate --- functions, we first have
   to measure sets. Unfortunately, when dealing with a large universe,
   it is often not possible to consistently assign a measure to every
   subset. Therefore it is necessary to define the set of measurable
   subsets of the universe. A sigma algebra is such a set that has
   three very natural and desirable properties.\<close>
 
 subsection \<open>Families of sets\<close>
 
 locale\<^marker>\<open>tag important\<close> subset_class =
   fixes \<Omega> :: "'a set" and M :: "'a set set"
   assumes space_closed: "M \<subseteq> Pow \<Omega>"
 
 lemma (in subset_class) sets_into_space: "x \<in> M \<Longrightarrow> x \<subseteq> \<Omega>"
   by (metis PowD contra_subsetD space_closed)
 
 subsubsection \<open>Semiring of sets\<close>
 
 locale\<^marker>\<open>tag important\<close> semiring_of_sets = subset_class +
   assumes empty_sets[iff]: "{} \<in> M"
   assumes Int[intro]: "\<And>a b. a \<in> M \<Longrightarrow> b \<in> M \<Longrightarrow> a \<inter> b \<in> M"
   assumes Diff_cover:
     "\<And>a b. a \<in> M \<Longrightarrow> b \<in> M \<Longrightarrow> \<exists>C\<subseteq>M. finite C \<and> disjoint C \<and> a - b = \<Union>C"
 
 lemma (in semiring_of_sets) finite_INT[intro]:
   assumes "finite I" "I \<noteq> {}" "\<And>i. i \<in> I \<Longrightarrow> A i \<in> M"
   shows "(\<Inter>i\<in>I. A i) \<in> M"
   using assms by (induct rule: finite_ne_induct) auto
 
 lemma (in semiring_of_sets) Int_space_eq1 [simp]: "x \<in> M \<Longrightarrow> \<Omega> \<inter> x = x"
   by (metis Int_absorb1 sets_into_space)
 
 lemma (in semiring_of_sets) Int_space_eq2 [simp]: "x \<in> M \<Longrightarrow> x \<inter> \<Omega> = x"
   by (metis Int_absorb2 sets_into_space)
 
 lemma (in semiring_of_sets) sets_Collect_conj:
   assumes "{x\<in>\<Omega>. P x} \<in> M" "{x\<in>\<Omega>. Q x} \<in> M"
   shows "{x\<in>\<Omega>. Q x \<and> P x} \<in> M"
 proof -
   have "{x\<in>\<Omega>. Q x \<and> P x} = {x\<in>\<Omega>. Q x} \<inter> {x\<in>\<Omega>. P x}"
     by auto
   with assms show ?thesis by auto
 qed
 
 lemma (in semiring_of_sets) sets_Collect_finite_All':
   assumes "\<And>i. i \<in> S \<Longrightarrow> {x\<in>\<Omega>. P i x} \<in> M" "finite S" "S \<noteq> {}"
   shows "{x\<in>\<Omega>. \<forall>i\<in>S. P i x} \<in> M"
 proof -
   have "{x\<in>\<Omega>. \<forall>i\<in>S. P i x} = (\<Inter>i\<in>S. {x\<in>\<Omega>. P i x})"
     using \<open>S \<noteq> {}\<close> by auto
   with assms show ?thesis by auto
 qed
 
 subsubsection \<open>Ring of sets\<close>
 
 locale\<^marker>\<open>tag important\<close> ring_of_sets = semiring_of_sets +
   assumes Un [intro]: "\<And>a b. a \<in> M \<Longrightarrow> b \<in> M \<Longrightarrow> a \<union> b \<in> M"
 
 lemma (in ring_of_sets) finite_Union [intro]:
   "finite X \<Longrightarrow> X \<subseteq> M \<Longrightarrow> \<Union>X \<in> M"
   by (induct set: finite) (auto simp add: Un)
 
 lemma (in ring_of_sets) finite_UN[intro]:
   assumes "finite I" and "\<And>i. i \<in> I \<Longrightarrow> A i \<in> M"
   shows "(\<Union>i\<in>I. A i) \<in> M"
   using assms by induct auto
 
 lemma (in ring_of_sets) Diff [intro]:
   assumes "a \<in> M" "b \<in> M" shows "a - b \<in> M"
   using Diff_cover[OF assms] by auto
 
 lemma ring_of_setsI:
   assumes space_closed: "M \<subseteq> Pow \<Omega>"
   assumes empty_sets[iff]: "{} \<in> M"
   assumes Un[intro]: "\<And>a b. a \<in> M \<Longrightarrow> b \<in> M \<Longrightarrow> a \<union> b \<in> M"
   assumes Diff[intro]: "\<And>a b. a \<in> M \<Longrightarrow> b \<in> M \<Longrightarrow> a - b \<in> M"
   shows "ring_of_sets \<Omega> M"
 proof
   fix a b assume ab: "a \<in> M" "b \<in> M"
   from ab show "\<exists>C\<subseteq>M. finite C \<and> disjoint C \<and> a - b = \<Union>C"
     by (intro exI[of _ "{a - b}"]) (auto simp: disjoint_def)
   have "a \<inter> b = a - (a - b)" by auto
   also have "\<dots> \<in> M" using ab by auto
   finally show "a \<inter> b \<in> M" .
 qed fact+
 
 lemma ring_of_sets_iff: "ring_of_sets \<Omega> M \<longleftrightarrow> M \<subseteq> Pow \<Omega> \<and> {} \<in> M \<and> (\<forall>a\<in>M. \<forall>b\<in>M. a \<union> b \<in> M) \<and> (\<forall>a\<in>M. \<forall>b\<in>M. a - b \<in> M)"
 proof
   assume "ring_of_sets \<Omega> M"
   then interpret ring_of_sets \<Omega> M .
   show "M \<subseteq> Pow \<Omega> \<and> {} \<in> M \<and> (\<forall>a\<in>M. \<forall>b\<in>M. a \<union> b \<in> M) \<and> (\<forall>a\<in>M. \<forall>b\<in>M. a - b \<in> M)"
     using space_closed by auto
 qed (auto intro!: ring_of_setsI)
 
 lemma (in ring_of_sets) insert_in_sets:
   assumes "{x} \<in> M" "A \<in> M" shows "insert x A \<in> M"
 proof -
   have "{x} \<union> A \<in> M" using assms by (rule Un)
   thus ?thesis by auto
 qed
 
 lemma (in ring_of_sets) sets_Collect_disj:
   assumes "{x\<in>\<Omega>. P x} \<in> M" "{x\<in>\<Omega>. Q x} \<in> M"
   shows "{x\<in>\<Omega>. Q x \<or> P x} \<in> M"
 proof -
   have "{x\<in>\<Omega>. Q x \<or> P x} = {x\<in>\<Omega>. Q x} \<union> {x\<in>\<Omega>. P x}"
     by auto
   with assms show ?thesis by auto
 qed
 
 lemma (in ring_of_sets) sets_Collect_finite_Ex:
   assumes "\<And>i. i \<in> S \<Longrightarrow> {x\<in>\<Omega>. P i x} \<in> M" "finite S"
   shows "{x\<in>\<Omega>. \<exists>i\<in>S. P i x} \<in> M"
 proof -
   have "{x\<in>\<Omega>. \<exists>i\<in>S. P i x} = (\<Union>i\<in>S. {x\<in>\<Omega>. P i x})"
     by auto
   with assms show ?thesis by auto
 qed
 
 subsubsection \<open>Algebra of sets\<close>
 
 locale\<^marker>\<open>tag important\<close> algebra = ring_of_sets +
   assumes top [iff]: "\<Omega> \<in> M"
 
 lemma (in algebra) compl_sets [intro]:
   "a \<in> M \<Longrightarrow> \<Omega> - a \<in> M"
   by auto
 
 proposition algebra_iff_Un:
   "algebra \<Omega> M \<longleftrightarrow>
     M \<subseteq> Pow \<Omega> \<and>
     {} \<in> M \<and>
     (\<forall>a \<in> M. \<Omega> - a \<in> M) \<and>
     (\<forall>a \<in> M. \<forall> b \<in> M. a \<union> b \<in> M)" (is "_ \<longleftrightarrow> ?Un")
 proof
   assume "algebra \<Omega> M"
   then interpret algebra \<Omega> M .
   show ?Un using sets_into_space by auto
 next
   assume ?Un
   then have "\<Omega> \<in> M" by auto
   interpret ring_of_sets \<Omega> M
   proof (rule ring_of_setsI)
     show \<Omega>: "M \<subseteq> Pow \<Omega>" "{} \<in> M"
       using \<open>?Un\<close> by auto
     fix a b assume a: "a \<in> M" and b: "b \<in> M"
     then show "a \<union> b \<in> M" using \<open>?Un\<close> by auto
     have "a - b = \<Omega> - ((\<Omega> - a) \<union> b)"
       using \<Omega> a b by auto
     then show "a - b \<in> M"
       using a b  \<open>?Un\<close> by auto
   qed
   show "algebra \<Omega> M" proof qed fact
 qed
 
 proposition algebra_iff_Int:
      "algebra \<Omega> M \<longleftrightarrow>
        M \<subseteq> Pow \<Omega> & {} \<in> M &
        (\<forall>a \<in> M. \<Omega> - a \<in> M) &
        (\<forall>a \<in> M. \<forall> b \<in> M. a \<inter> b \<in> M)" (is "_ \<longleftrightarrow> ?Int")
 proof
   assume "algebra \<Omega> M"
   then interpret algebra \<Omega> M .
   show ?Int using sets_into_space by auto
 next
   assume ?Int
   show "algebra \<Omega> M"
   proof (unfold algebra_iff_Un, intro conjI ballI)
     show \<Omega>: "M \<subseteq> Pow \<Omega>" "{} \<in> M"
       using \<open>?Int\<close> by auto
     from \<open>?Int\<close> show "\<And>a. a \<in> M \<Longrightarrow> \<Omega> - a \<in> M" by auto
     fix a b assume M: "a \<in> M" "b \<in> M"
     hence "a \<union> b = \<Omega> - ((\<Omega> - a) \<inter> (\<Omega> - b))"
       using \<Omega> by blast
     also have "... \<in> M"
       using M \<open>?Int\<close> by auto
     finally show "a \<union> b \<in> M" .
   qed
 qed
 
 lemma (in algebra) sets_Collect_neg:
   assumes "{x\<in>\<Omega>. P x} \<in> M"
   shows "{x\<in>\<Omega>. \<not> P x} \<in> M"
 proof -
   have "{x\<in>\<Omega>. \<not> P x} = \<Omega> - {x\<in>\<Omega>. P x}" by auto
   with assms show ?thesis by auto
 qed
 
 lemma (in algebra) sets_Collect_imp:
   "{x\<in>\<Omega>. P x} \<in> M \<Longrightarrow> {x\<in>\<Omega>. Q x} \<in> M \<Longrightarrow> {x\<in>\<Omega>. Q x \<longrightarrow> P x} \<in> M"
   unfolding imp_conv_disj by (intro sets_Collect_disj sets_Collect_neg)
 
 lemma (in algebra) sets_Collect_const:
   "{x\<in>\<Omega>. P} \<in> M"
   by (cases P) auto
 
 lemma algebra_single_set:
   "X \<subseteq> S \<Longrightarrow> algebra S { {}, X, S - X, S }"
   by (auto simp: algebra_iff_Int)
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Restricted algebras\<close>
 
 abbreviation (in algebra)
   "restricted_space A \<equiv> ((\<inter>) A) ` M"
 
 lemma (in algebra) restricted_algebra:
   assumes "A \<in> M" shows "algebra A (restricted_space A)"
   using assms by (auto simp: algebra_iff_Int)
 
 subsubsection \<open>Sigma Algebras\<close>
 
 locale\<^marker>\<open>tag important\<close> sigma_algebra = algebra +
   assumes countable_nat_UN [intro]: "\<And>A. range A \<subseteq> M \<Longrightarrow> (\<Union>i::nat. A i) \<in> M"
 
 lemma (in algebra) is_sigma_algebra:
   assumes "finite M"
   shows "sigma_algebra \<Omega> M"
 proof
   fix A :: "nat \<Rightarrow> 'a set" assume "range A \<subseteq> M"
   then have "(\<Union>i. A i) = (\<Union>s\<in>M \<inter> range A. s)"
     by auto
   also have "(\<Union>s\<in>M \<inter> range A. s) \<in> M"
     using \<open>finite M\<close> by auto
   finally show "(\<Union>i. A i) \<in> M" .
 qed
 
 lemma countable_UN_eq:
   fixes A :: "'i::countable \<Rightarrow> 'a set"
   shows "(range A \<subseteq> M \<longrightarrow> (\<Union>i. A i) \<in> M) \<longleftrightarrow>
     (range (A \<circ> from_nat) \<subseteq> M \<longrightarrow> (\<Union>i. (A \<circ> from_nat) i) \<in> M)"
 proof -
   let ?A' = "A \<circ> from_nat"
   have *: "(\<Union>i. ?A' i) = (\<Union>i. A i)" (is "?l = ?r")
   proof safe
     fix x i assume "x \<in> A i" thus "x \<in> ?l"
       by (auto intro!: exI[of _ "to_nat i"])
   next
     fix x i assume "x \<in> ?A' i" thus "x \<in> ?r"
       by (auto intro!: exI[of _ "from_nat i"])
   qed
   have "A ` range from_nat = range A"
     using surj_from_nat by simp
   then have **: "range ?A' = range A"
     by (simp only: image_comp [symmetric])
   show ?thesis unfolding * ** ..
 qed
 
 lemma (in sigma_algebra) countable_Union [intro]:
   assumes "countable X" "X \<subseteq> M" shows "\<Union>X \<in> M"
 proof cases
   assume "X \<noteq> {}"
   hence "\<Union>X = (\<Union>n. from_nat_into X n)"
     using assms by (auto cong del: SUP_cong)
   also have "\<dots> \<in> M" using assms
     by (auto intro!: countable_nat_UN) (metis \<open>X \<noteq> {}\<close> from_nat_into subsetD)
   finally show ?thesis .
 qed simp
 
 lemma (in sigma_algebra) countable_UN[intro]:
   fixes A :: "'i::countable \<Rightarrow> 'a set"
   assumes "A`X \<subseteq> M"
   shows  "(\<Union>x\<in>X. A x) \<in> M"
 proof -
   let ?A = "\<lambda>i. if i \<in> X then A i else {}"
   from assms have "range ?A \<subseteq> M" by auto
   with countable_nat_UN[of "?A \<circ> from_nat"] countable_UN_eq[of ?A M]
   have "(\<Union>x. ?A x) \<in> M" by auto
   moreover have "(\<Union>x. ?A x) = (\<Union>x\<in>X. A x)" by (auto split: if_split_asm)
   ultimately show ?thesis by simp
 qed
 
 lemma (in sigma_algebra) countable_UN':
   fixes A :: "'i \<Rightarrow> 'a set"
   assumes X: "countable X"
   assumes A: "A`X \<subseteq> M"
   shows  "(\<Union>x\<in>X. A x) \<in> M"
 proof -
   have "(\<Union>x\<in>X. A x) = (\<Union>i\<in>to_nat_on X ` X. A (from_nat_into X i))"
     using X by auto
   also have "\<dots> \<in> M"
     using A X
     by (intro countable_UN) auto
   finally show ?thesis .
 qed
 
 lemma (in sigma_algebra) countable_UN'':
   "\<lbrakk> countable X; \<And>x y. x \<in> X \<Longrightarrow> A x \<in> M \<rbrakk> \<Longrightarrow> (\<Union>x\<in>X. A x) \<in> M"
 by(erule countable_UN')(auto)
 
 lemma (in sigma_algebra) countable_INT [intro]:
   fixes A :: "'i::countable \<Rightarrow> 'a set"
   assumes A: "A`X \<subseteq> M" "X \<noteq> {}"
   shows "(\<Inter>i\<in>X. A i) \<in> M"
 proof -
   from A have "\<forall>i\<in>X. A i \<in> M" by fast
   hence "\<Omega> - (\<Union>i\<in>X. \<Omega> - A i) \<in> M" by blast
   moreover
   have "(\<Inter>i\<in>X. A i) = \<Omega> - (\<Union>i\<in>X. \<Omega> - A i)" using space_closed A
     by blast
   ultimately show ?thesis by metis
 qed
 
 lemma (in sigma_algebra) countable_INT':
   fixes A :: "'i \<Rightarrow> 'a set"
   assumes X: "countable X" "X \<noteq> {}"
   assumes A: "A`X \<subseteq> M"
   shows  "(\<Inter>x\<in>X. A x) \<in> M"
 proof -
   have "(\<Inter>x\<in>X. A x) = (\<Inter>i\<in>to_nat_on X ` X. A (from_nat_into X i))"
     using X by auto
   also have "\<dots> \<in> M"
     using A X
     by (intro countable_INT) auto
   finally show ?thesis .
 qed
 
 lemma (in sigma_algebra) countable_INT'':
   "UNIV \<in> M \<Longrightarrow> countable I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> F i \<in> M) \<Longrightarrow> (\<Inter>i\<in>I. F i) \<in> M"
   by (cases "I = {}") (auto intro: countable_INT')
 
 lemma (in sigma_algebra) countable:
   assumes "\<And>a. a \<in> A \<Longrightarrow> {a} \<in> M" "countable A"
   shows "A \<in> M"
 proof -
   have "(\<Union>a\<in>A. {a}) \<in> M"
     using assms by (intro countable_UN') auto
   also have "(\<Union>a\<in>A. {a}) = A" by auto
   finally show ?thesis by auto
 qed
 
 lemma ring_of_sets_Pow: "ring_of_sets sp (Pow sp)"
   by (auto simp: ring_of_sets_iff)
 
 lemma algebra_Pow: "algebra sp (Pow sp)"
   by (auto simp: algebra_iff_Un)
 
 lemma sigma_algebra_iff:
   "sigma_algebra \<Omega> M \<longleftrightarrow>
     algebra \<Omega> M \<and> (\<forall>A. range A \<subseteq> M \<longrightarrow> (\<Union>i::nat. A i) \<in> M)"
   by (simp add: sigma_algebra_def sigma_algebra_axioms_def)
 
 lemma sigma_algebra_Pow: "sigma_algebra sp (Pow sp)"
   by (auto simp: sigma_algebra_iff algebra_iff_Int)
 
 lemma (in sigma_algebra) sets_Collect_countable_All:
   assumes "\<And>i. {x\<in>\<Omega>. P i x} \<in> M"
   shows "{x\<in>\<Omega>. \<forall>i::'i::countable. P i x} \<in> M"
 proof -
   have "{x\<in>\<Omega>. \<forall>i::'i::countable. P i x} = (\<Inter>i. {x\<in>\<Omega>. P i x})" by auto
   with assms show ?thesis by auto
 qed
 
 lemma (in sigma_algebra) sets_Collect_countable_Ex:
   assumes "\<And>i. {x\<in>\<Omega>. P i x} \<in> M"
   shows "{x\<in>\<Omega>. \<exists>i::'i::countable. P i x} \<in> M"
 proof -
   have "{x\<in>\<Omega>. \<exists>i::'i::countable. P i x} = (\<Union>i. {x\<in>\<Omega>. P i x})" by auto
   with assms show ?thesis by auto
 qed
 
 lemma (in sigma_algebra) sets_Collect_countable_Ex':
   assumes "\<And>i. i \<in> I \<Longrightarrow> {x\<in>\<Omega>. P i x} \<in> M"
   assumes "countable I"
   shows "{x\<in>\<Omega>. \<exists>i\<in>I. P i x} \<in> M"
 proof -
   have "{x\<in>\<Omega>. \<exists>i\<in>I. P i x} = (\<Union>i\<in>I. {x\<in>\<Omega>. P i x})" by auto
   with assms show ?thesis
     by (auto intro!: countable_UN')
 qed
 
 lemma (in sigma_algebra) sets_Collect_countable_All':
   assumes "\<And>i. i \<in> I \<Longrightarrow> {x\<in>\<Omega>. P i x} \<in> M"
   assumes "countable I"
   shows "{x\<in>\<Omega>. \<forall>i\<in>I. P i x} \<in> M"
 proof -
   have "{x\<in>\<Omega>. \<forall>i\<in>I. P i x} = (\<Inter>i\<in>I. {x\<in>\<Omega>. P i x}) \<inter> \<Omega>" by auto
   with assms show ?thesis
     by (cases "I = {}") (auto intro!: countable_INT')
 qed
 
 lemma (in sigma_algebra) sets_Collect_countable_Ex1':
   assumes "\<And>i. i \<in> I \<Longrightarrow> {x\<in>\<Omega>. P i x} \<in> M"
   assumes "countable I"
   shows "{x\<in>\<Omega>. \<exists>!i\<in>I. P i x} \<in> M"
 proof -
   have "{x\<in>\<Omega>. \<exists>!i\<in>I. P i x} = {x\<in>\<Omega>. \<exists>i\<in>I. P i x \<and> (\<forall>j\<in>I. P j x \<longrightarrow> i = j)}"
     by auto
   with assms show ?thesis
     by (auto intro!: sets_Collect_countable_All' sets_Collect_countable_Ex' sets_Collect_conj sets_Collect_imp sets_Collect_const)
 qed
 
 lemmas (in sigma_algebra) sets_Collect =
   sets_Collect_imp sets_Collect_disj sets_Collect_conj sets_Collect_neg sets_Collect_const
   sets_Collect_countable_All sets_Collect_countable_Ex sets_Collect_countable_All
 
 lemma (in sigma_algebra) sets_Collect_countable_Ball:
   assumes "\<And>i. {x\<in>\<Omega>. P i x} \<in> M"
   shows "{x\<in>\<Omega>. \<forall>i::'i::countable\<in>X. P i x} \<in> M"
   unfolding Ball_def by (intro sets_Collect assms)
 
 lemma (in sigma_algebra) sets_Collect_countable_Bex:
   assumes "\<And>i. {x\<in>\<Omega>. P i x} \<in> M"
   shows "{x\<in>\<Omega>. \<exists>i::'i::countable\<in>X. P i x} \<in> M"
   unfolding Bex_def by (intro sets_Collect assms)
 
 lemma sigma_algebra_single_set:
   assumes "X \<subseteq> S"
   shows "sigma_algebra S { {}, X, S - X, S }"
   using algebra.is_sigma_algebra[OF algebra_single_set[OF \<open>X \<subseteq> S\<close>]] by simp
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Binary Unions\<close>
 
 definition binary :: "'a \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a"
   where "binary a b =  (\<lambda>x. b)(0 := a)"
 
 lemma range_binary_eq: "range(binary a b) = {a,b}"
   by (auto simp add: binary_def)
 
 lemma Un_range_binary: "a \<union> b = (\<Union>i::nat. binary a b i)"
   by (simp add: range_binary_eq cong del: SUP_cong_simp)
 
 lemma Int_range_binary: "a \<inter> b = (\<Inter>i::nat. binary a b i)"
   by (simp add: range_binary_eq cong del: INF_cong_simp)
 
 lemma sigma_algebra_iff2:
   "sigma_algebra \<Omega> M \<longleftrightarrow>
     M \<subseteq> Pow \<Omega> \<and> {} \<in> M \<and> (\<forall>s \<in> M. \<Omega> - s \<in> M)
     \<and> (\<forall>A. range A \<subseteq> M \<longrightarrow>(\<Union> i::nat. A i) \<in> M)" (is "?P \<longleftrightarrow> ?R \<and> ?S \<and> ?V \<and> ?W")
 proof
   assume ?P
   then interpret sigma_algebra \<Omega> M .
   from space_closed show "?R \<and> ?S \<and> ?V \<and> ?W"
     by auto
 next
   assume "?R \<and> ?S \<and> ?V \<and> ?W"
   then have ?R ?S ?V ?W
     by simp_all
   show ?P
   proof (rule sigma_algebra.intro)
     show "sigma_algebra_axioms M"
       by standard (use \<open>?W\<close> in simp)
     from \<open>?W\<close> have *: "range (binary a b) \<subseteq> M \<Longrightarrow> \<Union> (range (binary a b)) \<in> M" for a b
       by auto
     show "algebra \<Omega> M"
       unfolding algebra_iff_Un using \<open>?R\<close> \<open>?S\<close> \<open>?V\<close> *
       by (auto simp add: range_binary_eq)
   qed
 qed
 
 
 subsubsection \<open>Initial Sigma Algebra\<close>
 
 text\<^marker>\<open>tag important\<close> \<open>Sigma algebras can naturally be created as the closure of any set of
   M with regard to the properties just postulated.\<close>
 
 inductive_set\<^marker>\<open>tag important\<close> sigma_sets :: "'a set \<Rightarrow> 'a set set \<Rightarrow> 'a set set"
   for sp :: "'a set" and A :: "'a set set"
   where
     Basic[intro, simp]: "a \<in> A \<Longrightarrow> a \<in> sigma_sets sp A"
   | Empty: "{} \<in> sigma_sets sp A"
   | Compl: "a \<in> sigma_sets sp A \<Longrightarrow> sp - a \<in> sigma_sets sp A"
   | Union: "(\<And>i::nat. a i \<in> sigma_sets sp A) \<Longrightarrow> (\<Union>i. a i) \<in> sigma_sets sp A"
 
 lemma (in sigma_algebra) sigma_sets_subset:
   assumes a: "a \<subseteq> M"
   shows "sigma_sets \<Omega> a \<subseteq> M"
 proof
   fix x
   assume "x \<in> sigma_sets \<Omega> a"
   from this show "x \<in> M"
     by (induct rule: sigma_sets.induct, auto) (metis a subsetD)
 qed
 
 lemma sigma_sets_into_sp: "A \<subseteq> Pow sp \<Longrightarrow> x \<in> sigma_sets sp A \<Longrightarrow> x \<subseteq> sp"
   by (erule sigma_sets.induct, auto)
 
 lemma sigma_algebra_sigma_sets:
      "a \<subseteq> Pow \<Omega> \<Longrightarrow> sigma_algebra \<Omega> (sigma_sets \<Omega> a)"
   by (auto simp add: sigma_algebra_iff2 dest: sigma_sets_into_sp
            intro!: sigma_sets.Union sigma_sets.Empty sigma_sets.Compl)
 
 lemma sigma_sets_least_sigma_algebra:
   assumes "A \<subseteq> Pow S"
   shows "sigma_sets S A = \<Inter>{B. A \<subseteq> B \<and> sigma_algebra S B}"
 proof safe
   fix B X assume "A \<subseteq> B" and sa: "sigma_algebra S B"
     and X: "X \<in> sigma_sets S A"
   from sigma_algebra.sigma_sets_subset[OF sa, simplified, OF \<open>A \<subseteq> B\<close>] X
   show "X \<in> B" by auto
 next
   fix X assume "X \<in> \<Inter>{B. A \<subseteq> B \<and> sigma_algebra S B}"
   then have [intro!]: "\<And>B. A \<subseteq> B \<Longrightarrow> sigma_algebra S B \<Longrightarrow> X \<in> B"
      by simp
   have "A \<subseteq> sigma_sets S A" using assms by auto
   moreover have "sigma_algebra S (sigma_sets S A)"
     using assms by (intro sigma_algebra_sigma_sets[of A]) auto
   ultimately show "X \<in> sigma_sets S A" by auto
 qed
 
 lemma sigma_sets_top: "sp \<in> sigma_sets sp A"
   by (metis Diff_empty sigma_sets.Compl sigma_sets.Empty)
 
 lemma binary_in_sigma_sets:
   "binary a b i \<in> sigma_sets sp A" if "a \<in> sigma_sets sp A" and "b \<in> sigma_sets sp A"
   using that by (simp add: binary_def)
 
 lemma sigma_sets_Un:
   "a \<union> b \<in> sigma_sets sp A" if "a \<in> sigma_sets sp A" and "b \<in> sigma_sets sp A"
   using that by (simp add: Un_range_binary binary_in_sigma_sets Union)
 
 lemma sigma_sets_Inter:
   assumes Asb: "A \<subseteq> Pow sp"
   shows "(\<And>i::nat. a i \<in> sigma_sets sp A) \<Longrightarrow> (\<Inter>i. a i) \<in> sigma_sets sp A"
 proof -
   assume ai: "\<And>i::nat. a i \<in> sigma_sets sp A"
   hence "\<And>i::nat. sp-(a i) \<in> sigma_sets sp A"
     by (rule sigma_sets.Compl)
   hence "(\<Union>i. sp-(a i)) \<in> sigma_sets sp A"
     by (rule sigma_sets.Union)
   hence "sp-(\<Union>i. sp-(a i)) \<in> sigma_sets sp A"
     by (rule sigma_sets.Compl)
   also have "sp-(\<Union>i. sp-(a i)) = sp Int (\<Inter>i. a i)"
     by auto
   also have "... = (\<Inter>i. a i)" using ai
     by (blast dest: sigma_sets_into_sp [OF Asb])
   finally show ?thesis .
 qed
 
 lemma sigma_sets_INTER:
   assumes Asb: "A \<subseteq> Pow sp"
       and ai: "\<And>i::nat. i \<in> S \<Longrightarrow> a i \<in> sigma_sets sp A" and non: "S \<noteq> {}"
   shows "(\<Inter>i\<in>S. a i) \<in> sigma_sets sp A"
 proof -
   from ai have "\<And>i. (if i\<in>S then a i else sp) \<in> sigma_sets sp A"
     by (simp add: sigma_sets.intros(2-) sigma_sets_top)
   hence "(\<Inter>i. (if i\<in>S then a i else sp)) \<in> sigma_sets sp A"
     by (rule sigma_sets_Inter [OF Asb])
   also have "(\<Inter>i. (if i\<in>S then a i else sp)) = (\<Inter>i\<in>S. a i)"
     by auto (metis ai non sigma_sets_into_sp subset_empty subset_iff Asb)+
   finally show ?thesis .
 qed
 
 lemma sigma_sets_UNION:
   "countable B \<Longrightarrow> (\<And>b. b \<in> B \<Longrightarrow> b \<in> sigma_sets X A) \<Longrightarrow> \<Union> B \<in> sigma_sets X A"
   using from_nat_into [of B] range_from_nat_into [of B] sigma_sets.Union [of "from_nat_into B" X A]
   by (cases "B = {}") (simp_all add: sigma_sets.Empty cong del: SUP_cong)
 
 lemma (in sigma_algebra) sigma_sets_eq:
      "sigma_sets \<Omega> M = M"
 proof
   show "M \<subseteq> sigma_sets \<Omega> M"
     by (metis Set.subsetI sigma_sets.Basic)
   next
   show "sigma_sets \<Omega> M \<subseteq> M"
     by (metis sigma_sets_subset subset_refl)
 qed
 
 lemma sigma_sets_eqI:
   assumes A: "\<And>a. a \<in> A \<Longrightarrow> a \<in> sigma_sets M B"
   assumes B: "\<And>b. b \<in> B \<Longrightarrow> b \<in> sigma_sets M A"
   shows "sigma_sets M A = sigma_sets M B"
 proof (intro set_eqI iffI)
   fix a assume "a \<in> sigma_sets M A"
   from this A show "a \<in> sigma_sets M B"
     by induct (auto intro!: sigma_sets.intros(2-) del: sigma_sets.Basic)
 next
   fix b assume "b \<in> sigma_sets M B"
   from this B show "b \<in> sigma_sets M A"
     by induct (auto intro!: sigma_sets.intros(2-) del: sigma_sets.Basic)
 qed
 
 lemma sigma_sets_subseteq: assumes "A \<subseteq> B" shows "sigma_sets X A \<subseteq> sigma_sets X B"
 proof
   fix x assume "x \<in> sigma_sets X A" then show "x \<in> sigma_sets X B"
     by induct (insert \<open>A \<subseteq> B\<close>, auto intro: sigma_sets.intros(2-))
 qed
 
 lemma sigma_sets_mono: assumes "A \<subseteq> sigma_sets X B" shows "sigma_sets X A \<subseteq> sigma_sets X B"
 proof
   fix x assume "x \<in> sigma_sets X A" then show "x \<in> sigma_sets X B"
     by induct (insert \<open>A \<subseteq> sigma_sets X B\<close>, auto intro: sigma_sets.intros(2-))
 qed
 
 lemma sigma_sets_mono': assumes "A \<subseteq> B" shows "sigma_sets X A \<subseteq> sigma_sets X B"
 proof
   fix x assume "x \<in> sigma_sets X A" then show "x \<in> sigma_sets X B"
     by induct (insert \<open>A \<subseteq> B\<close>, auto intro: sigma_sets.intros(2-))
 qed
 
 lemma sigma_sets_superset_generator: "A \<subseteq> sigma_sets X A"
   by (auto intro: sigma_sets.Basic)
 
 lemma (in sigma_algebra) restriction_in_sets:
   fixes A :: "nat \<Rightarrow> 'a set"
   assumes "S \<in> M"
   and *: "range A \<subseteq> (\<lambda>A. S \<inter> A) ` M" (is "_ \<subseteq> ?r")
   shows "range A \<subseteq> M" "(\<Union>i. A i) \<in> (\<lambda>A. S \<inter> A) ` M"
 proof -
   { fix i have "A i \<in> ?r" using * by auto
     hence "\<exists>B. A i = B \<inter> S \<and> B \<in> M" by auto
     hence "A i \<subseteq> S" "A i \<in> M" using \<open>S \<in> M\<close> by auto }
   thus "range A \<subseteq> M" "(\<Union>i. A i) \<in> (\<lambda>A. S \<inter> A) ` M"
     by (auto intro!: image_eqI[of _ _ "(\<Union>i. A i)"])
 qed
 
 lemma (in sigma_algebra) restricted_sigma_algebra:
   assumes "S \<in> M"
   shows "sigma_algebra S (restricted_space S)"
   unfolding sigma_algebra_def sigma_algebra_axioms_def
 proof safe
   show "algebra S (restricted_space S)" using restricted_algebra[OF assms] .
 next
   fix A :: "nat \<Rightarrow> 'a set" assume "range A \<subseteq> restricted_space S"
   from restriction_in_sets[OF assms this[simplified]]
   show "(\<Union>i. A i) \<in> restricted_space S" by simp
 qed
 
 lemma sigma_sets_Int:
   assumes "A \<in> sigma_sets sp st" "A \<subseteq> sp"
   shows "(\<inter>) A ` sigma_sets sp st = sigma_sets A ((\<inter>) A ` st)"
 proof (intro equalityI subsetI)
   fix x assume "x \<in> (\<inter>) A ` sigma_sets sp st"
   then obtain y where "y \<in> sigma_sets sp st" "x = y \<inter> A" by auto
   then have "x \<in> sigma_sets (A \<inter> sp) ((\<inter>) A ` st)"
   proof (induct arbitrary: x)
     case (Compl a)
     then show ?case
       by (force intro!: sigma_sets.Compl simp: Diff_Int_distrib ac_simps)
   next
     case (Union a)
     then show ?case
       by (auto intro!: sigma_sets.Union
                simp add: UN_extend_simps simp del: UN_simps)
   qed (auto intro!: sigma_sets.intros(2-))
   then show "x \<in> sigma_sets A ((\<inter>) A ` st)"
     using \<open>A \<subseteq> sp\<close> by (simp add: Int_absorb2)
 next
   fix x assume "x \<in> sigma_sets A ((\<inter>) A ` st)"
   then show "x \<in> (\<inter>) A ` sigma_sets sp st"
   proof induct
     case (Compl a)
     then obtain x where "a = A \<inter> x" "x \<in> sigma_sets sp st" by auto
     then show ?case using \<open>A \<subseteq> sp\<close>
       by (force simp add: image_iff intro!: bexI[of _ "sp - x"] sigma_sets.Compl)
   next
     case (Union a)
     then have "\<forall>i. \<exists>x. x \<in> sigma_sets sp st \<and> a i = A \<inter> x"
       by (auto simp: image_iff Bex_def)
-    from choice[OF this] guess f ..
+    then obtain f where "\<forall>x. f x \<in> sigma_sets sp st \<and> a x = A \<inter> f x"
+      by metis
     then show ?case
       by (auto intro!: bexI[of _ "(\<Union>x. f x)"] sigma_sets.Union
                simp add: image_iff)
   qed (auto intro!: sigma_sets.intros(2-))
 qed
 
 lemma sigma_sets_empty_eq: "sigma_sets A {} = {{}, A}"
 proof (intro set_eqI iffI)
   fix a assume "a \<in> sigma_sets A {}" then show "a \<in> {{}, A}"
     by induct blast+
 qed (auto intro: sigma_sets.Empty sigma_sets_top)
 
 lemma sigma_sets_single[simp]: "sigma_sets A {A} = {{}, A}"
 proof (intro set_eqI iffI)
   fix x assume "x \<in> sigma_sets A {A}"
   then show "x \<in> {{}, A}"
     by induct blast+
 next
   fix x assume "x \<in> {{}, A}"
   then show "x \<in> sigma_sets A {A}"
     by (auto intro: sigma_sets.Empty sigma_sets_top)
 qed
 
 lemma sigma_sets_sigma_sets_eq:
   "M \<subseteq> Pow S \<Longrightarrow> sigma_sets S (sigma_sets S M) = sigma_sets S M"
   by (rule sigma_algebra.sigma_sets_eq[OF sigma_algebra_sigma_sets, of M S]) auto
 
 lemma sigma_sets_singleton:
   assumes "X \<subseteq> S"
   shows "sigma_sets S { X } = { {}, X, S - X, S }"
 proof -
   interpret sigma_algebra S "{ {}, X, S - X, S }"
     by (rule sigma_algebra_single_set) fact
   have "sigma_sets S { X } \<subseteq> sigma_sets S { {}, X, S - X, S }"
     by (rule sigma_sets_subseteq) simp
   moreover have "\<dots> = { {}, X, S - X, S }"
     using sigma_sets_eq by simp
   moreover
   { fix A assume "A \<in> { {}, X, S - X, S }"
     then have "A \<in> sigma_sets S { X }"
       by (auto intro: sigma_sets.intros(2-) sigma_sets_top) }
   ultimately have "sigma_sets S { X } = sigma_sets S { {}, X, S - X, S }"
     by (intro antisym) auto
   with sigma_sets_eq show ?thesis by simp
 qed
 
 lemma restricted_sigma:
   assumes S: "S \<in> sigma_sets \<Omega> M" and M: "M \<subseteq> Pow \<Omega>"
   shows "algebra.restricted_space (sigma_sets \<Omega> M) S =
     sigma_sets S (algebra.restricted_space M S)"
 proof -
   from S sigma_sets_into_sp[OF M]
   have "S \<in> sigma_sets \<Omega> M" "S \<subseteq> \<Omega>" by auto
   from sigma_sets_Int[OF this]
   show ?thesis by simp
 qed
 
 lemma sigma_sets_vimage_commute:
   assumes X: "X \<in> \<Omega> \<rightarrow> \<Omega>'"
   shows "{X -` A \<inter> \<Omega> |A. A \<in> sigma_sets \<Omega>' M'}
        = sigma_sets \<Omega> {X -` A \<inter> \<Omega> |A. A \<in> M'}" (is "?L = ?R")
 proof
   show "?L \<subseteq> ?R"
   proof clarify
     fix A assume "A \<in> sigma_sets \<Omega>' M'"
     then show "X -` A \<inter> \<Omega> \<in> ?R"
     proof induct
       case Empty then show ?case
         by (auto intro!: sigma_sets.Empty)
     next
       case (Compl B)
       have [simp]: "X -` (\<Omega>' - B) \<inter> \<Omega> = \<Omega> - (X -` B \<inter> \<Omega>)"
         by (auto simp add: funcset_mem [OF X])
       with Compl show ?case
         by (auto intro!: sigma_sets.Compl)
     next
       case (Union F)
       then show ?case
         by (auto simp add: vimage_UN UN_extend_simps(4) simp del: UN_simps
                  intro!: sigma_sets.Union)
     qed auto
   qed
   show "?R \<subseteq> ?L"
   proof clarify
     fix A assume "A \<in> ?R"
     then show "\<exists>B. A = X -` B \<inter> \<Omega> \<and> B \<in> sigma_sets \<Omega>' M'"
     proof induct
       case (Basic B) then show ?case by auto
     next
       case Empty then show ?case
         by (auto intro!: sigma_sets.Empty exI[of _ "{}"])
     next
       case (Compl B)
       then obtain A where A: "B = X -` A \<inter> \<Omega>" "A \<in> sigma_sets \<Omega>' M'" by auto
       then have [simp]: "\<Omega> - B = X -` (\<Omega>' - A) \<inter> \<Omega>"
         by (auto simp add: funcset_mem [OF X])
       with A(2) show ?case
         by (auto intro: sigma_sets.Compl)
     next
       case (Union F)
       then have "\<forall>i. \<exists>B. F i = X -` B \<inter> \<Omega> \<and> B \<in> sigma_sets \<Omega>' M'" by auto
-      from choice[OF this] guess A .. note A = this
-      with A show ?case
+      then obtain A where "\<forall>x. F x = X -` A x \<inter> \<Omega> \<and> A x \<in> sigma_sets \<Omega>' M'"
+        by metis
+      then show ?case
         by (auto simp: vimage_UN[symmetric] intro: sigma_sets.Union)
     qed
   qed
 qed
 
 lemma (in ring_of_sets) UNION_in_sets:
   fixes A:: "nat \<Rightarrow> 'a set"
   assumes A: "range A \<subseteq> M"
   shows  "(\<Union>i\<in>{0..<n}. A i) \<in> M"
 proof (induct n)
   case 0 show ?case by simp
 next
   case (Suc n)
   thus ?case
     by (simp add: atLeastLessThanSuc) (metis A Un UNIV_I image_subset_iff)
 qed
 
 lemma (in ring_of_sets) range_disjointed_sets:
   assumes A: "range A \<subseteq> M"
   shows  "range (disjointed A) \<subseteq> M"
 proof (auto simp add: disjointed_def)
   fix n
   show "A n - (\<Union>i\<in>{0..<n}. A i) \<in> M" using UNION_in_sets
     by (metis A Diff UNIV_I image_subset_iff)
 qed
 
 lemma (in algebra) range_disjointed_sets':
   "range A \<subseteq> M \<Longrightarrow> range (disjointed A) \<subseteq> M"
   using range_disjointed_sets .
 
 lemma sigma_algebra_disjoint_iff:
   "sigma_algebra \<Omega> M \<longleftrightarrow> algebra \<Omega> M \<and>
     (\<forall>A. range A \<subseteq> M \<longrightarrow> disjoint_family A \<longrightarrow> (\<Union>i::nat. A i) \<in> M)"
 proof (auto simp add: sigma_algebra_iff)
   fix A :: "nat \<Rightarrow> 'a set"
   assume M: "algebra \<Omega> M"
      and A: "range A \<subseteq> M"
      and UnA: "\<forall>A. range A \<subseteq> M \<longrightarrow> disjoint_family A \<longrightarrow> (\<Union>i::nat. A i) \<in> M"
   hence "range (disjointed A) \<subseteq> M \<longrightarrow>
          disjoint_family (disjointed A) \<longrightarrow>
          (\<Union>i. disjointed A i) \<in> M" by blast
   hence "(\<Union>i. disjointed A i) \<in> M"
     by (simp add: algebra.range_disjointed_sets'[of \<Omega>] M A disjoint_family_disjointed)
   thus "(\<Union>i::nat. A i) \<in> M" by (simp add: UN_disjointed_eq)
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Ring generated by a semiring\<close>
 
 definition (in semiring_of_sets) generated_ring :: "'a set set" where
   "generated_ring = { \<Union>C | C. C \<subseteq> M \<and> finite C \<and> disjoint C }"
 
 lemma (in semiring_of_sets) generated_ringE[elim?]:
   assumes "a \<in> generated_ring"
   obtains C where "finite C" "disjoint C" "C \<subseteq> M" "a = \<Union>C"
   using assms unfolding generated_ring_def by auto
 
 lemma (in semiring_of_sets) generated_ringI[intro?]:
   assumes "finite C" "disjoint C" "C \<subseteq> M" "a = \<Union>C"
   shows "a \<in> generated_ring"
   using assms unfolding generated_ring_def by auto
 
 lemma (in semiring_of_sets) generated_ringI_Basic:
   "A \<in> M \<Longrightarrow> A \<in> generated_ring"
   by (rule generated_ringI[of "{A}"]) (auto simp: disjoint_def)
 
 lemma (in semiring_of_sets) generated_ring_disjoint_Un[intro]:
   assumes a: "a \<in> generated_ring" and b: "b \<in> generated_ring"
   and "a \<inter> b = {}"
   shows "a \<union> b \<in> generated_ring"
 proof -
-  from a guess Ca .. note Ca = this
-  from b guess Cb .. note Cb = this
+  from a b obtain Ca Cb
+    where Ca: "finite Ca" "disjoint Ca" "Ca \<subseteq> M" "a = \<Union> Ca"
+      and Cb: "finite Cb" "disjoint Cb" "Cb \<subseteq> M" "b = \<Union> Cb"
+    using generated_ringE by metis
   show ?thesis
   proof
-    show "disjoint (Ca \<union> Cb)"
-      using \<open>a \<inter> b = {}\<close> Ca Cb by (auto intro!: disjoint_union)
-  qed (insert Ca Cb, auto)
+    from \<open>a \<inter> b = {}\<close> Ca Cb show "disjoint (Ca \<union> Cb)"
+      by (auto intro!: disjoint_union)
+  qed (use Ca Cb in auto)
 qed
 
 lemma (in semiring_of_sets) generated_ring_empty: "{} \<in> generated_ring"
   by (auto simp: generated_ring_def disjoint_def)
 
 lemma (in semiring_of_sets) generated_ring_disjoint_Union:
   assumes "finite A" shows "A \<subseteq> generated_ring \<Longrightarrow> disjoint A \<Longrightarrow> \<Union>A \<in> generated_ring"
   using assms by (induct A) (auto simp: disjoint_def intro!: generated_ring_disjoint_Un generated_ring_empty)
 
 lemma (in semiring_of_sets) generated_ring_disjoint_UNION:
   "finite I \<Longrightarrow> disjoint (A ` I) \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> A i \<in> generated_ring) \<Longrightarrow> \<Union>(A ` I) \<in> generated_ring"
   by (intro generated_ring_disjoint_Union) auto
 
 lemma (in semiring_of_sets) generated_ring_Int:
   assumes a: "a \<in> generated_ring" and b: "b \<in> generated_ring"
   shows "a \<inter> b \<in> generated_ring"
 proof -
-  from a guess Ca .. note Ca = this
-  from b guess Cb .. note Cb = this
+  from a b obtain Ca Cb
+    where Ca: "finite Ca" "disjoint Ca" "Ca \<subseteq> M" "a = \<Union> Ca"
+      and Cb: "finite Cb" "disjoint Cb" "Cb \<subseteq> M" "b = \<Union> Cb"
+    using generated_ringE by metis
   define C where "C = (\<lambda>(a,b). a \<inter> b)` (Ca\<times>Cb)"
   show ?thesis
   proof
     show "disjoint C"
     proof (simp add: disjoint_def C_def, intro ballI impI)
       fix a1 b1 a2 b2 assume sets: "a1 \<in> Ca" "b1 \<in> Cb" "a2 \<in> Ca" "b2 \<in> Cb"
       assume "a1 \<inter> b1 \<noteq> a2 \<inter> b2"
       then have "a1 \<noteq> a2 \<or> b1 \<noteq> b2" by auto
       then show "(a1 \<inter> b1) \<inter> (a2 \<inter> b2) = {}"
       proof
         assume "a1 \<noteq> a2"
         with sets Ca have "a1 \<inter> a2 = {}"
           by (auto simp: disjoint_def)
         then show ?thesis by auto
       next
         assume "b1 \<noteq> b2"
         with sets Cb have "b1 \<inter> b2 = {}"
           by (auto simp: disjoint_def)
         then show ?thesis by auto
       qed
     qed
-  qed (insert Ca Cb, auto simp: C_def)
+  qed (use Ca Cb in \<open>auto simp: C_def\<close>)
 qed
 
 lemma (in semiring_of_sets) generated_ring_Inter:
   assumes "finite A" "A \<noteq> {}" shows "A \<subseteq> generated_ring \<Longrightarrow> \<Inter>A \<in> generated_ring"
   using assms by (induct A rule: finite_ne_induct) (auto intro: generated_ring_Int)
 
 lemma (in semiring_of_sets) generated_ring_INTER:
   "finite I \<Longrightarrow> I \<noteq> {} \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> A i \<in> generated_ring) \<Longrightarrow> \<Inter>(A ` I) \<in> generated_ring"
   by (intro generated_ring_Inter) auto
 
 lemma (in semiring_of_sets) generating_ring:
   "ring_of_sets \<Omega> generated_ring"
 proof (rule ring_of_setsI)
   let ?R = generated_ring
   show "?R \<subseteq> Pow \<Omega>"
     using sets_into_space by (auto simp: generated_ring_def generated_ring_empty)
   show "{} \<in> ?R" by (rule generated_ring_empty)
 
-  { fix a assume a: "a \<in> ?R" then guess Ca .. note Ca = this
-    fix b assume b: "b \<in> ?R" then guess Cb .. note Cb = this
-
+  {
+    fix a b assume "a \<in> ?R" "b \<in> ?R"
+    then obtain Ca Cb
+      where Ca: "finite Ca" "disjoint Ca" "Ca \<subseteq> M" "a = \<Union> Ca"
+        and Cb: "finite Cb" "disjoint Cb" "Cb \<subseteq> M" "b = \<Union> Cb"
+      using generated_ringE by metis
     show "a - b \<in> ?R"
     proof cases
       assume "Cb = {}" with Cb \<open>a \<in> ?R\<close> show ?thesis
         by simp
     next
       assume "Cb \<noteq> {}"
       with Ca Cb have "a - b = (\<Union>a'\<in>Ca. \<Inter>b'\<in>Cb. a' - b')" by auto
       also have "\<dots> \<in> ?R"
       proof (intro generated_ring_INTER generated_ring_disjoint_UNION)
         fix a b assume "a \<in> Ca" "b \<in> Cb"
         with Ca Cb Diff_cover[of a b] show "a - b \<in> ?R"
           by (auto simp add: generated_ring_def)
             (metis DiffI Diff_eq_empty_iff empty_iff)
       next
         show "disjoint ((\<lambda>a'. \<Inter>b'\<in>Cb. a' - b')`Ca)"
           using Ca by (auto simp add: disjoint_def \<open>Cb \<noteq> {}\<close>)
       next
         show "finite Ca" "finite Cb" "Cb \<noteq> {}" by fact+
       qed
       finally show "a - b \<in> ?R" .
-    qed }
+    qed
+  }
   note Diff = this
 
   fix a b assume sets: "a \<in> ?R" "b \<in> ?R"
   have "a \<union> b = (a - b) \<union> (a \<inter> b) \<union> (b - a)" by auto
   also have "\<dots> \<in> ?R"
     by (intro sets generated_ring_disjoint_Un generated_ring_Int Diff) auto
   finally show "a \<union> b \<in> ?R" .
 qed
 
 lemma (in semiring_of_sets) sigma_sets_generated_ring_eq: "sigma_sets \<Omega> generated_ring = sigma_sets \<Omega> M"
 proof
   interpret M: sigma_algebra \<Omega> "sigma_sets \<Omega> M"
     using space_closed by (rule sigma_algebra_sigma_sets)
   show "sigma_sets \<Omega> generated_ring \<subseteq> sigma_sets \<Omega> M"
     by (blast intro!: sigma_sets_mono elim: generated_ringE)
 qed (auto intro!: generated_ringI_Basic sigma_sets_mono)
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>A Two-Element Series\<close>
 
 definition binaryset :: "'a set \<Rightarrow> 'a set \<Rightarrow> nat \<Rightarrow> 'a set"
   where "binaryset A B = (\<lambda>x. {})(0 := A, Suc 0 := B)"
 
 lemma range_binaryset_eq: "range(binaryset A B) = {A,B,{}}"
   apply (simp add: binaryset_def)
   apply (rule set_eqI)
   apply (auto simp add: image_iff)
   done
 
 lemma UN_binaryset_eq: "(\<Union>i. binaryset A B i) = A \<union> B"
   by (simp add: range_binaryset_eq cong del: SUP_cong_simp)
 
 subsubsection \<open>Closed CDI\<close>
 
 definition\<^marker>\<open>tag important\<close> closed_cdi :: "'a set \<Rightarrow> 'a set set \<Rightarrow> bool" where
   "closed_cdi \<Omega> M \<longleftrightarrow>
    M \<subseteq> Pow \<Omega> &
    (\<forall>s \<in> M. \<Omega> - s \<in> M) &
    (\<forall>A. (range A \<subseteq> M) & (A 0 = {}) & (\<forall>n. A n \<subseteq> A (Suc n)) \<longrightarrow>
         (\<Union>i. A i) \<in> M) &
    (\<forall>A. (range A \<subseteq> M) & disjoint_family A \<longrightarrow> (\<Union>i::nat. A i) \<in> M)"
 
 inductive_set
   smallest_ccdi_sets :: "'a set \<Rightarrow> 'a set set \<Rightarrow> 'a set set"
   for \<Omega> M
   where
     Basic [intro]:
       "a \<in> M \<Longrightarrow> a \<in> smallest_ccdi_sets \<Omega> M"
   | Compl [intro]:
       "a \<in> smallest_ccdi_sets \<Omega> M \<Longrightarrow> \<Omega> - a \<in> smallest_ccdi_sets \<Omega> M"
   | Inc:
       "range A \<in> Pow(smallest_ccdi_sets \<Omega> M) \<Longrightarrow> A 0 = {} \<Longrightarrow> (\<And>n. A n \<subseteq> A (Suc n))
        \<Longrightarrow> (\<Union>i. A i) \<in> smallest_ccdi_sets \<Omega> M"
   | Disj:
       "range A \<in> Pow(smallest_ccdi_sets \<Omega> M) \<Longrightarrow> disjoint_family A
        \<Longrightarrow> (\<Union>i::nat. A i) \<in> smallest_ccdi_sets \<Omega> M"
 
 lemma (in subset_class) smallest_closed_cdi1: "M \<subseteq> smallest_ccdi_sets \<Omega> M"
   by auto
 
 lemma (in subset_class) smallest_ccdi_sets: "smallest_ccdi_sets \<Omega> M \<subseteq> Pow \<Omega>"
   apply (rule subsetI)
   apply (erule smallest_ccdi_sets.induct)
   apply (auto intro: range_subsetD dest: sets_into_space)
   done
 
 lemma (in subset_class) smallest_closed_cdi2: "closed_cdi \<Omega> (smallest_ccdi_sets \<Omega> M)"
   apply (auto simp add: closed_cdi_def smallest_ccdi_sets)
   apply (blast intro: smallest_ccdi_sets.Inc smallest_ccdi_sets.Disj) +
   done
 
 lemma closed_cdi_subset: "closed_cdi \<Omega> M \<Longrightarrow> M \<subseteq> Pow \<Omega>"
   by (simp add: closed_cdi_def)
 
 lemma closed_cdi_Compl: "closed_cdi \<Omega> M \<Longrightarrow> s \<in> M \<Longrightarrow> \<Omega> - s \<in> M"
   by (simp add: closed_cdi_def)
 
 lemma closed_cdi_Inc:
   "closed_cdi \<Omega> M \<Longrightarrow> range A \<subseteq> M \<Longrightarrow> A 0 = {} \<Longrightarrow> (!!n. A n \<subseteq> A (Suc n)) \<Longrightarrow> (\<Union>i. A i) \<in> M"
   by (simp add: closed_cdi_def)
 
 lemma closed_cdi_Disj:
   "closed_cdi \<Omega> M \<Longrightarrow> range A \<subseteq> M \<Longrightarrow> disjoint_family A \<Longrightarrow> (\<Union>i::nat. A i) \<in> M"
   by (simp add: closed_cdi_def)
 
 lemma closed_cdi_Un:
   assumes cdi: "closed_cdi \<Omega> M" and empty: "{} \<in> M"
       and A: "A \<in> M" and B: "B \<in> M"
       and disj: "A \<inter> B = {}"
     shows "A \<union> B \<in> M"
 proof -
   have ra: "range (binaryset A B) \<subseteq> M"
    by (simp add: range_binaryset_eq empty A B)
  have di:  "disjoint_family (binaryset A B)" using disj
    by (simp add: disjoint_family_on_def binaryset_def Int_commute)
  from closed_cdi_Disj [OF cdi ra di]
  show ?thesis
    by (simp add: UN_binaryset_eq)
 qed
 
 lemma (in algebra) smallest_ccdi_sets_Un:
   assumes A: "A \<in> smallest_ccdi_sets \<Omega> M" and B: "B \<in> smallest_ccdi_sets \<Omega> M"
       and disj: "A \<inter> B = {}"
     shows "A \<union> B \<in> smallest_ccdi_sets \<Omega> M"
 proof -
   have ra: "range (binaryset A B) \<in> Pow (smallest_ccdi_sets \<Omega> M)"
     by (simp add: range_binaryset_eq  A B smallest_ccdi_sets.Basic)
   have di:  "disjoint_family (binaryset A B)" using disj
     by (simp add: disjoint_family_on_def binaryset_def Int_commute)
   from Disj [OF ra di]
   show ?thesis
     by (simp add: UN_binaryset_eq)
 qed
 
 lemma (in algebra) smallest_ccdi_sets_Int1:
   assumes a: "a \<in> M"
   shows "b \<in> smallest_ccdi_sets \<Omega> M \<Longrightarrow> a \<inter> b \<in> smallest_ccdi_sets \<Omega> M"
 proof (induct rule: smallest_ccdi_sets.induct)
   case (Basic x)
   thus ?case
     by (metis a Int smallest_ccdi_sets.Basic)
 next
   case (Compl x)
   have "a \<inter> (\<Omega> - x) = \<Omega> - ((\<Omega> - a) \<union> (a \<inter> x))"
     by blast
   also have "... \<in> smallest_ccdi_sets \<Omega> M"
     by (metis smallest_ccdi_sets.Compl a Compl(2) Diff_Int2 Diff_Int_distrib2
            Diff_disjoint Int_Diff Int_empty_right smallest_ccdi_sets_Un
            smallest_ccdi_sets.Basic smallest_ccdi_sets.Compl)
   finally show ?case .
 next
   case (Inc A)
   have 1: "(\<Union>i. (\<lambda>i. a \<inter> A i) i) = a \<inter> (\<Union>i. A i)"
     by blast
   have "range (\<lambda>i. a \<inter> A i) \<in> Pow(smallest_ccdi_sets \<Omega> M)" using Inc
     by blast
   moreover have "(\<lambda>i. a \<inter> A i) 0 = {}"
     by (simp add: Inc)
   moreover have "!!n. (\<lambda>i. a \<inter> A i) n \<subseteq> (\<lambda>i. a \<inter> A i) (Suc n)" using Inc
     by blast
   ultimately have 2: "(\<Union>i. (\<lambda>i. a \<inter> A i) i) \<in> smallest_ccdi_sets \<Omega> M"
     by (rule smallest_ccdi_sets.Inc)
   show ?case
     by (metis 1 2)
 next
   case (Disj A)
   have 1: "(\<Union>i. (\<lambda>i. a \<inter> A i) i) = a \<inter> (\<Union>i. A i)"
     by blast
   have "range (\<lambda>i. a \<inter> A i) \<in> Pow(smallest_ccdi_sets \<Omega> M)" using Disj
     by blast
   moreover have "disjoint_family (\<lambda>i. a \<inter> A i)" using Disj
     by (auto simp add: disjoint_family_on_def)
   ultimately have 2: "(\<Union>i. (\<lambda>i. a \<inter> A i) i) \<in> smallest_ccdi_sets \<Omega> M"
     by (rule smallest_ccdi_sets.Disj)
   show ?case
     by (metis 1 2)
 qed
 
 
 lemma (in algebra) smallest_ccdi_sets_Int:
   assumes b: "b \<in> smallest_ccdi_sets \<Omega> M"
   shows "a \<in> smallest_ccdi_sets \<Omega> M \<Longrightarrow> a \<inter> b \<in> smallest_ccdi_sets \<Omega> M"
 proof (induct rule: smallest_ccdi_sets.induct)
   case (Basic x)
   thus ?case
     by (metis b smallest_ccdi_sets_Int1)
 next
   case (Compl x)
   have "(\<Omega> - x) \<inter> b = \<Omega> - (x \<inter> b \<union> (\<Omega> - b))"
     by blast
   also have "... \<in> smallest_ccdi_sets \<Omega> M"
     by (metis Compl(2) Diff_disjoint Int_Diff Int_commute Int_empty_right b
            smallest_ccdi_sets.Compl smallest_ccdi_sets_Un)
   finally show ?case .
 next
   case (Inc A)
   have 1: "(\<Union>i. (\<lambda>i. A i \<inter> b) i) = (\<Union>i. A i) \<inter> b"
     by blast
   have "range (\<lambda>i. A i \<inter> b) \<in> Pow(smallest_ccdi_sets \<Omega> M)" using Inc
     by blast
   moreover have "(\<lambda>i. A i \<inter> b) 0 = {}"
     by (simp add: Inc)
   moreover have "!!n. (\<lambda>i. A i \<inter> b) n \<subseteq> (\<lambda>i. A i \<inter> b) (Suc n)" using Inc
     by blast
   ultimately have 2: "(\<Union>i. (\<lambda>i. A i \<inter> b) i) \<in> smallest_ccdi_sets \<Omega> M"
     by (rule smallest_ccdi_sets.Inc)
   show ?case
     by (metis 1 2)
 next
   case (Disj A)
   have 1: "(\<Union>i. (\<lambda>i. A i \<inter> b) i) = (\<Union>i. A i) \<inter> b"
     by blast
   have "range (\<lambda>i. A i \<inter> b) \<in> Pow(smallest_ccdi_sets \<Omega> M)" using Disj
     by blast
   moreover have "disjoint_family (\<lambda>i. A i \<inter> b)" using Disj
     by (auto simp add: disjoint_family_on_def)
   ultimately have 2: "(\<Union>i. (\<lambda>i. A i \<inter> b) i) \<in> smallest_ccdi_sets \<Omega> M"
     by (rule smallest_ccdi_sets.Disj)
   show ?case
     by (metis 1 2)
 qed
 
 lemma (in algebra) sigma_property_disjoint_lemma:
   assumes sbC: "M \<subseteq> C"
       and ccdi: "closed_cdi \<Omega> C"
   shows "sigma_sets \<Omega> M \<subseteq> C"
 proof -
   have "smallest_ccdi_sets \<Omega> M \<in> {B . M \<subseteq> B \<and> sigma_algebra \<Omega> B}"
     apply (auto simp add: sigma_algebra_disjoint_iff algebra_iff_Int
             smallest_ccdi_sets_Int)
     apply (metis Union_Pow_eq Union_upper subsetD smallest_ccdi_sets)
     apply (blast intro: smallest_ccdi_sets.Disj)
     done
   hence "sigma_sets (\<Omega>) (M) \<subseteq> smallest_ccdi_sets \<Omega> M"
     by clarsimp
        (drule sigma_algebra.sigma_sets_subset [where a="M"], auto)
   also have "...  \<subseteq> C"
     proof
       fix x
       assume x: "x \<in> smallest_ccdi_sets \<Omega> M"
       thus "x \<in> C"
         proof (induct rule: smallest_ccdi_sets.induct)
           case (Basic x)
           thus ?case
             by (metis Basic subsetD sbC)
         next
           case (Compl x)
           thus ?case
             by (blast intro: closed_cdi_Compl [OF ccdi, simplified])
         next
           case (Inc A)
           thus ?case
                by (auto intro: closed_cdi_Inc [OF ccdi, simplified])
         next
           case (Disj A)
           thus ?case
                by (auto intro: closed_cdi_Disj [OF ccdi, simplified])
         qed
     qed
   finally show ?thesis .
 qed
 
 lemma (in algebra) sigma_property_disjoint:
   assumes sbC: "M \<subseteq> C"
       and compl: "!!s. s \<in> C \<inter> sigma_sets (\<Omega>) (M) \<Longrightarrow> \<Omega> - s \<in> C"
       and inc: "!!A. range A \<subseteq> C \<inter> sigma_sets (\<Omega>) (M)
                      \<Longrightarrow> A 0 = {} \<Longrightarrow> (!!n. A n \<subseteq> A (Suc n))
                      \<Longrightarrow> (\<Union>i. A i) \<in> C"
       and disj: "!!A. range A \<subseteq> C \<inter> sigma_sets (\<Omega>) (M)
                       \<Longrightarrow> disjoint_family A \<Longrightarrow> (\<Union>i::nat. A i) \<in> C"
   shows "sigma_sets (\<Omega>) (M) \<subseteq> C"
 proof -
   have "sigma_sets (\<Omega>) (M) \<subseteq> C \<inter> sigma_sets (\<Omega>) (M)"
     proof (rule sigma_property_disjoint_lemma)
       show "M \<subseteq> C \<inter> sigma_sets (\<Omega>) (M)"
         by (metis Int_greatest Set.subsetI sbC sigma_sets.Basic)
     next
       show "closed_cdi \<Omega> (C \<inter> sigma_sets (\<Omega>) (M))"
         by (simp add: closed_cdi_def compl inc disj)
            (metis PowI Set.subsetI le_infI2 sigma_sets_into_sp space_closed
              IntE sigma_sets.Compl range_subsetD sigma_sets.Union)
     qed
   thus ?thesis
     by blast
 qed
 
 subsubsection \<open>Dynkin systems\<close>
 
 locale\<^marker>\<open>tag important\<close> Dynkin_system = subset_class +
   assumes space: "\<Omega> \<in> M"
     and   compl[intro!]: "\<And>A. A \<in> M \<Longrightarrow> \<Omega> - A \<in> M"
     and   UN[intro!]: "\<And>A. disjoint_family A \<Longrightarrow> range A \<subseteq> M
                            \<Longrightarrow> (\<Union>i::nat. A i) \<in> M"
 
 lemma (in Dynkin_system) empty[intro, simp]: "{} \<in> M"
   using space compl[of "\<Omega>"] by simp
 
 lemma (in Dynkin_system) diff:
   assumes sets: "D \<in> M" "E \<in> M" and "D \<subseteq> E"
   shows "E - D \<in> M"
 proof -
   let ?f = "\<lambda>x. if x = 0 then D else if x = Suc 0 then \<Omega> - E else {}"
   have "range ?f = {D, \<Omega> - E, {}}"
     by (auto simp: image_iff)
   moreover have "D \<union> (\<Omega> - E) = (\<Union>i. ?f i)"
     by (auto simp: image_iff split: if_split_asm)
   moreover
   have "disjoint_family ?f" unfolding disjoint_family_on_def
     using \<open>D \<in> M\<close>[THEN sets_into_space] \<open>D \<subseteq> E\<close> by auto
   ultimately have "\<Omega> - (D \<union> (\<Omega> - E)) \<in> M"
     using sets UN by auto fastforce
   also have "\<Omega> - (D \<union> (\<Omega> - E)) = E - D"
     using assms sets_into_space by auto
   finally show ?thesis .
 qed
 
 lemma Dynkin_systemI:
   assumes "\<And> A. A \<in> M \<Longrightarrow> A \<subseteq> \<Omega>" "\<Omega> \<in> M"
   assumes "\<And> A. A \<in> M \<Longrightarrow> \<Omega> - A \<in> M"
   assumes "\<And> A. disjoint_family A \<Longrightarrow> range A \<subseteq> M
           \<Longrightarrow> (\<Union>i::nat. A i) \<in> M"
   shows "Dynkin_system \<Omega> M"
   using assms by (auto simp: Dynkin_system_def Dynkin_system_axioms_def subset_class_def)
 
 lemma Dynkin_systemI':
   assumes 1: "\<And> A. A \<in> M \<Longrightarrow> A \<subseteq> \<Omega>"
   assumes empty: "{} \<in> M"
   assumes Diff: "\<And> A. A \<in> M \<Longrightarrow> \<Omega> - A \<in> M"
   assumes 2: "\<And> A. disjoint_family A \<Longrightarrow> range A \<subseteq> M
           \<Longrightarrow> (\<Union>i::nat. A i) \<in> M"
   shows "Dynkin_system \<Omega> M"
 proof -
   from Diff[OF empty] have "\<Omega> \<in> M" by auto
   from 1 this Diff 2 show ?thesis
     by (intro Dynkin_systemI) auto
 qed
 
 lemma Dynkin_system_trivial:
   shows "Dynkin_system A (Pow A)"
   by (rule Dynkin_systemI) auto
 
 lemma sigma_algebra_imp_Dynkin_system:
   assumes "sigma_algebra \<Omega> M" shows "Dynkin_system \<Omega> M"
 proof -
   interpret sigma_algebra \<Omega> M by fact
   show ?thesis using sets_into_space by (fastforce intro!: Dynkin_systemI)
 qed
 
 subsubsection "Intersection sets systems"
 
 definition\<^marker>\<open>tag important\<close> Int_stable :: "'a set set \<Rightarrow> bool" where
 "Int_stable M \<longleftrightarrow> (\<forall> a \<in> M. \<forall> b \<in> M. a \<inter> b \<in> M)"
 
 lemma (in algebra) Int_stable: "Int_stable M"
   unfolding Int_stable_def by auto
 
 lemma Int_stableI_image:
   "(\<And>i j. i \<in> I \<Longrightarrow> j \<in> I \<Longrightarrow> \<exists>k\<in>I. A i \<inter> A j = A k) \<Longrightarrow> Int_stable (A ` I)"
   by (auto simp: Int_stable_def image_def)
 
 lemma Int_stableI:
   "(\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> a \<inter> b \<in> A) \<Longrightarrow> Int_stable A"
   unfolding Int_stable_def by auto
 
 lemma Int_stableD:
   "Int_stable M \<Longrightarrow> a \<in> M \<Longrightarrow> b \<in> M \<Longrightarrow> a \<inter> b \<in> M"
   unfolding Int_stable_def by auto
 
 lemma (in Dynkin_system) sigma_algebra_eq_Int_stable:
   "sigma_algebra \<Omega> M \<longleftrightarrow> Int_stable M"
 proof
   assume "sigma_algebra \<Omega> M" then show "Int_stable M"
     unfolding sigma_algebra_def using algebra.Int_stable by auto
 next
   assume "Int_stable M"
   show "sigma_algebra \<Omega> M"
     unfolding sigma_algebra_disjoint_iff algebra_iff_Un
   proof (intro conjI ballI allI impI)
     show "M \<subseteq> Pow (\<Omega>)" using sets_into_space by auto
   next
     fix A B assume "A \<in> M" "B \<in> M"
     then have "A \<union> B = \<Omega> - ((\<Omega> - A) \<inter> (\<Omega> - B))"
               "\<Omega> - A \<in> M" "\<Omega> - B \<in> M"
       using sets_into_space by auto
     then show "A \<union> B \<in> M"
       using \<open>Int_stable M\<close> unfolding Int_stable_def by auto
   qed auto
 qed
 
 subsubsection "Smallest Dynkin systems"
 
 definition\<^marker>\<open>tag important\<close> Dynkin :: "'a set \<Rightarrow> 'a set set \<Rightarrow> 'a set set" where
   "Dynkin \<Omega> M =  (\<Inter>{D. Dynkin_system \<Omega> D \<and> M \<subseteq> D})"
 
 lemma Dynkin_system_Dynkin:
   assumes "M \<subseteq> Pow (\<Omega>)"
   shows "Dynkin_system \<Omega> (Dynkin \<Omega> M)"
 proof (rule Dynkin_systemI)
   fix A assume "A \<in> Dynkin \<Omega> M"
   moreover
   { fix D assume "A \<in> D" and d: "Dynkin_system \<Omega> D"
     then have "A \<subseteq> \<Omega>" by (auto simp: Dynkin_system_def subset_class_def) }
   moreover have "{D. Dynkin_system \<Omega> D \<and> M \<subseteq> D} \<noteq> {}"
     using assms Dynkin_system_trivial by fastforce
   ultimately show "A \<subseteq> \<Omega>"
     unfolding Dynkin_def using assms
     by auto
 next
   show "\<Omega> \<in> Dynkin \<Omega> M"
     unfolding Dynkin_def using Dynkin_system.space by fastforce
 next
   fix A assume "A \<in> Dynkin \<Omega> M"
   then show "\<Omega> - A \<in> Dynkin \<Omega> M"
     unfolding Dynkin_def using Dynkin_system.compl by force
 next
   fix A :: "nat \<Rightarrow> 'a set"
   assume A: "disjoint_family A" "range A \<subseteq> Dynkin \<Omega> M"
   show "(\<Union>i. A i) \<in> Dynkin \<Omega> M" unfolding Dynkin_def
   proof (simp, safe)
     fix D assume "Dynkin_system \<Omega> D" "M \<subseteq> D"
     with A have "(\<Union>i. A i) \<in> D"
       by (intro Dynkin_system.UN) (auto simp: Dynkin_def)
     then show "(\<Union>i. A i) \<in> D" by auto
   qed
 qed
 
 lemma Dynkin_Basic[intro]: "A \<in> M \<Longrightarrow> A \<in> Dynkin \<Omega> M"
   unfolding Dynkin_def by auto
 
 lemma (in Dynkin_system) restricted_Dynkin_system:
   assumes "D \<in> M"
   shows "Dynkin_system \<Omega> {Q. Q \<subseteq> \<Omega> \<and> Q \<inter> D \<in> M}"
 proof (rule Dynkin_systemI, simp_all)
   have "\<Omega> \<inter> D = D"
     using \<open>D \<in> M\<close> sets_into_space by auto
   then show "\<Omega> \<inter> D \<in> M"
     using \<open>D \<in> M\<close> by auto
 next
   fix A assume "A \<subseteq> \<Omega> \<and> A \<inter> D \<in> M"
   moreover have "(\<Omega> - A) \<inter> D = (\<Omega> - (A \<inter> D)) - (\<Omega> - D)"
     by auto
   ultimately show "(\<Omega> - A) \<inter> D \<in> M"
     using  \<open>D \<in> M\<close> by (auto intro: diff)
 next
   fix A :: "nat \<Rightarrow> 'a set"
   assume "disjoint_family A" "range A \<subseteq> {Q. Q \<subseteq> \<Omega> \<and> Q \<inter> D \<in> M}"
   then have "\<And>i. A i \<subseteq> \<Omega>" "disjoint_family (\<lambda>i. A i \<inter> D)"
     "range (\<lambda>i. A i \<inter> D) \<subseteq> M" "(\<Union>x. A x) \<inter> D = (\<Union>x. A x \<inter> D)"
     by ((fastforce simp: disjoint_family_on_def)+)
   then show "(\<Union>x. A x) \<subseteq> \<Omega> \<and> (\<Union>x. A x) \<inter> D \<in> M"
     by (auto simp del: UN_simps)
 qed
 
 lemma (in Dynkin_system) Dynkin_subset:
   assumes "N \<subseteq> M"
   shows "Dynkin \<Omega> N \<subseteq> M"
 proof -
   have "Dynkin_system \<Omega> M" ..
   then have "Dynkin_system \<Omega> M"
     using assms unfolding Dynkin_system_def Dynkin_system_axioms_def subset_class_def by simp
   with \<open>N \<subseteq> M\<close> show ?thesis by (auto simp add: Dynkin_def)
 qed
 
 lemma sigma_eq_Dynkin:
   assumes sets: "M \<subseteq> Pow \<Omega>"
   assumes "Int_stable M"
   shows "sigma_sets \<Omega> M = Dynkin \<Omega> M"
 proof -
   have "Dynkin \<Omega> M \<subseteq> sigma_sets (\<Omega>) (M)"
     using sigma_algebra_imp_Dynkin_system
     unfolding Dynkin_def sigma_sets_least_sigma_algebra[OF sets] by auto
   moreover
   interpret Dynkin_system \<Omega> "Dynkin \<Omega> M"
     using Dynkin_system_Dynkin[OF sets] .
   have "sigma_algebra \<Omega> (Dynkin \<Omega> M)"
     unfolding sigma_algebra_eq_Int_stable Int_stable_def
   proof (intro ballI)
     fix A B assume "A \<in> Dynkin \<Omega> M" "B \<in> Dynkin \<Omega> M"
     let ?D = "\<lambda>E. {Q. Q \<subseteq> \<Omega> \<and> Q \<inter> E \<in> Dynkin \<Omega> M}"
     have "M \<subseteq> ?D B"
     proof
       fix E assume "E \<in> M"
       then have "M \<subseteq> ?D E" "E \<in> Dynkin \<Omega> M"
         using sets_into_space \<open>Int_stable M\<close> by (auto simp: Int_stable_def)
       then have "Dynkin \<Omega> M \<subseteq> ?D E"
         using restricted_Dynkin_system \<open>E \<in> Dynkin \<Omega> M\<close>
         by (intro Dynkin_system.Dynkin_subset) simp_all
       then have "B \<in> ?D E"
         using \<open>B \<in> Dynkin \<Omega> M\<close> by auto
       then have "E \<inter> B \<in> Dynkin \<Omega> M"
         by (subst Int_commute) simp
       then show "E \<in> ?D B"
         using sets \<open>E \<in> M\<close> by auto
     qed
     then have "Dynkin \<Omega> M \<subseteq> ?D B"
       using restricted_Dynkin_system \<open>B \<in> Dynkin \<Omega> M\<close>
       by (intro Dynkin_system.Dynkin_subset) simp_all
     then show "A \<inter> B \<in> Dynkin \<Omega> M"
       using \<open>A \<in> Dynkin \<Omega> M\<close> sets_into_space by auto
   qed
   from sigma_algebra.sigma_sets_subset[OF this, of "M"]
   have "sigma_sets (\<Omega>) (M) \<subseteq> Dynkin \<Omega> M" by auto
   ultimately have "sigma_sets (\<Omega>) (M) = Dynkin \<Omega> M" by auto
   then show ?thesis
     by (auto simp: Dynkin_def)
 qed
 
 lemma (in Dynkin_system) Dynkin_idem:
   "Dynkin \<Omega> M = M"
 proof -
   have "Dynkin \<Omega> M = M"
   proof
     show "M \<subseteq> Dynkin \<Omega> M"
       using Dynkin_Basic by auto
     show "Dynkin \<Omega> M \<subseteq> M"
       by (intro Dynkin_subset) auto
   qed
   then show ?thesis
     by (auto simp: Dynkin_def)
 qed
 
 lemma (in Dynkin_system) Dynkin_lemma:
   assumes "Int_stable E"
   and E: "E \<subseteq> M" "M \<subseteq> sigma_sets \<Omega> E"
   shows "sigma_sets \<Omega> E = M"
 proof -
   have "E \<subseteq> Pow \<Omega>"
     using E sets_into_space by force
   then have *: "sigma_sets \<Omega> E = Dynkin \<Omega> E"
     using \<open>Int_stable E\<close> by (rule sigma_eq_Dynkin)
   then have "Dynkin \<Omega> E = M"
     using assms Dynkin_subset[OF E(1)] by simp
   with * show ?thesis
     using assms by (auto simp: Dynkin_def)
 qed
 
 subsubsection \<open>Induction rule for intersection-stable generators\<close>
 
 text\<^marker>\<open>tag important\<close> \<open>The reason to introduce Dynkin-systems is the following induction rules for \<open>\<sigma>\<close>-algebras
 generated by a generator closed under intersection.\<close>
 
 proposition sigma_sets_induct_disjoint[consumes 3, case_names basic empty compl union]:
   assumes "Int_stable G"
     and closed: "G \<subseteq> Pow \<Omega>"
     and A: "A \<in> sigma_sets \<Omega> G"
   assumes basic: "\<And>A. A \<in> G \<Longrightarrow> P A"
     and empty: "P {}"
     and compl: "\<And>A. A \<in> sigma_sets \<Omega> G \<Longrightarrow> P A \<Longrightarrow> P (\<Omega> - A)"
     and union: "\<And>A. disjoint_family A \<Longrightarrow> range A \<subseteq> sigma_sets \<Omega> G \<Longrightarrow> (\<And>i. P (A i)) \<Longrightarrow> P (\<Union>i::nat. A i)"
   shows "P A"
 proof -
   let ?D = "{ A \<in> sigma_sets \<Omega> G. P A }"
   interpret sigma_algebra \<Omega> "sigma_sets \<Omega> G"
     using closed by (rule sigma_algebra_sigma_sets)
   from compl[OF _ empty] closed have space: "P \<Omega>" by simp
   interpret Dynkin_system \<Omega> ?D
     by standard (auto dest: sets_into_space intro!: space compl union)
   have "sigma_sets \<Omega> G = ?D"
     by (rule Dynkin_lemma) (auto simp: basic \<open>Int_stable G\<close>)
   with A show ?thesis by auto
 qed
 
 subsection \<open>Measure type\<close>
 
 definition\<^marker>\<open>tag important\<close> positive :: "'a set set \<Rightarrow> ('a set \<Rightarrow> ennreal) \<Rightarrow> bool" where
   "positive M \<mu> \<longleftrightarrow> \<mu> {} = 0"
 
 definition\<^marker>\<open>tag important\<close> countably_additive :: "'a set set \<Rightarrow> ('a set \<Rightarrow> ennreal) \<Rightarrow> bool" where
 "countably_additive M f \<longleftrightarrow>
   (\<forall>A. range A \<subseteq> M \<longrightarrow> disjoint_family A \<longrightarrow> (\<Union>i. A i) \<in> M \<longrightarrow>
     (\<Sum>i. f (A i)) = f (\<Union>i. A i))"
 
 definition\<^marker>\<open>tag important\<close> measure_space :: "'a set \<Rightarrow> 'a set set \<Rightarrow> ('a set \<Rightarrow> ennreal) \<Rightarrow> bool" where
 "measure_space \<Omega> A \<mu> \<longleftrightarrow>
   sigma_algebra \<Omega> A \<and> positive A \<mu> \<and> countably_additive A \<mu>"
 
 typedef\<^marker>\<open>tag important\<close> 'a measure =
   "{(\<Omega>::'a set, A, \<mu>). (\<forall>a\<in>-A. \<mu> a = 0) \<and> measure_space \<Omega> A \<mu> }"
 proof
   have "sigma_algebra UNIV {{}, UNIV}"
     by (auto simp: sigma_algebra_iff2)
   then show "(UNIV, {{}, UNIV}, \<lambda>A. 0) \<in> {(\<Omega>, A, \<mu>). (\<forall>a\<in>-A. \<mu> a = 0) \<and> measure_space \<Omega> A \<mu>} "
     by (auto simp: measure_space_def positive_def countably_additive_def)
 qed
 
 definition\<^marker>\<open>tag important\<close> space :: "'a measure \<Rightarrow> 'a set" where
   "space M = fst (Rep_measure M)"
 
 definition\<^marker>\<open>tag important\<close> sets :: "'a measure \<Rightarrow> 'a set set" where
   "sets M = fst (snd (Rep_measure M))"
 
 definition\<^marker>\<open>tag important\<close> emeasure :: "'a measure \<Rightarrow> 'a set \<Rightarrow> ennreal" where
   "emeasure M = snd (snd (Rep_measure M))"
 
 definition\<^marker>\<open>tag important\<close> measure :: "'a measure \<Rightarrow> 'a set \<Rightarrow> real" where
   "measure M A = enn2real (emeasure M A)"
 
 declare [[coercion sets]]
 
 declare [[coercion measure]]
 
 declare [[coercion emeasure]]
 
 lemma measure_space: "measure_space (space M) (sets M) (emeasure M)"
   by (cases M) (auto simp: space_def sets_def emeasure_def Abs_measure_inverse)
 
 interpretation sets: sigma_algebra "space M" "sets M" for M :: "'a measure"
   using measure_space[of M] by (auto simp: measure_space_def)
 
 definition\<^marker>\<open>tag important\<close> measure_of :: "'a set \<Rightarrow> 'a set set \<Rightarrow> ('a set \<Rightarrow> ennreal) \<Rightarrow> 'a measure"
   where
 "measure_of \<Omega> A \<mu> =
   Abs_measure (\<Omega>, if A \<subseteq> Pow \<Omega> then sigma_sets \<Omega> A else {{}, \<Omega>},
     \<lambda>a. if a \<in> sigma_sets \<Omega> A \<and> measure_space \<Omega> (sigma_sets \<Omega> A) \<mu> then \<mu> a else 0)"
 
 abbreviation "sigma \<Omega> A \<equiv> measure_of \<Omega> A (\<lambda>x. 0)"
 
 lemma measure_space_0: "A \<subseteq> Pow \<Omega> \<Longrightarrow> measure_space \<Omega> (sigma_sets \<Omega> A) (\<lambda>x. 0)"
   unfolding measure_space_def
   by (auto intro!: sigma_algebra_sigma_sets simp: positive_def countably_additive_def)
 
 lemma sigma_algebra_trivial: "sigma_algebra \<Omega> {{}, \<Omega>}"
 by unfold_locales(fastforce intro: exI[where x="{{}}"] exI[where x="{\<Omega>}"])+
 
 lemma measure_space_0': "measure_space \<Omega> {{}, \<Omega>} (\<lambda>x. 0)"
 by(simp add: measure_space_def positive_def countably_additive_def sigma_algebra_trivial)
 
 lemma measure_space_closed:
   assumes "measure_space \<Omega> M \<mu>"
   shows "M \<subseteq> Pow \<Omega>"
 proof -
   interpret sigma_algebra \<Omega> M using assms by(simp add: measure_space_def)
   show ?thesis by(rule space_closed)
 qed
 
 lemma (in ring_of_sets) positive_cong_eq:
   "(\<And>a. a \<in> M \<Longrightarrow> \<mu>' a = \<mu> a) \<Longrightarrow> positive M \<mu>' = positive M \<mu>"
   by (auto simp add: positive_def)
 
 lemma (in sigma_algebra) countably_additive_eq:
   "(\<And>a. a \<in> M \<Longrightarrow> \<mu>' a = \<mu> a) \<Longrightarrow> countably_additive M \<mu>' = countably_additive M \<mu>"
   unfolding countably_additive_def
   by (intro arg_cong[where f=All] ext) (auto simp add: countably_additive_def subset_eq)
 
 lemma measure_space_eq:
   assumes closed: "A \<subseteq> Pow \<Omega>" and eq: "\<And>a. a \<in> sigma_sets \<Omega> A \<Longrightarrow> \<mu> a = \<mu>' a"
   shows "measure_space \<Omega> (sigma_sets \<Omega> A) \<mu> = measure_space \<Omega> (sigma_sets \<Omega> A) \<mu>'"
 proof -
   interpret sigma_algebra \<Omega> "sigma_sets \<Omega> A" using closed by (rule sigma_algebra_sigma_sets)
   from positive_cong_eq[OF eq, of "\<lambda>i. i"] countably_additive_eq[OF eq, of "\<lambda>i. i"] show ?thesis
     by (auto simp: measure_space_def)
 qed
 
 lemma measure_of_eq:
   assumes closed: "A \<subseteq> Pow \<Omega>" and eq: "(\<And>a. a \<in> sigma_sets \<Omega> A \<Longrightarrow> \<mu> a = \<mu>' a)"
   shows "measure_of \<Omega> A \<mu> = measure_of \<Omega> A \<mu>'"
 proof -
   have "measure_space \<Omega> (sigma_sets \<Omega> A) \<mu> = measure_space \<Omega> (sigma_sets \<Omega> A) \<mu>'"
     using assms by (rule measure_space_eq)
   with eq show ?thesis
     by (auto simp add: measure_of_def intro!: arg_cong[where f=Abs_measure])
 qed
 
 lemma
   shows space_measure_of_conv: "space (measure_of \<Omega> A \<mu>) = \<Omega>" (is ?space)
   and sets_measure_of_conv:
   "sets (measure_of \<Omega> A \<mu>) = (if A \<subseteq> Pow \<Omega> then sigma_sets \<Omega> A else {{}, \<Omega>})" (is ?sets)
   and emeasure_measure_of_conv:
   "emeasure (measure_of \<Omega> A \<mu>) =
   (\<lambda>B. if B \<in> sigma_sets \<Omega> A \<and> measure_space \<Omega> (sigma_sets \<Omega> A) \<mu> then \<mu> B else 0)" (is ?emeasure)
 proof -
   have "?space \<and> ?sets \<and> ?emeasure"
   proof(cases "measure_space \<Omega> (sigma_sets \<Omega> A) \<mu>")
     case True
     from measure_space_closed[OF this] sigma_sets_superset_generator[of A \<Omega>]
     have "A \<subseteq> Pow \<Omega>" by simp
     hence "measure_space \<Omega> (sigma_sets \<Omega> A) \<mu> = measure_space \<Omega> (sigma_sets \<Omega> A)
       (\<lambda>a. if a \<in> sigma_sets \<Omega> A then \<mu> a else 0)"
       by(rule measure_space_eq) auto
     with True \<open>A \<subseteq> Pow \<Omega>\<close> show ?thesis
       by(simp add: measure_of_def space_def sets_def emeasure_def Abs_measure_inverse)
   next
     case False thus ?thesis
       by(cases "A \<subseteq> Pow \<Omega>")(simp_all add: Abs_measure_inverse measure_of_def sets_def space_def emeasure_def measure_space_0 measure_space_0')
   qed
   thus ?space ?sets ?emeasure by simp_all
 qed
 
 lemma [simp]:
   assumes A: "A \<subseteq> Pow \<Omega>"
   shows sets_measure_of: "sets (measure_of \<Omega> A \<mu>) = sigma_sets \<Omega> A"
     and space_measure_of: "space (measure_of \<Omega> A \<mu>) = \<Omega>"
 using assms
 by(simp_all add: sets_measure_of_conv space_measure_of_conv)
 
 lemma space_in_measure_of[simp]: "\<Omega> \<in> sets (measure_of \<Omega> M \<mu>)"
   by (subst sets_measure_of_conv) (auto simp: sigma_sets_top)
 
 lemma (in sigma_algebra) sets_measure_of_eq[simp]: "sets (measure_of \<Omega> M \<mu>) = M"
   using space_closed by (auto intro!: sigma_sets_eq)
 
 lemma (in sigma_algebra) space_measure_of_eq[simp]: "space (measure_of \<Omega> M \<mu>) = \<Omega>"
   by (rule space_measure_of_conv)
 
 lemma measure_of_subset: "M \<subseteq> Pow \<Omega> \<Longrightarrow> M' \<subseteq> M \<Longrightarrow> sets (measure_of \<Omega> M' \<mu>) \<subseteq> sets (measure_of \<Omega> M \<mu>')"
   by (auto intro!: sigma_sets_subseteq)
 
 lemma emeasure_sigma: "emeasure (sigma \<Omega> A) = (\<lambda>x. 0)"
   unfolding measure_of_def emeasure_def
   by (subst Abs_measure_inverse)
      (auto simp: measure_space_def positive_def countably_additive_def
            intro!: sigma_algebra_sigma_sets sigma_algebra_trivial)
 
 lemma sigma_sets_mono'':
   assumes "A \<in> sigma_sets C D"
   assumes "B \<subseteq> D"
   assumes "D \<subseteq> Pow C"
   shows "sigma_sets A B \<subseteq> sigma_sets C D"
 proof
   fix x assume "x \<in> sigma_sets A B"
   thus "x \<in> sigma_sets C D"
   proof induct
     case (Basic a) with assms have "a \<in> D" by auto
     thus ?case ..
   next
     case Empty show ?case by (rule sigma_sets.Empty)
   next
     from assms have "A \<in> sets (sigma C D)" by (subst sets_measure_of[OF \<open>D \<subseteq> Pow C\<close>])
     moreover case (Compl a) hence "a \<in> sets (sigma C D)" by (subst sets_measure_of[OF \<open>D \<subseteq> Pow C\<close>])
     ultimately have "A - a \<in> sets (sigma C D)" ..
     thus ?case by (subst (asm) sets_measure_of[OF \<open>D \<subseteq> Pow C\<close>])
   next
     case (Union a)
     thus ?case by (intro sigma_sets.Union)
   qed
 qed
 
 lemma in_measure_of[intro, simp]: "M \<subseteq> Pow \<Omega> \<Longrightarrow> A \<in> M \<Longrightarrow> A \<in> sets (measure_of \<Omega> M \<mu>)"
   by auto
 
 lemma space_empty_iff: "space N = {} \<longleftrightarrow> sets N = {{}}"
   by (metis Pow_empty Sup_bot_conv(1) cSup_singleton empty_iff
             sets.sigma_sets_eq sets.space_closed sigma_sets_top subset_singletonD)
 
 subsubsection \<open>Constructing simple \<^typ>\<open>'a measure\<close>\<close>
 
 proposition emeasure_measure_of:
   assumes M: "M = measure_of \<Omega> A \<mu>"
   assumes ms: "A \<subseteq> Pow \<Omega>" "positive (sets M) \<mu>" "countably_additive (sets M) \<mu>"
   assumes X: "X \<in> sets M"
   shows "emeasure M X = \<mu> X"
 proof -
   interpret sigma_algebra \<Omega> "sigma_sets \<Omega> A" by (rule sigma_algebra_sigma_sets) fact
   have "measure_space \<Omega> (sigma_sets \<Omega> A) \<mu>"
     using ms M by (simp add: measure_space_def sigma_algebra_sigma_sets)
   thus ?thesis using X ms
     by(simp add: M emeasure_measure_of_conv sets_measure_of_conv)
 qed
 
 lemma emeasure_measure_of_sigma:
   assumes ms: "sigma_algebra \<Omega> M" "positive M \<mu>" "countably_additive M \<mu>"
   assumes A: "A \<in> M"
   shows "emeasure (measure_of \<Omega> M \<mu>) A = \<mu> A"
 proof -
   interpret sigma_algebra \<Omega> M by fact
   have "measure_space \<Omega> (sigma_sets \<Omega> M) \<mu>"
     using ms sigma_sets_eq by (simp add: measure_space_def)
   thus ?thesis by(simp add: emeasure_measure_of_conv A)
 qed
 
 lemma measure_cases[cases type: measure]:
   obtains (measure) \<Omega> A \<mu> where "x = Abs_measure (\<Omega>, A, \<mu>)" "\<forall>a\<in>-A. \<mu> a = 0" "measure_space \<Omega> A \<mu>"
   by atomize_elim (cases x, auto)
 
 lemma sets_le_imp_space_le: "sets A \<subseteq> sets B \<Longrightarrow> space A \<subseteq> space B"
   by (auto dest: sets.sets_into_space)
 
 lemma sets_eq_imp_space_eq: "sets M = sets M' \<Longrightarrow> space M = space M'"
   by (auto intro!: antisym sets_le_imp_space_le)
 
 lemma emeasure_notin_sets: "A \<notin> sets M \<Longrightarrow> emeasure M A = 0"
   by (cases M) (auto simp: sets_def emeasure_def Abs_measure_inverse measure_space_def)
 
 lemma emeasure_neq_0_sets: "emeasure M A \<noteq> 0 \<Longrightarrow> A \<in> sets M"
   using emeasure_notin_sets[of A M] by blast
 
 lemma measure_notin_sets: "A \<notin> sets M \<Longrightarrow> measure M A = 0"
   by (simp add: measure_def emeasure_notin_sets zero_ennreal.rep_eq)
 
 lemma measure_eqI:
   fixes M N :: "'a measure"
   assumes "sets M = sets N" and eq: "\<And>A. A \<in> sets M \<Longrightarrow> emeasure M A = emeasure N A"
   shows "M = N"
 proof (cases M N rule: measure_cases[case_product measure_cases])
   case (measure_measure \<Omega> A \<mu> \<Omega>' A' \<mu>')
   interpret M: sigma_algebra \<Omega> A using measure_measure by (auto simp: measure_space_def)
   interpret N: sigma_algebra \<Omega>' A' using measure_measure by (auto simp: measure_space_def)
   have "A = sets M" "A' = sets N"
     using measure_measure by (simp_all add: sets_def Abs_measure_inverse)
   with \<open>sets M = sets N\<close> have AA': "A = A'" by simp
   moreover from M.top N.top M.space_closed N.space_closed AA' have "\<Omega> = \<Omega>'" by auto
   moreover { fix B have "\<mu> B = \<mu>' B"
     proof cases
       assume "B \<in> A"
       with eq \<open>A = sets M\<close> have "emeasure M B = emeasure N B" by simp
       with measure_measure show "\<mu> B = \<mu>' B"
         by (simp add: emeasure_def Abs_measure_inverse)
     next
       assume "B \<notin> A"
       with \<open>A = sets M\<close> \<open>A' = sets N\<close> \<open>A = A'\<close> have "B \<notin> sets M" "B \<notin> sets N"
         by auto
       then have "emeasure M B = 0" "emeasure N B = 0"
         by (simp_all add: emeasure_notin_sets)
       with measure_measure show "\<mu> B = \<mu>' B"
         by (simp add: emeasure_def Abs_measure_inverse)
     qed }
   then have "\<mu> = \<mu>'" by auto
   ultimately show "M = N"
     by (simp add: measure_measure)
 qed
 
 lemma sigma_eqI:
   assumes [simp]: "M \<subseteq> Pow \<Omega>" "N \<subseteq> Pow \<Omega>" "sigma_sets \<Omega> M = sigma_sets \<Omega> N"
   shows "sigma \<Omega> M = sigma \<Omega> N"
   by (rule measure_eqI) (simp_all add: emeasure_sigma)
 
 subsubsection \<open>Measurable functions\<close>
 
 definition\<^marker>\<open>tag important\<close> measurable :: "'a measure \<Rightarrow> 'b measure \<Rightarrow> ('a \<Rightarrow> 'b) set"
   (infixr "\<rightarrow>\<^sub>M" 60) where
 "measurable A B = {f \<in> space A \<rightarrow> space B. \<forall>y \<in> sets B. f -` y \<inter> space A \<in> sets A}"
 
 lemma measurableI:
   "(\<And>x. x \<in> space M \<Longrightarrow> f x \<in> space N) \<Longrightarrow> (\<And>A. A \<in> sets N \<Longrightarrow> f -` A \<inter> space M \<in> sets M) \<Longrightarrow>
     f \<in> measurable M N"
   by (auto simp: measurable_def)
 
 lemma measurable_space:
   "f \<in> measurable M A \<Longrightarrow> x \<in> space M \<Longrightarrow> f x \<in> space A"
    unfolding measurable_def by auto
 
 lemma measurable_sets:
   "f \<in> measurable M A \<Longrightarrow> S \<in> sets A \<Longrightarrow> f -` S \<inter> space M \<in> sets M"
    unfolding measurable_def by auto
 
 lemma measurable_sets_Collect:
   assumes f: "f \<in> measurable M N" and P: "{x\<in>space N. P x} \<in> sets N" shows "{x\<in>space M. P (f x)} \<in> sets M"
 proof -
   have "f -` {x \<in> space N. P x} \<inter> space M = {x\<in>space M. P (f x)}"
     using measurable_space[OF f] by auto
   with measurable_sets[OF f P] show ?thesis
     by simp
 qed
 
 lemma measurable_sigma_sets:
   assumes B: "sets N = sigma_sets \<Omega> A" "A \<subseteq> Pow \<Omega>"
       and f: "f \<in> space M \<rightarrow> \<Omega>"
       and ba: "\<And>y. y \<in> A \<Longrightarrow> (f -` y) \<inter> space M \<in> sets M"
   shows "f \<in> measurable M N"
 proof -
   interpret A: sigma_algebra \<Omega> "sigma_sets \<Omega> A" using B(2) by (rule sigma_algebra_sigma_sets)
   from B sets.top[of N] A.top sets.space_closed[of N] A.space_closed have \<Omega>: "\<Omega> = space N" by force
 
   { fix X assume "X \<in> sigma_sets \<Omega> A"
     then have "f -` X \<inter> space M \<in> sets M \<and> X \<subseteq> \<Omega>"
       proof induct
         case (Basic a) then show ?case
           by (auto simp add: ba) (metis B(2) subsetD PowD)
       next
         case (Compl a)
         have [simp]: "f -` \<Omega> \<inter> space M = space M"
           by (auto simp add: funcset_mem [OF f])
         then show ?case
           by (auto simp add: vimage_Diff Diff_Int_distrib2 sets.compl_sets Compl)
       next
         case (Union a)
         then show ?case
           by (simp add: vimage_UN, simp only: UN_extend_simps(4)) blast
       qed auto }
   with f show ?thesis
     by (auto simp add: measurable_def B \<Omega>)
 qed
 
 lemma measurable_measure_of:
   assumes B: "N \<subseteq> Pow \<Omega>"
       and f: "f \<in> space M \<rightarrow> \<Omega>"
       and ba: "\<And>y. y \<in> N \<Longrightarrow> (f -` y) \<inter> space M \<in> sets M"
   shows "f \<in> measurable M (measure_of \<Omega> N \<mu>)"
 proof -
   have "sets (measure_of \<Omega> N \<mu>) = sigma_sets \<Omega> N"
     using B by (rule sets_measure_of)
   from this assms show ?thesis by (rule measurable_sigma_sets)
 qed
 
 lemma measurable_iff_measure_of:
   assumes "N \<subseteq> Pow \<Omega>" "f \<in> space M \<rightarrow> \<Omega>"
   shows "f \<in> measurable M (measure_of \<Omega> N \<mu>) \<longleftrightarrow> (\<forall>A\<in>N. f -` A \<inter> space M \<in> sets M)"
   by (metis assms in_measure_of measurable_measure_of assms measurable_sets)
 
 lemma measurable_cong_sets:
   assumes sets: "sets M = sets M'" "sets N = sets N'"
   shows "measurable M N = measurable M' N'"
   using sets[THEN sets_eq_imp_space_eq] sets by (simp add: measurable_def)
 
 lemma measurable_cong:
   assumes "\<And>w. w \<in> space M \<Longrightarrow> f w = g w"
   shows "f \<in> measurable M M' \<longleftrightarrow> g \<in> measurable M M'"
   unfolding measurable_def using assms
   by (simp cong: vimage_inter_cong Pi_cong)
 
 lemma measurable_cong':
   assumes "\<And>w. w \<in> space M =simp=> f w = g w"
   shows "f \<in> measurable M M' \<longleftrightarrow> g \<in> measurable M M'"
   unfolding measurable_def using assms
   by (simp cong: vimage_inter_cong Pi_cong add: simp_implies_def)
 
 lemma measurable_cong_simp:
   "M = N \<Longrightarrow> M' = N' \<Longrightarrow> (\<And>w. w \<in> space M \<Longrightarrow> f w = g w) \<Longrightarrow>
     f \<in> measurable M M' \<longleftrightarrow> g \<in> measurable N N'"
   by (metis measurable_cong)
 
 lemma measurable_compose:
   assumes f: "f \<in> measurable M N" and g: "g \<in> measurable N L"
   shows "(\<lambda>x. g (f x)) \<in> measurable M L"
 proof -
   have "\<And>A. (\<lambda>x. g (f x)) -` A \<inter> space M = f -` (g -` A \<inter> space N) \<inter> space M"
     using measurable_space[OF f] by auto
   with measurable_space[OF f] measurable_space[OF g] show ?thesis
     by (auto intro: measurable_sets[OF f] measurable_sets[OF g]
              simp del: vimage_Int simp add: measurable_def)
 qed
 
 lemma measurable_comp:
   "f \<in> measurable M N \<Longrightarrow> g \<in> measurable N L \<Longrightarrow> g \<circ> f \<in> measurable M L"
   using measurable_compose[of f M N g L] by (simp add: comp_def)
 
 lemma measurable_const:
   "c \<in> space M' \<Longrightarrow> (\<lambda>x. c) \<in> measurable M M'"
   by (auto simp add: measurable_def)
 
 lemma measurable_ident: "id \<in> measurable M M"
   by (auto simp add: measurable_def)
 
 lemma measurable_id: "(\<lambda>x. x) \<in> measurable M M"
   by (simp add: measurable_def)
 
 lemma measurable_ident_sets:
   assumes eq: "sets M = sets M'" shows "(\<lambda>x. x) \<in> measurable M M'"
   using measurable_ident[of M]
   unfolding id_def measurable_def eq sets_eq_imp_space_eq[OF eq] .
 
 lemma sets_Least:
   assumes meas: "\<And>i::nat. {x\<in>space M. P i x} \<in> M"
   shows "(\<lambda>x. LEAST j. P j x) -` A \<inter> space M \<in> sets M"
 proof -
   { fix i have "(\<lambda>x. LEAST j. P j x) -` {i} \<inter> space M \<in> sets M"
     proof cases
       assume i: "(LEAST j. False) = i"
       have "(\<lambda>x. LEAST j. P j x) -` {i} \<inter> space M =
         {x\<in>space M. P i x} \<inter> (space M - (\<Union>j<i. {x\<in>space M. P j x})) \<union> (space M - (\<Union>i. {x\<in>space M. P i x}))"
         by (simp add: set_eq_iff, safe)
            (insert i, auto dest: Least_le intro: LeastI intro!: Least_equality)
       with meas show ?thesis
         by (auto intro!: sets.Int)
     next
       assume i: "(LEAST j. False) \<noteq> i"
       then have "(\<lambda>x. LEAST j. P j x) -` {i} \<inter> space M =
         {x\<in>space M. P i x} \<inter> (space M - (\<Union>j<i. {x\<in>space M. P j x}))"
       proof (simp add: set_eq_iff, safe)
         fix x assume neq: "(LEAST j. False) \<noteq> (LEAST j. P j x)"
         have "\<exists>j. P j x"
           by (rule ccontr) (insert neq, auto)
         then show "P (LEAST j. P j x) x" by (rule LeastI_ex)
       qed (auto dest: Least_le intro!: Least_equality)
       with meas show ?thesis
         by auto
     qed }
   then have "(\<Union>i\<in>A. (\<lambda>x. LEAST j. P j x) -` {i} \<inter> space M) \<in> sets M"
     by (intro sets.countable_UN) auto
   moreover have "(\<Union>i\<in>A. (\<lambda>x. LEAST j. P j x) -` {i} \<inter> space M) =
     (\<lambda>x. LEAST j. P j x) -` A \<inter> space M" by auto
   ultimately show ?thesis by auto
 qed
 
 lemma measurable_mono1:
   "M' \<subseteq> Pow \<Omega> \<Longrightarrow> M \<subseteq> M' \<Longrightarrow>
     measurable (measure_of \<Omega> M \<mu>) N \<subseteq> measurable (measure_of \<Omega> M' \<mu>') N"
   using measure_of_subset[of M' \<Omega> M] by (auto simp add: measurable_def)
 
 subsubsection \<open>Counting space\<close>
 
 definition\<^marker>\<open>tag important\<close> count_space :: "'a set \<Rightarrow> 'a measure" where
 "count_space \<Omega> = measure_of \<Omega> (Pow \<Omega>) (\<lambda>A. if finite A then of_nat (card A) else \<infinity>)"
 
 lemma
   shows space_count_space[simp]: "space (count_space \<Omega>) = \<Omega>"
     and sets_count_space[simp]: "sets (count_space \<Omega>) = Pow \<Omega>"
   using sigma_sets_into_sp[of "Pow \<Omega>" \<Omega>]
   by (auto simp: count_space_def)
 
 lemma measurable_count_space_eq1[simp]:
   "f \<in> measurable (count_space A) M \<longleftrightarrow> f \<in> A \<rightarrow> space M"
  unfolding measurable_def by simp
 
 lemma measurable_compose_countable':
   assumes f: "\<And>i. i \<in> I \<Longrightarrow> (\<lambda>x. f i x) \<in> measurable M N"
   and g: "g \<in> measurable M (count_space I)" and I: "countable I"
   shows "(\<lambda>x. f (g x) x) \<in> measurable M N"
   unfolding measurable_def
 proof safe
   fix x assume "x \<in> space M" then show "f (g x) x \<in> space N"
     using measurable_space[OF f] g[THEN measurable_space] by auto
 next
   fix A assume A: "A \<in> sets N"
   have "(\<lambda>x. f (g x) x) -` A \<inter> space M = (\<Union>i\<in>I. (g -` {i} \<inter> space M) \<inter> (f i -` A \<inter> space M))"
     using measurable_space[OF g] by auto
   also have "\<dots> \<in> sets M"
     using f[THEN measurable_sets, OF _ A] g[THEN measurable_sets]
     by (auto intro!: sets.countable_UN' I intro: sets.Int[OF measurable_sets measurable_sets])
   finally show "(\<lambda>x. f (g x) x) -` A \<inter> space M \<in> sets M" .
 qed
 
 lemma measurable_count_space_eq_countable:
   assumes "countable A"
   shows "f \<in> measurable M (count_space A) \<longleftrightarrow> (f \<in> space M \<rightarrow> A \<and> (\<forall>a\<in>A. f -` {a} \<inter> space M \<in> sets M))"
 proof -
   { fix X assume "X \<subseteq> A" "f \<in> space M \<rightarrow> A"
     with \<open>countable A\<close> have "f -` X \<inter> space M = (\<Union>a\<in>X. f -` {a} \<inter> space M)" "countable X"
       by (auto dest: countable_subset)
     moreover assume "\<forall>a\<in>A. f -` {a} \<inter> space M \<in> sets M"
     ultimately have "f -` X \<inter> space M \<in> sets M"
       using \<open>X \<subseteq> A\<close> by (auto intro!: sets.countable_UN' simp del: UN_simps) }
   then show ?thesis
     unfolding measurable_def by auto
 qed
 
 lemma measurable_count_space_eq2:
   "finite A \<Longrightarrow> f \<in> measurable M (count_space A) \<longleftrightarrow> (f \<in> space M \<rightarrow> A \<and> (\<forall>a\<in>A. f -` {a} \<inter> space M \<in> sets M))"
   by (intro measurable_count_space_eq_countable countable_finite)
 
 lemma measurable_count_space_eq2_countable:
   fixes f :: "'a => 'c::countable"
   shows "f \<in> measurable M (count_space A) \<longleftrightarrow> (f \<in> space M \<rightarrow> A \<and> (\<forall>a\<in>A. f -` {a} \<inter> space M \<in> sets M))"
   by (intro measurable_count_space_eq_countable countableI_type)
 
 lemma measurable_compose_countable:
   assumes f: "\<And>i::'i::countable. (\<lambda>x. f i x) \<in> measurable M N" and g: "g \<in> measurable M (count_space UNIV)"
   shows "(\<lambda>x. f (g x) x) \<in> measurable M N"
   by (rule measurable_compose_countable'[OF assms]) auto
 
 lemma measurable_count_space_const:
   "(\<lambda>x. c) \<in> measurable M (count_space UNIV)"
   by (simp add: measurable_const)
 
 lemma measurable_count_space:
   "f \<in> measurable (count_space A) (count_space UNIV)"
   by simp
 
 lemma measurable_compose_rev:
   assumes f: "f \<in> measurable L N" and g: "g \<in> measurable M L"
   shows "(\<lambda>x. f (g x)) \<in> measurable M N"
   using measurable_compose[OF g f] .
 
 lemma measurable_empty_iff:
   "space N = {} \<Longrightarrow> f \<in> measurable M N \<longleftrightarrow> space M = {}"
   by (auto simp add: measurable_def Pi_iff)
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Extend measure\<close>
 
 definition extend_measure :: "'a set \<Rightarrow> 'b set \<Rightarrow> ('b \<Rightarrow> 'a set) \<Rightarrow> ('b \<Rightarrow> ennreal) \<Rightarrow> 'a measure"
   where
 "extend_measure \<Omega> I G \<mu> =
   (if (\<exists>\<mu>'. (\<forall>i\<in>I. \<mu>' (G i) = \<mu> i) \<and> measure_space \<Omega> (sigma_sets \<Omega> (G`I)) \<mu>') \<and> \<not> (\<forall>i\<in>I. \<mu> i = 0)
       then measure_of \<Omega> (G`I) (SOME \<mu>'. (\<forall>i\<in>I. \<mu>' (G i) = \<mu> i) \<and> measure_space \<Omega> (sigma_sets \<Omega> (G`I)) \<mu>')
       else measure_of \<Omega> (G`I) (\<lambda>_. 0))"
 
 lemma space_extend_measure: "G ` I \<subseteq> Pow \<Omega> \<Longrightarrow> space (extend_measure \<Omega> I G \<mu>) = \<Omega>"
   unfolding extend_measure_def by simp
 
 lemma sets_extend_measure: "G ` I \<subseteq> Pow \<Omega> \<Longrightarrow> sets (extend_measure \<Omega> I G \<mu>) = sigma_sets \<Omega> (G`I)"
   unfolding extend_measure_def by simp
 
 lemma emeasure_extend_measure:
   assumes M: "M = extend_measure \<Omega> I G \<mu>"
     and eq: "\<And>i. i \<in> I \<Longrightarrow> \<mu>' (G i) = \<mu> i"
     and ms: "G ` I \<subseteq> Pow \<Omega>" "positive (sets M) \<mu>'" "countably_additive (sets M) \<mu>'"
     and "i \<in> I"
   shows "emeasure M (G i) = \<mu> i"
 proof cases
   assume *: "(\<forall>i\<in>I. \<mu> i = 0)"
   with M have M_eq: "M = measure_of \<Omega> (G`I) (\<lambda>_. 0)"
    by (simp add: extend_measure_def)
   from measure_space_0[OF ms(1)] ms \<open>i\<in>I\<close>
   have "emeasure M (G i) = 0"
     by (intro emeasure_measure_of[OF M_eq]) (auto simp add: M measure_space_def sets_extend_measure)
   with \<open>i\<in>I\<close> * show ?thesis
     by simp
 next
   define P where "P \<mu>' \<longleftrightarrow> (\<forall>i\<in>I. \<mu>' (G i) = \<mu> i) \<and> measure_space \<Omega> (sigma_sets \<Omega> (G`I)) \<mu>'" for \<mu>'
   assume "\<not> (\<forall>i\<in>I. \<mu> i = 0)"
   moreover
   have "measure_space (space M) (sets M) \<mu>'"
     using ms unfolding measure_space_def by auto standard
   with ms eq have "\<exists>\<mu>'. P \<mu>'"
     unfolding P_def
     by (intro exI[of _ \<mu>']) (auto simp add: M space_extend_measure sets_extend_measure)
   ultimately have M_eq: "M = measure_of \<Omega> (G`I) (Eps P)"
     by (simp add: M extend_measure_def P_def[symmetric])
 
   from \<open>\<exists>\<mu>'. P \<mu>'\<close> have P: "P (Eps P)" by (rule someI_ex)
   show "emeasure M (G i) = \<mu> i"
   proof (subst emeasure_measure_of[OF M_eq])
     have sets_M: "sets M = sigma_sets \<Omega> (G`I)"
       using M_eq ms by (auto simp: sets_extend_measure)
     then show "G i \<in> sets M" using \<open>i \<in> I\<close> by auto
     show "positive (sets M) (Eps P)" "countably_additive (sets M) (Eps P)" "Eps P (G i) = \<mu> i"
       using P \<open>i\<in>I\<close> by (auto simp add: sets_M measure_space_def P_def)
   qed fact
 qed
 
 lemma emeasure_extend_measure_Pair:
   assumes M: "M = extend_measure \<Omega> {(i, j). I i j} (\<lambda>(i, j). G i j) (\<lambda>(i, j). \<mu> i j)"
     and eq: "\<And>i j. I i j \<Longrightarrow> \<mu>' (G i j) = \<mu> i j"
     and ms: "\<And>i j. I i j \<Longrightarrow> G i j \<in> Pow \<Omega>" "positive (sets M) \<mu>'" "countably_additive (sets M) \<mu>'"
     and "I i j"
   shows "emeasure M (G i j) = \<mu> i j"
   using emeasure_extend_measure[OF M _ _ ms(2,3), of "(i,j)"] eq ms(1) \<open>I i j\<close>
   by (auto simp: subset_eq)
 
 subsection \<open>The smallest \<open>\<sigma>\<close>-algebra regarding a function\<close>
 
 definition\<^marker>\<open>tag important\<close> vimage_algebra :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b measure \<Rightarrow> 'a measure" where
   "vimage_algebra X f M = sigma X {f -` A \<inter> X | A. A \<in> sets M}"
 
 lemma space_vimage_algebra[simp]: "space (vimage_algebra X f M) = X"
   unfolding vimage_algebra_def by (rule space_measure_of) auto
 
 lemma sets_vimage_algebra: "sets (vimage_algebra X f M) = sigma_sets X {f -` A \<inter> X | A. A \<in> sets M}"
   unfolding vimage_algebra_def by (rule sets_measure_of) auto
 
 lemma sets_vimage_algebra2:
   "f \<in> X \<rightarrow> space M \<Longrightarrow> sets (vimage_algebra X f M) = {f -` A \<inter> X | A. A \<in> sets M}"
   using sigma_sets_vimage_commute[of f X "space M" "sets M"]
   unfolding sets_vimage_algebra sets.sigma_sets_eq by simp
 
 lemma sets_vimage_algebra_cong: "sets M = sets N \<Longrightarrow> sets (vimage_algebra X f M) = sets (vimage_algebra X f N)"
   by (simp add: sets_vimage_algebra)
 
 lemma vimage_algebra_cong:
   assumes "X = Y"
   assumes "\<And>x. x \<in> Y \<Longrightarrow> f x = g x"
   assumes "sets M = sets N"
   shows "vimage_algebra X f M = vimage_algebra Y g N"
   by (auto simp: vimage_algebra_def assms intro!: arg_cong2[where f=sigma])
 
 lemma in_vimage_algebra: "A \<in> sets M \<Longrightarrow> f -` A \<inter> X \<in> sets (vimage_algebra X f M)"
   by (auto simp: vimage_algebra_def)
 
 lemma sets_image_in_sets:
   assumes N: "space N = X"
   assumes f: "f \<in> measurable N M"
   shows "sets (vimage_algebra X f M) \<subseteq> sets N"
   unfolding sets_vimage_algebra N[symmetric]
   by (rule sets.sigma_sets_subset) (auto intro!: measurable_sets f)
 
 lemma measurable_vimage_algebra1: "f \<in> X \<rightarrow> space M \<Longrightarrow> f \<in> measurable (vimage_algebra X f M) M"
   unfolding measurable_def by (auto intro: in_vimage_algebra)
 
 lemma measurable_vimage_algebra2:
   assumes g: "g \<in> space N \<rightarrow> X" and f: "(\<lambda>x. f (g x)) \<in> measurable N M"
   shows "g \<in> measurable N (vimage_algebra X f M)"
   unfolding vimage_algebra_def
 proof (rule measurable_measure_of)
   fix A assume "A \<in> {f -` A \<inter> X | A. A \<in> sets M}"
   then obtain Y where Y: "Y \<in> sets M" and A: "A = f -` Y \<inter> X"
     by auto
   then have "g -` A \<inter> space N = (\<lambda>x. f (g x)) -` Y \<inter> space N"
     using g by auto
   also have "\<dots> \<in> sets N"
     using f Y by (rule measurable_sets)
   finally show "g -` A \<inter> space N \<in> sets N" .
 qed (insert g, auto)
 
 lemma vimage_algebra_sigma:
   assumes X: "X \<subseteq> Pow \<Omega>'" and f: "f \<in> \<Omega> \<rightarrow> \<Omega>'"
   shows "vimage_algebra \<Omega> f (sigma \<Omega>' X) = sigma \<Omega> {f -` A \<inter> \<Omega> | A. A \<in> X }" (is "?V = ?S")
 proof (rule measure_eqI)
   have \<Omega>: "{f -` A \<inter> \<Omega> |A. A \<in> X} \<subseteq> Pow \<Omega>" by auto
   show "sets ?V = sets ?S"
     using sigma_sets_vimage_commute[OF f, of X]
     by (simp add: space_measure_of_conv f sets_vimage_algebra2 \<Omega> X)
 qed (simp add: vimage_algebra_def emeasure_sigma)
 
 lemma vimage_algebra_vimage_algebra_eq:
   assumes *: "f \<in> X \<rightarrow> Y" "g \<in> Y \<rightarrow> space M"
   shows "vimage_algebra X f (vimage_algebra Y g M) = vimage_algebra X (\<lambda>x. g (f x)) M"
     (is "?VV = ?V")
 proof (rule measure_eqI)
   have "(\<lambda>x. g (f x)) \<in> X \<rightarrow> space M" "\<And>A. A \<inter> f -` Y \<inter> X = A \<inter> X"
     using * by auto
   with * show "sets ?VV = sets ?V"
     by (simp add: sets_vimage_algebra2 vimage_comp comp_def flip: ex_simps)
 qed (simp add: vimage_algebra_def emeasure_sigma)
 
 subsubsection \<open>Restricted Space Sigma Algebra\<close>
 
 definition restrict_space :: "'a measure \<Rightarrow> 'a set \<Rightarrow> 'a measure" where
   "restrict_space M \<Omega> = measure_of (\<Omega> \<inter> space M) (((\<inter>) \<Omega>) ` sets M) (emeasure M)"
 
 lemma space_restrict_space: "space (restrict_space M \<Omega>) = \<Omega> \<inter> space M"
   using sets.sets_into_space unfolding restrict_space_def by (subst space_measure_of) auto
 
 lemma space_restrict_space2 [simp]: "\<Omega> \<in> sets M \<Longrightarrow> space (restrict_space M \<Omega>) = \<Omega>"
   by (simp add: space_restrict_space sets.sets_into_space)
 
 lemma sets_restrict_space: "sets (restrict_space M \<Omega>) = ((\<inter>) \<Omega>) ` sets M"
   unfolding restrict_space_def
 proof (subst sets_measure_of)
   show "(\<inter>) \<Omega> ` sets M \<subseteq> Pow (\<Omega> \<inter> space M)"
     by (auto dest: sets.sets_into_space)
   have "sigma_sets (\<Omega> \<inter> space M) {((\<lambda>x. x) -` X) \<inter> (\<Omega> \<inter> space M) | X. X \<in> sets M} =
     (\<lambda>X. X \<inter> (\<Omega> \<inter> space M)) ` sets M"
     by (subst sigma_sets_vimage_commute[symmetric, where \<Omega>' = "space M"])
        (auto simp add: sets.sigma_sets_eq)
   moreover have "{((\<lambda>x. x) -` X) \<inter> (\<Omega> \<inter> space M) | X. X \<in> sets M} = (\<lambda>X. X \<inter> (\<Omega> \<inter> space M)) `  sets M"
     by auto
   moreover have "(\<lambda>X. X \<inter> (\<Omega> \<inter> space M)) `  sets M = ((\<inter>) \<Omega>) ` sets M"
     by (intro image_cong) (auto dest: sets.sets_into_space)
   ultimately show "sigma_sets (\<Omega> \<inter> space M) ((\<inter>) \<Omega> ` sets M) = (\<inter>) \<Omega> ` sets M"
     by simp
 qed
 
 lemma restrict_space_sets_cong:
   "A = B \<Longrightarrow> sets M = sets N \<Longrightarrow> sets (restrict_space M A) = sets (restrict_space N B)"
   by (auto simp: sets_restrict_space)
 
 lemma sets_restrict_space_count_space :
   "sets (restrict_space (count_space A) B) = sets (count_space (A \<inter> B))"
 by(auto simp add: sets_restrict_space)
 
 lemma sets_restrict_UNIV[simp]: "sets (restrict_space M UNIV) = sets M"
   by (auto simp add: sets_restrict_space)
 
 lemma sets_restrict_restrict_space:
   "sets (restrict_space (restrict_space M A) B) = sets (restrict_space M (A \<inter> B))"
   unfolding sets_restrict_space image_comp by (intro image_cong) auto
 
 lemma sets_restrict_space_iff:
   "\<Omega> \<inter> space M \<in> sets M \<Longrightarrow> A \<in> sets (restrict_space M \<Omega>) \<longleftrightarrow> (A \<subseteq> \<Omega> \<and> A \<in> sets M)"
 proof (subst sets_restrict_space, safe)
   fix A assume "\<Omega> \<inter> space M \<in> sets M" and A: "A \<in> sets M"
   then have "(\<Omega> \<inter> space M) \<inter> A \<in> sets M"
     by rule
   also have "(\<Omega> \<inter> space M) \<inter> A = \<Omega> \<inter> A"
     using sets.sets_into_space[OF A] by auto
   finally show "\<Omega> \<inter> A \<in> sets M"
     by auto
 qed auto
 
 lemma sets_restrict_space_cong: "sets M = sets N \<Longrightarrow> sets (restrict_space M \<Omega>) = sets (restrict_space N \<Omega>)"
   by (simp add: sets_restrict_space)
 
 lemma restrict_space_eq_vimage_algebra:
   "\<Omega> \<subseteq> space M \<Longrightarrow> sets (restrict_space M \<Omega>) = sets (vimage_algebra \<Omega> (\<lambda>x. x) M)"
   unfolding restrict_space_def
   apply (subst sets_measure_of)
   apply (auto simp add: image_subset_iff dest: sets.sets_into_space) []
   apply (auto simp add: sets_vimage_algebra intro!: arg_cong2[where f=sigma_sets])
   done
 
 lemma sets_Collect_restrict_space_iff:
   assumes "S \<in> sets M"
   shows "{x\<in>space (restrict_space M S). P x} \<in> sets (restrict_space M S) \<longleftrightarrow> {x\<in>space M. x \<in> S \<and> P x} \<in> sets M"
 proof -
   have "{x\<in>S. P x} = {x\<in>space M. x \<in> S \<and> P x}"
     using sets.sets_into_space[OF assms] by auto
   then show ?thesis
     by (subst sets_restrict_space_iff) (auto simp add: space_restrict_space assms)
 qed
 
 lemma measurable_restrict_space1:
   assumes f: "f \<in> measurable M N"
   shows "f \<in> measurable (restrict_space M \<Omega>) N"
   unfolding measurable_def
 proof (intro CollectI conjI ballI)
   show sp: "f \<in> space (restrict_space M \<Omega>) \<rightarrow> space N"
     using measurable_space[OF f] by (auto simp: space_restrict_space)
 
   fix A assume "A \<in> sets N"
   have "f -` A \<inter> space (restrict_space M \<Omega>) = (f -` A \<inter> space M) \<inter> (\<Omega> \<inter> space M)"
     by (auto simp: space_restrict_space)
   also have "\<dots> \<in> sets (restrict_space M \<Omega>)"
     unfolding sets_restrict_space
     using measurable_sets[OF f \<open>A \<in> sets N\<close>] by blast
   finally show "f -` A \<inter> space (restrict_space M \<Omega>) \<in> sets (restrict_space M \<Omega>)" .
 qed
 
 lemma measurable_restrict_space2_iff:
   "f \<in> measurable M (restrict_space N \<Omega>) \<longleftrightarrow> (f \<in> measurable M N \<and> f \<in> space M \<rightarrow> \<Omega>)"
 proof -
   have "\<And>A. f \<in> space M \<rightarrow> \<Omega> \<Longrightarrow> f -` \<Omega> \<inter> f -` A \<inter> space M = f -` A \<inter> space M"
     by auto
   then show ?thesis
     by (auto simp: measurable_def space_restrict_space Pi_Int[symmetric] sets_restrict_space)
 qed
 
 lemma measurable_restrict_space2:
   "f \<in> space M \<rightarrow> \<Omega> \<Longrightarrow> f \<in> measurable M N \<Longrightarrow> f \<in> measurable M (restrict_space N \<Omega>)"
   by (simp add: measurable_restrict_space2_iff)
 
 lemma measurable_piecewise_restrict:
   assumes I: "countable C"
     and X: "\<And>\<Omega>. \<Omega> \<in> C \<Longrightarrow> \<Omega> \<inter> space M \<in> sets M" "space M \<subseteq> \<Union>C"
     and f: "\<And>\<Omega>. \<Omega> \<in> C \<Longrightarrow> f \<in> measurable (restrict_space M \<Omega>) N"
   shows "f \<in> measurable M N"
 proof (rule measurableI)
   fix x assume "x \<in> space M"
   with X obtain \<Omega> where "\<Omega> \<in> C" "x \<in> \<Omega>" "x \<in> space M" by auto
   then show "f x \<in> space N"
     by (auto simp: space_restrict_space intro: f measurable_space)
 next
   fix A assume A: "A \<in> sets N"
   have "f -` A \<inter> space M = (\<Union>\<Omega>\<in>C. (f -` A \<inter> (\<Omega> \<inter> space M)))"
     using X by (auto simp: subset_eq)
   also have "\<dots> \<in> sets M"
     using measurable_sets[OF f A] X I
     by (intro sets.countable_UN') (auto simp: sets_restrict_space_iff space_restrict_space)
   finally show "f -` A \<inter> space M \<in> sets M" .
 qed
 
 lemma measurable_piecewise_restrict_iff:
   "countable C \<Longrightarrow> (\<And>\<Omega>. \<Omega> \<in> C \<Longrightarrow> \<Omega> \<inter> space M \<in> sets M) \<Longrightarrow> space M \<subseteq> (\<Union>C) \<Longrightarrow>
     f \<in> measurable M N \<longleftrightarrow> (\<forall>\<Omega>\<in>C. f \<in> measurable (restrict_space M \<Omega>) N)"
   by (auto intro: measurable_piecewise_restrict measurable_restrict_space1)
 
 lemma measurable_If_restrict_space_iff:
   "{x\<in>space M. P x} \<in> sets M \<Longrightarrow>
     (\<lambda>x. if P x then f x else g x) \<in> measurable M N \<longleftrightarrow>
     (f \<in> measurable (restrict_space M {x. P x}) N \<and> g \<in> measurable (restrict_space M {x. \<not> P x}) N)"
   by (subst measurable_piecewise_restrict_iff[where C="{{x. P x}, {x. \<not> P x}}"])
      (auto simp: Int_def sets.sets_Collect_neg space_restrict_space conj_commute[of _ "x \<in> space M" for x]
            cong: measurable_cong')
 
 lemma measurable_If:
   "f \<in> measurable M M' \<Longrightarrow> g \<in> measurable M M' \<Longrightarrow> {x\<in>space M. P x} \<in> sets M \<Longrightarrow>
     (\<lambda>x. if P x then f x else g x) \<in> measurable M M'"
   unfolding measurable_If_restrict_space_iff by (auto intro: measurable_restrict_space1)
 
 lemma measurable_If_set:
   assumes measure: "f \<in> measurable M M'" "g \<in> measurable M M'"
   assumes P: "A \<inter> space M \<in> sets M"
   shows "(\<lambda>x. if x \<in> A then f x else g x) \<in> measurable M M'"
 proof (rule measurable_If[OF measure])
   have "{x \<in> space M. x \<in> A} = A \<inter> space M" by auto
   thus "{x \<in> space M. x \<in> A} \<in> sets M" using \<open>A \<inter> space M \<in> sets M\<close> by auto
 qed
 
 lemma measurable_restrict_space_iff:
   "\<Omega> \<inter> space M \<in> sets M \<Longrightarrow> c \<in> space N \<Longrightarrow>
     f \<in> measurable (restrict_space M \<Omega>) N \<longleftrightarrow> (\<lambda>x. if x \<in> \<Omega> then f x else c) \<in> measurable M N"
   by (subst measurable_If_restrict_space_iff)
      (simp_all add: Int_def conj_commute measurable_const)
 
 lemma restrict_space_singleton: "{x} \<in> sets M \<Longrightarrow> sets (restrict_space M {x}) = sets (count_space {x})"
   using sets_restrict_space_iff[of "{x}" M]
   by (auto simp add: sets_restrict_space_iff dest!: subset_singletonD)
 
 lemma measurable_restrict_countable:
   assumes X[intro]: "countable X"
   assumes sets[simp]: "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M"
   assumes space[simp]: "\<And>x. x \<in> X \<Longrightarrow> f x \<in> space N"
   assumes f: "f \<in> measurable (restrict_space M (- X)) N"
   shows "f \<in> measurable M N"
   using f sets.countable[OF sets X]
   by (intro measurable_piecewise_restrict[where M=M and C="{- X} \<union> ((\<lambda>x. {x}) ` X)"])
      (auto simp: Diff_Int_distrib2 Compl_eq_Diff_UNIV Int_insert_left sets.Diff restrict_space_singleton
            simp del: sets_count_space  cong: measurable_cong_sets)
 
 lemma measurable_discrete_difference:
   assumes f: "f \<in> measurable M N"
   assumes X: "countable X" "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M" "\<And>x. x \<in> X \<Longrightarrow> g x \<in> space N"
   assumes eq: "\<And>x. x \<in> space M \<Longrightarrow> x \<notin> X \<Longrightarrow> f x = g x"
   shows "g \<in> measurable M N"
   by (rule measurable_restrict_countable[OF X])
      (auto simp: eq[symmetric] space_restrict_space cong: measurable_cong' intro: f measurable_restrict_space1)
 
 lemma measurable_count_space_extend: "A \<subseteq> B \<Longrightarrow> f \<in> space M \<rightarrow> A \<Longrightarrow> f \<in> M \<rightarrow>\<^sub>M count_space B \<Longrightarrow> f \<in> M \<rightarrow>\<^sub>M count_space A"
   by (auto simp: measurable_def)
 
 end
diff --git a/src/HOL/Analysis/Summation_Tests.thy b/src/HOL/Analysis/Summation_Tests.thy
--- a/src/HOL/Analysis/Summation_Tests.thy
+++ b/src/HOL/Analysis/Summation_Tests.thy
@@ -1,901 +1,901 @@
 (*  Title:    HOL/Analysis/Summation_Tests.thy
     Author:   Manuel Eberl, TU München
 *)
 
 section \<open>Radius of Convergence and Summation Tests\<close>
 
 theory Summation_Tests
 imports
   Complex_Main
   "HOL-Library.Discrete"
   "HOL-Library.Extended_Real"
   "HOL-Library.Liminf_Limsup"
   Extended_Real_Limits
 begin
 
 text \<open>
   The definition of the radius of convergence of a power series,
   various summability tests, lemmas to compute the radius of convergence etc.
 \<close>
 
 subsection \<open>Convergence tests for infinite sums\<close>
 
 subsubsection \<open>Root test\<close>
 
 lemma limsup_root_powser:
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   shows "limsup (\<lambda>n. ereal (root n (norm (f n * z ^ n)))) =
              limsup (\<lambda>n. ereal (root n (norm (f n)))) * ereal (norm z)"
 proof -
   have A: "(\<lambda>n. ereal (root n (norm (f n * z ^ n)))) =
               (\<lambda>n. ereal (root n (norm (f n))) * ereal (norm z))" (is "?g = ?h")
   proof
     fix n show "?g n = ?h n"
     by (cases "n = 0") (simp_all add: norm_mult real_root_mult real_root_pos2 norm_power)
   qed
   show ?thesis by (subst A, subst limsup_ereal_mult_right) simp_all
 qed
 
 lemma limsup_root_limit:
   assumes "(\<lambda>n. ereal (root n (norm (f n)))) \<longlonglongrightarrow> l" (is "?g \<longlonglongrightarrow> _")
   shows   "limsup (\<lambda>n. ereal (root n (norm (f n)))) = l"
 proof -
   from assms have "convergent ?g" "lim ?g = l"
     unfolding convergent_def by (blast intro: limI)+
   with convergent_limsup_cl show ?thesis by force
 qed
 
 lemma limsup_root_limit':
   assumes "(\<lambda>n. root n (norm (f n))) \<longlonglongrightarrow> l"
   shows   "limsup (\<lambda>n. ereal (root n (norm (f n)))) = ereal l"
   by (intro limsup_root_limit tendsto_ereal assms)
 
 theorem root_test_convergence':
   fixes f :: "nat \<Rightarrow> 'a :: banach"
   defines "l \<equiv> limsup (\<lambda>n. ereal (root n (norm (f n))))"
   assumes l: "l < 1"
   shows   "summable f"
 proof -
   have "0 = limsup (\<lambda>n. 0)" by (simp add: Limsup_const)
   also have "... \<le> l" unfolding l_def by (intro Limsup_mono) (simp_all add: real_root_ge_zero)
   finally have "l \<ge> 0" by simp
   with l obtain l' where l': "l = ereal l'" by (cases l) simp_all
 
   define c where "c = (1 - l') / 2"
   from l and \<open>l \<ge> 0\<close> have c: "l + c > l" "l' + c \<ge> 0" "l' + c < 1" unfolding c_def
     by (simp_all add: field_simps l')
   have "\<forall>C>l. eventually (\<lambda>n. ereal (root n (norm (f n))) < C) sequentially"
     by (subst Limsup_le_iff[symmetric]) (simp add: l_def)
   with c have "eventually (\<lambda>n. ereal (root n (norm (f n))) < l + ereal c) sequentially" by simp
   with eventually_gt_at_top[of "0::nat"]
     have "eventually (\<lambda>n. norm (f n) \<le> (l' + c) ^ n) sequentially"
   proof eventually_elim
     fix n :: nat assume n: "n > 0"
     assume "ereal (root n (norm (f n))) < l + ereal c"
     hence "root n (norm (f n)) \<le> l' + c" by (simp add: l')
     with c n have "root n (norm (f n)) ^ n \<le> (l' + c) ^ n"
       by (intro power_mono) (simp_all add: real_root_ge_zero)
     also from n have "root n (norm (f n)) ^ n = norm (f n)" by simp
     finally show "norm (f n) \<le> (l' + c) ^ n" by simp
   qed
   thus ?thesis
     by (rule summable_comparison_test_ev[OF _ summable_geometric]) (simp add: c)
 qed
 
 theorem root_test_divergence:
   fixes f :: "nat \<Rightarrow> 'a :: banach"
   defines "l \<equiv> limsup (\<lambda>n. ereal (root n (norm (f n))))"
   assumes l: "l > 1"
   shows   "\<not>summable f"
 proof
   assume "summable f"
   hence bounded: "Bseq f" by (simp add: summable_imp_Bseq)
 
   have "0 = limsup (\<lambda>n. 0)" by (simp add: Limsup_const)
   also have "... \<le> l" unfolding l_def by (intro Limsup_mono) (simp_all add: real_root_ge_zero)
   finally have l_nonneg: "l \<ge> 0" by simp
 
   define c where "c = (if l = \<infinity> then 2 else 1 + (real_of_ereal l - 1) / 2)"
   from l l_nonneg consider "l = \<infinity>" | "\<exists>l'. l = ereal l'" by (cases l) simp_all
   hence c: "c > 1 \<and> ereal c < l" by cases (insert l, auto simp: c_def field_simps)
 
   have unbounded: "\<not>bdd_above {n. root n (norm (f n)) > c}"
   proof
     assume "bdd_above {n. root n (norm (f n)) > c}"
     then obtain N where "\<forall>n. root n (norm (f n)) > c \<longrightarrow> n \<le> N" unfolding bdd_above_def by blast
     hence "\<exists>N. \<forall>n\<ge>N. root n (norm (f n)) \<le> c"
       by (intro exI[of _ "N + 1"]) (force simp: not_less_eq_eq[symmetric])
     hence "eventually (\<lambda>n. root n (norm (f n)) \<le> c) sequentially"
       by (auto simp: eventually_at_top_linorder)
     hence "l \<le> c" unfolding l_def by (intro Limsup_bounded) simp_all
     with c show False by auto
   qed
 
   from bounded obtain K where K: "K > 0" "\<And>n. norm (f n) \<le> K" using BseqE by blast
   define n where "n = nat \<lceil>log c K\<rceil>"
   from unbounded have "\<exists>m>n. c < root m (norm (f m))" unfolding bdd_above_def
     by (auto simp: not_le)
-  then guess m by (elim exE conjE) note m = this
+  then obtain m where m: "n < m" "c < root m (norm (f m))" by auto
   from c K have "K = c powr log c K" by (simp add: powr_def log_def)
   also from c have "c powr log c K \<le> c powr real n" unfolding n_def
     by (intro powr_mono, linarith, simp)
   finally have "K \<le> c ^ n" using c by (simp add: powr_realpow)
   also from c m have "c ^ n < c ^ m" by simp
   also from c m have "c ^ m < root m (norm (f m)) ^ m" by (intro power_strict_mono) simp_all
   also from m have "... = norm (f m)" by simp
   finally show False using K(2)[of m]  by simp
 qed
 
 
 subsubsection \<open>Cauchy's condensation test\<close>
 
 context
 fixes f :: "nat \<Rightarrow> real"
 begin
 
 private lemma condensation_inequality:
   assumes mono: "\<And>m n. 0 < m \<Longrightarrow> m \<le> n \<Longrightarrow> f n \<le> f m"
   shows   "(\<Sum>k=1..<n. f k) \<ge> (\<Sum>k=1..<n. f (2 * 2 ^ Discrete.log k))" (is "?thesis1")
           "(\<Sum>k=1..<n. f k) \<le> (\<Sum>k=1..<n. f (2 ^ Discrete.log k))" (is "?thesis2")
   by (intro sum_mono mono Discrete.log_exp2_ge Discrete.log_exp2_le, simp, simp)+
 
 private lemma condensation_condense1: "(\<Sum>k=1..<2^n. f (2 ^ Discrete.log k)) = (\<Sum>k<n. 2^k * f (2 ^ k))"
 proof (induction n)
   case (Suc n)
   have "{1..<2^Suc n} = {1..<2^n} \<union> {2^n..<(2^Suc n :: nat)}" by auto
   also have "(\<Sum>k\<in>\<dots>. f (2 ^ Discrete.log k)) =
                  (\<Sum>k<n. 2^k * f (2^k)) + (\<Sum>k = 2^n..<2^Suc n. f (2^Discrete.log k))"
     by (subst sum.union_disjoint) (insert Suc, auto)
   also have "Discrete.log k = n" if "k \<in> {2^n..<2^Suc n}" for k using that by (intro Discrete.log_eqI) simp_all
   hence "(\<Sum>k = 2^n..<2^Suc n. f (2^Discrete.log k)) = (\<Sum>(_::nat) = 2^n..<2^Suc n. f (2^n))"
     by (intro sum.cong) simp_all
   also have "\<dots> = 2^n * f (2^n)" by (simp)
   finally show ?case by simp
 qed simp
 
 private lemma condensation_condense2: "(\<Sum>k=1..<2^n. f (2 * 2 ^ Discrete.log k)) = (\<Sum>k<n. 2^k * f (2 ^ Suc k))"
 proof (induction n)
   case (Suc n)
   have "{1..<2^Suc n} = {1..<2^n} \<union> {2^n..<(2^Suc n :: nat)}" by auto
   also have "(\<Sum>k\<in>\<dots>. f (2 * 2 ^ Discrete.log k)) =
                  (\<Sum>k<n. 2^k * f (2^Suc k)) + (\<Sum>k = 2^n..<2^Suc n. f (2 * 2^Discrete.log k))"
     by (subst sum.union_disjoint) (insert Suc, auto)
   also have "Discrete.log k = n" if "k \<in> {2^n..<2^Suc n}" for k using that by (intro Discrete.log_eqI) simp_all
   hence "(\<Sum>k = 2^n..<2^Suc n. f (2*2^Discrete.log k)) = (\<Sum>(_::nat) = 2^n..<2^Suc n. f (2^Suc n))"
     by (intro sum.cong) simp_all
   also have "\<dots> = 2^n * f (2^Suc n)" by (simp)
   finally show ?case by simp
 qed simp
 
 theorem condensation_test:
   assumes mono: "\<And>m. 0 < m \<Longrightarrow> f (Suc m) \<le> f m"
   assumes nonneg: "\<And>n. f n \<ge> 0"
   shows "summable f \<longleftrightarrow> summable (\<lambda>n. 2^n * f (2^n))"
 proof -
   define f' where "f' n = (if n = 0 then 0 else f n)" for n
   from mono have mono': "decseq (\<lambda>n. f (Suc n))" by (intro decseq_SucI) simp
   hence mono': "f n \<le> f m" if "m \<le> n" "m > 0" for m n
     using that decseqD[OF mono', of "m - 1" "n - 1"] by simp
 
   have "(\<lambda>n. f (Suc n)) = (\<lambda>n. f' (Suc n))" by (intro ext) (simp add: f'_def)
   hence "summable f \<longleftrightarrow> summable f'"
     by (subst (1 2) summable_Suc_iff [symmetric]) (simp only:)
   also have "\<dots> \<longleftrightarrow> convergent (\<lambda>n. \<Sum>k<n. f' k)" unfolding summable_iff_convergent ..
   also have "monoseq (\<lambda>n. \<Sum>k<n. f' k)" unfolding f'_def
     by (intro mono_SucI1) (auto intro!: mult_nonneg_nonneg nonneg)
   hence "convergent (\<lambda>n. \<Sum>k<n. f' k) \<longleftrightarrow> Bseq (\<lambda>n. \<Sum>k<n. f' k)"
     by (rule monoseq_imp_convergent_iff_Bseq)
   also have "\<dots> \<longleftrightarrow> Bseq (\<lambda>n. \<Sum>k=1..<n. f' k)" unfolding One_nat_def
     by (subst sum_shift_lb_Suc0_0_upt) (simp_all add: f'_def atLeast0LessThan)
   also have "\<dots> \<longleftrightarrow> Bseq (\<lambda>n. \<Sum>k=1..<n. f k)" unfolding f'_def by simp
   also have "\<dots> \<longleftrightarrow> Bseq (\<lambda>n. \<Sum>k=1..<2^n. f k)"
     by (rule nonneg_incseq_Bseq_subseq_iff[symmetric])
        (auto intro!: sum_nonneg incseq_SucI nonneg simp: strict_mono_def)
   also have "\<dots> \<longleftrightarrow> Bseq (\<lambda>n. \<Sum>k<n. 2^k * f (2^k))"
   proof (intro iffI)
     assume A: "Bseq (\<lambda>n. \<Sum>k=1..<2^n. f k)"
     have "eventually (\<lambda>n. norm (\<Sum>k<n. 2^k * f (2^Suc k)) \<le> norm (\<Sum>k=1..<2^n. f k)) sequentially"
     proof (intro always_eventually allI)
       fix n :: nat
       have "norm (\<Sum>k<n. 2^k * f (2^Suc k)) = (\<Sum>k<n. 2^k * f (2^Suc k))" unfolding real_norm_def
         by (intro abs_of_nonneg sum_nonneg ballI mult_nonneg_nonneg nonneg) simp_all
       also have "\<dots> \<le> (\<Sum>k=1..<2^n. f k)"
         by (subst condensation_condense2 [symmetric]) (intro condensation_inequality mono')
       also have "\<dots> = norm \<dots>" unfolding real_norm_def
         by (intro abs_of_nonneg[symmetric] sum_nonneg ballI mult_nonneg_nonneg nonneg)
       finally show "norm (\<Sum>k<n. 2 ^ k * f (2 ^ Suc k)) \<le> norm (\<Sum>k=1..<2^n. f k)" .
     qed
     from this and A have "Bseq (\<lambda>n. \<Sum>k<n. 2^k * f (2^Suc k))" by (rule Bseq_eventually_mono)
     from Bseq_mult[OF Bfun_const[of 2] this] have "Bseq (\<lambda>n. \<Sum>k<n. 2^Suc k * f (2^Suc k))"
       by (simp add: sum_distrib_left sum_distrib_right mult_ac)
     hence "Bseq (\<lambda>n. (\<Sum>k=Suc 0..<Suc n. 2^k * f (2^k)) + f 1)"
       by (intro Bseq_add, subst sum.shift_bounds_Suc_ivl) (simp add: atLeast0LessThan)
     hence "Bseq (\<lambda>n. (\<Sum>k=0..<Suc n. 2^k * f (2^k)))"
       by (subst sum.atLeast_Suc_lessThan) (simp_all add: add_ac)
     thus "Bseq (\<lambda>n. (\<Sum>k<n. 2^k * f (2^k)))"
       by (subst (asm) Bseq_Suc_iff) (simp add: atLeast0LessThan)
   next
     assume A: "Bseq (\<lambda>n. (\<Sum>k<n. 2^k * f (2^k)))"
     have "eventually (\<lambda>n. norm (\<Sum>k=1..<2^n. f k) \<le> norm (\<Sum>k<n. 2^k * f (2^k))) sequentially"
     proof (intro always_eventually allI)
       fix n :: nat
       have "norm (\<Sum>k=1..<2^n. f k) = (\<Sum>k=1..<2^n. f k)" unfolding real_norm_def
         by (intro abs_of_nonneg sum_nonneg ballI mult_nonneg_nonneg nonneg)
       also have "\<dots> \<le> (\<Sum>k<n. 2^k * f (2^k))"
         by (subst condensation_condense1 [symmetric]) (intro condensation_inequality mono')
       also have "\<dots> = norm \<dots>" unfolding real_norm_def
         by (intro abs_of_nonneg [symmetric] sum_nonneg ballI mult_nonneg_nonneg nonneg) simp_all
       finally show "norm (\<Sum>k=1..<2^n. f k) \<le> norm (\<Sum>k<n. 2^k * f (2^k))" .
     qed
     from this and A show "Bseq (\<lambda>n. \<Sum>k=1..<2^n. f k)" by (rule Bseq_eventually_mono)
   qed
   also have "monoseq (\<lambda>n. (\<Sum>k<n. 2^k * f (2^k)))"
     by (intro mono_SucI1) (auto intro!: mult_nonneg_nonneg nonneg)
   hence "Bseq (\<lambda>n. (\<Sum>k<n. 2^k * f (2^k))) \<longleftrightarrow> convergent (\<lambda>n. (\<Sum>k<n. 2^k * f (2^k)))"
     by (rule monoseq_imp_convergent_iff_Bseq [symmetric])
   also have "\<dots> \<longleftrightarrow> summable (\<lambda>k. 2^k * f (2^k))" by (simp only: summable_iff_convergent)
   finally show ?thesis .
 qed
 
 end
 
 
 subsubsection \<open>Summability of powers\<close>
 
 lemma abs_summable_complex_powr_iff:
     "summable (\<lambda>n. norm (exp (of_real (ln (of_nat n)) * s))) \<longleftrightarrow> Re s < -1"
 proof (cases "Re s \<le> 0")
   let ?l = "\<lambda>n. complex_of_real (ln (of_nat n))"
   case False
   have "eventually (\<lambda>n. norm (1 :: real) \<le> norm (exp (?l n * s))) sequentially"
     apply (rule eventually_mono [OF eventually_gt_at_top[of "0::nat"]])
     using False ge_one_powr_ge_zero by auto
   from summable_comparison_test_ev[OF this] False show ?thesis by (auto simp: summable_const_iff)
 next
   let ?l = "\<lambda>n. complex_of_real (ln (of_nat n))"
   case True
   hence "summable (\<lambda>n. norm (exp (?l n * s))) \<longleftrightarrow> summable (\<lambda>n. 2^n * norm (exp (?l (2^n) * s)))"
     by (intro condensation_test) (auto intro!: mult_right_mono_neg)
   also have "(\<lambda>n. 2^n * norm (exp (?l (2^n) * s))) = (\<lambda>n. (2 powr (Re s + 1)) ^ n)"
   proof
     fix n :: nat
     have "2^n * norm (exp (?l (2^n) * s)) = exp (real n * ln 2) * exp (real n * ln 2 * Re s)"
       using True by (subst exp_of_nat_mult) (simp add: ln_realpow algebra_simps)
     also have "\<dots> = exp (real n * (ln 2 * (Re s + 1)))"
       by (simp add: algebra_simps exp_add)
     also have "\<dots> = exp (ln 2 * (Re s + 1)) ^ n" by (subst exp_of_nat_mult) simp
     also have "exp (ln 2 * (Re s + 1)) = 2 powr (Re s + 1)" by (simp add: powr_def)
     finally show "2^n * norm (exp (?l (2^n) * s)) = (2 powr (Re s + 1)) ^ n" .
   qed
   also have "summable \<dots> \<longleftrightarrow> 2 powr (Re s + 1) < 2 powr 0"
     by (subst summable_geometric_iff) simp
   also have "\<dots> \<longleftrightarrow> Re s < -1" by (subst powr_less_cancel_iff) (simp, linarith)
   finally show ?thesis .
 qed
 
 theorem summable_complex_powr_iff:
   assumes "Re s < -1"
   shows   "summable (\<lambda>n. exp (of_real (ln (of_nat n)) * s))"
   by (rule summable_norm_cancel, subst abs_summable_complex_powr_iff) fact
 
 lemma summable_real_powr_iff: "summable (\<lambda>n. of_nat n powr s :: real) \<longleftrightarrow> s < -1"
 proof -
   from eventually_gt_at_top[of "0::nat"]
     have "summable (\<lambda>n. of_nat n powr s) \<longleftrightarrow> summable (\<lambda>n. exp (ln (of_nat n) * s))"
     by (intro summable_cong) (auto elim!: eventually_mono simp: powr_def)
   also have "\<dots> \<longleftrightarrow> s < -1" using abs_summable_complex_powr_iff[of "of_real s"] by simp
   finally show ?thesis .
 qed
 
 lemma inverse_power_summable:
   assumes s: "s \<ge> 2"
   shows "summable (\<lambda>n. inverse (of_nat n ^ s :: 'a :: {real_normed_div_algebra,banach}))"
 proof (rule summable_norm_cancel, subst summable_cong)
   from eventually_gt_at_top[of "0::nat"]
     show "eventually (\<lambda>n. norm (inverse (of_nat n ^ s:: 'a)) = real_of_nat n powr (-real s)) at_top"
     by eventually_elim (simp add: norm_inverse norm_power powr_minus powr_realpow)
 qed (insert s summable_real_powr_iff[of "-s"], simp_all)
 
 lemma not_summable_harmonic: "\<not>summable (\<lambda>n. inverse (of_nat n) :: 'a :: real_normed_field)"
 proof
   assume "summable (\<lambda>n. inverse (of_nat n) :: 'a)"
   hence "convergent (\<lambda>n. norm (of_real (\<Sum>k<n. inverse (of_nat k)) :: 'a))"
     by (simp add: summable_iff_convergent convergent_norm)
   hence "convergent (\<lambda>n. abs (\<Sum>k<n. inverse (of_nat k)) :: real)" by (simp only: norm_of_real)
   also have "(\<lambda>n. abs (\<Sum>k<n. inverse (of_nat k)) :: real) = (\<lambda>n. \<Sum>k<n. inverse (of_nat k))"
     by (intro ext abs_of_nonneg sum_nonneg) auto
   also have "convergent \<dots> \<longleftrightarrow> summable (\<lambda>k. inverse (of_nat k) :: real)"
     by (simp add: summable_iff_convergent)
   finally show False using summable_real_powr_iff[of "-1"] by (simp add: powr_minus)
 qed
 
 
 subsubsection \<open>Kummer's test\<close>
 
 theorem kummers_test_convergence:
   fixes f p :: "nat \<Rightarrow> real"
   assumes pos_f: "eventually (\<lambda>n. f n > 0) sequentially"
   assumes nonneg_p: "eventually (\<lambda>n. p n \<ge> 0) sequentially"
   defines "l \<equiv> liminf (\<lambda>n. ereal (p n * f n / f (Suc n) - p (Suc n)))"
   assumes l: "l > 0"
   shows   "summable f"
   unfolding summable_iff_convergent'
 proof -
   define r where "r = (if l = \<infinity> then 1 else real_of_ereal l / 2)"
   from l have "r > 0 \<and> of_real r < l" by (cases l) (simp_all add: r_def)
   hence r: "r > 0" "of_real r < l" by simp_all
   hence "eventually (\<lambda>n. p n * f n / f (Suc n) - p (Suc n) > r) sequentially"
     unfolding l_def by (force dest: less_LiminfD)
   moreover from pos_f have "eventually (\<lambda>n. f (Suc n) > 0) sequentially"
     by (subst eventually_sequentially_Suc)
   ultimately have "eventually (\<lambda>n. p n * f n - p (Suc n) * f (Suc n) > r * f (Suc n)) sequentially"
     by eventually_elim (simp add: field_simps)
   from eventually_conj[OF pos_f eventually_conj[OF nonneg_p this]]
     obtain m where m: "\<And>n. n \<ge> m \<Longrightarrow> f n > 0" "\<And>n. n \<ge> m \<Longrightarrow> p n \<ge> 0"
         "\<And>n. n \<ge> m \<Longrightarrow> p n * f n - p (Suc n) * f (Suc n) > r * f (Suc n)"
     unfolding eventually_at_top_linorder by blast
 
   let ?c = "(norm (\<Sum>k\<le>m. r * f k) + p m * f m) / r"
   have "Bseq (\<lambda>n. (\<Sum>k\<le>n + Suc m. f k))"
   proof (rule BseqI')
     fix k :: nat
     define n where "n = k + Suc m"
     have n: "n > m" by (simp add: n_def)
 
     from r have "r * norm (\<Sum>k\<le>n. f k) = norm (\<Sum>k\<le>n. r * f k)"
       by (simp add: sum_distrib_left[symmetric] abs_mult)
     also from n have "{..n} = {..m} \<union> {Suc m..n}" by auto
     hence "(\<Sum>k\<le>n. r * f k) = (\<Sum>k\<in>{..m} \<union> {Suc m..n}. r * f k)" by (simp only:)
     also have "\<dots> = (\<Sum>k\<le>m. r * f k) + (\<Sum>k=Suc m..n. r * f k)"
       by (subst sum.union_disjoint) auto
     also have "norm \<dots> \<le> norm (\<Sum>k\<le>m. r * f k) + norm (\<Sum>k=Suc m..n. r * f k)"
       by (rule norm_triangle_ineq)
     also from r less_imp_le[OF m(1)] have "(\<Sum>k=Suc m..n. r * f k) \<ge> 0"
       by (intro sum_nonneg) auto
     hence "norm (\<Sum>k=Suc m..n. r * f k) = (\<Sum>k=Suc m..n. r * f k)" by simp
     also have "(\<Sum>k=Suc m..n. r * f k) = (\<Sum>k=m..<n. r * f (Suc k))"
      by (subst sum.shift_bounds_Suc_ivl [symmetric])
           (simp only: atLeastLessThanSuc_atLeastAtMost)
     also from m have "\<dots> \<le> (\<Sum>k=m..<n. p k * f k - p (Suc k) * f (Suc k))"
       by (intro sum_mono[OF less_imp_le]) simp_all
     also have "\<dots> = -(\<Sum>k=m..<n. p (Suc k) * f (Suc k) - p k * f k)"
       by (simp add: sum_negf [symmetric] algebra_simps)
     also from n have "\<dots> = p m * f m - p n * f n"
       by (cases n, simp, simp only: atLeastLessThanSuc_atLeastAtMost, subst sum_Suc_diff) simp_all
     also from less_imp_le[OF m(1)] m(2) n have "\<dots> \<le> p m * f m" by simp
     finally show "norm (\<Sum>k\<le>n. f k) \<le> (norm (\<Sum>k\<le>m. r * f k) + p m * f m) / r" using r
       by (subst pos_le_divide_eq[OF r(1)]) (simp only: mult_ac)
   qed
   moreover have "(\<Sum>k\<le>n. f k) \<le> (\<Sum>k\<le>n'. f k)" if "Suc m \<le> n" "n \<le> n'" for n n'
     using less_imp_le[OF m(1)] that by (intro sum_mono2) auto
   ultimately show "convergent (\<lambda>n. \<Sum>k\<le>n. f k)" by (rule Bseq_monoseq_convergent'_inc)
 qed
 
 
 theorem kummers_test_divergence:
   fixes f p :: "nat \<Rightarrow> real"
   assumes pos_f: "eventually (\<lambda>n. f n > 0) sequentially"
   assumes pos_p: "eventually (\<lambda>n. p n > 0) sequentially"
   assumes divergent_p: "\<not>summable (\<lambda>n. inverse (p n))"
   defines "l \<equiv> limsup (\<lambda>n. ereal (p n * f n / f (Suc n) - p (Suc n)))"
   assumes l: "l < 0"
   shows   "\<not>summable f"
 proof
   assume "summable f"
   from eventually_conj[OF pos_f eventually_conj[OF pos_p Limsup_lessD[OF l[unfolded l_def]]]]
     obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> p n > 0" "\<And>n. n \<ge> N \<Longrightarrow> f n > 0"
                       "\<And>n. n \<ge> N \<Longrightarrow> p n * f n / f (Suc n) - p (Suc n) < 0"
     by (auto simp: eventually_at_top_linorder)
   hence A: "p n * f n < p (Suc n) * f (Suc n)" if "n \<ge> N" for n using that N[of n] N[of "Suc n"]
     by (simp add: field_simps)
   have B: "p n * f n \<ge> p N * f N" if "n \<ge> N" for n using that and A
     by (induction n rule: dec_induct) (auto intro!: less_imp_le elim!: order.trans)
   have "eventually (\<lambda>n. norm (p N * f N * inverse (p n)) \<le> f n) sequentially"
     apply (rule eventually_mono [OF eventually_ge_at_top[of N]])
     using B N  by (auto  simp: field_simps abs_of_pos)
   from this and \<open>summable f\<close> have "summable (\<lambda>n. p N * f N * inverse (p n))"
     by (rule summable_comparison_test_ev)
   from summable_mult[OF this, of "inverse (p N * f N)"] N[OF le_refl]
     have "summable (\<lambda>n. inverse (p n))" by (simp add: field_split_simps)
   with divergent_p show False by contradiction
 qed
 
 
 subsubsection \<open>Ratio test\<close>
 
 theorem ratio_test_convergence:
   fixes f :: "nat \<Rightarrow> real"
   assumes pos_f: "eventually (\<lambda>n. f n > 0) sequentially"
   defines "l \<equiv> liminf (\<lambda>n. ereal (f n / f (Suc n)))"
   assumes l: "l > 1"
   shows   "summable f"
 proof (rule kummers_test_convergence[OF pos_f])
   note l
   also have "l = liminf (\<lambda>n. ereal (f n / f (Suc n) - 1)) + 1"
     by (subst Liminf_add_ereal_right[symmetric]) (simp_all add: minus_ereal_def l_def one_ereal_def)
   finally show "liminf (\<lambda>n. ereal (1 * f n / f (Suc n) - 1)) > 0"
     by (cases "liminf (\<lambda>n. ereal (1 * f n / f (Suc n) - 1))") simp_all
 qed simp
 
 theorem ratio_test_divergence:
   fixes f :: "nat \<Rightarrow> real"
   assumes pos_f: "eventually (\<lambda>n. f n > 0) sequentially"
   defines "l \<equiv> limsup (\<lambda>n. ereal (f n / f (Suc n)))"
   assumes l: "l < 1"
   shows   "\<not>summable f"
 proof (rule kummers_test_divergence[OF pos_f])
   have "limsup (\<lambda>n. ereal (f n / f (Suc n) - 1)) + 1 = l"
     by (subst Limsup_add_ereal_right[symmetric]) (simp_all add: minus_ereal_def l_def one_ereal_def)
   also note l
   finally show "limsup (\<lambda>n. ereal (1 * f n / f (Suc n) - 1)) < 0"
     by (cases "limsup (\<lambda>n. ereal (1 * f n / f (Suc n) - 1))") simp_all
 qed (simp_all add: summable_const_iff)
 
 
 subsubsection \<open>Raabe's test\<close>
 
 theorem raabes_test_convergence:
 fixes f :: "nat \<Rightarrow> real"
   assumes pos: "eventually (\<lambda>n. f n > 0) sequentially"
   defines "l \<equiv> liminf (\<lambda>n. ereal (of_nat n * (f n / f (Suc n) - 1)))"
   assumes l: "l > 1"
   shows   "summable f"
 proof (rule kummers_test_convergence)
   let ?l' = "liminf (\<lambda>n. ereal (of_nat n * f n / f (Suc n) - of_nat (Suc n)))"
   have "1 < l" by fact
   also have "l = liminf (\<lambda>n. ereal (of_nat n * f n / f (Suc n) - of_nat (Suc n)) + 1)"
     by (simp add: l_def algebra_simps)
   also have "\<dots> = ?l' + 1" by (subst Liminf_add_ereal_right) simp_all
   finally show "?l' > 0" by (cases ?l') (simp_all add: algebra_simps)
 qed (simp_all add: pos)
 
 theorem raabes_test_divergence:
 fixes f :: "nat \<Rightarrow> real"
   assumes pos: "eventually (\<lambda>n. f n > 0) sequentially"
   defines "l \<equiv> limsup (\<lambda>n. ereal (of_nat n * (f n / f (Suc n) - 1)))"
   assumes l: "l < 1"
   shows   "\<not>summable f"
 proof (rule kummers_test_divergence)
   let ?l' = "limsup (\<lambda>n. ereal (of_nat n * f n / f (Suc n) - of_nat (Suc n)))"
   note l
   also have "l = limsup (\<lambda>n. ereal (of_nat n * f n / f (Suc n) - of_nat (Suc n)) + 1)"
     by (simp add: l_def algebra_simps)
   also have "\<dots> = ?l' + 1" by (subst Limsup_add_ereal_right) simp_all
   finally show "?l' < 0" by (cases ?l') (simp_all add: algebra_simps)
 qed (insert pos eventually_gt_at_top[of "0::nat"] not_summable_harmonic, simp_all)
 
 
 subsection \<open>Radius of convergence\<close>
 
 text \<open>
   The radius of convergence of a power series. This value always exists, ranges from
   \<^term>\<open>0::ereal\<close> to \<^term>\<open>\<infinity>::ereal\<close>, and the power series is guaranteed to converge for
   all inputs with a norm that is smaller than that radius and to diverge for all inputs with a
   norm that is greater.
 \<close>
 definition\<^marker>\<open>tag important\<close> conv_radius :: "(nat \<Rightarrow> 'a :: banach) \<Rightarrow> ereal" where
   "conv_radius f = inverse (limsup (\<lambda>n. ereal (root n (norm (f n)))))"
 
 lemma conv_radius_cong_weak [cong]: "(\<And>n. f n = g n) \<Longrightarrow> conv_radius f = conv_radius g"
   by (drule ext) simp_all
 
 lemma conv_radius_nonneg: "conv_radius f \<ge> 0"
 proof -
   have "0 = limsup (\<lambda>n. 0)" by (subst Limsup_const) simp_all
   also have "\<dots> \<le> limsup (\<lambda>n. ereal (root n (norm (f n))))"
     by (intro Limsup_mono) (simp_all add: real_root_ge_zero)
   finally show ?thesis
     unfolding conv_radius_def by (auto simp: ereal_inverse_nonneg_iff)
 qed
 
 lemma conv_radius_zero [simp]: "conv_radius (\<lambda>_. 0) = \<infinity>"
   by (auto simp: conv_radius_def zero_ereal_def [symmetric] Limsup_const)
 
 lemma conv_radius_altdef:
   "conv_radius f = liminf (\<lambda>n. inverse (ereal (root n (norm (f n)))))"
   by (subst Liminf_inverse_ereal) (simp_all add: real_root_ge_zero conv_radius_def)
 
 lemma conv_radius_cong':
   assumes "eventually (\<lambda>x. f x = g x) sequentially"
   shows   "conv_radius f = conv_radius g"
   unfolding conv_radius_altdef by (intro Liminf_eq eventually_mono [OF assms]) auto
 
 lemma conv_radius_cong:
   assumes "eventually (\<lambda>x. norm (f x) = norm (g x)) sequentially"
   shows   "conv_radius f = conv_radius g"
   unfolding conv_radius_altdef by (intro Liminf_eq eventually_mono [OF assms]) auto
 
 theorem abs_summable_in_conv_radius:
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   assumes "ereal (norm z) < conv_radius f"
   shows   "summable (\<lambda>n. norm (f n * z ^ n))"
 proof (rule root_test_convergence')
   define l where "l = limsup (\<lambda>n. ereal (root n (norm (f n))))"
   have "0 = limsup (\<lambda>n. 0)" by (simp add: Limsup_const)
   also have "... \<le> l" unfolding l_def by (intro Limsup_mono) (simp_all add: real_root_ge_zero)
   finally have l_nonneg: "l \<ge> 0" .
 
   have "limsup (\<lambda>n. root n (norm (f n * z^n))) = l * ereal (norm z)" unfolding l_def
     by (rule limsup_root_powser)
   also from l_nonneg consider "l = 0" | "l = \<infinity>" | "\<exists>l'. l = ereal l' \<and> l' > 0"
     by (cases "l") (auto simp: less_le)
   hence "l * ereal (norm z) < 1"
   proof cases
     assume "l = \<infinity>"
     hence "conv_radius f = 0" unfolding conv_radius_def l_def by simp
     with assms show ?thesis by simp
   next
     assume "\<exists>l'. l = ereal l' \<and> l' > 0"
-    then guess l' by (elim exE conjE) note l' = this
+    then obtain l' where l': "l = ereal l'" "0 < l'" by auto
     hence "l \<noteq> \<infinity>" by auto
     have "l * ereal (norm z) < l * conv_radius f"
       by (intro ereal_mult_strict_left_mono) (simp_all add: l' assms)
     also have "conv_radius f = inverse l" by (simp add: conv_radius_def l_def)
     also from l' have "l * inverse l = 1" by simp
     finally show ?thesis .
   qed simp_all
   finally show "limsup (\<lambda>n. ereal (root n (norm (norm (f n * z ^ n))))) < 1" by simp
 qed
 
 lemma summable_in_conv_radius:
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   assumes "ereal (norm z) < conv_radius f"
   shows   "summable (\<lambda>n. f n * z ^ n)"
   by (rule summable_norm_cancel, rule abs_summable_in_conv_radius) fact+
 
 theorem not_summable_outside_conv_radius:
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   assumes "ereal (norm z) > conv_radius f"
   shows   "\<not>summable (\<lambda>n. f n * z ^ n)"
 proof (rule root_test_divergence)
   define l where "l = limsup (\<lambda>n. ereal (root n (norm (f n))))"
   have "0 = limsup (\<lambda>n. 0)" by (simp add: Limsup_const)
   also have "... \<le> l" unfolding l_def by (intro Limsup_mono) (simp_all add: real_root_ge_zero)
   finally have l_nonneg: "l \<ge> 0" .
   from assms have l_nz: "l \<noteq> 0" unfolding conv_radius_def l_def by auto
 
   have "limsup (\<lambda>n. ereal (root n (norm (f n * z^n)))) = l * ereal (norm z)"
     unfolding l_def by (rule limsup_root_powser)
   also have "... > 1"
   proof (cases l)
     assume "l = \<infinity>"
     with assms conv_radius_nonneg[of f] show ?thesis
       by (auto simp: zero_ereal_def[symmetric])
   next
     fix l' assume l': "l = ereal l'"
     from l_nonneg l_nz have "1 = l * inverse l" by (auto simp: l' field_simps)
     also from l_nz have "inverse l = conv_radius f"
       unfolding l_def conv_radius_def by auto
     also from l' l_nz l_nonneg assms have "l * \<dots> < l * ereal (norm z)"
       by (intro ereal_mult_strict_left_mono) (auto simp: l')
     finally show ?thesis .
   qed (insert l_nonneg, simp_all)
   finally show "limsup (\<lambda>n. ereal (root n (norm (f n * z^n)))) > 1" .
 qed
 
 
 lemma conv_radius_geI:
   assumes "summable (\<lambda>n. f n * z ^ n :: 'a :: {banach, real_normed_div_algebra})"
   shows   "conv_radius f \<ge> norm z"
   using not_summable_outside_conv_radius[of f z] assms by (force simp: not_le[symmetric])
 
 lemma conv_radius_leI:
   assumes "\<not>summable (\<lambda>n. norm (f n * z ^ n :: 'a :: {banach, real_normed_div_algebra}))"
   shows   "conv_radius f \<le> norm z"
   using abs_summable_in_conv_radius[of z f] assms by (force simp: not_le[symmetric])
 
 lemma conv_radius_leI':
   assumes "\<not>summable (\<lambda>n. f n * z ^ n :: 'a :: {banach, real_normed_div_algebra})"
   shows   "conv_radius f \<le> norm z"
   using summable_in_conv_radius[of z f] assms by (force simp: not_le[symmetric])
 
 lemma conv_radius_geI_ex:
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   assumes "\<And>r. 0 < r \<Longrightarrow> ereal r < R \<Longrightarrow> \<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z^n)"
   shows   "conv_radius f \<ge> R"
 proof (rule linorder_cases[of "conv_radius f" R])
   assume R: "conv_radius f < R"
   with conv_radius_nonneg[of f] obtain conv_radius'
     where [simp]: "conv_radius f = ereal conv_radius'"
     by (cases "conv_radius f") simp_all
   define r where "r = (if R = \<infinity> then conv_radius' + 1 else (real_of_ereal R + conv_radius') / 2)"
   from R conv_radius_nonneg[of f] have "0 < r \<and> ereal r < R \<and> ereal r > conv_radius f"
     unfolding r_def by (cases R) (auto simp: r_def field_simps)
   with assms(1)[of r] obtain z where "norm z > conv_radius f" "summable (\<lambda>n. f n * z^n)" by auto
   with not_summable_outside_conv_radius[of f z] show ?thesis by simp
 qed simp_all
 
 lemma conv_radius_geI_ex':
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   assumes "\<And>r. 0 < r \<Longrightarrow> ereal r < R \<Longrightarrow> summable (\<lambda>n. f n * of_real r^n)"
   shows   "conv_radius f \<ge> R"
 proof (rule conv_radius_geI_ex)
   fix r assume "0 < r" "ereal r < R"
   with assms[of r] show "\<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z ^ n)"
     by (intro exI[of _ "of_real r :: 'a"]) auto
 qed
 
 lemma conv_radius_leI_ex:
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   assumes "R \<ge> 0"
   assumes "\<And>r. 0 < r \<Longrightarrow> ereal r > R \<Longrightarrow> \<exists>z. norm z = r \<and> \<not>summable (\<lambda>n. norm (f n * z^n))"
   shows   "conv_radius f \<le> R"
 proof (rule linorder_cases[of "conv_radius f" R])
   assume R: "conv_radius f > R"
   from R assms(1) obtain R' where R': "R = ereal R'" by (cases R) simp_all
   define r where
     "r = (if conv_radius f = \<infinity> then R' + 1 else (R' + real_of_ereal (conv_radius f)) / 2)"
   from R conv_radius_nonneg[of f] have "r > R \<and> r < conv_radius f" unfolding r_def
     by (cases "conv_radius f") (auto simp: r_def field_simps R')
   with assms(1) assms(2)[of r] R'
     obtain z where "norm z < conv_radius f" "\<not>summable (\<lambda>n. norm (f n * z^n))" by auto
   with abs_summable_in_conv_radius[of z f] show ?thesis by auto
 qed simp_all
 
 lemma conv_radius_leI_ex':
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   assumes "R \<ge> 0"
   assumes "\<And>r. 0 < r \<Longrightarrow> ereal r > R \<Longrightarrow> \<not>summable (\<lambda>n. f n * of_real r^n)"
   shows   "conv_radius f \<le> R"
 proof (rule conv_radius_leI_ex)
   fix r assume "0 < r" "ereal r > R"
   with assms(2)[of r] show "\<exists>z. norm z = r \<and> \<not>summable (\<lambda>n. norm (f n * z ^ n))"
     by (intro exI[of _ "of_real r :: 'a"]) (auto dest: summable_norm_cancel)
 qed fact+
 
 lemma conv_radius_eqI:
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   assumes "R \<ge> 0"
   assumes "\<And>r. 0 < r \<Longrightarrow> ereal r < R \<Longrightarrow> \<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z^n)"
   assumes "\<And>r. 0 < r \<Longrightarrow> ereal r > R \<Longrightarrow> \<exists>z. norm z = r \<and> \<not>summable (\<lambda>n. norm (f n * z^n))"
   shows   "conv_radius f = R"
   by (intro antisym conv_radius_geI_ex conv_radius_leI_ex assms)
 
 lemma conv_radius_eqI':
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   assumes "R \<ge> 0"
   assumes "\<And>r. 0 < r \<Longrightarrow> ereal r < R \<Longrightarrow> summable (\<lambda>n. f n * (of_real r)^n)"
   assumes "\<And>r. 0 < r \<Longrightarrow> ereal r > R \<Longrightarrow> \<not>summable (\<lambda>n. norm (f n * (of_real r)^n))"
   shows   "conv_radius f = R"
 proof (intro conv_radius_eqI[OF assms(1)])
   fix r assume "0 < r" "ereal r < R" with assms(2)[OF this]
     show "\<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z ^ n)" by force
 next
   fix r assume "0 < r" "ereal r > R" with assms(3)[OF this]
     show "\<exists>z. norm z = r \<and> \<not>summable (\<lambda>n. norm (f n * z ^ n))" by force
 qed
 
 lemma conv_radius_zeroI:
   fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
   assumes "\<And>z. z \<noteq> 0 \<Longrightarrow> \<not>summable (\<lambda>n. f n * z^n)"
   shows   "conv_radius f = 0"
 proof (rule ccontr)
   assume "conv_radius f \<noteq> 0"
   with conv_radius_nonneg[of f] have pos: "conv_radius f > 0" by simp
   define r where "r = (if conv_radius f = \<infinity> then 1 else real_of_ereal (conv_radius f) / 2)"
   from pos have r: "ereal r > 0 \<and> ereal r < conv_radius f"
     by (cases "conv_radius f") (simp_all add: r_def)
   hence "summable (\<lambda>n. f n * of_real r ^ n)" by (intro summable_in_conv_radius) simp
   moreover from r and assms[of "of_real r"] have "\<not>summable (\<lambda>n. f n * of_real r ^ n)" by simp
   ultimately show False by contradiction
 qed
 
 lemma conv_radius_inftyI':
   fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
   assumes "\<And>r. r > c \<Longrightarrow> \<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z^n)"
   shows   "conv_radius f = \<infinity>"
 proof -
   {
     fix r :: real
     have "max r (c + 1) > c" by (auto simp: max_def)
     from assms[OF this] obtain z where "norm z = max r (c + 1)" "summable (\<lambda>n. f n * z^n)" by blast
     from conv_radius_geI[OF this(2)] this(1) have "conv_radius f \<ge> r" by simp
   }
   from this[of "real_of_ereal (conv_radius f + 1)"] show "conv_radius f = \<infinity>"
     by (cases "conv_radius f") simp_all
 qed
 
 lemma conv_radius_inftyI:
   fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
   assumes "\<And>r. \<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z^n)"
   shows   "conv_radius f = \<infinity>"
   using assms by (rule conv_radius_inftyI')
 
 lemma conv_radius_inftyI'':
   fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
   assumes "\<And>z. summable (\<lambda>n. f n * z^n)"
   shows   "conv_radius f = \<infinity>"
 proof (rule conv_radius_inftyI')
   fix r :: real assume "r > 0"
   with assms show "\<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z^n)"
     by (intro exI[of _ "of_real r"]) simp
 qed
 
 lemma conv_radius_conv_Sup:
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   shows "conv_radius f = Sup {r. \<forall>z. ereal (norm z) < r \<longrightarrow> summable (\<lambda>n. f n * z ^ n)}"
 proof (rule Sup_eqI [symmetric], goal_cases)
   case (1 r)
   thus ?case
     by (intro conv_radius_geI_ex') auto
 next
   case (2 r)
   from 2[of 0] have r: "r \<ge> 0" by auto
   show ?case
   proof (intro conv_radius_leI_ex' r)
     fix R assume R: "R > 0" "ereal R > r"
     with r obtain r' where [simp]: "r = ereal r'" by (cases r) auto
     show "\<not>summable (\<lambda>n. f n * of_real R ^ n)"
     proof
       assume *: "summable (\<lambda>n. f n * of_real R ^ n)"
       define R' where "R' = (R + r') / 2"
       from R have R': "R' > r'" "R' < R" by (simp_all add: R'_def)
       hence "\<forall>z. norm z < R' \<longrightarrow> summable (\<lambda>n. f n * z ^ n)"
         using powser_inside[OF *] by auto
       from 2[of R'] and this have "R' \<le> r'" by auto
       with \<open>R' > r'\<close> show False by simp
     qed
   qed
 qed
 
 lemma conv_radius_shift:
   fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
   shows   "conv_radius (\<lambda>n. f (n + m)) = conv_radius f"
   unfolding conv_radius_conv_Sup summable_powser_ignore_initial_segment ..
 
 lemma conv_radius_norm [simp]: "conv_radius (\<lambda>x. norm (f x)) = conv_radius f"
   by (simp add: conv_radius_def)
 
 lemma conv_radius_ratio_limit_ereal:
   fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
   assumes nz:  "eventually (\<lambda>n. f n \<noteq> 0) sequentially"
   assumes lim: "(\<lambda>n. ereal (norm (f n) / norm (f (Suc n)))) \<longlonglongrightarrow> c"
   shows   "conv_radius f = c"
 proof (rule conv_radius_eqI')
   show "c \<ge> 0" by (intro Lim_bounded2[OF lim]) simp_all
 next
   fix r assume r: "0 < r" "ereal r < c"
   let ?l = "liminf (\<lambda>n. ereal (norm (f n * of_real r ^ n) / norm (f (Suc n) * of_real r ^ Suc n)))"
   have "?l = liminf (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n)))) * ereal (inverse r))"
     using r by (simp add: norm_mult norm_power field_split_simps)
   also from r have "\<dots> = liminf (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n))))) * ereal (inverse r)"
     by (intro Liminf_ereal_mult_right) simp_all
   also have "liminf (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n))))) = c"
     by (intro lim_imp_Liminf lim) simp
   finally have l: "?l = c * ereal (inverse r)" by simp
   from r have  l': "c * ereal (inverse r) > 1" by (cases c) (simp_all add: field_simps)
   show "summable (\<lambda>n. f n * of_real r^n)"
     by (rule summable_norm_cancel, rule ratio_test_convergence)
        (insert r nz l l', auto elim!: eventually_mono)
 next
   fix r assume r: "0 < r" "ereal r > c"
   let ?l = "limsup (\<lambda>n. ereal (norm (f n * of_real r ^ n) / norm (f (Suc n) * of_real r ^ Suc n)))"
   have "?l = limsup (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n)))) * ereal (inverse r))"
     using r by (simp add: norm_mult norm_power field_split_simps)
   also from r have "\<dots> = limsup (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n))))) * ereal (inverse r)"
     by (intro Limsup_ereal_mult_right) simp_all
   also have "limsup (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n))))) = c"
     by (intro lim_imp_Limsup lim) simp
   finally have l: "?l = c * ereal (inverse r)" by simp
   from r have  l': "c * ereal (inverse r) < 1" by (cases c) (simp_all add: field_simps)
   show "\<not>summable (\<lambda>n. norm (f n * of_real r^n))"
     by (rule ratio_test_divergence) (insert r nz l l', auto elim!: eventually_mono)
 qed
 
 lemma conv_radius_ratio_limit_ereal_nonzero:
   fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
   assumes nz:  "c \<noteq> 0"
   assumes lim: "(\<lambda>n. ereal (norm (f n) / norm (f (Suc n)))) \<longlonglongrightarrow> c"
   shows   "conv_radius f = c"
 proof (rule conv_radius_ratio_limit_ereal[OF _ lim], rule ccontr)
   assume "\<not>eventually (\<lambda>n. f n \<noteq> 0) sequentially"
   hence "frequently (\<lambda>n. f n = 0) sequentially" by (simp add: frequently_def)
   hence "frequently (\<lambda>n. ereal (norm (f n) / norm (f (Suc n))) = 0) sequentially"
     by (force elim!: frequently_elim1)
   hence "c = 0" by (intro limit_frequently_eq[OF _ _ lim]) auto
   with nz show False by contradiction
 qed
 
 lemma conv_radius_ratio_limit:
   fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
   assumes "c' = ereal c"
   assumes nz:  "eventually (\<lambda>n. f n \<noteq> 0) sequentially"
   assumes lim: "(\<lambda>n. norm (f n) / norm (f (Suc n))) \<longlonglongrightarrow> c"
   shows   "conv_radius f = c'"
   using assms by (intro conv_radius_ratio_limit_ereal) simp_all
 
 lemma conv_radius_ratio_limit_nonzero:
   fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
   assumes "c' = ereal c"
   assumes nz:  "c \<noteq> 0"
   assumes lim: "(\<lambda>n. norm (f n) / norm (f (Suc n))) \<longlonglongrightarrow> c"
   shows   "conv_radius f = c'"
   using assms by (intro conv_radius_ratio_limit_ereal_nonzero) simp_all
 
 lemma conv_radius_cmult_left:
   assumes "c \<noteq> (0 :: 'a :: {banach, real_normed_div_algebra})"
   shows   "conv_radius (\<lambda>n. c * f n) = conv_radius f"
 proof -
   have "conv_radius (\<lambda>n. c * f n) = 
           inverse (limsup (\<lambda>n. ereal (root n (norm (c * f n)))))"
     unfolding conv_radius_def ..
   also have "(\<lambda>n. ereal (root n (norm (c * f n)))) = 
                (\<lambda>n. ereal (root n (norm c)) * ereal (root n (norm (f n))))"
     by (rule ext) (auto simp: norm_mult real_root_mult)
   also have "limsup \<dots> = ereal 1 * limsup (\<lambda>n. ereal (root n (norm (f n))))"
     using assms by (intro ereal_limsup_lim_mult tendsto_ereal LIMSEQ_root_const) auto
   also have "inverse \<dots> = conv_radius f" by (simp add: conv_radius_def)
   finally show ?thesis .
 qed
 
 lemma conv_radius_cmult_right:
   assumes "c \<noteq> (0 :: 'a :: {banach, real_normed_div_algebra})"
   shows   "conv_radius (\<lambda>n. f n * c) = conv_radius f"
 proof -
   have "conv_radius (\<lambda>n. f n * c) = conv_radius (\<lambda>n. c * f n)"
     by (simp add: conv_radius_def norm_mult mult.commute)
   with conv_radius_cmult_left[OF assms, of f] show ?thesis by simp
 qed
 
 lemma conv_radius_mult_power:
   assumes "c \<noteq> (0 :: 'a :: {real_normed_div_algebra,banach})"
   shows   "conv_radius (\<lambda>n. c ^ n * f n) = conv_radius f / ereal (norm c)"
 proof -
   have "limsup (\<lambda>n. ereal (root n (norm (c ^ n * f n)))) =
           limsup (\<lambda>n. ereal (norm c) * ereal (root n (norm (f n))))"
     by (intro Limsup_eq eventually_mono [OF eventually_gt_at_top[of "0::nat"]])
        (auto simp: norm_mult norm_power real_root_mult real_root_power)
   also have "\<dots> = ereal (norm c) * limsup (\<lambda>n. ereal (root n (norm (f n))))"
     using assms by (subst Limsup_ereal_mult_left[symmetric]) simp_all
   finally have A: "limsup (\<lambda>n. ereal (root n (norm (c ^ n * f n)))) =
                        ereal (norm c) * limsup (\<lambda>n. ereal (root n (norm (f n))))" .
   show ?thesis using assms
     apply (cases "limsup (\<lambda>n. ereal (root n (norm (f n)))) = 0")
     apply (simp add: A conv_radius_def)
     apply (unfold conv_radius_def A divide_ereal_def, simp add: mult.commute ereal_inverse_mult)
     done
 qed
 
 lemma conv_radius_mult_power_right:
   assumes "c \<noteq> (0 :: 'a :: {real_normed_div_algebra,banach})"
   shows   "conv_radius (\<lambda>n. f n * c ^ n) = conv_radius f / ereal (norm c)"
   using conv_radius_mult_power[OF assms, of f]
   unfolding conv_radius_def by (simp add: mult.commute norm_mult)
 
 lemma conv_radius_divide_power:
   assumes "c \<noteq> (0 :: 'a :: {real_normed_div_algebra,banach})"
   shows   "conv_radius (\<lambda>n. f n / c^n) = conv_radius f * ereal (norm c)"
 proof -
   from assms have "inverse c \<noteq> 0" by simp
   from conv_radius_mult_power_right[OF this, of f] show ?thesis
     by (simp add: divide_inverse divide_ereal_def assms norm_inverse power_inverse)
 qed
 
 
 lemma conv_radius_add_ge:
   "min (conv_radius f) (conv_radius g) \<le>
        conv_radius (\<lambda>x. f x + g x :: 'a :: {banach,real_normed_div_algebra})"
   by (rule conv_radius_geI_ex')
      (auto simp: algebra_simps intro!: summable_add summable_in_conv_radius)
 
 lemma conv_radius_mult_ge:
   fixes f g :: "nat \<Rightarrow> ('a :: {banach,real_normed_div_algebra})"
   shows "conv_radius (\<lambda>x. \<Sum>i\<le>x. f i * g (x - i)) \<ge> min (conv_radius f) (conv_radius g)"
 proof (rule conv_radius_geI_ex')
   fix r assume r: "r > 0" "ereal r < min (conv_radius f) (conv_radius g)"
   from r have "summable (\<lambda>n. (\<Sum>i\<le>n. (f i * of_real r^i) * (g (n - i) * of_real r^(n - i))))"
     by (intro summable_Cauchy_product abs_summable_in_conv_radius) simp_all
   thus "summable (\<lambda>n. (\<Sum>i\<le>n. f i * g (n - i)) * of_real r ^ n)"
     by (simp add: algebra_simps of_real_def power_add [symmetric] scaleR_sum_right)
 qed
 
 lemma le_conv_radius_iff:
   fixes a :: "nat \<Rightarrow> 'a::{real_normed_div_algebra,banach}"
   shows "r \<le> conv_radius a \<longleftrightarrow> (\<forall>x. norm (x-\<xi>) < r \<longrightarrow> summable (\<lambda>i. a i * (x - \<xi>) ^ i))"
 apply (intro iffI allI impI summable_in_conv_radius conv_radius_geI_ex)
 apply (meson less_ereal.simps(1) not_le order_trans)
 apply (rule_tac x="of_real ra" in exI, simp)
 apply (metis abs_of_nonneg add_diff_cancel_left' less_eq_real_def norm_of_real)
 done
 
 end
diff --git a/src/HOL/Combinatorics/Multiset_Permutations.thy b/src/HOL/Combinatorics/Multiset_Permutations.thy
--- a/src/HOL/Combinatorics/Multiset_Permutations.thy
+++ b/src/HOL/Combinatorics/Multiset_Permutations.thy
@@ -1,513 +1,514 @@
 (*  Author:     Manuel Eberl (TU München)
 
 Defines the set of permutations of a given multiset (or set), i.e. the set of all lists whose 
 entries correspond to the multiset (resp. set).
 *)
 
 section \<open>Permutations of a Multiset\<close>
 
 theory Multiset_Permutations
 imports
   Complex_Main
   Permutations
 begin
 
 (* TODO Move *)
 lemma mset_tl: "xs \<noteq> [] \<Longrightarrow> mset (tl xs) = mset xs - {#hd xs#}"
   by (cases xs) simp_all
 
 lemma mset_set_image_inj:
   assumes "inj_on f A"
   shows   "mset_set (f ` A) = image_mset f (mset_set A)"
 proof (cases "finite A")
   case True
   from this and assms show ?thesis by (induction A) auto
 qed (insert assms, simp add: finite_image_iff)
 
 lemma multiset_remove_induct [case_names empty remove]:
   assumes "P {#}" "\<And>A. A \<noteq> {#} \<Longrightarrow> (\<And>x. x \<in># A \<Longrightarrow> P (A - {#x#})) \<Longrightarrow> P A"
   shows   "P A"
 proof (induction A rule: full_multiset_induct)
   case (less A)
   hence IH: "P B" if "B \<subset># A" for B using that by blast
   show ?case
   proof (cases "A = {#}")
     case True
     thus ?thesis by (simp add: assms)
   next
     case False
     hence "P (A - {#x#})" if "x \<in># A" for x
       using that by (intro IH) (simp add: mset_subset_diff_self)
     from False and this show "P A" by (rule assms)
   qed
 qed
 
 lemma map_list_bind: "map g (List.bind xs f) = List.bind xs (map g \<circ> f)"
   by (simp add: List.bind_def map_concat)
 
 lemma mset_eq_mset_set_imp_distinct:
   "finite A \<Longrightarrow> mset_set A = mset xs \<Longrightarrow> distinct xs"
 proof (induction xs arbitrary: A)
   case (Cons x xs A)
   from Cons.prems(2) have "x \<in># mset_set A" by simp
   with Cons.prems(1) have [simp]: "x \<in> A" by simp
   from Cons.prems have "x \<notin># mset_set (A - {x})" by simp
   also from Cons.prems have "mset_set (A - {x}) = mset_set A - {#x#}"
     by (subst mset_set_Diff) simp_all
   also have "mset_set A = mset (x#xs)" by (simp add: Cons.prems)
   also have "\<dots> - {#x#} = mset xs" by simp
   finally have [simp]: "x \<notin> set xs" by (simp add: in_multiset_in_set)
   from Cons.prems show ?case by (auto intro!: Cons.IH[of "A - {x}"] simp: mset_set_Diff)
 qed simp_all
 (* END TODO *)
 
 
 subsection \<open>Permutations of a multiset\<close>
 
 definition permutations_of_multiset :: "'a multiset \<Rightarrow> 'a list set" where
   "permutations_of_multiset A = {xs. mset xs = A}"
 
 lemma permutations_of_multisetI: "mset xs = A \<Longrightarrow> xs \<in> permutations_of_multiset A"
   by (simp add: permutations_of_multiset_def)
 
 lemma permutations_of_multisetD: "xs \<in> permutations_of_multiset A \<Longrightarrow> mset xs = A"
   by (simp add: permutations_of_multiset_def)
 
 lemma permutations_of_multiset_Cons_iff:
   "x # xs \<in> permutations_of_multiset A \<longleftrightarrow> x \<in># A \<and> xs \<in> permutations_of_multiset (A - {#x#})"
   by (auto simp: permutations_of_multiset_def)
 
 lemma permutations_of_multiset_empty [simp]: "permutations_of_multiset {#} = {[]}"
   unfolding permutations_of_multiset_def by simp
 
 lemma permutations_of_multiset_nonempty: 
   assumes nonempty: "A \<noteq> {#}"
   shows   "permutations_of_multiset A = 
              (\<Union>x\<in>set_mset A. ((#) x) ` permutations_of_multiset (A - {#x#}))" (is "_ = ?rhs")
 proof safe
   fix xs assume "xs \<in> permutations_of_multiset A"
   hence mset_xs: "mset xs = A" by (simp add: permutations_of_multiset_def)
   hence "xs \<noteq> []" by (auto simp: nonempty)
   then obtain x xs' where xs: "xs = x # xs'" by (cases xs) simp_all
   with mset_xs have "x \<in> set_mset A" "xs' \<in> permutations_of_multiset (A - {#x#})"
     by (auto simp: permutations_of_multiset_def)
   with xs show "xs \<in> ?rhs" by auto
 qed (auto simp: permutations_of_multiset_def)
 
 lemma permutations_of_multiset_singleton [simp]: "permutations_of_multiset {#x#} = {[x]}"
   by (simp add: permutations_of_multiset_nonempty)
 
 lemma permutations_of_multiset_doubleton: 
   "permutations_of_multiset {#x,y#} = {[x,y], [y,x]}"
   by (simp add: permutations_of_multiset_nonempty insert_commute)
 
 lemma rev_permutations_of_multiset [simp]:
   "rev ` permutations_of_multiset A = permutations_of_multiset A"
 proof
   have "rev ` rev ` permutations_of_multiset A \<subseteq> rev ` permutations_of_multiset A"
     unfolding permutations_of_multiset_def by auto
   also have "rev ` rev ` permutations_of_multiset A = permutations_of_multiset A"
     by (simp add: image_image)
   finally show "permutations_of_multiset A \<subseteq> rev ` permutations_of_multiset A" .
 next
   show "rev ` permutations_of_multiset A \<subseteq> permutations_of_multiset A"
     unfolding permutations_of_multiset_def by auto
 qed
 
 lemma length_finite_permutations_of_multiset:
   "xs \<in> permutations_of_multiset A \<Longrightarrow> length xs = size A"
   by (auto simp: permutations_of_multiset_def)
 
 lemma permutations_of_multiset_lists: "permutations_of_multiset A \<subseteq> lists (set_mset A)"
   by (auto simp: permutations_of_multiset_def)
 
 lemma finite_permutations_of_multiset [simp]: "finite (permutations_of_multiset A)"
 proof (rule finite_subset)
   show "permutations_of_multiset A \<subseteq> {xs. set xs \<subseteq> set_mset A \<and> length xs = size A}" 
     by (auto simp: permutations_of_multiset_def)
   show "finite {xs. set xs \<subseteq> set_mset A \<and> length xs = size A}" 
     by (rule finite_lists_length_eq) simp_all
 qed
 
 lemma permutations_of_multiset_not_empty [simp]: "permutations_of_multiset A \<noteq> {}"
 proof -
-  from ex_mset[of A] guess xs ..
+  from ex_mset[of A] obtain xs where "mset xs = A" ..
   thus ?thesis by (auto simp: permutations_of_multiset_def)
 qed
 
 lemma permutations_of_multiset_image:
   "permutations_of_multiset (image_mset f A) = map f ` permutations_of_multiset A"
 proof safe
   fix xs assume A: "xs \<in> permutations_of_multiset (image_mset f A)"
   from ex_mset[of A] obtain ys where ys: "mset ys = A" ..
   with A have "mset xs = mset (map f ys)" 
     by (simp add: permutations_of_multiset_def)
-  from mset_eq_permutation[OF this] guess \<sigma> . note \<sigma> = this
+  then obtain \<sigma> where \<sigma>: "\<sigma> permutes {..<length (map f ys)}" "permute_list \<sigma> (map f ys) = xs"
+    by (rule mset_eq_permutation)
   with ys have "xs = map f (permute_list \<sigma> ys)"
     by (simp add: permute_list_map)
   moreover from \<sigma> ys have "permute_list \<sigma> ys \<in> permutations_of_multiset A"
     by (simp add: permutations_of_multiset_def)
   ultimately show "xs \<in> map f ` permutations_of_multiset A" by blast
 qed (auto simp: permutations_of_multiset_def)
 
 
 subsection \<open>Cardinality of permutations\<close>
 
 text \<open>
   In this section, we prove some basic facts about the number of permutations of a multiset.
 \<close>
 
 context
 begin
 
 private lemma multiset_prod_fact_insert:
   "(\<Prod>y\<in>set_mset (A+{#x#}). fact (count (A+{#x#}) y)) =
      (count A x + 1) * (\<Prod>y\<in>set_mset A. fact (count A y))"
 proof -
   have "(\<Prod>y\<in>set_mset (A+{#x#}). fact (count (A+{#x#}) y)) =
           (\<Prod>y\<in>set_mset (A+{#x#}). (if y = x then count A x + 1 else 1) * fact (count A y))"
     by (intro prod.cong) simp_all
   also have "\<dots> = (count A x + 1) * (\<Prod>y\<in>set_mset (A+{#x#}). fact (count A y))"
     by (simp add: prod.distrib)
   also have "(\<Prod>y\<in>set_mset (A+{#x#}). fact (count A y)) = (\<Prod>y\<in>set_mset A. fact (count A y))"
     by (intro prod.mono_neutral_right) (auto simp: not_in_iff)
   finally show ?thesis .
 qed
 
 private lemma multiset_prod_fact_remove:
   "x \<in># A \<Longrightarrow> (\<Prod>y\<in>set_mset A. fact (count A y)) =
                    count A x * (\<Prod>y\<in>set_mset (A-{#x#}). fact (count (A-{#x#}) y))"
   using multiset_prod_fact_insert[of "A - {#x#}" x] by simp
 
 lemma card_permutations_of_multiset_aux:
   "card (permutations_of_multiset A) * (\<Prod>x\<in>set_mset A. fact (count A x)) = fact (size A)"
 proof (induction A rule: multiset_remove_induct)
   case (remove A)
   have "card (permutations_of_multiset A) = 
           card (\<Union>x\<in>set_mset A. (#) x ` permutations_of_multiset (A - {#x#}))"
     by (simp add: permutations_of_multiset_nonempty remove.hyps)
   also have "\<dots> = (\<Sum>x\<in>set_mset A. card (permutations_of_multiset (A - {#x#})))"
     by (subst card_UN_disjoint) (auto simp: card_image)
   also have "\<dots> * (\<Prod>x\<in>set_mset A. fact (count A x)) = 
                (\<Sum>x\<in>set_mset A. card (permutations_of_multiset (A - {#x#})) * 
                  (\<Prod>y\<in>set_mset A. fact (count A y)))"
     by (subst sum_distrib_right) simp_all
   also have "\<dots> = (\<Sum>x\<in>set_mset A. count A x * fact (size A - 1))"
   proof (intro sum.cong refl)
     fix x assume x: "x \<in># A"
     have "card (permutations_of_multiset (A - {#x#})) * (\<Prod>y\<in>set_mset A. fact (count A y)) = 
             count A x * (card (permutations_of_multiset (A - {#x#})) * 
               (\<Prod>y\<in>set_mset (A - {#x#}). fact (count (A - {#x#}) y)))" (is "?lhs = _")
       by (subst multiset_prod_fact_remove[OF x]) simp_all
     also note remove.IH[OF x]
     also from x have "size (A - {#x#}) = size A - 1" by (simp add: size_Diff_submset)
     finally show "?lhs = count A x * fact (size A - 1)" .
   qed
   also have "(\<Sum>x\<in>set_mset A. count A x * fact (size A - 1)) =
                 size A * fact (size A - 1)"
     by (simp add: sum_distrib_right size_multiset_overloaded_eq)
   also from remove.hyps have "\<dots> = fact (size A)"
     by (cases "size A") auto
   finally show ?case .
 qed simp_all
 
 theorem card_permutations_of_multiset:
   "card (permutations_of_multiset A) = fact (size A) div (\<Prod>x\<in>set_mset A. fact (count A x))"
   "(\<Prod>x\<in>set_mset A. fact (count A x) :: nat) dvd fact (size A)"
   by (simp_all flip: card_permutations_of_multiset_aux[of A])
 
 lemma card_permutations_of_multiset_insert_aux:
   "card (permutations_of_multiset (A + {#x#})) * (count A x + 1) = 
       (size A + 1) * card (permutations_of_multiset A)"
 proof -
   note card_permutations_of_multiset_aux[of "A + {#x#}"]
   also have "fact (size (A + {#x#})) = (size A + 1) * fact (size A)" by simp
   also note multiset_prod_fact_insert[of A x]
   also note card_permutations_of_multiset_aux[of A, symmetric]
   finally have "card (permutations_of_multiset (A + {#x#})) * (count A x + 1) *
                     (\<Prod>y\<in>set_mset A. fact (count A y)) =
                 (size A + 1) * card (permutations_of_multiset A) *
                     (\<Prod>x\<in>set_mset A. fact (count A x))" by (simp only: mult_ac)
   thus ?thesis by (subst (asm) mult_right_cancel) simp_all
 qed
 
 lemma card_permutations_of_multiset_remove_aux:
   assumes "x \<in># A"
   shows   "card (permutations_of_multiset A) * count A x = 
              size A * card (permutations_of_multiset (A - {#x#}))"
 proof -
   from assms have A: "A - {#x#} + {#x#} = A" by simp
   from assms have B: "size A = size (A - {#x#}) + 1" 
     by (subst A [symmetric], subst size_union) simp
   show ?thesis
     using card_permutations_of_multiset_insert_aux[of "A - {#x#}" x, unfolded A] assms
     by (simp add: B)
 qed
 
 lemma real_card_permutations_of_multiset_remove:
   assumes "x \<in># A"
   shows   "real (card (permutations_of_multiset (A - {#x#}))) = 
              real (card (permutations_of_multiset A) * count A x) / real (size A)"
   using assms by (subst card_permutations_of_multiset_remove_aux[OF assms]) auto
 
 lemma real_card_permutations_of_multiset_remove':
   assumes "x \<in># A"
   shows   "real (card (permutations_of_multiset A)) = 
              real (size A * card (permutations_of_multiset (A - {#x#}))) / real (count A x)"
   using assms by (subst card_permutations_of_multiset_remove_aux[OF assms, symmetric]) simp
 
 end
 
 
 
 subsection \<open>Permutations of a set\<close>
 
 definition permutations_of_set :: "'a set \<Rightarrow> 'a list set" where
   "permutations_of_set A = {xs. set xs = A \<and> distinct xs}"
 
 lemma permutations_of_set_altdef:
   "finite A \<Longrightarrow> permutations_of_set A = permutations_of_multiset (mset_set A)"
   by (auto simp add: permutations_of_set_def permutations_of_multiset_def mset_set_set 
         in_multiset_in_set [symmetric] mset_eq_mset_set_imp_distinct)
 
 lemma permutations_of_setI [intro]:
   assumes "set xs = A" "distinct xs"
   shows   "xs \<in> permutations_of_set A"
   using assms unfolding permutations_of_set_def by simp
   
 lemma permutations_of_setD:
   assumes "xs \<in> permutations_of_set A"
   shows   "set xs = A" "distinct xs"
   using assms unfolding permutations_of_set_def by simp_all
   
 lemma permutations_of_set_lists: "permutations_of_set A \<subseteq> lists A"
   unfolding permutations_of_set_def by auto
 
 lemma permutations_of_set_empty [simp]: "permutations_of_set {} = {[]}"
   by (auto simp: permutations_of_set_def)
   
 lemma UN_set_permutations_of_set [simp]:
   "finite A \<Longrightarrow> (\<Union>xs\<in>permutations_of_set A. set xs) = A"
   using finite_distinct_list by (auto simp: permutations_of_set_def)
 
 lemma permutations_of_set_infinite:
   "\<not>finite A \<Longrightarrow> permutations_of_set A = {}"
   by (auto simp: permutations_of_set_def)
 
 lemma permutations_of_set_nonempty:
   "A \<noteq> {} \<Longrightarrow> permutations_of_set A = 
                   (\<Union>x\<in>A. (\<lambda>xs. x # xs) ` permutations_of_set (A - {x}))"
   by (cases "finite A")
      (simp_all add: permutations_of_multiset_nonempty mset_set_empty_iff mset_set_Diff 
                     permutations_of_set_altdef permutations_of_set_infinite)
     
 lemma permutations_of_set_singleton [simp]: "permutations_of_set {x} = {[x]}"
   by (subst permutations_of_set_nonempty) auto
 
 lemma permutations_of_set_doubleton: 
   "x \<noteq> y \<Longrightarrow> permutations_of_set {x,y} = {[x,y], [y,x]}"
   by (subst permutations_of_set_nonempty) 
      (simp_all add: insert_Diff_if insert_commute)
 
 lemma rev_permutations_of_set [simp]:
   "rev ` permutations_of_set A = permutations_of_set A"
   by (cases "finite A") (simp_all add: permutations_of_set_altdef permutations_of_set_infinite)
 
 lemma length_finite_permutations_of_set:
   "xs \<in> permutations_of_set A \<Longrightarrow> length xs = card A"
   by (auto simp: permutations_of_set_def distinct_card)
 
 lemma finite_permutations_of_set [simp]: "finite (permutations_of_set A)"
   by (cases "finite A") (simp_all add: permutations_of_set_infinite permutations_of_set_altdef)
 
 lemma permutations_of_set_empty_iff [simp]:
   "permutations_of_set A = {} \<longleftrightarrow> \<not>finite A"
   unfolding permutations_of_set_def using finite_distinct_list[of A] by auto
 
 lemma card_permutations_of_set [simp]:
   "finite A \<Longrightarrow> card (permutations_of_set A) = fact (card A)"
   by (simp add: permutations_of_set_altdef card_permutations_of_multiset del: One_nat_def)
 
 lemma permutations_of_set_image_inj:
   assumes inj: "inj_on f A"
   shows   "permutations_of_set (f ` A) = map f ` permutations_of_set A"
   by (cases "finite A")
      (simp_all add: permutations_of_set_infinite permutations_of_set_altdef
                     permutations_of_multiset_image mset_set_image_inj inj finite_image_iff)
 
 lemma permutations_of_set_image_permutes:
   "\<sigma> permutes A \<Longrightarrow> map \<sigma> ` permutations_of_set A = permutations_of_set A"
   by (subst permutations_of_set_image_inj [symmetric])
      (simp_all add: permutes_inj_on permutes_image)
 
 
 subsection \<open>Code generation\<close>
 
 text \<open>
   First, we give code an implementation for permutations of lists.
 \<close>
 
 declare length_remove1 [termination_simp] 
 
 fun permutations_of_list_impl where
   "permutations_of_list_impl xs = (if xs = [] then [[]] else
      List.bind (remdups xs) (\<lambda>x. map ((#) x) (permutations_of_list_impl (remove1 x xs))))"
 
 fun permutations_of_list_impl_aux where
   "permutations_of_list_impl_aux acc xs = (if xs = [] then [acc] else
      List.bind (remdups xs) (\<lambda>x. permutations_of_list_impl_aux (x#acc) (remove1 x xs)))"
 
 declare permutations_of_list_impl_aux.simps [simp del]    
 declare permutations_of_list_impl.simps [simp del]
     
 lemma permutations_of_list_impl_Nil [simp]:
   "permutations_of_list_impl [] = [[]]"
   by (simp add: permutations_of_list_impl.simps)
 
 lemma permutations_of_list_impl_nonempty:
   "xs \<noteq> [] \<Longrightarrow> permutations_of_list_impl xs = 
      List.bind (remdups xs) (\<lambda>x. map ((#) x) (permutations_of_list_impl (remove1 x xs)))"
   by (subst permutations_of_list_impl.simps) simp_all
 
 lemma set_permutations_of_list_impl:
   "set (permutations_of_list_impl xs) = permutations_of_multiset (mset xs)"
   by (induction xs rule: permutations_of_list_impl.induct)
      (subst permutations_of_list_impl.simps, 
       simp_all add: permutations_of_multiset_nonempty set_list_bind)
 
 lemma distinct_permutations_of_list_impl:
   "distinct (permutations_of_list_impl xs)"
   by (induction xs rule: permutations_of_list_impl.induct, 
       subst permutations_of_list_impl.simps)
      (auto intro!: distinct_list_bind simp: distinct_map o_def disjoint_family_on_def)
 
 lemma permutations_of_list_impl_aux_correct':
   "permutations_of_list_impl_aux acc xs = 
      map (\<lambda>xs. rev xs @ acc) (permutations_of_list_impl xs)"
   by (induction acc xs rule: permutations_of_list_impl_aux.induct,
       subst permutations_of_list_impl_aux.simps, subst permutations_of_list_impl.simps)
      (auto simp: map_list_bind intro!: list_bind_cong)
     
 lemma permutations_of_list_impl_aux_correct:
   "permutations_of_list_impl_aux [] xs = map rev (permutations_of_list_impl xs)"
   by (simp add: permutations_of_list_impl_aux_correct')
 
 lemma distinct_permutations_of_list_impl_aux:
   "distinct (permutations_of_list_impl_aux acc xs)"
   by (simp add: permutations_of_list_impl_aux_correct' distinct_map 
         distinct_permutations_of_list_impl inj_on_def)
 
 lemma set_permutations_of_list_impl_aux:
   "set (permutations_of_list_impl_aux [] xs) = permutations_of_multiset (mset xs)"
   by (simp add: permutations_of_list_impl_aux_correct set_permutations_of_list_impl)
   
 declare set_permutations_of_list_impl_aux [symmetric, code]
 
 value [code] "permutations_of_multiset {#1,2,3,4::int#}"
 
 
 
 text \<open>
   Now we turn to permutations of sets. We define an auxiliary version with an 
   accumulator to avoid having to map over the results.
 \<close>
 function permutations_of_set_aux where
   "permutations_of_set_aux acc A = 
      (if \<not>finite A then {} else if A = {} then {acc} else 
         (\<Union>x\<in>A. permutations_of_set_aux (x#acc) (A - {x})))"
 by auto
 termination by (relation "Wellfounded.measure (card \<circ> snd)") (simp_all add: card_gt_0_iff)
 
 lemma permutations_of_set_aux_altdef:
   "permutations_of_set_aux acc A = (\<lambda>xs. rev xs @ acc) ` permutations_of_set A"
 proof (cases "finite A")
   assume "finite A"
   thus ?thesis
   proof (induction A arbitrary: acc rule: finite_psubset_induct)
     case (psubset A acc)
     show ?case
     proof (cases "A = {}")
       case False
       note [simp del] = permutations_of_set_aux.simps
       from psubset.hyps False 
         have "permutations_of_set_aux acc A = 
                 (\<Union>y\<in>A. permutations_of_set_aux (y#acc) (A - {y}))"
         by (subst permutations_of_set_aux.simps) simp_all
       also have "\<dots> = (\<Union>y\<in>A. (\<lambda>xs. rev xs @ acc) ` (\<lambda>xs. y # xs) ` permutations_of_set (A - {y}))"
         apply (rule arg_cong [of _ _ Union], rule image_cong)
          apply (simp_all add: image_image)
         apply (subst psubset)
          apply auto
         done
       also from False have "\<dots> = (\<lambda>xs. rev xs @ acc) ` permutations_of_set A"
         by (subst (2) permutations_of_set_nonempty) (simp_all add: image_UN)
       finally show ?thesis .
     qed simp_all
   qed
 qed (simp_all add: permutations_of_set_infinite)
 
 declare permutations_of_set_aux.simps [simp del]
 
 lemma permutations_of_set_aux_correct:
   "permutations_of_set_aux [] A = permutations_of_set A"
   by (simp add: permutations_of_set_aux_altdef)
 
 
 text \<open>
   In another refinement step, we define a version on lists.
 \<close>
 declare length_remove1 [termination_simp]
 
 fun permutations_of_set_aux_list where
   "permutations_of_set_aux_list acc xs = 
      (if xs = [] then [acc] else 
         List.bind xs (\<lambda>x. permutations_of_set_aux_list (x#acc) (List.remove1 x xs)))"
 
 definition permutations_of_set_list where
   "permutations_of_set_list xs = permutations_of_set_aux_list [] xs"
 
 declare permutations_of_set_aux_list.simps [simp del]
 
 lemma permutations_of_set_aux_list_refine:
   assumes "distinct xs"
   shows   "set (permutations_of_set_aux_list acc xs) = permutations_of_set_aux acc (set xs)"
   using assms
   by (induction acc xs rule: permutations_of_set_aux_list.induct)
      (subst permutations_of_set_aux_list.simps,
       subst permutations_of_set_aux.simps,
       simp_all add: set_list_bind)
 
 
 text \<open>
   The permutation lists contain no duplicates if the inputs contain no duplicates.
   Therefore, these functions can easily be used when working with a representation of
   sets by distinct lists.
   The same approach should generalise to any kind of set implementation that supports
   a monadic bind operation, and since the results are disjoint, merging should be cheap.
 \<close>
 lemma distinct_permutations_of_set_aux_list:
   "distinct xs \<Longrightarrow> distinct (permutations_of_set_aux_list acc xs)"
   by (induction acc xs rule: permutations_of_set_aux_list.induct)
      (subst permutations_of_set_aux_list.simps,
       auto intro!: distinct_list_bind simp: disjoint_family_on_def 
          permutations_of_set_aux_list_refine permutations_of_set_aux_altdef)
 
 lemma distinct_permutations_of_set_list:
     "distinct xs \<Longrightarrow> distinct (permutations_of_set_list xs)"
   by (simp add: permutations_of_set_list_def distinct_permutations_of_set_aux_list)
 
 lemma permutations_of_list:
     "permutations_of_set (set xs) = set (permutations_of_set_list (remdups xs))"
   by (simp add: permutations_of_set_aux_correct [symmetric] 
         permutations_of_set_aux_list_refine permutations_of_set_list_def)
 
 lemma permutations_of_list_code [code]:
   "permutations_of_set (set xs) = set (permutations_of_set_list (remdups xs))"
   "permutations_of_set (List.coset xs) = 
      Code.abort (STR ''Permutation of set complement not supported'') 
        (\<lambda>_. permutations_of_set (List.coset xs))"
   by (simp_all add: permutations_of_list)
 
 value [code] "permutations_of_set (set ''abcd'')"
 
 end
diff --git a/src/HOL/Complex_Analysis/Complex_Residues.thy b/src/HOL/Complex_Analysis/Complex_Residues.thy
--- a/src/HOL/Complex_Analysis/Complex_Residues.thy
+++ b/src/HOL/Complex_Analysis/Complex_Residues.thy
@@ -1,540 +1,542 @@
 theory Complex_Residues
   imports Complex_Singularities
 begin
 
 subsection \<open>Definition of residues\<close>
 
 text\<open>Wenda Li and LC Paulson (2016). A Formal Proof of Cauchy's Residue Theorem.
     Interactive Theorem Proving\<close>
 
 definition\<^marker>\<open>tag important\<close> residue :: "(complex \<Rightarrow> complex) \<Rightarrow> complex \<Rightarrow> complex" where
   "residue f z = (SOME int. \<exists>e>0. \<forall>\<epsilon>>0. \<epsilon><e
     \<longrightarrow> (f has_contour_integral 2*pi* \<i> *int) (circlepath z \<epsilon>))"
 
 lemma residue_cong:
   assumes eq: "eventually (\<lambda>z. f z = g z) (at z)" and "z = z'"
   shows   "residue f z = residue g z'"
 proof -
   from assms have eq': "eventually (\<lambda>z. g z = f z) (at z)"
     by (simp add: eq_commute)
   let ?P = "\<lambda>f c e. (\<forall>\<epsilon>>0. \<epsilon> < e \<longrightarrow>
    (f has_contour_integral of_real (2 * pi) * \<i> * c) (circlepath z \<epsilon>))"
   have "residue f z = residue g z" unfolding residue_def
   proof (rule Eps_cong)
     fix c :: complex
     have "\<exists>e>0. ?P g c e"
       if "\<exists>e>0. ?P f c e" and "eventually (\<lambda>z. f z = g z) (at z)" for f g
     proof -
       from that(1) obtain e where e: "e > 0" "?P f c e"
         by blast
       from that(2) obtain e' where e': "e' > 0" "\<And>z'. z' \<noteq> z \<Longrightarrow> dist z' z < e' \<Longrightarrow> f z' = g z'"
         unfolding eventually_at by blast
       have "?P g c (min e e')"
       proof (intro allI exI impI, goal_cases)
         case (1 \<epsilon>)
         hence "(f has_contour_integral of_real (2 * pi) * \<i> * c) (circlepath z \<epsilon>)"
           using e(2) by auto
         thus ?case
         proof (rule has_contour_integral_eq)
           fix z' assume "z' \<in> path_image (circlepath z \<epsilon>)"
           hence "dist z' z < e'" and "z' \<noteq> z"
             using 1 by (auto simp: dist_commute)
           with e'(2)[of z'] show "f z' = g z'" by simp
         qed
       qed
       moreover from e and e' have "min e e' > 0" by auto
       ultimately show ?thesis by blast
     qed
     from this[OF _ eq] and this[OF _ eq']
       show "(\<exists>e>0. ?P f c e) \<longleftrightarrow> (\<exists>e>0. ?P g c e)"
       by blast
   qed
   with assms show ?thesis by simp
 qed
 
 lemma contour_integral_circlepath_eq:
   assumes "open s" and f_holo:"f holomorphic_on (s-{z})" and "0<e1" "e1\<le>e2"
     and e2_cball:"cball z e2 \<subseteq> s"
   shows
     "f contour_integrable_on circlepath z e1"
     "f contour_integrable_on circlepath z e2"
     "contour_integral (circlepath z e2) f = contour_integral (circlepath z e1) f"
 proof -
   define l where "l \<equiv> linepath (z+e2) (z+e1)"
   have [simp]:"valid_path l" "pathstart l=z+e2" "pathfinish l=z+e1" unfolding l_def by auto
   have "e2>0" using \<open>e1>0\<close> \<open>e1\<le>e2\<close> by auto
   have zl_img:"z\<notin>path_image l"
     proof
       assume "z \<in> path_image l"
       then have "e2 \<le> cmod (e2 - e1)"
         using segment_furthest_le[of z "z+e2" "z+e1" "z+e2",simplified] \<open>e1>0\<close> \<open>e2>0\<close> unfolding l_def
         by (auto simp add:closed_segment_commute)
       thus False using \<open>e2>0\<close> \<open>e1>0\<close> \<open>e1\<le>e2\<close>
         apply (subst (asm) norm_of_real)
         by auto
     qed
   define g where "g \<equiv> circlepath z e2 +++ l +++ reversepath (circlepath z e1) +++ reversepath l"
   show [simp]: "f contour_integrable_on circlepath z e2" "f contour_integrable_on (circlepath z e1)"
     proof -
       show "f contour_integrable_on circlepath z e2"
         apply (intro contour_integrable_continuous_circlepath[OF
                 continuous_on_subset[OF holomorphic_on_imp_continuous_on[OF f_holo]]])
         using \<open>e2>0\<close> e2_cball by auto
       show "f contour_integrable_on (circlepath z e1)"
         apply (intro contour_integrable_continuous_circlepath[OF
                       continuous_on_subset[OF holomorphic_on_imp_continuous_on[OF f_holo]]])
         using \<open>e1>0\<close> \<open>e1\<le>e2\<close> e2_cball by auto
     qed
   have [simp]:"f contour_integrable_on l"
     proof -
       have "closed_segment (z + e2) (z + e1) \<subseteq> cball z e2" using \<open>e2>0\<close> \<open>e1>0\<close> \<open>e1\<le>e2\<close>
         by (intro closed_segment_subset,auto simp add:dist_norm)
       hence "closed_segment (z + e2) (z + e1) \<subseteq> s - {z}" using zl_img e2_cball unfolding l_def
         by auto
       then show "f contour_integrable_on l" unfolding l_def
         apply (intro contour_integrable_continuous_linepath[OF
                       continuous_on_subset[OF holomorphic_on_imp_continuous_on[OF f_holo]]])
         by auto
     qed
   let ?ig="\<lambda>g. contour_integral g f"
   have "(f has_contour_integral 0) g"
     proof (rule Cauchy_theorem_global[OF _ f_holo])
       show "open (s - {z})" using \<open>open s\<close> by auto
       show "valid_path g" unfolding g_def l_def by auto
       show "pathfinish g = pathstart g" unfolding g_def l_def by auto
     next
       have path_img:"path_image g \<subseteq> cball z e2"
         proof -
           have "closed_segment (z + e2) (z + e1) \<subseteq> cball z e2" using \<open>e2>0\<close> \<open>e1>0\<close> \<open>e1\<le>e2\<close>
             by (intro closed_segment_subset,auto simp add:dist_norm)
           moreover have "sphere z \<bar>e1\<bar> \<subseteq> cball z e2" using \<open>e2>0\<close> \<open>e1\<le>e2\<close> \<open>e1>0\<close> by auto
           ultimately show ?thesis unfolding g_def l_def using \<open>e2>0\<close>
             by (simp add: path_image_join closed_segment_commute)
         qed
       show "path_image g \<subseteq> s - {z}"
         proof -
           have "z\<notin>path_image g" using zl_img
             unfolding g_def l_def by (auto simp add: path_image_join closed_segment_commute)
           moreover note \<open>cball z e2 \<subseteq> s\<close> and path_img
           ultimately show ?thesis by auto
         qed
       show "winding_number g w = 0" when"w \<notin> s - {z}" for w
         proof -
           have "winding_number g w = 0" when "w\<notin>s" using that e2_cball
             apply (intro winding_number_zero_outside[OF _ _ _ _ path_img])
             by (auto simp add:g_def l_def)
           moreover have "winding_number g z=0"
             proof -
               let ?Wz="\<lambda>g. winding_number g z"
               have "?Wz g = ?Wz (circlepath z e2) + ?Wz l + ?Wz (reversepath (circlepath z e1))
                   + ?Wz (reversepath l)"
                 using \<open>e2>0\<close> \<open>e1>0\<close> zl_img unfolding g_def l_def
                 by (subst winding_number_join,auto simp add:path_image_join closed_segment_commute)+
               also have "... = ?Wz (circlepath z e2) + ?Wz (reversepath (circlepath z e1))"
                 using zl_img
                 apply (subst (2) winding_number_reversepath)
                 by (auto simp add:l_def closed_segment_commute)
               also have "... = 0"
                 proof -
                   have "?Wz (circlepath z e2) = 1" using \<open>e2>0\<close>
                     by (auto intro: winding_number_circlepath_centre)
                   moreover have "?Wz (reversepath (circlepath z e1)) = -1" using \<open>e1>0\<close>
                     apply (subst winding_number_reversepath)
                     by (auto intro: winding_number_circlepath_centre)
                   ultimately show ?thesis by auto
                 qed
               finally show ?thesis .
             qed
           ultimately show ?thesis using that by auto
         qed
     qed
   then have "0 = ?ig g" using contour_integral_unique by simp
   also have "... = ?ig (circlepath z e2) + ?ig l + ?ig (reversepath (circlepath z e1))
       + ?ig (reversepath l)"
     unfolding g_def
     by (auto simp add:contour_integrable_reversepath_eq)
   also have "... = ?ig (circlepath z e2)  - ?ig (circlepath z e1)"
     by (auto simp add:contour_integral_reversepath)
   finally show "contour_integral (circlepath z e2) f = contour_integral (circlepath z e1) f"
     by simp
 qed
 
 lemma base_residue:
   assumes "open s" "z\<in>s" "r>0" and f_holo:"f holomorphic_on (s - {z})"
     and r_cball:"cball z r \<subseteq> s"
   shows "(f has_contour_integral 2 * pi * \<i> * (residue f z)) (circlepath z r)"
 proof -
   obtain e where "e>0" and e_cball:"cball z e \<subseteq> s"
     using open_contains_cball[of s] \<open>open s\<close> \<open>z\<in>s\<close> by auto
   define c where "c \<equiv> 2 * pi * \<i>"
   define i where "i \<equiv> contour_integral (circlepath z e) f / c"
   have "(f has_contour_integral c*i) (circlepath z \<epsilon>)" when "\<epsilon>>0" "\<epsilon><e" for \<epsilon>
     proof -
       have "contour_integral (circlepath z e) f = contour_integral (circlepath z \<epsilon>) f"
           "f contour_integrable_on circlepath z \<epsilon>"
           "f contour_integrable_on circlepath z e"
         using \<open>\<epsilon><e\<close>
         by (intro contour_integral_circlepath_eq[OF \<open>open s\<close> f_holo \<open>\<epsilon>>0\<close> _ e_cball],auto)+
       then show ?thesis unfolding i_def c_def
         by (auto intro:has_contour_integral_integral)
     qed
   then have "\<exists>e>0. \<forall>\<epsilon>>0. \<epsilon><e \<longrightarrow> (f has_contour_integral c * (residue f z)) (circlepath z \<epsilon>)"
     unfolding residue_def c_def
     apply (rule_tac someI[of _ i],intro  exI[where x=e])
     by (auto simp add:\<open>e>0\<close> c_def)
   then obtain e' where "e'>0"
       and e'_def:"\<forall>\<epsilon>>0. \<epsilon><e' \<longrightarrow> (f has_contour_integral c * (residue f z)) (circlepath z \<epsilon>)"
     by auto
   let ?int="\<lambda>e. contour_integral (circlepath z e) f"
   define  \<epsilon> where "\<epsilon> \<equiv> Min {r,e'} / 2"
   have "\<epsilon>>0" "\<epsilon>\<le>r" "\<epsilon><e'" using \<open>r>0\<close> \<open>e'>0\<close> unfolding \<epsilon>_def by auto
   have "(f has_contour_integral c * (residue f z)) (circlepath z \<epsilon>)"
     using e'_def[rule_format,OF \<open>\<epsilon>>0\<close> \<open>\<epsilon><e'\<close>] .
   then show ?thesis unfolding c_def
     using contour_integral_circlepath_eq[OF \<open>open s\<close> f_holo \<open>\<epsilon>>0\<close> \<open>\<epsilon>\<le>r\<close> r_cball]
     by (auto elim: has_contour_integral_eqpath[of _ _ "circlepath z \<epsilon>" "circlepath z r"])
 qed
 
 lemma residue_holo:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s"
   shows "residue f z = 0"
 proof -
   define c where "c \<equiv> 2 * pi * \<i>"
   obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
     using open_contains_cball_eq by blast
   have "(f has_contour_integral c*residue f z) (circlepath z e)"
     using f_holo
     by (auto intro: base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
   moreover have "(f has_contour_integral 0) (circlepath z e)"
     using f_holo e_cball \<open>e>0\<close>
     by (auto intro: Cauchy_theorem_convex_simple[of _ "cball z e"])
   ultimately have "c*residue f z =0"
     using has_contour_integral_unique by blast
   thus ?thesis unfolding c_def  by auto
 qed
 
 lemma residue_const:"residue (\<lambda>_. c) z = 0"
   by (intro residue_holo[of "UNIV::complex set"],auto intro:holomorphic_intros)
 
 lemma residue_add:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
       and g_holo:"g holomorphic_on s - {z}"
   shows "residue (\<lambda>z. f z + g z) z= residue f z + residue g z"
 proof -
   define c where "c \<equiv> 2 * pi * \<i>"
   define fg where "fg \<equiv> (\<lambda>z. f z+g z)"
   obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
     using open_contains_cball_eq by blast
   have "(fg has_contour_integral c * residue fg z) (circlepath z e)"
     unfolding fg_def using f_holo g_holo
     apply (intro base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
     by (auto intro:holomorphic_intros)
   moreover have "(fg has_contour_integral c*residue f z + c* residue g z) (circlepath z e)"
     unfolding fg_def using f_holo g_holo
     by (auto intro: has_contour_integral_add base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
   ultimately have "c*(residue f z + residue g z) = c * residue fg z"
     using has_contour_integral_unique by (auto simp add:distrib_left)
   thus ?thesis unfolding fg_def
     by (auto simp add:c_def)
 qed
 
 lemma residue_lmul:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
   shows "residue (\<lambda>z. c * (f z)) z= c * residue f z"
 proof (cases "c=0")
   case True
   thus ?thesis using residue_const by auto
 next
   case False
   define c' where "c' \<equiv> 2 * pi * \<i>"
   define f' where "f' \<equiv> (\<lambda>z. c * (f z))"
   obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
     using open_contains_cball_eq by blast
   have "(f' has_contour_integral c' * residue f' z) (circlepath z e)"
     unfolding f'_def using f_holo
     apply (intro base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c'_def])
     by (auto intro:holomorphic_intros)
   moreover have "(f' has_contour_integral c * (c' * residue f z)) (circlepath z e)"
     unfolding f'_def using f_holo
     by (auto intro: has_contour_integral_lmul
       base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c'_def])
   ultimately have "c' * residue f' z  = c * (c' * residue f z)"
     using has_contour_integral_unique by auto
   thus ?thesis unfolding f'_def c'_def using False
     by (auto simp add:field_simps)
 qed
 
 lemma residue_rmul:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
   shows "residue (\<lambda>z. (f z) * c) z= residue f z * c"
 using residue_lmul[OF assms,of c] by (auto simp add:algebra_simps)
 
 lemma residue_div:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
   shows "residue (\<lambda>z. (f z) / c) z= residue f z / c "
 using residue_lmul[OF assms,of "1/c"] by (auto simp add:algebra_simps)
 
 lemma residue_neg:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
   shows "residue (\<lambda>z. - (f z)) z= - residue f z"
 using residue_lmul[OF assms,of "-1"] by auto
 
 lemma residue_diff:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
       and g_holo:"g holomorphic_on s - {z}"
   shows "residue (\<lambda>z. f z - g z) z= residue f z - residue g z"
 using residue_add[OF assms(1,2,3),of "\<lambda>z. - g z"] residue_neg[OF assms(1,2,4)]
 by (auto intro:holomorphic_intros g_holo)
 
 lemma residue_simple:
   assumes "open s" "z\<in>s" and f_holo:"f holomorphic_on s"
   shows "residue (\<lambda>w. f w / (w - z)) z = f z"
 proof -
   define c where "c \<equiv> 2 * pi * \<i>"
   define f' where "f' \<equiv> \<lambda>w. f w / (w - z)"
   obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
     using open_contains_cball_eq by blast
   have "(f' has_contour_integral c * f z) (circlepath z e)"
     unfolding f'_def c_def using \<open>e>0\<close> f_holo e_cball
     by (auto intro!: Cauchy_integral_circlepath_simple holomorphic_intros)
   moreover have "(f' has_contour_integral c * residue f' z) (circlepath z e)"
     unfolding f'_def using f_holo
     apply (intro base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
     by (auto intro!:holomorphic_intros)
   ultimately have "c * f z = c * residue f' z"
     using has_contour_integral_unique by blast
   thus ?thesis unfolding c_def f'_def  by auto
 qed
 
 lemma residue_simple':
   assumes s: "open s" "z \<in> s" and holo: "f holomorphic_on (s - {z})"
       and lim: "((\<lambda>w. f w * (w - z)) \<longlongrightarrow> c) (at z)"
   shows   "residue f z = c"
 proof -
   define g where "g = (\<lambda>w. if w = z then c else f w * (w - z))"
   from holo have "(\<lambda>w. f w * (w - z)) holomorphic_on (s - {z})" (is "?P")
     by (force intro: holomorphic_intros)
   also have "?P \<longleftrightarrow> g holomorphic_on (s - {z})"
     by (intro holomorphic_cong refl) (simp_all add: g_def)
   finally have *: "g holomorphic_on (s - {z})" .
 
   note lim
   also have "(\<lambda>w. f w * (w - z)) \<midarrow>z\<rightarrow> c \<longleftrightarrow> g \<midarrow>z\<rightarrow> g z"
     by (intro filterlim_cong refl) (simp_all add: g_def [abs_def] eventually_at_filter)
   finally have **: "g \<midarrow>z\<rightarrow> g z" .
 
   have g_holo: "g holomorphic_on s"
     by (rule no_isolated_singularity'[where K = "{z}"])
        (insert assms * **, simp_all add: at_within_open_NO_MATCH)
   from s and this have "residue (\<lambda>w. g w / (w - z)) z = g z"
     by (rule residue_simple)
   also have "\<forall>\<^sub>F za in at z. g za / (za - z) = f za"
     unfolding eventually_at by (auto intro!: exI[of _ 1] simp: field_simps g_def)
   hence "residue (\<lambda>w. g w / (w - z)) z = residue f z"
     by (intro residue_cong refl)
   finally show ?thesis
     by (simp add: g_def)
 qed
 
 lemma residue_holomorphic_over_power:
   assumes "open A" "z0 \<in> A" "f holomorphic_on A"
   shows   "residue (\<lambda>z. f z / (z - z0) ^ Suc n) z0 = (deriv ^^ n) f z0 / fact n"
 proof -
   let ?f = "\<lambda>z. f z / (z - z0) ^ Suc n"
   from assms(1,2) obtain r where r: "r > 0" "cball z0 r \<subseteq> A"
     by (auto simp: open_contains_cball)
   have "(?f has_contour_integral 2 * pi * \<i> * residue ?f z0) (circlepath z0 r)"
     using r assms by (intro base_residue[of A]) (auto intro!: holomorphic_intros)
   moreover have "(?f has_contour_integral 2 * pi * \<i> / fact n * (deriv ^^ n) f z0) (circlepath z0 r)"
     using assms r
     by (intro Cauchy_has_contour_integral_higher_derivative_circlepath)
        (auto intro!: holomorphic_on_subset[OF assms(3)] holomorphic_on_imp_continuous_on)
   ultimately have "2 * pi * \<i> * residue ?f z0 = 2 * pi * \<i> / fact n * (deriv ^^ n) f z0"
     by (rule has_contour_integral_unique)
   thus ?thesis by (simp add: field_simps)
 qed
 
 lemma residue_holomorphic_over_power':
   assumes "open A" "0 \<in> A" "f holomorphic_on A"
   shows   "residue (\<lambda>z. f z / z ^ Suc n) 0 = (deriv ^^ n) f 0 / fact n"
   using residue_holomorphic_over_power[OF assms] by simp
 
 theorem residue_fps_expansion_over_power_at_0:
   assumes "f has_fps_expansion F"
   shows   "residue (\<lambda>z. f z / z ^ Suc n) 0 = fps_nth F n"
 proof -
-  from has_fps_expansion_imp_holomorphic[OF assms] guess s . note s = this
-  have "residue (\<lambda>z. f z / (z - 0) ^ Suc n) 0 = (deriv ^^ n) f 0 / fact n"
-    using assms s unfolding has_fps_expansion_def
+  from has_fps_expansion_imp_holomorphic[OF assms] obtain s
+    where "open s" "0 \<in> s" "f holomorphic_on s" "\<And>z. z \<in> s \<Longrightarrow> f z = eval_fps F z"
+    by auto
+  with assms have "residue (\<lambda>z. f z / (z - 0) ^ Suc n) 0 = (deriv ^^ n) f 0 / fact n"
+    unfolding has_fps_expansion_def
     by (intro residue_holomorphic_over_power[of s]) (auto simp: zero_ereal_def)
   also from assms have "\<dots> = fps_nth F n"
     by (subst fps_nth_fps_expansion) auto
   finally show ?thesis by simp
 qed
 
 lemma residue_pole_order:
   fixes f::"complex \<Rightarrow> complex" and z::complex
   defines "n \<equiv> nat (- zorder f z)" and "h \<equiv> zor_poly f z"
   assumes f_iso:"isolated_singularity_at f z"
     and pole:"is_pole f z"
   shows "residue f z = ((deriv ^^ (n - 1)) h z / fact (n-1))"
 proof -
   define g where "g \<equiv> \<lambda>x. if x=z then 0 else inverse (f x)"
   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
   obtain r where "0 < n" "0 < r" and r_cball:"cball z r \<subseteq> ball z e" and h_holo: "h holomorphic_on cball z r"
       and h_divide:"(\<forall>w\<in>cball z r. (w\<noteq>z \<longrightarrow> f w = h w / (w - z) ^ n) \<and> h w \<noteq> 0)"
   proof -
     obtain r where r:"zorder f z < 0" "h z \<noteq> 0" "r>0" "cball z r \<subseteq> ball z e" "h holomorphic_on cball z r"
         "(\<forall>w\<in>cball z r - {z}. f w = h w / (w - z) ^ n \<and> h w \<noteq> 0)"
       using zorder_exist_pole[OF f_holo,simplified,OF \<open>is_pole f z\<close>,folded n_def h_def] by auto
     have "n>0" using \<open>zorder f z < 0\<close> unfolding n_def by simp
     moreover have "(\<forall>w\<in>cball z r. (w\<noteq>z \<longrightarrow> f w = h w / (w - z) ^ n) \<and> h w \<noteq> 0)"
       using \<open>h z\<noteq>0\<close> r(6) by blast
     ultimately show ?thesis using r(3,4,5) that by blast
   qed
   have r_nonzero:"\<And>w. w \<in> ball z r - {z} \<Longrightarrow> f w \<noteq> 0"
     using h_divide by simp
   define c where "c \<equiv> 2 * pi * \<i>"
   define der_f where "der_f \<equiv> ((deriv ^^ (n - 1)) h z / fact (n-1))"
   define h' where "h' \<equiv> \<lambda>u. h u / (u - z) ^ n"
   have "(h' has_contour_integral c / fact (n - 1) * (deriv ^^ (n - 1)) h z) (circlepath z r)"
     unfolding h'_def
     proof (rule Cauchy_has_contour_integral_higher_derivative_circlepath[of z r h z "n-1",
         folded c_def Suc_pred'[OF \<open>n>0\<close>]])
       show "continuous_on (cball z r) h" using holomorphic_on_imp_continuous_on h_holo by simp
       show "h holomorphic_on ball z r" using h_holo by auto
       show " z \<in> ball z r" using \<open>r>0\<close> by auto
     qed
   then have "(h' has_contour_integral c * der_f) (circlepath z r)" unfolding der_f_def by auto
   then have "(f has_contour_integral c * der_f) (circlepath z r)"
     proof (elim has_contour_integral_eq)
       fix x assume "x \<in> path_image (circlepath z r)"
       hence "x\<in>cball z r - {z}" using \<open>r>0\<close> by auto
       then show "h' x = f x" using h_divide unfolding h'_def by auto
     qed
   moreover have "(f has_contour_integral c * residue f z) (circlepath z r)"
     using base_residue[of \<open>ball z e\<close> z,simplified,OF \<open>r>0\<close> f_holo r_cball,folded c_def]
     unfolding c_def by simp
   ultimately have "c * der_f =  c * residue f z" using has_contour_integral_unique by blast
   hence "der_f = residue f z" unfolding c_def by auto
   thus ?thesis unfolding der_f_def by auto
 qed
 
 lemma residue_simple_pole:
   assumes "isolated_singularity_at f z0"
   assumes "is_pole f z0" "zorder f z0 = - 1"
   shows   "residue f z0 = zor_poly f z0 z0"
   using assms by (subst residue_pole_order) simp_all
 
 lemma residue_simple_pole_limit:
   assumes "isolated_singularity_at f z0"
   assumes "is_pole f z0" "zorder f z0 = - 1"
   assumes "((\<lambda>x. f (g x) * (g x - z0)) \<longlongrightarrow> c) F"
   assumes "filterlim g (at z0) F" "F \<noteq> bot"
   shows   "residue f z0 = c"
 proof -
   have "residue f z0 = zor_poly f z0 z0"
     by (rule residue_simple_pole assms)+
   also have "\<dots> = c"
     apply (rule zor_poly_pole_eqI)
     using assms by auto
   finally show ?thesis .
 qed
 
 lemma
   assumes f_holo:"f holomorphic_on s" and g_holo:"g holomorphic_on s"
           and "open s" "connected s" "z \<in> s"
   assumes g_deriv:"(g has_field_derivative g') (at z)"
   assumes "f z \<noteq> 0" "g z = 0" "g' \<noteq> 0"
   shows   porder_simple_pole_deriv: "zorder (\<lambda>w. f w / g w) z = - 1"
     and   residue_simple_pole_deriv: "residue (\<lambda>w. f w / g w) z = f z / g'"
 proof -
   have [simp]:"isolated_singularity_at f z" "isolated_singularity_at g z"
     using isolated_singularity_at_holomorphic[OF _ \<open>open s\<close> \<open>z\<in>s\<close>] f_holo g_holo
     by (meson Diff_subset holomorphic_on_subset)+
   have [simp]:"not_essential f z" "not_essential g z"
     unfolding not_essential_def using f_holo g_holo assms(3,5)
     by (meson continuous_on_eq_continuous_at continuous_within holomorphic_on_imp_continuous_on)+
   have g_nconst:"\<exists>\<^sub>F w in at z. g w \<noteq>0 "
   proof (rule ccontr)
     assume "\<not> (\<exists>\<^sub>F w in at z. g w \<noteq> 0)"
     then have "\<forall>\<^sub>F w in nhds z. g w = 0"
       unfolding eventually_at eventually_nhds frequently_at using \<open>g z = 0\<close>
       by (metis open_ball UNIV_I centre_in_ball dist_commute mem_ball)
     then have "deriv g z = deriv (\<lambda>_. 0) z"
       by (intro deriv_cong_ev) auto
     then have "deriv g z = 0" by auto
     then have "g' = 0" using g_deriv DERIV_imp_deriv by blast
     then show False using \<open>g'\<noteq>0\<close> by auto
   qed
 
   have "zorder (\<lambda>w. f w / g w) z = zorder f z - zorder g z"
   proof -
     have "\<forall>\<^sub>F w in at z. f w \<noteq>0 \<and> w\<in>s"
       apply (rule non_zero_neighbour_alt)
       using assms by auto
     with g_nconst have "\<exists>\<^sub>F w in at z. f w * g w \<noteq> 0"
       by (elim frequently_rev_mp eventually_rev_mp,auto)
     then show ?thesis using zorder_divide[of f z g] by auto
   qed
   moreover have "zorder f z=0"
     apply (rule zorder_zero_eqI[OF f_holo \<open>open s\<close> \<open>z\<in>s\<close>])
     using \<open>f z\<noteq>0\<close> by auto
   moreover have "zorder g z=1"
     apply (rule zorder_zero_eqI[OF g_holo \<open>open s\<close> \<open>z\<in>s\<close>])
     subgoal using assms(8) by auto
     subgoal using DERIV_imp_deriv assms(9) g_deriv by auto
     subgoal by simp
     done
   ultimately show "zorder (\<lambda>w. f w / g w) z = - 1" by auto
 
   show "residue (\<lambda>w. f w / g w) z = f z / g'"
   proof (rule residue_simple_pole_limit[where g=id and F="at z",simplified])
     show "zorder (\<lambda>w. f w / g w) z = - 1" by fact
     show "isolated_singularity_at (\<lambda>w. f w / g w) z"
       by (auto intro: singularity_intros)
     show "is_pole (\<lambda>w. f w / g w) z"
     proof (rule is_pole_divide)
       have "\<forall>\<^sub>F x in at z. g x \<noteq> 0"
         apply (rule non_zero_neighbour)
         using g_nconst by auto
       moreover have "g \<midarrow>z\<rightarrow> 0"
         using DERIV_isCont assms(8) continuous_at g_deriv by force
       ultimately show "filterlim g (at 0) (at z)" unfolding filterlim_at by simp
       show "isCont f z"
         using assms(3,5) continuous_on_eq_continuous_at f_holo holomorphic_on_imp_continuous_on
         by auto
       show "f z \<noteq> 0" by fact
     qed
     show "filterlim id (at z) (at z)" by (simp add: filterlim_iff)
     have "((\<lambda>w. (f w * (w - z)) / g w) \<longlongrightarrow> f z / g') (at z)"
     proof (rule lhopital_complex_simple)
       show "((\<lambda>w. f w * (w - z)) has_field_derivative f z) (at z)"
         using assms by (auto intro!: derivative_eq_intros holomorphic_derivI[OF f_holo])
       show "(g has_field_derivative g') (at z)" by fact
     qed (insert assms, auto)
     then show "((\<lambda>w. (f w / g w) * (w - z)) \<longlongrightarrow> f z / g') (at z)"
       by (simp add: field_split_simps)
   qed
 qed
 
 
 subsection \<open>Poles and residues of some well-known functions\<close>
 
 (* TODO: add more material here for other functions *)
 lemma is_pole_Gamma: "is_pole Gamma (-of_nat n)"
   unfolding is_pole_def using Gamma_poles .
 
 lemma Gamma_residue:
   "residue Gamma (-of_nat n) = (-1) ^ n / fact n"
 proof (rule residue_simple')
   show "open (- (\<int>\<^sub>\<le>\<^sub>0 - {-of_nat n}) :: complex set)"
     by (intro open_Compl closed_subset_Ints) auto
   show "Gamma holomorphic_on (- (\<int>\<^sub>\<le>\<^sub>0 - {-of_nat n}) - {- of_nat n})"
     by (rule holomorphic_Gamma) auto
   show "(\<lambda>w. Gamma w * (w - (-of_nat n))) \<midarrow>(-of_nat n)\<rightarrow> (- 1) ^ n / fact n"
     using Gamma_residues[of n] by simp
 qed auto
 
 end
diff --git a/src/HOL/Computational_Algebra/Factorial_Ring.thy b/src/HOL/Computational_Algebra/Factorial_Ring.thy
--- a/src/HOL/Computational_Algebra/Factorial_Ring.thy
+++ b/src/HOL/Computational_Algebra/Factorial_Ring.thy
@@ -1,2238 +1,2260 @@
 (*  Title:      HOL/Computational_Algebra/Factorial_Ring.thy
     Author:     Manuel Eberl, TU Muenchen
     Author:     Florian Haftmann, TU Muenchen
 *)
 
 section \<open>Factorial (semi)rings\<close>
 
 theory Factorial_Ring
 imports
   Main
   "HOL-Library.Multiset"
 begin
 
 subsection \<open>Irreducible and prime elements\<close>
 
 context comm_semiring_1
 begin
 
 definition irreducible :: "'a \<Rightarrow> bool" where
   "irreducible p \<longleftrightarrow> p \<noteq> 0 \<and> \<not>p dvd 1 \<and> (\<forall>a b. p = a * b \<longrightarrow> a dvd 1 \<or> b dvd 1)"
 
 lemma not_irreducible_zero [simp]: "\<not>irreducible 0"
   by (simp add: irreducible_def)
 
 lemma irreducible_not_unit: "irreducible p \<Longrightarrow> \<not>p dvd 1"
   by (simp add: irreducible_def)
 
 lemma not_irreducible_one [simp]: "\<not>irreducible 1"
   by (simp add: irreducible_def)
 
 lemma irreducibleI:
   "p \<noteq> 0 \<Longrightarrow> \<not>p dvd 1 \<Longrightarrow> (\<And>a b. p = a * b \<Longrightarrow> a dvd 1 \<or> b dvd 1) \<Longrightarrow> irreducible p"
   by (simp add: irreducible_def)
 
 lemma irreducibleD: "irreducible p \<Longrightarrow> p = a * b \<Longrightarrow> a dvd 1 \<or> b dvd 1"
   by (simp add: irreducible_def)
 
 lemma irreducible_mono:
   assumes irr: "irreducible b" and "a dvd b" "\<not>a dvd 1"
   shows   "irreducible a"
 proof (rule irreducibleI)
   fix c d assume "a = c * d"
   from assms obtain k where [simp]: "b = a * k" by auto
   from \<open>a = c * d\<close> have "b = c * d * k"
     by simp
   hence "c dvd 1 \<or> (d * k) dvd 1"
     using irreducibleD[OF irr, of c "d * k"] by (auto simp: mult.assoc)
   thus "c dvd 1 \<or> d dvd 1"
     by auto
 qed (use assms in \<open>auto simp: irreducible_def\<close>)
 
 definition prime_elem :: "'a \<Rightarrow> bool" where
   "prime_elem p \<longleftrightarrow> p \<noteq> 0 \<and> \<not>p dvd 1 \<and> (\<forall>a b. p dvd (a * b) \<longrightarrow> p dvd a \<or> p dvd b)"
 
 lemma not_prime_elem_zero [simp]: "\<not>prime_elem 0"
   by (simp add: prime_elem_def)
 
 lemma prime_elem_not_unit: "prime_elem p \<Longrightarrow> \<not>p dvd 1"
   by (simp add: prime_elem_def)
 
 lemma prime_elemI:
     "p \<noteq> 0 \<Longrightarrow> \<not>p dvd 1 \<Longrightarrow> (\<And>a b. p dvd (a * b) \<Longrightarrow> p dvd a \<or> p dvd b) \<Longrightarrow> prime_elem p"
   by (simp add: prime_elem_def)
 
 lemma prime_elem_dvd_multD:
     "prime_elem p \<Longrightarrow> p dvd (a * b) \<Longrightarrow> p dvd a \<or> p dvd b"
   by (simp add: prime_elem_def)
 
 lemma prime_elem_dvd_mult_iff:
   "prime_elem p \<Longrightarrow> p dvd (a * b) \<longleftrightarrow> p dvd a \<or> p dvd b"
   by (auto simp: prime_elem_def)
 
 lemma not_prime_elem_one [simp]:
   "\<not> prime_elem 1"
   by (auto dest: prime_elem_not_unit)
 
 lemma prime_elem_not_zeroI:
   assumes "prime_elem p"
   shows "p \<noteq> 0"
   using assms by (auto intro: ccontr)
 
 lemma prime_elem_dvd_power:
   "prime_elem p \<Longrightarrow> p dvd x ^ n \<Longrightarrow> p dvd x"
   by (induction n) (auto dest: prime_elem_dvd_multD intro: dvd_trans[of _ 1])
 
 lemma prime_elem_dvd_power_iff:
   "prime_elem p \<Longrightarrow> n > 0 \<Longrightarrow> p dvd x ^ n \<longleftrightarrow> p dvd x"
   by (auto dest: prime_elem_dvd_power intro: dvd_trans)
 
 lemma prime_elem_imp_nonzero [simp]:
   "ASSUMPTION (prime_elem x) \<Longrightarrow> x \<noteq> 0"
   unfolding ASSUMPTION_def by (rule prime_elem_not_zeroI)
 
 lemma prime_elem_imp_not_one [simp]:
   "ASSUMPTION (prime_elem x) \<Longrightarrow> x \<noteq> 1"
   unfolding ASSUMPTION_def by auto
 
 end
 
 
 lemma (in normalization_semidom) irreducible_cong:
   assumes "normalize a = normalize b"
   shows   "irreducible a \<longleftrightarrow> irreducible b"
 proof (cases "a = 0 \<or> a dvd 1")
   case True
   hence "\<not>irreducible a" by (auto simp: irreducible_def)
   from True have "normalize a = 0 \<or> normalize a dvd 1"
     by auto
   also note assms
   finally have "b = 0 \<or> b dvd 1" by simp
   hence "\<not>irreducible b" by (auto simp: irreducible_def)
   with \<open>\<not>irreducible a\<close> show ?thesis by simp
 next
   case False
   hence b: "b \<noteq> 0" "\<not>is_unit b" using assms
     by (auto simp: is_unit_normalize[of b])
   show ?thesis
   proof
     assume "irreducible a"
     thus "irreducible b"
       by (rule irreducible_mono) (use assms False b in \<open>auto dest: associatedD2\<close>)
   next
     assume "irreducible b"
     thus "irreducible a"
       by (rule irreducible_mono) (use assms False b in \<open>auto dest: associatedD1\<close>)
   qed
 qed
 
 lemma (in normalization_semidom) associatedE1:
   assumes "normalize a = normalize b"
   obtains u where "is_unit u" "a = u * b"
 proof (cases "a = 0")
   case [simp]: False
   from assms have [simp]: "b \<noteq> 0" by auto
   show ?thesis
   proof (rule that)
     show "is_unit (unit_factor a div unit_factor b)"
       by auto
     have "unit_factor a div unit_factor b * b = unit_factor a * (b div unit_factor b)"
       using \<open>b \<noteq> 0\<close> unit_div_commute unit_div_mult_swap unit_factor_is_unit by metis
     also have "b div unit_factor b = normalize b" by simp
     finally show "a = unit_factor a div unit_factor b * b"
       by (metis assms unit_factor_mult_normalize)
   qed
 next
   case [simp]: True
   hence [simp]: "b = 0"
     using assms[symmetric] by auto
   show ?thesis
     by (intro that[of 1]) auto
 qed
 
 lemma (in normalization_semidom) associatedE2:
   assumes "normalize a = normalize b"
   obtains u where "is_unit u" "b = u * a"
 proof -
   from assms have "normalize b = normalize a"
     by simp
   then obtain u where "is_unit u" "b = u * a"
     by (elim associatedE1)
   thus ?thesis using that by blast
 qed
   
 
 (* TODO Move *)
 lemma (in normalization_semidom) normalize_power_normalize:
   "normalize (normalize x ^ n) = normalize (x ^ n)"
 proof (induction n)
   case (Suc n)
   have "normalize (normalize x ^ Suc n) = normalize (x * normalize (normalize x ^ n))"
     by simp
   also note Suc.IH
   finally show ?case by simp
 qed auto
 
 context algebraic_semidom
 begin
 
 lemma prime_elem_imp_irreducible:
   assumes "prime_elem p"
   shows   "irreducible p"
 proof (rule irreducibleI)
   fix a b
   assume p_eq: "p = a * b"
   with assms have nz: "a \<noteq> 0" "b \<noteq> 0" by auto
   from p_eq have "p dvd a * b" by simp
   with \<open>prime_elem p\<close> have "p dvd a \<or> p dvd b" by (rule prime_elem_dvd_multD)
   with \<open>p = a * b\<close> have "a * b dvd 1 * b \<or> a * b dvd a * 1" by auto
   thus "a dvd 1 \<or> b dvd 1"
     by (simp only: dvd_times_left_cancel_iff[OF nz(1)] dvd_times_right_cancel_iff[OF nz(2)])
 qed (insert assms, simp_all add: prime_elem_def)
 
 lemma (in algebraic_semidom) unit_imp_no_irreducible_divisors:
   assumes "is_unit x" "irreducible p"
   shows   "\<not>p dvd x"
 proof (rule notI)
   assume "p dvd x"
   with \<open>is_unit x\<close> have "is_unit p"
     by (auto intro: dvd_trans)
   with \<open>irreducible p\<close> show False
     by (simp add: irreducible_not_unit)
 qed
 
 lemma unit_imp_no_prime_divisors:
   assumes "is_unit x" "prime_elem p"
   shows   "\<not>p dvd x"
   using unit_imp_no_irreducible_divisors[OF assms(1) prime_elem_imp_irreducible[OF assms(2)]] .
 
 lemma prime_elem_mono:
   assumes "prime_elem p" "\<not>q dvd 1" "q dvd p"
   shows   "prime_elem q"
 proof -
   from \<open>q dvd p\<close> obtain r where r: "p = q * r" by (elim dvdE)
   hence "p dvd q * r" by simp
   with \<open>prime_elem p\<close> have "p dvd q \<or> p dvd r" by (rule prime_elem_dvd_multD)
   hence "p dvd q"
   proof
     assume "p dvd r"
     then obtain s where s: "r = p * s" by (elim dvdE)
     from r have "p * 1 = p * (q * s)" by (subst (asm) s) (simp add: mult_ac)
     with \<open>prime_elem p\<close> have "q dvd 1"
       by (subst (asm) mult_cancel_left) auto
     with \<open>\<not>q dvd 1\<close> show ?thesis by contradiction
   qed
 
   show ?thesis
   proof (rule prime_elemI)
     fix a b assume "q dvd (a * b)"
     with \<open>p dvd q\<close> have "p dvd (a * b)" by (rule dvd_trans)
     with \<open>prime_elem p\<close> have "p dvd a \<or> p dvd b" by (rule prime_elem_dvd_multD)
     with \<open>q dvd p\<close> show "q dvd a \<or> q dvd b" by (blast intro: dvd_trans)
   qed (insert assms, auto)
 qed
 
 lemma irreducibleD':
   assumes "irreducible a" "b dvd a"
   shows   "a dvd b \<or> is_unit b"
 proof -
   from assms obtain c where c: "a = b * c" by (elim dvdE)
   from irreducibleD[OF assms(1) this] have "is_unit b \<or> is_unit c" .
   thus ?thesis by (auto simp: c mult_unit_dvd_iff)
 qed
 
 lemma irreducibleI':
   assumes "a \<noteq> 0" "\<not>is_unit a" "\<And>b. b dvd a \<Longrightarrow> a dvd b \<or> is_unit b"
   shows   "irreducible a"
 proof (rule irreducibleI)
   fix b c assume a_eq: "a = b * c"
   hence "a dvd b \<or> is_unit b" by (intro assms) simp_all
   thus "is_unit b \<or> is_unit c"
   proof
     assume "a dvd b"
     hence "b * c dvd b * 1" by (simp add: a_eq)
     moreover from \<open>a \<noteq> 0\<close> a_eq have "b \<noteq> 0" by auto
     ultimately show ?thesis by (subst (asm) dvd_times_left_cancel_iff) auto
   qed blast
 qed (simp_all add: assms(1,2))
 
 lemma irreducible_altdef:
   "irreducible x \<longleftrightarrow> x \<noteq> 0 \<and> \<not>is_unit x \<and> (\<forall>b. b dvd x \<longrightarrow> x dvd b \<or> is_unit b)"
   using irreducibleI'[of x] irreducibleD'[of x] irreducible_not_unit[of x] by auto
 
 lemma prime_elem_multD:
   assumes "prime_elem (a * b)"
   shows "is_unit a \<or> is_unit b"
 proof -
   from assms have "a \<noteq> 0" "b \<noteq> 0" by (auto dest!: prime_elem_not_zeroI)
   moreover from assms prime_elem_dvd_multD [of "a * b"] have "a * b dvd a \<or> a * b dvd b"
     by auto
   ultimately show ?thesis
     using dvd_times_left_cancel_iff [of a b 1]
       dvd_times_right_cancel_iff [of b a 1]
     by auto
 qed
 
 lemma prime_elemD2:
   assumes "prime_elem p" and "a dvd p" and "\<not> is_unit a"
   shows "p dvd a"
 proof -
   from \<open>a dvd p\<close> obtain b where "p = a * b" ..
   with \<open>prime_elem p\<close> prime_elem_multD \<open>\<not> is_unit a\<close> have "is_unit b" by auto
   with \<open>p = a * b\<close> show ?thesis
     by (auto simp add: mult_unit_dvd_iff)
 qed
 
 lemma prime_elem_dvd_prod_msetE:
   assumes "prime_elem p"
   assumes dvd: "p dvd prod_mset A"
   obtains a where "a \<in># A" and "p dvd a"
 proof -
   from dvd have "\<exists>a. a \<in># A \<and> p dvd a"
   proof (induct A)
     case empty then show ?case
     using \<open>prime_elem p\<close> by (simp add: prime_elem_not_unit)
   next
     case (add a A)
     then have "p dvd a * prod_mset A" by simp
     with \<open>prime_elem p\<close> consider (A) "p dvd prod_mset A" | (B) "p dvd a"
       by (blast dest: prime_elem_dvd_multD)
     then show ?case proof cases
       case B then show ?thesis by auto
     next
       case A
       with add.hyps obtain b where "b \<in># A" "p dvd b"
         by auto
       then show ?thesis by auto
     qed
   qed
   with that show thesis by blast
 
 qed
 
 context
 begin
 
 private lemma prime_elem_powerD:
   assumes "prime_elem (p ^ n)"
   shows   "prime_elem p \<and> n = 1"
 proof (cases n)
   case (Suc m)
   note assms
   also from Suc have "p ^ n = p * p^m" by simp
   finally have "is_unit p \<or> is_unit (p^m)" by (rule prime_elem_multD)
   moreover from assms have "\<not>is_unit p" by (simp add: prime_elem_def is_unit_power_iff)
   ultimately have "is_unit (p ^ m)" by simp
   with \<open>\<not>is_unit p\<close> have "m = 0" by (simp add: is_unit_power_iff)
   with Suc assms show ?thesis by simp
 qed (insert assms, simp_all)
 
 lemma prime_elem_power_iff:
   "prime_elem (p ^ n) \<longleftrightarrow> prime_elem p \<and> n = 1"
   by (auto dest: prime_elem_powerD)
 
 end
 
 lemma irreducible_mult_unit_left:
   "is_unit a \<Longrightarrow> irreducible (a * p) \<longleftrightarrow> irreducible p"
   by (auto simp: irreducible_altdef mult.commute[of a] is_unit_mult_iff
         mult_unit_dvd_iff dvd_mult_unit_iff)
 
 lemma prime_elem_mult_unit_left:
   "is_unit a \<Longrightarrow> prime_elem (a * p) \<longleftrightarrow> prime_elem p"
   by (auto simp: prime_elem_def mult.commute[of a] is_unit_mult_iff mult_unit_dvd_iff)
 
 lemma prime_elem_dvd_cases:
   assumes pk: "p*k dvd m*n" and p: "prime_elem p"
   shows "(\<exists>x. k dvd x*n \<and> m = p*x) \<or> (\<exists>y. k dvd m*y \<and> n = p*y)"
 proof -
   have "p dvd m*n" using dvd_mult_left pk by blast
   then consider "p dvd m" | "p dvd n"
     using p prime_elem_dvd_mult_iff by blast
   then show ?thesis
   proof cases
     case 1 then obtain a where "m = p * a" by (metis dvd_mult_div_cancel)
       then have "\<exists>x. k dvd x * n \<and> m = p * x"
         using p pk by (auto simp: mult.assoc)
     then show ?thesis ..
   next
     case 2 then obtain b where "n = p * b" by (metis dvd_mult_div_cancel)
     with p pk have "\<exists>y. k dvd m*y \<and> n = p*y"
       by (metis dvd_mult_right dvd_times_left_cancel_iff mult.left_commute mult_zero_left)
     then show ?thesis ..
   qed
 qed
 
 lemma prime_elem_power_dvd_prod:
   assumes pc: "p^c dvd m*n" and p: "prime_elem p"
   shows "\<exists>a b. a+b = c \<and> p^a dvd m \<and> p^b dvd n"
 using pc
 proof (induct c arbitrary: m n)
   case 0 show ?case by simp
 next
   case (Suc c)
   consider x where "p^c dvd x*n" "m = p*x" | y where "p^c dvd m*y" "n = p*y"
     using prime_elem_dvd_cases [of _ "p^c", OF _ p] Suc.prems by force
   then show ?case
   proof cases
     case (1 x)
     with Suc.hyps[of x n] obtain a b where "a + b = c \<and> p ^ a dvd x \<and> p ^ b dvd n" by blast
     with 1 have "Suc a + b = Suc c \<and> p ^ Suc a dvd m \<and> p ^ b dvd n"
       by (auto intro: mult_dvd_mono)
     thus ?thesis by blast
   next
     case (2 y)
     with Suc.hyps[of m y] obtain a b where "a + b = c \<and> p ^ a dvd m \<and> p ^ b dvd y" by blast
     with 2 have "a + Suc b = Suc c \<and> p ^ a dvd m \<and> p ^ Suc b dvd n"
       by (auto intro: mult_dvd_mono)
     with Suc.hyps [of m y] show "\<exists>a b. a + b = Suc c \<and> p ^ a dvd m \<and> p ^ b dvd n"
       by blast
   qed
 qed
 
 lemma prime_elem_power_dvd_cases:
   assumes "p ^ c dvd m * n" and "a + b = Suc c" and "prime_elem p"
   shows "p ^ a dvd m \<or> p ^ b dvd n"
 proof -
   from assms obtain r s
     where "r + s = c \<and> p ^ r dvd m \<and> p ^ s dvd n"
     by (blast dest: prime_elem_power_dvd_prod)
   moreover with assms have
     "a \<le> r \<or> b \<le> s" by arith
   ultimately show ?thesis by (auto intro: power_le_dvd)
 qed
 
 lemma prime_elem_not_unit' [simp]:
   "ASSUMPTION (prime_elem x) \<Longrightarrow> \<not>is_unit x"
   unfolding ASSUMPTION_def by (rule prime_elem_not_unit)
 
 lemma prime_elem_dvd_power_iff:
   assumes "prime_elem p"
   shows "p dvd a ^ n \<longleftrightarrow> p dvd a \<and> n > 0"
   using assms by (induct n) (auto dest: prime_elem_not_unit prime_elem_dvd_multD)
 
 lemma prime_power_dvd_multD:
   assumes "prime_elem p"
   assumes "p ^ n dvd a * b" and "n > 0" and "\<not> p dvd a"
   shows "p ^ n dvd b"
   using \<open>p ^ n dvd a * b\<close> and \<open>n > 0\<close>
 proof (induct n arbitrary: b)
   case 0 then show ?case by simp
 next
   case (Suc n) show ?case
   proof (cases "n = 0")
     case True with Suc \<open>prime_elem p\<close> \<open>\<not> p dvd a\<close> show ?thesis
       by (simp add: prime_elem_dvd_mult_iff)
   next
     case False then have "n > 0" by simp
     from \<open>prime_elem p\<close> have "p \<noteq> 0" by auto
     from Suc.prems have *: "p * p ^ n dvd a * b"
       by simp
     then have "p dvd a * b"
       by (rule dvd_mult_left)
     with Suc \<open>prime_elem p\<close> \<open>\<not> p dvd a\<close> have "p dvd b"
       by (simp add: prime_elem_dvd_mult_iff)
     moreover define c where "c = b div p"
     ultimately have b: "b = p * c" by simp
     with * have "p * p ^ n dvd p * (a * c)"
       by (simp add: ac_simps)
     with \<open>p \<noteq> 0\<close> have "p ^ n dvd a * c"
       by simp
     with Suc.hyps \<open>n > 0\<close> have "p ^ n dvd c"
       by blast
     with \<open>p \<noteq> 0\<close> show ?thesis
       by (simp add: b)
   qed
 qed
 
 end
 
 
 subsection \<open>Generalized primes: normalized prime elements\<close>
 
 context normalization_semidom
 begin
 
 lemma irreducible_normalized_divisors:
   assumes "irreducible x" "y dvd x" "normalize y = y"
   shows   "y = 1 \<or> y = normalize x"
 proof -
   from assms have "is_unit y \<or> x dvd y" by (auto simp: irreducible_altdef)
   thus ?thesis
   proof (elim disjE)
     assume "is_unit y"
     hence "normalize y = 1" by (simp add: is_unit_normalize)
     with assms show ?thesis by simp
   next
     assume "x dvd y"
     with \<open>y dvd x\<close> have "normalize y = normalize x" by (rule associatedI)
     with assms show ?thesis by simp
   qed
 qed
 
 lemma irreducible_normalize_iff [simp]: "irreducible (normalize x) = irreducible x"
   using irreducible_mult_unit_left[of "1 div unit_factor x" x]
   by (cases "x = 0") (simp_all add: unit_div_commute)
 
 lemma prime_elem_normalize_iff [simp]: "prime_elem (normalize x) = prime_elem x"
   using prime_elem_mult_unit_left[of "1 div unit_factor x" x]
   by (cases "x = 0") (simp_all add: unit_div_commute)
 
 lemma prime_elem_associated:
   assumes "prime_elem p" and "prime_elem q" and "q dvd p"
   shows "normalize q = normalize p"
 using \<open>q dvd p\<close> proof (rule associatedI)
   from \<open>prime_elem q\<close> have "\<not> is_unit q"
     by (auto simp add: prime_elem_not_unit)
   with \<open>prime_elem p\<close> \<open>q dvd p\<close> show "p dvd q"
     by (blast intro: prime_elemD2)
 qed
 
 definition prime :: "'a \<Rightarrow> bool" where
   "prime p \<longleftrightarrow> prime_elem p \<and> normalize p = p"
 
 lemma not_prime_0 [simp]: "\<not>prime 0" by (simp add: prime_def)
 
 lemma not_prime_unit: "is_unit x \<Longrightarrow> \<not>prime x"
   using prime_elem_not_unit[of x] by (auto simp add: prime_def)
 
 lemma not_prime_1 [simp]: "\<not>prime 1" by (simp add: not_prime_unit)
 
 lemma primeI: "prime_elem x \<Longrightarrow> normalize x = x \<Longrightarrow> prime x"
   by (simp add: prime_def)
 
 lemma prime_imp_prime_elem [dest]: "prime p \<Longrightarrow> prime_elem p"
   by (simp add: prime_def)
 
 lemma normalize_prime: "prime p \<Longrightarrow> normalize p = p"
   by (simp add: prime_def)
 
 lemma prime_normalize_iff [simp]: "prime (normalize p) \<longleftrightarrow> prime_elem p"
   by (auto simp add: prime_def)
 
 lemma prime_power_iff:
   "prime (p ^ n) \<longleftrightarrow> prime p \<and> n = 1"
   by (auto simp: prime_def prime_elem_power_iff)
 
 lemma prime_imp_nonzero [simp]:
   "ASSUMPTION (prime x) \<Longrightarrow> x \<noteq> 0"
   unfolding ASSUMPTION_def prime_def by auto
 
 lemma prime_imp_not_one [simp]:
   "ASSUMPTION (prime x) \<Longrightarrow> x \<noteq> 1"
   unfolding ASSUMPTION_def by auto
 
 lemma prime_not_unit' [simp]:
   "ASSUMPTION (prime x) \<Longrightarrow> \<not>is_unit x"
   unfolding ASSUMPTION_def prime_def by auto
 
 lemma prime_normalize' [simp]: "ASSUMPTION (prime x) \<Longrightarrow> normalize x = x"
   unfolding ASSUMPTION_def prime_def by simp
 
 lemma unit_factor_prime: "prime x \<Longrightarrow> unit_factor x = 1"
   using unit_factor_normalize[of x] unfolding prime_def by auto
 
 lemma unit_factor_prime' [simp]: "ASSUMPTION (prime x) \<Longrightarrow> unit_factor x = 1"
   unfolding ASSUMPTION_def by (rule unit_factor_prime)
 
 lemma prime_imp_prime_elem' [simp]: "ASSUMPTION (prime x) \<Longrightarrow> prime_elem x"
   by (simp add: prime_def ASSUMPTION_def)
 
 lemma prime_dvd_multD: "prime p \<Longrightarrow> p dvd a * b \<Longrightarrow> p dvd a \<or> p dvd b"
   by (intro prime_elem_dvd_multD) simp_all
 
 lemma prime_dvd_mult_iff: "prime p \<Longrightarrow> p dvd a * b \<longleftrightarrow> p dvd a \<or> p dvd b"
   by (auto dest: prime_dvd_multD)
 
 lemma prime_dvd_power:
   "prime p \<Longrightarrow> p dvd x ^ n \<Longrightarrow> p dvd x"
   by (auto dest!: prime_elem_dvd_power simp: prime_def)
 
 lemma prime_dvd_power_iff:
   "prime p \<Longrightarrow> n > 0 \<Longrightarrow> p dvd x ^ n \<longleftrightarrow> p dvd x"
   by (subst prime_elem_dvd_power_iff) simp_all
 
 lemma prime_dvd_prod_mset_iff: "prime p \<Longrightarrow> p dvd prod_mset A \<longleftrightarrow> (\<exists>x. x \<in># A \<and> p dvd x)"
   by (induction A) (simp_all add: prime_elem_dvd_mult_iff prime_imp_prime_elem, blast+)
 
 lemma prime_dvd_prod_iff: "finite A \<Longrightarrow> prime p \<Longrightarrow> p dvd prod f A \<longleftrightarrow> (\<exists>x\<in>A. p dvd f x)"
   by (auto simp: prime_dvd_prod_mset_iff prod_unfold_prod_mset)
 
 lemma primes_dvd_imp_eq:
   assumes "prime p" "prime q" "p dvd q"
   shows   "p = q"
 proof -
   from assms have "irreducible q" by (simp add: prime_elem_imp_irreducible prime_def)
   from irreducibleD'[OF this \<open>p dvd q\<close>] assms have "q dvd p" by simp
   with \<open>p dvd q\<close> have "normalize p = normalize q" by (rule associatedI)
   with assms show "p = q" by simp
 qed
 
 lemma prime_dvd_prod_mset_primes_iff:
   assumes "prime p" "\<And>q. q \<in># A \<Longrightarrow> prime q"
   shows   "p dvd prod_mset A \<longleftrightarrow> p \<in># A"
 proof -
   from assms(1) have "p dvd prod_mset A \<longleftrightarrow> (\<exists>x. x \<in># A \<and> p dvd x)" by (rule prime_dvd_prod_mset_iff)
   also from assms have "\<dots> \<longleftrightarrow> p \<in># A" by (auto dest: primes_dvd_imp_eq)
   finally show ?thesis .
 qed
 
 lemma prod_mset_primes_dvd_imp_subset:
   assumes "prod_mset A dvd prod_mset B" "\<And>p. p \<in># A \<Longrightarrow> prime p" "\<And>p. p \<in># B \<Longrightarrow> prime p"
   shows   "A \<subseteq># B"
 using assms
 proof (induction A arbitrary: B)
   case empty
   thus ?case by simp
 next
   case (add p A B)
   hence p: "prime p" by simp
   define B' where "B' = B - {#p#}"
   from add.prems have "p dvd prod_mset B" by (simp add: dvd_mult_left)
   with add.prems have "p \<in># B"
     by (subst (asm) (2) prime_dvd_prod_mset_primes_iff) simp_all
   hence B: "B = B' + {#p#}" by (simp add: B'_def)
   from add.prems p have "A \<subseteq># B'" by (intro add.IH) (simp_all add: B)
   thus ?case by (simp add: B)
 qed
 
 lemma prod_mset_dvd_prod_mset_primes_iff:
   assumes "\<And>x. x \<in># A \<Longrightarrow> prime x" "\<And>x. x \<in># B \<Longrightarrow> prime x"
   shows   "prod_mset A dvd prod_mset B \<longleftrightarrow> A \<subseteq># B"
   using assms by (auto intro: prod_mset_subset_imp_dvd prod_mset_primes_dvd_imp_subset)
 
 lemma is_unit_prod_mset_primes_iff:
   assumes "\<And>x. x \<in># A \<Longrightarrow> prime x"
   shows   "is_unit (prod_mset A) \<longleftrightarrow> A = {#}"
   by (auto simp add: is_unit_prod_mset_iff)
     (meson all_not_in_conv assms not_prime_unit set_mset_eq_empty_iff)
 
 lemma prod_mset_primes_irreducible_imp_prime:
   assumes irred: "irreducible (prod_mset A)"
   assumes A: "\<And>x. x \<in># A \<Longrightarrow> prime x"
   assumes B: "\<And>x. x \<in># B \<Longrightarrow> prime x"
   assumes C: "\<And>x. x \<in># C \<Longrightarrow> prime x"
   assumes dvd: "prod_mset A dvd prod_mset B * prod_mset C"
   shows   "prod_mset A dvd prod_mset B \<or> prod_mset A dvd prod_mset C"
 proof -
   from dvd have "prod_mset A dvd prod_mset (B + C)"
     by simp
   with A B C have subset: "A \<subseteq># B + C"
     by (subst (asm) prod_mset_dvd_prod_mset_primes_iff) auto
   define A1 and A2 where "A1 = A \<inter># B" and "A2 = A - A1"
   have "A = A1 + A2" unfolding A1_def A2_def
     by (rule sym, intro subset_mset.add_diff_inverse) simp_all
   from subset have "A1 \<subseteq># B" "A2 \<subseteq># C"
     by (auto simp: A1_def A2_def Multiset.subset_eq_diff_conv Multiset.union_commute)
   from \<open>A = A1 + A2\<close> have "prod_mset A = prod_mset A1 * prod_mset A2" by simp
   from irred and this have "is_unit (prod_mset A1) \<or> is_unit (prod_mset A2)"
     by (rule irreducibleD)
   with A have "A1 = {#} \<or> A2 = {#}" unfolding A1_def A2_def
     by (subst (asm) (1 2) is_unit_prod_mset_primes_iff) (auto dest: Multiset.in_diffD)
   with dvd \<open>A = A1 + A2\<close> \<open>A1 \<subseteq># B\<close> \<open>A2 \<subseteq># C\<close> show ?thesis
     by (auto intro: prod_mset_subset_imp_dvd)
 qed
 
 lemma prod_mset_primes_finite_divisor_powers:
   assumes A: "\<And>x. x \<in># A \<Longrightarrow> prime x"
   assumes B: "\<And>x. x \<in># B \<Longrightarrow> prime x"
   assumes "A \<noteq> {#}"
   shows   "finite {n. prod_mset A ^ n dvd prod_mset B}"
 proof -
   from \<open>A \<noteq> {#}\<close> obtain x where x: "x \<in># A" by blast
   define m where "m = count B x"
   have "{n. prod_mset A ^ n dvd prod_mset B} \<subseteq> {..m}"
   proof safe
     fix n assume dvd: "prod_mset A ^ n dvd prod_mset B"
     from x have "x ^ n dvd prod_mset A ^ n" by (intro dvd_power_same dvd_prod_mset)
     also note dvd
     also have "x ^ n = prod_mset (replicate_mset n x)" by simp
     finally have "replicate_mset n x \<subseteq># B"
       by (rule prod_mset_primes_dvd_imp_subset) (insert A B x, simp_all split: if_splits)
     thus "n \<le> m" by (simp add: count_le_replicate_mset_subset_eq m_def)
   qed
   moreover have "finite {..m}" by simp
   ultimately show ?thesis by (rule finite_subset)
 qed
 
 end
 
 
 subsection \<open>In a semiring with GCD, each irreducible element is a prime element\<close>
 
 context semiring_gcd
 begin
 
 lemma irreducible_imp_prime_elem_gcd:
   assumes "irreducible x"
   shows   "prime_elem x"
 proof (rule prime_elemI)
   fix a b assume "x dvd a * b"
   from dvd_productE[OF this] obtain y z where yz: "x = y * z" "y dvd a" "z dvd b" .
   from \<open>irreducible x\<close> and \<open>x = y * z\<close> have "is_unit y \<or> is_unit z" by (rule irreducibleD)
   with yz show "x dvd a \<or> x dvd b"
     by (auto simp: mult_unit_dvd_iff mult_unit_dvd_iff')
 qed (insert assms, auto simp: irreducible_not_unit)
 
 lemma prime_elem_imp_coprime:
   assumes "prime_elem p" "\<not>p dvd n"
   shows   "coprime p n"
 proof (rule coprimeI)
   fix d assume "d dvd p" "d dvd n"
   show "is_unit d"
   proof (rule ccontr)
     assume "\<not>is_unit d"
     from \<open>prime_elem p\<close> and \<open>d dvd p\<close> and this have "p dvd d"
       by (rule prime_elemD2)
     from this and \<open>d dvd n\<close> have "p dvd n" by (rule dvd_trans)
     with \<open>\<not>p dvd n\<close> show False by contradiction
   qed
 qed
 
 lemma prime_imp_coprime:
   assumes "prime p" "\<not>p dvd n"
   shows   "coprime p n"
   using assms by (simp add: prime_elem_imp_coprime)
 
 lemma prime_elem_imp_power_coprime:
   "prime_elem p \<Longrightarrow> \<not> p dvd a \<Longrightarrow> coprime a (p ^ m)"
   by (cases "m > 0") (auto dest: prime_elem_imp_coprime simp add: ac_simps)
 
 lemma prime_imp_power_coprime:
   "prime p \<Longrightarrow> \<not> p dvd a \<Longrightarrow> coprime a (p ^ m)"
   by (rule prime_elem_imp_power_coprime) simp_all
 
 lemma prime_elem_divprod_pow:
   assumes p: "prime_elem p" and ab: "coprime a b" and pab: "p^n dvd a * b"
   shows   "p^n dvd a \<or> p^n dvd b"
   using assms
 proof -
   from p have "\<not> is_unit p"
     by simp
   with ab p have "\<not> p dvd a \<or> \<not> p dvd b"
     using not_coprimeI by blast
   with p have "coprime (p ^ n) a \<or> coprime (p ^ n) b"
     by (auto dest: prime_elem_imp_power_coprime simp add: ac_simps)
   with pab show ?thesis
     by (auto simp add: coprime_dvd_mult_left_iff coprime_dvd_mult_right_iff)
 qed
 
 lemma primes_coprime:
   "prime p \<Longrightarrow> prime q \<Longrightarrow> p \<noteq> q \<Longrightarrow> coprime p q"
   using prime_imp_coprime primes_dvd_imp_eq by blast
 
 end
 
 
 subsection \<open>Factorial semirings: algebraic structures with unique prime factorizations\<close>
 
 class factorial_semiring = normalization_semidom +
   assumes prime_factorization_exists:
     "x \<noteq> 0 \<Longrightarrow> \<exists>A. (\<forall>x. x \<in># A \<longrightarrow> prime_elem x) \<and> normalize (prod_mset A) = normalize x"
 
 text \<open>Alternative characterization\<close>
 
 lemma (in normalization_semidom) factorial_semiring_altI_aux:
   assumes finite_divisors: "\<And>x. x \<noteq> 0 \<Longrightarrow> finite {y. y dvd x \<and> normalize y = y}"
   assumes irreducible_imp_prime_elem: "\<And>x. irreducible x \<Longrightarrow> prime_elem x"
   assumes "x \<noteq> 0"
   shows   "\<exists>A. (\<forall>x. x \<in># A \<longrightarrow> prime_elem x) \<and> normalize (prod_mset A) = normalize x"
 using \<open>x \<noteq> 0\<close>
 proof (induction "card {b. b dvd x \<and> normalize b = b}" arbitrary: x rule: less_induct)
   case (less a)
   let ?fctrs = "\<lambda>a. {b. b dvd a \<and> normalize b = b}"
   show ?case
   proof (cases "is_unit a")
     case True
     thus ?thesis by (intro exI[of _ "{#}"]) (auto simp: is_unit_normalize)
   next
     case False
     show ?thesis
     proof (cases "\<exists>b. b dvd a \<and> \<not>is_unit b \<and> \<not>a dvd b")
       case False
       with \<open>\<not>is_unit a\<close> less.prems have "irreducible a" by (auto simp: irreducible_altdef)
       hence "prime_elem a" by (rule irreducible_imp_prime_elem)
       thus ?thesis by (intro exI[of _ "{#normalize a#}"]) auto
     next
       case True
-      then guess b by (elim exE conjE) note b = this
-
+      then obtain b where b: "b dvd a" "\<not> is_unit b" "\<not> a dvd b" by auto
       from b have "?fctrs b \<subseteq> ?fctrs a" by (auto intro: dvd_trans)
       moreover from b have "normalize a \<notin> ?fctrs b" "normalize a \<in> ?fctrs a" by simp_all
       hence "?fctrs b \<noteq> ?fctrs a" by blast
       ultimately have "?fctrs b \<subset> ?fctrs a" by (subst subset_not_subset_eq) blast
       with finite_divisors[OF \<open>a \<noteq> 0\<close>] have "card (?fctrs b) < card (?fctrs a)"
         by (rule psubset_card_mono)
       moreover from \<open>a \<noteq> 0\<close> b have "b \<noteq> 0" by auto
       ultimately have "\<exists>A. (\<forall>x. x \<in># A \<longrightarrow> prime_elem x) \<and> normalize (prod_mset A) = normalize b"
         by (intro less) auto
-      then guess A .. note A = this
+      then obtain A where A: "(\<forall>x. x \<in># A \<longrightarrow> prime_elem x) \<and> normalize (\<Prod>\<^sub># A) = normalize b"
+        by auto
 
       define c where "c = a div b"
       from b have c: "a = b * c" by (simp add: c_def)
       from less.prems c have "c \<noteq> 0" by auto
       from b c have "?fctrs c \<subseteq> ?fctrs a" by (auto intro: dvd_trans)
       moreover have "normalize a \<notin> ?fctrs c"
       proof safe
         assume "normalize a dvd c"
         hence "b * c dvd 1 * c" by (simp add: c)
         hence "b dvd 1" by (subst (asm) dvd_times_right_cancel_iff) fact+
         with b show False by simp
       qed
       with \<open>normalize a \<in> ?fctrs a\<close> have "?fctrs a \<noteq> ?fctrs c" by blast
       ultimately have "?fctrs c \<subset> ?fctrs a" by (subst subset_not_subset_eq) blast
       with finite_divisors[OF \<open>a \<noteq> 0\<close>] have "card (?fctrs c) < card (?fctrs a)"
         by (rule psubset_card_mono)
       with \<open>c \<noteq> 0\<close> have "\<exists>A. (\<forall>x. x \<in># A \<longrightarrow> prime_elem x) \<and> normalize (prod_mset A) = normalize c"
         by (intro less) auto
-      then guess B .. note B = this
+      then obtain B where B: "(\<forall>x. x \<in># B \<longrightarrow> prime_elem x) \<and> normalize (\<Prod>\<^sub># B) = normalize c"
+        by auto
 
       show ?thesis
       proof (rule exI[of _ "A + B"]; safe)
         have "normalize (prod_mset (A + B)) =
                 normalize (normalize (prod_mset A) * normalize (prod_mset B))"
           by simp
         also have "\<dots> = normalize (b * c)"
           by (simp only: A B) auto
         also have "b * c = a"
           using c by simp
         finally show "normalize (prod_mset (A + B)) = normalize a" .
       next
       qed (use A B in auto)
     qed
   qed
 qed
 
 lemma factorial_semiring_altI:
   assumes finite_divisors: "\<And>x::'a. x \<noteq> 0 \<Longrightarrow> finite {y. y dvd x \<and> normalize y = y}"
   assumes irreducible_imp_prime: "\<And>x::'a. irreducible x \<Longrightarrow> prime_elem x"
   shows   "OFCLASS('a :: normalization_semidom, factorial_semiring_class)"
   by intro_classes (rule factorial_semiring_altI_aux[OF assms])
 
 text \<open>Properties\<close>
 
 context factorial_semiring
 begin
 
 lemma prime_factorization_exists':
   assumes "x \<noteq> 0"
   obtains A where "\<And>x. x \<in># A \<Longrightarrow> prime x" "normalize (prod_mset A) = normalize x"
 proof -
   from prime_factorization_exists[OF assms] obtain A
     where A: "\<And>x. x \<in># A \<Longrightarrow> prime_elem x" "normalize (prod_mset A) = normalize x" by blast
   define A' where "A' = image_mset normalize A"
   have "normalize (prod_mset A') = normalize (prod_mset A)"
     by (simp add: A'_def normalize_prod_mset_normalize)
   also note A(2)
   finally have "normalize (prod_mset A') = normalize x" by simp
   moreover from A(1) have "\<forall>x. x \<in># A' \<longrightarrow> prime x" by (auto simp: prime_def A'_def)
   ultimately show ?thesis by (intro that[of A']) blast
 qed
 
 lemma irreducible_imp_prime_elem:
   assumes "irreducible x"
   shows   "prime_elem x"
 proof (rule prime_elemI)
   fix a b assume dvd: "x dvd a * b"
   from assms have "x \<noteq> 0" by auto
   show "x dvd a \<or> x dvd b"
   proof (cases "a = 0 \<or> b = 0")
     case False
     hence "a \<noteq> 0" "b \<noteq> 0" by blast+
     note nz = \<open>x \<noteq> 0\<close> this
-    from nz[THEN prime_factorization_exists'] guess A B C . note ABC = this
+    from nz[THEN prime_factorization_exists'] obtain A B C
+      where ABC:
+        "\<And>z. z \<in># A \<Longrightarrow> prime z"
+        "normalize (\<Prod>\<^sub># A) = normalize x"
+        "\<And>z. z \<in># B \<Longrightarrow> prime z"
+        "normalize (\<Prod>\<^sub># B) = normalize a"
+        "\<And>z. z \<in># C \<Longrightarrow> prime z"
+        "normalize (\<Prod>\<^sub># C) = normalize b"
+      by this blast
 
     have "irreducible (prod_mset A)"
       by (subst irreducible_cong[OF ABC(2)]) fact
     moreover have "normalize (prod_mset A) dvd
                      normalize (normalize (prod_mset B) * normalize (prod_mset C))"
       unfolding ABC using dvd by simp
     hence "prod_mset A dvd prod_mset B * prod_mset C"
       unfolding normalize_mult_normalize_left normalize_mult_normalize_right by simp
     ultimately have "prod_mset A dvd prod_mset B \<or> prod_mset A dvd prod_mset C"
       by (intro prod_mset_primes_irreducible_imp_prime) (use ABC in auto)
     hence "normalize (prod_mset A) dvd normalize (prod_mset B) \<or>
            normalize (prod_mset A) dvd normalize (prod_mset C)" by simp
     thus ?thesis unfolding ABC by simp
   qed auto
-qed (insert assms, simp_all add: irreducible_def)
+qed (use assms in \<open>simp_all add: irreducible_def\<close>)
 
 lemma finite_divisor_powers:
   assumes "y \<noteq> 0" "\<not>is_unit x"
   shows   "finite {n. x ^ n dvd y}"
 proof (cases "x = 0")
   case True
   with assms have "{n. x ^ n dvd y} = {0}" by (auto simp: power_0_left)
   thus ?thesis by simp
 next
   case False
   note nz = this \<open>y \<noteq> 0\<close>
-  from nz[THEN prime_factorization_exists'] guess A B . note AB = this
+  from nz[THEN prime_factorization_exists'] obtain A B
+    where AB:
+      "\<And>z. z \<in># A \<Longrightarrow> prime z"
+      "normalize (\<Prod>\<^sub># A) = normalize x"
+      "\<And>z. z \<in># B \<Longrightarrow> prime z"
+      "normalize (\<Prod>\<^sub># B) = normalize y"
+    by this blast
+
   from AB assms have "A \<noteq> {#}" by (auto simp: normalize_1_iff)
   from AB(2,4) prod_mset_primes_finite_divisor_powers [of A B, OF AB(1,3) this]
     have "finite {n. prod_mset A ^ n dvd prod_mset B}" by simp
   also have "{n. prod_mset A ^ n dvd prod_mset B} =
              {n. normalize (normalize (prod_mset A) ^ n) dvd normalize (prod_mset B)}"
     unfolding normalize_power_normalize by simp
   also have "\<dots> = {n. x ^ n dvd y}"
     unfolding AB unfolding normalize_power_normalize by simp
   finally show ?thesis .
 qed
 
 lemma finite_prime_divisors:
   assumes "x \<noteq> 0"
   shows   "finite {p. prime p \<and> p dvd x}"
 proof -
-  from prime_factorization_exists'[OF assms] guess A . note A = this
+  from prime_factorization_exists'[OF assms] obtain A
+    where A: "\<And>z. z \<in># A \<Longrightarrow> prime z" "normalize (\<Prod>\<^sub># A) = normalize x" by this blast
   have "{p. prime p \<and> p dvd x} \<subseteq> set_mset A"
   proof safe
     fix p assume p: "prime p" and dvd: "p dvd x"
     from dvd have "p dvd normalize x" by simp
     also from A have "normalize x = normalize (prod_mset A)" by simp
     finally have "p dvd prod_mset A"
       by simp
     thus  "p \<in># A" using p A
       by (subst (asm) prime_dvd_prod_mset_primes_iff)
   qed
   moreover have "finite (set_mset A)" by simp
   ultimately show ?thesis by (rule finite_subset)
 qed
 
 lemma infinite_unit_divisor_powers:
  assumes "y \<noteq> 0"
  assumes "is_unit x"
  shows "infinite {n. x^n dvd y}"
 proof -
  from `is_unit x` have "is_unit (x^n)" for n
    using is_unit_power_iff by auto
  hence "x^n dvd y" for n
    by auto
  hence "{n. x^n dvd y} = UNIV"
    by auto
  thus ?thesis
    by auto
 qed
 
 corollary is_unit_iff_infinite_divisor_powers:
  assumes "y \<noteq> 0"
  shows "is_unit x \<longleftrightarrow> infinite {n. x^n dvd y}"
  using infinite_unit_divisor_powers finite_divisor_powers assms by auto
 
 lemma prime_elem_iff_irreducible: "prime_elem x \<longleftrightarrow> irreducible x"
   by (blast intro: irreducible_imp_prime_elem prime_elem_imp_irreducible)
 
 lemma prime_divisor_exists:
   assumes "a \<noteq> 0" "\<not>is_unit a"
   shows   "\<exists>b. b dvd a \<and> prime b"
 proof -
-  from prime_factorization_exists'[OF assms(1)] guess A . note A = this
-  moreover from A and assms have "A \<noteq> {#}" by auto
+  from prime_factorization_exists'[OF assms(1)]
+  obtain A where A: "\<And>z. z \<in># A \<Longrightarrow> prime z" "normalize (\<Prod>\<^sub># A) = normalize a"
+    by this blast
+  with assms have "A \<noteq> {#}" by auto
   then obtain x where "x \<in># A" by blast
   with A(1) have *: "x dvd normalize (prod_mset A)" "prime x"
     by (auto simp: dvd_prod_mset)
-  hence "x dvd a" unfolding A by simp
+  hence "x dvd a" by (simp add: A(2))
   with * show ?thesis by blast
 qed
 
 lemma prime_divisors_induct [case_names zero unit factor]:
   assumes "P 0" "\<And>x. is_unit x \<Longrightarrow> P x" "\<And>p x. prime p \<Longrightarrow> P x \<Longrightarrow> P (p * x)"
   shows   "P x"
 proof (cases "x = 0")
   case False
-  from prime_factorization_exists'[OF this] guess A . note A = this
+  from prime_factorization_exists'[OF this]
+  obtain A where A: "\<And>z. z \<in># A \<Longrightarrow> prime z" "normalize (\<Prod>\<^sub># A) = normalize x"
+    by this blast
   from A obtain u where u: "is_unit u" "x = u * prod_mset A"
     by (elim associatedE2)
 
   from A(1) have "P (u * prod_mset A)"
   proof (induction A)
     case (add p A)
     from add.prems have "prime p" by simp
     moreover from add.prems have "P (u * prod_mset A)" by (intro add.IH) simp_all
     ultimately have "P (p * (u * prod_mset A))" by (rule assms(3))
     thus ?case by (simp add: mult_ac)
   qed (simp_all add: assms False u)
   with A u show ?thesis by simp
 qed (simp_all add: assms(1))
 
 lemma no_prime_divisors_imp_unit:
   assumes "a \<noteq> 0" "\<And>b. b dvd a \<Longrightarrow> normalize b = b \<Longrightarrow> \<not> prime_elem b"
   shows "is_unit a"
 proof (rule ccontr)
   assume "\<not>is_unit a"
-  from prime_divisor_exists[OF assms(1) this] guess b by (elim exE conjE)
+  from prime_divisor_exists[OF assms(1) this] obtain b where "b dvd a" "prime b" by auto
   with assms(2)[of b] show False by (simp add: prime_def)
 qed
 
 lemma prime_divisorE:
   assumes "a \<noteq> 0" and "\<not> is_unit a"
   obtains p where "prime p" and "p dvd a"
   using assms no_prime_divisors_imp_unit unfolding prime_def by blast
 
 definition multiplicity :: "'a \<Rightarrow> 'a \<Rightarrow> nat" where
   "multiplicity p x = (if finite {n. p ^ n dvd x} then Max {n. p ^ n dvd x} else 0)"
 
 lemma multiplicity_dvd: "p ^ multiplicity p x dvd x"
 proof (cases "finite {n. p ^ n dvd x}")
   case True
   hence "multiplicity p x = Max {n. p ^ n dvd x}"
     by (simp add: multiplicity_def)
   also have "\<dots> \<in> {n. p ^ n dvd x}"
     by (rule Max_in) (auto intro!: True exI[of _ "0::nat"])
   finally show ?thesis by simp
 qed (simp add: multiplicity_def)
 
 lemma multiplicity_dvd': "n \<le> multiplicity p x \<Longrightarrow> p ^ n dvd x"
   by (rule dvd_trans[OF le_imp_power_dvd multiplicity_dvd])
 
 context
   fixes x p :: 'a
   assumes xp: "x \<noteq> 0" "\<not>is_unit p"
 begin
 
 lemma multiplicity_eq_Max: "multiplicity p x = Max {n. p ^ n dvd x}"
   using finite_divisor_powers[OF xp] by (simp add: multiplicity_def)
 
 lemma multiplicity_geI:
   assumes "p ^ n dvd x"
   shows   "multiplicity p x \<ge> n"
 proof -
   from assms have "n \<le> Max {n. p ^ n dvd x}"
     by (intro Max_ge finite_divisor_powers xp) simp_all
   thus ?thesis by (subst multiplicity_eq_Max)
 qed
 
 lemma multiplicity_lessI:
   assumes "\<not>p ^ n dvd x"
   shows   "multiplicity p x < n"
 proof (rule ccontr)
   assume "\<not>(n > multiplicity p x)"
   hence "p ^ n dvd x" by (intro multiplicity_dvd') simp
   with assms show False by contradiction
 qed
 
 lemma power_dvd_iff_le_multiplicity:
   "p ^ n dvd x \<longleftrightarrow> n \<le> multiplicity p x"
   using multiplicity_geI[of n] multiplicity_lessI[of n] by (cases "p ^ n dvd x") auto
 
 lemma multiplicity_eq_zero_iff:
   shows   "multiplicity p x = 0 \<longleftrightarrow> \<not>p dvd x"
   using power_dvd_iff_le_multiplicity[of 1] by auto
 
 lemma multiplicity_gt_zero_iff:
   shows   "multiplicity p x > 0 \<longleftrightarrow> p dvd x"
   using power_dvd_iff_le_multiplicity[of 1] by auto
 
 lemma multiplicity_decompose:
   "\<not>p dvd (x div p ^ multiplicity p x)"
 proof
   assume *: "p dvd x div p ^ multiplicity p x"
   have "x = x div p ^ multiplicity p x * (p ^ multiplicity p x)"
     using multiplicity_dvd[of p x] by simp
   also from * have "x div p ^ multiplicity p x = (x div p ^ multiplicity p x div p) * p" by simp
   also have "x div p ^ multiplicity p x div p * p * p ^ multiplicity p x =
                x div p ^ multiplicity p x div p * p ^ Suc (multiplicity p x)"
     by (simp add: mult_assoc)
   also have "p ^ Suc (multiplicity p x) dvd \<dots>" by (rule dvd_triv_right)
   finally show False by (subst (asm) power_dvd_iff_le_multiplicity) simp
 qed
 
 lemma multiplicity_decompose':
   obtains y where "x = p ^ multiplicity p x * y" "\<not>p dvd y"
   using that[of "x div p ^ multiplicity p x"]
   by (simp add: multiplicity_decompose multiplicity_dvd)
 
 end
 
 lemma multiplicity_zero [simp]: "multiplicity p 0 = 0"
   by (simp add: multiplicity_def)
 
 lemma prime_elem_multiplicity_eq_zero_iff:
   "prime_elem p \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> multiplicity p x = 0 \<longleftrightarrow> \<not>p dvd x"
   by (rule multiplicity_eq_zero_iff) simp_all
 
 lemma prime_multiplicity_other:
   assumes "prime p" "prime q" "p \<noteq> q"
   shows   "multiplicity p q = 0"
   using assms by (subst prime_elem_multiplicity_eq_zero_iff) (auto dest: primes_dvd_imp_eq)
 
 lemma prime_multiplicity_gt_zero_iff:
   "prime_elem p \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> multiplicity p x > 0 \<longleftrightarrow> p dvd x"
   by (rule multiplicity_gt_zero_iff) simp_all
 
 lemma multiplicity_unit_left: "is_unit p \<Longrightarrow> multiplicity p x = 0"
   by (simp add: multiplicity_def is_unit_power_iff unit_imp_dvd)
 
 lemma multiplicity_unit_right:
   assumes "is_unit x"
   shows   "multiplicity p x = 0"
 proof (cases "is_unit p \<or> x = 0")
   case False
   with multiplicity_lessI[of x p 1] this assms
     show ?thesis by (auto dest: dvd_unit_imp_unit)
 qed (auto simp: multiplicity_unit_left)
 
 lemma multiplicity_one [simp]: "multiplicity p 1 = 0"
   by (rule multiplicity_unit_right) simp_all
 
 lemma multiplicity_eqI:
   assumes "p ^ n dvd x" "\<not>p ^ Suc n dvd x"
   shows   "multiplicity p x = n"
 proof -
   consider "x = 0" | "is_unit p" | "x \<noteq> 0" "\<not>is_unit p" by blast
   thus ?thesis
   proof cases
     assume xp: "x \<noteq> 0" "\<not>is_unit p"
     from xp assms(1) have "multiplicity p x \<ge> n" by (intro multiplicity_geI)
     moreover from assms(2) xp have "multiplicity p x < Suc n" by (intro multiplicity_lessI)
     ultimately show ?thesis by simp
   next
     assume "is_unit p"
     hence "is_unit (p ^ Suc n)" by (simp add: is_unit_power_iff del: power_Suc)
     hence "p ^ Suc n dvd x" by (rule unit_imp_dvd)
     with \<open>\<not>p ^ Suc n dvd x\<close> show ?thesis by contradiction
   qed (insert assms, simp_all)
 qed
 
 
 context
   fixes x p :: 'a
   assumes xp: "x \<noteq> 0" "\<not>is_unit p"
 begin
 
 lemma multiplicity_times_same:
   assumes "p \<noteq> 0"
   shows   "multiplicity p (p * x) = Suc (multiplicity p x)"
 proof (rule multiplicity_eqI)
   show "p ^ Suc (multiplicity p x) dvd p * x"
     by (auto intro!: mult_dvd_mono multiplicity_dvd)
   from xp assms show "\<not> p ^ Suc (Suc (multiplicity p x)) dvd p * x"
     using power_dvd_iff_le_multiplicity[OF xp, of "Suc (multiplicity p x)"] by simp
 qed
 
 end
 
 lemma multiplicity_same_power': "multiplicity p (p ^ n) = (if p = 0 \<or> is_unit p then 0 else n)"
 proof -
   consider "p = 0" | "is_unit p" |"p \<noteq> 0" "\<not>is_unit p" by blast
   thus ?thesis
   proof cases
     assume "p \<noteq> 0" "\<not>is_unit p"
     thus ?thesis by (induction n) (simp_all add: multiplicity_times_same)
   qed (simp_all add: power_0_left multiplicity_unit_left)
 qed
 
 lemma multiplicity_same_power:
   "p \<noteq> 0 \<Longrightarrow> \<not>is_unit p \<Longrightarrow> multiplicity p (p ^ n) = n"
   by (simp add: multiplicity_same_power')
 
 lemma multiplicity_prime_elem_times_other:
   assumes "prime_elem p" "\<not>p dvd q"
   shows   "multiplicity p (q * x) = multiplicity p x"
 proof (cases "x = 0")
   case False
   show ?thesis
   proof (rule multiplicity_eqI)
     have "1 * p ^ multiplicity p x dvd q * x"
       by (intro mult_dvd_mono multiplicity_dvd) simp_all
     thus "p ^ multiplicity p x dvd q * x" by simp
   next
     define n where "n = multiplicity p x"
     from assms have "\<not>is_unit p" by simp
-    from multiplicity_decompose'[OF False this] guess y . note y = this [folded n_def]
+    from multiplicity_decompose'[OF False this]
+    obtain y where y [folded n_def]: "x = p ^ multiplicity p x * y" "\<not> p dvd y" .
     from y have "p ^ Suc n dvd q * x \<longleftrightarrow> p ^ n * p dvd p ^ n * (q * y)" by (simp add: mult_ac)
     also from assms have "\<dots> \<longleftrightarrow> p dvd q * y" by simp
     also have "\<dots> \<longleftrightarrow> p dvd q \<or> p dvd y" by (rule prime_elem_dvd_mult_iff) fact+
     also from assms y have "\<dots> \<longleftrightarrow> False" by simp
     finally show "\<not>(p ^ Suc n dvd q * x)" by blast
   qed
 qed simp_all
 
 lemma multiplicity_self:
   assumes "p \<noteq> 0" "\<not>is_unit p"
   shows   "multiplicity p p = 1"
 proof -
   from assms have "multiplicity p p = Max {n. p ^ n dvd p}"
     by (simp add: multiplicity_eq_Max)
   also from assms have "p ^ n dvd p \<longleftrightarrow> n \<le> 1" for n
     using dvd_power_iff[of p n 1] by auto
   hence "{n. p ^ n dvd p} = {..1}" by auto
   also have "\<dots> = {0,1}" by auto
   finally show ?thesis by simp
 qed
 
 lemma multiplicity_times_unit_left:
   assumes "is_unit c"
   shows   "multiplicity (c * p) x = multiplicity p x"
 proof -
   from assms have "{n. (c * p) ^ n dvd x} = {n. p ^ n dvd x}"
     by (subst mult.commute) (simp add: mult_unit_dvd_iff power_mult_distrib is_unit_power_iff)
   thus ?thesis by (simp add: multiplicity_def)
 qed
 
 lemma multiplicity_times_unit_right:
   assumes "is_unit c"
   shows   "multiplicity p (c * x) = multiplicity p x"
 proof -
   from assms have "{n. p ^ n dvd c * x} = {n. p ^ n dvd x}"
     by (subst mult.commute) (simp add: dvd_mult_unit_iff)
   thus ?thesis by (simp add: multiplicity_def)
 qed
 
 lemma multiplicity_normalize_left [simp]:
   "multiplicity (normalize p) x = multiplicity p x"
 proof (cases "p = 0")
   case [simp]: False
   have "normalize p = (1 div unit_factor p) * p"
     by (simp add: unit_div_commute is_unit_unit_factor)
   also have "multiplicity \<dots> x = multiplicity p x"
     by (rule multiplicity_times_unit_left) (simp add: is_unit_unit_factor)
   finally show ?thesis .
 qed simp_all
 
 lemma multiplicity_normalize_right [simp]:
   "multiplicity p (normalize x) = multiplicity p x"
 proof (cases "x = 0")
   case [simp]: False
   have "normalize x = (1 div unit_factor x) * x"
     by (simp add: unit_div_commute is_unit_unit_factor)
   also have "multiplicity p \<dots> = multiplicity p x"
     by (rule multiplicity_times_unit_right) (simp add: is_unit_unit_factor)
   finally show ?thesis .
 qed simp_all
 
 lemma multiplicity_prime [simp]: "prime_elem p \<Longrightarrow> multiplicity p p = 1"
   by (rule multiplicity_self) auto
 
 lemma multiplicity_prime_power [simp]: "prime_elem p \<Longrightarrow> multiplicity p (p ^ n) = n"
   by (subst multiplicity_same_power') auto
 
 lift_definition prime_factorization :: "'a \<Rightarrow> 'a multiset" is
   "\<lambda>x p. if prime p then multiplicity p x else 0"
 proof -
   fix x :: 'a
   show "finite {p. 0 < (if prime p then multiplicity p x else 0)}" (is "finite ?A")
   proof (cases "x = 0")
     case False
     from False have "?A \<subseteq> {p. prime p \<and> p dvd x}"
       by (auto simp: multiplicity_gt_zero_iff)
     moreover from False have "finite {p. prime p \<and> p dvd x}"
       by (rule finite_prime_divisors)
     ultimately show ?thesis by (rule finite_subset)
   qed simp_all
 qed
 
 abbreviation prime_factors :: "'a \<Rightarrow> 'a set" where
   "prime_factors a \<equiv> set_mset (prime_factorization a)"
 
 lemma count_prime_factorization_nonprime:
   "\<not>prime p \<Longrightarrow> count (prime_factorization x) p = 0"
   by transfer simp
 
 lemma count_prime_factorization_prime:
   "prime p \<Longrightarrow> count (prime_factorization x) p = multiplicity p x"
   by transfer simp
 
 lemma count_prime_factorization:
   "count (prime_factorization x) p = (if prime p then multiplicity p x else 0)"
   by transfer simp
 
 lemma dvd_imp_multiplicity_le:
   assumes "a dvd b" "b \<noteq> 0"
   shows   "multiplicity p a \<le> multiplicity p b"
 proof (cases "is_unit p")
   case False
   with assms show ?thesis
     by (intro multiplicity_geI ) (auto intro: dvd_trans[OF multiplicity_dvd' assms(1)])
 qed (insert assms, auto simp: multiplicity_unit_left)
 
 lemma prime_power_inj:
   assumes "prime a" "a ^ m = a ^ n"
   shows   "m = n"
 proof -
   have "multiplicity a (a ^ m) = multiplicity a (a ^ n)" by (simp only: assms)
   thus ?thesis using assms by (subst (asm) (1 2) multiplicity_prime_power) simp_all
 qed
 
 lemma prime_power_inj':
   assumes "prime p" "prime q"
   assumes "p ^ m = q ^ n" "m > 0" "n > 0"
   shows   "p = q" "m = n"
 proof -
   from assms have "p ^ 1 dvd p ^ m" by (intro le_imp_power_dvd) simp
   also have "p ^ m = q ^ n" by fact
   finally have "p dvd q ^ n" by simp
   with assms have "p dvd q" using prime_dvd_power[of p q] by simp
   with assms show "p = q" by (simp add: primes_dvd_imp_eq)
   with assms show "m = n" by (simp add: prime_power_inj)
 qed
 
 lemma prime_power_eq_one_iff [simp]: "prime p \<Longrightarrow> p ^ n = 1 \<longleftrightarrow> n = 0"
   using prime_power_inj[of p n 0] by auto
 
 lemma one_eq_prime_power_iff [simp]: "prime p \<Longrightarrow> 1 = p ^ n \<longleftrightarrow> n = 0"
   using prime_power_inj[of p 0 n] by auto
 
 lemma prime_power_inj'':
   assumes "prime p" "prime q"
   shows   "p ^ m = q ^ n \<longleftrightarrow> (m = 0 \<and> n = 0) \<or> (p = q \<and> m = n)"
   using assms 
   by (cases "m = 0"; cases "n = 0")
      (auto dest: prime_power_inj'[OF assms])
 
 lemma prime_factorization_0 [simp]: "prime_factorization 0 = {#}"
   by (simp add: multiset_eq_iff count_prime_factorization)
 
 lemma prime_factorization_empty_iff:
   "prime_factorization x = {#} \<longleftrightarrow> x = 0 \<or> is_unit x"
 proof
   assume *: "prime_factorization x = {#}"
   {
     assume x: "x \<noteq> 0" "\<not>is_unit x"
     {
       fix p assume p: "prime p"
       have "count (prime_factorization x) p = 0" by (simp add: *)
       also from p have "count (prime_factorization x) p = multiplicity p x"
         by (rule count_prime_factorization_prime)
       also from x p have "\<dots> = 0 \<longleftrightarrow> \<not>p dvd x" by (simp add: multiplicity_eq_zero_iff)
       finally have "\<not>p dvd x" .
     }
     with prime_divisor_exists[OF x] have False by blast
   }
   thus "x = 0 \<or> is_unit x" by blast
 next
   assume "x = 0 \<or> is_unit x"
   thus "prime_factorization x = {#}"
   proof
     assume x: "is_unit x"
     {
       fix p assume p: "prime p"
       from p x have "multiplicity p x = 0"
         by (subst multiplicity_eq_zero_iff)
            (auto simp: multiplicity_eq_zero_iff dest: unit_imp_no_prime_divisors)
     }
     thus ?thesis by (simp add: multiset_eq_iff count_prime_factorization)
   qed simp_all
 qed
 
 lemma prime_factorization_unit:
   assumes "is_unit x"
   shows   "prime_factorization x = {#}"
 proof (rule multiset_eqI)
   fix p :: 'a
   show "count (prime_factorization x) p = count {#} p"
   proof (cases "prime p")
     case True
     with assms have "multiplicity p x = 0"
       by (subst multiplicity_eq_zero_iff)
          (auto simp: multiplicity_eq_zero_iff dest: unit_imp_no_prime_divisors)
     with True show ?thesis by (simp add: count_prime_factorization_prime)
   qed (simp_all add: count_prime_factorization_nonprime)
 qed
 
 lemma prime_factorization_1 [simp]: "prime_factorization 1 = {#}"
   by (simp add: prime_factorization_unit)
 
 lemma prime_factorization_times_prime:
   assumes "x \<noteq> 0" "prime p"
   shows   "prime_factorization (p * x) = {#p#} + prime_factorization x"
 proof (rule multiset_eqI)
   fix q :: 'a
   consider "\<not>prime q" | "p = q" | "prime q" "p \<noteq> q" by blast
   thus "count (prime_factorization (p * x)) q = count ({#p#} + prime_factorization x) q"
   proof cases
     assume q: "prime q" "p \<noteq> q"
     with assms primes_dvd_imp_eq[of q p] have "\<not>q dvd p" by auto
     with q assms show ?thesis
       by (simp add: multiplicity_prime_elem_times_other count_prime_factorization)
   qed (insert assms, auto simp: count_prime_factorization multiplicity_times_same)
 qed
 
 lemma prod_mset_prime_factorization_weak:
   assumes "x \<noteq> 0"
   shows   "normalize (prod_mset (prime_factorization x)) = normalize x"
   using assms
 proof (induction x rule: prime_divisors_induct)
   case (factor p x)
   have "normalize (prod_mset (prime_factorization (p * x))) =
           normalize (p * normalize (prod_mset (prime_factorization x)))"
     using factor.prems factor.hyps by (simp add: prime_factorization_times_prime)
   also have "normalize (prod_mset (prime_factorization x)) = normalize x"
     by (rule factor.IH) (use factor in auto)
   finally show ?case by simp
 qed (auto simp: prime_factorization_unit is_unit_normalize)
 
 lemma in_prime_factors_iff:
   "p \<in> prime_factors x \<longleftrightarrow> x \<noteq> 0 \<and> p dvd x \<and> prime p"
 proof -
   have "p \<in> prime_factors x \<longleftrightarrow> count (prime_factorization x) p > 0" by simp
   also have "\<dots> \<longleftrightarrow> x \<noteq> 0 \<and> p dvd x \<and> prime p"
    by (subst count_prime_factorization, cases "x = 0")
       (auto simp: multiplicity_eq_zero_iff multiplicity_gt_zero_iff)
   finally show ?thesis .
 qed
 
 lemma in_prime_factors_imp_prime [intro]:
   "p \<in> prime_factors x \<Longrightarrow> prime p"
   by (simp add: in_prime_factors_iff)
 
 lemma in_prime_factors_imp_dvd [dest]:
   "p \<in> prime_factors x \<Longrightarrow> p dvd x"
   by (simp add: in_prime_factors_iff)
 
 lemma prime_factorsI:
   "x \<noteq> 0 \<Longrightarrow> prime p \<Longrightarrow> p dvd x \<Longrightarrow> p \<in> prime_factors x"
   by (auto simp: in_prime_factors_iff)
 
 lemma prime_factors_dvd:
   "x \<noteq> 0 \<Longrightarrow> prime_factors x = {p. prime p \<and> p dvd x}"
   by (auto intro: prime_factorsI)
 
 lemma prime_factors_multiplicity:
   "prime_factors n = {p. prime p \<and> multiplicity p n > 0}"
   by (cases "n = 0") (auto simp add: prime_factors_dvd prime_multiplicity_gt_zero_iff)
 
 lemma prime_factorization_prime:
   assumes "prime p"
   shows   "prime_factorization p = {#p#}"
 proof (rule multiset_eqI)
   fix q :: 'a
   consider "\<not>prime q" | "q = p" | "prime q" "q \<noteq> p" by blast
   thus "count (prime_factorization p) q = count {#p#} q"
     by cases (insert assms, auto dest: primes_dvd_imp_eq
                 simp: count_prime_factorization multiplicity_self multiplicity_eq_zero_iff)
 qed
 
 lemma prime_factorization_prod_mset_primes:
   assumes "\<And>p. p \<in># A \<Longrightarrow> prime p"
   shows   "prime_factorization (prod_mset A) = A"
   using assms
 proof (induction A)
   case (add p A)
   from add.prems[of 0] have "0 \<notin># A" by auto
   hence "prod_mset A \<noteq> 0" by auto
   with add show ?case
     by (simp_all add: mult_ac prime_factorization_times_prime Multiset.union_commute)
 qed simp_all
 
 lemma prime_factorization_cong:
   "normalize x = normalize y \<Longrightarrow> prime_factorization x = prime_factorization y"
   by (simp add: multiset_eq_iff count_prime_factorization
                 multiplicity_normalize_right [of _ x, symmetric]
                 multiplicity_normalize_right [of _ y, symmetric]
            del:  multiplicity_normalize_right)
 
 lemma prime_factorization_unique:
   assumes "x \<noteq> 0" "y \<noteq> 0"
   shows   "prime_factorization x = prime_factorization y \<longleftrightarrow> normalize x = normalize y"
 proof
   assume "prime_factorization x = prime_factorization y"
   hence "prod_mset (prime_factorization x) = prod_mset (prime_factorization y)" by simp
   hence "normalize (prod_mset (prime_factorization x)) =
          normalize (prod_mset (prime_factorization y))"
     by (simp only: )
   with assms show "normalize x = normalize y"
     by (simp add: prod_mset_prime_factorization_weak)
 qed (rule prime_factorization_cong)
 
 lemma prime_factorization_normalize [simp]:
   "prime_factorization (normalize x) = prime_factorization x"
   by (cases "x = 0", simp, subst prime_factorization_unique) auto
 
 lemma prime_factorization_eqI_strong:
   assumes "\<And>p. p \<in># P \<Longrightarrow> prime p" "prod_mset P = n"
   shows   "prime_factorization n = P"
   using prime_factorization_prod_mset_primes[of P] assms by simp
 
 lemma prime_factorization_eqI:
   assumes "\<And>p. p \<in># P \<Longrightarrow> prime p" "normalize (prod_mset P) = normalize n"
   shows   "prime_factorization n = P"
 proof -
   have "P = prime_factorization (normalize (prod_mset P))"
     using prime_factorization_prod_mset_primes[of P] assms(1) by simp
   with assms(2) show ?thesis by simp
 qed
 
 lemma prime_factorization_mult:
   assumes "x \<noteq> 0" "y \<noteq> 0"
   shows   "prime_factorization (x * y) = prime_factorization x + prime_factorization y"
 proof -
   have "normalize (prod_mset (prime_factorization x) * prod_mset (prime_factorization y)) =
           normalize (normalize (prod_mset (prime_factorization x)) *
                      normalize (prod_mset (prime_factorization y)))"
     by (simp only: normalize_mult_normalize_left normalize_mult_normalize_right)
   also have "\<dots> = normalize (x * y)"
     by (subst (1 2) prod_mset_prime_factorization_weak) (use assms in auto)
   finally show ?thesis
     by (intro prime_factorization_eqI) auto
 qed
 
 lemma prime_factorization_prod:
   assumes "finite A" "\<And>x. x \<in> A \<Longrightarrow> f x \<noteq> 0"
   shows   "prime_factorization (prod f A) = (\<Sum>n\<in>A. prime_factorization (f n))"
   using assms by (induction A rule: finite_induct)
                  (auto simp: Sup_multiset_empty prime_factorization_mult)
 
 lemma prime_elem_multiplicity_mult_distrib:
   assumes "prime_elem p" "x \<noteq> 0" "y \<noteq> 0"
   shows   "multiplicity p (x * y) = multiplicity p x + multiplicity p y"
 proof -
   have "multiplicity p (x * y) = count (prime_factorization (x * y)) (normalize p)"
     by (subst count_prime_factorization_prime) (simp_all add: assms)
   also from assms
     have "prime_factorization (x * y) = prime_factorization x + prime_factorization y"
       by (intro prime_factorization_mult)
   also have "count \<dots> (normalize p) =
     count (prime_factorization x) (normalize p) + count (prime_factorization y) (normalize p)"
     by simp
   also have "\<dots> = multiplicity p x + multiplicity p y"
     by (subst (1 2) count_prime_factorization_prime) (simp_all add: assms)
   finally show ?thesis .
 qed
 
 lemma prime_elem_multiplicity_prod_mset_distrib:
   assumes "prime_elem p" "0 \<notin># A"
   shows   "multiplicity p (prod_mset A) = sum_mset (image_mset (multiplicity p) A)"
   using assms by (induction A) (auto simp: prime_elem_multiplicity_mult_distrib)
 
 lemma prime_elem_multiplicity_power_distrib:
   assumes "prime_elem p" "x \<noteq> 0"
   shows   "multiplicity p (x ^ n) = n * multiplicity p x"
   using assms prime_elem_multiplicity_prod_mset_distrib [of p "replicate_mset n x"]
   by simp
 
 lemma prime_elem_multiplicity_prod_distrib:
   assumes "prime_elem p" "0 \<notin> f ` A" "finite A"
   shows   "multiplicity p (prod f A) = (\<Sum>x\<in>A. multiplicity p (f x))"
 proof -
   have "multiplicity p (prod f A) = (\<Sum>x\<in>#mset_set A. multiplicity p (f x))"
     using assms by (subst prod_unfold_prod_mset)
                    (simp_all add: prime_elem_multiplicity_prod_mset_distrib sum_unfold_sum_mset
                       multiset.map_comp o_def)
   also from \<open>finite A\<close> have "\<dots> = (\<Sum>x\<in>A. multiplicity p (f x))"
     by (induction A rule: finite_induct) simp_all
   finally show ?thesis .
 qed
 
 lemma multiplicity_distinct_prime_power:
   "prime p \<Longrightarrow> prime q \<Longrightarrow> p \<noteq> q \<Longrightarrow> multiplicity p (q ^ n) = 0"
   by (subst prime_elem_multiplicity_power_distrib) (auto simp: prime_multiplicity_other)
 
 lemma prime_factorization_prime_power:
   "prime p \<Longrightarrow> prime_factorization (p ^ n) = replicate_mset n p"
   by (induction n)
      (simp_all add: prime_factorization_mult prime_factorization_prime Multiset.union_commute)
 
 lemma prime_factorization_subset_iff_dvd:
   assumes [simp]: "x \<noteq> 0" "y \<noteq> 0"
   shows   "prime_factorization x \<subseteq># prime_factorization y \<longleftrightarrow> x dvd y"
 proof -
   have "x dvd y \<longleftrightarrow>
     normalize (prod_mset (prime_factorization x)) dvd normalize (prod_mset (prime_factorization y))"
     using assms by (subst (1 2) prod_mset_prime_factorization_weak) auto
   also have "\<dots> \<longleftrightarrow> prime_factorization x \<subseteq># prime_factorization y"
     by (auto intro!: prod_mset_primes_dvd_imp_subset prod_mset_subset_imp_dvd)
   finally show ?thesis ..
 qed
 
 lemma prime_factorization_subset_imp_dvd:
   "x \<noteq> 0 \<Longrightarrow> (prime_factorization x \<subseteq># prime_factorization y) \<Longrightarrow> x dvd y"
   by (cases "y = 0") (simp_all add: prime_factorization_subset_iff_dvd)
 
 lemma prime_factorization_divide:
   assumes "b dvd a"
   shows   "prime_factorization (a div b) = prime_factorization a - prime_factorization b"
 proof (cases "a = 0")
   case [simp]: False
   from assms have [simp]: "b \<noteq> 0" by auto
   have "prime_factorization ((a div b) * b) = prime_factorization (a div b) + prime_factorization b"
     by (intro prime_factorization_mult) (insert assms, auto elim!: dvdE)
   with assms show ?thesis by simp
 qed simp_all
 
 lemma zero_not_in_prime_factors [simp]: "0 \<notin> prime_factors x"
   by (auto dest: in_prime_factors_imp_prime)
 
 lemma prime_prime_factors:
   "prime p \<Longrightarrow> prime_factors p = {p}"
   by (drule prime_factorization_prime) simp
 
 lemma prime_factors_product:
   "x \<noteq> 0 \<Longrightarrow> y \<noteq> 0 \<Longrightarrow> prime_factors (x * y) = prime_factors x \<union> prime_factors y"
   by (simp add: prime_factorization_mult)
 
 lemma dvd_prime_factors [intro]:
   "y \<noteq> 0 \<Longrightarrow> x dvd y \<Longrightarrow> prime_factors x \<subseteq> prime_factors y"
   by (intro set_mset_mono, subst prime_factorization_subset_iff_dvd) auto
 
 (* RENAMED multiplicity_dvd *)
 lemma multiplicity_le_imp_dvd:
   assumes "x \<noteq> 0" "\<And>p. prime p \<Longrightarrow> multiplicity p x \<le> multiplicity p y"
   shows   "x dvd y"
 proof (cases "y = 0")
   case False
   from assms this have "prime_factorization x \<subseteq># prime_factorization y"
     by (intro mset_subset_eqI) (auto simp: count_prime_factorization)
   with assms False show ?thesis by (subst (asm) prime_factorization_subset_iff_dvd)
 qed auto
 
 lemma dvd_multiplicity_eq:
   "x \<noteq> 0 \<Longrightarrow> y \<noteq> 0 \<Longrightarrow> x dvd y \<longleftrightarrow> (\<forall>p. multiplicity p x \<le> multiplicity p y)"
   by (auto intro: dvd_imp_multiplicity_le multiplicity_le_imp_dvd)
 
 lemma multiplicity_eq_imp_eq:
   assumes "x \<noteq> 0" "y \<noteq> 0"
   assumes "\<And>p. prime p \<Longrightarrow> multiplicity p x = multiplicity p y"
   shows   "normalize x = normalize y"
   using assms by (intro associatedI multiplicity_le_imp_dvd) simp_all
 
 lemma prime_factorization_unique':
   assumes "\<forall>p \<in># M. prime p" "\<forall>p \<in># N. prime p" "(\<Prod>i \<in># M. i) = (\<Prod>i \<in># N. i)"
   shows   "M = N"
 proof -
   have "prime_factorization (\<Prod>i \<in># M. i) = prime_factorization (\<Prod>i \<in># N. i)"
     by (simp only: assms)
   also from assms have "prime_factorization (\<Prod>i \<in># M. i) = M"
     by (subst prime_factorization_prod_mset_primes) simp_all
   also from assms have "prime_factorization (\<Prod>i \<in># N. i) = N"
     by (subst prime_factorization_prod_mset_primes) simp_all
   finally show ?thesis .
 qed
 
 lemma prime_factorization_unique'':
   assumes "\<forall>p \<in># M. prime p" "\<forall>p \<in># N. prime p" "normalize (\<Prod>i \<in># M. i) = normalize (\<Prod>i \<in># N. i)"
   shows   "M = N"
 proof -
   have "prime_factorization (normalize (\<Prod>i \<in># M. i)) =
         prime_factorization (normalize (\<Prod>i \<in># N. i))"
     by (simp only: assms)
   also from assms have "prime_factorization (normalize (\<Prod>i \<in># M. i)) = M"
     by (subst prime_factorization_normalize, subst prime_factorization_prod_mset_primes) simp_all
   also from assms have "prime_factorization (normalize (\<Prod>i \<in># N. i)) = N"
     by (subst prime_factorization_normalize, subst prime_factorization_prod_mset_primes) simp_all
   finally show ?thesis .
 qed
 
 lemma multiplicity_cong:
   "(\<And>r. p ^ r dvd a \<longleftrightarrow> p ^ r dvd b) \<Longrightarrow> multiplicity p a = multiplicity p b"
   by (simp add: multiplicity_def)
 
 lemma not_dvd_imp_multiplicity_0:
   assumes "\<not>p dvd x"
   shows   "multiplicity p x = 0"
 proof -
   from assms have "multiplicity p x < 1"
     by (intro multiplicity_lessI) auto
   thus ?thesis by simp
 qed
 
 lemma multiplicity_zero_left [simp]: "multiplicity 0 x = 0"
  by (cases "x = 0") (auto intro: not_dvd_imp_multiplicity_0)
 
 lemma inj_on_Prod_primes:
   assumes "\<And>P p. P \<in> A \<Longrightarrow> p \<in> P \<Longrightarrow> prime p"
   assumes "\<And>P. P \<in> A \<Longrightarrow> finite P"
   shows   "inj_on Prod A"
 proof (rule inj_onI)
   fix P Q assume PQ: "P \<in> A" "Q \<in> A" "\<Prod>P = \<Prod>Q"
   with prime_factorization_unique'[of "mset_set P" "mset_set Q"] assms[of P] assms[of Q]
     have "mset_set P = mset_set Q" by (auto simp: prod_unfold_prod_mset)
     with assms[of P] assms[of Q] PQ show "P = Q" by simp
 qed
 
 lemma divides_primepow_weak:
   assumes "prime p" and "a dvd p ^ n"
   obtains m where "m \<le> n" and "normalize a = normalize (p ^ m)"
 proof -
   from assms have "a \<noteq> 0"
     by auto
   with assms
   have "normalize (prod_mset (prime_factorization a)) dvd
           normalize (prod_mset (prime_factorization (p ^ n)))"
     by (subst (1 2) prod_mset_prime_factorization_weak) auto
   then have "prime_factorization a \<subseteq># prime_factorization (p ^ n)"
     by (simp add: in_prime_factors_imp_prime prod_mset_dvd_prod_mset_primes_iff)
   with assms have "prime_factorization a \<subseteq># replicate_mset n p"
     by (simp add: prime_factorization_prime_power)
   then obtain m where "m \<le> n" and "prime_factorization a = replicate_mset m p"
     by (rule msubseteq_replicate_msetE)
   then have *: "normalize (prod_mset (prime_factorization a)) =
                   normalize (prod_mset (replicate_mset m p))" by metis
   also have "normalize (prod_mset (prime_factorization a)) = normalize a"
     using \<open>a \<noteq> 0\<close> by (simp add: prod_mset_prime_factorization_weak)
   also have "prod_mset (replicate_mset m p) = p ^ m"
     by simp
   finally show ?thesis using \<open>m \<le> n\<close> 
     by (intro that[of m])
 qed
 
 lemma divide_out_primepow_ex:
   assumes "n \<noteq> 0" "\<exists>p\<in>prime_factors n. P p"
   obtains p k n' where "P p" "prime p" "p dvd n" "\<not>p dvd n'" "k > 0" "n = p ^ k * n'"
 proof -
   from assms obtain p where p: "P p" "prime p" "p dvd n"
     by auto
   define k where "k = multiplicity p n"
   define n' where "n' = n div p ^ k"
   have n': "n = p ^ k * n'" "\<not>p dvd n'"
     using assms p multiplicity_decompose[of n p]
     by (auto simp: n'_def k_def multiplicity_dvd)
   from n' p have "k > 0" by (intro Nat.gr0I) auto
   with n' p that[of p n' k] show ?thesis by auto
 qed
 
 lemma divide_out_primepow:
   assumes "n \<noteq> 0" "\<not>is_unit n"
   obtains p k n' where "prime p" "p dvd n" "\<not>p dvd n'" "k > 0" "n = p ^ k * n'"
   using divide_out_primepow_ex[OF assms(1), of "\<lambda>_. True"] prime_divisor_exists[OF assms] assms
         prime_factorsI by metis
 
 
 subsection \<open>GCD and LCM computation with unique factorizations\<close>
 
 definition "gcd_factorial a b = (if a = 0 then normalize b
      else if b = 0 then normalize a
      else normalize (prod_mset (prime_factorization a \<inter># prime_factorization b)))"
 
 definition "lcm_factorial a b = (if a = 0 \<or> b = 0 then 0
      else normalize (prod_mset (prime_factorization a \<union># prime_factorization b)))"
 
 definition "Gcd_factorial A =
   (if A \<subseteq> {0} then 0 else normalize (prod_mset (Inf (prime_factorization ` (A - {0})))))"
 
 definition "Lcm_factorial A =
   (if A = {} then 1
    else if 0 \<notin> A \<and> subset_mset.bdd_above (prime_factorization ` (A - {0})) then
      normalize (prod_mset (Sup (prime_factorization ` A)))
    else
      0)"
 
 lemma prime_factorization_gcd_factorial:
   assumes [simp]: "a \<noteq> 0" "b \<noteq> 0"
   shows   "prime_factorization (gcd_factorial a b) = prime_factorization a \<inter># prime_factorization b"
 proof -
   have "prime_factorization (gcd_factorial a b) =
           prime_factorization (prod_mset (prime_factorization a \<inter># prime_factorization b))"
     by (simp add: gcd_factorial_def)
   also have "\<dots> = prime_factorization a \<inter># prime_factorization b"
     by (subst prime_factorization_prod_mset_primes) auto
   finally show ?thesis .
 qed
 
 lemma prime_factorization_lcm_factorial:
   assumes [simp]: "a \<noteq> 0" "b \<noteq> 0"
   shows   "prime_factorization (lcm_factorial a b) = prime_factorization a \<union># prime_factorization b"
 proof -
   have "prime_factorization (lcm_factorial a b) =
           prime_factorization (prod_mset (prime_factorization a \<union># prime_factorization b))"
     by (simp add: lcm_factorial_def)
   also have "\<dots> = prime_factorization a \<union># prime_factorization b"
     by (subst prime_factorization_prod_mset_primes) auto
   finally show ?thesis .
 qed
 
 lemma prime_factorization_Gcd_factorial:
   assumes "\<not>A \<subseteq> {0}"
   shows   "prime_factorization (Gcd_factorial A) = Inf (prime_factorization ` (A - {0}))"
 proof -
   from assms obtain x where x: "x \<in> A - {0}" by auto
   hence "Inf (prime_factorization ` (A - {0})) \<subseteq># prime_factorization x"
     by (intro subset_mset.cInf_lower) simp_all
   hence "\<forall>y. y \<in># Inf (prime_factorization ` (A - {0})) \<longrightarrow> y \<in> prime_factors x"
     by (auto dest: mset_subset_eqD)
   with in_prime_factors_imp_prime[of _ x]
     have "\<forall>p. p \<in># Inf (prime_factorization ` (A - {0})) \<longrightarrow> prime p" by blast
   with assms show ?thesis
     by (simp add: Gcd_factorial_def prime_factorization_prod_mset_primes)
 qed
 
 lemma prime_factorization_Lcm_factorial:
   assumes "0 \<notin> A" "subset_mset.bdd_above (prime_factorization ` A)"
   shows   "prime_factorization (Lcm_factorial A) = Sup (prime_factorization ` A)"
 proof (cases "A = {}")
   case True
   hence "prime_factorization ` A = {}" by auto
   also have "Sup \<dots> = {#}" by (simp add: Sup_multiset_empty)
   finally show ?thesis by (simp add: Lcm_factorial_def)
 next
   case False
   have "\<forall>y. y \<in># Sup (prime_factorization ` A) \<longrightarrow> prime y"
     by (auto simp: in_Sup_multiset_iff assms)
   with assms False show ?thesis
     by (simp add: Lcm_factorial_def prime_factorization_prod_mset_primes)
 qed
 
 lemma gcd_factorial_commute: "gcd_factorial a b = gcd_factorial b a"
   by (simp add: gcd_factorial_def multiset_inter_commute)
 
 lemma gcd_factorial_dvd1: "gcd_factorial a b dvd a"
 proof (cases "a = 0 \<or> b = 0")
   case False
   hence "gcd_factorial a b \<noteq> 0" by (auto simp: gcd_factorial_def)
   with False show ?thesis
     by (subst prime_factorization_subset_iff_dvd [symmetric])
        (auto simp: prime_factorization_gcd_factorial)
 qed (auto simp: gcd_factorial_def)
 
 lemma gcd_factorial_dvd2: "gcd_factorial a b dvd b"
   by (subst gcd_factorial_commute) (rule gcd_factorial_dvd1)
 
 lemma normalize_gcd_factorial [simp]: "normalize (gcd_factorial a b) = gcd_factorial a b"
   by (simp add: gcd_factorial_def)
 
 lemma normalize_lcm_factorial [simp]: "normalize (lcm_factorial a b) = lcm_factorial a b"
   by (simp add: lcm_factorial_def)
 
 lemma gcd_factorial_greatest: "c dvd gcd_factorial a b" if "c dvd a" "c dvd b" for a b c
 proof (cases "a = 0 \<or> b = 0")
   case False
   with that have [simp]: "c \<noteq> 0" by auto
   let ?p = "prime_factorization"
   from that False have "?p c \<subseteq># ?p a" "?p c \<subseteq># ?p b"
     by (simp_all add: prime_factorization_subset_iff_dvd)
   hence "prime_factorization c \<subseteq>#
            prime_factorization (prod_mset (prime_factorization a \<inter># prime_factorization b))"
     using False by (subst prime_factorization_prod_mset_primes) auto
   with False show ?thesis
     by (auto simp: gcd_factorial_def prime_factorization_subset_iff_dvd [symmetric])
 qed (auto simp: gcd_factorial_def that)
 
 lemma lcm_factorial_gcd_factorial:
   "lcm_factorial a b = normalize (a * b div gcd_factorial a b)" for a b
 proof (cases "a = 0 \<or> b = 0")
   case False
   let ?p = "prime_factorization"
   have 1: "normalize x * normalize y dvd z \<longleftrightarrow> x * y dvd z" for x y z :: 'a
   proof -
     have "normalize (normalize x * normalize y) dvd z \<longleftrightarrow> x * y dvd z"
       unfolding normalize_mult_normalize_left normalize_mult_normalize_right by simp
     thus ?thesis unfolding normalize_dvd_iff by simp
   qed
 
   have "?p (a * b) = (?p a \<union># ?p b) + (?p a \<inter># ?p b)"
     using False by (subst prime_factorization_mult) (auto intro!: multiset_eqI)
   hence "normalize (prod_mset (?p (a * b))) =
            normalize (prod_mset ((?p a \<union># ?p b) + (?p a \<inter># ?p b)))"
     by (simp only:)
   hence *: "normalize (a * b) = normalize (lcm_factorial a b * gcd_factorial a b)" using False
     by (subst (asm) prod_mset_prime_factorization_weak)
        (auto simp: lcm_factorial_def gcd_factorial_def)
 
   have [simp]: "gcd_factorial a b dvd a * b" "lcm_factorial a b dvd a * b"
     using associatedD2[OF *] by auto
   from False have [simp]: "gcd_factorial a b \<noteq> 0" "lcm_factorial a b \<noteq> 0"
     by (auto simp: gcd_factorial_def lcm_factorial_def)
   
   show ?thesis
     by (rule associated_eqI)
        (use * in \<open>auto simp: dvd_div_iff_mult div_dvd_iff_mult dest: associatedD1 associatedD2\<close>)
 qed (auto simp: lcm_factorial_def)
 
 lemma normalize_Gcd_factorial:
   "normalize (Gcd_factorial A) = Gcd_factorial A"
   by (simp add: Gcd_factorial_def)
 
 lemma Gcd_factorial_eq_0_iff:
   "Gcd_factorial A = 0 \<longleftrightarrow> A \<subseteq> {0}"
   by (auto simp: Gcd_factorial_def in_Inf_multiset_iff split: if_splits)
 
 lemma Gcd_factorial_dvd:
   assumes "x \<in> A"
   shows   "Gcd_factorial A dvd x"
 proof (cases "x = 0")
   case False
   with assms have "prime_factorization (Gcd_factorial A) = Inf (prime_factorization ` (A - {0}))"
     by (intro prime_factorization_Gcd_factorial) auto
   also from False assms have "\<dots> \<subseteq># prime_factorization x"
     by (intro subset_mset.cInf_lower) auto
   finally show ?thesis
     by (subst (asm) prime_factorization_subset_iff_dvd)
        (insert assms False, auto simp: Gcd_factorial_eq_0_iff)
 qed simp_all
 
 lemma Gcd_factorial_greatest:
   assumes "\<And>y. y \<in> A \<Longrightarrow> x dvd y"
   shows   "x dvd Gcd_factorial A"
 proof (cases "A \<subseteq> {0}")
   case False
   from False obtain y where "y \<in> A" "y \<noteq> 0" by auto
   with assms[of y] have nz: "x \<noteq> 0" by auto
   from nz assms have "prime_factorization x \<subseteq># prime_factorization y" if "y \<in> A - {0}" for y
     using that by (subst prime_factorization_subset_iff_dvd) auto
   with False have "prime_factorization x \<subseteq># Inf (prime_factorization ` (A - {0}))"
     by (intro subset_mset.cInf_greatest) auto
   also from False have "\<dots> = prime_factorization (Gcd_factorial A)"
     by (rule prime_factorization_Gcd_factorial [symmetric])
   finally show ?thesis
     by (subst (asm) prime_factorization_subset_iff_dvd)
        (insert nz False, auto simp: Gcd_factorial_eq_0_iff)
 qed (simp_all add: Gcd_factorial_def)
 
 lemma normalize_Lcm_factorial:
   "normalize (Lcm_factorial A) = Lcm_factorial A"
   by (simp add: Lcm_factorial_def)
 
 lemma Lcm_factorial_eq_0_iff:
   "Lcm_factorial A = 0 \<longleftrightarrow> 0 \<in> A \<or> \<not>subset_mset.bdd_above (prime_factorization ` A)"
   by (auto simp: Lcm_factorial_def in_Sup_multiset_iff)
 
 lemma dvd_Lcm_factorial:
   assumes "x \<in> A"
   shows   "x dvd Lcm_factorial A"
 proof (cases "0 \<notin> A \<and> subset_mset.bdd_above (prime_factorization ` A)")
   case True
   with assms have [simp]: "0 \<notin> A" "x \<noteq> 0" "A \<noteq> {}" by auto
   from assms True have "prime_factorization x \<subseteq># Sup (prime_factorization ` A)"
     by (intro subset_mset.cSup_upper) auto
   also have "\<dots> = prime_factorization (Lcm_factorial A)"
     by (rule prime_factorization_Lcm_factorial [symmetric]) (insert True, simp_all)
   finally show ?thesis
     by (subst (asm) prime_factorization_subset_iff_dvd)
        (insert True, auto simp: Lcm_factorial_eq_0_iff)
 qed (insert assms, auto simp: Lcm_factorial_def)
 
 lemma Lcm_factorial_least:
   assumes "\<And>y. y \<in> A \<Longrightarrow> y dvd x"
   shows   "Lcm_factorial A dvd x"
 proof -
   consider "A = {}" | "0 \<in> A" | "x = 0" | "A \<noteq> {}" "0 \<notin> A" "x \<noteq> 0" by blast
   thus ?thesis
   proof cases
     assume *: "A \<noteq> {}" "0 \<notin> A" "x \<noteq> 0"
     hence nz: "x \<noteq> 0" if "x \<in> A" for x using that by auto
     from * have bdd: "subset_mset.bdd_above (prime_factorization ` A)"
       by (intro subset_mset.bdd_aboveI[of _ "prime_factorization x"])
          (auto simp: prime_factorization_subset_iff_dvd nz dest: assms)
     have "prime_factorization (Lcm_factorial A) = Sup (prime_factorization ` A)"
       by (rule prime_factorization_Lcm_factorial) fact+
     also from * have "\<dots> \<subseteq># prime_factorization x"
       by (intro subset_mset.cSup_least)
          (auto simp: prime_factorization_subset_iff_dvd nz dest: assms)
     finally show ?thesis
       by (subst (asm) prime_factorization_subset_iff_dvd)
          (insert * bdd, auto simp: Lcm_factorial_eq_0_iff)
   qed (auto simp: Lcm_factorial_def dest: assms)
 qed
 
 lemmas gcd_lcm_factorial =
   gcd_factorial_dvd1 gcd_factorial_dvd2 gcd_factorial_greatest
   normalize_gcd_factorial lcm_factorial_gcd_factorial
   normalize_Gcd_factorial Gcd_factorial_dvd Gcd_factorial_greatest
   normalize_Lcm_factorial dvd_Lcm_factorial Lcm_factorial_least
 
 end
 
 class factorial_semiring_gcd = factorial_semiring + gcd + Gcd +
   assumes gcd_eq_gcd_factorial: "gcd a b = gcd_factorial a b"
   and     lcm_eq_lcm_factorial: "lcm a b = lcm_factorial a b"
   and     Gcd_eq_Gcd_factorial: "Gcd A = Gcd_factorial A"
   and     Lcm_eq_Lcm_factorial: "Lcm A = Lcm_factorial A"
 begin
 
 lemma prime_factorization_gcd:
   assumes [simp]: "a \<noteq> 0" "b \<noteq> 0"
   shows   "prime_factorization (gcd a b) = prime_factorization a \<inter># prime_factorization b"
   by (simp add: gcd_eq_gcd_factorial prime_factorization_gcd_factorial)
 
 lemma prime_factorization_lcm:
   assumes [simp]: "a \<noteq> 0" "b \<noteq> 0"
   shows   "prime_factorization (lcm a b) = prime_factorization a \<union># prime_factorization b"
   by (simp add: lcm_eq_lcm_factorial prime_factorization_lcm_factorial)
 
 lemma prime_factorization_Gcd:
   assumes "Gcd A \<noteq> 0"
   shows   "prime_factorization (Gcd A) = Inf (prime_factorization ` (A - {0}))"
   using assms
   by (simp add: prime_factorization_Gcd_factorial Gcd_eq_Gcd_factorial Gcd_factorial_eq_0_iff)
 
 lemma prime_factorization_Lcm:
   assumes "Lcm A \<noteq> 0"
   shows   "prime_factorization (Lcm A) = Sup (prime_factorization ` A)"
   using assms
   by (simp add: prime_factorization_Lcm_factorial Lcm_eq_Lcm_factorial Lcm_factorial_eq_0_iff)
 
 lemma prime_factors_gcd [simp]: 
   "a \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> prime_factors (gcd a b) = 
      prime_factors a \<inter> prime_factors b"
   by (subst prime_factorization_gcd) auto
 
 lemma prime_factors_lcm [simp]: 
   "a \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> prime_factors (lcm a b) = 
      prime_factors a \<union> prime_factors b"
   by (subst prime_factorization_lcm) auto
 
 subclass semiring_gcd
   by (standard, unfold gcd_eq_gcd_factorial lcm_eq_lcm_factorial)
      (rule gcd_lcm_factorial; assumption)+
 
 subclass semiring_Gcd
   by (standard, unfold Gcd_eq_Gcd_factorial Lcm_eq_Lcm_factorial)
      (rule gcd_lcm_factorial; assumption)+
 
 lemma
   assumes "x \<noteq> 0" "y \<noteq> 0"
   shows gcd_eq_factorial':
           "gcd x y = normalize (\<Prod>p \<in> prime_factors x \<inter> prime_factors y.
                           p ^ min (multiplicity p x) (multiplicity p y))" (is "_ = ?rhs1")
     and lcm_eq_factorial':
           "lcm x y = normalize (\<Prod>p \<in> prime_factors x \<union> prime_factors y.
                           p ^ max (multiplicity p x) (multiplicity p y))" (is "_ = ?rhs2")
 proof -
   have "gcd x y = gcd_factorial x y" by (rule gcd_eq_gcd_factorial)
   also have "\<dots> = ?rhs1"
     by (auto simp: gcd_factorial_def assms prod_mset_multiplicity
           count_prime_factorization_prime
           intro!: arg_cong[of _ _ normalize] dest: in_prime_factors_imp_prime intro!: prod.cong)
   finally show "gcd x y = ?rhs1" .
   have "lcm x y = lcm_factorial x y" by (rule lcm_eq_lcm_factorial)
   also have "\<dots> = ?rhs2"
     by (auto simp: lcm_factorial_def assms prod_mset_multiplicity
           count_prime_factorization_prime intro!: arg_cong[of _ _ normalize] 
           dest: in_prime_factors_imp_prime intro!: prod.cong)
   finally show "lcm x y = ?rhs2" .
 qed
 
 lemma
   assumes "x \<noteq> 0" "y \<noteq> 0" "prime p"
   shows   multiplicity_gcd: "multiplicity p (gcd x y) = min (multiplicity p x) (multiplicity p y)"
     and   multiplicity_lcm: "multiplicity p (lcm x y) = max (multiplicity p x) (multiplicity p y)"
 proof -
   have "gcd x y = gcd_factorial x y" by (rule gcd_eq_gcd_factorial)
   also from assms have "multiplicity p \<dots> = min (multiplicity p x) (multiplicity p y)"
     by (simp add: count_prime_factorization_prime [symmetric] prime_factorization_gcd_factorial)
   finally show "multiplicity p (gcd x y) = min (multiplicity p x) (multiplicity p y)" .
   have "lcm x y = lcm_factorial x y" by (rule lcm_eq_lcm_factorial)
   also from assms have "multiplicity p \<dots> = max (multiplicity p x) (multiplicity p y)"
     by (simp add: count_prime_factorization_prime [symmetric] prime_factorization_lcm_factorial)
   finally show "multiplicity p (lcm x y) = max (multiplicity p x) (multiplicity p y)" .
 qed
 
 lemma gcd_lcm_distrib:
   "gcd x (lcm y z) = lcm (gcd x y) (gcd x z)"
 proof (cases "x = 0 \<or> y = 0 \<or> z = 0")
   case True
   thus ?thesis
     by (auto simp: lcm_proj1_if_dvd lcm_proj2_if_dvd)
 next
   case False
   hence "normalize (gcd x (lcm y z)) = normalize (lcm (gcd x y) (gcd x z))"
     by (intro associatedI prime_factorization_subset_imp_dvd)
        (auto simp: lcm_eq_0_iff prime_factorization_gcd prime_factorization_lcm
           subset_mset.inf_sup_distrib1)
   thus ?thesis by simp
 qed
 
 lemma lcm_gcd_distrib:
   "lcm x (gcd y z) = gcd (lcm x y) (lcm x z)"
 proof (cases "x = 0 \<or> y = 0 \<or> z = 0")
   case True
   thus ?thesis
     by (auto simp: lcm_proj1_if_dvd lcm_proj2_if_dvd)
 next
   case False
   hence "normalize (lcm x (gcd y z)) = normalize (gcd (lcm x y) (lcm x z))"
     by (intro associatedI prime_factorization_subset_imp_dvd)
        (auto simp: lcm_eq_0_iff prime_factorization_gcd prime_factorization_lcm
           subset_mset.sup_inf_distrib1)
   thus ?thesis by simp
 qed
 
 end
 
 class factorial_ring_gcd = factorial_semiring_gcd + idom
 begin
 
 subclass ring_gcd ..
 
 subclass idom_divide ..
 
 end
 
 
 class factorial_semiring_multiplicative =
   factorial_semiring + normalization_semidom_multiplicative
 begin
 
 lemma normalize_prod_mset_primes:
   "(\<And>p. p \<in># A \<Longrightarrow> prime p) \<Longrightarrow> normalize (prod_mset A) = prod_mset A"
 proof (induction A)
   case (add p A)
   hence "prime p" by simp
   hence "normalize p = p" by simp
   with add show ?case by (simp add: normalize_mult)
 qed simp_all
 
 lemma prod_mset_prime_factorization:
   assumes "x \<noteq> 0"
   shows   "prod_mset (prime_factorization x) = normalize x"
   using assms
   by (induction x rule: prime_divisors_induct)
      (simp_all add: prime_factorization_unit prime_factorization_times_prime
                     is_unit_normalize normalize_mult)
 
 lemma prime_decomposition: "unit_factor x * prod_mset (prime_factorization x) = x"
   by (cases "x = 0") (simp_all add: prod_mset_prime_factorization)
 
 lemma prod_prime_factors:
   assumes "x \<noteq> 0"
   shows   "(\<Prod>p \<in> prime_factors x. p ^ multiplicity p x) = normalize x"
 proof -
   have "normalize x = prod_mset (prime_factorization x)"
     by (simp add: prod_mset_prime_factorization assms)
   also have "\<dots> = (\<Prod>p \<in> prime_factors x. p ^ count (prime_factorization x) p)"
     by (subst prod_mset_multiplicity) simp_all
   also have "\<dots> = (\<Prod>p \<in> prime_factors x. p ^ multiplicity p x)"
     by (intro prod.cong)
       (simp_all add: assms count_prime_factorization_prime in_prime_factors_imp_prime)
   finally show ?thesis ..
 qed
 
 lemma prime_factorization_unique'':
   assumes S_eq: "S = {p. 0 < f p}"
     and "finite S"
     and S: "\<forall>p\<in>S. prime p" "normalize n = (\<Prod>p\<in>S. p ^ f p)"
   shows "S = prime_factors n \<and> (\<forall>p. prime p \<longrightarrow> f p = multiplicity p n)"
 proof
   define A where "A = Abs_multiset f"
   from \<open>finite S\<close> S(1) have "(\<Prod>p\<in>S. p ^ f p) \<noteq> 0" by auto
   with S(2) have nz: "n \<noteq> 0" by auto
   from S_eq \<open>finite S\<close> have count_A: "count A = f"
     unfolding A_def by (subst multiset.Abs_multiset_inverse) simp_all
   from S_eq count_A have set_mset_A: "set_mset A = S"
     by (simp only: set_mset_def)
   from S(2) have "normalize n = (\<Prod>p\<in>S. p ^ f p)" .
   also have "\<dots> = prod_mset A" by (simp add: prod_mset_multiplicity S_eq set_mset_A count_A)
   also from nz have "normalize n = prod_mset (prime_factorization n)"
     by (simp add: prod_mset_prime_factorization)
   finally have "prime_factorization (prod_mset A) =
                   prime_factorization (prod_mset (prime_factorization n))" by simp
   also from S(1) have "prime_factorization (prod_mset A) = A"
     by (intro prime_factorization_prod_mset_primes) (auto simp: set_mset_A)
   also have "prime_factorization (prod_mset (prime_factorization n)) = prime_factorization n"
     by (intro prime_factorization_prod_mset_primes) auto
   finally show "S = prime_factors n" by (simp add: set_mset_A [symmetric])
 
   show "(\<forall>p. prime p \<longrightarrow> f p = multiplicity p n)"
   proof safe
     fix p :: 'a assume p: "prime p"
     have "multiplicity p n = multiplicity p (normalize n)" by simp
     also have "normalize n = prod_mset A"
       by (simp add: prod_mset_multiplicity S_eq set_mset_A count_A S)
     also from p set_mset_A S(1)
     have "multiplicity p \<dots> = sum_mset (image_mset (multiplicity p) A)"
       by (intro prime_elem_multiplicity_prod_mset_distrib) auto
     also from S(1) p
     have "image_mset (multiplicity p) A = image_mset (\<lambda>q. if p = q then 1 else 0) A"
       by (intro image_mset_cong) (auto simp: set_mset_A multiplicity_self prime_multiplicity_other)
     also have "sum_mset \<dots> = f p"
       by (simp add: semiring_1_class.sum_mset_delta' count_A)
     finally show "f p = multiplicity p n" ..
   qed
 qed
 
 lemma divides_primepow:
   assumes "prime p" and "a dvd p ^ n"
   obtains m where "m \<le> n" and "normalize a = p ^ m"
   using divides_primepow_weak[OF assms] that assms
   by (auto simp add: normalize_power)
 
 lemma Ex_other_prime_factor:
   assumes "n \<noteq> 0" and "\<not>(\<exists>k. normalize n = p ^ k)" "prime p"
   shows   "\<exists>q\<in>prime_factors n. q \<noteq> p"
 proof (rule ccontr)
   assume *: "\<not>(\<exists>q\<in>prime_factors n. q \<noteq> p)"
   have "normalize n = (\<Prod>p\<in>prime_factors n. p ^ multiplicity p n)"
     using assms(1) by (intro prod_prime_factors [symmetric]) auto
   also from * have "\<dots> = (\<Prod>p\<in>{p}. p ^ multiplicity p n)"
     using assms(3) by (intro prod.mono_neutral_left) (auto simp: prime_factors_multiplicity)
   finally have "normalize n = p ^ multiplicity p n" by auto
   with assms show False by auto
 qed
 
 text \<open>Now a string of results due to Jakub Kądziołka\<close>
 
 lemma multiplicity_dvd_iff_dvd:
  assumes "x \<noteq> 0"
  shows "p^k dvd x \<longleftrightarrow> p^k dvd p^multiplicity p x"
 proof (cases "is_unit p")
  case True
  then have "is_unit (p^k)"
    using is_unit_power_iff by simp
  hence "p^k dvd x"
    by auto
  moreover from `is_unit p` have "p^k dvd p^multiplicity p x"
    using multiplicity_unit_left is_unit_power_iff by simp
  ultimately show ?thesis by simp
 next
  case False
  show ?thesis
  proof (cases "p = 0")
    case True
    then have "p^multiplicity p x = 1"
      by simp
    moreover have "p^k dvd x \<Longrightarrow> k = 0"
    proof (rule ccontr)
      assume "p^k dvd x" and "k \<noteq> 0"
      with `p = 0` have "p^k = 0" by auto
      with `p^k dvd x` have "0 dvd x" by auto
      hence "x = 0" by auto
      with `x \<noteq> 0` show False by auto
    qed
    ultimately show ?thesis
      by (auto simp add: is_unit_power_iff `\<not> is_unit p`)
  next
    case False
    with `x \<noteq> 0` `\<not> is_unit p` show ?thesis
      by (simp add: power_dvd_iff_le_multiplicity dvd_power_iff multiplicity_same_power)
  qed
 qed
 
 lemma multiplicity_decomposeI:
  assumes "x = p^k * x'" and "\<not> p dvd x'" and "p \<noteq> 0"
  shows "multiplicity p x = k"
   using assms local.multiplicity_eqI local.power_Suc2 by force
 
 lemma multiplicity_sum_lt:
  assumes "multiplicity p a < multiplicity p b" "a \<noteq> 0" "b \<noteq> 0"
  shows "multiplicity p (a + b) = multiplicity p a"
 proof -
  let ?vp = "multiplicity p"
  have unit: "\<not> is_unit p"
  proof
    assume "is_unit p"
    then have "?vp a = 0" and "?vp b = 0" using multiplicity_unit_left by auto
    with assms show False by auto
  qed
 
  from multiplicity_decompose' obtain a' where a': "a = p^?vp a * a'" "\<not> p dvd a'"
    using unit assms by metis
  from multiplicity_decompose' obtain b' where b': "b = p^?vp b * b'"
    using unit assms by metis
 
  show "?vp (a + b) = ?vp a"
  proof (rule multiplicity_decomposeI)
    let ?k = "?vp b - ?vp a"
    from assms have k: "?k > 0" by simp
    with b' have "b = p^?vp a * p^?k * b'"
      by (simp flip: power_add)
    with a' show *: "a + b = p^?vp a * (a' + p^?k * b')"
      by (simp add: ac_simps distrib_left)
    moreover show "\<not> p dvd a' + p^?k * b'"
      using a' k dvd_add_left_iff by auto
    show "p \<noteq> 0" using assms by auto
  qed
 qed
 
 corollary multiplicity_sum_min:
  assumes "multiplicity p a \<noteq> multiplicity p b" "a \<noteq> 0" "b \<noteq> 0"
  shows "multiplicity p (a + b) = min (multiplicity p a) (multiplicity p b)"
 proof -
  let ?vp = "multiplicity p"
  from assms have "?vp a < ?vp b \<or> ?vp a > ?vp b"
    by auto
  then show ?thesis
    by (metis assms multiplicity_sum_lt min.commute add_commute min.strict_order_iff)    
 qed
 
 end
 
 end
diff --git a/src/HOL/Computational_Algebra/Formal_Power_Series.thy b/src/HOL/Computational_Algebra/Formal_Power_Series.thy
--- a/src/HOL/Computational_Algebra/Formal_Power_Series.thy
+++ b/src/HOL/Computational_Algebra/Formal_Power_Series.thy
@@ -1,6244 +1,6244 @@
 (*  Title:      HOL/Computational_Algebra/Formal_Power_Series.thy
     Author:     Amine Chaieb, University of Cambridge
     Author:     Jeremy Sylvestre, University of Alberta (Augustana Campus)
     Author:     Manuel Eberl, TU München
 *)
 
 section \<open>A formalization of formal power series\<close>
 
 theory Formal_Power_Series
 imports
   Complex_Main
   Euclidean_Algorithm
 begin
 
 
 subsection \<open>The type of formal power series\<close>
 
 typedef 'a fps = "{f :: nat \<Rightarrow> 'a. True}"
   morphisms fps_nth Abs_fps
   by simp
 
 notation fps_nth (infixl "$" 75)
 
 lemma expand_fps_eq: "p = q \<longleftrightarrow> (\<forall>n. p $ n = q $ n)"
   by (simp add: fps_nth_inject [symmetric] fun_eq_iff)
 
 lemmas fps_eq_iff = expand_fps_eq
 
 lemma fps_ext: "(\<And>n. p $ n = q $ n) \<Longrightarrow> p = q"
   by (simp add: expand_fps_eq)
 
 lemma fps_nth_Abs_fps [simp]: "Abs_fps f $ n = f n"
   by (simp add: Abs_fps_inverse)
 
 text \<open>Definition of the basic elements 0 and 1 and the basic operations of addition,
   negation and multiplication.\<close>
 
 instantiation fps :: (zero) zero
 begin
   definition fps_zero_def: "0 = Abs_fps (\<lambda>n. 0)"
   instance ..
 end
 
 lemma fps_zero_nth [simp]: "0 $ n = 0"
   unfolding fps_zero_def by simp
 
 lemma fps_nonzero_nth: "f \<noteq> 0 \<longleftrightarrow> (\<exists> n. f $n \<noteq> 0)"
   by (simp add: expand_fps_eq)
 
 lemma fps_nonzero_nth_minimal: "f \<noteq> 0 \<longleftrightarrow> (\<exists>n. f $ n \<noteq> 0 \<and> (\<forall>m < n. f $ m = 0))"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   let ?n = "LEAST n. f $ n \<noteq> 0"
   show ?rhs if ?lhs
   proof -
     from that have "\<exists>n. f $ n \<noteq> 0"
       by (simp add: fps_nonzero_nth)
     then have "f $ ?n \<noteq> 0"
       by (rule LeastI_ex)
     moreover have "\<forall>m<?n. f $ m = 0"
       by (auto dest: not_less_Least)
     ultimately have "f $ ?n \<noteq> 0 \<and> (\<forall>m<?n. f $ m = 0)" ..
     then show ?thesis ..
   qed
   show ?lhs if ?rhs
     using that by (auto simp add: expand_fps_eq)
 qed
 
 lemma fps_nonzeroI: "f$n \<noteq> 0 \<Longrightarrow> f \<noteq> 0"
   by auto
 
 instantiation fps :: ("{one, zero}") one
 begin
   definition fps_one_def: "1 = Abs_fps (\<lambda>n. if n = 0 then 1 else 0)"
   instance ..
 end
 
 lemma fps_one_nth [simp]: "1 $ n = (if n = 0 then 1 else 0)"
   unfolding fps_one_def by simp
 
 instantiation fps :: (plus) plus
 begin
   definition fps_plus_def: "(+) = (\<lambda>f g. Abs_fps (\<lambda>n. f $ n + g $ n))"
   instance ..
 end
 
 lemma fps_add_nth [simp]: "(f + g) $ n = f $ n + g $ n"
   unfolding fps_plus_def by simp
 
 instantiation fps :: (minus) minus
 begin
   definition fps_minus_def: "(-) = (\<lambda>f g. Abs_fps (\<lambda>n. f $ n - g $ n))"
   instance ..
 end
 
 lemma fps_sub_nth [simp]: "(f - g) $ n = f $ n - g $ n"
   unfolding fps_minus_def by simp
 
 instantiation fps :: (uminus) uminus
 begin
   definition fps_uminus_def: "uminus = (\<lambda>f. Abs_fps (\<lambda>n. - (f $ n)))"
   instance ..
 end
 
 lemma fps_neg_nth [simp]: "(- f) $ n = - (f $ n)"
   unfolding fps_uminus_def by simp
 
 lemma fps_neg_0 [simp]: "-(0::'a::group_add fps) = 0"
   by (rule iffD2, rule fps_eq_iff, auto)
 
 instantiation fps :: ("{comm_monoid_add, times}") times
 begin
   definition fps_times_def: "(*) = (\<lambda>f g. Abs_fps (\<lambda>n. \<Sum>i=0..n. f $ i * g $ (n - i)))"
   instance ..
 end
 
 lemma fps_mult_nth: "(f * g) $ n = (\<Sum>i=0..n. f$i * g$(n - i))"
   unfolding fps_times_def by simp
 
 lemma fps_mult_nth_0 [simp]: "(f * g) $ 0 = f $ 0 * g $ 0"
   unfolding fps_times_def by simp
 
 lemma fps_mult_nth_1: "(f * g) $ 1 = f$0 * g$1 + f$1 * g$0"
   by (simp add: fps_mult_nth)
 
 lemma fps_mult_nth_1' [simp]: "(f * g) $ Suc 0 = f$0 * g$Suc 0 + f$Suc 0 * g$0"
   by (simp add: fps_mult_nth)
 
 lemmas mult_nth_0 = fps_mult_nth_0
 lemmas mult_nth_1 = fps_mult_nth_1
 
 instance fps :: ("{comm_monoid_add, mult_zero}") mult_zero
 proof
   fix a :: "'a fps"
   show "0 * a = 0" by (simp add: fps_ext fps_mult_nth)
   show "a * 0 = 0" by (simp add: fps_ext fps_mult_nth)
 qed
 
 declare atLeastAtMost_iff [presburger]
 declare Bex_def [presburger]
 declare Ball_def [presburger]
 
 lemma mult_delta_left:
   fixes x y :: "'a::mult_zero"
   shows "(if b then x else 0) * y = (if b then x * y else 0)"
   by simp
 
 lemma mult_delta_right:
   fixes x y :: "'a::mult_zero"
   shows "x * (if b then y else 0) = (if b then x * y else 0)"
   by simp
 
 lemma fps_one_mult:
   fixes f :: "'a::{comm_monoid_add, mult_zero, monoid_mult} fps"
   shows "1 * f = f"
   and   "f * 1 = f"
   by    (simp_all add: fps_ext fps_mult_nth mult_delta_left mult_delta_right)
 
 
 subsection \<open>Subdegrees\<close>
 
 definition subdegree :: "('a::zero) fps \<Rightarrow> nat" where
   "subdegree f = (if f = 0 then 0 else LEAST n. f$n \<noteq> 0)"
 
 lemma subdegreeI:
   assumes "f $ d \<noteq> 0" and "\<And>i. i < d \<Longrightarrow> f $ i = 0"
   shows   "subdegree f = d"
 proof-
   from assms(1) have "f \<noteq> 0" by auto
   moreover from assms(1) have "(LEAST i. f $ i \<noteq> 0) = d"
   proof (rule Least_equality)
     fix e assume "f $ e \<noteq> 0"
     with assms(2) have "\<not>(e < d)" by blast
     thus "e \<ge> d" by simp
   qed
   ultimately show ?thesis unfolding subdegree_def by simp
 qed
 
 lemma nth_subdegree_nonzero [simp,intro]: "f \<noteq> 0 \<Longrightarrow> f $ subdegree f \<noteq> 0"
 proof-
   assume "f \<noteq> 0"
   hence "subdegree f = (LEAST n. f $ n \<noteq> 0)" by (simp add: subdegree_def)
   also from \<open>f \<noteq> 0\<close> have "\<exists>n. f$n \<noteq> 0" using fps_nonzero_nth by blast
   from LeastI_ex[OF this] have "f $ (LEAST n. f $ n \<noteq> 0) \<noteq> 0" .
   finally show ?thesis .
 qed
 
 lemma nth_less_subdegree_zero [dest]: "n < subdegree f \<Longrightarrow> f $ n = 0"
 proof (cases "f = 0")
   assume "f \<noteq> 0" and less: "n < subdegree f"
   note less
   also from \<open>f \<noteq> 0\<close> have "subdegree f = (LEAST n. f $ n \<noteq> 0)" by (simp add: subdegree_def)
   finally show "f $ n = 0" using not_less_Least by blast
 qed simp_all
 
 lemma subdegree_geI:
   assumes "f \<noteq> 0" "\<And>i. i < n \<Longrightarrow> f$i = 0"
   shows   "subdegree f \<ge> n"
 proof (rule ccontr)
   assume "\<not>(subdegree f \<ge> n)"
   with assms(2) have "f $ subdegree f = 0" by simp
   moreover from assms(1) have "f $ subdegree f \<noteq> 0" by simp
   ultimately show False by contradiction
 qed
 
 lemma subdegree_greaterI:
   assumes "f \<noteq> 0" "\<And>i. i \<le> n \<Longrightarrow> f$i = 0"
   shows   "subdegree f > n"
 proof (rule ccontr)
   assume "\<not>(subdegree f > n)"
   with assms(2) have "f $ subdegree f = 0" by simp
   moreover from assms(1) have "f $ subdegree f \<noteq> 0" by simp
   ultimately show False by contradiction
 qed
 
 lemma subdegree_leI:
   "f $ n \<noteq> 0 \<Longrightarrow> subdegree f \<le> n"
   by (rule leI) auto
 
 lemma subdegree_0 [simp]: "subdegree 0 = 0"
   by (simp add: subdegree_def)
 
 lemma subdegree_1 [simp]: "subdegree 1 = 0"
   by  (cases "(1::'a) = 0")
       (auto intro: subdegreeI fps_ext simp: subdegree_def)
 
 lemma subdegree_eq_0_iff: "subdegree f = 0 \<longleftrightarrow> f = 0 \<or> f $ 0 \<noteq> 0"
 proof (cases "f = 0")
   assume "f \<noteq> 0"
   thus ?thesis
     using nth_subdegree_nonzero[OF \<open>f \<noteq> 0\<close>] by (fastforce intro!: subdegreeI)
 qed simp_all
 
 lemma subdegree_eq_0 [simp]: "f $ 0 \<noteq> 0 \<Longrightarrow> subdegree f = 0"
   by (simp add: subdegree_eq_0_iff)
 
 lemma nth_subdegree_zero_iff [simp]: "f $ subdegree f = 0 \<longleftrightarrow> f = 0"
   by (cases "f = 0") auto
 
 lemma fps_nonzero_subdegree_nonzeroI: "subdegree f > 0 \<Longrightarrow> f \<noteq> 0"
  by auto
 
 lemma subdegree_uminus [simp]:
   "subdegree (-(f::('a::group_add) fps)) = subdegree f"
 proof (cases "f=0")
   case False thus ?thesis by (force intro: subdegreeI)
 qed simp
 
 lemma subdegree_minus_commute [simp]:
   "subdegree (f-(g::('a::group_add) fps)) = subdegree (g - f)"
 proof (-, cases "g-f=0")
   case True
   have "\<And>n. (f - g) $ n = -((g - f) $ n)" by simp
   with True have "f - g = 0" by (intro fps_ext) simp
   with True show ?thesis by simp
 next
   case False show ?thesis
     using nth_subdegree_nonzero[OF False] by (fastforce intro: subdegreeI)
 qed
 
 lemma subdegree_add_ge':
   fixes   f g :: "'a::monoid_add fps"
   assumes "f + g \<noteq> 0"
   shows   "subdegree (f + g) \<ge> min (subdegree f) (subdegree g)"
   using   assms
   by      (force intro: subdegree_geI)
 
 lemma subdegree_add_ge:
   assumes "f \<noteq> -(g :: ('a :: group_add) fps)"
   shows   "subdegree (f + g) \<ge> min (subdegree f) (subdegree g)"
 proof (rule subdegree_add_ge')
   have "f + g = 0 \<Longrightarrow> False"
   proof-
     assume fg: "f + g = 0"
     have "\<And>n. f $ n = - g $ n"
     proof-
       fix n
       from fg have "(f + g) $ n = 0" by simp
       hence "f $ n + g $ n - g $ n = - g $ n" by simp
       thus "f $ n = - g $ n" by simp      
     qed
     with assms show False by (auto intro: fps_ext)
   qed
   thus "f + g \<noteq> 0" by fast
 qed
 
 lemma subdegree_add_eq1:
   assumes "f \<noteq> 0"
   and     "subdegree f < subdegree (g :: 'a::monoid_add fps)"
   shows   "subdegree (f + g) = subdegree f"
   using   assms
   by      (auto intro: subdegreeI simp: nth_less_subdegree_zero)
 
 lemma subdegree_add_eq2:
   assumes "g \<noteq> 0"
   and     "subdegree g < subdegree (f :: 'a :: monoid_add fps)"
   shows   "subdegree (f + g) = subdegree g"
   using   assms
   by      (auto intro: subdegreeI simp: nth_less_subdegree_zero)
 
 lemma subdegree_diff_eq1:
   assumes "f \<noteq> 0"
   and     "subdegree f < subdegree (g :: 'a :: group_add fps)"
   shows   "subdegree (f - g) = subdegree f"
   using   assms
   by      (auto intro: subdegreeI simp: nth_less_subdegree_zero)
 
 lemma subdegree_diff_eq1_cancel:
   assumes "f \<noteq> 0"
   and     "subdegree f < subdegree (g :: 'a :: cancel_comm_monoid_add fps)"
   shows   "subdegree (f - g) = subdegree f"
   using   assms
   by      (auto intro: subdegreeI simp: nth_less_subdegree_zero)
 
 lemma subdegree_diff_eq2:
   assumes "g \<noteq> 0"
   and     "subdegree g < subdegree (f :: 'a :: group_add fps)"
   shows   "subdegree (f - g) = subdegree g"
   using   assms
   by      (auto intro: subdegreeI simp: nth_less_subdegree_zero)
 
 lemma subdegree_diff_ge [simp]:
   assumes "f \<noteq> (g :: 'a :: group_add fps)"
   shows   "subdegree (f - g) \<ge> min (subdegree f) (subdegree g)"
 proof-
   from assms have "f = - (- g) \<Longrightarrow> False" using expand_fps_eq by fastforce
   hence "f \<noteq> - (- g)" by fast
   moreover have "f + - g = f - g" by (simp add: fps_ext)
   ultimately show ?thesis
     using subdegree_add_ge[of f "-g"] by simp
 qed
 
 lemma subdegree_diff_ge':
   fixes   f g :: "'a :: comm_monoid_diff fps"
   assumes "f - g \<noteq> 0"
   shows   "subdegree (f - g) \<ge> subdegree f"
   using   assms
   by      (auto intro: subdegree_geI simp: nth_less_subdegree_zero)
 
 lemma nth_subdegree_mult_left [simp]:
   fixes f g :: "('a :: {mult_zero,comm_monoid_add}) fps"
   shows "(f * g) $ (subdegree f) = f $ subdegree f * g $ 0"
   by    (cases "subdegree f") (simp_all add: fps_mult_nth nth_less_subdegree_zero)
 
 lemma nth_subdegree_mult_right [simp]:
   fixes f g :: "('a :: {mult_zero,comm_monoid_add}) fps"
   shows "(f * g) $ (subdegree g) = f $ 0 * g $ subdegree g"
   by    (cases "subdegree g") (simp_all add: fps_mult_nth nth_less_subdegree_zero sum.atLeast_Suc_atMost)
 
 lemma nth_subdegree_mult [simp]:
   fixes f g :: "('a :: {mult_zero,comm_monoid_add}) fps"
   shows "(f * g) $ (subdegree f + subdegree g) = f $ subdegree f * g $ subdegree g"
 proof-
   let ?n = "subdegree f + subdegree g"
   have "(f * g) $ ?n = (\<Sum>i=0..?n. f$i * g$(?n-i))"
     by (simp add: fps_mult_nth)
   also have "... = (\<Sum>i=0..?n. if i = subdegree f then f$i * g$(?n-i) else 0)"
   proof (intro sum.cong)
     fix x assume x: "x \<in> {0..?n}"
     hence "x = subdegree f \<or> x < subdegree f \<or> ?n - x < subdegree g" by auto
     thus "f $ x * g $ (?n - x) = (if x = subdegree f then f $ x * g $ (?n - x) else 0)"
       by (elim disjE conjE) auto
   qed auto
   also have "... = f $ subdegree f * g $ subdegree g" by simp
   finally show ?thesis .
 qed
 
 lemma fps_mult_nth_eq0:
   fixes f g :: "'a::{comm_monoid_add,mult_zero} fps"
   assumes "n < subdegree f + subdegree g"
   shows   "(f*g) $ n = 0"
 proof-
   have "\<And>i. i\<in>{0..n} \<Longrightarrow> f$i * g$(n - i) = 0"
   proof-
     fix i assume i: "i\<in>{0..n}"
     show "f$i * g$(n - i) = 0"
     proof (cases "i < subdegree f \<or> n - i < subdegree g")
       case False with assms i show ?thesis by auto
     qed (auto simp: nth_less_subdegree_zero)
   qed
   thus "(f * g) $ n = 0" by (simp add: fps_mult_nth)
 qed
 
 lemma fps_mult_subdegree_ge:
   fixes   f g :: "'a::{comm_monoid_add,mult_zero} fps"
   assumes "f*g \<noteq> 0"
   shows   "subdegree (f*g) \<ge> subdegree f + subdegree g"
   using   assms fps_mult_nth_eq0
   by      (intro subdegree_geI) simp
 
 lemma subdegree_mult':
   fixes   f g :: "'a::{comm_monoid_add,mult_zero} fps"
   assumes "f $ subdegree f * g $ subdegree g \<noteq> 0"
   shows   "subdegree (f*g) = subdegree f + subdegree g"
 proof-
   from assms have "(f * g) $ (subdegree f + subdegree g) \<noteq> 0" by simp
   hence "f*g \<noteq> 0" by fastforce
   hence "subdegree (f*g) \<ge> subdegree f + subdegree g" using fps_mult_subdegree_ge by fast
   moreover from assms have "subdegree (f*g) \<le> subdegree f + subdegree g"
     by (intro subdegree_leI) simp
   ultimately show ?thesis by simp
 qed
 
 lemma subdegree_mult [simp]:
   fixes   f g :: "'a :: {semiring_no_zero_divisors} fps"
   assumes "f \<noteq> 0" "g \<noteq> 0"
   shows   "subdegree (f * g) = subdegree f + subdegree g"
   using   assms
   by      (intro subdegree_mult') simp
 
 lemma fps_mult_nth_conv_upto_subdegree_left:
   fixes f g :: "('a :: {mult_zero,comm_monoid_add}) fps"
   shows "(f * g) $ n = (\<Sum>i=subdegree f..n. f $ i * g $ (n - i))"
 proof (cases "subdegree f \<le> n")
   case True
   hence "{0..n} = {0..<subdegree f} \<union> {subdegree f..n}" by auto
   moreover have "{0..<subdegree f} \<inter> {subdegree f..n} = {}" by auto
   ultimately show ?thesis
     using nth_less_subdegree_zero[of _ f]
     by    (simp add: fps_mult_nth sum.union_disjoint)
 qed (simp add: fps_mult_nth nth_less_subdegree_zero)
 
 lemma fps_mult_nth_conv_upto_subdegree_right:
   fixes f g :: "('a :: {mult_zero,comm_monoid_add}) fps"
   shows "(f * g) $ n = (\<Sum>i=0..n - subdegree g. f $ i * g $ (n - i))"
 proof-
   have "{0..n} = {0..n - subdegree g} \<union> {n - subdegree g<..n}" by auto
   moreover have "{0..n - subdegree g} \<inter> {n - subdegree g<..n} = {}" by auto
   moreover have "\<forall>i\<in>{n - subdegree g<..n}. g $ (n - i) = 0"
     using nth_less_subdegree_zero[of _ g] by auto
   ultimately show ?thesis by (simp add: fps_mult_nth sum.union_disjoint)
 qed
 
 lemma fps_mult_nth_conv_inside_subdegrees:
   fixes f g :: "('a :: {mult_zero,comm_monoid_add}) fps"
   shows "(f * g) $ n = (\<Sum>i=subdegree f..n - subdegree g. f $ i * g $ (n - i))"
 proof (cases "subdegree f \<le> n - subdegree g")
   case True
   hence "{subdegree f..n} = {subdegree f..n - subdegree g} \<union> {n - subdegree g<..n}"
     by auto
   moreover have "{subdegree f..n - subdegree g} \<inter> {n - subdegree g<..n} = {}" by auto
   moreover have "\<forall>i\<in>{n - subdegree g<..n}. f $ i * g $ (n - i) = 0"
     using nth_less_subdegree_zero[of _ g] by auto
   ultimately show ?thesis
     using fps_mult_nth_conv_upto_subdegree_left[of f g n]
     by    (simp add: sum.union_disjoint)
 next
   case False
   hence 1: "subdegree f > n - subdegree g" by simp
   show ?thesis
   proof (cases "f*g = 0")
     case False
     with 1 have "n < subdegree (f*g)" using fps_mult_subdegree_ge[of f g] by simp
     with 1 show ?thesis by auto
   qed (simp add: 1)
 qed
 
 lemma fps_mult_nth_outside_subdegrees:
   fixes f g :: "('a :: {mult_zero,comm_monoid_add}) fps"
   shows "n < subdegree f \<Longrightarrow> (f * g) $ n = 0"
   and   "n < subdegree g \<Longrightarrow> (f * g) $ n = 0"
   by    (auto simp: fps_mult_nth_conv_inside_subdegrees)
 
 
 subsection \<open>Formal power series form a commutative ring with unity, if the range of sequences
   they represent is a commutative ring with unity\<close>
 
 instance fps :: (semigroup_add) semigroup_add
 proof
   fix a b c :: "'a fps"
   show "a + b + c = a + (b + c)"
     by (simp add: fps_ext add.assoc)
 qed
 
 instance fps :: (ab_semigroup_add) ab_semigroup_add
 proof
   fix a b :: "'a fps"
   show "a + b = b + a"
     by (simp add: fps_ext add.commute)
 qed
 
 instance fps :: (monoid_add) monoid_add
 proof
   fix a :: "'a fps"
   show "0 + a = a" by (simp add: fps_ext)
   show "a + 0 = a" by (simp add: fps_ext)
 qed
 
 instance fps :: (comm_monoid_add) comm_monoid_add
 proof
   fix a :: "'a fps"
   show "0 + a = a" by (simp add: fps_ext)
 qed
 
 instance fps :: (cancel_semigroup_add) cancel_semigroup_add
 proof
   fix a b c :: "'a fps"
   show "b = c" if "a + b = a + c"
     using that by (simp add: expand_fps_eq)
   show "b = c" if "b + a = c + a"
     using that by (simp add: expand_fps_eq)
 qed
 
 instance fps :: (cancel_ab_semigroup_add) cancel_ab_semigroup_add
 proof
   fix a b c :: "'a fps"
   show "a + b - a = b"
     by (simp add: expand_fps_eq)
   show "a - b - c = a - (b + c)"
     by (simp add: expand_fps_eq diff_diff_eq)
 qed
 
 instance fps :: (cancel_comm_monoid_add) cancel_comm_monoid_add ..
 
 instance fps :: (group_add) group_add
 proof
   fix a b :: "'a fps"
   show "- a + a = 0" by (simp add: fps_ext)
   show "a + - b = a - b" by (simp add: fps_ext)
 qed
 
 instance fps :: (ab_group_add) ab_group_add
 proof
   fix a b :: "'a fps"
   show "- a + a = 0" by (simp add: fps_ext)
   show "a - b = a + - b" by (simp add: fps_ext)
 qed
 
 instance fps :: (zero_neq_one) zero_neq_one
   by standard (simp add: expand_fps_eq)
 
 lemma fps_mult_assoc_lemma:
   fixes k :: nat
     and f :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a::comm_monoid_add"
   shows "(\<Sum>j=0..k. \<Sum>i=0..j. f i (j - i) (n - j)) =
          (\<Sum>j=0..k. \<Sum>i=0..k - j. f j i (n - j - i))"
   by (induct k) (simp_all add: Suc_diff_le sum.distrib add.assoc)
 
 instance fps :: (semiring_0) semiring_0
 proof
   fix a b c :: "'a fps"
   show "(a + b) * c = a * c + b * c"
     by (simp add: expand_fps_eq fps_mult_nth distrib_right sum.distrib)
   show "a * (b + c) = a * b + a * c"
     by (simp add: expand_fps_eq fps_mult_nth distrib_left sum.distrib)
   show "(a * b) * c = a * (b * c)"
   proof (rule fps_ext)
     fix n :: nat
     have "(\<Sum>j=0..n. \<Sum>i=0..j. a$i * b$(j - i) * c$(n - j)) =
           (\<Sum>j=0..n. \<Sum>i=0..n - j. a$j * b$i * c$(n - j - i))"
       by (rule fps_mult_assoc_lemma)
     then show "((a * b) * c) $ n = (a * (b * c)) $ n"
       by (simp add: fps_mult_nth sum_distrib_left sum_distrib_right mult.assoc)
   qed
 qed
 
 instance fps :: (semiring_0_cancel) semiring_0_cancel ..
 
 lemma fps_mult_commute_lemma:
   fixes n :: nat
     and f :: "nat \<Rightarrow> nat \<Rightarrow> 'a::comm_monoid_add"
   shows "(\<Sum>i=0..n. f i (n - i)) = (\<Sum>i=0..n. f (n - i) i)"
   by (rule sum.reindex_bij_witness[where i="(-) n" and j="(-) n"]) auto
 
 instance fps :: (comm_semiring_0) comm_semiring_0
 proof
   fix a b c :: "'a fps"
   show "a * b = b * a"
   proof (rule fps_ext)
     fix n :: nat
     have "(\<Sum>i=0..n. a$i * b$(n - i)) = (\<Sum>i=0..n. a$(n - i) * b$i)"
       by (rule fps_mult_commute_lemma)
     then show "(a * b) $ n = (b * a) $ n"
       by (simp add: fps_mult_nth mult.commute)
   qed 
 qed (simp add: distrib_right)
 
 instance fps :: (comm_semiring_0_cancel) comm_semiring_0_cancel ..
 
 instance fps :: (semiring_1) semiring_1
 proof
   fix a :: "'a fps"
   show "1 * a = a" "a * 1 = a" by (simp_all add: fps_one_mult)
 qed
 
 instance fps :: (comm_semiring_1) comm_semiring_1
   by standard simp
 
 instance fps :: (semiring_1_cancel) semiring_1_cancel ..
 
 
 subsection \<open>Selection of the nth power of the implicit variable in the infinite sum\<close>
 
 lemma fps_square_nth: "(f^2) $ n = (\<Sum>k\<le>n. f $ k * f $ (n - k))"
   by (simp add: power2_eq_square fps_mult_nth atLeast0AtMost)
 
 lemma fps_sum_nth: "sum f S $ n = sum (\<lambda>k. (f k) $ n) S"
 proof (cases "finite S")
   case True
   then show ?thesis by (induct set: finite) auto
 next
   case False
   then show ?thesis by simp
 qed
 
 
 subsection \<open>Injection of the basic ring elements and multiplication by scalars\<close>
 
 definition "fps_const c = Abs_fps (\<lambda>n. if n = 0 then c else 0)"
 
 lemma fps_nth_fps_const [simp]: "fps_const c $ n = (if n = 0 then c else 0)"
   unfolding fps_const_def by simp
 
 lemma fps_const_0_eq_0 [simp]: "fps_const 0 = 0"
   by (simp add: fps_ext)
 
 lemma fps_const_nonzero_eq_nonzero: "c \<noteq> 0 \<Longrightarrow> fps_const c \<noteq> 0"
   using fps_nonzeroI[of "fps_const c" 0] by simp
 
 lemma fps_const_1_eq_1 [simp]: "fps_const 1 = 1"
   by (simp add: fps_ext)
 
 lemma subdegree_fps_const [simp]: "subdegree (fps_const c) = 0"
   by (cases "c = 0") (auto intro!: subdegreeI)
 
 lemma fps_const_neg [simp]: "- (fps_const (c::'a::group_add)) = fps_const (- c)"
   by (simp add: fps_ext)
 
 lemma fps_const_add [simp]: "fps_const (c::'a::monoid_add) + fps_const d = fps_const (c + d)"
   by (simp add: fps_ext)
 
 lemma fps_const_add_left: "fps_const (c::'a::monoid_add) + f =
     Abs_fps (\<lambda>n. if n = 0 then c + f$0 else f$n)"
   by (simp add: fps_ext)
 
 lemma fps_const_add_right: "f + fps_const (c::'a::monoid_add) =
     Abs_fps (\<lambda>n. if n = 0 then f$0 + c else f$n)"
   by (simp add: fps_ext)
 
 lemma fps_const_sub [simp]: "fps_const (c::'a::group_add) - fps_const d = fps_const (c - d)"
   by (simp add: fps_ext)
 
 lemmas fps_const_minus = fps_const_sub
 
 lemma fps_const_mult[simp]:
   fixes c d :: "'a::{comm_monoid_add,mult_zero}"
   shows "fps_const c * fps_const d = fps_const (c * d)"
   by    (simp add: fps_eq_iff fps_mult_nth sum.neutral)
 
 lemma fps_const_mult_left:
   "fps_const (c::'a::{comm_monoid_add,mult_zero}) * f = Abs_fps (\<lambda>n. c * f$n)"
   unfolding fps_eq_iff fps_mult_nth
   by (simp add: fps_const_def mult_delta_left)
 
 lemma fps_const_mult_right:
   "f * fps_const (c::'a::{comm_monoid_add,mult_zero}) = Abs_fps (\<lambda>n. f$n * c)"
   unfolding fps_eq_iff fps_mult_nth
   by (simp add: fps_const_def mult_delta_right)
 
 lemma fps_mult_left_const_nth [simp]:
   "(fps_const (c::'a::{comm_monoid_add,mult_zero}) * f)$n = c* f$n"
   by (simp add: fps_mult_nth mult_delta_left)
 
 lemma fps_mult_right_const_nth [simp]:
   "(f * fps_const (c::'a::{comm_monoid_add,mult_zero}))$n = f$n * c"
   by (simp add: fps_mult_nth mult_delta_right)
 
 lemma fps_const_power [simp]: "fps_const c ^ n = fps_const (c^n)"
   by (induct n) auto
 
 
 subsection \<open>Formal power series form an integral domain\<close>
 
 instance fps :: (ring) ring ..
 
 instance fps :: (comm_ring) comm_ring ..
 
 instance fps :: (ring_1) ring_1 ..
 
 instance fps :: (comm_ring_1) comm_ring_1 ..
 
 instance fps :: (semiring_no_zero_divisors) semiring_no_zero_divisors
 proof
   fix a b :: "'a fps"
   assume "a \<noteq> 0" and "b \<noteq> 0"
   hence "(a * b) $ (subdegree a + subdegree b) \<noteq> 0" by simp
   thus "a * b \<noteq> 0" using fps_nonzero_nth by fast
 qed
 
 instance fps :: (semiring_1_no_zero_divisors) semiring_1_no_zero_divisors ..
 
 instance fps :: ("{cancel_semigroup_add,semiring_no_zero_divisors_cancel}")
   semiring_no_zero_divisors_cancel
 proof
   fix a b c :: "'a fps"
   show "(a * c = b * c) = (c = 0 \<or> a = b)"
   proof
     assume ab: "a * c = b * c"
     have "c \<noteq> 0 \<Longrightarrow> a = b"
     proof (rule fps_ext)
       fix n
       assume c: "c \<noteq> 0"
       show "a $ n = b $ n"
       proof (induct n rule: nat_less_induct)
         case (1 n)
         with ab c show ?case
           using fps_mult_nth_conv_upto_subdegree_right[of a c "subdegree c + n"]
                 fps_mult_nth_conv_upto_subdegree_right[of b c "subdegree c + n"]
           by    (cases n) auto
       qed
     qed
     thus "c = 0 \<or> a = b" by fast
   qed auto
   show "(c * a = c * b) = (c = 0 \<or> a = b)"
   proof
     assume ab: "c * a = c * b"
     have "c \<noteq> 0 \<Longrightarrow> a = b"
     proof (rule fps_ext)
       fix n
       assume c: "c \<noteq> 0"
       show "a $ n = b $ n"
       proof (induct n rule: nat_less_induct)
         case (1 n)
         moreover have "\<forall>i\<in>{Suc (subdegree c)..subdegree c + n}. subdegree c + n - i < n" by auto
         ultimately show ?case
           using ab c fps_mult_nth_conv_upto_subdegree_left[of c a "subdegree c + n"]
                 fps_mult_nth_conv_upto_subdegree_left[of c b "subdegree c + n"]
           by    (simp add: sum.atLeast_Suc_atMost)
       qed
     qed    
     thus "c = 0 \<or> a = b" by fast
   qed auto
 qed
 
 instance fps :: (ring_no_zero_divisors) ring_no_zero_divisors ..
 
 instance fps :: (ring_1_no_zero_divisors) ring_1_no_zero_divisors ..
 
 instance fps :: (idom) idom ..
 
 lemma fps_numeral_fps_const: "numeral k = fps_const (numeral k)"
   by (induct k) (simp_all only: numeral.simps fps_const_1_eq_1 fps_const_add [symmetric])
 
 lemmas numeral_fps_const = fps_numeral_fps_const
 
 lemma neg_numeral_fps_const:
   "(- numeral k :: 'a :: ring_1 fps) = fps_const (- numeral k)"
   by (simp add: numeral_fps_const)
 
 lemma fps_numeral_nth: "numeral n $ i = (if i = 0 then numeral n else 0)"
   by (simp add: numeral_fps_const)
 
 lemma fps_numeral_nth_0 [simp]: "numeral n $ 0 = numeral n"
   by (simp add: numeral_fps_const)
 
 lemma subdegree_numeral [simp]: "subdegree (numeral n) = 0"
   by (simp add: numeral_fps_const)
 
 lemma fps_of_nat: "fps_const (of_nat c) = of_nat c"
   by (induction c) (simp_all add: fps_const_add [symmetric] del: fps_const_add)
 
 lemma fps_of_int: "fps_const (of_int c) = of_int c"
   by (induction c) (simp_all add: fps_const_minus [symmetric] fps_of_nat fps_const_neg [symmetric] 
                              del: fps_const_minus fps_const_neg)
 
 lemma fps_nth_of_nat [simp]:
   "(of_nat c) $ n = (if n=0 then of_nat c else 0)"
   by (simp add: fps_of_nat[symmetric])
 
 lemma fps_nth_of_int [simp]:
   "(of_int c) $ n = (if n=0 then of_int c else 0)"
   by (simp add: fps_of_int[symmetric])
 
 lemma fps_mult_of_nat_nth [simp]:
   shows "(of_nat k * f) $ n = of_nat k * f$n"
   and   "(f * of_nat k ) $ n = f$n * of_nat k"
   by    (simp_all add: fps_of_nat[symmetric])
 
 lemma fps_mult_of_int_nth [simp]:
   shows "(of_int k * f) $ n = of_int k * f$n"
   and   "(f * of_int k ) $ n = f$n * of_int k"
   by    (simp_all add: fps_of_int[symmetric])
 
 lemma numeral_neq_fps_zero [simp]: "(numeral f :: 'a :: field_char_0 fps) \<noteq> 0"
 proof
   assume "numeral f = (0 :: 'a fps)"
   from arg_cong[of _ _ "\<lambda>F. F $ 0", OF this] show False by simp
 qed 
 
 lemma subdegree_power_ge:
   "f^n \<noteq> 0 \<Longrightarrow> subdegree (f^n) \<ge> n * subdegree f"
 proof (induct n)
   case (Suc n) thus ?case using fps_mult_subdegree_ge by fastforce
 qed simp
 
 lemma fps_pow_nth_below_subdegree:
   "k < n * subdegree f \<Longrightarrow> (f^n) $ k = 0"
 proof (cases "f^n = 0")
   case False
   assume "k < n * subdegree f"
   with False have "k < subdegree (f^n)" using subdegree_power_ge[of f n] by simp
   thus "(f^n) $ k = 0" by auto
 qed simp
 
 lemma fps_pow_base [simp]:
   "(f ^ n) $ (n * subdegree f) = (f $ subdegree f) ^ n"
 proof (induct n)
   case (Suc n)
   show ?case
   proof (cases "Suc n * subdegree f < subdegree f + subdegree (f^n)")
     case True with Suc show ?thesis
       by (auto simp: fps_mult_nth_eq0 distrib_right)
   next
     case False
     hence "\<forall>i\<in>{Suc (subdegree f)..Suc n * subdegree f - subdegree (f ^ n)}.
             f ^ n $ (Suc n * subdegree f - i) = 0"
      by (auto simp: fps_pow_nth_below_subdegree)
    with False Suc show ?thesis
       using fps_mult_nth_conv_inside_subdegrees[of f "f^n" "Suc n * subdegree f"]
             sum.atLeast_Suc_atMost[of
               "subdegree f"
               "Suc n * subdegree f - subdegree (f ^ n)"
               "\<lambda>i. f $ i * f ^ n $ (Suc n * subdegree f - i)"
             ]
       by    simp
   qed
 qed simp
 
 lemma subdegree_power_eqI:
   fixes f :: "'a::semiring_1 fps"
   shows "(f $ subdegree f) ^ n \<noteq> 0 \<Longrightarrow> subdegree (f ^ n) = n * subdegree f"
 proof (induct n)
   case (Suc n)
   from Suc have 1: "subdegree (f ^ n) = n * subdegree f" by fastforce
   with Suc(2) have "f $ subdegree f * f ^ n $ subdegree (f ^ n) \<noteq> 0" by simp
   with 1 show ?case using subdegree_mult'[of f "f^n"] by simp
 qed simp
 
 lemma subdegree_power [simp]:
   "subdegree ((f :: ('a :: semiring_1_no_zero_divisors) fps) ^ n) = n * subdegree f"
   by (cases "f = 0"; induction n) simp_all
 
 
 subsection \<open>The efps_Xtractor series fps_X\<close>
 
 lemma minus_one_power_iff: "(- (1::'a::ring_1)) ^ n = (if even n then 1 else - 1)"
   by (induct n) auto
 
 definition "fps_X = Abs_fps (\<lambda>n. if n = 1 then 1 else 0)"
 
 lemma subdegree_fps_X [simp]: "subdegree (fps_X :: ('a :: zero_neq_one) fps) = 1"
   by (auto intro!: subdegreeI simp: fps_X_def)
 
 lemma fps_X_mult_nth [simp]:
   fixes f :: "'a::{comm_monoid_add,mult_zero,monoid_mult} fps"
   shows "(fps_X * f) $ n = (if n = 0 then 0 else f $ (n - 1))"
 proof (cases n)
   case (Suc m)
   moreover have "(fps_X * f) $ Suc m = f $ (Suc m - 1)"
   proof (cases m)
     case 0 thus ?thesis using fps_mult_nth_1[of "fps_X" f] by (simp add: fps_X_def)
   next
     case (Suc k) thus ?thesis by (simp add: fps_mult_nth fps_X_def sum.atLeast_Suc_atMost)
   qed
   ultimately show ?thesis by simp
 qed (simp add: fps_X_def)
 
 lemma fps_X_mult_right_nth [simp]:
   fixes a :: "'a::{comm_monoid_add,mult_zero,monoid_mult} fps"
   shows "(a * fps_X) $ n = (if n = 0 then 0 else a $ (n - 1))"
 proof (cases n)
   case (Suc m)
   moreover have "(a * fps_X) $ Suc m = a $ (Suc m - 1)"
   proof (cases m)
     case 0 thus ?thesis using fps_mult_nth_1[of a "fps_X"] by (simp add: fps_X_def)
   next
     case (Suc k)
     hence "(a * fps_X) $ Suc m = (\<Sum>i=0..k. a$i * fps_X$(Suc m - i)) + a$(Suc k)"
       by (simp add: fps_mult_nth fps_X_def)
     moreover have "\<forall>i\<in>{0..k}. a$i * fps_X$(Suc m - i) = 0" by (auto simp: Suc fps_X_def)
     ultimately show ?thesis by (simp add: Suc)
   qed
   ultimately show ?thesis by simp
 qed (simp add: fps_X_def)
 
 lemma fps_mult_fps_X_commute:
   fixes a :: "'a::{comm_monoid_add,mult_zero,monoid_mult} fps"
   shows "fps_X * a = a * fps_X" 
   by (simp add: fps_eq_iff)
 
 lemma fps_mult_fps_X_power_commute: "fps_X ^ k * a = a * fps_X ^ k"
 proof (induct k)
   case (Suc k)
   hence "fps_X ^ Suc k * a = a * fps_X * fps_X ^ k"
     by (simp add: mult.assoc fps_mult_fps_X_commute[symmetric])
   thus ?case by (simp add: mult.assoc)
 qed simp
 
 lemma fps_subdegree_mult_fps_X:
   fixes   f :: "'a::{comm_monoid_add,mult_zero,monoid_mult} fps"
   assumes "f \<noteq> 0"
   shows   "subdegree (fps_X * f) = subdegree f + 1"
   and     "subdegree (f * fps_X) = subdegree f + 1"
 proof-
   show "subdegree (fps_X * f) = subdegree f + 1"
   proof (intro subdegreeI)
     fix i :: nat assume i: "i < subdegree f + 1"
     show "(fps_X * f) $ i = 0"
     proof (cases "i=0")
       case False with i show ?thesis by (simp add: nth_less_subdegree_zero)
     next
       case True thus ?thesis using fps_X_mult_nth[of f i] by simp
     qed
   qed (simp add: assms)
   thus "subdegree (f * fps_X) = subdegree f + 1"
     by (simp add: fps_mult_fps_X_commute)
 qed
 
 lemma fps_mult_fps_X_nonzero:
   fixes   f :: "'a::{comm_monoid_add,mult_zero,monoid_mult} fps"
   assumes "f \<noteq> 0"
   shows   "fps_X * f \<noteq> 0"
   and     "f * fps_X \<noteq> 0"
   using   assms fps_subdegree_mult_fps_X[of f]
           fps_nonzero_subdegree_nonzeroI[of "fps_X * f"]
           fps_nonzero_subdegree_nonzeroI[of "f * fps_X"]
   by      auto
 
 lemma fps_mult_fps_X_power_nonzero:
   assumes "f \<noteq> 0"
   shows   "fps_X ^ n * f \<noteq> 0"
   and     "f * fps_X ^ n \<noteq> 0"
 proof -
   show "fps_X ^ n * f \<noteq> 0"
     by (induct n) (simp_all add: assms mult.assoc fps_mult_fps_X_nonzero(1))
   thus "f * fps_X ^ n \<noteq> 0"
     by (simp add: fps_mult_fps_X_power_commute)
 qed
 
 lemma fps_X_power_iff: "fps_X ^ n = Abs_fps (\<lambda>m. if m = n then 1 else 0)"
   by (induction n) (auto simp: fps_eq_iff)
 
 lemma fps_X_nth[simp]: "fps_X$n = (if n = 1 then 1 else 0)"
   by (simp add: fps_X_def)
 
 lemma fps_X_power_nth[simp]: "(fps_X^k) $n = (if n = k then 1 else 0)"
   by (simp add: fps_X_power_iff)
 
 lemma fps_X_power_subdegree: "subdegree (fps_X^n) = n"
   by (auto intro: subdegreeI)
 
 lemma fps_X_power_mult_nth:
   "(fps_X^k * f) $ n = (if n < k then 0 else f $ (n - k))"
   by  (cases "n<k")
       (simp_all add: fps_mult_nth_conv_upto_subdegree_left fps_X_power_subdegree sum.atLeast_Suc_atMost)
 
 lemma fps_X_power_mult_right_nth:
   "(f * fps_X^k) $ n = (if n < k then 0 else f $ (n - k))"
   using fps_mult_fps_X_power_commute[of k f] fps_X_power_mult_nth[of k f] by simp
 
 lemma fps_subdegree_mult_fps_X_power:
   assumes "f \<noteq> 0"
   shows   "subdegree (fps_X ^ n * f) = subdegree f + n"
   and     "subdegree (f * fps_X ^ n) = subdegree f + n"
 proof -
   from assms show "subdegree (fps_X ^ n * f) = subdegree f + n"
     by (induct n)
        (simp_all add: algebra_simps fps_subdegree_mult_fps_X(1) fps_mult_fps_X_power_nonzero(1))
   thus "subdegree (f * fps_X ^ n) = subdegree f + n"
     by (simp add: fps_mult_fps_X_power_commute)
 qed
 
 lemma fps_mult_fps_X_plus_1_nth:
   "((1+fps_X)*a) $n = (if n = 0 then (a$n :: 'a::semiring_1) else a$n + a$(n - 1))"
 proof (cases n)
   case 0
   then show ?thesis
     by (simp add: fps_mult_nth)
 next
   case (Suc m)
   have "((1 + fps_X)*a) $ n = sum (\<lambda>i. (1 + fps_X) $ i * a $ (n - i)) {0..n}"
     by (simp add: fps_mult_nth)
   also have "\<dots> = sum (\<lambda>i. (1+fps_X)$i * a$(n-i)) {0.. 1}"
     unfolding Suc by (rule sum.mono_neutral_right) auto
   also have "\<dots> = (if n = 0 then a$n else a$n + a$(n - 1))"
     by (simp add: Suc)
   finally show ?thesis .
 qed
 
 lemma fps_mult_right_fps_X_plus_1_nth:
   fixes a :: "'a :: semiring_1 fps"
   shows "(a*(1+fps_X)) $ n = (if n = 0 then a$n else a$n + a$(n - 1))"
   using fps_mult_fps_X_plus_1_nth
   by    (simp add: distrib_left fps_mult_fps_X_commute distrib_right)
 
 lemma fps_X_neq_fps_const [simp]: "(fps_X :: 'a :: zero_neq_one fps) \<noteq> fps_const c"
 proof
   assume "(fps_X::'a fps) = fps_const (c::'a)"
   hence "fps_X$1 = (fps_const (c::'a))$1" by (simp only:)
   thus False by auto
 qed
 
 lemma fps_X_neq_zero [simp]: "(fps_X :: 'a :: zero_neq_one fps) \<noteq> 0"
   by (simp only: fps_const_0_eq_0[symmetric] fps_X_neq_fps_const) simp
 
 lemma fps_X_neq_one [simp]: "(fps_X :: 'a :: zero_neq_one fps) \<noteq> 1"
   by (simp only: fps_const_1_eq_1[symmetric] fps_X_neq_fps_const) simp
 
 lemma fps_X_neq_numeral [simp]: "fps_X \<noteq> numeral c"
   by (simp only: numeral_fps_const fps_X_neq_fps_const) simp
 
 lemma fps_X_pow_eq_fps_X_pow_iff [simp]: "fps_X ^ m = fps_X ^ n \<longleftrightarrow> m = n"
 proof
   assume "(fps_X :: 'a fps) ^ m = fps_X ^ n"
   hence "(fps_X :: 'a fps) ^ m $ m = fps_X ^ n $ m" by (simp only:)
   thus "m = n" by (simp split: if_split_asm)
 qed simp_all
 
 
 subsection \<open>Shifting and slicing\<close>
 
 definition fps_shift :: "nat \<Rightarrow> 'a fps \<Rightarrow> 'a fps" where
   "fps_shift n f = Abs_fps (\<lambda>i. f $ (i + n))"
 
 lemma fps_shift_nth [simp]: "fps_shift n f $ i = f $ (i + n)"
   by (simp add: fps_shift_def)
 
 lemma fps_shift_0 [simp]: "fps_shift 0 f = f"
   by (intro fps_ext) (simp add: fps_shift_def)
 
 lemma fps_shift_zero [simp]: "fps_shift n 0 = 0"
   by (intro fps_ext) (simp add: fps_shift_def)
 
 lemma fps_shift_one: "fps_shift n 1 = (if n = 0 then 1 else 0)"
   by (intro fps_ext) (simp add: fps_shift_def)
 
 lemma fps_shift_fps_const: "fps_shift n (fps_const c) = (if n = 0 then fps_const c else 0)"
   by (intro fps_ext) (simp add: fps_shift_def)
 
 lemma fps_shift_numeral: "fps_shift n (numeral c) = (if n = 0 then numeral c else 0)"
   by (simp add: numeral_fps_const fps_shift_fps_const)
 
 lemma fps_shift_fps_X [simp]:
   "n \<ge> 1 \<Longrightarrow> fps_shift n fps_X = (if n = 1 then 1 else 0)"
   by (intro fps_ext) (auto simp: fps_X_def)
 
 lemma fps_shift_fps_X_power [simp]:
   "n \<le> m \<Longrightarrow> fps_shift n (fps_X ^ m) = fps_X ^ (m - n)"
  by (intro fps_ext) auto
 
 lemma fps_shift_subdegree [simp]:
   "n \<le> subdegree f \<Longrightarrow> subdegree (fps_shift n f) = subdegree f - n"
   by (cases "f=0") (auto intro: subdegreeI simp: nth_less_subdegree_zero)
 
 lemma fps_shift_fps_shift:
   "fps_shift (m + n) f = fps_shift m (fps_shift n f)"
   by (rule fps_ext) (simp add: add_ac)
 
 lemma fps_shift_fps_shift_reorder:
   "fps_shift m (fps_shift n f) = fps_shift n (fps_shift m f)"
   using fps_shift_fps_shift[of m n f] fps_shift_fps_shift[of n m f] by (simp add: add.commute)
 
 lemma fps_shift_rev_shift:
   "m \<le> n \<Longrightarrow> fps_shift n (Abs_fps (\<lambda>k. if k<m then 0 else f $ (k-m))) = fps_shift (n-m) f"
   "m > n \<Longrightarrow> fps_shift n (Abs_fps (\<lambda>k. if k<m then 0 else f $ (k-m))) =
     Abs_fps (\<lambda>k. if k<m-n then 0 else f $ (k-(m-n)))"
 proof -
   assume "m \<le> n"
   thus "fps_shift n (Abs_fps (\<lambda>k. if k<m then 0 else f $ (k-m))) = fps_shift (n-m) f"
     by (intro fps_ext) auto
 next
   assume mn: "m > n"
   hence "\<And>k. k \<ge> m-n \<Longrightarrow> k+n-m = k - (m-n)" by auto
   thus
     "fps_shift n (Abs_fps (\<lambda>k. if k<m then 0 else f $ (k-m))) =
       Abs_fps (\<lambda>k. if k<m-n then 0 else f $ (k-(m-n)))"
     by (intro fps_ext) auto
 qed
 
 lemma fps_shift_add:
   "fps_shift n (f + g) = fps_shift n f + fps_shift n g"
   by (simp add: fps_eq_iff)
 
 lemma fps_shift_diff:
   "fps_shift n (f - g) = fps_shift n f - fps_shift n g"
   by (auto intro: fps_ext)
 
 lemma fps_shift_uminus:
   "fps_shift n (-f) = - fps_shift n f"
   by (auto intro: fps_ext)
 
 lemma fps_shift_mult:
   assumes "n \<le> subdegree (g :: 'b :: {comm_monoid_add, mult_zero} fps)"
   shows "fps_shift n (h*g) = h * fps_shift n g"
 proof-
   have case1: "\<And>a b::'b fps. 1 \<le> subdegree b \<Longrightarrow> fps_shift 1 (a*b) = a * fps_shift 1 b"
   proof (rule fps_ext)
     fix a b :: "'b fps"
     and n :: nat
     assume b: "1 \<le> subdegree b"
     have "\<And>i. i \<le> n \<Longrightarrow> n + 1 - i = (n-i) + 1"
       by (simp add: algebra_simps)
     with b show "fps_shift 1 (a*b) $ n = (a * fps_shift 1 b) $ n"
       by (simp add: fps_mult_nth nth_less_subdegree_zero)
   qed
   have "n \<le> subdegree g \<Longrightarrow> fps_shift n (h*g) = h * fps_shift n g"
   proof (induct n)
     case (Suc n)
     have "fps_shift (Suc n) (h*g) = fps_shift 1 (fps_shift n (h*g))"
       by (simp add: fps_shift_fps_shift[symmetric])
     also have "\<dots> = h * (fps_shift 1 (fps_shift n g))"
       using Suc case1 by force
     finally show ?case by (simp add: fps_shift_fps_shift[symmetric])
   qed simp
   with assms show ?thesis by fast
 qed
 
 lemma fps_shift_mult_right_noncomm:
   assumes "n \<le> subdegree (g :: 'b :: {comm_monoid_add, mult_zero} fps)"
   shows "fps_shift n (g*h) = fps_shift n g * h"
 proof-
   have case1: "\<And>a b::'b fps. 1 \<le> subdegree a \<Longrightarrow> fps_shift 1 (a*b) = fps_shift 1 a * b"
   proof (rule fps_ext)
     fix a b :: "'b fps"
     and n :: nat
     assume "1 \<le> subdegree a"
     hence "fps_shift 1 (a*b) $ n = (\<Sum>i=Suc 0..Suc n. a$i * b$(n+1-i))"
       using sum.atLeast_Suc_atMost[of 0 "n+1" "\<lambda>i. a$i * b$(n+1-i)"]
       by    (simp add: fps_mult_nth nth_less_subdegree_zero)
     thus "fps_shift 1 (a*b) $ n = (fps_shift 1 a * b) $ n"
       using sum.shift_bounds_cl_Suc_ivl[of "\<lambda>i. a$i * b$(n+1-i)" 0 n]
       by    (simp add: fps_mult_nth)
   qed
   have "n \<le> subdegree g \<Longrightarrow> fps_shift n (g*h) = fps_shift n g * h"
   proof (induct n)
     case (Suc n)
     have "fps_shift (Suc n) (g*h) = fps_shift 1 (fps_shift n (g*h))"
       by (simp add: fps_shift_fps_shift[symmetric])
     also have "\<dots> = (fps_shift 1 (fps_shift n g)) * h"
       using Suc case1 by force
     finally show ?case by (simp add: fps_shift_fps_shift[symmetric])
   qed simp
   with assms show ?thesis by fast
 qed
 
 lemma fps_shift_mult_right:
   assumes "n \<le> subdegree (g :: 'b :: comm_semiring_0 fps)"
   shows   "fps_shift n (g*h) = h * fps_shift n g"
   by      (simp add: assms fps_shift_mult_right_noncomm mult.commute)
 
 lemma fps_shift_mult_both:
   fixes   f g :: "'a::{comm_monoid_add, mult_zero} fps"
   assumes "m \<le> subdegree f" "n \<le> subdegree g"
   shows   "fps_shift m f * fps_shift n g = fps_shift (m+n) (f*g)"
   using   assms
   by      (simp add: fps_shift_mult fps_shift_mult_right_noncomm fps_shift_fps_shift)
 
 lemma fps_shift_subdegree_zero_iff [simp]:
   "fps_shift (subdegree f) f = 0 \<longleftrightarrow> f = 0"
   by (subst (1) nth_subdegree_zero_iff[symmetric], cases "f = 0")
      (simp_all del: nth_subdegree_zero_iff)
 
 lemma fps_shift_times_fps_X:
   fixes f g :: "'a::{comm_monoid_add,mult_zero,monoid_mult} fps"
   shows "1 \<le> subdegree f \<Longrightarrow> fps_shift 1 f * fps_X = f"
   by (intro fps_ext) (simp add: nth_less_subdegree_zero)
 
 lemma fps_shift_times_fps_X' [simp]:
   fixes f :: "'a::{comm_monoid_add,mult_zero,monoid_mult} fps"
   shows "fps_shift 1 (f * fps_X) = f"
   by (intro fps_ext) (simp add: nth_less_subdegree_zero)
 
 lemma fps_shift_times_fps_X'':
   fixes f :: "'a::{comm_monoid_add,mult_zero,monoid_mult} fps"
   shows "1 \<le> n \<Longrightarrow> fps_shift n (f * fps_X) = fps_shift (n - 1) f"
   by (intro fps_ext) (simp add: nth_less_subdegree_zero)
 
 lemma fps_shift_times_fps_X_power:
   "n \<le> subdegree f \<Longrightarrow> fps_shift n f * fps_X ^ n = f"
   by (intro fps_ext) (simp add: fps_X_power_mult_right_nth nth_less_subdegree_zero)
 
 lemma fps_shift_times_fps_X_power' [simp]:
   "fps_shift n (f * fps_X^n) = f"
   by (intro fps_ext) (simp add: fps_X_power_mult_right_nth nth_less_subdegree_zero)
 
 lemma fps_shift_times_fps_X_power'':
   "m \<le> n \<Longrightarrow> fps_shift n (f * fps_X^m) = fps_shift (n - m) f"
   by (intro fps_ext) (simp add: fps_X_power_mult_right_nth nth_less_subdegree_zero)
 
 lemma fps_shift_times_fps_X_power''':
   "m > n \<Longrightarrow> fps_shift n (f * fps_X^m) = f * fps_X^(m - n)"
 proof (cases "f=0")
   case False
   assume m: "m>n"
   hence "m = n + (m-n)" by auto
   with False m show ?thesis
     using power_add[of "fps_X::'a fps" n "m-n"]
           fps_shift_mult_right_noncomm[of n "f * fps_X^n" "fps_X^(m-n)"]
     by    (simp add: mult.assoc fps_subdegree_mult_fps_X_power(2))
 qed simp
 
 lemma subdegree_decompose:
   "f = fps_shift (subdegree f) f * fps_X ^ subdegree f"
   by (rule fps_ext) (auto simp: fps_X_power_mult_right_nth)
 
 lemma subdegree_decompose':
   "n \<le> subdegree f \<Longrightarrow> f = fps_shift n f * fps_X^n"
   by (rule fps_ext) (auto simp: fps_X_power_mult_right_nth intro!: nth_less_subdegree_zero)
 
 instantiation fps :: (zero) unit_factor
 begin
 definition fps_unit_factor_def [simp]:
   "unit_factor f = fps_shift (subdegree f) f"
 instance ..
 end
 
 lemma fps_unit_factor_zero_iff: "unit_factor (f::'a::zero fps) = 0 \<longleftrightarrow> f = 0"
   by simp
 
 lemma fps_unit_factor_nth_0: "f \<noteq> 0 \<Longrightarrow> unit_factor f $ 0 \<noteq> 0"
   by simp
 
 lemma fps_X_unit_factor: "unit_factor (fps_X :: 'a :: zero_neq_one fps) = 1"
  by (intro fps_ext) auto
 
 lemma fps_X_power_unit_factor: "unit_factor (fps_X ^ n) = 1"
 proof-
   define X :: "'a fps" where "X \<equiv> fps_X"
   hence "unit_factor (X^n) = fps_shift n (X^n)"
     by (simp add: fps_X_power_subdegree)
   moreover have "fps_shift n (X^n) = 1"
     by (auto intro: fps_ext simp: fps_X_power_iff X_def)
   ultimately show ?thesis by (simp add: X_def)
 qed
 
 lemma fps_unit_factor_decompose:
   "f = unit_factor f * fps_X ^ subdegree f"
   by (simp add: subdegree_decompose)
 
 lemma fps_unit_factor_decompose':
   "f = fps_X ^ subdegree f * unit_factor f"
   using fps_unit_factor_decompose by (simp add: fps_mult_fps_X_power_commute)
 
 lemma fps_unit_factor_uminus:
   "unit_factor (-f) = - unit_factor (f::'a::group_add fps)"
   by    (simp add: fps_shift_uminus)
 
 lemma fps_unit_factor_shift:
   assumes "n \<le> subdegree f"
   shows   "unit_factor (fps_shift n f) = unit_factor f"
   by      (simp add: assms fps_shift_fps_shift[symmetric])
 
 lemma fps_unit_factor_mult_fps_X:
   fixes f :: "'a::{comm_monoid_add,monoid_mult,mult_zero} fps"
   shows "unit_factor (fps_X * f) = unit_factor f"
   and   "unit_factor (f * fps_X) = unit_factor f"
 proof -
   show "unit_factor (fps_X * f) = unit_factor f"
     by (cases "f=0") (auto intro: fps_ext simp: fps_subdegree_mult_fps_X(1))
   thus "unit_factor (f * fps_X) = unit_factor f" by (simp add: fps_mult_fps_X_commute)
 qed
 
 lemma fps_unit_factor_mult_fps_X_power:
   shows "unit_factor (fps_X ^ n * f) = unit_factor f"
   and   "unit_factor (f * fps_X ^ n) = unit_factor f"
 proof -
   show "unit_factor (fps_X ^ n * f) = unit_factor f"
   proof (induct n)
     case (Suc m) thus ?case
       using fps_unit_factor_mult_fps_X(1)[of "fps_X ^ m * f"] by (simp add: mult.assoc)
   qed simp
   thus "unit_factor (f * fps_X ^ n) = unit_factor f"
     by (simp add: fps_mult_fps_X_power_commute)
 qed
 
 lemma fps_unit_factor_mult_unit_factor:
   fixes f g :: "'a::{comm_monoid_add,mult_zero} fps"
   shows "unit_factor (f * unit_factor g) = unit_factor (f * g)"
   and   "unit_factor (unit_factor f * g) = unit_factor (f * g)"
 proof -
   show "unit_factor (f * unit_factor g) = unit_factor (f * g)"
   proof (cases "f*g = 0")
     case False thus ?thesis
       using fps_mult_subdegree_ge[of f g] fps_unit_factor_shift[of "subdegree g" "f*g"]
       by    (simp add: fps_shift_mult)
   next
     case True
     moreover have "f * unit_factor g = fps_shift (subdegree g) (f*g)"
       by (simp add: fps_shift_mult)
     ultimately show ?thesis by simp
   qed
   show "unit_factor (unit_factor f * g) = unit_factor (f * g)"
   proof (cases "f*g = 0")
     case False thus ?thesis
       using fps_mult_subdegree_ge[of f g] fps_unit_factor_shift[of "subdegree f" "f*g"]
       by    (simp add: fps_shift_mult_right_noncomm)
   next
     case True
     moreover have "unit_factor f * g = fps_shift (subdegree f) (f*g)"
       by (simp add: fps_shift_mult_right_noncomm)
     ultimately show ?thesis by simp
   qed
 qed
 
 lemma fps_unit_factor_mult_both_unit_factor:
   fixes f g :: "'a::{comm_monoid_add,mult_zero} fps"
   shows "unit_factor (unit_factor f * unit_factor g) = unit_factor (f * g)"
   using fps_unit_factor_mult_unit_factor(1)[of "unit_factor f" g]
         fps_unit_factor_mult_unit_factor(2)[of f g]
   by    simp
 
 lemma fps_unit_factor_mult':
   fixes   f g :: "'a::{comm_monoid_add,mult_zero} fps"
   assumes "f $ subdegree f * g $ subdegree g \<noteq> 0"
   shows   "unit_factor (f * g) = unit_factor f * unit_factor g"
   using   assms
   by      (simp add: subdegree_mult' fps_shift_mult_both)
 
 lemma fps_unit_factor_mult:
   fixes f g :: "'a::semiring_no_zero_divisors fps"
   shows "unit_factor (f * g) = unit_factor f * unit_factor g"
   using fps_unit_factor_mult'[of f g]
   by    (cases "f=0 \<or> g=0") auto
 
 definition "fps_cutoff n f = Abs_fps (\<lambda>i. if i < n then f$i else 0)"
 
 lemma fps_cutoff_nth [simp]: "fps_cutoff n f $ i = (if i < n then f$i else 0)"
   unfolding fps_cutoff_def by simp
 
 lemma fps_cutoff_zero_iff: "fps_cutoff n f = 0 \<longleftrightarrow> (f = 0 \<or> n \<le> subdegree f)"
 proof
   assume A: "fps_cutoff n f = 0"
   thus "f = 0 \<or> n \<le> subdegree f"
   proof (cases "f = 0")
     assume "f \<noteq> 0"
     with A have "n \<le> subdegree f"
       by (intro subdegree_geI) (simp_all add: fps_eq_iff split: if_split_asm)
     thus ?thesis ..
   qed simp
 qed (auto simp: fps_eq_iff intro: nth_less_subdegree_zero)
 
 lemma fps_cutoff_0 [simp]: "fps_cutoff 0 f = 0"
   by (simp add: fps_eq_iff)
 
 lemma fps_cutoff_zero [simp]: "fps_cutoff n 0 = 0"
   by (simp add: fps_eq_iff)
 
 lemma fps_cutoff_one: "fps_cutoff n 1 = (if n = 0 then 0 else 1)"
   by (simp add: fps_eq_iff)
 
 lemma fps_cutoff_fps_const: "fps_cutoff n (fps_const c) = (if n = 0 then 0 else fps_const c)"
   by (simp add: fps_eq_iff)
 
 lemma fps_cutoff_numeral: "fps_cutoff n (numeral c) = (if n = 0 then 0 else numeral c)"
   by (simp add: numeral_fps_const fps_cutoff_fps_const)
 
 lemma fps_shift_cutoff:
   "fps_shift n f * fps_X^n + fps_cutoff n f = f"
   by (simp add: fps_eq_iff fps_X_power_mult_right_nth)
 
 lemma fps_shift_cutoff':
   "fps_X^n * fps_shift n f + fps_cutoff n f = f"
   by (simp add: fps_eq_iff fps_X_power_mult_nth)
 
 lemma fps_cutoff_left_mult_nth:
   "k < n \<Longrightarrow> (fps_cutoff n f * g) $ k = (f * g) $ k"
   by (simp add: fps_mult_nth)
 
 lemma fps_cutoff_right_mult_nth:
   assumes "k < n"
   shows   "(f * fps_cutoff n g) $ k = (f * g) $ k"
 proof-
   from assms have "\<forall>i\<in>{0..k}. fps_cutoff n g $ (k - i) = g $ (k - i)" by auto
   thus ?thesis by (simp add: fps_mult_nth)
 qed
 
 subsection \<open>Formal Power series form a metric space\<close>
 
 instantiation fps :: ("{minus,zero}") dist
 begin
 
 definition
   dist_fps_def: "dist (a :: 'a fps) b = (if a = b then 0 else inverse (2 ^ subdegree (a - b)))"
 
 lemma dist_fps_ge0: "dist (a :: 'a fps) b \<ge> 0"
   by (simp add: dist_fps_def)
 
 instance ..
 
 end
 
 instantiation fps :: (group_add) metric_space
 begin
 
 definition uniformity_fps_def [code del]:
   "(uniformity :: ('a fps \<times> 'a fps) filter) = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_fps_def' [code del]:
   "open (U :: 'a fps set) \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 
 lemma dist_fps_sym: "dist (a :: 'a fps) b = dist b a"
   by (simp add: dist_fps_def)
 
 instance
 proof
   show th: "dist a b = 0 \<longleftrightarrow> a = b" for a b :: "'a fps"
     by (simp add: dist_fps_def split: if_split_asm)
   then have th'[simp]: "dist a a = 0" for a :: "'a fps" by simp
 
   fix a b c :: "'a fps"
   consider "a = b" | "c = a \<or> c = b" | "a \<noteq> b" "a \<noteq> c" "b \<noteq> c" by blast
   then show "dist a b \<le> dist a c + dist b c"
   proof cases
     case 1
     then show ?thesis by (simp add: dist_fps_def)
   next
     case 2
     then show ?thesis
       by (cases "c = a") (simp_all add: th dist_fps_sym)
   next
     case neq: 3
     have False if "dist a b > dist a c + dist b c"
     proof -
       let ?n = "subdegree (a - b)"
       from neq have "dist a b > 0" "dist b c > 0" and "dist a c > 0" by (simp_all add: dist_fps_def)
       with that have "dist a b > dist a c" and "dist a b > dist b c" by simp_all
       with neq have "?n < subdegree (a - c)" and "?n < subdegree (b - c)"
         by (simp_all add: dist_fps_def field_simps)
       hence "(a - c) $ ?n = 0" and "(b - c) $ ?n = 0"
         by (simp_all only: nth_less_subdegree_zero)
       hence "(a - b) $ ?n = 0" by simp
       moreover from neq have "(a - b) $ ?n \<noteq> 0" by (intro nth_subdegree_nonzero) simp_all
       ultimately show False by contradiction
     qed
     thus ?thesis by (auto simp add: not_le[symmetric])
   qed
 qed (rule open_fps_def' uniformity_fps_def)+
 
 end
 
 declare uniformity_Abort[where 'a="'a :: group_add fps", code]
 
 lemma open_fps_def: "open (S :: 'a::group_add fps set) = (\<forall>a \<in> S. \<exists>r. r >0 \<and> {y. dist y a < r} \<subseteq> S)"
   unfolding open_dist subset_eq by simp
 
 text \<open>The infinite sums and justification of the notation in textbooks.\<close>
 
 lemma reals_power_lt_ex:
   fixes x y :: real
   assumes xp: "x > 0"
     and y1: "y > 1"
   shows "\<exists>k>0. (1/y)^k < x"
 proof -
   have yp: "y > 0"
     using y1 by simp
   from reals_Archimedean2[of "max 0 (- log y x) + 1"]
   obtain k :: nat where k: "real k > max 0 (- log y x) + 1"
     by blast
   from k have kp: "k > 0"
     by simp
   from k have "real k > - log y x"
     by simp
   then have "ln y * real k > - ln x"
     unfolding log_def
     using ln_gt_zero_iff[OF yp] y1
     by (simp add: minus_divide_left field_simps del: minus_divide_left[symmetric])
   then have "ln y * real k + ln x > 0"
     by simp
   then have "exp (real k * ln y + ln x) > exp 0"
     by (simp add: ac_simps)
   then have "y ^ k * x > 1"
     unfolding exp_zero exp_add exp_of_nat_mult exp_ln [OF xp] exp_ln [OF yp]
     by simp
   then have "x > (1 / y)^k" using yp
     by (simp add: field_simps)
   then show ?thesis
     using kp by blast
 qed
 
 lemma fps_sum_rep_nth: "(sum (\<lambda>i. fps_const(a$i)*fps_X^i) {0..m})$n = (if n \<le> m then a$n else 0)"
   by (simp add: fps_sum_nth if_distrib cong del: if_weak_cong)
 
 lemma fps_notation: "(\<lambda>n. sum (\<lambda>i. fps_const(a$i) * fps_X^i) {0..n}) \<longlonglongrightarrow> a"
   (is "?s \<longlonglongrightarrow> a")
 proof -
   have "\<exists>n0. \<forall>n \<ge> n0. dist (?s n) a < r" if "r > 0" for r
   proof -
     obtain n0 where n0: "(1/2)^n0 < r" "n0 > 0"
       using reals_power_lt_ex[OF \<open>r > 0\<close>, of 2] by auto
     show ?thesis
     proof -
       have "dist (?s n) a < r" if nn0: "n \<ge> n0" for n
       proof -
         from that have thnn0: "(1/2)^n \<le> (1/2 :: real)^n0"
           by (simp add: field_split_simps)
         show ?thesis
         proof (cases "?s n = a")
           case True
           then show ?thesis
             unfolding dist_eq_0_iff[of "?s n" a, symmetric]
             using \<open>r > 0\<close> by (simp del: dist_eq_0_iff)
         next
           case False
           from False have dth: "dist (?s n) a = (1/2)^subdegree (?s n - a)"
             by (simp add: dist_fps_def field_simps)
           from False have kn: "subdegree (?s n - a) > n"
             by (intro subdegree_greaterI) (simp_all add: fps_sum_rep_nth)
           then have "dist (?s n) a < (1/2)^n"
             by (simp add: field_simps dist_fps_def)
           also have "\<dots> \<le> (1/2)^n0"
             using nn0 by (simp add: field_split_simps)
           also have "\<dots> < r"
             using n0 by simp
           finally show ?thesis .
         qed
       qed
       then show ?thesis by blast
     qed
   qed
   then show ?thesis
     unfolding lim_sequentially by blast
 qed
 
 
 subsection \<open>Inverses and division of formal power series\<close>
 
 declare sum.cong[fundef_cong]
 
 fun fps_left_inverse_constructor ::
   "'a::{comm_monoid_add,times,uminus} fps \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a"
 where
   "fps_left_inverse_constructor f a 0 = a"
 | "fps_left_inverse_constructor f a (Suc n) =
     - sum (\<lambda>i. fps_left_inverse_constructor f a i * f$(Suc n - i)) {0..n} * a"
 
 \<comment> \<open>This will construct a left inverse for f in case that x * f$0 = 1\<close>
 abbreviation "fps_left_inverse \<equiv> (\<lambda>f x. Abs_fps (fps_left_inverse_constructor f x))"
 
 fun fps_right_inverse_constructor ::
   "'a::{comm_monoid_add,times,uminus} fps \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a"
 where
   "fps_right_inverse_constructor f a 0 = a"
 | "fps_right_inverse_constructor f a n =
     - a * sum (\<lambda>i. f$i * fps_right_inverse_constructor f a (n - i)) {1..n}"
 
 \<comment> \<open>This will construct a right inverse for f in case that f$0 * y = 1\<close>
 abbreviation "fps_right_inverse \<equiv> (\<lambda>f y. Abs_fps (fps_right_inverse_constructor f y))"
 
 instantiation fps :: ("{comm_monoid_add,inverse,times,uminus}") inverse
 begin
 
 \<comment> \<open>For backwards compatibility.\<close>
 abbreviation natfun_inverse:: "'a fps \<Rightarrow> nat \<Rightarrow> 'a"
   where "natfun_inverse f \<equiv> fps_right_inverse_constructor f (inverse (f$0))"
 
 definition fps_inverse_def: "inverse f = Abs_fps (natfun_inverse f)"
 \<comment> \<open>
   With scalars from a (possibly non-commutative) ring, this defines a right inverse.
   Furthermore, if scalars are of class @{class mult_zero} and satisfy
   condition @{term "inverse 0 = 0"}, then this will evaluate to zero when
   the zeroth term is zero.
 \<close>
 
 definition fps_divide_def: "f div g = fps_shift (subdegree g) (f * inverse (unit_factor g))"
 \<comment> \<open>
   If scalars are of class @{class mult_zero} and satisfy condition
   @{term "inverse 0 = 0"}, then div by zero will equal zero.
 \<close>
 
 instance ..
 
 end
 
 lemma fps_lr_inverse_0_iff:
   "(fps_left_inverse f x) $ 0 = 0 \<longleftrightarrow> x = 0"
   "(fps_right_inverse f x) $ 0 = 0 \<longleftrightarrow> x = 0"
   by auto
 
 lemma fps_inverse_0_iff': "(inverse f) $ 0 = 0 \<longleftrightarrow> inverse (f $ 0) = 0"
   by (simp add: fps_inverse_def fps_lr_inverse_0_iff(2))
 
 lemma fps_inverse_0_iff[simp]: "(inverse f) $ 0 = (0::'a::division_ring) \<longleftrightarrow> f $ 0 = 0"
   by (simp add: fps_inverse_0_iff')
 
 lemma fps_lr_inverse_nth_0:
   "(fps_left_inverse f x) $ 0 = x" "(fps_right_inverse f x) $ 0 = x"
   by auto
 
 lemma fps_inverse_nth_0 [simp]: "(inverse f) $ 0 = inverse (f $ 0)"
   by (simp add: fps_inverse_def)
 
 lemma fps_lr_inverse_starting0:
   fixes f :: "'a::{comm_monoid_add,mult_zero,uminus} fps"
   and   g :: "'b::{ab_group_add,mult_zero} fps"
   shows "fps_left_inverse f 0 = 0"
   and   "fps_right_inverse g 0 = 0"
 proof-
   show "fps_left_inverse f 0 = 0"
   proof (rule fps_ext)
     fix n show "fps_left_inverse f 0 $ n = 0 $ n"
       by (cases n) (simp_all add: fps_inverse_def)
   qed
   show "fps_right_inverse g 0 = 0"
   proof (rule fps_ext)
     fix n show "fps_right_inverse g 0 $ n = 0 $ n"
       by (cases n) (simp_all add: fps_inverse_def)
   qed
 qed
 
 lemma fps_lr_inverse_eq0_imp_starting0:
   "fps_left_inverse f x = 0 \<Longrightarrow> x = 0"
   "fps_right_inverse f x = 0 \<Longrightarrow> x = 0"
 proof-
   assume A: "fps_left_inverse f x = 0"
   have "0 = fps_left_inverse f x $ 0" by (subst A) simp
   thus "x = 0" by simp
 next
   assume A: "fps_right_inverse f x = 0"
   have "0 = fps_right_inverse f x $ 0" by (subst A) simp
   thus "x = 0" by simp
 qed
 
 lemma fps_lr_inverse_eq_0_iff:
   fixes x :: "'a::{comm_monoid_add,mult_zero,uminus}"
   and   y :: "'b::{ab_group_add,mult_zero}"
   shows "fps_left_inverse f x = 0 \<longleftrightarrow> x = 0"
   and   "fps_right_inverse g y = 0 \<longleftrightarrow> y = 0"
   using fps_lr_inverse_starting0 fps_lr_inverse_eq0_imp_starting0
   by    auto
 
 lemma fps_inverse_eq_0_iff':
   fixes f :: "'a::{ab_group_add,inverse,mult_zero} fps"
   shows "inverse f = 0 \<longleftrightarrow> inverse (f $ 0) = 0"
   by    (simp add: fps_inverse_def fps_lr_inverse_eq_0_iff(2))
 
 lemma fps_inverse_eq_0_iff[simp]: "inverse f = (0:: ('a::division_ring) fps) \<longleftrightarrow> f $ 0 = 0"
   using fps_inverse_eq_0_iff'[of f] by simp
 
 lemmas fps_inverse_eq_0' = iffD2[OF fps_inverse_eq_0_iff']
 lemmas fps_inverse_eq_0  = iffD2[OF fps_inverse_eq_0_iff]
 
 lemma fps_const_lr_inverse:
   fixes a :: "'a::{ab_group_add,mult_zero}"
   and   b :: "'b::{comm_monoid_add,mult_zero,uminus}"
   shows "fps_left_inverse (fps_const a) x = fps_const x"
   and   "fps_right_inverse (fps_const b) y = fps_const y"
 proof-
   show "fps_left_inverse (fps_const a) x = fps_const x"
   proof (rule fps_ext)
     fix n show "fps_left_inverse (fps_const a) x $ n = fps_const x $ n"
       by (cases n) auto
   qed
   show "fps_right_inverse (fps_const b) y = fps_const y"
   proof (rule fps_ext)
     fix n show "fps_right_inverse (fps_const b) y $ n = fps_const y $ n"
       by (cases n) auto
   qed
 qed
 
 lemma fps_const_inverse:
   fixes     a :: "'a::{comm_monoid_add,inverse,mult_zero,uminus}"
   shows     "inverse (fps_const a) = fps_const (inverse a)"
   unfolding fps_inverse_def
   by        (simp add: fps_const_lr_inverse(2))
 
 lemma fps_lr_inverse_zero:
   fixes x :: "'a::{ab_group_add,mult_zero}"
   and   y :: "'b::{comm_monoid_add,mult_zero,uminus}"
   shows "fps_left_inverse 0 x = fps_const x"
   and   "fps_right_inverse 0 y = fps_const y"
   using fps_const_lr_inverse[of 0]
   by    simp_all
 
 lemma fps_inverse_zero_conv_fps_const:
   "inverse (0::'a::{comm_monoid_add,mult_zero,uminus,inverse} fps) = fps_const (inverse 0)"
   using fps_lr_inverse_zero(2)[of "inverse (0::'a)"] by (simp add: fps_inverse_def)
 
 lemma fps_inverse_zero':
   assumes "inverse (0::'a::{comm_monoid_add,inverse,mult_zero,uminus}) = 0"
   shows   "inverse (0::'a fps) = 0"
   by      (simp add: assms fps_inverse_zero_conv_fps_const)
 
 lemma fps_inverse_zero [simp]:
   "inverse (0::'a::division_ring fps) = 0"
   by (rule fps_inverse_zero'[OF inverse_zero])
 
 lemma fps_lr_inverse_one:
   fixes x :: "'a::{ab_group_add,mult_zero,one}"
   and   y :: "'b::{comm_monoid_add,mult_zero,uminus,one}"
   shows "fps_left_inverse 1 x = fps_const x"
   and   "fps_right_inverse 1 y = fps_const y"
   using fps_const_lr_inverse[of 1]
   by    simp_all
 
 lemma fps_lr_inverse_one_one:
   "fps_left_inverse 1 1 = (1::'a::{ab_group_add,mult_zero,one} fps)"
   "fps_right_inverse 1 1 = (1::'b::{comm_monoid_add,mult_zero,uminus,one} fps)"
   by (simp_all add: fps_lr_inverse_one)
 
 lemma fps_inverse_one':
   assumes "inverse (1::'a::{comm_monoid_add,inverse,mult_zero,uminus,one}) = 1"
   shows   "inverse (1 :: 'a fps) = 1"
   using   assms fps_lr_inverse_one_one(2)
   by      (simp add: fps_inverse_def)
 
 lemma fps_inverse_one [simp]: "inverse (1 :: 'a :: division_ring fps) = 1"
   by (rule fps_inverse_one'[OF inverse_1])
 
 lemma fps_lr_inverse_minus:
   fixes f :: "'a::ring_1 fps"
   shows "fps_left_inverse (-f) (-x) = - fps_left_inverse f x"
   and   "fps_right_inverse (-f) (-x) = - fps_right_inverse f x"
 proof-
 
   show "fps_left_inverse (-f) (-x) = - fps_left_inverse f x"
   proof (intro fps_ext)
     fix n show "fps_left_inverse (-f) (-x) $ n = - fps_left_inverse f x $ n"
     proof (induct n rule: nat_less_induct)
       case (1 n) thus ?case by (cases n) (simp_all add: sum_negf algebra_simps)
     qed
   qed
 
   show "fps_right_inverse (-f) (-x) = - fps_right_inverse f x"
   proof (intro fps_ext)
     fix n show "fps_right_inverse (-f) (-x) $ n = - fps_right_inverse f x $ n"
     proof (induct n rule: nat_less_induct)
       case (1 n) show ?case
       proof (cases n)
         case (Suc m)
         with 1 have
           "\<forall>i\<in>{1..Suc m}. fps_right_inverse (-f) (-x) $ (Suc m - i) =
             - fps_right_inverse f x $ (Suc m - i)"
           by auto
         with Suc show ?thesis by (simp add: sum_negf algebra_simps)
       qed simp
     qed
   qed
 
 qed
 
 lemma fps_inverse_minus [simp]: "inverse (-f) = -inverse (f :: 'a :: division_ring fps)"
   by (simp add: fps_inverse_def fps_lr_inverse_minus(2))
 
 lemma fps_left_inverse:
   fixes   f :: "'a::ring_1 fps"
   assumes f0: "x * f$0 = 1"
   shows   "fps_left_inverse f x * f = 1"
 proof (rule fps_ext)
   fix n show "(fps_left_inverse f x * f) $ n = 1 $ n"
     by (cases n) (simp_all add: f0 fps_mult_nth mult.assoc)
 qed
 
 lemma fps_right_inverse:
   fixes   f :: "'a::ring_1 fps"
   assumes f0: "f$0 * y = 1"
   shows   "f * fps_right_inverse f y = 1"
 proof (rule fps_ext)
   fix n
   show "(f * fps_right_inverse f y) $ n = 1 $ n"
   proof (cases n)
     case (Suc k)
     moreover from Suc have "fps_right_inverse f y $ n =
             - y * sum (\<lambda>i. f$i * fps_right_inverse_constructor f y (n - i)) {1..n}"
       by simp
     hence
       "(f * fps_right_inverse f y) $ n =
         - 1 * sum (\<lambda>i. f$i * fps_right_inverse_constructor f y (n - i)) {1..n} +
         sum (\<lambda>i. f$i * (fps_right_inverse_constructor f y (n - i))) {1..n}"
       by (simp add: fps_mult_nth sum.atLeast_Suc_atMost mult.assoc f0[symmetric])
     thus "(f * fps_right_inverse f y) $ n = 1 $ n" by (simp add: Suc)
   qed (simp add: f0 fps_inverse_def)
 qed
 
 \<comment> \<open>
   It is possible in a ring for an element to have a left inverse but not a right inverse, or
   vice versa. But when an element has both, they must be the same.
 \<close>
 lemma fps_left_inverse_eq_fps_right_inverse:
   fixes   f :: "'a::ring_1 fps"
   assumes f0: "x * f$0 = 1" "f $ 0 * y = 1"
   \<comment> \<open>These assumptions imply x equals y, but no need to assume that.\<close>
   shows   "fps_left_inverse f x = fps_right_inverse f y"
 proof-
   from f0(2) have "f * fps_right_inverse f y = 1"
       by (simp add: fps_right_inverse)
   hence "fps_left_inverse f x * f * fps_right_inverse f y = fps_left_inverse f x"
     by (simp add: mult.assoc)
   moreover from f0(1) have
     "fps_left_inverse f x * f * fps_right_inverse f y = fps_right_inverse f y"
     by (simp add: fps_left_inverse)
   ultimately show ?thesis by simp
 qed
 
 lemma fps_left_inverse_eq_fps_right_inverse_comm:
   fixes   f :: "'a::comm_ring_1 fps"
   assumes f0: "x * f$0 = 1"
   shows   "fps_left_inverse f x = fps_right_inverse f x"
   using   assms fps_left_inverse_eq_fps_right_inverse[of x f x]
   by      (simp add: mult.commute)
 
 lemma fps_left_inverse':
   fixes   f :: "'a::ring_1 fps"
   assumes "x * f$0 = 1" "f$0 * y = 1"
   \<comment> \<open>These assumptions imply x equals y, but no need to assume that.\<close>
   shows   "fps_right_inverse f y * f = 1"
   using   assms fps_left_inverse_eq_fps_right_inverse[of x f y] fps_left_inverse[of x f]
   by      simp
 
 lemma fps_right_inverse':
   fixes   f :: "'a::ring_1 fps"
   assumes "x * f$0 = 1" "f$0 * y = 1"
   \<comment> \<open>These assumptions imply x equals y, but no need to assume that.\<close>
   shows   "f * fps_left_inverse f x = 1"
   using   assms fps_left_inverse_eq_fps_right_inverse[of x f y] fps_right_inverse[of f y]
   by      simp
 
 lemma inverse_mult_eq_1 [intro]:
   assumes "f$0 \<noteq> (0::'a::division_ring)"
   shows   "inverse f * f = 1"
   using   fps_left_inverse'[of "inverse (f$0)"]
   by      (simp add: assms fps_inverse_def)
 
 lemma inverse_mult_eq_1':
   assumes "f$0 \<noteq> (0::'a::division_ring)"
   shows   "f * inverse f = 1"
   using   assms fps_right_inverse
   by      (force simp: fps_inverse_def)
 
 lemma fps_mult_left_inverse_unit_factor:
   fixes   f :: "'a::ring_1 fps"
   assumes "x * f $ subdegree f = 1"
   shows   "fps_left_inverse (unit_factor f) x * f = fps_X ^ subdegree f"
 proof-
   have
     "fps_left_inverse (unit_factor f) x * f =
       fps_left_inverse (unit_factor f) x * unit_factor f * fps_X ^ subdegree f"
     using fps_unit_factor_decompose[of f] by (simp add: mult.assoc)
   with assms show ?thesis by (simp add: fps_left_inverse)
 qed
 
 lemma fps_mult_right_inverse_unit_factor:
   fixes   f :: "'a::ring_1 fps"
   assumes "f $ subdegree f * y = 1"
   shows   "f * fps_right_inverse (unit_factor f) y = fps_X ^ subdegree f"
 proof-
   have
     "f * fps_right_inverse (unit_factor f) y =
       fps_X ^ subdegree f * (unit_factor f * fps_right_inverse (unit_factor f) y)"
     using fps_unit_factor_decompose'[of f] by (simp add: mult.assoc[symmetric])
   with assms show ?thesis by (simp add: fps_right_inverse)
 qed
 
 lemma fps_mult_right_inverse_unit_factor_divring:
   "(f :: 'a::division_ring fps) \<noteq> 0 \<Longrightarrow> f * inverse (unit_factor f) = fps_X ^ subdegree f"
   using   fps_mult_right_inverse_unit_factor[of f]
   by      (simp add: fps_inverse_def)
 
 lemma fps_left_inverse_idempotent_ring1:
   fixes   f :: "'a::ring_1 fps"
   assumes "x * f$0 = 1" "y * x = 1"
   \<comment> \<open>These assumptions imply y equals f$0, but no need to assume that.\<close>
   shows   "fps_left_inverse (fps_left_inverse f x) y = f"
 proof-
   from assms(1) have
     "fps_left_inverse (fps_left_inverse f x) y * fps_left_inverse f x * f =
       fps_left_inverse (fps_left_inverse f x) y"
     by (simp add: fps_left_inverse mult.assoc)
   moreover from assms(2) have
     "fps_left_inverse (fps_left_inverse f x) y * fps_left_inverse f x = 1"
     by (simp add: fps_left_inverse)
   ultimately show ?thesis by simp
 qed
 
 lemma fps_left_inverse_idempotent_comm_ring1:
   fixes   f :: "'a::comm_ring_1 fps"
   assumes "x * f$0 = 1"
   shows   "fps_left_inverse (fps_left_inverse f x) (f$0) = f"
   using   assms fps_left_inverse_idempotent_ring1[of x f "f$0"]
   by      (simp add: mult.commute)
 
 lemma fps_right_inverse_idempotent_ring1:
   fixes   f :: "'a::ring_1 fps"
   assumes "f$0 * x = 1" "x * y = 1"
   \<comment> \<open>These assumptions imply y equals f$0, but no need to assume that.\<close>
   shows   "fps_right_inverse (fps_right_inverse f x) y = f"
 proof-
   from assms(1) have "f * (fps_right_inverse f x * fps_right_inverse (fps_right_inverse f x) y) =
       fps_right_inverse (fps_right_inverse f x) y"
     by (simp add: fps_right_inverse mult.assoc[symmetric])
   moreover from assms(2) have
     "fps_right_inverse f x * fps_right_inverse (fps_right_inverse f x) y = 1"
     by (simp add: fps_right_inverse)
   ultimately show ?thesis by simp
 qed
 
 lemma fps_right_inverse_idempotent_comm_ring1:
   fixes   f :: "'a::comm_ring_1 fps"
   assumes "f$0 * x = 1"
   shows   "fps_right_inverse (fps_right_inverse f x) (f$0) = f"
   using   assms fps_right_inverse_idempotent_ring1[of f x "f$0"]
   by      (simp add: mult.commute)
 
 lemma fps_inverse_idempotent[intro, simp]:
   "f$0 \<noteq> (0::'a::division_ring) \<Longrightarrow> inverse (inverse f) = f"
   using fps_right_inverse_idempotent_ring1[of f]
   by    (simp add: fps_inverse_def)
 
 lemma fps_lr_inverse_unique_ring1:
   fixes   f g :: "'a :: ring_1 fps"
   assumes fg: "f * g = 1" "g$0 * f$0 = 1"
   shows   "fps_left_inverse g (f$0) = f"
   and     "fps_right_inverse f (g$0) = g"
 proof-
 
   show "fps_left_inverse g (f$0) = f"
   proof (intro fps_ext)
     fix n show "fps_left_inverse g (f$0) $ n = f $ n"
     proof (induct n rule: nat_less_induct)
       case (1 n) show ?case
       proof (cases n)
         case (Suc k)
         hence "\<forall>i\<in>{0..k}. fps_left_inverse g (f$0) $ i = f $ i" using 1 by simp
         hence "fps_left_inverse g (f$0) $ Suc k = f $ Suc k - 1 $ Suc k * f$0"
           by (simp add: fps_mult_nth fg(1)[symmetric] distrib_right mult.assoc fg(2))
         with Suc show ?thesis by simp
       qed simp
     qed
   qed
 
   show "fps_right_inverse f (g$0) = g"
   proof (intro fps_ext)
     fix n show "fps_right_inverse f (g$0) $ n = g $ n"
     proof (induct n rule: nat_less_induct)
       case (1 n) show ?case
       proof (cases n)
         case (Suc k)
         hence "\<forall>i\<in>{1..Suc k}. fps_right_inverse f (g$0) $ (Suc k - i) = g $ (Suc k - i)"
           using 1 by auto
         hence
           "fps_right_inverse f (g$0) $ Suc k = 1 * g $ Suc k - g$0 * 1 $ Suc k"
           by (simp add: fps_mult_nth fg(1)[symmetric] algebra_simps fg(2)[symmetric] sum.atLeast_Suc_atMost)
         with Suc show ?thesis by simp
       qed simp
     qed
   qed
 
 qed
 
 lemma fps_lr_inverse_unique_divring:
   fixes   f g :: "'a ::division_ring fps"
   assumes fg: "f * g = 1"
   shows   "fps_left_inverse g (f$0) = f"
   and     "fps_right_inverse f (g$0) = g"
 proof-
   from fg have "f$0 * g$0 = 1" using fps_mult_nth_0[of f g] by simp
   hence "g$0 * f$0 = 1" using inverse_unique[of "f$0"] left_inverse[of "f$0"] by force
   thus "fps_left_inverse g (f$0) = f" "fps_right_inverse f (g$0) = g"
     using fg fps_lr_inverse_unique_ring1 by auto
 qed
 
 lemma fps_inverse_unique:
   fixes   f g :: "'a :: division_ring fps"
   assumes fg: "f * g = 1"
   shows   "inverse f = g"
 proof -
   from fg have if0: "inverse (f$0) = g$0" "f$0 \<noteq> 0"
     using inverse_unique[of "f$0"] fps_mult_nth_0[of f g] by auto
   with fg have "fps_right_inverse f (g$0) = g"
     using left_inverse[of "f$0"] by (intro fps_lr_inverse_unique_ring1(2)) simp_all
   with if0(1) show ?thesis by (simp add: fps_inverse_def)
 qed
 
 lemma inverse_fps_numeral:
   "inverse (numeral n :: ('a :: field_char_0) fps) = fps_const (inverse (numeral n))"
   by (intro fps_inverse_unique fps_ext) (simp_all add: fps_numeral_nth)
 
 lemma inverse_fps_of_nat:
   "inverse (of_nat n :: 'a :: {semiring_1,times,uminus,inverse} fps) =
     fps_const (inverse (of_nat n))"
   by (simp add: fps_of_nat fps_const_inverse[symmetric])
 
 lemma fps_lr_inverse_mult_ring1:
   fixes   f g :: "'a::ring_1 fps"
   assumes x: "x * f$0 = 1" "f$0 * x = 1"
   and     y: "y * g$0 = 1" "g$0 * y = 1"
   shows   "fps_left_inverse (f * g) (y*x) = fps_left_inverse g y * fps_left_inverse f x"
   and     "fps_right_inverse (f * g) (y*x) = fps_right_inverse g y * fps_right_inverse f x"
 proof -
   define h where "h \<equiv> fps_left_inverse g y * fps_left_inverse f x"
   hence h0: "h$0 = y*x" by simp
   have "fps_left_inverse (f*g) (h$0) = h"
   proof (intro fps_lr_inverse_unique_ring1(1))
     from h_def
       have  "h * (f * g) = fps_left_inverse g y * (fps_left_inverse f x * f) * g"
       by    (simp add: mult.assoc)
     thus "h * (f * g) = 1"
       using fps_left_inverse[OF x(1)] fps_left_inverse[OF y(1)] by simp
     from h_def have "(f*g)$0 * h$0 = f$0 * 1 * x"
       by (simp add: mult.assoc y(2)[symmetric])
     with x(2) show "(f * g) $ 0 * h $ 0 = 1" by simp
   qed
   with h_def
     show  "fps_left_inverse (f * g) (y*x) = fps_left_inverse g y * fps_left_inverse f x"
     by    simp
 next
   define h where "h \<equiv> fps_right_inverse g y * fps_right_inverse f x"
   hence h0: "h$0 = y*x" by simp
   have "fps_right_inverse (f*g) (h$0) = h"
   proof (intro fps_lr_inverse_unique_ring1(2))
     from h_def
       have  "f * g * h = f * (g * fps_right_inverse g y) * fps_right_inverse f x"
       by    (simp add: mult.assoc)
     thus "f * g * h = 1"
       using fps_right_inverse[OF x(2)] fps_right_inverse[OF y(2)] by simp
     from h_def have "h$0 * (f*g)$0 = y * 1 * g$0"
       by (simp add: mult.assoc x(1)[symmetric])
     with y(1) show "h$0 * (f*g)$0  = 1" by simp
   qed
   with h_def
     show  "fps_right_inverse (f * g) (y*x) = fps_right_inverse g y * fps_right_inverse f x"
     by    simp
 qed
 
 lemma fps_lr_inverse_mult_divring:
   fixes f g :: "'a::division_ring fps"
   shows "fps_left_inverse (f * g) (inverse ((f*g)$0)) =
           fps_left_inverse g (inverse (g$0)) * fps_left_inverse f (inverse (f$0))"
   and   "fps_right_inverse (f * g) (inverse ((f*g)$0)) =
           fps_right_inverse g (inverse (g$0)) * fps_right_inverse f (inverse (f$0))"
 proof-
   show "fps_left_inverse (f * g) (inverse ((f*g)$0)) =
           fps_left_inverse g (inverse (g$0)) * fps_left_inverse f (inverse (f$0))"
   proof (cases "f$0 = 0 \<or> g$0 = 0")
     case True
     hence "fps_left_inverse (f * g) (inverse ((f*g)$0)) = 0"
       by (simp add: fps_lr_inverse_eq_0_iff(1))
     moreover from True have
       "fps_left_inverse g (inverse (g$0)) * fps_left_inverse f (inverse (f$0)) = 0"
       by (auto simp: fps_lr_inverse_eq_0_iff(1))
     ultimately show ?thesis by simp
   next
     case False
     hence "fps_left_inverse (f * g) (inverse (g$0) * inverse (f$0)) =
             fps_left_inverse g (inverse (g$0)) * fps_left_inverse f (inverse (f$0))"
       by  (intro fps_lr_inverse_mult_ring1(1)) simp_all
     with False show ?thesis by (simp add: nonzero_inverse_mult_distrib)
   qed
   show "fps_right_inverse (f * g) (inverse ((f*g)$0)) =
           fps_right_inverse g (inverse (g$0)) * fps_right_inverse f (inverse (f$0))"
   proof (cases "f$0 = 0 \<or> g$0 = 0")
     case True
     from True have "fps_right_inverse (f * g) (inverse ((f*g)$0)) = 0"
       by (simp add: fps_lr_inverse_eq_0_iff(2))
     moreover from True have
       "fps_right_inverse g (inverse (g$0)) * fps_right_inverse f (inverse (f$0)) = 0"
       by (auto simp: fps_lr_inverse_eq_0_iff(2))
     ultimately show ?thesis by simp
   next
     case False
     hence "fps_right_inverse (f * g) (inverse (g$0) * inverse (f$0)) =
             fps_right_inverse g (inverse (g$0)) * fps_right_inverse f (inverse (f$0))"
       by  (intro fps_lr_inverse_mult_ring1(2)) simp_all
     with False show ?thesis by (simp add: nonzero_inverse_mult_distrib)
   qed
 qed
 
 lemma fps_inverse_mult_divring:
   "inverse (f * g) = inverse g * inverse (f :: 'a::division_ring fps)"
   using fps_lr_inverse_mult_divring(2) by (simp add: fps_inverse_def)
 
 lemma fps_inverse_mult: "inverse (f * g :: 'a::field fps) = inverse f * inverse g"
   by (simp add: fps_inverse_mult_divring)
 
 lemma fps_lr_inverse_gp_ring1:
   fixes   ones ones_inv :: "'a :: ring_1 fps"
   defines "ones \<equiv> Abs_fps (\<lambda>n. 1)"
   and     "ones_inv \<equiv> Abs_fps (\<lambda>n. if n=0 then 1 else if n=1 then - 1 else 0)"
   shows   "fps_left_inverse ones 1 = ones_inv"
   and     "fps_right_inverse ones 1 = ones_inv"
 proof-
   show "fps_left_inverse ones 1 = ones_inv"
   proof (rule fps_ext)
     fix n
     show "fps_left_inverse ones 1 $ n = ones_inv $ n"
     proof (induct n rule: nat_less_induct)
       case (1 n) show ?case
       proof (cases n)
         case (Suc m)
         have m: "n = Suc m" by fact
         moreover have "fps_left_inverse ones 1 $ Suc m = ones_inv $ Suc m"
         proof (cases m)
           case (Suc k) thus ?thesis
             using Suc m 1 by (simp add: ones_def ones_inv_def sum.atLeast_Suc_atMost)
         qed (simp add: ones_def ones_inv_def)
         ultimately show ?thesis by simp
       qed (simp add: ones_inv_def)
     qed
   qed
   moreover have "fps_right_inverse ones 1 = fps_left_inverse ones 1"
     by (auto intro: fps_left_inverse_eq_fps_right_inverse[symmetric] simp: ones_def)
   ultimately show "fps_right_inverse ones 1 = ones_inv" by simp
 qed
 
 lemma fps_lr_inverse_gp_ring1':
   fixes   ones :: "'a :: ring_1 fps"
   defines "ones \<equiv> Abs_fps (\<lambda>n. 1)"
   shows   "fps_left_inverse ones 1 = 1 - fps_X"
   and     "fps_right_inverse ones 1 = 1 - fps_X"
 proof-
   define ones_inv :: "'a :: ring_1 fps" 
     where "ones_inv \<equiv> Abs_fps (\<lambda>n. if n=0 then 1 else if n=1 then - 1 else 0)"
   hence "fps_left_inverse ones 1 = ones_inv"
   and   "fps_right_inverse ones 1 = ones_inv"
     using ones_def fps_lr_inverse_gp_ring1 by auto
   thus "fps_left_inverse ones 1 = 1 - fps_X"
   and   "fps_right_inverse ones 1 = 1 - fps_X"
     by (auto intro: fps_ext simp: ones_inv_def)
 qed
 
 lemma fps_inverse_gp:
   "inverse (Abs_fps(\<lambda>n. (1::'a::division_ring))) =
     Abs_fps (\<lambda>n. if n= 0 then 1 else if n=1 then - 1 else 0)"
   using fps_lr_inverse_gp_ring1(2) by (simp add: fps_inverse_def)
 
 lemma fps_inverse_gp': "inverse (Abs_fps (\<lambda>n. 1::'a::division_ring)) = 1 - fps_X"
   by (simp add: fps_inverse_def fps_lr_inverse_gp_ring1'(2))
 
 lemma fps_lr_inverse_one_minus_fps_X:
   fixes   ones :: "'a :: ring_1 fps"
   defines "ones \<equiv> Abs_fps (\<lambda>n. 1)"
   shows "fps_left_inverse (1 - fps_X) 1 = ones"
   and   "fps_right_inverse (1 - fps_X) 1 = ones"
 proof-
   have "fps_left_inverse ones 1 = 1 - fps_X"
     using fps_lr_inverse_gp_ring1'(1) by (simp add: ones_def)
   thus "fps_left_inverse (1 - fps_X) 1 = ones"
     using fps_left_inverse_idempotent_ring1[of 1 ones 1] by (simp add: ones_def)
   have "fps_right_inverse ones 1 = 1 - fps_X"
     using fps_lr_inverse_gp_ring1'(2) by (simp add: ones_def)
   thus "fps_right_inverse (1 - fps_X) 1 = ones"
     using fps_right_inverse_idempotent_ring1[of ones 1 1] by (simp add: ones_def)
 qed
 
 lemma fps_inverse_one_minus_fps_X:
   fixes   ones :: "'a :: division_ring fps"
   defines "ones \<equiv> Abs_fps (\<lambda>n. 1)"
   shows   "inverse (1 - fps_X) = ones"
   by      (simp add: fps_inverse_def assms fps_lr_inverse_one_minus_fps_X(2))
 
 lemma fps_lr_one_over_one_minus_fps_X_squared:
   shows   "fps_left_inverse ((1 - fps_X)^2) (1::'a::ring_1) = Abs_fps (\<lambda>n. of_nat (n+1))"
           "fps_right_inverse ((1 - fps_X)^2) (1::'a) = Abs_fps (\<lambda>n. of_nat (n+1))"
 proof-
   define  f invf2 :: "'a fps"
     where "f \<equiv> (1 - fps_X)"
     and   "invf2 \<equiv> Abs_fps (\<lambda>n. of_nat (n+1))"
 
   have f2_nth_simps:
     "f^2 $ 1 = - of_nat 2" "f^2 $ 2 = 1" "\<And>n. n>2 \<Longrightarrow> f^2 $ n = 0"
       by (simp_all add: power2_eq_square f_def fps_mult_nth sum.atLeast_Suc_atMost)
 
   show "fps_left_inverse (f^2) 1 = invf2"
   proof (intro fps_ext)
     fix n show "fps_left_inverse (f^2) 1 $ n = invf2 $ n"
     proof (induct n rule: nat_less_induct)
       case (1 t)
       hence induct_assm:
         "\<And>m. m < t \<Longrightarrow> fps_left_inverse (f\<^sup>2) 1 $ m = invf2 $ m"
         by fast
       show ?case
       proof (cases t)
         case (Suc m)
         have m: "t = Suc m" by fact
         moreover have "fps_left_inverse (f^2) 1 $ Suc m = invf2 $ Suc m"
         proof (cases m)
           case 0 thus ?thesis using f2_nth_simps(1) by (simp add: invf2_def)
         next
           case (Suc l)
           have l: "m = Suc l" by fact
           moreover have "fps_left_inverse (f^2) 1 $ Suc (Suc l) = invf2 $ Suc (Suc l)"
           proof (cases l)
             case 0 thus ?thesis using f2_nth_simps(1,2) by (simp add: Suc_1[symmetric] invf2_def)
           next
             case (Suc k)
             from Suc l m
               have A: "fps_left_inverse (f\<^sup>2) 1 $ Suc (Suc k) = invf2 $ Suc (Suc k)"
               and  B: "fps_left_inverse (f\<^sup>2) 1 $ Suc k = invf2 $ Suc k"
               using induct_assm[of "Suc k"] induct_assm[of "Suc (Suc k)"]
               by    auto
             have times2: "\<And>a::nat. 2*a = a + a" by simp
             have "\<forall>i\<in>{0..k}. (f^2)$(Suc (Suc (Suc k)) - i) = 0"
               using f2_nth_simps(3) by auto
             hence
               "fps_left_inverse (f^2) 1 $ Suc (Suc (Suc k)) =
                 fps_left_inverse (f\<^sup>2) 1 $ Suc (Suc k) * of_nat 2 -
                 fps_left_inverse (f\<^sup>2) 1 $ Suc k"
               using sum.ub_add_nat f2_nth_simps(1,2) by simp
             also have "\<dots> = of_nat (2 * Suc (Suc (Suc k))) - of_nat (Suc (Suc k))"
               by (subst A, subst B) (simp add: invf2_def mult.commute)
             also have "\<dots> = of_nat (Suc (Suc (Suc k)) + 1)"
               by (subst times2[of "Suc (Suc (Suc k))"]) simp
             finally have
               "fps_left_inverse (f^2) 1 $ Suc (Suc (Suc k)) = invf2 $ Suc (Suc (Suc k))"
                by (simp add: invf2_def)
             with Suc show ?thesis by simp
           qed
           ultimately show ?thesis by simp
         qed
         ultimately show ?thesis by simp
       qed (simp add: invf2_def)
     qed
   qed
 
   moreover have "fps_right_inverse (f^2) 1 = fps_left_inverse (f^2) 1"
     by  (auto
           intro: fps_left_inverse_eq_fps_right_inverse[symmetric]
           simp: f_def power2_eq_square
         )
   ultimately show "fps_right_inverse (f^2) 1 = invf2"
     by simp
 
 qed
 
 lemma fps_one_over_one_minus_fps_X_squared':
   assumes "inverse (1::'a::{ring_1,inverse}) = 1"
   shows   "inverse ((1 - fps_X)^2 :: 'a  fps) = Abs_fps (\<lambda>n. of_nat (n+1))"
   using   assms fps_lr_one_over_one_minus_fps_X_squared(2)
   by      (simp add: fps_inverse_def power2_eq_square)
 
 lemma fps_one_over_one_minus_fps_X_squared:
   "inverse ((1 - fps_X)^2 :: 'a :: division_ring fps) = Abs_fps (\<lambda>n. of_nat (n+1))"
   by (rule fps_one_over_one_minus_fps_X_squared'[OF inverse_1])
 
 lemma fps_lr_inverse_fps_X_plus1:
   "fps_left_inverse (1 + fps_X) (1::'a::ring_1) = Abs_fps (\<lambda>n. (-1)^n)"
   "fps_right_inverse (1 + fps_X) (1::'a) = Abs_fps (\<lambda>n. (-1)^n)"
 proof-
 
   show "fps_left_inverse (1 + fps_X) (1::'a) = Abs_fps (\<lambda>n. (-1)^n)"
   proof (rule fps_ext)
     fix n show "fps_left_inverse (1 + fps_X) (1::'a) $ n = Abs_fps (\<lambda>n. (-1)^n) $ n"
     proof (induct n rule: nat_less_induct)
       case (1 n) show ?case
       proof (cases n)
         case (Suc m)
         have m: "n = Suc m" by fact
         from Suc 1 have
           A:  "fps_left_inverse (1 + fps_X) (1::'a) $ n =
                 - (\<Sum>i=0..m. (- 1)^i * (1 + fps_X) $ (Suc m - i))"
           by simp
         show ?thesis
         proof (cases m)
           case (Suc l)
           have "\<forall>i\<in>{0..l}. ((1::'a fps) + fps_X) $ (Suc (Suc l) - i) = 0" by auto
           with Suc A m show ?thesis by simp
         qed (simp add: m A)
       qed simp
     qed
   qed
 
   moreover have
     "fps_right_inverse (1 + fps_X) (1::'a) = fps_left_inverse (1 + fps_X) 1"
     by (intro fps_left_inverse_eq_fps_right_inverse[symmetric]) simp_all
   ultimately show "fps_right_inverse (1 + fps_X) (1::'a) = Abs_fps (\<lambda>n. (-1)^n)" by simp
 
 qed
 
 lemma fps_inverse_fps_X_plus1':
   assumes "inverse (1::'a::{ring_1,inverse}) = 1"
   shows   "inverse (1 + fps_X) = Abs_fps (\<lambda>n. (- (1::'a)) ^ n)"
   using   assms fps_lr_inverse_fps_X_plus1(2)
   by      (simp add: fps_inverse_def)
 
 lemma fps_inverse_fps_X_plus1:
   "inverse (1 + fps_X) = Abs_fps (\<lambda>n. (- (1::'a::division_ring)) ^ n)"
   by (rule fps_inverse_fps_X_plus1'[OF inverse_1])
 
 lemma subdegree_lr_inverse:
   fixes x :: "'a::{comm_monoid_add,mult_zero,uminus}"
   and   y :: "'b::{ab_group_add,mult_zero}"
   shows "subdegree (fps_left_inverse f x) = 0"
   and   "subdegree (fps_right_inverse g y) = 0"
 proof-
   show "subdegree (fps_left_inverse f x) = 0"
     using fps_lr_inverse_eq_0_iff(1) subdegree_eq_0_iff by fastforce
   show "subdegree (fps_right_inverse g y) = 0"
     using fps_lr_inverse_eq_0_iff(2) subdegree_eq_0_iff by fastforce
 qed
 
 lemma subdegree_inverse [simp]:
   fixes f :: "'a::{ab_group_add,inverse,mult_zero} fps"
   shows "subdegree (inverse f) = 0"
   using subdegree_lr_inverse(2)
   by    (simp add: fps_inverse_def)
 
 lemma fps_div_zero [simp]:
   "0 div (g :: 'a :: {comm_monoid_add,inverse,mult_zero,uminus} fps) = 0"
   by (simp add: fps_divide_def)
 
 lemma fps_div_by_zero':
   fixes   g :: "'a::{comm_monoid_add,inverse,mult_zero,uminus} fps"
   assumes "inverse (0::'a) = 0"
   shows   "g div 0 = 0"
   by      (simp add: fps_divide_def assms fps_inverse_zero')
 
 lemma fps_div_by_zero [simp]: "(g::'a::division_ring fps) div 0 = 0"
   by    (rule fps_div_by_zero'[OF inverse_zero])
 
 lemma fps_divide_unit': "subdegree g = 0 \<Longrightarrow> f div g = f * inverse g"
   by (simp add: fps_divide_def)
 
 lemma fps_divide_unit: "g$0 \<noteq> 0 \<Longrightarrow> f div g = f * inverse g"
   by (intro fps_divide_unit') (simp add: subdegree_eq_0_iff)
 
 lemma fps_divide_nth_0':
   "subdegree (g::'a::division_ring fps) = 0 \<Longrightarrow> (f div g) $ 0 = f $ 0 / (g $ 0)"
   by (simp add: fps_divide_unit' divide_inverse)
 
 lemma fps_divide_nth_0 [simp]:
   "g $ 0 \<noteq> 0 \<Longrightarrow> (f div g) $ 0 = f $ 0 / (g $ 0 :: _ :: division_ring)"
   by (simp add: fps_divide_nth_0')
 
 lemma fps_divide_nth_below:
   fixes f g :: "'a::{comm_monoid_add,uminus,mult_zero,inverse} fps"
   shows "n < subdegree f - subdegree g \<Longrightarrow> (f div g) $ n = 0"
   by    (simp add: fps_divide_def fps_mult_nth_eq0)
 
 lemma fps_divide_nth_base:
   fixes   f g :: "'a::division_ring fps"
   assumes "subdegree g \<le> subdegree f"
   shows   "(f div g) $ (subdegree f - subdegree g) = f $ subdegree f * inverse (g $ subdegree g)"
   by      (simp add: assms fps_divide_def fps_divide_unit')
 
 lemma fps_divide_subdegree_ge:
   fixes   f g :: "'a::{comm_monoid_add,uminus,mult_zero,inverse} fps"
   assumes "f / g \<noteq> 0"
   shows   "subdegree (f / g) \<ge> subdegree f - subdegree g"
   by      (intro subdegree_geI) (simp_all add: assms fps_divide_nth_below)
 
 lemma fps_divide_subdegree:
   fixes   f g :: "'a::division_ring fps"
   assumes "f \<noteq> 0" "g \<noteq> 0" "subdegree g \<le> subdegree f"
   shows   "subdegree (f / g) = subdegree f - subdegree g"
 proof (intro antisym)
   from assms have 1: "(f div g) $ (subdegree f - subdegree g) \<noteq> 0"
     using fps_divide_nth_base[of g f] by simp
   thus "subdegree (f / g) \<le> subdegree f - subdegree g" by (intro subdegree_leI) simp
   from 1 have "f / g \<noteq> 0" by (auto intro: fps_nonzeroI)
   thus "subdegree f - subdegree g \<le> subdegree (f / g)" by (rule fps_divide_subdegree_ge)
 qed
 
 lemma fps_divide_shift_numer:
   fixes   f g :: "'a::{inverse,comm_monoid_add,uminus,mult_zero} fps"
   assumes "n \<le> subdegree f"
   shows   "fps_shift n f / g = fps_shift n (f/g)"
   using   assms fps_shift_mult_right_noncomm[of n f "inverse (unit_factor g)"]
           fps_shift_fps_shift_reorder[of "subdegree g" n "f * inverse (unit_factor g)"]
   by      (simp add: fps_divide_def)
 
 lemma fps_divide_shift_denom:
   fixes   f g :: "'a::{inverse,comm_monoid_add,uminus,mult_zero} fps"
   assumes "n \<le> subdegree g" "subdegree g \<le> subdegree f"
   shows   "f / fps_shift n g = Abs_fps (\<lambda>k. if k<n then 0 else (f/g) $ (k-n))"
 proof (intro fps_ext)
   fix k
   from assms(1) have LHS:
     "(f / fps_shift n g) $ k = (f * inverse (unit_factor g)) $ (k + (subdegree g - n))"
     using fps_unit_factor_shift[of n g]
     by    (simp add: fps_divide_def)
   show "(f / fps_shift n g) $ k = Abs_fps (\<lambda>k. if k<n then 0 else (f/g) $ (k-n)) $ k"
   proof (cases "k<n")
     case True with assms LHS show ?thesis using fps_mult_nth_eq0[of _ f] by simp
   next
     case False
     hence "(f/g) $ (k-n) = (f * inverse (unit_factor g)) $ ((k-n) + subdegree g)"
       by (simp add: fps_divide_def)
     with False LHS assms(1) show ?thesis by auto
   qed
 qed
 
 lemma fps_divide_unit_factor_numer:
   fixes   f g :: "'a::{inverse,comm_monoid_add,uminus,mult_zero} fps"
   shows   "unit_factor f / g = fps_shift (subdegree f) (f/g)"
   by      (simp add: fps_divide_shift_numer)
 
 lemma fps_divide_unit_factor_denom:
   fixes   f g :: "'a::{inverse,comm_monoid_add,uminus,mult_zero} fps"
   assumes "subdegree g \<le> subdegree f"
   shows
     "f / unit_factor g = Abs_fps (\<lambda>k. if k<subdegree g then 0 else (f/g) $ (k-subdegree g))"
   by      (simp add: assms fps_divide_shift_denom)
 
 lemma fps_divide_unit_factor_both':
   fixes   f g :: "'a::{inverse,comm_monoid_add,uminus,mult_zero} fps"
   assumes "subdegree g \<le> subdegree f"
   shows   "unit_factor f / unit_factor g = fps_shift (subdegree f - subdegree g) (f / g)"
   using   assms fps_divide_unit_factor_numer[of f "unit_factor g"]
           fps_divide_unit_factor_denom[of g f]
           fps_shift_rev_shift(1)[of "subdegree g" "subdegree f" "f/g"]
   by      simp
 
 lemma fps_divide_unit_factor_both:
   fixes   f g :: "'a::division_ring fps"
   assumes "subdegree g \<le> subdegree f"
   shows   "unit_factor f / unit_factor g = unit_factor (f / g)"
   using   assms fps_divide_unit_factor_both'[of g f] fps_divide_subdegree[of f g]
   by      (cases "f=0 \<or> g=0") auto
 
 lemma fps_divide_self:
   "(f::'a::division_ring fps) \<noteq> 0 \<Longrightarrow> f / f = 1"
   using   fps_mult_right_inverse_unit_factor_divring[of f]
   by      (simp add: fps_divide_def)
 
 lemma fps_divide_add:
   fixes f g h :: "'a::{semiring_0,inverse,uminus} fps"
   shows "(f + g) / h = f / h + g / h"
   by    (simp add: fps_divide_def algebra_simps fps_shift_add)
 
 lemma fps_divide_diff:
   fixes f g h :: "'a::{ring,inverse} fps"
   shows "(f - g) / h = f / h - g / h"
   by    (simp add: fps_divide_def algebra_simps fps_shift_diff)
 
 lemma fps_divide_uminus:
   fixes f g h :: "'a::{ring,inverse} fps"
   shows "(- f) / g = - (f / g)"
   by    (simp add: fps_divide_def algebra_simps fps_shift_uminus)
 
 lemma fps_divide_uminus':
   fixes f g h :: "'a::division_ring fps"
   shows "f / (- g) = - (f / g)"
   by (simp add: fps_divide_def fps_unit_factor_uminus fps_shift_uminus)
 
 lemma fps_divide_times:
   fixes   f g h :: "'a::{semiring_0,inverse,uminus} fps"
   assumes "subdegree h \<le> subdegree g"
   shows   "(f * g) / h = f * (g / h)"
   using   assms fps_mult_subdegree_ge[of g "inverse (unit_factor h)"]
           fps_shift_mult[of "subdegree h" "g * inverse (unit_factor h)" f]
   by      (fastforce simp add: fps_divide_def mult.assoc)
 
 lemma fps_divide_times2:
   fixes   f g h :: "'a::{comm_semiring_0,inverse,uminus} fps"
   assumes "subdegree h \<le> subdegree f"
   shows   "(f * g) / h = (f / h) * g"
   using   assms fps_divide_times[of h f g]
   by      (simp add: mult.commute)
 
 lemma fps_times_divide_eq:
   fixes   f g :: "'a::field fps"
   assumes "g \<noteq> 0" and "subdegree f \<ge> subdegree g"
   shows   "f div g * g = f"
   using   assms fps_divide_times2[of g f g]
   by      (simp add: fps_divide_times fps_divide_self)
 
 lemma fps_divide_times_eq:
   "(g :: 'a::division_ring fps) \<noteq> 0 \<Longrightarrow> (f * g) div g = f"
   by (simp add: fps_divide_times fps_divide_self)
 
 lemma fps_divide_by_mult':
   fixes   f g h :: "'a :: division_ring fps"
   assumes "subdegree h \<le> subdegree f"
   shows   "f / (g * h) = f / h / g"
 proof (cases "f=0 \<or> g=0 \<or> h=0")
   case False with assms show ?thesis
     using fps_unit_factor_mult[of g h]
     by    (auto simp:
             fps_divide_def fps_shift_fps_shift fps_inverse_mult_divring mult.assoc
             fps_shift_mult_right_noncomm
           )
 qed auto
 
 lemma fps_divide_by_mult:
   fixes   f g h :: "'a :: field fps"
   assumes "subdegree g \<le> subdegree f"
   shows   "f / (g * h) = f / g / h"
 proof-
   have "f / (g * h) = f / (h * g)" by (simp add: mult.commute)
   also have "\<dots> = f / g / h" using fps_divide_by_mult'[OF assms] by simp
   finally show ?thesis by simp
 qed
 
 lemma fps_divide_cancel:
   fixes   f g h :: "'a :: division_ring fps"
   shows "h \<noteq> 0 \<Longrightarrow> (f * h) div (g * h) = f div g"
   by    (cases "f=0")
         (auto simp: fps_divide_by_mult' fps_divide_times_eq)
 
 lemma fps_divide_1':
   fixes   a :: "'a::{comm_monoid_add,inverse,mult_zero,uminus,zero_neq_one,monoid_mult} fps"
   assumes "inverse (1::'a) = 1"
   shows   "a / 1 = a"
   using   assms fps_inverse_one' fps_one_mult(2)[of a]
   by      (force simp: fps_divide_def)
 
 lemma fps_divide_1 [simp]: "(a :: 'a::division_ring fps) / 1 = a"
   by (rule fps_divide_1'[OF inverse_1])
 
 lemma fps_divide_X':
   fixes   f :: "'a::{comm_monoid_add,inverse,mult_zero,uminus,zero_neq_one,monoid_mult} fps"
   assumes "inverse (1::'a) = 1"
   shows   "f / fps_X = fps_shift 1 f"
   using   assms fps_one_mult(2)[of f]
   by      (simp add: fps_divide_def fps_X_unit_factor fps_inverse_one')
 
 lemma fps_divide_X [simp]: "a / fps_X = fps_shift 1 (a::'a::division_ring fps)"
   by (rule fps_divide_X'[OF inverse_1])
 
 lemma fps_divide_X_power':
   fixes   f :: "'a::{semiring_1,inverse,uminus} fps"
   assumes "inverse (1::'a) = 1"
   shows   "f / (fps_X ^ n) = fps_shift n f"
   using   fps_inverse_one'[OF assms] fps_one_mult(2)[of f]
   by      (simp add: fps_divide_def fps_X_power_subdegree)
 
 lemma fps_divide_X_power [simp]: "a / (fps_X ^ n) = fps_shift n (a::'a::division_ring fps)"
   by (rule fps_divide_X_power'[OF inverse_1])
 
 lemma fps_divide_shift_denom_conv_times_fps_X_power:
   fixes   f g :: "'a::{semiring_1,inverse,uminus} fps"
   assumes "n \<le> subdegree g" "subdegree g \<le> subdegree f"
   shows   "f / fps_shift n g = f / g * fps_X ^ n"
   using   assms
   by      (intro fps_ext) (simp_all add: fps_divide_shift_denom fps_X_power_mult_right_nth)
 
 lemma fps_divide_unit_factor_denom_conv_times_fps_X_power:
   fixes   f g :: "'a::{semiring_1,inverse,uminus} fps"
   assumes "subdegree g \<le> subdegree f"
   shows   "f / unit_factor g = f / g * fps_X ^ subdegree g"
   by      (simp add: assms fps_divide_shift_denom_conv_times_fps_X_power)
 
 lemma fps_shift_altdef':
   fixes   f :: "'a::{semiring_1,inverse,uminus} fps"
   assumes "inverse (1::'a) = 1"
   shows   "fps_shift n f = f div fps_X^n"
   using   assms 
   by      (simp add:
             fps_divide_def fps_X_power_subdegree fps_X_power_unit_factor fps_inverse_one'
           )
 
 lemma fps_shift_altdef:
   "fps_shift n f = (f :: 'a :: division_ring fps) div fps_X^n"
   by (rule fps_shift_altdef'[OF inverse_1])
 
 lemma fps_div_fps_X_power_nth':
   fixes   f :: "'a::{semiring_1,inverse,uminus} fps"
   assumes "inverse (1::'a) = 1"
   shows   "(f div fps_X^n) $ k = f $ (k + n)"
   using   assms
   by      (simp add: fps_shift_altdef' [symmetric])
 
 lemma fps_div_fps_X_power_nth: "((f :: 'a :: division_ring fps) div fps_X^n) $ k = f $ (k + n)"
   by (rule fps_div_fps_X_power_nth'[OF inverse_1])
 
 lemma fps_div_fps_X_nth':
   fixes   f :: "'a::{semiring_1,inverse,uminus} fps"
   assumes "inverse (1::'a) = 1"
   shows   "(f div fps_X) $ k = f $ Suc k"
   using   assms fps_div_fps_X_power_nth'[of f 1]
   by      simp
 
 lemma fps_div_fps_X_nth: "((f :: 'a :: division_ring fps) div fps_X) $ k = f $ Suc k"
   by (rule fps_div_fps_X_nth'[OF inverse_1])
 
 lemma divide_fps_const':
   fixes c :: "'a :: {inverse,comm_monoid_add,uminus,mult_zero}"
   shows   "f / fps_const c = f * fps_const (inverse c)"
   by      (simp add: fps_divide_def fps_const_inverse)
 
 lemma divide_fps_const [simp]:
   fixes c :: "'a :: {comm_semiring_0,inverse,uminus}"
   shows "f / fps_const c = fps_const (inverse c) * f"
   by    (simp add: divide_fps_const' mult.commute)
 
 lemma fps_const_divide: "fps_const (x :: _ :: division_ring) / fps_const y = fps_const (x / y)"
   by (simp add: fps_divide_def fps_const_inverse divide_inverse)
 
 lemma fps_numeral_divide_divide:
   "x / numeral b / numeral c = (x / numeral (b * c) :: 'a :: field fps)"
   by (simp add: fps_divide_by_mult[symmetric])
 
 lemma fps_numeral_mult_divide:
   "numeral b * x / numeral c = (numeral b / numeral c * x :: 'a :: field fps)"
   by (simp add: fps_divide_times2)
 
 lemmas fps_numeral_simps = 
   fps_numeral_divide_divide fps_numeral_mult_divide inverse_fps_numeral neg_numeral_fps_const
 
 lemma fps_is_left_unit_iff_zeroth_is_left_unit:
   fixes f :: "'a :: ring_1 fps"
   shows "(\<exists>g. 1 = f * g) \<longleftrightarrow> (\<exists>k. 1 = f$0 * k)"
 proof
   assume "\<exists>g. 1 = f * g"
   then obtain g where "1 = f * g" by fast
   hence "1 = f$0 * g$0" using fps_mult_nth_0[of f g] by simp
   thus "\<exists>k. 1 = f$0 * k" by auto
 next
   assume "\<exists>k. 1 = f$0 * k"
   then obtain k where "1 = f$0 * k" by fast
   hence "1 = f * fps_right_inverse f k"
     using fps_right_inverse by simp
   thus "\<exists>g. 1 = f * g" by fast
 qed
 
 lemma fps_is_right_unit_iff_zeroth_is_right_unit:
   fixes f :: "'a :: ring_1 fps"
   shows "(\<exists>g. 1 = g * f) \<longleftrightarrow> (\<exists>k. 1 = k * f$0)"
 proof
   assume "\<exists>g. 1 = g * f"
   then obtain g where "1 = g * f" by fast
   hence "1 = g$0 * f$0" using fps_mult_nth_0[of g f] by simp
   thus "\<exists>k. 1 = k * f$0" by auto
 next
   assume "\<exists>k. 1 = k * f$0"
   then obtain k where "1 = k * f$0" by fast
   hence "1 = fps_left_inverse f k * f"
     using fps_left_inverse by simp
   thus "\<exists>g. 1 = g * f" by fast
 qed
 
 lemma fps_is_unit_iff [simp]: "(f :: 'a :: field fps) dvd 1 \<longleftrightarrow> f $ 0 \<noteq> 0"
 proof
   assume "f dvd 1"
   then obtain g where "1 = f * g" by (elim dvdE)
   from this[symmetric] have "(f*g) $ 0 = 1" by simp
   thus "f $ 0 \<noteq> 0" by auto
 next
   assume A: "f $ 0 \<noteq> 0"
   thus "f dvd 1" by (simp add: inverse_mult_eq_1[OF A, symmetric])
 qed
 
 lemma subdegree_eq_0_left:
   fixes   f :: "'a::{comm_monoid_add,zero_neq_one,mult_zero} fps"
   assumes "\<exists>g. 1 = f * g"
   shows   "subdegree f = 0"
 proof (intro subdegree_eq_0)
   from assms obtain g where "1 = f * g" by fast
   hence "f$0 * g$0 = 1" using fps_mult_nth_0[of f g] by simp
   thus "f$0 \<noteq> 0" by auto
 qed
 
 lemma subdegree_eq_0_right:
   fixes   f :: "'a::{comm_monoid_add,zero_neq_one,mult_zero} fps"
   assumes "\<exists>g. 1 = g * f"
   shows   "subdegree f = 0"
 proof (intro subdegree_eq_0)
   from assms obtain g where "1 = g * f" by fast
   hence "g$0 * f$0 = 1" using fps_mult_nth_0[of g f] by simp
   thus "f$0 \<noteq> 0" by auto
 qed
 
 lemma subdegree_eq_0' [simp]: "(f :: 'a :: field fps) dvd 1 \<Longrightarrow> subdegree f = 0"
   by simp
 
 lemma fps_dvd1_left_trivial_unit_factor:
   fixes   f :: "'a::{comm_monoid_add, zero_neq_one, mult_zero} fps"
   assumes "\<exists>g. 1 = f * g"
   shows   "unit_factor f = f"
   using   assms subdegree_eq_0_left
   by      fastforce
 
 lemma fps_dvd1_right_trivial_unit_factor:
   fixes   f :: "'a::{comm_monoid_add, zero_neq_one, mult_zero} fps"
   assumes "\<exists>g. 1 = g * f"
   shows   "unit_factor f = f"
   using   assms subdegree_eq_0_right
   by      fastforce
 
 lemma fps_dvd1_trivial_unit_factor:
   "(f :: 'a::comm_semiring_1 fps) dvd 1 \<Longrightarrow> unit_factor f = f"
   unfolding dvd_def by (rule fps_dvd1_left_trivial_unit_factor) simp
 
 lemma fps_unit_dvd_left:
   fixes   f :: "'a :: division_ring fps"
   assumes "f $ 0 \<noteq> 0"
   shows   "\<exists>g. 1 = f * g"
   using   assms fps_is_left_unit_iff_zeroth_is_left_unit right_inverse
   by      fastforce
 
 lemma fps_unit_dvd_right:
   fixes   f :: "'a :: division_ring fps"
   assumes "f $ 0 \<noteq> 0"
   shows   "\<exists>g. 1 = g * f"
   using   assms fps_is_right_unit_iff_zeroth_is_right_unit left_inverse
   by      fastforce
 
 lemma fps_unit_dvd [simp]: "(f $ 0 :: 'a :: field) \<noteq> 0 \<Longrightarrow> f dvd g"
   using fps_unit_dvd_left dvd_trans[of f 1] by simp
 
 lemma dvd_left_imp_subdegree_le:
   fixes   f g :: "'a::{comm_monoid_add,mult_zero} fps"
   assumes "\<exists>k. g = f * k" "g \<noteq> 0"
   shows   "subdegree f \<le> subdegree g"
   using   assms fps_mult_subdegree_ge
   by      fastforce
 
 lemma dvd_right_imp_subdegree_le:
   fixes   f g :: "'a::{comm_monoid_add,mult_zero} fps"
   assumes "\<exists>k. g = k * f" "g \<noteq> 0"
   shows   "subdegree f \<le> subdegree g"
   using   assms fps_mult_subdegree_ge
   by      fastforce
 
 lemma dvd_imp_subdegree_le:
   "f dvd g \<Longrightarrow> g \<noteq> 0 \<Longrightarrow> subdegree f \<le> subdegree g"
   using dvd_left_imp_subdegree_le by fast
 
 lemma subdegree_le_imp_dvd_left_ring1:
   fixes   f g :: "'a :: ring_1 fps"
   assumes "\<exists>y. f $ subdegree f * y = 1" "subdegree f \<le> subdegree g"
   shows   "\<exists>k. g = f * k"
 proof-
   define h :: "'a fps" where "h \<equiv> fps_X ^ (subdegree g - subdegree f)"
   from assms(1) obtain y where "f $ subdegree f * y = 1" by fast
   hence "unit_factor f $ 0 * y = 1" by simp
   from this obtain k where "1 = unit_factor f * k"
     using fps_is_left_unit_iff_zeroth_is_left_unit[of "unit_factor f"] by auto
   hence "fps_X ^ subdegree f = fps_X ^ subdegree f * unit_factor f * k"
     by (simp add: mult.assoc)
   moreover have "fps_X ^ subdegree f * unit_factor f = f"
     by (rule fps_unit_factor_decompose'[symmetric])
   ultimately have
     "fps_X ^ (subdegree f + (subdegree g - subdegree f)) = f * k * h"
     by (simp add: power_add h_def)
   hence "g = f * (k * h * unit_factor g)"
     using fps_unit_factor_decompose'[of g]
     by    (simp add: assms(2) mult.assoc)
   thus ?thesis by fast
 qed
 
 lemma subdegree_le_imp_dvd_left_divring:
   fixes   f g :: "'a :: division_ring fps"
   assumes "f \<noteq> 0" "subdegree f \<le> subdegree g"
   shows   "\<exists>k. g = f * k"
 proof (intro subdegree_le_imp_dvd_left_ring1)
   from assms(1) have "f $ subdegree f \<noteq> 0" by simp
   thus "\<exists>y. f $ subdegree f * y = 1" using right_inverse by blast
 qed (rule assms(2))
 
 lemma subdegree_le_imp_dvd_right_ring1:
   fixes   f g :: "'a :: ring_1 fps"
   assumes "\<exists>x. x * f $ subdegree f = 1" "subdegree f \<le> subdegree g"
   shows   "\<exists>k. g = k * f"
 proof-
   define h :: "'a fps" where "h \<equiv> fps_X ^ (subdegree g - subdegree f)"
   from assms(1) obtain x where "x * f $ subdegree f = 1" by fast
   hence "x * unit_factor f $ 0 = 1" by simp
   from this obtain k where "1 = k * unit_factor f"
     using fps_is_right_unit_iff_zeroth_is_right_unit[of "unit_factor f"] by auto
   hence "fps_X ^ subdegree f = k * (unit_factor f * fps_X ^ subdegree f)"
     by (simp add: mult.assoc[symmetric])
   moreover have "unit_factor f * fps_X ^ subdegree f = f"
     by (rule fps_unit_factor_decompose[symmetric])
   ultimately have "fps_X ^ (subdegree g - subdegree f + subdegree f) = h * k * f"
     by (simp add: power_add h_def mult.assoc)
   hence "g = unit_factor g * h * k * f"
     using fps_unit_factor_decompose[of g]
     by    (simp add: assms(2) mult.assoc)
   thus ?thesis by fast
 qed
 
 lemma subdegree_le_imp_dvd_right_divring:
   fixes   f g :: "'a :: division_ring fps"
   assumes "f \<noteq> 0" "subdegree f \<le> subdegree g"
   shows   "\<exists>k. g = k * f"
 proof (intro subdegree_le_imp_dvd_right_ring1)
   from assms(1) have "f $ subdegree f \<noteq> 0" by simp
   thus "\<exists>x. x * f $ subdegree f = 1" using left_inverse by blast
 qed (rule assms(2))
 
 lemma fps_dvd_iff:
   assumes "(f :: 'a :: field fps) \<noteq> 0" "g \<noteq> 0"
   shows   "f dvd g \<longleftrightarrow> subdegree f \<le> subdegree g"
 proof
   assume "subdegree f \<le> subdegree g"
   with assms show "f dvd g"
     using subdegree_le_imp_dvd_left_divring
     by    (auto intro: dvdI)
 qed (simp add: assms dvd_imp_subdegree_le)
 
 lemma subdegree_div':
   fixes   p q :: "'a::division_ring fps"
   assumes "\<exists>k. p = k * q"
   shows   "subdegree (p div q) = subdegree p - subdegree q"
 proof (cases "p = 0")
   case False
   from assms(1) obtain k where k: "p = k * q" by blast
   with False have "subdegree (p div q) = subdegree k" by (simp add: fps_divide_times_eq)
   moreover have "k $ subdegree k * q $ subdegree q \<noteq> 0"
   proof
     assume "k $ subdegree k * q $ subdegree q = 0"
     hence "k $ subdegree k * q $ subdegree q * inverse (q $ subdegree q) = 0" by simp
     with False k show False by (simp add: mult.assoc)
   qed
   ultimately show ?thesis by (simp add: k subdegree_mult')
 qed simp
 
 lemma subdegree_div:
   fixes     p q :: "'a :: field fps"
   assumes   "q dvd p"
   shows     "subdegree (p div q) = subdegree p - subdegree q"
   using     assms
   unfolding dvd_def
   by        (auto intro: subdegree_div')
 
 lemma subdegree_div_unit':
   fixes   p q :: "'a :: {ab_group_add,mult_zero,inverse} fps"
   assumes "q $ 0 \<noteq> 0" "p $ subdegree p * inverse (q $ 0) \<noteq> 0"
   shows   "subdegree (p div q) = subdegree p"
   using   assms subdegree_mult'[of p "inverse q"]
   by      (auto simp add: fps_divide_unit)
 
 lemma subdegree_div_unit'':
   fixes   p q :: "'a :: {ring_no_zero_divisors,inverse} fps"
   assumes "q $ 0 \<noteq> 0" "inverse (q $ 0) \<noteq> 0"
   shows   "subdegree (p div q) = subdegree p"
   by      (cases "p = 0") (auto intro: subdegree_div_unit' simp: assms)
 
 lemma subdegree_div_unit:
   fixes   p q :: "'a :: division_ring fps"
   assumes "q $ 0 \<noteq> 0"
   shows   "subdegree (p div q) = subdegree p"
   by      (intro subdegree_div_unit'') (simp_all add: assms)
 
 instantiation fps :: ("{comm_semiring_1,inverse,uminus}") modulo
 begin
 
 definition fps_mod_def:
   "f mod g = (if g = 0 then f else
      let h = unit_factor g in  fps_cutoff (subdegree g) (f * inverse h) * h)"
 
 instance ..
 
 end
 
 lemma fps_mod_zero [simp]:
   "(f::'a::{comm_semiring_1,inverse,uminus} fps) mod 0 = f"
   by (simp add: fps_mod_def)
 
 lemma fps_mod_eq_zero:
   assumes "g \<noteq> 0" and "subdegree f \<ge> subdegree g"
   shows   "f mod g = 0"
 proof (cases "f * inverse (unit_factor g) = 0")
   case False
   have "fps_cutoff (subdegree g) (f * inverse (unit_factor g)) = 0"
     using False assms(2) fps_mult_subdegree_ge fps_cutoff_zero_iff by force
   with assms(1) show ?thesis by (simp add: fps_mod_def Let_def)
 qed (simp add: assms fps_mod_def)
 
 lemma fps_mod_unit [simp]: "g$0 \<noteq> 0 \<Longrightarrow> f mod g = 0"
   by (intro fps_mod_eq_zero) auto
 
 lemma subdegree_mod:
   assumes "subdegree (f::'a::field fps) < subdegree g"
   shows   "subdegree (f mod g) = subdegree f"
 proof (cases "f = 0")
   case False
   with assms show ?thesis
     by  (intro subdegreeI)
         (auto simp: inverse_mult_eq_1 fps_mod_def Let_def fps_cutoff_left_mult_nth mult.assoc)
 qed (simp add: fps_mod_def)
 
 instance fps :: (field) idom_modulo
 proof
 
   fix f g :: "'a fps"
 
   define n where "n = subdegree g"
   define h where "h = f * inverse (unit_factor g)"
 
   show "f div g * g + f mod g = f"
   proof (cases "g = 0")
     case False
     with n_def h_def have
       "f div g * g + f mod g = (fps_shift n h * fps_X ^ n + fps_cutoff n h) * unit_factor g"
       by (simp add: fps_divide_def fps_mod_def Let_def subdegree_decompose algebra_simps)
     with False show ?thesis
       by (simp add: fps_shift_cutoff h_def inverse_mult_eq_1)
   qed auto
 
 qed (rule fps_divide_times_eq, simp_all add: fps_divide_def)
 
 instantiation fps :: (field) normalization_semidom_multiplicative
 begin
 
 definition fps_normalize_def [simp]:
   "normalize f = (if f = 0 then 0 else fps_X ^ subdegree f)"
 
 instance proof
   fix f g :: "'a fps"
   assume "is_unit f"
   thus "unit_factor (f * g) = f * unit_factor g"
     using fps_unit_factor_mult[of f g] by simp
 next
   fix f g :: "'a fps"
   show "unit_factor f * normalize f = f"
     by (simp add: fps_shift_times_fps_X_power)
 next
   fix f g :: "'a fps"
   show "unit_factor (f * g) = unit_factor f * unit_factor g"
     using fps_unit_factor_mult[of f g] by simp
 qed (simp_all add: fps_divide_def Let_def)
 
 end
 
 
 subsection \<open>Formal power series form a Euclidean ring\<close>
 
 instantiation fps :: (field) euclidean_ring_cancel
 begin
 
 definition fps_euclidean_size_def:
   "euclidean_size f = (if f = 0 then 0 else 2 ^ subdegree f)"
 
 instance proof
   fix f g :: "'a fps" assume [simp]: "g \<noteq> 0"
   show "euclidean_size f \<le> euclidean_size (f * g)"
     by (cases "f = 0") (simp_all add: fps_euclidean_size_def)
   show "euclidean_size (f mod g) < euclidean_size g"
   proof (cases "f = 0")
     case True
     then show ?thesis
       by (simp add: fps_euclidean_size_def)
   next
     case False
     then show ?thesis 
       using le_less_linear[of "subdegree g" "subdegree f"]
       by (force simp add: fps_mod_eq_zero fps_euclidean_size_def subdegree_mod)
   qed
 next
   fix f g h :: "'a fps" assume [simp]: "h \<noteq> 0"
   show "(h * f) div (h * g) = f div g"
     by (simp add: fps_divide_cancel mult.commute)
   show "(f + g * h) div h = g + f div h"
     by (simp add: fps_divide_add fps_divide_times_eq)
 qed (simp add: fps_euclidean_size_def)
 
 end
 
 instance fps :: (field) normalization_euclidean_semiring ..
 
 instantiation fps :: (field) euclidean_ring_gcd
 begin
 definition fps_gcd_def: "(gcd :: 'a fps \<Rightarrow> _) = Euclidean_Algorithm.gcd"
 definition fps_lcm_def: "(lcm :: 'a fps \<Rightarrow> _) = Euclidean_Algorithm.lcm"
 definition fps_Gcd_def: "(Gcd :: 'a fps set \<Rightarrow> _) = Euclidean_Algorithm.Gcd"
 definition fps_Lcm_def: "(Lcm :: 'a fps set \<Rightarrow> _) = Euclidean_Algorithm.Lcm"
 instance by standard (simp_all add: fps_gcd_def fps_lcm_def fps_Gcd_def fps_Lcm_def)
 end
 
 lemma fps_gcd:
   assumes [simp]: "f \<noteq> 0" "g \<noteq> 0"
   shows   "gcd f g = fps_X ^ min (subdegree f) (subdegree g)"
 proof -
   let ?m = "min (subdegree f) (subdegree g)"
   show "gcd f g = fps_X ^ ?m"
   proof (rule sym, rule gcdI)
     fix d assume "d dvd f" "d dvd g"
     thus "d dvd fps_X ^ ?m" by (cases "d = 0") (simp_all add: fps_dvd_iff)
   qed (simp_all add: fps_dvd_iff)
 qed
 
 lemma fps_gcd_altdef: "gcd f g =
   (if f = 0 \<and> g = 0 then 0 else
    if f = 0 then fps_X ^ subdegree g else
    if g = 0 then fps_X ^ subdegree f else
      fps_X ^ min (subdegree f) (subdegree g))"
   by (simp add: fps_gcd)
 
 lemma fps_lcm:
   assumes [simp]: "f \<noteq> 0" "g \<noteq> 0"
   shows   "lcm f g = fps_X ^ max (subdegree f) (subdegree g)"
 proof -
   let ?m = "max (subdegree f) (subdegree g)"
   show "lcm f g = fps_X ^ ?m"
   proof (rule sym, rule lcmI)
     fix d assume "f dvd d" "g dvd d"
     thus "fps_X ^ ?m dvd d" by (cases "d = 0") (simp_all add: fps_dvd_iff)
   qed (simp_all add: fps_dvd_iff)
 qed
 
 lemma fps_lcm_altdef: "lcm f g =
   (if f = 0 \<or> g = 0 then 0 else fps_X ^ max (subdegree f) (subdegree g))"
   by (simp add: fps_lcm)
 
 lemma fps_Gcd:
   assumes "A - {0} \<noteq> {}"
   shows   "Gcd A = fps_X ^ (INF f\<in>A-{0}. subdegree f)"
 proof (rule sym, rule GcdI)
   fix f assume "f \<in> A"
   thus "fps_X ^ (INF f\<in>A - {0}. subdegree f) dvd f"
     by (cases "f = 0") (auto simp: fps_dvd_iff intro!: cINF_lower)
 next
   fix d assume d: "\<And>f. f \<in> A \<Longrightarrow> d dvd f"
   from assms obtain f where "f \<in> A - {0}" by auto
   with d[of f] have [simp]: "d \<noteq> 0" by auto
   from d assms have "subdegree d \<le> (INF f\<in>A-{0}. subdegree f)"
     by (intro cINF_greatest) (simp_all add: fps_dvd_iff[symmetric])
   with d assms show "d dvd fps_X ^ (INF f\<in>A-{0}. subdegree f)" by (simp add: fps_dvd_iff)
 qed simp_all
 
 lemma fps_Gcd_altdef: "Gcd A =
   (if A \<subseteq> {0} then 0 else fps_X ^ (INF f\<in>A-{0}. subdegree f))"
   using fps_Gcd by auto
 
 lemma fps_Lcm:
   assumes "A \<noteq> {}" "0 \<notin> A" "bdd_above (subdegree`A)"
   shows   "Lcm A = fps_X ^ (SUP f\<in>A. subdegree f)"
 proof (rule sym, rule LcmI)
   fix f assume "f \<in> A"
   moreover from assms(3) have "bdd_above (subdegree ` A)" by auto
   ultimately show "f dvd fps_X ^ (SUP f\<in>A. subdegree f)" using assms(2)
     by (cases "f = 0") (auto simp: fps_dvd_iff intro!: cSUP_upper)
 next
   fix d assume d: "\<And>f. f \<in> A \<Longrightarrow> f dvd d"
   from assms obtain f where f: "f \<in> A" "f \<noteq> 0" by auto
   show "fps_X ^ (SUP f\<in>A. subdegree f) dvd d"
   proof (cases "d = 0")
     assume "d \<noteq> 0"
     moreover from d have "\<And>f. f \<in> A \<Longrightarrow> f \<noteq> 0 \<Longrightarrow> f dvd d" by blast
     ultimately have "subdegree d \<ge> (SUP f\<in>A. subdegree f)" using assms
       by (intro cSUP_least) (auto simp: fps_dvd_iff)
     with \<open>d \<noteq> 0\<close> show ?thesis by (simp add: fps_dvd_iff)
   qed simp_all
 qed simp_all
 
 lemma fps_Lcm_altdef:
   "Lcm A =
      (if 0 \<in> A \<or> \<not>bdd_above (subdegree`A) then 0 else
       if A = {} then 1 else fps_X ^ (SUP f\<in>A. subdegree f))"
 proof (cases "bdd_above (subdegree`A)")
   assume unbounded: "\<not>bdd_above (subdegree`A)"
   have "Lcm A = 0"
   proof (rule ccontr)
     assume "Lcm A \<noteq> 0"
     from unbounded obtain f where f: "f \<in> A" "subdegree (Lcm A) < subdegree f"
       unfolding bdd_above_def by (auto simp: not_le)
     moreover from f and \<open>Lcm A \<noteq> 0\<close> have "subdegree f \<le> subdegree (Lcm A)"
       by (intro dvd_imp_subdegree_le dvd_Lcm) simp_all
     ultimately show False by simp
   qed
   with unbounded show ?thesis by simp
 qed (simp_all add: fps_Lcm Lcm_eq_0_I)
 
 
 
 subsection \<open>Formal Derivatives, and the MacLaurin theorem around 0\<close>
 
 definition "fps_deriv f = Abs_fps (\<lambda>n. of_nat (n + 1) * f $ (n + 1))"
 
 lemma fps_deriv_nth[simp]: "fps_deriv f $ n = of_nat (n + 1) * f $ (n + 1)"
   by (simp add: fps_deriv_def)
 
 lemma fps_0th_higher_deriv: 
   "(fps_deriv ^^ n) f $ 0 = fact n * f $ n"
   by  (induction n arbitrary: f)
       (simp_all add: funpow_Suc_right mult_of_nat_commute algebra_simps del: funpow.simps)
 
 lemma fps_deriv_mult[simp]:
   "fps_deriv (f * g) = f * fps_deriv g + fps_deriv f * g"
 proof (intro fps_ext)
   fix n
   have LHS: "fps_deriv (f * g) $ n = (\<Sum>i=0..Suc n. of_nat (n+1) * f$i * g$(Suc n - i))"
     by (simp add: fps_mult_nth sum_distrib_left algebra_simps)
 
   have "\<forall>i\<in>{1..n}. n - (i - 1) = n - i + 1" by auto
   moreover have
     "(\<Sum>i=0..n. of_nat (i+1) * f$(i+1) * g$(n - i)) =
       (\<Sum>i=1..Suc n. of_nat i * f$i * g$(n - (i - 1)))"
     by (intro sum.reindex_bij_witness[where i="\<lambda>x. x-1" and j="\<lambda>x. x+1"]) auto
   ultimately have
     "(f * fps_deriv g + fps_deriv f * g) $ n =
       of_nat (Suc n) * f$0 * g$(Suc n) +
       (\<Sum>i=1..n. (of_nat (n - i + 1) + of_nat i) * f $ i * g $ (n - i + 1)) +
           of_nat (Suc n) * f$(Suc n) * g$0"
     by (simp add: fps_mult_nth algebra_simps mult_of_nat_commute sum.atLeast_Suc_atMost sum.distrib)
   moreover have
     "\<forall>i\<in>{1..n}.
       (of_nat (n - i + 1) + of_nat i) * f $ i * g $ (n - i + 1) =
       of_nat (n + 1) * f $ i * g $ (Suc n - i)"
   proof
     fix i assume i: "i \<in> {1..n}"
     from i have "of_nat (n - i + 1) + (of_nat i :: 'a) = of_nat (n + 1)"
       using of_nat_add[of "n-i+1" i,symmetric] by simp
     moreover from i have "Suc n - i = n - i + 1" by auto
     ultimately show "(of_nat (n - i + 1) + of_nat i) * f $ i * g $ (n - i + 1) =
             of_nat (n + 1) * f $ i * g $ (Suc n - i)"
       by simp
   qed
   ultimately have
     "(f * fps_deriv g + fps_deriv f * g) $ n =
       (\<Sum>i=0..Suc n. of_nat (Suc n) * f $ i * g $ (Suc n - i))"
     by (simp add: sum.atLeast_Suc_atMost)
   with LHS show "fps_deriv (f * g) $ n = (f * fps_deriv g + fps_deriv f * g) $ n"
     by simp
 qed
 
 lemma fps_deriv_fps_X[simp]: "fps_deriv fps_X = 1"
   by (simp add: fps_deriv_def fps_X_def fps_eq_iff)
 
 lemma fps_deriv_neg[simp]:
   "fps_deriv (- (f:: 'a::ring_1 fps)) = - (fps_deriv f)"
   by (simp add: fps_eq_iff fps_deriv_def)
 
 lemma fps_deriv_add[simp]: "fps_deriv (f + g) = fps_deriv f + fps_deriv g"
   by (auto intro: fps_ext simp: algebra_simps)
 
 lemma fps_deriv_sub[simp]:
   "fps_deriv ((f:: 'a::ring_1 fps) - g) = fps_deriv f - fps_deriv g"
   using fps_deriv_add [of f "- g"] by simp
 
 lemma fps_deriv_const[simp]: "fps_deriv (fps_const c) = 0"
   by (simp add: fps_ext fps_deriv_def fps_const_def)
 
 lemma fps_deriv_of_nat [simp]: "fps_deriv (of_nat n) = 0"
   by (simp add: fps_of_nat [symmetric])
 
 lemma fps_deriv_of_int [simp]: "fps_deriv (of_int n) = 0"
   by (simp add: fps_of_int [symmetric])
 
 lemma fps_deriv_numeral [simp]: "fps_deriv (numeral n) = 0"
   by (simp add: numeral_fps_const)    
 
 lemma fps_deriv_mult_const_left[simp]:
   "fps_deriv (fps_const c * f) = fps_const c * fps_deriv f"
   by simp
 
 lemma fps_deriv_linear[simp]:
   "fps_deriv (fps_const a * f + fps_const b * g) =
     fps_const a * fps_deriv f + fps_const b * fps_deriv g"
   by simp
 
 lemma fps_deriv_0[simp]: "fps_deriv 0 = 0"
   by (simp add: fps_deriv_def fps_eq_iff)
 
 lemma fps_deriv_1[simp]: "fps_deriv 1 = 0"
   by (simp add: fps_deriv_def fps_eq_iff)
 
 lemma fps_deriv_mult_const_right[simp]:
   "fps_deriv (f * fps_const c) = fps_deriv f * fps_const c"
   by simp
 
 lemma fps_deriv_sum:
   "fps_deriv (sum f S) = sum (\<lambda>i. fps_deriv (f i)) S"
 proof (cases "finite S")
   case False
   then show ?thesis by simp
 next
   case True
   show ?thesis by (induct rule: finite_induct [OF True]) simp_all
 qed
 
 lemma fps_deriv_eq_0_iff [simp]:
   "fps_deriv f = 0 \<longleftrightarrow> f = fps_const (f$0 :: 'a::{semiring_no_zero_divisors,semiring_char_0})"
 proof
   assume f: "fps_deriv f = 0"
   show "f = fps_const (f$0)"
   proof (intro fps_ext)
     fix n show "f $ n = fps_const (f$0) $ n"
     proof (cases n)
       case (Suc m)
       have "(of_nat (Suc m) :: 'a) \<noteq> 0" by (rule of_nat_neq_0)
       with f Suc show ?thesis using fps_deriv_nth[of f] by auto
     qed simp
   qed
 next
   show "f = fps_const (f$0) \<Longrightarrow> fps_deriv f = 0" using fps_deriv_const[of "f$0"] by simp
 qed
 
 lemma fps_deriv_eq_iff:
   fixes f g :: "'a::{ring_1_no_zero_divisors,semiring_char_0} fps"
   shows "fps_deriv f = fps_deriv g \<longleftrightarrow> (f = fps_const(f$0 - g$0) + g)"
 proof -
   have "fps_deriv f = fps_deriv g \<longleftrightarrow> fps_deriv (f - g) = 0"
     using fps_deriv_sub[of f g]
     by simp
   also have "\<dots> \<longleftrightarrow> f - g = fps_const ((f - g) $ 0)"
     unfolding fps_deriv_eq_0_iff ..
   finally show ?thesis
     by (simp add: field_simps)
 qed
 
 lemma fps_deriv_eq_iff_ex:
   fixes f g :: "'a::{ring_1_no_zero_divisors,semiring_char_0} fps"
   shows "(fps_deriv f = fps_deriv g) \<longleftrightarrow> (\<exists>c. f = fps_const c + g)"
   by    (auto simp: fps_deriv_eq_iff)
 
 
 fun fps_nth_deriv :: "nat \<Rightarrow> 'a::semiring_1 fps \<Rightarrow> 'a fps"
 where
   "fps_nth_deriv 0 f = f"
 | "fps_nth_deriv (Suc n) f = fps_nth_deriv n (fps_deriv f)"
 
 lemma fps_nth_deriv_commute: "fps_nth_deriv (Suc n) f = fps_deriv (fps_nth_deriv n f)"
   by (induct n arbitrary: f) auto
 
 lemma fps_nth_deriv_linear[simp]:
   "fps_nth_deriv n (fps_const a * f + fps_const b * g) =
     fps_const a * fps_nth_deriv n f + fps_const b * fps_nth_deriv n g"
   by (induct n arbitrary: f g) auto
 
 lemma fps_nth_deriv_neg[simp]:
   "fps_nth_deriv n (- (f :: 'a::ring_1 fps)) = - (fps_nth_deriv n f)"
   by (induct n arbitrary: f) simp_all
 
 lemma fps_nth_deriv_add[simp]:
   "fps_nth_deriv n ((f :: 'a::ring_1 fps) + g) = fps_nth_deriv n f + fps_nth_deriv n g"
   using fps_nth_deriv_linear[of n 1 f 1 g] by simp
 
 lemma fps_nth_deriv_sub[simp]:
   "fps_nth_deriv n ((f :: 'a::ring_1 fps) - g) = fps_nth_deriv n f - fps_nth_deriv n g"
   using fps_nth_deriv_add [of n f "- g"] by simp
 
 lemma fps_nth_deriv_0[simp]: "fps_nth_deriv n 0 = 0"
   by (induct n) simp_all
 
 lemma fps_nth_deriv_1[simp]: "fps_nth_deriv n 1 = (if n = 0 then 1 else 0)"
   by (induct n) simp_all
 
 lemma fps_nth_deriv_const[simp]:
   "fps_nth_deriv n (fps_const c) = (if n = 0 then fps_const c else 0)"
   by (cases n) simp_all
 
 lemma fps_nth_deriv_mult_const_left[simp]:
   "fps_nth_deriv n (fps_const c * f) = fps_const c * fps_nth_deriv n f"
   using fps_nth_deriv_linear[of n "c" f 0 0 ] by simp
 
 lemma fps_nth_deriv_mult_const_right[simp]:
   "fps_nth_deriv n (f * fps_const c) = fps_nth_deriv n f * fps_const c"
   by (induct n arbitrary: f) auto
 
 lemma fps_nth_deriv_sum:
   "fps_nth_deriv n (sum f S) = sum (\<lambda>i. fps_nth_deriv n (f i :: 'a::ring_1 fps)) S"
 proof (cases "finite S")
   case True
   show ?thesis by (induct rule: finite_induct [OF True]) simp_all
 next
   case False
   then show ?thesis by simp
 qed
 
 lemma fps_deriv_maclauren_0:
   "(fps_nth_deriv k (f :: 'a::comm_semiring_1 fps)) $ 0 = of_nat (fact k) * f $ k"
   by (induct k arbitrary: f) (simp_all add: field_simps)
 
 lemma fps_deriv_lr_inverse:
   fixes   x y :: "'a::ring_1"
   assumes "x * f$0 = 1" "f$0 * y = 1"
   \<comment> \<open>These assumptions imply x equals y, but no need to assume that.\<close>
   shows   "fps_deriv (fps_left_inverse f x) =
             - fps_left_inverse f x * fps_deriv f * fps_left_inverse f x"
   and     "fps_deriv (fps_right_inverse f y) =
             - fps_right_inverse f y * fps_deriv f * fps_right_inverse f y"
 proof-
 
   define L where "L \<equiv> fps_left_inverse f x"
   hence "fps_deriv (L * f) = 0" using fps_left_inverse[OF assms(1)] by simp
   with assms show "fps_deriv L = - L * fps_deriv f * L"
     using fps_right_inverse'[OF assms]
     by    (simp add: minus_unique mult.assoc L_def)
 
   define R where "R \<equiv> fps_right_inverse f y"
   hence "fps_deriv (f * R) = 0" using fps_right_inverse[OF assms(2)] by simp
   hence 1: "f * fps_deriv R + fps_deriv f * R = 0" by simp
   have "R * f * fps_deriv R = - R * fps_deriv f * R"
     using iffD2[OF eq_neg_iff_add_eq_0, OF 1] by (simp add: mult.assoc)
   thus "fps_deriv R = - R * fps_deriv f * R"
     using fps_left_inverse'[OF assms] by (simp add: R_def)
 
 qed
 
 lemma fps_deriv_lr_inverse_comm:
   fixes   x :: "'a::comm_ring_1"
   assumes "x * f$0 = 1"
   shows   "fps_deriv (fps_left_inverse f x) = - fps_deriv f * (fps_left_inverse f x)\<^sup>2"
   and     "fps_deriv (fps_right_inverse f x) = - fps_deriv f * (fps_right_inverse f x)\<^sup>2"
   using   assms fps_deriv_lr_inverse[of x f x]
   by      (simp_all add: mult.commute power2_eq_square)
 
 lemma fps_inverse_deriv_divring:
   fixes   a :: "'a::division_ring fps"
   assumes "a$0 \<noteq> 0"
   shows   "fps_deriv (inverse a) = - inverse a * fps_deriv a * inverse a"
   using   assms fps_deriv_lr_inverse(2)[of "inverse (a$0)" a "inverse (a$0)"]
   by      (simp add: fps_inverse_def)
 
 lemma fps_inverse_deriv:
   fixes   a :: "'a::field fps"
   assumes "a$0 \<noteq> 0"
   shows   "fps_deriv (inverse a) = - fps_deriv a * (inverse a)\<^sup>2"
   using   assms fps_deriv_lr_inverse_comm(2)[of "inverse (a$0)" a]
   by      (simp add: fps_inverse_def)
 
 lemma fps_inverse_deriv':
   fixes a :: "'a::field fps"
   assumes a0: "a $ 0 \<noteq> 0"
   shows "fps_deriv (inverse a) = - fps_deriv a / a\<^sup>2"
   using fps_inverse_deriv[OF a0] a0
   by (simp add: fps_divide_unit power2_eq_square fps_inverse_mult)
 
 (* FIXME: The last part of this proof should go through by simp once we have a proper
    theorem collection for simplifying division on rings *)
 lemma fps_divide_deriv:
   assumes "b dvd (a :: 'a :: field fps)"
   shows   "fps_deriv (a / b) = (fps_deriv a * b - a * fps_deriv b) / b^2"
 proof -
   have eq_divide_imp: "c \<noteq> 0 \<Longrightarrow> a * c = b \<Longrightarrow> a = b div c" for a b c :: "'a :: field fps"
     by (drule sym) (simp add: mult.assoc)
   from assms have "a = a / b * b" by simp
   also have "fps_deriv (a / b * b) = fps_deriv (a / b) * b + a / b * fps_deriv b" by simp
   finally have "fps_deriv (a / b) * b^2 = fps_deriv a * b - a * fps_deriv b" using assms
     by (simp add: power2_eq_square algebra_simps)
   thus ?thesis by (cases "b = 0") (simp_all add: eq_divide_imp)
 qed
 
 lemma fps_nth_deriv_fps_X[simp]: "fps_nth_deriv n fps_X = (if n = 0 then fps_X else if n=1 then 1 else 0)"
   by (cases n) simp_all
 
 
 subsection \<open>Powers\<close>
 
 lemma fps_power_zeroth: "(a^n) $ 0 = (a$0)^n"
   by (induct n) auto
 
 lemma fps_power_zeroth_eq_one: "a$0 = 1 \<Longrightarrow> a^n $ 0 = 1"
   by (simp add: fps_power_zeroth)
 
 lemma fps_power_first:
   fixes a :: "'a::comm_semiring_1 fps"
   shows "(a^n) $ 1 = of_nat n * (a$0)^(n-1) * a$1"
 proof (cases n)
   case (Suc m)
   have "(a ^ Suc m) $ 1 = of_nat (Suc m) * (a$0)^(Suc m - 1) * a$1"
   proof (induct m)
     case (Suc k)
     hence "(a ^ Suc (Suc k)) $ 1 =
             a$0 * of_nat (Suc k) * (a $ 0)^k * a$1 + a$1 * ((a$0)^(Suc k))"
       using fps_mult_nth_1[of a] by (simp add: fps_power_zeroth[symmetric] mult.assoc)
     thus ?case by (simp add: algebra_simps)
   qed simp
   with Suc show ?thesis by simp
 qed simp
 
 lemma fps_power_first_eq: "a $ 0 = 1 \<Longrightarrow> a^n $ 1 = of_nat n * a$1"
 proof (induct n)
   case (Suc n)
   show ?case unfolding power_Suc fps_mult_nth
     using Suc.hyps[OF \<open>a$0 = 1\<close>] \<open>a$0 = 1\<close> fps_power_zeroth_eq_one[OF \<open>a$0=1\<close>]
     by (simp add: algebra_simps)
 qed simp
 
 lemma fps_power_first_eq':
   assumes "a $ 1 = 1"
   shows   "a^n $ 1 = of_nat n * (a$0)^(n-1)"
 proof (cases n)
   case (Suc m)
   from assms have "(a ^ Suc m) $ 1 = of_nat (Suc m) * (a$0)^(Suc m - 1)"
     using fps_mult_nth_1[of a]
     by    (induct m)
           (simp_all add: algebra_simps mult_of_nat_commute fps_power_zeroth)
   with Suc show ?thesis by simp
 qed simp
 
 lemmas startsby_one_power = fps_power_zeroth_eq_one
 
 lemma startsby_zero_power: "a $ 0 = 0 \<Longrightarrow> n > 0 \<Longrightarrow> a^n $0 = 0"
   by (simp add: fps_power_zeroth zero_power)
 
 lemma startsby_power: "a $0 = v \<Longrightarrow> a^n $0 = v^n"
   by (simp add: fps_power_zeroth)
 
 lemma startsby_nonzero_power:
   fixes a :: "'a::semiring_1_no_zero_divisors fps"
   shows "a $ 0 \<noteq> 0 \<Longrightarrow> a^n $ 0 \<noteq> 0"
   by    (simp add: startsby_power)
 
 lemma startsby_zero_power_iff[simp]:
   "a^n $0 = (0::'a::semiring_1_no_zero_divisors) \<longleftrightarrow> n \<noteq> 0 \<and> a$0 = 0"
 proof
   show "a ^ n $ 0 = 0 \<Longrightarrow> n \<noteq> 0 \<and> a $ 0 = 0"
   proof
     assume a: "a^n $ 0 = 0"
     thus "a $ 0 = 0" using startsby_nonzero_power by auto
     have "n = 0 \<Longrightarrow> a^n $ 0 = 1" by simp
     with a show "n \<noteq> 0" by fastforce
   qed
   show "n \<noteq> 0 \<and> a $ 0 = 0 \<Longrightarrow> a ^ n $ 0 = 0"
     by (cases n) auto
 qed
 
 lemma startsby_zero_power_prefix:
   assumes a0: "a $ 0 = 0"
   shows "\<forall>n < k. a ^ k $ n = 0"
 proof (induct k rule: nat_less_induct, clarify)
   case (1 k)
   fix j :: nat assume j: "j < k"
   show "a ^ k $ j = 0"
   proof (cases k)
     case 0 with j show ?thesis by simp
   next
     case (Suc i)
     with 1 j have "\<forall>m\<in>{0<..j}. a ^ i $ (j - m) = 0" by auto
     with Suc a0 show ?thesis by (simp add: fps_mult_nth sum.atLeast_Suc_atMost)
   qed
 qed
 
 lemma startsby_zero_sum_depends:
   assumes a0: "a $0 = 0"
     and kn: "n \<ge> k"
   shows "sum (\<lambda>i. (a ^ i)$k) {0 .. n} = sum (\<lambda>i. (a ^ i)$k) {0 .. k}"
 proof (intro strip sum.mono_neutral_right)
   show "\<And>i. i \<in> {0..n} - {0..k} \<Longrightarrow> a ^ i $ k = 0"
     by (simp add: a0 startsby_zero_power_prefix)
 qed (use kn in auto)
 
 lemma startsby_zero_power_nth_same:
   assumes a0: "a$0 = 0"
   shows   "a^n $ n = (a$1) ^ n"
 proof (induct n)
   case (Suc n)
   have "\<forall>i\<in>{Suc 1..Suc n}. a ^ n $ (Suc n - i) = 0"
     using a0 startsby_zero_power_prefix[of a n] by auto
   thus ?case
     using a0 Suc sum.atLeast_Suc_atMost[of 0 "Suc n" "\<lambda>i. a $ i * a ^ n $ (Suc n - i)"]
           sum.atLeast_Suc_atMost[of 1 "Suc n" "\<lambda>i. a $ i * a ^ n $ (Suc n - i)"]
     by    (simp add: fps_mult_nth)
 qed simp
 
 lemma fps_lr_inverse_power:
   fixes a :: "'a::ring_1 fps"
   assumes "x * a$0 = 1" "a$0 * x = 1"
   shows "fps_left_inverse (a^n) (x^n) = fps_left_inverse a x ^ n"
   and   "fps_right_inverse (a^n) (x^n) = fps_right_inverse a x ^ n"
 proof-
 
   from assms have xn: "\<And>n. x^n * (a^n $ 0) = 1" "\<And>n. (a^n $ 0) * x^n = 1" 
     by (simp_all add: left_right_inverse_power fps_power_zeroth)
 
   show "fps_left_inverse (a^n) (x^n) = fps_left_inverse a x ^ n"
   proof (induct n)
     case 0
     then show ?case by (simp add: fps_lr_inverse_one_one(1))
   next
     case (Suc n)
     with assms show ?case
       using xn fps_lr_inverse_mult_ring1(1)[of x a "x^n" "a^n"]
       by    (simp add: power_Suc2[symmetric])
   qed
 
   moreover have "fps_right_inverse (a^n) (x^n) = fps_left_inverse (a^n) (x^n)"
     using xn by (intro fps_left_inverse_eq_fps_right_inverse[symmetric])
   moreover have "fps_right_inverse a x = fps_left_inverse a x"
     using assms by (intro fps_left_inverse_eq_fps_right_inverse[symmetric])
   ultimately show "fps_right_inverse (a^n) (x^n) = fps_right_inverse a x ^ n"
     by simp
 
 qed
 
 lemma fps_inverse_power:
   fixes a :: "'a::division_ring fps"
   shows "inverse (a^n) = inverse a ^ n"
 proof (cases "n=0" "a$0 = 0" rule: case_split[case_product case_split])
   case False_True
   hence LHS: "inverse (a^n) = 0" and RHS: "inverse a ^ n = 0"
     by (simp_all add: startsby_zero_power)
   show ?thesis using trans_sym[OF LHS RHS] by fast
 next
   case False_False
   from False_False(2) show ?thesis
     by  (simp add:
           fps_inverse_def fps_power_zeroth power_inverse fps_lr_inverse_power(2)[symmetric]
         )
 qed auto
 
 lemma fps_deriv_power':
   fixes a :: "'a::comm_semiring_1 fps"
   shows "fps_deriv (a ^ n) = (of_nat n) * fps_deriv a * a ^ (n - 1)"
 proof (cases n)
   case (Suc m)
   moreover have "fps_deriv (a^Suc m) = of_nat (Suc m) * fps_deriv a * a^m"
     by (induct m) (simp_all add: algebra_simps)
   ultimately show ?thesis by simp
 qed simp
 
 lemma fps_deriv_power:
   fixes a :: "'a::comm_semiring_1 fps"
   shows "fps_deriv (a ^ n) = fps_const (of_nat n) * fps_deriv a * a ^ (n - 1)"
   by (simp add: fps_deriv_power' fps_of_nat)
 
 
 subsection \<open>Integration\<close>
 
 definition fps_integral :: "'a::{semiring_1,inverse} fps \<Rightarrow> 'a \<Rightarrow> 'a fps"
   where "fps_integral a a0 =
           Abs_fps (\<lambda>n. if n=0 then a0 else inverse (of_nat n) * a$(n - 1))"
 
 abbreviation "fps_integral0 a \<equiv> fps_integral a 0"
 
 lemma fps_integral_nth_0_Suc [simp]:
   fixes a :: "'a::{semiring_1,inverse} fps"
   shows "fps_integral a a0 $ 0 = a0"
   and   "fps_integral a a0 $ Suc n = inverse (of_nat (Suc n)) * a $ n"
   by    (auto simp: fps_integral_def)
 
 lemma fps_integral_conv_plus_const:
   "fps_integral a a0 = fps_integral a 0 + fps_const a0"
   unfolding fps_integral_def by (intro fps_ext) simp
 
 lemma fps_deriv_fps_integral:
   fixes a :: "'a::{division_ring,ring_char_0} fps"
   shows "fps_deriv (fps_integral a a0) = a"
 proof (intro fps_ext)
   fix n
   have "(of_nat (Suc n) :: 'a) \<noteq> 0" by (rule of_nat_neq_0)
   hence "of_nat (Suc n) * inverse (of_nat (Suc n) :: 'a) = 1" by simp
   moreover have
     "fps_deriv (fps_integral a a0) $ n = of_nat (Suc n) * inverse (of_nat (Suc n)) * a $ n"
     by (simp add: mult.assoc)
   ultimately show "fps_deriv (fps_integral a a0) $ n = a $ n" by simp
 qed
 
 lemma fps_integral0_deriv:
   fixes a :: "'a::{division_ring,ring_char_0} fps"
   shows "fps_integral0 (fps_deriv a) = a - fps_const (a$0)"
 proof (intro fps_ext)
   fix n
   show "fps_integral0 (fps_deriv a) $ n = (a - fps_const (a$0)) $ n"
   proof (cases n)
     case (Suc m)
     have "(of_nat (Suc m) :: 'a) \<noteq> 0" by (rule of_nat_neq_0)
     hence "inverse (of_nat (Suc m) :: 'a) * of_nat (Suc m) = 1" by simp
     moreover have
       "fps_integral0 (fps_deriv a) $ Suc m =
         inverse (of_nat (Suc m)) * of_nat (Suc m) * a $ (Suc m)"
       by (simp add: mult.assoc)
     ultimately show ?thesis using Suc by simp
   qed simp
 qed
 
 lemma fps_integral_deriv:
   fixes a :: "'a::{division_ring,ring_char_0} fps"
   shows "fps_integral (fps_deriv a) (a$0) = a"
   using fps_integral_conv_plus_const[of "fps_deriv a" "a$0"]
   by    (simp add: fps_integral0_deriv)
 
 lemma fps_integral0_zero:
   "fps_integral0 (0::'a::{semiring_1,inverse} fps) = 0"
   by (intro fps_ext) (simp add: fps_integral_def)
 
 lemma fps_integral0_fps_const':
   fixes   c :: "'a::{semiring_1,inverse}"
   assumes "inverse (1::'a) = 1"
   shows   "fps_integral0 (fps_const c) = fps_const c * fps_X"
 proof (intro fps_ext)
   fix n
   show "fps_integral0 (fps_const c) $ n = (fps_const c * fps_X) $ n"
     by (cases n) (simp_all add: assms mult_delta_right)
 qed
 
 lemma fps_integral0_fps_const:
   fixes c :: "'a::division_ring"
   shows "fps_integral0 (fps_const c) = fps_const c * fps_X"
   by    (rule fps_integral0_fps_const'[OF inverse_1])
 
 lemma fps_integral0_one':
   assumes "inverse (1::'a::{semiring_1,inverse}) = 1"
   shows   "fps_integral0 (1::'a fps) = fps_X"
   using   assms fps_integral0_fps_const'[of "1::'a"]
   by      simp
 
 lemma fps_integral0_one:
   "fps_integral0 (1::'a::division_ring fps) = fps_X"
   by (rule fps_integral0_one'[OF inverse_1])
 
 lemma fps_integral0_fps_const_mult_left:
   fixes a :: "'a::division_ring fps"
   shows "fps_integral0 (fps_const c * a) = fps_const c * fps_integral0 a"
 proof (intro fps_ext)
   fix n
   show "fps_integral0 (fps_const c * a) $ n = (fps_const c * fps_integral0 a) $ n"
     using mult_inverse_of_nat_commute[of n c, symmetric]
           mult.assoc[of "inverse (of_nat n)" c "a$(n-1)"]
           mult.assoc[of c "inverse (of_nat n)" "a$(n-1)"]
     by    (simp add: fps_integral_def)
 qed
 
 lemma fps_integral0_fps_const_mult_right:
   fixes a :: "'a::{semiring_1,inverse} fps"
   shows "fps_integral0 (a * fps_const c) = fps_integral0 a * fps_const c"
   by    (intro fps_ext) (simp add: fps_integral_def algebra_simps)
 
 lemma fps_integral0_neg:
   fixes a :: "'a::{ring_1,inverse} fps"
   shows "fps_integral0 (-a) = - fps_integral0 a"
   using fps_integral0_fps_const_mult_right[of a "-1"]
   by    (simp add: fps_const_neg[symmetric])
 
 lemma fps_integral0_add:
   "fps_integral0 (a+b) = fps_integral0 a + fps_integral0 b"
   by (intro fps_ext) (simp add: fps_integral_def algebra_simps)
 
 lemma fps_integral0_linear:
   fixes a b :: "'a::division_ring"
   shows "fps_integral0 (fps_const a * f + fps_const b * g) =
           fps_const a * fps_integral0 f + fps_const b * fps_integral0 g"
   by    (simp add: fps_integral0_add fps_integral0_fps_const_mult_left)
   
 lemma fps_integral0_linear2:
   "fps_integral0 (f * fps_const a + g * fps_const b) =
     fps_integral0 f * fps_const a + fps_integral0 g * fps_const b"
   by (simp add: fps_integral0_add fps_integral0_fps_const_mult_right)
 
 lemma fps_integral_linear:
   fixes a b a0 b0 :: "'a::division_ring"
   shows
   "fps_integral (fps_const a * f + fps_const b * g) (a*a0 + b*b0) =
     fps_const a * fps_integral f a0 + fps_const b * fps_integral g b0"
   using fps_integral_conv_plus_const[of
           "fps_const a * f + fps_const b * g"
           "a*a0 + b*b0"
         ]
         fps_integral_conv_plus_const[of f a0] fps_integral_conv_plus_const[of g b0]
   by    (simp add: fps_integral0_linear algebra_simps)
 
 lemma fps_integral0_sub:
   fixes a b :: "'a::{ring_1,inverse} fps"
   shows "fps_integral0 (a-b) = fps_integral0 a - fps_integral0 b"
   using fps_integral0_linear2[of a 1 b "-1"]
   by    (simp add: fps_const_neg[symmetric])
 
 lemma fps_integral0_of_nat:
   "fps_integral0 (of_nat n :: 'a::division_ring fps) = of_nat n * fps_X"
   using fps_integral0_fps_const[of "of_nat n :: 'a"] by (simp add: fps_of_nat)
 
 lemma fps_integral0_sum:
   "fps_integral0 (sum f S) = sum (\<lambda>i. fps_integral0 (f i)) S"
 proof (cases "finite S")
   case True show ?thesis
     by  (induct rule: finite_induct [OF True])
         (simp_all add: fps_integral0_zero fps_integral0_add)
 qed (simp add: fps_integral0_zero)
 
 lemma fps_integral0_by_parts:
   fixes a b :: "'a::{division_ring,ring_char_0} fps"
   shows
     "fps_integral0 (a * b) =
       a * fps_integral0 b - fps_integral0 (fps_deriv a * fps_integral0 b)"
 proof-
   have "fps_integral0 (fps_deriv (a * fps_integral0 b)) = a * fps_integral0 b"
     using fps_integral0_deriv[of "(a * fps_integral0 b)"] by simp
   moreover have
     "fps_integral0 (a * b) =
       fps_integral0 (fps_deriv (a * fps_integral0 b)) -
       fps_integral0 (fps_deriv a * fps_integral0 b)"
     by (auto simp: fps_deriv_fps_integral fps_integral0_sub[symmetric])
   ultimately show ?thesis by simp
 qed
 
 lemma fps_integral0_fps_X:
   "fps_integral0 (fps_X::'a::{semiring_1,inverse} fps) =
     fps_const (inverse (of_nat 2)) * fps_X\<^sup>2"
   by (intro fps_ext) (auto simp: fps_integral_def)
 
 lemma fps_integral0_fps_X_power:
   "fps_integral0 ((fps_X::'a::{semiring_1,inverse} fps) ^ n) =
             fps_const (inverse (of_nat (Suc n))) * fps_X ^ Suc n"
 proof (intro fps_ext)
   fix k show
     "fps_integral0 ((fps_X::'a fps) ^ n) $ k =
       (fps_const (inverse (of_nat (Suc n))) * fps_X ^ Suc n) $ k"
     by (cases k) simp_all
 qed
 
 
 subsection \<open>Composition of FPSs\<close>
 
 definition fps_compose :: "'a::semiring_1 fps \<Rightarrow> 'a fps \<Rightarrow> 'a fps"  (infixl "oo" 55)
   where "a oo b = Abs_fps (\<lambda>n. sum (\<lambda>i. a$i * (b^i$n)) {0..n})"
 
 lemma fps_compose_nth: "(a oo b)$n = sum (\<lambda>i. a$i * (b^i$n)) {0..n}"
   by (simp add: fps_compose_def)
 
 lemma fps_compose_nth_0 [simp]: "(f oo g) $ 0 = f $ 0"
   by (simp add: fps_compose_nth)
 
 lemma fps_compose_fps_X[simp]: "a oo fps_X = (a :: 'a::comm_ring_1 fps)"
   by (simp add: fps_ext fps_compose_def mult_delta_right)
 
 lemma fps_const_compose[simp]: "fps_const (a::'a::comm_ring_1) oo b = fps_const a"
   by (simp add: fps_eq_iff fps_compose_nth mult_delta_left)
 
 lemma numeral_compose[simp]: "(numeral k :: 'a::comm_ring_1 fps) oo b = numeral k"
   unfolding numeral_fps_const by simp
 
 lemma neg_numeral_compose[simp]: "(- numeral k :: 'a::comm_ring_1 fps) oo b = - numeral k"
   unfolding neg_numeral_fps_const by simp
 
 lemma fps_X_fps_compose_startby0[simp]: "a$0 = 0 \<Longrightarrow> fps_X oo a = (a :: 'a::comm_ring_1 fps)"
   by (simp add: fps_eq_iff fps_compose_def mult_delta_left not_le)
 
 
 subsection \<open>Rules from Herbert Wilf's Generatingfunctionology\<close>
 
 subsubsection \<open>Rule 1\<close>
   (* {a_{n+k}}_0^infty Corresponds to (f - sum (\<lambda>i. a_i * x^i))/x^h, for h>0*)
 
 lemma fps_power_mult_eq_shift:
   "fps_X^Suc k * Abs_fps (\<lambda>n. a (n + Suc k)) =
     Abs_fps a - sum (\<lambda>i. fps_const (a i :: 'a::comm_ring_1) * fps_X^i) {0 .. k}"
   (is "?lhs = ?rhs")
 proof -
   have "?lhs $ n = ?rhs $ n" for n :: nat
   proof -
     have "?lhs $ n = (if n < Suc k then 0 else a n)"
       unfolding fps_X_power_mult_nth by auto
     also have "\<dots> = ?rhs $ n"
     proof (induct k)
       case 0
       then show ?case
         by (simp add: fps_sum_nth)
     next
       case (Suc k)
       have "(Abs_fps a - sum (\<lambda>i. fps_const (a i :: 'a) * fps_X^i) {0 .. Suc k})$n =
         (Abs_fps a - sum (\<lambda>i. fps_const (a i :: 'a) * fps_X^i) {0 .. k} -
           fps_const (a (Suc k)) * fps_X^ Suc k) $ n"
         by (simp add: field_simps)
       also have "\<dots> = (if n < Suc k then 0 else a n) - (fps_const (a (Suc k)) * fps_X^ Suc k)$n"
         using Suc.hyps[symmetric] unfolding fps_sub_nth by simp
       also have "\<dots> = (if n < Suc (Suc k) then 0 else a n)"
         unfolding fps_X_power_mult_right_nth
         by (simp add: not_less le_less_Suc_eq)
       finally show ?case
         by simp
     qed
     finally show ?thesis .
   qed
   then show ?thesis
     by (simp add: fps_eq_iff)
 qed
 
 
 subsubsection \<open>Rule 2\<close>
 
   (* We can not reach the form of Wilf, but still near to it using rewrite rules*)
   (* If f reprents {a_n} and P is a polynomial, then
         P(xD) f represents {P(n) a_n}*)
 
 definition "fps_XD = (*) fps_X \<circ> fps_deriv"
 
 lemma fps_XD_add[simp]:"fps_XD (a + b) = fps_XD a + fps_XD (b :: 'a::comm_ring_1 fps)"
   by (simp add: fps_XD_def field_simps)
 
 lemma fps_XD_mult_const[simp]:"fps_XD (fps_const (c::'a::comm_ring_1) * a) = fps_const c * fps_XD a"
   by (simp add: fps_XD_def field_simps)
 
 lemma fps_XD_linear[simp]: "fps_XD (fps_const c * a + fps_const d * b) =
     fps_const c * fps_XD a + fps_const d * fps_XD (b :: 'a::comm_ring_1 fps)"
   by simp
 
 lemma fps_XDN_linear:
   "(fps_XD ^^ n) (fps_const c * a + fps_const d * b) =
     fps_const c * (fps_XD ^^ n) a + fps_const d * (fps_XD ^^ n) (b :: 'a::comm_ring_1 fps)"
   by (induct n) simp_all
 
 lemma fps_mult_fps_X_deriv_shift: "fps_X* fps_deriv a = Abs_fps (\<lambda>n. of_nat n* a$n)"
   by (simp add: fps_eq_iff)
 
 lemma fps_mult_fps_XD_shift:
   "(fps_XD ^^ k) (a :: 'a::comm_ring_1 fps) = Abs_fps (\<lambda>n. (of_nat n ^ k) * a$n)"
   by (induct k arbitrary: a) (simp_all add: fps_XD_def fps_eq_iff field_simps del: One_nat_def)
 
 
 subsubsection \<open>Rule 3\<close>
 
 text \<open>Rule 3 is trivial and is given by \<open>fps_times_def\<close>.\<close>
 
 
 subsubsection \<open>Rule 5 --- summation and "division" by (1 - fps_X)\<close>
 
 lemma fps_divide_fps_X_minus1_sum_lemma:
   "a = ((1::'a::ring_1 fps) - fps_X) * Abs_fps (\<lambda>n. sum (\<lambda>i. a $ i) {0..n})"
 proof (rule fps_ext)
   define f g :: "'a fps"
     where "f \<equiv> 1 - fps_X"
     and   "g \<equiv> Abs_fps (\<lambda>n. sum (\<lambda>i. a $ i) {0..n})"
   fix n show "a $ n= (f * g) $ n"
   proof (cases n)
     case (Suc m)
     hence "(f * g) $ n = g $ Suc m - g $ m"
       using fps_mult_nth[of f g "Suc m"]
             sum.atLeast_Suc_atMost[of 0 "Suc m" "\<lambda>i. f $ i * g $ (Suc m - i)"]
             sum.atLeast_Suc_atMost[of 1 "Suc m" "\<lambda>i. f $ i * g $ (Suc m - i)"]
       by    (simp add: f_def)
     with Suc show ?thesis by (simp add: g_def)
   qed (simp add: f_def g_def)
 qed
 
 lemma fps_divide_fps_X_minus1_sum_ring1:
   assumes "inverse 1 = (1::'a::{ring_1,inverse})"
   shows   "a /((1::'a fps) - fps_X) = Abs_fps (\<lambda>n. sum (\<lambda>i. a $ i) {0..n})"
 proof-
   from assms have "a /((1::'a fps) - fps_X) = a * Abs_fps (\<lambda>n. 1)"
     by (simp add: fps_divide_def fps_inverse_def fps_lr_inverse_one_minus_fps_X(2))
   thus ?thesis by (auto intro: fps_ext simp: fps_mult_nth)
 qed
 
 lemma fps_divide_fps_X_minus1_sum:
   "a /((1::'a::division_ring fps) - fps_X) = Abs_fps (\<lambda>n. sum (\<lambda>i. a $ i) {0..n})"
   using fps_divide_fps_X_minus1_sum_ring1[of a] by simp
 
 
 subsubsection \<open>Rule 4 in its more general form: generalizes Rule 3 for an arbitrary
   finite product of FPS, also the relvant instance of powers of a FPS\<close>
 
 definition "natpermute n k = {l :: nat list. length l = k \<and> sum_list l = n}"
 
 lemma natlist_trivial_1: "natpermute n 1 = {[n]}"
 proof -
   have "\<lbrakk>length xs = 1; n = sum_list xs\<rbrakk> \<Longrightarrow> xs = [sum_list xs]" for xs
     by (cases xs) auto
   then show ?thesis
     by (auto simp add: natpermute_def)
 qed
 
 lemma natlist_trivial_Suc0 [simp]: "natpermute n (Suc 0) = {[n]}"
   using natlist_trivial_1 by force
 
 lemma append_natpermute_less_eq:
   assumes "xs @ ys \<in> natpermute n k"
   shows "sum_list xs \<le> n"
     and "sum_list ys \<le> n"
 proof -
   from assms have "sum_list (xs @ ys) = n"
     by (simp add: natpermute_def)
   then have "sum_list xs + sum_list ys = n"
     by simp
   then show "sum_list xs \<le> n" and "sum_list ys \<le> n"
     by simp_all
 qed
 
 lemma natpermute_split:
   assumes "h \<le> k"
   shows "natpermute n k =
     (\<Union>m \<in>{0..n}. {l1 @ l2 |l1 l2. l1 \<in> natpermute m h \<and> l2 \<in> natpermute (n - m) (k - h)})"
   (is "?L = ?R" is "_ = (\<Union>m \<in>{0..n}. ?S m)")
 proof
   show "?R \<subseteq> ?L"
   proof
     fix l
     assume l: "l \<in> ?R"
     from l obtain m xs ys where h: "m \<in> {0..n}"
       and xs: "xs \<in> natpermute m h"
       and ys: "ys \<in> natpermute (n - m) (k - h)"
       and leq: "l = xs@ys" by blast
     from xs have xs': "sum_list xs = m"
       by (simp add: natpermute_def)
     from ys have ys': "sum_list ys = n - m"
       by (simp add: natpermute_def)
     show "l \<in> ?L" using leq xs ys h
       using assms by (force simp add: natpermute_def)
   qed
   show "?L \<subseteq> ?R"
   proof
     fix l
     assume l: "l \<in> natpermute n k"
     let ?xs = "take h l"
     let ?ys = "drop h l"
     let ?m = "sum_list ?xs"
     from l have ls: "sum_list (?xs @ ?ys) = n"
       by (simp add: natpermute_def)
     have xs: "?xs \<in> natpermute ?m h" using l assms
       by (simp add: natpermute_def)
     have l_take_drop: "sum_list l = sum_list (take h l @ drop h l)"
       by simp
     then have ys: "?ys \<in> natpermute (n - ?m) (k - h)"
       using l assms ls by (auto simp add: natpermute_def simp del: append_take_drop_id)
     from ls have m: "?m \<in> {0..n}"
       by (simp add: l_take_drop del: append_take_drop_id)
     have "sum_list (take h l) \<le> sum_list l"
       using l_take_drop ls m by presburger
     with xs ys ls l show "l \<in> ?R"
       by simp (metis append_take_drop_id m)
   qed
 qed
 
 lemma natpermute_0: "natpermute n 0 = (if n = 0 then {[]} else {})"
   by (auto simp add: natpermute_def)
 
 lemma natpermute_0'[simp]: "natpermute 0 k = (if k = 0 then {[]} else {replicate k 0})"
   by (auto simp add: set_replicate_conv_if natpermute_def replicate_length_same)
 
 lemma natpermute_finite: "finite (natpermute n k)"
 proof (induct k arbitrary: n)
   case 0
   then show ?case
     by (simp add: natpermute_0)
 next
   case (Suc k)
   then show ?case
     using natpermute_split [of k "Suc k"] finite_UN_I by simp
 qed
 
 lemma natpermute_contain_maximal:
   "{xs \<in> natpermute n (k + 1). n \<in> set xs} = (\<Union>i\<in>{0 .. k}. {(replicate (k + 1) 0) [i:=n]})"
   (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof
     fix xs
     assume "xs \<in> ?A"
     then have H: "xs \<in> natpermute n (k + 1)" and n: "n \<in> set xs"
       by blast+
     then obtain i where i: "i \<in> {0.. k}" "xs!i = n"
       unfolding in_set_conv_nth by (auto simp add: less_Suc_eq_le natpermute_def)
     have eqs: "({0..k} - {i}) \<union> {i} = {0..k}"
       using i by auto
     have f: "finite({0..k} - {i})" "finite {i}"
       by auto
     have d: "({0..k} - {i}) \<inter> {i} = {}"
       using i by auto
     from H have "n = sum (nth xs) {0..k}"
       by (auto simp add: natpermute_def atLeastLessThanSuc_atLeastAtMost sum_list_sum_nth)
     also have "\<dots> = n + sum (nth xs) ({0..k} - {i})"
       unfolding sum.union_disjoint[OF f d, unfolded eqs] using i by simp
     finally have zxs: "\<forall> j\<in> {0..k} - {i}. xs!j = 0"
       by auto
     from H have xsl: "length xs = k+1"
       by (simp add: natpermute_def)
     from i have i': "i < length (replicate (k+1) 0)"   "i < k+1"
       unfolding length_replicate by presburger+
     have "xs = (replicate (k+1) 0) [i := n]"
     proof (rule nth_equalityI)
       show "length xs = length ((replicate (k + 1) 0)[i := n])"
         by (metis length_list_update length_replicate xsl)
       show "xs ! j = (replicate (k + 1) 0)[i := n] ! j" if "j < length xs" for j
       proof (cases "j = i")
         case True
         then show ?thesis
           by (metis i'(1) i(2) nth_list_update)
       next
         case False
         with that show ?thesis
           by (simp add: xsl zxs del: replicate.simps split: nat.split)
       qed
     qed
     then show "xs \<in> ?B" using i by blast
   qed
   show "?B \<subseteq> ?A"
   proof
     fix xs
     assume "xs \<in> ?B"
     then obtain i where i: "i \<in> {0..k}" and xs: "xs = (replicate (k + 1) 0) [i:=n]"
       by auto
     have nxs: "n \<in> set xs"
       unfolding xs using set_update_memI i 
       by (metis Suc_eq_plus1 atLeast0AtMost atMost_iff le_simps(2) length_replicate)
     have xsl: "length xs = k + 1"
       by (simp only: xs length_replicate length_list_update)
     have "sum_list xs = sum (nth xs) {0..<k+1}"
       unfolding sum_list_sum_nth xsl ..
     also have "\<dots> = sum (\<lambda>j. if j = i then n else 0) {0..< k+1}"
       by (rule sum.cong) (simp_all add: xs del: replicate.simps)
     also have "\<dots> = n" using i by simp
     finally have "xs \<in> natpermute n (k + 1)"
       using xsl unfolding natpermute_def mem_Collect_eq by blast
     then show "xs \<in> ?A"
       using nxs by blast
   qed
 qed
 
 text \<open>The general form.\<close>
 lemma fps_prod_nth:
   fixes m :: nat
     and a :: "nat \<Rightarrow> 'a::comm_ring_1 fps"
   shows "(prod a {0 .. m}) $ n =
     sum (\<lambda>v. prod (\<lambda>j. (a j) $ (v!j)) {0..m}) (natpermute n (m+1))"
   (is "?P m n")
 proof (induct m arbitrary: n rule: nat_less_induct)
   fix m n assume H: "\<forall>m' < m. \<forall>n. ?P m' n"
   show "?P m n"
   proof (cases m)
     case 0
     then show ?thesis
       by simp
   next
     case (Suc k)
     then have km: "k < m" by arith
     have u0: "{0 .. k} \<union> {m} = {0..m}"
       using Suc by (simp add: set_eq_iff) presburger
     have f0: "finite {0 .. k}" "finite {m}" by auto
     have d0: "{0 .. k} \<inter> {m} = {}" using Suc by auto
     have "(prod a {0 .. m}) $ n = (prod a {0 .. k} * a m) $ n"
       unfolding prod.union_disjoint[OF f0 d0, unfolded u0] by simp
     also have "\<dots> = (\<Sum>i = 0..n. (\<Sum>v\<in>natpermute i (k + 1).
             (\<Prod>j = 0..k. a j $ v ! j) * a m $ (n - i)))"
       unfolding fps_mult_nth H[rule_format, OF km] sum_distrib_right ..
     also have "... = (\<Sum>i = 0..n.
                        \<Sum>v\<in>(\<lambda>l1. l1 @ [n - i]) ` natpermute i (Suc k).
                         (\<Prod>j = 0..k. a j $ v ! j) * a (Suc k) $ v ! Suc k)"
       by (intro sum.cong [OF refl sym] sum.reindex_cong) (auto simp: inj_on_def natpermute_def nth_append Suc)
     also have "... = (\<Sum>v\<in>(\<Union>x\<in>{0..n}. {l1 @ [n - x] |l1. l1 \<in> natpermute x (Suc k)}).
                       (\<Prod>j = 0..k. a j $ v ! j) * a (Suc k) $ v ! Suc k)"
       by (subst sum.UNION_disjoint) (auto simp add: natpermute_finite setcompr_eq_image)
     also have "\<dots> = (\<Sum>v\<in>natpermute n (m + 1). \<Prod>j\<in>{0..m}. a j $ v ! j)"
       using natpermute_split[of m "m + 1"] by (simp add: Suc)
     finally show ?thesis .
   qed
 qed
 
 text \<open>The special form for powers.\<close>
 lemma fps_power_nth_Suc:
   fixes m :: nat
     and a :: "'a::comm_ring_1 fps"
   shows "(a ^ Suc m)$n = sum (\<lambda>v. prod (\<lambda>j. a $ (v!j)) {0..m}) (natpermute n (m+1))"
 proof -
   have th0: "a^Suc m = prod (\<lambda>i. a) {0..m}"
     by (simp add: prod_constant)
   show ?thesis unfolding th0 fps_prod_nth ..
 qed
 
 lemma fps_power_nth:
   fixes m :: nat
     and a :: "'a::comm_ring_1 fps"
   shows "(a ^m)$n =
     (if m=0 then 1$n else sum (\<lambda>v. prod (\<lambda>j. a $ (v!j)) {0..m - 1}) (natpermute n m))"
   by (cases m) (simp_all add: fps_power_nth_Suc del: power_Suc)
 
 lemmas fps_nth_power_0 = fps_power_zeroth
 
 lemma natpermute_max_card:
   assumes n0: "n \<noteq> 0"
   shows "card {xs \<in> natpermute n (k + 1). n \<in> set xs} = k + 1"
   unfolding natpermute_contain_maximal
 proof -
   let ?A = "\<lambda>i. {(replicate (k + 1) 0)[i := n]}"
   let ?K = "{0 ..k}"
   have fK: "finite ?K"
     by simp
   have fAK: "\<forall>i\<in>?K. finite (?A i)"
     by auto
   have d: "\<forall>i\<in> ?K. \<forall>j\<in> ?K. i \<noteq> j \<longrightarrow>
     {(replicate (k + 1) 0)[i := n]} \<inter> {(replicate (k + 1) 0)[j := n]} = {}"
   proof clarify
     fix i j
     assume i: "i \<in> ?K" and j: "j \<in> ?K" and ij: "i \<noteq> j"
     have False if eq: "(replicate (k+1) 0)[i:=n] = (replicate (k+1) 0)[j:= n]"
     proof -
       have "(replicate (k+1) 0) [i:=n] ! i = n"
         using i by (simp del: replicate.simps)
       moreover
       have "(replicate (k+1) 0) [j:=n] ! i = 0"
         using i ij by (simp del: replicate.simps)
       ultimately show ?thesis
         using eq n0 by (simp del: replicate.simps)
     qed
     then show "{(replicate (k + 1) 0)[i := n]} \<inter> {(replicate (k + 1) 0)[j := n]} = {}"
       by auto
   qed
   from card_UN_disjoint[OF fK fAK d]
   show "card (\<Union>i\<in>{0..k}. {(replicate (k + 1) 0)[i := n]}) = k + 1"
     by simp
 qed
 
 lemma fps_power_Suc_nth:
   fixes f :: "'a :: comm_ring_1 fps"
   assumes k: "k > 0"
   shows "(f ^ Suc m) $ k = 
            of_nat (Suc m) * (f $ k * (f $ 0) ^ m) +
            (\<Sum>v\<in>{v\<in>natpermute k (m+1). k \<notin> set v}. \<Prod>j = 0..m. f $ v ! j)"
 proof -
   define A B 
     where "A = {v\<in>natpermute k (m+1). k \<in> set v}" 
       and  "B = {v\<in>natpermute k (m+1). k \<notin> set v}"
   have [simp]: "finite A" "finite B" "A \<inter> B = {}" by (auto simp: A_def B_def natpermute_finite)
 
   from natpermute_max_card[of k m] k have card_A: "card A = m + 1" by (simp add: A_def)
   {
     fix v assume v: "v \<in> A"
     from v have [simp]: "length v = Suc m" by (simp add: A_def natpermute_def)
     from v have "\<exists>j. j \<le> m \<and> v ! j = k" 
       by (auto simp: set_conv_nth A_def natpermute_def less_Suc_eq_le)
-    then guess j by (elim exE conjE) note j = this
+    then obtain j where j: "j \<le> m" "v ! j = k" by auto
     
     from v have "k = sum_list v" by (simp add: A_def natpermute_def)
     also have "\<dots> = (\<Sum>i=0..m. v ! i)"
       by (simp add: sum_list_sum_nth atLeastLessThanSuc_atLeastAtMost del: sum.op_ivl_Suc)
     also from j have "{0..m} = insert j ({0..m}-{j})" by auto
     also from j have "(\<Sum>i\<in>\<dots>. v ! i) = k + (\<Sum>i\<in>{0..m}-{j}. v ! i)"
       by (subst sum.insert) simp_all
     finally have "(\<Sum>i\<in>{0..m}-{j}. v ! i) = 0" by simp
     hence zero: "v ! i = 0" if "i \<in> {0..m}-{j}" for i using that
       by (subst (asm) sum_eq_0_iff) auto
       
     from j have "{0..m} = insert j ({0..m} - {j})" by auto
     also from j have "(\<Prod>i\<in>\<dots>. f $ (v ! i)) = f $ k * (\<Prod>i\<in>{0..m} - {j}. f $ (v ! i))"
       by (subst prod.insert) auto
     also have "(\<Prod>i\<in>{0..m} - {j}. f $ (v ! i)) = (\<Prod>i\<in>{0..m} - {j}. f $ 0)"
       by (intro prod.cong) (simp_all add: zero)
     also from j have "\<dots> = (f $ 0) ^ m" by (subst prod_constant) simp_all
     finally have "(\<Prod>j = 0..m. f $ (v ! j)) = f $ k * (f $ 0) ^ m" .
   } note A = this
   
   have "(f ^ Suc m) $ k = (\<Sum>v\<in>natpermute k (m + 1). \<Prod>j = 0..m. f $ v ! j)"
     by (rule fps_power_nth_Suc)
   also have "natpermute k (m+1) = A \<union> B" unfolding A_def B_def by blast
   also have "(\<Sum>v\<in>\<dots>. \<Prod>j = 0..m. f $ (v ! j)) = 
                (\<Sum>v\<in>A. \<Prod>j = 0..m. f $ (v ! j)) + (\<Sum>v\<in>B. \<Prod>j = 0..m. f $ (v ! j))"
     by (intro sum.union_disjoint) simp_all   
   also have "(\<Sum>v\<in>A. \<Prod>j = 0..m. f $ (v ! j)) = of_nat (Suc m) * (f $ k * (f $ 0) ^ m)"
     by (simp add: A card_A)
   finally show ?thesis by (simp add: B_def)
 qed 
   
 lemma fps_power_Suc_eqD:
   fixes f g :: "'a :: {idom,semiring_char_0} fps"
   assumes "f ^ Suc m = g ^ Suc m" "f $ 0 = g $ 0" "f $ 0 \<noteq> 0"
   shows   "f = g"
 proof (rule fps_ext)
   fix k :: nat
   show "f $ k = g $ k"
   proof (induction k rule: less_induct)
     case (less k)
     show ?case
     proof (cases "k = 0")
       case False
       let ?h = "\<lambda>f. (\<Sum>v | v \<in> natpermute k (m + 1) \<and> k \<notin> set v. \<Prod>j = 0..m. f $ v ! j)"
       from False fps_power_Suc_nth[of k f m] fps_power_Suc_nth[of k g m]
         have "f $ k * (of_nat (Suc m) * (f $ 0) ^ m) + ?h f =
                 g $ k * (of_nat (Suc m) * (f $ 0) ^ m) + ?h g" using assms 
         by (simp add: mult_ac del: power_Suc of_nat_Suc)
       also have "v ! i < k" if "v \<in> {v\<in>natpermute k (m+1). k \<notin> set v}" "i \<le> m" for v i
         using that elem_le_sum_list[of i v] unfolding natpermute_def
         by (auto simp: set_conv_nth dest!: spec[of _ i])
       hence "?h f = ?h g"
         by (intro sum.cong refl prod.cong less lessI) (simp add: natpermute_def)
       finally have "f $ k * (of_nat (Suc m) * (f $ 0) ^ m) = g $ k * (of_nat (Suc m) * (f $ 0) ^ m)"
         by simp
       with assms show "f $ k = g $ k" 
         by (subst (asm) mult_right_cancel) (auto simp del: of_nat_Suc)
     qed (simp_all add: assms)
   qed
 qed
 
 lemma fps_power_Suc_eqD':
   fixes f g :: "'a :: {idom,semiring_char_0} fps"
   assumes "f ^ Suc m = g ^ Suc m" "f $ subdegree f = g $ subdegree g"
   shows   "f = g"
 proof (cases "f = 0")
   case False
   have "Suc m * subdegree f = subdegree (f ^ Suc m)"
     by (rule subdegree_power [symmetric])
   also have "f ^ Suc m = g ^ Suc m" by fact
   also have "subdegree \<dots> = Suc m * subdegree g" by (rule subdegree_power)
   finally have [simp]: "subdegree f = subdegree g"
     by (subst (asm) Suc_mult_cancel1)
   have "fps_shift (subdegree f) f * fps_X ^ subdegree f = f"
     by (rule subdegree_decompose [symmetric])
   also have "\<dots> ^ Suc m = g ^ Suc m" by fact
   also have "g = fps_shift (subdegree g) g * fps_X ^ subdegree g"
     by (rule subdegree_decompose)
   also have "subdegree f = subdegree g" by fact
   finally have "fps_shift (subdegree g) f ^ Suc m = fps_shift (subdegree g) g ^ Suc m"
     by (simp add: algebra_simps power_mult_distrib del: power_Suc)
   hence "fps_shift (subdegree g) f = fps_shift (subdegree g) g"
     by (rule fps_power_Suc_eqD) (insert assms False, auto)
   with subdegree_decompose[of f] subdegree_decompose[of g] show ?thesis by simp
 qed (insert assms, simp_all)
 
 lemma fps_power_eqD':
   fixes f g :: "'a :: {idom,semiring_char_0} fps"
   assumes "f ^ m = g ^ m" "f $ subdegree f = g $ subdegree g" "m > 0"
   shows   "f = g"
   using fps_power_Suc_eqD'[of f "m-1" g] assms by simp
 
 lemma fps_power_eqD:
   fixes f g :: "'a :: {idom,semiring_char_0} fps"
   assumes "f ^ m = g ^ m" "f $ 0 = g $ 0" "f $ 0 \<noteq> 0" "m > 0"
   shows   "f = g"
   by (rule fps_power_eqD'[of f m g]) (insert assms, simp_all)
 
 lemma fps_compose_inj_right:
   assumes a0: "a$0 = (0::'a::idom)"
     and a1: "a$1 \<noteq> 0"
   shows "(b oo a = c oo a) \<longleftrightarrow> b = c"
   (is "?lhs \<longleftrightarrow>?rhs")
 proof
   show ?lhs if ?rhs using that by simp
   show ?rhs if ?lhs
   proof -
     have "b$n = c$n" for n
     proof (induct n rule: nat_less_induct)
       fix n
       assume H: "\<forall>m<n. b$m = c$m"
       show "b$n = c$n"
       proof (cases n)
         case 0
         from \<open>?lhs\<close> have "(b oo a)$n = (c oo a)$n"
           by simp
         then show ?thesis
           using 0 by (simp add: fps_compose_nth)
       next
         case (Suc n1)
         have f: "finite {0 .. n1}" "finite {n}" by simp_all
         have eq: "{0 .. n1} \<union> {n} = {0 .. n}" using Suc by auto
         have d: "{0 .. n1} \<inter> {n} = {}" using Suc by auto
         have seq: "(\<Sum>i = 0..n1. b $ i * a ^ i $ n) = (\<Sum>i = 0..n1. c $ i * a ^ i $ n)"
           using H Suc by auto
         have th0: "(b oo a) $n = (\<Sum>i = 0..n1. c $ i * a ^ i $ n) + b$n * (a$1)^n"
           unfolding fps_compose_nth sum.union_disjoint[OF f d, unfolded eq] seq
           using startsby_zero_power_nth_same[OF a0]
           by simp
         have th1: "(c oo a) $n = (\<Sum>i = 0..n1. c $ i * a ^ i $ n) + c$n * (a$1)^n"
           unfolding fps_compose_nth sum.union_disjoint[OF f d, unfolded eq]
           using startsby_zero_power_nth_same[OF a0]
           by simp
         from \<open>?lhs\<close>[unfolded fps_eq_iff, rule_format, of n] th0 th1 a1
         show ?thesis by auto
       qed
     qed
     then show ?rhs by (simp add: fps_eq_iff)
   qed
 qed
 
 
 subsection \<open>Radicals\<close>
 
 declare prod.cong [fundef_cong]
 
 function radical :: "(nat \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a::field fps \<Rightarrow> nat \<Rightarrow> 'a"
 where
   "radical r 0 a 0 = 1"
 | "radical r 0 a (Suc n) = 0"
 | "radical r (Suc k) a 0 = r (Suc k) (a$0)"
 | "radical r (Suc k) a (Suc n) =
     (a$ Suc n - sum (\<lambda>xs. prod (\<lambda>j. radical r (Suc k) a (xs ! j)) {0..k})
       {xs. xs \<in> natpermute (Suc n) (Suc k) \<and> Suc n \<notin> set xs}) /
     (of_nat (Suc k) * (radical r (Suc k) a 0)^k)"
   by pat_completeness auto
 
 termination radical
 proof
   let ?R = "measure (\<lambda>(r, k, a, n). n)"
   {
     show "wf ?R" by auto
   next
     fix r :: "nat \<Rightarrow> 'a \<Rightarrow> 'a"
     and a :: "'a fps"
     and k n xs i
     assume xs: "xs \<in> {xs \<in> natpermute (Suc n) (Suc k). Suc n \<notin> set xs}" and i: "i \<in> {0..k}"
     have False if c: "Suc n \<le> xs ! i"
     proof -
       from xs i have "xs !i \<noteq> Suc n"
         by (simp add: in_set_conv_nth natpermute_def)
       with c have c': "Suc n < xs!i" by arith
       have fths: "finite {0 ..< i}" "finite {i}" "finite {i+1..<Suc k}"
         by simp_all
       have d: "{0 ..< i} \<inter> ({i} \<union> {i+1 ..< Suc k}) = {}" "{i} \<inter> {i+1..< Suc k} = {}"
         by auto
       have eqs: "{0..<Suc k} = {0 ..< i} \<union> ({i} \<union> {i+1 ..< Suc k})"
         using i by auto
       from xs have "Suc n = sum_list xs"
         by (simp add: natpermute_def)
       also have "\<dots> = sum (nth xs) {0..<Suc k}" using xs
         by (simp add: natpermute_def sum_list_sum_nth)
       also have "\<dots> = xs!i + sum (nth xs) {0..<i} + sum (nth xs) {i+1..<Suc k}"
         unfolding eqs  sum.union_disjoint[OF fths(1) finite_UnI[OF fths(2,3)] d(1)]
         unfolding sum.union_disjoint[OF fths(2) fths(3) d(2)]
         by simp
       finally show ?thesis using c' by simp
     qed
     then show "((r, Suc k, a, xs!i), r, Suc k, a, Suc n) \<in> ?R"
       using not_less by auto
   next
     fix r :: "nat \<Rightarrow> 'a \<Rightarrow> 'a"
     and a :: "'a fps"
     and k n
     show "((r, Suc k, a, 0), r, Suc k, a, Suc n) \<in> ?R" by simp
   }
 qed
 
 definition "fps_radical r n a = Abs_fps (radical r n a)"
 
 lemma radical_0 [simp]: "\<And>n. 0 < n \<Longrightarrow> radical r 0 a n = 0"
   using radical.elims by blast
 
 lemma fps_radical0[simp]: "fps_radical r 0 a = 1"
   by (auto simp add: fps_eq_iff fps_radical_def)
 
 lemma fps_radical_nth_0[simp]: "fps_radical r n a $ 0 = (if n = 0 then 1 else r n (a$0))"
   by (cases n) (simp_all add: fps_radical_def)
 
 lemma fps_radical_power_nth[simp]:
   assumes r: "(r k (a$0)) ^ k = a$0"
   shows "fps_radical r k a ^ k $ 0 = (if k = 0 then 1 else a$0)"
 proof (cases k)
   case 0
   then show ?thesis by simp
 next
   case (Suc h)
   have eq1: "fps_radical r k a ^ k $ 0 = (\<Prod>j\<in>{0..h}. fps_radical r k a $ (replicate k 0) ! j)"
     unfolding fps_power_nth Suc by simp
   also have "\<dots> = (\<Prod>j\<in>{0..h}. r k (a$0))"
   proof (rule prod.cong [OF refl])
     show "fps_radical r k a $ replicate k 0 ! j = r k (a $ 0)" if "j \<in> {0..h}" for j
     proof -
       have "j < Suc h"
         using that by presburger
       then show ?thesis
         by (metis Suc fps_radical_nth_0 nth_replicate old.nat.distinct(2))
     qed
   qed
   also have "\<dots> = a$0"
     using r Suc by simp
   finally show ?thesis
     using Suc by simp
 qed
 
 lemma power_radical:
   fixes a:: "'a::field_char_0 fps"
   assumes a0: "a$0 \<noteq> 0"
   shows "(r (Suc k) (a$0)) ^ Suc k = a$0 \<longleftrightarrow> (fps_radical r (Suc k) a) ^ (Suc k) = a"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   let ?r = "fps_radical r (Suc k) a"
   show ?rhs if r0: ?lhs
   proof -
     from a0 r0 have r00: "r (Suc k) (a$0) \<noteq> 0" by auto
     have "?r ^ Suc k $ z = a$z" for z
     proof (induct z rule: nat_less_induct)
       fix n
       assume H: "\<forall>m<n. ?r ^ Suc k $ m = a$m"
       show "?r ^ Suc k $ n = a $n"
       proof (cases n)
         case 0
         then show ?thesis
           using fps_radical_power_nth[of r "Suc k" a, OF r0] by simp
       next
         case (Suc n1)
         then have "n \<noteq> 0" by simp
         let ?Pnk = "natpermute n (k + 1)"
         let ?Pnkn = "{xs \<in> ?Pnk. n \<in> set xs}"
         let ?Pnknn = "{xs \<in> ?Pnk. n \<notin> set xs}"
         have eq: "?Pnkn \<union> ?Pnknn = ?Pnk" by blast
         have d: "?Pnkn \<inter> ?Pnknn = {}" by blast
         have f: "finite ?Pnkn" "finite ?Pnknn"
           using finite_Un[of ?Pnkn ?Pnknn, unfolded eq]
           by (metis natpermute_finite)+
         let ?f = "\<lambda>v. \<Prod>j\<in>{0..k}. ?r $ v ! j"
         have "sum ?f ?Pnkn = sum (\<lambda>v. ?r $ n * r (Suc k) (a $ 0) ^ k) ?Pnkn"
         proof (rule sum.cong)
           fix v assume v: "v \<in> {xs \<in> natpermute n (k + 1). n \<in> set xs}"
           let ?ths = "(\<Prod>j\<in>{0..k}. fps_radical r (Suc k) a $ v ! j) =
             fps_radical r (Suc k) a $ n * r (Suc k) (a $ 0) ^ k"
           from v obtain i where i: "i \<in> {0..k}" "v = (replicate (k+1) 0) [i:= n]"
             unfolding natpermute_contain_maximal by auto
           have "(\<Prod>j\<in>{0..k}. fps_radical r (Suc k) a $ v ! j) =
                 (\<Prod>j\<in>{0..k}. if j = i then fps_radical r (Suc k) a $ n else r (Suc k) (a$0))"
               using i r0 by (auto simp del: replicate.simps intro: prod.cong)
           also have "\<dots> = (fps_radical r (Suc k) a $ n) * r (Suc k) (a$0) ^ k"
             using i r0 by (simp add: prod_gen_delta)
           finally show ?ths .
         qed rule
         then have "sum ?f ?Pnkn = of_nat (k+1) * ?r $ n * r (Suc k) (a $ 0) ^ k"
           by (simp add: natpermute_max_card[OF \<open>n \<noteq> 0\<close>, simplified])
         also have "\<dots> = a$n - sum ?f ?Pnknn"
           unfolding Suc using r00 a0 by (simp add: field_simps fps_radical_def del: of_nat_Suc)
         finally have fn: "sum ?f ?Pnkn = a$n - sum ?f ?Pnknn" .
         have "(?r ^ Suc k)$n = sum ?f ?Pnkn + sum ?f ?Pnknn"
           unfolding fps_power_nth_Suc sum.union_disjoint[OF f d, unfolded eq] ..
         also have "\<dots> = a$n" unfolding fn by simp
         finally show ?thesis .
       qed
     qed
     then show ?thesis using r0 by (simp add: fps_eq_iff)
   qed
   show ?lhs if ?rhs
   proof -
     from that have "((fps_radical r (Suc k) a) ^ (Suc k))$0 = a$0"
       by simp
     then show ?thesis
       unfolding fps_power_nth_Suc
       by (simp add: prod_constant del: replicate.simps)
   qed
 qed
 
 lemma radical_unique:
   assumes r0: "(r (Suc k) (b$0)) ^ Suc k = b$0"
     and a0: "r (Suc k) (b$0 ::'a::field_char_0) = a$0"
     and b0: "b$0 \<noteq> 0"
   shows "a^(Suc k) = b \<longleftrightarrow> a = fps_radical r (Suc k) b"
     (is "?lhs \<longleftrightarrow> ?rhs" is "_ \<longleftrightarrow> a = ?r")
 proof
   show ?lhs if ?rhs
     using that using power_radical[OF b0, of r k, unfolded r0] by simp
   show ?rhs if ?lhs
   proof -
     have r00: "r (Suc k) (b$0) \<noteq> 0" using b0 r0 by auto
     have ceq: "card {0..k} = Suc k" by simp
     from a0 have a0r0: "a$0 = ?r$0" by simp
     have "a $ n = ?r $ n" for n
     proof (induct n rule: nat_less_induct)
       fix n
       assume h: "\<forall>m<n. a$m = ?r $m"
       show "a$n = ?r $ n"
       proof (cases n)
         case 0
         then show ?thesis using a0 by simp
       next
         case (Suc n1)
         have fK: "finite {0..k}" by simp
         have nz: "n \<noteq> 0" using Suc by simp
         let ?Pnk = "natpermute n (Suc k)"
         let ?Pnkn = "{xs \<in> ?Pnk. n \<in> set xs}"
         let ?Pnknn = "{xs \<in> ?Pnk. n \<notin> set xs}"
         have eq: "?Pnkn \<union> ?Pnknn = ?Pnk" by blast
         have d: "?Pnkn \<inter> ?Pnknn = {}" by blast
         have f: "finite ?Pnkn" "finite ?Pnknn"
           using finite_Un[of ?Pnkn ?Pnknn, unfolded eq]
           by (metis natpermute_finite)+
         let ?f = "\<lambda>v. \<Prod>j\<in>{0..k}. ?r $ v ! j"
         let ?g = "\<lambda>v. \<Prod>j\<in>{0..k}. a $ v ! j"
         have "sum ?g ?Pnkn = sum (\<lambda>v. a $ n * (?r$0)^k) ?Pnkn"
         proof (rule sum.cong)
           fix v
           assume v: "v \<in> {xs \<in> natpermute n (Suc k). n \<in> set xs}"
           let ?ths = "(\<Prod>j\<in>{0..k}. a $ v ! j) = a $ n * (?r$0)^k"
           from v obtain i where i: "i \<in> {0..k}" "v = (replicate (k+1) 0) [i:= n]"
             unfolding Suc_eq_plus1 natpermute_contain_maximal
             by (auto simp del: replicate.simps)
           have "(\<Prod>j\<in>{0..k}. a $ v ! j) = (\<Prod>j\<in>{0..k}. if j = i then a $ n else r (Suc k) (b$0))"
             using i a0 by (auto simp del: replicate.simps intro: prod.cong)
           also have "\<dots> = a $ n * (?r $ 0)^k"
             using i by (simp add: prod_gen_delta)
           finally show ?ths .
         qed rule
         then have th0: "sum ?g ?Pnkn = of_nat (k+1) * a $ n * (?r $ 0)^k"
           by (simp add: natpermute_max_card[OF nz, simplified])
         have th1: "sum ?g ?Pnknn = sum ?f ?Pnknn"
         proof (rule sum.cong, rule refl, rule prod.cong, simp)
           fix xs i
           assume xs: "xs \<in> ?Pnknn" and i: "i \<in> {0..k}"
           have False if c: "n \<le> xs ! i"
           proof -
             from xs i have "xs ! i \<noteq> n"
               by (simp add: in_set_conv_nth natpermute_def)
             with c have c': "n < xs!i" by arith
             have fths: "finite {0 ..< i}" "finite {i}" "finite {i+1..<Suc k}"
               by simp_all
             have d: "{0 ..< i} \<inter> ({i} \<union> {i+1 ..< Suc k}) = {}" "{i} \<inter> {i+1..< Suc k} = {}"
               by auto
             have eqs: "{0..<Suc k} = {0 ..< i} \<union> ({i} \<union> {i+1 ..< Suc k})"
               using i by auto
             from xs have "n = sum_list xs"
               by (simp add: natpermute_def)
             also have "\<dots> = sum (nth xs) {0..<Suc k}"
               using xs by (simp add: natpermute_def sum_list_sum_nth)
             also have "\<dots> = xs!i + sum (nth xs) {0..<i} + sum (nth xs) {i+1..<Suc k}"
               unfolding eqs  sum.union_disjoint[OF fths(1) finite_UnI[OF fths(2,3)] d(1)]
               unfolding sum.union_disjoint[OF fths(2) fths(3) d(2)]
               by simp
             finally show ?thesis using c' by simp
           qed
           then have thn: "xs!i < n" by presburger
           from h[rule_format, OF thn] show "a$(xs !i) = ?r$(xs!i)" .
         qed
         have th00: "\<And>x::'a. of_nat (Suc k) * (x * inverse (of_nat (Suc k))) = x"
           by (simp add: field_simps del: of_nat_Suc)
         from \<open>?lhs\<close> have "b$n = a^Suc k $ n"
           by (simp add: fps_eq_iff)
         also have "a ^ Suc k$n = sum ?g ?Pnkn + sum ?g ?Pnknn"
           unfolding fps_power_nth_Suc
           using sum.union_disjoint[OF f d, unfolded Suc_eq_plus1[symmetric],
             unfolded eq, of ?g] by simp
         also have "\<dots> = of_nat (k+1) * a $ n * (?r $ 0)^k + sum ?f ?Pnknn"
           unfolding th0 th1 ..
         finally have \<section>: "of_nat (k+1) * a $ n * (?r $ 0)^k = b$n - sum ?f ?Pnknn"
           by simp
         have "a$n = (b$n - sum ?f ?Pnknn) / (of_nat (k+1) * (?r $ 0)^k)"
           apply (rule eq_divide_imp)
           using r00 \<section> by (simp_all add: ac_simps del: of_nat_Suc)
         then show ?thesis
           unfolding fps_radical_def Suc
           by (simp del: of_nat_Suc)
       qed
     qed
     then show ?rhs by (simp add: fps_eq_iff)
   qed
 qed
 
 
 lemma radical_power:
   assumes r0: "r (Suc k) ((a$0) ^ Suc k) = a$0"
     and a0: "(a$0 :: 'a::field_char_0) \<noteq> 0"
   shows "(fps_radical r (Suc k) (a ^ Suc k)) = a"
 proof -
   let ?ak = "a^ Suc k"
   have ak0: "?ak $ 0 = (a$0) ^ Suc k"
     by (simp add: fps_nth_power_0 del: power_Suc)
   from r0 have th0: "r (Suc k) (a ^ Suc k $ 0) ^ Suc k = a ^ Suc k $ 0"
     using ak0 by auto
   from r0 ak0 have th1: "r (Suc k) (a ^ Suc k $ 0) = a $ 0"
     by auto
   from ak0 a0 have ak00: "?ak $ 0 \<noteq>0 "
     by auto
   from radical_unique[of r k ?ak a, OF th0 th1 ak00] show ?thesis
     by metis
 qed
 
 lemma fps_deriv_radical':
   fixes a :: "'a::field_char_0 fps"
   assumes r0: "(r (Suc k) (a$0)) ^ Suc k = a$0"
     and a0: "a$0 \<noteq> 0"
   shows "fps_deriv (fps_radical r (Suc k) a) =
     fps_deriv a / ((of_nat (Suc k)) * (fps_radical r (Suc k) a) ^ k)"
 proof -
   let ?r = "fps_radical r (Suc k) a"
   let ?w = "(of_nat (Suc k)) * ?r ^ k"
   from a0 r0 have r0': "r (Suc k) (a$0) \<noteq> 0"
     by auto
   from r0' have w0: "?w $ 0 \<noteq> 0"
     by (simp del: of_nat_Suc)
   note th0 = inverse_mult_eq_1[OF w0]
   let ?iw = "inverse ?w"
   from iffD1[OF power_radical[of a r], OF a0 r0]
   have "fps_deriv (?r ^ Suc k) = fps_deriv a"
     by simp
   then have "fps_deriv ?r * ?w = fps_deriv a"
     by (simp add: fps_deriv_power' ac_simps del: power_Suc)
   then have "?iw * fps_deriv ?r * ?w = ?iw * fps_deriv a"
     by simp
   with a0 r0 have "fps_deriv ?r * (?iw * ?w) = fps_deriv a / ?w"
     by (subst fps_divide_unit) (auto simp del: of_nat_Suc)
   then show ?thesis unfolding th0 by simp
 qed
 
 lemma fps_deriv_radical:
   fixes a :: "'a::field_char_0 fps"
   assumes r0: "(r (Suc k) (a$0)) ^ Suc k = a$0"
     and a0: "a$0 \<noteq> 0"
   shows "fps_deriv (fps_radical r (Suc k) a) =
     fps_deriv a / (fps_const (of_nat (Suc k)) * (fps_radical r (Suc k) a) ^ k)"
   using fps_deriv_radical'[of r k a, OF r0 a0]
   by (simp add: fps_of_nat[symmetric])
 
 lemma radical_mult_distrib:
   fixes a :: "'a::field_char_0 fps"
   assumes k: "k > 0"
     and ra0: "r k (a $ 0) ^ k = a $ 0"
     and rb0: "r k (b $ 0) ^ k = b $ 0"
     and a0: "a $ 0 \<noteq> 0"
     and b0: "b $ 0 \<noteq> 0"
   shows "r k ((a * b) $ 0) = r k (a $ 0) * r k (b $ 0) \<longleftrightarrow>
     fps_radical r k (a * b) = fps_radical r k a * fps_radical r k b"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   show ?rhs if r0': ?lhs
   proof -
     from r0' have r0: "(r k ((a * b) $ 0)) ^ k = (a * b) $ 0"
       by (simp add: fps_mult_nth ra0 rb0 power_mult_distrib)
     show ?thesis
     proof (cases k)
       case 0
       then show ?thesis using r0' by simp
     next
       case (Suc h)
       let ?ra = "fps_radical r (Suc h) a"
       let ?rb = "fps_radical r (Suc h) b"
       have th0: "r (Suc h) ((a * b) $ 0) = (fps_radical r (Suc h) a * fps_radical r (Suc h) b) $ 0"
         using r0' Suc by (simp add: fps_mult_nth)
       have ab0: "(a*b) $ 0 \<noteq> 0"
         using a0 b0 by (simp add: fps_mult_nth)
       from radical_unique[of r h "a*b" "fps_radical r (Suc h) a * fps_radical r (Suc h) b", OF r0[unfolded Suc] th0 ab0, symmetric]
         iffD1[OF power_radical[of _ r], OF a0 ra0[unfolded Suc]] iffD1[OF power_radical[of _ r], OF b0 rb0[unfolded Suc]] Suc r0'
       show ?thesis
         by (auto simp add: power_mult_distrib simp del: power_Suc)
     qed
   qed
   show ?lhs if ?rhs
   proof -
     from that have "(fps_radical r k (a * b)) $ 0 = (fps_radical r k a * fps_radical r k b) $ 0"
       by simp
     then show ?thesis
       using k by (simp add: fps_mult_nth)
   qed
 qed
 
 (*
 lemma radical_mult_distrib:
   fixes a:: "'a::field_char_0 fps"
   assumes
   ra0: "r k (a $ 0) ^ k = a $ 0"
   and rb0: "r k (b $ 0) ^ k = b $ 0"
   and r0': "r k ((a * b) $ 0) = r k (a $ 0) * r k (b $ 0)"
   and a0: "a$0 \<noteq> 0"
   and b0: "b$0 \<noteq> 0"
   shows "fps_radical r (k) (a*b) = fps_radical r (k) a * fps_radical r (k) (b)"
 proof-
   from r0' have r0: "(r (k) ((a*b)$0)) ^ k = (a*b)$0"
     by (simp add: fps_mult_nth ra0 rb0 power_mult_distrib)
   {assume "k=0" then have ?thesis by simp}
   moreover
   {fix h assume k: "k = Suc h"
   let ?ra = "fps_radical r (Suc h) a"
   let ?rb = "fps_radical r (Suc h) b"
   have th0: "r (Suc h) ((a * b) $ 0) = (fps_radical r (Suc h) a * fps_radical r (Suc h) b) $ 0"
     using r0' k by (simp add: fps_mult_nth)
   have ab0: "(a*b) $ 0 \<noteq> 0" using a0 b0 by (simp add: fps_mult_nth)
   from radical_unique[of r h "a*b" "fps_radical r (Suc h) a * fps_radical r (Suc h) b", OF r0[unfolded k] th0 ab0, symmetric]
     power_radical[of r, OF ra0[unfolded k] a0] power_radical[of r, OF rb0[unfolded k] b0] k
   have ?thesis by (auto simp add: power_mult_distrib simp del: power_Suc)}
 ultimately show ?thesis by (cases k, auto)
 qed
 *)
 
 lemma radical_divide:
   fixes a :: "'a::field_char_0 fps"
   assumes kp: "k > 0"
     and ra0: "(r k (a $ 0)) ^ k = a $ 0"
     and rb0: "(r k (b $ 0)) ^ k = b $ 0"
     and a0: "a$0 \<noteq> 0"
     and b0: "b$0 \<noteq> 0"
   shows "r k ((a $ 0) / (b$0)) = r k (a$0) / r k (b $ 0) \<longleftrightarrow>
     fps_radical r k (a/b) = fps_radical r k a / fps_radical r k b"
   (is "?lhs = ?rhs")
 proof
   let ?r = "fps_radical r k"
   from kp obtain h where k: "k = Suc h"
     by (cases k) auto
   have ra0': "r k (a$0) \<noteq> 0" using a0 ra0 k by auto
   have rb0': "r k (b$0) \<noteq> 0" using b0 rb0 k by auto
 
   show ?lhs if ?rhs
   proof -
     from that have "?r (a/b) $ 0 = (?r a / ?r b)$0"
       by simp
     then show ?thesis
       using k a0 b0 rb0' by (simp add: fps_divide_unit fps_mult_nth fps_inverse_def divide_inverse)
   qed
   show ?rhs if ?lhs
   proof -
     from a0 b0 have ab0[simp]: "(a/b)$0 = a$0 / b$0"
       by (simp add: fps_divide_def fps_mult_nth divide_inverse fps_inverse_def)
     have th0: "r k ((a/b)$0) ^ k = (a/b)$0"
       by (simp add: \<open>?lhs\<close> power_divide ra0 rb0)
     from a0 b0 ra0' rb0' kp \<open>?lhs\<close>
     have th1: "r k ((a / b) $ 0) = (fps_radical r k a / fps_radical r k b) $ 0"
       by (simp add: fps_divide_unit fps_mult_nth fps_inverse_def divide_inverse)
     from a0 b0 ra0' rb0' kp have ab0': "(a / b) $ 0 \<noteq> 0"
       by (simp add: fps_divide_unit fps_mult_nth fps_inverse_def nonzero_imp_inverse_nonzero)
     note tha[simp] = iffD1[OF power_radical[where r=r and k=h], OF a0 ra0[unfolded k], unfolded k[symmetric]]
     note thb[simp] = iffD1[OF power_radical[where r=r and k=h], OF b0 rb0[unfolded k], unfolded k[symmetric]]
     from b0 rb0' have th2: "(?r a / ?r b)^k = a/b"
       by (simp add: fps_divide_unit power_mult_distrib fps_inverse_power[symmetric])
 
     from iffD1[OF radical_unique[where r=r and a="?r a / ?r b" and b="a/b" and k=h], symmetric, unfolded k[symmetric], OF th0 th1 ab0' th2]
     show ?thesis .
   qed
 qed
 
 lemma radical_inverse:
   fixes a :: "'a::field_char_0 fps"
   assumes k: "k > 0"
     and ra0: "r k (a $ 0) ^ k = a $ 0"
     and r1: "(r k 1)^k = 1"
     and a0: "a$0 \<noteq> 0"
   shows "r k (inverse (a $ 0)) = r k 1 / (r k (a $ 0)) \<longleftrightarrow>
     fps_radical r k (inverse a) = fps_radical r k 1 / fps_radical r k a"
   using radical_divide[where k=k and r=r and a=1 and b=a, OF k ] ra0 r1 a0
   by (simp add: divide_inverse fps_divide_def)
 
 
 subsection \<open>Derivative of composition\<close>
 
 lemma fps_compose_deriv:
   fixes a :: "'a::idom fps"
   assumes b0: "b$0 = 0"
   shows "fps_deriv (a oo b) = ((fps_deriv a) oo b) * fps_deriv b"
 proof -
   have "(fps_deriv (a oo b))$n = (((fps_deriv a) oo b) * (fps_deriv b)) $n" for n
   proof -
     have "(fps_deriv (a oo b))$n = sum (\<lambda>i. a $ i * (fps_deriv (b^i))$n) {0.. Suc n}"
       by (simp add: fps_compose_def field_simps sum_distrib_left del: of_nat_Suc)
     also have "\<dots> = sum (\<lambda>i. a$i * ((fps_const (of_nat i)) * (fps_deriv b * (b^(i - 1))))$n) {0.. Suc n}"
       by (simp add: field_simps fps_deriv_power del: fps_mult_left_const_nth of_nat_Suc)
     also have "\<dots> = sum (\<lambda>i. of_nat i * a$i * (((b^(i - 1)) * fps_deriv b))$n) {0.. Suc n}"
       unfolding fps_mult_left_const_nth  by (simp add: field_simps)
     also have "\<dots> = sum (\<lambda>i. of_nat i * a$i * (sum (\<lambda>j. (b^ (i - 1))$j * (fps_deriv b)$(n - j)) {0..n})) {0.. Suc n}"
       unfolding fps_mult_nth ..
     also have "\<dots> = sum (\<lambda>i. of_nat i * a$i * (sum (\<lambda>j. (b^ (i - 1))$j * (fps_deriv b)$(n - j)) {0..n})) {1.. Suc n}"
       by (intro sum.mono_neutral_right) (auto simp add: mult_delta_left not_le)
     also have "\<dots> = sum (\<lambda>i. of_nat (i + 1) * a$(i+1) * (sum (\<lambda>j. (b^ i)$j * of_nat (n - j + 1) * b$(n - j + 1)) {0..n})) {0.. n}"
       unfolding fps_deriv_nth
       by (rule sum.reindex_cong [of Suc]) (simp_all add: mult.assoc)
     finally have th0: "(fps_deriv (a oo b))$n =
       sum (\<lambda>i. of_nat (i + 1) * a$(i+1) * (sum (\<lambda>j. (b^ i)$j * of_nat (n - j + 1) * b$(n - j + 1)) {0..n})) {0.. n}" .
 
     have "(((fps_deriv a) oo b) * (fps_deriv b))$n = sum (\<lambda>i. (fps_deriv b)$ (n - i) * ((fps_deriv a) oo b)$i) {0..n}"
       unfolding fps_mult_nth by (simp add: ac_simps)
     also have "\<dots> = sum (\<lambda>i. sum (\<lambda>j. of_nat (n - i +1) * b$(n - i + 1) * of_nat (j + 1) * a$(j+1) * (b^j)$i) {0..n}) {0..n}"
       unfolding fps_deriv_nth fps_compose_nth sum_distrib_left mult.assoc
       by (auto simp: subset_eq b0 startsby_zero_power_prefix sum.mono_neutral_left intro: sum.cong)
     also have "\<dots> = sum (\<lambda>i. of_nat (i + 1) * a$(i+1) * (sum (\<lambda>j. (b^ i)$j * of_nat (n - j + 1) * b$(n - j + 1)) {0..n})) {0.. n}"
       unfolding sum_distrib_left
       by (subst sum.swap) (force intro: sum.cong)
     finally show ?thesis
       unfolding th0 by simp
   qed
   then show ?thesis by (simp add: fps_eq_iff)
 qed
 
 
 subsection \<open>Finite FPS (i.e. polynomials) and fps_X\<close>
 
 lemma fps_poly_sum_fps_X:
   assumes "\<forall>i > n. a$i = 0"
   shows "a = sum (\<lambda>i. fps_const (a$i) * fps_X^i) {0..n}" (is "a = ?r")
 proof -
   have "a$i = ?r$i" for i
     unfolding fps_sum_nth fps_mult_left_const_nth fps_X_power_nth
     by (simp add: mult_delta_right assms)
   then show ?thesis
     unfolding fps_eq_iff by blast
 qed
 
 
 subsection \<open>Compositional inverses\<close>
 
 fun compinv :: "'a fps \<Rightarrow> nat \<Rightarrow> 'a::field"
 where
   "compinv a 0 = fps_X$0"
 | "compinv a (Suc n) =
     (fps_X$ Suc n - sum (\<lambda>i. (compinv a i) * (a^i)$Suc n) {0 .. n}) / (a$1) ^ Suc n"
 
 definition "fps_inv a = Abs_fps (compinv a)"
 
 lemma fps_inv:
   assumes a0: "a$0 = 0"
     and a1: "a$1 \<noteq> 0"
   shows "fps_inv a oo a = fps_X"
 proof -
   let ?i = "fps_inv a oo a"
   have "?i $n = fps_X$n" for n
   proof (induct n rule: nat_less_induct)
     fix n
     assume h: "\<forall>m<n. ?i$m = fps_X$m"
     show "?i $ n = fps_X$n"
     proof (cases n)
       case 0
       then show ?thesis using a0
         by (simp add: fps_compose_nth fps_inv_def)
     next
       case (Suc n1)
       have "?i $ n = sum (\<lambda>i. (fps_inv a $ i) * (a^i)$n) {0 .. n1} + fps_inv a $ Suc n1 * (a $ 1)^ Suc n1"
         by (simp only: fps_compose_nth) (simp add: Suc startsby_zero_power_nth_same [OF a0] del: power_Suc)
       also have "\<dots> = sum (\<lambda>i. (fps_inv a $ i) * (a^i)$n) {0 .. n1} +
         (fps_X$ Suc n1 - sum (\<lambda>i. (fps_inv a $ i) * (a^i)$n) {0 .. n1})"
         using a0 a1 Suc by (simp add: fps_inv_def)
       also have "\<dots> = fps_X$n" using Suc by simp
       finally show ?thesis .
     qed
   qed
   then show ?thesis
     by (simp add: fps_eq_iff)
 qed
 
 
 fun gcompinv :: "'a fps \<Rightarrow> 'a fps \<Rightarrow> nat \<Rightarrow> 'a::field"
 where
   "gcompinv b a 0 = b$0"
 | "gcompinv b a (Suc n) =
     (b$ Suc n - sum (\<lambda>i. (gcompinv b a i) * (a^i)$Suc n) {0 .. n}) / (a$1) ^ Suc n"
 
 definition "fps_ginv b a = Abs_fps (gcompinv b a)"
 
 lemma fps_ginv:
   assumes a0: "a$0 = 0"
     and a1: "a$1 \<noteq> 0"
   shows "fps_ginv b a oo a = b"
 proof -
   let ?i = "fps_ginv b a oo a"
   have "?i $n = b$n" for n
   proof (induct n rule: nat_less_induct)
     fix n
     assume h: "\<forall>m<n. ?i$m = b$m"
     show "?i $ n = b$n"
     proof (cases n)
       case 0
       then show ?thesis using a0
         by (simp add: fps_compose_nth fps_ginv_def)
     next
       case (Suc n1)
       have "?i $ n = sum (\<lambda>i. (fps_ginv b a $ i) * (a^i)$n) {0 .. n1} + fps_ginv b a $ Suc n1 * (a $ 1)^ Suc n1"
         by (simp only: fps_compose_nth) (simp add: Suc startsby_zero_power_nth_same [OF a0] del: power_Suc)
       also have "\<dots> = sum (\<lambda>i. (fps_ginv b a $ i) * (a^i)$n) {0 .. n1} +
         (b$ Suc n1 - sum (\<lambda>i. (fps_ginv b a $ i) * (a^i)$n) {0 .. n1})"
         using a0 a1 Suc by (simp add: fps_ginv_def)
       also have "\<dots> = b$n" using Suc by simp
       finally show ?thesis .
     qed
   qed
   then show ?thesis
     by (simp add: fps_eq_iff)
 qed
 
 lemma fps_inv_ginv: "fps_inv = fps_ginv fps_X"
 proof -
   have "compinv x n = gcompinv fps_X x n" for n and x :: "'a fps"
   proof (induction n rule: nat_less_induct)
     case (1 n)
     then show ?case
       by (cases n) auto
   qed
   then show ?thesis
     by (auto simp add: fun_eq_iff fps_eq_iff fps_inv_def fps_ginv_def)
 qed
 
 lemma fps_compose_1[simp]: "1 oo a = 1"
   by (simp add: fps_eq_iff fps_compose_nth mult_delta_left)
 
 lemma fps_compose_0[simp]: "0 oo a = 0"
   by (simp add: fps_eq_iff fps_compose_nth)
 
 lemma fps_compose_0_right[simp]: "a oo 0 = fps_const (a $ 0)"
   by (simp add: fps_eq_iff fps_compose_nth power_0_left sum.neutral)
 
 lemma fps_compose_add_distrib: "(a + b) oo c = (a oo c) + (b oo c)"
   by (simp add: fps_eq_iff fps_compose_nth field_simps sum.distrib)
 
 lemma fps_compose_sum_distrib: "(sum f S) oo a = sum (\<lambda>i. f i oo a) S"
 proof (cases "finite S")
   case True
   show ?thesis
   proof (rule finite_induct[OF True])
     show "sum f {} oo a = (\<Sum>i\<in>{}. f i oo a)"
       by simp
   next
     fix x F
     assume fF: "finite F"
       and xF: "x \<notin> F"
       and h: "sum f F oo a = sum (\<lambda>i. f i oo a) F"
     show "sum f (insert x F) oo a  = sum (\<lambda>i. f i oo a) (insert x F)"
       using fF xF h by (simp add: fps_compose_add_distrib)
   qed
 next
   case False
   then show ?thesis by simp
 qed
 
 lemma convolution_eq:
   "sum (\<lambda>i. a (i :: nat) * b (n - i)) {0 .. n} =
     sum (\<lambda>(i,j). a i * b j) {(i,j). i \<le> n \<and> j \<le> n \<and> i + j = n}"
   by (rule sum.reindex_bij_witness[where i=fst and j="\<lambda>i. (i, n - i)"]) auto
 
 lemma product_composition_lemma:
   assumes c0: "c$0 = (0::'a::idom)"
     and d0: "d$0 = 0"
   shows "((a oo c) * (b oo d))$n =
     sum (\<lambda>(k,m). a$k * b$m * (c^k * d^m) $ n) {(k,m). k + m \<le> n}"  (is "?l = ?r")
 proof -
   let ?S = "{(k::nat, m::nat). k + m \<le> n}"
   have s: "?S \<subseteq> {0..n} \<times> {0..n}" by (simp add: subset_eq)
   have f: "finite {(k::nat, m::nat). k + m \<le> n}"
     by (auto intro: finite_subset[OF s])
   have "?r = (\<Sum>(k, m) \<in> {(k, m). k + m \<le> n}. \<Sum>j = 0..n. a $ k * b $ m * (c ^ k $ j * d ^ m $ (n - j)))"
     by (simp add: fps_mult_nth sum_distrib_left)
   also have "\<dots> = (\<Sum>i = 0..n. \<Sum>(k,m)\<in>{(k,m). k+m \<le> n}. a $ k * c ^ k $ i * b $ m * d ^ m $ (n-i))"
     unfolding sum.swap [where A = "{0..n}"] by (auto simp add: field_simps intro: sum.cong)
   also have "... = (\<Sum>i = 0..n.
                     \<Sum>q = 0..i. \<Sum>j = 0..n - i. a $ q * c ^ q $ i * (b $ j * d ^ j $ (n - i)))"
     apply (rule sum.cong [OF refl])
     apply (simp add: sum.cartesian_product mult.assoc)
     apply (rule sum.mono_neutral_right[OF f], force)
     by clarsimp (meson c0 d0 leI startsby_zero_power_prefix)
   also have "\<dots> = ?l"
     by (simp add: fps_mult_nth fps_compose_nth sum_product)
   finally show ?thesis by simp
 qed
 
 lemma sum_pair_less_iff:
   "sum (\<lambda>((k::nat),m). a k * b m * c (k + m)) {(k,m). k + m \<le> n} =
     sum (\<lambda>s. sum (\<lambda>i. a i * b (s - i) * c s) {0..s}) {0..n}"
   (is "?l = ?r")
 proof -
   have th0: "{(k, m). k + m \<le> n} = (\<Union>s\<in>{0..n}. \<Union>i\<in>{0..s}. {(i, s - i)})"
     by auto
   show "?l = ?r"
     unfolding th0
     by (simp add: sum.UNION_disjoint eq_diff_iff disjoint_iff)
 qed
 
 lemma fps_compose_mult_distrib_lemma:
   assumes c0: "c$0 = (0::'a::idom)"
   shows "((a oo c) * (b oo c))$n = sum (\<lambda>s. sum (\<lambda>i. a$i * b$(s - i) * (c^s) $ n) {0..s}) {0..n}"
   unfolding product_composition_lemma[OF c0 c0] power_add[symmetric]
   unfolding sum_pair_less_iff[where a = "\<lambda>k. a$k" and b="\<lambda>m. b$m" and c="\<lambda>s. (c ^ s)$n" and n = n] ..
 
 lemma fps_compose_mult_distrib:
   assumes c0: "c $ 0 = (0::'a::idom)"
   shows "(a * b) oo c = (a oo c) * (b oo c)"
 proof (clarsimp simp add: fps_eq_iff fps_compose_mult_distrib_lemma [OF c0])
   show "(a * b oo c) $ n = (\<Sum>s = 0..n. \<Sum>i = 0..s. a $ i * b $ (s - i) * c ^ s $ n)" for n
     by (simp add: fps_compose_nth fps_mult_nth sum_distrib_right)
 qed
 
 
 lemma fps_compose_prod_distrib:
   assumes c0: "c$0 = (0::'a::idom)"
   shows "prod a S oo c = prod (\<lambda>k. a k oo c) S"
 proof (induct S rule: infinite_finite_induct)
 next
   case (insert)
   then show ?case   
     by (simp add: fps_compose_mult_distrib[OF c0])
 qed auto
 
 lemma fps_compose_divide:
   assumes [simp]: "g dvd f" "h $ 0 = 0"
   shows   "fps_compose f h = fps_compose (f / g :: 'a :: field fps) h * fps_compose g h"
 proof -
   have "f = (f / g) * g" by simp
   also have "fps_compose \<dots> h = fps_compose (f / g) h * fps_compose g h"
     by (subst fps_compose_mult_distrib) simp_all
   finally show ?thesis .
 qed
 
 lemma fps_compose_divide_distrib:
   assumes "g dvd f" "h $ 0 = 0" "fps_compose g h \<noteq> 0"
   shows   "fps_compose (f / g :: 'a :: field fps) h = fps_compose f h / fps_compose g h"
   using fps_compose_divide[OF assms(1,2)] assms(3) by simp
 
 lemma fps_compose_power:
   assumes c0: "c$0 = (0::'a::idom)"
   shows "(a oo c)^n = a^n oo c"
 proof (cases n)
   case 0
   then show ?thesis by simp
 next
   case (Suc m)
   have "(\<Prod>n = 0..m. a) oo c = (\<Prod>n = 0..m. a oo c)"
     using c0 fps_compose_prod_distrib by blast
   moreover have th0: "a^n = prod (\<lambda>k. a) {0..m}" "(a oo c) ^ n = prod (\<lambda>k. a oo c) {0..m}"
     by (simp_all add: prod_constant Suc)
   ultimately show ?thesis
     by presburger
 qed
 
 lemma fps_compose_uminus: "- (a::'a::ring_1 fps) oo c = - (a oo c)"
   by (simp add: fps_eq_iff fps_compose_nth field_simps sum_negf[symmetric])
     
 lemma fps_compose_sub_distrib: "(a - b) oo (c::'a::ring_1 fps) = (a oo c) - (b oo c)"
   using fps_compose_add_distrib [of a "- b" c] by (simp add: fps_compose_uminus)
 
 lemma fps_X_fps_compose: "fps_X oo a = Abs_fps (\<lambda>n. if n = 0 then (0::'a::comm_ring_1) else a$n)"
   by (simp add: fps_eq_iff fps_compose_nth mult_delta_left)
 
 lemma fps_inverse_compose:
   assumes b0: "(b$0 :: 'a::field) = 0"
     and a0: "a$0 \<noteq> 0"
   shows "inverse a oo b = inverse (a oo b)"
 proof -
   let ?ia = "inverse a"
   let ?ab = "a oo b"
   let ?iab = "inverse ?ab"
 
   from a0 have ia0: "?ia $ 0 \<noteq> 0" by simp
   from a0 have ab0: "?ab $ 0 \<noteq> 0" by (simp add: fps_compose_def)
   have "(?ia oo b) *  (a oo b) = 1"
     unfolding fps_compose_mult_distrib[OF b0, symmetric]
     unfolding inverse_mult_eq_1[OF a0]
     fps_compose_1 ..
 
   then have "(?ia oo b) *  (a oo b) * ?iab  = 1 * ?iab" by simp
   then have "(?ia oo b) *  (?iab * (a oo b))  = ?iab" by simp
   then show ?thesis unfolding inverse_mult_eq_1[OF ab0] by simp
 qed
 
 lemma fps_divide_compose:
   assumes c0: "(c$0 :: 'a::field) = 0"
     and b0: "b$0 \<noteq> 0"
   shows "(a/b) oo c = (a oo c) / (b oo c)"
     using b0 c0 by (simp add: fps_divide_unit fps_inverse_compose fps_compose_mult_distrib)
 
 lemma gp:
   assumes a0: "a$0 = (0::'a::field)"
   shows "(Abs_fps (\<lambda>n. 1)) oo a = 1/(1 - a)"
     (is "?one oo a = _")
 proof -
   have o0: "?one $ 0 \<noteq> 0" by simp
   have th0: "(1 - fps_X) $ 0 \<noteq> (0::'a)" by simp
   from fps_inverse_gp[where ?'a = 'a]
   have "inverse ?one = 1 - fps_X" by (simp add: fps_eq_iff)
   then have "inverse (inverse ?one) = inverse (1 - fps_X)" by simp
   then have th: "?one = 1/(1 - fps_X)" unfolding fps_inverse_idempotent[OF o0]
     by (simp add: fps_divide_def)
   show ?thesis
     unfolding th
     unfolding fps_divide_compose[OF a0 th0]
     fps_compose_1 fps_compose_sub_distrib fps_X_fps_compose_startby0[OF a0] ..
 qed
 
 lemma fps_compose_radical:
   assumes b0: "b$0 = (0::'a::field_char_0)"
     and ra0: "r (Suc k) (a$0) ^ Suc k = a$0"
     and a0: "a$0 \<noteq> 0"
   shows "fps_radical r (Suc k)  a oo b = fps_radical r (Suc k) (a oo b)"
 proof -
   let ?r = "fps_radical r (Suc k)"
   let ?ab = "a oo b"
   have ab0: "?ab $ 0 = a$0"
     by (simp add: fps_compose_def)
   from ab0 a0 ra0 have rab0: "?ab $ 0 \<noteq> 0" "r (Suc k) (?ab $ 0) ^ Suc k = ?ab $ 0"
     by simp_all
   have th00: "r (Suc k) ((a oo b) $ 0) = (fps_radical r (Suc k) a oo b) $ 0"
     by (simp add: ab0 fps_compose_def)
   have th0: "(?r a oo b) ^ (Suc k) = a  oo b"
     unfolding fps_compose_power[OF b0]
     unfolding iffD1[OF power_radical[of a r k], OF a0 ra0]  ..
   from iffD1[OF radical_unique[where r=r and k=k and b= ?ab and a = "?r a oo b", OF rab0(2) th00 rab0(1)], OF th0]
   show ?thesis  .
 qed
 
 lemma fps_const_mult_apply_left: "fps_const c * (a oo b) = (fps_const c * a) oo b"
   by (simp add: fps_eq_iff fps_compose_nth sum_distrib_left mult.assoc)
 
 lemma fps_const_mult_apply_right:
   "(a oo b) * fps_const (c::'a::comm_semiring_1) = (fps_const c * a) oo b"
   by (simp add: fps_const_mult_apply_left mult.commute)
 
 lemma fps_compose_assoc:
   assumes c0: "c$0 = (0::'a::idom)"
     and b0: "b$0 = 0"
   shows "a oo (b oo c) = a oo b oo c" (is "?l = ?r")
 proof -
   have "?l$n = ?r$n" for n
   proof -
     have "?l$n = (sum (\<lambda>i. (fps_const (a$i) * b^i) oo c) {0..n})$n"
       by (simp add: fps_compose_nth fps_compose_power[OF c0] fps_const_mult_apply_left
         sum_distrib_left mult.assoc fps_sum_nth)
     also have "\<dots> = ((sum (\<lambda>i. fps_const (a$i) * b^i) {0..n}) oo c)$n"
       by (simp add: fps_compose_sum_distrib)
     also have "... = (\<Sum>i = 0..n. \<Sum>j = 0..n. a $ j * (b ^ j $ i * c ^ i $ n))"
       by (simp add: fps_compose_nth fps_sum_nth sum_distrib_right mult.assoc)
     also have "... = (\<Sum>i = 0..n. \<Sum>j = 0..i. a $ j * (b ^ j $ i * c ^ i $ n))"
       by (intro sum.cong [OF refl] sum.mono_neutral_right; simp add: b0 startsby_zero_power_prefix)
     also have "\<dots> = ?r$n"
       by (simp add: fps_compose_nth  sum_distrib_right mult.assoc)
     finally show ?thesis .
   qed
   then show ?thesis
     by (simp add: fps_eq_iff)
 qed
 
 
 lemma fps_X_power_compose:
   assumes a0: "a$0=0"
   shows "fps_X^k oo a = (a::'a::idom fps)^k"
   (is "?l = ?r")
 proof (cases k)
   case 0
   then show ?thesis by simp
 next
   case (Suc h)
   have "?l $ n = ?r $n" for n
   proof -
     consider "k > n" | "k \<le> n" by arith
     then show ?thesis
     proof cases
       case 1
       then show ?thesis
         using a0 startsby_zero_power_prefix[OF a0] Suc
         by (simp add: fps_compose_nth del: power_Suc)
     next
       case 2
       then show ?thesis
         by (simp add: fps_compose_nth mult_delta_left)
     qed
   qed
   then show ?thesis
     unfolding fps_eq_iff by blast
 qed
 
 lemma fps_inv_right:
   assumes a0: "a$0 = 0"
     and a1: "a$1 \<noteq> 0"
   shows "a oo fps_inv a = fps_X"
 proof -
   let ?ia = "fps_inv a"
   let ?iaa = "a oo fps_inv a"
   have th0: "?ia $ 0 = 0"
     by (simp add: fps_inv_def)
   have th1: "?iaa $ 0 = 0"
     using a0 a1 by (simp add: fps_inv_def fps_compose_nth)
   have th2: "fps_X$0 = 0"
     by simp
   from fps_inv[OF a0 a1] have "a oo (fps_inv a oo a) = a oo fps_X"
     by simp
   then have "(a oo fps_inv a) oo a = fps_X oo a"
     by (simp add: fps_compose_assoc[OF a0 th0] fps_X_fps_compose_startby0[OF a0])
   with fps_compose_inj_right[OF a0 a1] show ?thesis
     by simp
 qed
 
 lemma fps_inv_deriv:
   assumes a0: "a$0 = (0::'a::field)"
     and a1: "a$1 \<noteq> 0"
   shows "fps_deriv (fps_inv a) = inverse (fps_deriv a oo fps_inv a)"
 proof -
   let ?ia = "fps_inv a"
   let ?d = "fps_deriv a oo ?ia"
   let ?dia = "fps_deriv ?ia"
   have ia0: "?ia$0 = 0"
     by (simp add: fps_inv_def)
   have th0: "?d$0 \<noteq> 0"
     using a1 by (simp add: fps_compose_nth)
   from fps_inv_right[OF a0 a1] have "?d * ?dia = 1"
     by (simp add: fps_compose_deriv[OF ia0, of a, symmetric] )
   then have "inverse ?d * ?d * ?dia = inverse ?d * 1"
     by simp
   with inverse_mult_eq_1 [OF th0] show "?dia = inverse ?d"
     by simp
 qed
 
 lemma fps_inv_idempotent:
   assumes a0: "a$0 = 0"
     and a1: "a$1 \<noteq> 0"
   shows "fps_inv (fps_inv a) = a"
 proof -
   let ?r = "fps_inv"
   have ra0: "?r a $ 0 = 0"
     by (simp add: fps_inv_def)
   from a1 have ra1: "?r a $ 1 \<noteq> 0"
     by (simp add: fps_inv_def field_simps)
   have fps_X0: "fps_X$0 = 0"
     by simp
   from fps_inv[OF ra0 ra1] have "?r (?r a) oo ?r a = fps_X" .
   then have "?r (?r a) oo ?r a oo a = fps_X oo a"
     by simp
   then have "?r (?r a) oo (?r a oo a) = a"
     unfolding fps_X_fps_compose_startby0[OF a0]
     unfolding fps_compose_assoc[OF a0 ra0, symmetric] .
   then show ?thesis
     unfolding fps_inv[OF a0 a1] by simp
 qed
 
 lemma fps_ginv_ginv:
   assumes a0: "a$0 = 0"
     and a1: "a$1 \<noteq> 0"
     and c0: "c$0 = 0"
     and  c1: "c$1 \<noteq> 0"
   shows "fps_ginv b (fps_ginv c a) = b oo a oo fps_inv c"
 proof -
   let ?r = "fps_ginv"
   from c0 have rca0: "?r c a $0 = 0"
     by (simp add: fps_ginv_def)
   from a1 c1 have rca1: "?r c a $ 1 \<noteq> 0"
     by (simp add: fps_ginv_def field_simps)
   from fps_ginv[OF rca0 rca1]
   have "?r b (?r c a) oo ?r c a = b" .
   then have "?r b (?r c a) oo ?r c a oo a = b oo a"
     by simp
   then have "?r b (?r c a) oo (?r c a oo a) = b oo a"
     by (simp add: a0 fps_compose_assoc rca0)
   then have "?r b (?r c a) oo c = b oo a"
     unfolding fps_ginv[OF a0 a1] .
   then have "?r b (?r c a) oo c oo fps_inv c= b oo a oo fps_inv c"
     by simp
   then have "?r b (?r c a) oo (c oo fps_inv c) = b oo a oo fps_inv c"
     by (metis c0 c1 fps_compose_assoc fps_compose_nth_0 fps_inv fps_inv_right)
   then show ?thesis
     unfolding fps_inv_right[OF c0 c1] by simp
 qed
 
 lemma fps_ginv_deriv:
   assumes a0:"a$0 = (0::'a::field)"
     and a1: "a$1 \<noteq> 0"
   shows "fps_deriv (fps_ginv b a) = (fps_deriv b / fps_deriv a) oo fps_ginv fps_X a"
 proof -
   let ?ia = "fps_ginv b a"
   let ?ifps_Xa = "fps_ginv fps_X a"
   let ?d = "fps_deriv"
   let ?dia = "?d ?ia"
   have ifps_Xa0: "?ifps_Xa $ 0 = 0"
     by (simp add: fps_ginv_def)
   have da0: "?d a $ 0 \<noteq> 0"
     using a1 by simp
   from fps_ginv[OF a0 a1, of b] have "?d (?ia oo a) = fps_deriv b"
     by simp
   then have "(?d ?ia oo a) * ?d a = ?d b"
     unfolding fps_compose_deriv[OF a0] .
   then have "(?d ?ia oo a) * ?d a * inverse (?d a) = ?d b * inverse (?d a)"
     by simp
   with a1 have "(?d ?ia oo a) * (inverse (?d a) * ?d a) = ?d b / ?d a"
     by (simp add: fps_divide_unit)
   then have "(?d ?ia oo a) oo ?ifps_Xa =  (?d b / ?d a) oo ?ifps_Xa"
     unfolding inverse_mult_eq_1[OF da0] by simp
   then have "?d ?ia oo (a oo ?ifps_Xa) =  (?d b / ?d a) oo ?ifps_Xa"
     unfolding fps_compose_assoc[OF ifps_Xa0 a0] .
   then show ?thesis unfolding fps_inv_ginv[symmetric]
     unfolding fps_inv_right[OF a0 a1] by simp
 qed
 
 lemma fps_compose_linear:
   "fps_compose (f :: 'a :: comm_ring_1 fps) (fps_const c * fps_X) = Abs_fps (\<lambda>n. c^n * f $ n)"
   by (simp add: fps_eq_iff fps_compose_def power_mult_distrib
                 if_distrib cong: if_cong)
               
 lemma fps_compose_uminus': 
   "fps_compose f (-fps_X :: 'a :: comm_ring_1 fps) = Abs_fps (\<lambda>n. (-1)^n * f $ n)"
   using fps_compose_linear[of f "-1"] 
   by (simp only: fps_const_neg [symmetric] fps_const_1_eq_1) simp
 
 subsection \<open>Elementary series\<close>
 
 subsubsection \<open>Exponential series\<close>
 
 definition "fps_exp x = Abs_fps (\<lambda>n. x^n / of_nat (fact n))"
 
 lemma fps_exp_deriv[simp]: "fps_deriv (fps_exp a) = fps_const (a::'a::field_char_0) * fps_exp a" 
   (is "?l = ?r")
 proof -
   have "?l$n = ?r $ n" for n
     using of_nat_neq_0 by (auto simp add: fps_exp_def divide_simps)
   then show ?thesis
     by (simp add: fps_eq_iff)
 qed
 
 lemma fps_exp_unique_ODE:
   "fps_deriv a = fps_const c * a \<longleftrightarrow> a = fps_const (a$0) * fps_exp (c::'a::field_char_0)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   show ?rhs if ?lhs
   proof -
     from that have th: "\<And>n. a $ Suc n = c * a$n / of_nat (Suc n)"
       by (simp add: fps_deriv_def fps_eq_iff field_simps del: of_nat_Suc)
     have th': "a$n = a$0 * c ^ n/ (fact n)" for n
     proof (induct n)
       case 0
       then show ?case by simp
     next
       case Suc
       then show ?case
         by (simp add: th divide_simps)
     qed
     show ?thesis
       by (auto simp add: fps_eq_iff fps_const_mult_left fps_exp_def intro: th')
   qed
   show ?lhs if ?rhs
     using that by (metis fps_exp_deriv fps_deriv_mult_const_left mult.left_commute)
 qed
 
 lemma fps_exp_add_mult: "fps_exp (a + b) = fps_exp (a::'a::field_char_0) * fps_exp b" (is "?l = ?r")
 proof -
   have "fps_deriv ?r = fps_const (a + b) * ?r"
     by (simp add: fps_const_add[symmetric] field_simps del: fps_const_add)
   then have "?r = ?l"
     by (simp only: fps_exp_unique_ODE) (simp add: fps_mult_nth fps_exp_def)
   then show ?thesis ..
 qed
 
 lemma fps_exp_nth[simp]: "fps_exp a $ n = a^n / of_nat (fact n)"
   by (simp add: fps_exp_def)
 
 lemma fps_exp_0[simp]: "fps_exp (0::'a::field) = 1"
   by (simp add: fps_eq_iff power_0_left)
 
 lemma fps_exp_neg: "fps_exp (- a) = inverse (fps_exp (a::'a::field_char_0))"
 proof -
   from fps_exp_add_mult[of a "- a"] have th0: "fps_exp a * fps_exp (- a) = 1" by simp
   from fps_inverse_unique[OF th0] show ?thesis by simp
 qed
 
 lemma fps_exp_nth_deriv[simp]: 
   "fps_nth_deriv n (fps_exp (a::'a::field_char_0)) = (fps_const a)^n * (fps_exp a)"
   by (induct n) auto
 
 lemma fps_X_compose_fps_exp[simp]: "fps_X oo fps_exp (a::'a::field) = fps_exp a - 1"
   by (simp add: fps_eq_iff fps_X_fps_compose)
 
 lemma fps_inv_fps_exp_compose:
   assumes a: "a \<noteq> 0"
   shows "fps_inv (fps_exp a - 1) oo (fps_exp a - 1) = fps_X"
     and "(fps_exp a - 1) oo fps_inv (fps_exp a - 1) = fps_X"
 proof -
   let ?b = "fps_exp a - 1"
   have b0: "?b $ 0 = 0"
     by simp
   have b1: "?b $ 1 \<noteq> 0"
     by (simp add: a)
   from fps_inv[OF b0 b1] show "fps_inv (fps_exp a - 1) oo (fps_exp a - 1) = fps_X" .
   from fps_inv_right[OF b0 b1] show "(fps_exp a - 1) oo fps_inv (fps_exp a - 1) = fps_X" .
 qed
 
 lemma fps_exp_power_mult: "(fps_exp (c::'a::field_char_0))^n = fps_exp (of_nat n * c)"
   by (induct n) (simp_all add: field_simps fps_exp_add_mult)
 
 lemma radical_fps_exp:
   assumes r: "r (Suc k) 1 = 1"
   shows "fps_radical r (Suc k) (fps_exp (c::'a::field_char_0)) = fps_exp (c / of_nat (Suc k))"
 proof -
   let ?ck = "(c / of_nat (Suc k))"
   let ?r = "fps_radical r (Suc k)"
   have eq0[simp]: "?ck * of_nat (Suc k) = c" "of_nat (Suc k) * ?ck = c"
     by (simp_all del: of_nat_Suc)
   have th0: "fps_exp ?ck ^ (Suc k) = fps_exp c" unfolding fps_exp_power_mult eq0 ..
   have th: "r (Suc k) (fps_exp c $0) ^ Suc k = fps_exp c $ 0"
     "r (Suc k) (fps_exp c $ 0) = fps_exp ?ck $ 0" "fps_exp c $ 0 \<noteq> 0" using r by simp_all
   from th0 radical_unique[where r=r and k=k, OF th] show ?thesis
     by auto
 qed
 
 lemma fps_exp_compose_linear [simp]: 
   "fps_exp (d::'a::field_char_0) oo (fps_const c * fps_X) = fps_exp (c * d)"
   by (simp add: fps_compose_linear fps_exp_def fps_eq_iff power_mult_distrib)
   
 lemma fps_fps_exp_compose_minus [simp]: 
   "fps_compose (fps_exp c) (-fps_X) = fps_exp (-c :: 'a :: field_char_0)"
   using fps_exp_compose_linear[of c "-1 :: 'a"] 
   unfolding fps_const_neg [symmetric] fps_const_1_eq_1 by simp
 
 lemma fps_exp_eq_iff [simp]: "fps_exp c = fps_exp d \<longleftrightarrow> c = (d :: 'a :: field_char_0)"
 proof
   assume "fps_exp c = fps_exp d"
   from arg_cong[of _ _ "\<lambda>F. F $ 1", OF this] show "c = d" by simp
 qed simp_all
 
 lemma fps_exp_eq_fps_const_iff [simp]: 
   "fps_exp (c :: 'a :: field_char_0) = fps_const c' \<longleftrightarrow> c = 0 \<and> c' = 1"
 proof
   assume "c = 0 \<and> c' = 1"
   thus "fps_exp c = fps_const c'" by (simp add: fps_eq_iff)
 next
   assume "fps_exp c = fps_const c'"
   from arg_cong[of _ _ "\<lambda>F. F $ 1", OF this] arg_cong[of _ _ "\<lambda>F. F $ 0", OF this] 
     show "c = 0 \<and> c' = 1" by simp_all
 qed
 
 lemma fps_exp_neq_0 [simp]: "\<not>fps_exp (c :: 'a :: field_char_0) = 0"
   unfolding fps_const_0_eq_0 [symmetric] fps_exp_eq_fps_const_iff by simp  
 
 lemma fps_exp_eq_1_iff [simp]: "fps_exp (c :: 'a :: field_char_0) = 1 \<longleftrightarrow> c = 0"
   unfolding fps_const_1_eq_1 [symmetric] fps_exp_eq_fps_const_iff by simp
     
 lemma fps_exp_neq_numeral_iff [simp]: 
   "fps_exp (c :: 'a :: field_char_0) = numeral n \<longleftrightarrow> c = 0 \<and> n = Num.One"
   unfolding numeral_fps_const fps_exp_eq_fps_const_iff by simp
 
 
 subsubsection \<open>Logarithmic series\<close>
 
 lemma Abs_fps_if_0:
   "Abs_fps (\<lambda>n. if n = 0 then (v::'a::ring_1) else f n) =
     fps_const v + fps_X * Abs_fps (\<lambda>n. f (Suc n))"
   by (simp add: fps_eq_iff)
 
 definition fps_ln :: "'a::field_char_0 \<Rightarrow> 'a fps"
   where "fps_ln c = fps_const (1/c) * Abs_fps (\<lambda>n. if n = 0 then 0 else (- 1) ^ (n - 1) / of_nat n)"
 
 lemma fps_ln_deriv: "fps_deriv (fps_ln c) = fps_const (1/c) * inverse (1 + fps_X)"
   unfolding fps_inverse_fps_X_plus1
   by (simp add: fps_ln_def fps_eq_iff del: of_nat_Suc)
 
 lemma fps_ln_nth: "fps_ln c $ n = (if n = 0 then 0 else 1/c * ((- 1) ^ (n - 1) / of_nat n))"
   by (simp add: fps_ln_def field_simps)
 
 lemma fps_ln_0 [simp]: "fps_ln c $ 0 = 0" by (simp add: fps_ln_def)
 
 lemma fps_ln_fps_exp_inv:
   fixes a :: "'a::field_char_0"
   assumes a: "a \<noteq> 0"
   shows "fps_ln a = fps_inv (fps_exp a - 1)"  (is "?l = ?r")
 proof -
   let ?b = "fps_exp a - 1"
   have b0: "?b $ 0 = 0" by simp
   have b1: "?b $ 1 \<noteq> 0" by (simp add: a)
   have "fps_deriv (fps_exp a - 1) oo fps_inv (fps_exp a - 1) =
     (fps_const a * (fps_exp a - 1) + fps_const a) oo fps_inv (fps_exp a - 1)"
     by (simp add: field_simps)
   also have "\<dots> = fps_const a * (fps_X + 1)"
     by (simp add: fps_compose_add_distrib fps_inv_right[OF b0 b1] distrib_left flip: fps_const_mult_apply_left)
   finally have eq: "fps_deriv (fps_exp a - 1) oo fps_inv (fps_exp a - 1) = fps_const a * (fps_X + 1)" .
   from fps_inv_deriv[OF b0 b1, unfolded eq]
   have "fps_deriv (fps_inv ?b) = fps_const (inverse a) / (fps_X + 1)"
     using a by (simp add: fps_const_inverse eq fps_divide_def fps_inverse_mult)
   then have "fps_deriv ?l = fps_deriv ?r"
     by (simp add: fps_ln_deriv add.commute fps_divide_def divide_inverse)
   then show ?thesis unfolding fps_deriv_eq_iff
     by (simp add: fps_ln_nth fps_inv_def)
 qed
 
 lemma fps_ln_mult_add:
   assumes c0: "c\<noteq>0"
     and d0: "d\<noteq>0"
   shows "fps_ln c + fps_ln d = fps_const (c+d) * fps_ln (c*d)"
   (is "?r = ?l")
 proof-
   from c0 d0 have eq: "1/c + 1/d = (c+d)/(c*d)" by (simp add: field_simps)
   have "fps_deriv ?r = fps_const (1/c + 1/d) * inverse (1 + fps_X)"
     by (simp add: fps_ln_deriv fps_const_add[symmetric] algebra_simps del: fps_const_add)
   also have "\<dots> = fps_deriv ?l"
     by (simp add: eq fps_ln_deriv)
   finally show ?thesis
     unfolding fps_deriv_eq_iff by simp
 qed
 
 lemma fps_X_dvd_fps_ln [simp]: "fps_X dvd fps_ln c"
 proof -
   have "fps_ln c = fps_X * Abs_fps (\<lambda>n. (-1) ^ n / (of_nat (Suc n) * c))"
     by (intro fps_ext) (simp add: fps_ln_def of_nat_diff)
   thus ?thesis by simp
 qed
 
 
 subsubsection \<open>Binomial series\<close>
 
 definition "fps_binomial a = Abs_fps (\<lambda>n. a gchoose n)"
 
 lemma fps_binomial_nth[simp]: "fps_binomial a $ n = a gchoose n"
   by (simp add: fps_binomial_def)
 
 lemma fps_binomial_ODE_unique:
   fixes c :: "'a::field_char_0"
   shows "fps_deriv a = (fps_const c * a) / (1 + fps_X) \<longleftrightarrow> a = fps_const (a$0) * fps_binomial c"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   let ?da = "fps_deriv a"
   let ?x1 = "(1 + fps_X):: 'a fps"
   let ?l = "?x1 * ?da"
   let ?r = "fps_const c * a"
 
   have eq: "?l = ?r \<longleftrightarrow> ?lhs"
   proof -
     have x10: "?x1 $ 0 \<noteq> 0" by simp
     have "?l = ?r \<longleftrightarrow> inverse ?x1 * ?l = inverse ?x1 * ?r" by simp
     also have "\<dots> \<longleftrightarrow> ?da = (fps_const c * a) / ?x1"
       unfolding fps_divide_def  mult.assoc[symmetric] inverse_mult_eq_1[OF x10]
       by (simp add: field_simps)
     finally show ?thesis .
   qed
 
   show ?rhs if ?lhs
   proof -
     from eq that have h: "?l = ?r" ..
     have th0: "a$ Suc n = ((c - of_nat n) / of_nat (Suc n)) * a $n" for n
     proof -
       from h have "?l $ n = ?r $ n" by simp
       then show ?thesis
         by (simp add: field_simps del: of_nat_Suc split: if_split_asm)
     qed
     have th1: "a $ n = (c gchoose n) * a $ 0" for n
     proof (induct n)
       case 0
       then show ?case by simp
     next
       case (Suc m)
       have "(c - of_nat m) * (c gchoose m) = (c gchoose Suc m) * of_nat (Suc m)"
         by (metis gbinomial_absorb_comp gbinomial_absorption mult.commute)
       with Suc show ?case
         unfolding th0
         by (simp add: divide_simps del: of_nat_Suc)
     qed
     show ?thesis
       by (metis expand_fps_eq fps_binomial_nth fps_mult_right_const_nth mult.commute th1)
   qed
 
   show ?lhs if ?rhs
   proof -
     have th00: "x * (a $ 0 * y) = a $ 0 * (x * y)" for x y
       by (simp add: mult.commute)
     have "?l = (1 + fps_X) * fps_deriv (fps_const (a $ 0) * fps_binomial c)"
       using that by auto
     also have "... = fps_const c * (fps_const (a $ 0) * fps_binomial c)"
     proof (clarsimp simp add: fps_eq_iff algebra_simps)
       show "a $ 0 * (c gchoose Suc n) + (of_nat n * ((c gchoose n) * a $ 0) + of_nat n * (a $ 0 * (c gchoose Suc n))) 
          = c * ((c gchoose n) * a $ 0)" for n
       unfolding mult.assoc[symmetric]  
       by (simp add: field_simps gbinomial_mult_1)
   qed
     also have "... = ?r"
       using that by auto
     finally have "?l = ?r" .
     with eq show ?thesis ..
   qed
 qed
 
 lemma fps_binomial_ODE_unique':
   "(fps_deriv a = fps_const c * a / (1 + fps_X) \<and> a $ 0 = 1) \<longleftrightarrow> (a = fps_binomial c)"
   by (subst fps_binomial_ODE_unique) auto
 
 lemma fps_binomial_deriv: "fps_deriv (fps_binomial c) = fps_const c * fps_binomial c / (1 + fps_X)"
 proof -
   let ?a = "fps_binomial c"
   have th0: "?a = fps_const (?a$0) * ?a" by (simp)
   from iffD2[OF fps_binomial_ODE_unique, OF th0] show ?thesis .
 qed
 
 lemma fps_binomial_add_mult: "fps_binomial (c+d) = fps_binomial c * fps_binomial d" (is "?l = ?r")
 proof -
   let ?P = "?r - ?l"
   let ?b = "fps_binomial"
   let ?db = "\<lambda>x. fps_deriv (?b x)"
   have "fps_deriv ?P = ?db c * ?b d + ?b c * ?db d - ?db (c + d)"  by simp
   also have "\<dots> = inverse (1 + fps_X) *
       (fps_const c * ?b c * ?b d + fps_const d * ?b c * ?b d - fps_const (c+d) * ?b (c + d))"
     unfolding fps_binomial_deriv
     by (simp add: fps_divide_def field_simps)
   also have "\<dots> = (fps_const (c + d)/ (1 + fps_X)) * ?P"
     by (simp add: field_simps fps_divide_unit fps_const_add[symmetric] del: fps_const_add)
   finally have th0: "fps_deriv ?P = fps_const (c+d) * ?P / (1 + fps_X)"
     by (simp add: fps_divide_def)
   have "?P = fps_const (?P$0) * ?b (c + d)"
     unfolding fps_binomial_ODE_unique[symmetric]
     using th0 by simp
   then have "?P = 0" by (simp add: fps_mult_nth)
   then show ?thesis by simp
 qed
 
 lemma fps_binomial_minus_one: "fps_binomial (- 1) = inverse (1 + fps_X)"
   (is "?l = inverse ?r")
 proof-
   have th: "?r$0 \<noteq> 0" by simp
   have th': "fps_deriv (inverse ?r) = fps_const (- 1) * inverse ?r / (1 + fps_X)"
     by (simp add: fps_inverse_deriv[OF th] fps_divide_def
       power2_eq_square mult.commute fps_const_neg[symmetric] del: fps_const_neg)
   have eq: "inverse ?r $ 0 = 1"
     by (simp add: fps_inverse_def)
   from iffD1[OF fps_binomial_ODE_unique[of "inverse (1 + fps_X)" "- 1"] th'] eq
   show ?thesis by (simp add: fps_inverse_def)
 qed
 
 lemma fps_binomial_of_nat: "fps_binomial (of_nat n) = (1 + fps_X :: 'a :: field_char_0 fps) ^ n"
 proof (cases "n = 0")
   case [simp]: True
   have "fps_deriv ((1 + fps_X) ^ n :: 'a fps) = 0" by simp
   also have "\<dots> = fps_const (of_nat n) * (1 + fps_X) ^ n / (1 + fps_X)" by (simp add: fps_binomial_def)
   finally show ?thesis by (subst sym, subst fps_binomial_ODE_unique' [symmetric]) simp_all
 next
   case False
   have "fps_deriv ((1 + fps_X) ^ n :: 'a fps) = fps_const (of_nat n) * (1 + fps_X) ^ (n - 1)"
     by (simp add: fps_deriv_power)
   also have "(1 + fps_X :: 'a fps) $ 0 \<noteq> 0" by simp
   hence "(1 + fps_X :: 'a fps) \<noteq> 0" by (intro notI) (simp only: , simp)
   with False have "(1 + fps_X :: 'a fps) ^ (n - 1) = (1 + fps_X) ^ n / (1 + fps_X)"
     by (cases n) (simp_all )
   also have "fps_const (of_nat n :: 'a) * ((1 + fps_X) ^ n / (1 + fps_X)) =
                fps_const (of_nat n) * (1 + fps_X) ^ n / (1 + fps_X)"
     by (simp add: unit_div_mult_swap)
   finally show ?thesis
     by (subst sym, subst fps_binomial_ODE_unique' [symmetric]) (simp_all add: fps_power_nth)
 qed
 
 lemma fps_binomial_0 [simp]: "fps_binomial 0 = 1"
   using fps_binomial_of_nat[of 0] by simp
   
 lemma fps_binomial_power: "fps_binomial a ^ n = fps_binomial (of_nat n * a)"
   by (induction n) (simp_all add: fps_binomial_add_mult ring_distribs)
 
 lemma fps_binomial_1: "fps_binomial 1 = 1 + fps_X"
   using fps_binomial_of_nat[of 1] by simp
 
 lemma fps_binomial_minus_of_nat:
   "fps_binomial (- of_nat n) = inverse ((1 + fps_X :: 'a :: field_char_0 fps) ^ n)"
   by (rule sym, rule fps_inverse_unique)
      (simp add: fps_binomial_of_nat [symmetric] fps_binomial_add_mult [symmetric])
 
 lemma one_minus_const_fps_X_power:
   "c \<noteq> 0 \<Longrightarrow> (1 - fps_const c * fps_X) ^ n =
      fps_compose (fps_binomial (of_nat n)) (-fps_const c * fps_X)"
   by (subst fps_binomial_of_nat)
      (simp add: fps_compose_power [symmetric] fps_compose_add_distrib fps_const_neg [symmetric] 
            del: fps_const_neg)
 
 lemma one_minus_fps_X_const_neg_power:
   "inverse ((1 - fps_const c * fps_X) ^ n) = 
        fps_compose (fps_binomial (-of_nat n)) (-fps_const c * fps_X)"
 proof (cases "c = 0")
   case False
   thus ?thesis
   by (subst fps_binomial_minus_of_nat)
      (simp add: fps_compose_power [symmetric] fps_inverse_compose fps_compose_add_distrib
                 fps_const_neg [symmetric] del: fps_const_neg)
 qed simp
 
 lemma fps_X_plus_const_power:
   "c \<noteq> 0 \<Longrightarrow> (fps_X + fps_const c) ^ n =
      fps_const (c^n) * fps_compose (fps_binomial (of_nat n)) (fps_const (inverse c) * fps_X)"
   by (subst fps_binomial_of_nat)
      (simp add: fps_compose_power [symmetric] fps_binomial_of_nat fps_compose_add_distrib
                 fps_const_power [symmetric] power_mult_distrib [symmetric] 
                 algebra_simps inverse_mult_eq_1' del: fps_const_power)
 
 lemma fps_X_plus_const_neg_power:
   "c \<noteq> 0 \<Longrightarrow> inverse ((fps_X + fps_const c) ^ n) =
      fps_const (inverse c^n) * fps_compose (fps_binomial (-of_nat n)) (fps_const (inverse c) * fps_X)"
   by (subst fps_binomial_minus_of_nat)
      (simp add: fps_compose_power [symmetric] fps_binomial_of_nat fps_compose_add_distrib
                 fps_const_power [symmetric] power_mult_distrib [symmetric] fps_inverse_compose 
                 algebra_simps fps_const_inverse [symmetric] fps_inverse_mult [symmetric]
                 fps_inverse_power [symmetric] inverse_mult_eq_1'
            del: fps_const_power)
 
 
 lemma one_minus_const_fps_X_neg_power':
   fixes c :: "'a :: field_char_0"
   assumes "n > 0"
   shows "inverse ((1 - fps_const c * fps_X) ^ n) = Abs_fps (\<lambda>k. of_nat ((n + k - 1) choose k) * c^k)"
 proof -
   have \<section>: "\<And>j. Abs_fps (\<lambda>na. (- c) ^ na * fps_binomial (- of_nat n) $ na) $ j =
           Abs_fps (\<lambda>k. of_nat (n + k - 1 choose k) * c ^ k) $ j"
     using assms
     by (simp add: gbinomial_minus binomial_gbinomial of_nat_diff flip: power_mult_distrib mult.assoc)
   show ?thesis
     apply (rule fps_ext)
     using \<section> 
     by (metis (no_types, lifting) one_minus_fps_X_const_neg_power fps_const_neg fps_compose_linear fps_nth_Abs_fps)
 qed
 
 text \<open>Vandermonde's Identity as a consequence.\<close>
 lemma gbinomial_Vandermonde:
   "sum (\<lambda>k. (a gchoose k) * (b gchoose (n - k))) {0..n} = (a + b) gchoose n"
 proof -
   let ?ba = "fps_binomial a"
   let ?bb = "fps_binomial b"
   let ?bab = "fps_binomial (a + b)"
   from fps_binomial_add_mult[of a b] have "?bab $ n = (?ba * ?bb)$n" by simp
   then show ?thesis by (simp add: fps_mult_nth)
 qed
 
 lemma binomial_Vandermonde:
   "sum (\<lambda>k. (a choose k) * (b choose (n - k))) {0..n} = (a + b) choose n"
   using gbinomial_Vandermonde[of "(of_nat a)" "of_nat b" n]
   by (simp only: binomial_gbinomial[symmetric] of_nat_mult[symmetric]
                  of_nat_sum[symmetric] of_nat_add[symmetric] of_nat_eq_iff)
 
 lemma binomial_Vandermonde_same: "sum (\<lambda>k. (n choose k)\<^sup>2) {0..n} = (2 * n) choose n"
   using binomial_Vandermonde[of n n n, symmetric]
   unfolding mult_2
   by (metis atMost_atLeast0 choose_square_sum mult_2)
 
 lemma Vandermonde_pochhammer_lemma:
   fixes a :: "'a::field_char_0"
   assumes b: "\<And>j. j<n \<Longrightarrow> b \<noteq> of_nat j"
   shows "sum (\<lambda>k. (pochhammer (- a) k * pochhammer (- (of_nat n)) k) /
       (of_nat (fact k) * pochhammer (b - of_nat n + 1) k)) {0..n} =
     pochhammer (- (a + b)) n / pochhammer (- b) n"
   (is "?l = ?r")
 proof -
   let ?m1 = "\<lambda>m. (- 1 :: 'a) ^ m"
   let ?f = "\<lambda>m. of_nat (fact m)"
   let ?p = "\<lambda>(x::'a). pochhammer (- x)"
   from b have bn0: "?p b n \<noteq> 0"
     unfolding pochhammer_eq_0_iff by simp
   have th00:
     "b gchoose (n - k) =
         (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)"
       (is ?gchoose)
     "pochhammer (1 + b - of_nat n) k \<noteq> 0"
       (is ?pochhammer)
     if kn: "k \<in> {0..n}" for k
   proof -
     from kn have "k \<le> n" by simp
     have nz: "pochhammer (1 + b - of_nat n) n \<noteq> 0"
     proof
       assume "pochhammer (1 + b - of_nat n) n = 0"
       then have c: "pochhammer (b - of_nat n + 1) n = 0"
         by (simp add: algebra_simps)
       then obtain j where j: "j < n" "b - of_nat n + 1 = - of_nat j"
         unfolding pochhammer_eq_0_iff by blast
       from j have "b = of_nat n - of_nat j - of_nat 1"
         by (simp add: algebra_simps)
       then have "b = of_nat (n - j - 1)"
         using j kn by (simp add: of_nat_diff)
       then show False 
         using \<open>j < n\<close> j b by auto
     qed
 
     from nz kn [simplified] have nz': "pochhammer (1 + b - of_nat n) k \<noteq> 0"
       by (rule pochhammer_neq_0_mono)
 
     consider "k = 0 \<or> n = 0" | "k \<noteq> 0" "n \<noteq> 0"
       by blast
     then have "b gchoose (n - k) =
       (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)"
     proof cases
       case 1
       then show ?thesis
         using kn by (cases "k = 0") (simp_all add: gbinomial_pochhammer)
     next
       case neq: 2
       then obtain m where m: "n = Suc m"
         by (cases n) auto
       from neq(1) obtain h where h: "k = Suc h"
         by (cases k) auto
       show ?thesis
       proof (cases "k = n")
         case True
         with pochhammer_minus'[where k=k and b=b] bn0 show ?thesis       
           by (simp add: pochhammer_same)
       next
         case False
         with kn have kn': "k < n"
           by simp
         have "h \<le> m"
           using \<open>k \<le> n\<close> h m by blast
         have m1nk: "?m1 n = prod (\<lambda>i. - 1) {..m}" "?m1 k = prod (\<lambda>i. - 1) {0..h}"
           by (simp_all add: m h)
         have bnz0: "pochhammer (b - of_nat n + 1) k \<noteq> 0"
           using bn0 kn
           unfolding pochhammer_eq_0_iff
           by (metis add.commute add_diff_eq nz' pochhammer_eq_0_iff)
         have eq1: "prod (\<lambda>k. (1::'a) + of_nat m - of_nat k) {..h} =
           prod of_nat {Suc (m - h) .. Suc m}"
           using kn' h m
           by (intro prod.reindex_bij_witness[where i="\<lambda>k. Suc m - k" and j="\<lambda>k. Suc m - k"])
              (auto simp: of_nat_diff)
         have "(\<Prod>i = 0..<k. 1 + of_nat n - of_nat k + of_nat i) = (\<Prod>x = n - k..<n. (1::'a) + of_nat x)"
           using \<open>k \<le> n\<close> 
           using prod.atLeastLessThan_shift_bounds [where ?'a = 'a, of "\<lambda>i. 1 + of_nat i" 0 "n - k" k]
           by (auto simp add: of_nat_diff field_simps)
         then have "fact (n - k) * pochhammer ((1::'a) + of_nat n - of_nat k) k = fact n"
           using \<open>k \<le> n\<close> 
           by (auto simp add: fact_split [of k n] pochhammer_prod field_simps)
         then have th1: "(?m1 k * ?p (of_nat n) k) / ?f n = 1 / of_nat(fact (n - k))"
           by (simp add: pochhammer_minus field_simps)
         have "?m1 n * ?p b n = pochhammer (b - of_nat m) (Suc m)"
           by (simp add: pochhammer_minus field_simps m)
         also have "... = (\<Prod>i = 0..m. b - of_nat i)"
           by (auto simp add: pochhammer_prod_rev of_nat_diff prod.atLeast_Suc_atMost_Suc_shift simp del: prod.cl_ivl_Suc)
         finally have th20: "?m1 n * ?p b n = prod (\<lambda>i. b - of_nat i) {0..m}" .
         have "(\<Prod>x = 0..h. b - of_nat m + of_nat (h - x)) = (\<Prod>i = m - h..m. b - of_nat i)"
           using \<open>h \<le> m\<close> prod.atLeastAtMost_shift_0 [of "m - h" m, where ?'a = 'a]
           by (auto simp add: of_nat_diff field_simps)
         then have th21:"pochhammer (b - of_nat n + 1) k = prod (\<lambda>i. b - of_nat i) {n - k .. n - 1}"
           using kn by (simp add: pochhammer_prod_rev m h prod.atLeast_Suc_atMost_Suc_shift del: prod.op_ivl_Suc del: prod.cl_ivl_Suc)
         have "?m1 n * ?p b n =
           prod (\<lambda>i. b - of_nat i) {0.. n - k - 1} * pochhammer (b - of_nat n + 1) k"
           using kn' m h unfolding th20 th21 
           by (auto simp flip: prod.union_disjoint intro: prod.cong)
         then have th2: "(?m1 n * ?p b n)/pochhammer (b - of_nat n + 1) k =
           prod (\<lambda>i. b - of_nat i) {0.. n - k - 1}"
           using nz' by (simp add: field_simps)
         have "(?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k) =
           ((?m1 k * ?p (of_nat n) k) / ?f n) * ((?m1 n * ?p b n)/pochhammer (b - of_nat n + 1) k)"
           using bnz0
           by (simp add: field_simps)
         also have "\<dots> = b gchoose (n - k)"
           unfolding th1 th2
           using kn' m h
           by (auto simp: field_simps gbinomial_mult_fact intro: prod.cong)
         finally show ?thesis by simp
       qed
     qed
     then show ?gchoose and ?pochhammer
       using nz' by force+
   qed
   have "?r = ((a + b) gchoose n) * (of_nat (fact n) / (?m1 n * pochhammer (- b) n))"
     unfolding gbinomial_pochhammer
     using bn0 by (auto simp add: field_simps)
   also have "\<dots> = ?l"
     using bn0
     unfolding gbinomial_Vandermonde[symmetric]
     apply (simp add: th00)
     by (simp add: gbinomial_pochhammer sum_distrib_right sum_distrib_left field_simps)
   finally show ?thesis by simp
 qed
 
 lemma Vandermonde_pochhammer:
   fixes a :: "'a::field_char_0"
   assumes c: "\<forall>i \<in> {0..< n}. c \<noteq> - of_nat i"
   shows "sum (\<lambda>k. (pochhammer a k * pochhammer (- (of_nat n)) k) /
     (of_nat (fact k) * pochhammer c k)) {0..n} = pochhammer (c - a) n / pochhammer c n"
 proof -
   let ?a = "- a"
   let ?b = "c + of_nat n - 1"
   have h: "?b \<noteq> of_nat j" if "j < n" for j
   proof -
     have "c \<noteq> - of_nat (n - j - 1)"
       using c that by auto
     with that show ?thesis
       by (auto simp add: algebra_simps of_nat_diff)
   qed
   have th0: "pochhammer (- (?a + ?b)) n = (- 1)^n * pochhammer (c - a) n"
     unfolding pochhammer_minus
     by (simp add: algebra_simps)
   have th1: "pochhammer (- ?b) n = (- 1)^n * pochhammer c n"
     unfolding pochhammer_minus
     by simp
   have nz: "pochhammer c n \<noteq> 0" using c
     by (simp add: pochhammer_eq_0_iff)
   from Vandermonde_pochhammer_lemma[where a = "?a" and b="?b" and n=n, OF h, unfolded th0 th1]
   show ?thesis
     using nz by (simp add: field_simps sum_distrib_left)
 qed
 
 
 subsubsection \<open>Formal trigonometric functions\<close>
 
 definition "fps_sin (c::'a::field_char_0) =
   Abs_fps (\<lambda>n. if even n then 0 else (- 1) ^((n - 1) div 2) * c^n /(of_nat (fact n)))"
 
 definition "fps_cos (c::'a::field_char_0) =
   Abs_fps (\<lambda>n. if even n then (- 1) ^ (n div 2) * c^n / (of_nat (fact n)) else 0)"
 
 lemma fps_sin_0 [simp]: "fps_sin 0 = 0"
   by (intro fps_ext) (auto simp: fps_sin_def elim!: oddE)
 
 lemma fps_cos_0 [simp]: "fps_cos 0 = 1"
   by (intro fps_ext) (simp add: fps_cos_def)
 
 lemma fps_sin_deriv:
   "fps_deriv (fps_sin c) = fps_const c * fps_cos c"
   (is "?lhs = ?rhs")
 proof (rule fps_ext)
   fix n :: nat
   show "?lhs $ n = ?rhs $ n"
   proof (cases "even n")
     case True
     have "?lhs$n = of_nat (n+1) * (fps_sin c $ (n+1))" by simp
     also have "\<dots> = of_nat (n+1) * ((- 1)^(n div 2) * c^Suc n / of_nat (fact (Suc n)))"
       using True by (simp add: fps_sin_def)
     also have "\<dots> = (- 1)^(n div 2) * c^Suc n * (of_nat (n+1) / (of_nat (Suc n) * of_nat (fact n)))"
       unfolding fact_Suc of_nat_mult
       by (simp add: field_simps del: of_nat_add of_nat_Suc)
     also have "\<dots> = (- 1)^(n div 2) * c^Suc n / of_nat (fact n)"
       by (simp add: field_simps del: of_nat_add of_nat_Suc)
     finally show ?thesis
       using True by (simp add: fps_cos_def field_simps)
   next
     case False
     then show ?thesis
       by (simp_all add: fps_deriv_def fps_sin_def fps_cos_def)
   qed
 qed
 
 lemma fps_cos_deriv: "fps_deriv (fps_cos c) = fps_const (- c)* (fps_sin c)"
   (is "?lhs = ?rhs")
 proof (rule fps_ext)
   have th0: "- ((- 1::'a) ^ n) = (- 1)^Suc n" for n
     by simp
   show "?lhs $ n = ?rhs $ n" for n
   proof (cases "even n")
     case False
     then have n0: "n \<noteq> 0" by presburger
     from False have th1: "Suc ((n - 1) div 2) = Suc n div 2"
       by (cases n) simp_all
     have "?lhs$n = of_nat (n+1) * (fps_cos c $ (n+1))" by simp
     also have "\<dots> = of_nat (n+1) * ((- 1)^((n + 1) div 2) * c^Suc n / of_nat (fact (Suc n)))"
       using False by (simp add: fps_cos_def)
     also have "\<dots> = (- 1)^((n + 1) div 2) * c^Suc n * (of_nat (n+1) / (of_nat (Suc n) * of_nat (fact n)))"
       unfolding fact_Suc of_nat_mult
       by (simp add: field_simps del: of_nat_add of_nat_Suc)
     also have "\<dots> = (- 1)^((n + 1) div 2) * c^Suc n / of_nat (fact n)"
       by (simp add: field_simps del: of_nat_add of_nat_Suc)
     also have "\<dots> = (- ((- 1)^((n - 1) div 2))) * c^Suc n / of_nat (fact n)"
       unfolding th0 unfolding th1 by simp
     finally show ?thesis
       using False by (simp add: fps_sin_def field_simps)
   next
     case True
     then show ?thesis
       by (simp_all add: fps_deriv_def fps_sin_def fps_cos_def)
   qed
 qed
 
 lemma fps_sin_cos_sum_of_squares: "(fps_cos c)\<^sup>2 + (fps_sin c)\<^sup>2 = 1"
   (is "?lhs = _")
 proof -
   have "fps_deriv ?lhs = 0"
     by (simp add:  fps_deriv_power fps_sin_deriv fps_cos_deriv field_simps flip: fps_const_neg)
   then have "?lhs = fps_const (?lhs $ 0)"
     unfolding fps_deriv_eq_0_iff .
   also have "\<dots> = 1"
     by (simp add: fps_eq_iff numeral_2_eq_2 fps_mult_nth fps_cos_def fps_sin_def)
   finally show ?thesis .
 qed
 
 lemma fps_sin_nth_0 [simp]: "fps_sin c $ 0 = 0"
   unfolding fps_sin_def by simp
 
 lemma fps_sin_nth_1 [simp]: "fps_sin c $ Suc 0 = c"
   unfolding fps_sin_def by simp
 
 lemma fps_sin_nth_add_2:
     "fps_sin c $ (n + 2) = - (c * c * fps_sin c $ n / (of_nat (n + 1) * of_nat (n + 2)))"
 proof (cases n)
   case (Suc n')
   then show ?thesis
     unfolding fps_sin_def by (simp add: field_simps)
 qed (auto simp: fps_sin_def)
 
 
 lemma fps_cos_nth_0 [simp]: "fps_cos c $ 0 = 1"
   unfolding fps_cos_def by simp
 
 lemma fps_cos_nth_1 [simp]: "fps_cos c $ Suc 0 = 0"
   unfolding fps_cos_def by simp
 
 lemma fps_cos_nth_add_2:
   "fps_cos c $ (n + 2) = - (c * c * fps_cos c $ n / (of_nat (n + 1) * of_nat (n + 2)))"
 proof (cases n)
   case (Suc n')
   then show ?thesis
     unfolding fps_cos_def by (simp add: field_simps)
 qed (auto simp: fps_cos_def)
 
 lemma nat_add_1_add_1: "(n::nat) + 1 + 1 = n + 2"
   by simp
 
 lemma eq_fps_sin:
   assumes a0: "a $ 0 = 0"
     and a1: "a $ 1 = c"
     and a2: "fps_deriv (fps_deriv a) = - (fps_const c * fps_const c * a)"
   shows "fps_sin c = a"
 proof (rule fps_ext)
   fix n
   show "fps_sin c $ n = a $ n"
   proof (induction n rule: nat_induct2)
     case (step n)
     then have "of_nat (n + 1) * (of_nat (n + 2) * a $ (n + 2)) =
      - (c * c * fps_sin c $ n)"
       using a2
       by (metis fps_const_mult fps_deriv_nth fps_mult_left_const_nth fps_neg_nth nat_add_1_add_1)
     with step show ?case
       by (metis (no_types, lifting) a0 add.commute add.inverse_inverse fps_sin_nth_0 fps_sin_nth_add_2 mult_divide_mult_cancel_left_if mult_minus_right nonzero_mult_div_cancel_left not_less_zero of_nat_eq_0_iff plus_1_eq_Suc zero_less_Suc)
   qed (use assms in auto)
 qed
 
 lemma eq_fps_cos:
   assumes a0: "a $ 0 = 1"
     and a1: "a $ 1 = 0"
     and a2: "fps_deriv (fps_deriv a) = - (fps_const c * fps_const c * a)"
   shows "fps_cos c = a"
 proof (rule fps_ext)
   fix n
   show "fps_cos c $ n = a $ n"
   proof (induction n rule: nat_induct2)
     case (step n)
     then have "of_nat (n + 1) * (of_nat (n + 2) * a $ (n + 2)) =
      - (c * c * fps_cos c $ n)"
       using a2
       by (metis fps_const_mult fps_deriv_nth fps_mult_left_const_nth fps_neg_nth nat_add_1_add_1)
     with step show ?case
       by (metis (no_types, lifting) a0 add.commute add.inverse_inverse fps_cos_nth_0 fps_cos_nth_add_2 mult_divide_mult_cancel_left_if mult_minus_right nonzero_mult_div_cancel_left not_less_zero of_nat_eq_0_iff plus_1_eq_Suc zero_less_Suc)
   qed (use assms in auto)
 qed
 
 lemma fps_sin_add: "fps_sin (a + b) = fps_sin a * fps_cos b + fps_cos a * fps_sin b"
 proof -
   have "fps_deriv (fps_deriv (fps_sin a * fps_cos b + fps_cos a * fps_sin b)) =
          - (fps_const (a + b) * fps_const (a + b) * (fps_sin a * fps_cos b + fps_cos a * fps_sin b))"
     by (simp flip: fps_const_neg fps_const_add fps_const_mult
         add: fps_sin_deriv fps_cos_deriv algebra_simps)
   then show ?thesis
     by (auto intro: eq_fps_sin)
 qed
 
 
 lemma fps_cos_add: "fps_cos (a + b) = fps_cos a * fps_cos b - fps_sin a * fps_sin b"
 proof -
   have "fps_deriv
      (fps_deriv (fps_cos a * fps_cos b - fps_sin a * fps_sin b)) =
     - (fps_const (a + b) * fps_const (a + b) *
        (fps_cos a * fps_cos b - fps_sin a * fps_sin b))"
     by (simp flip: fps_const_neg fps_const_add fps_const_mult
         add: fps_sin_deriv fps_cos_deriv algebra_simps)
   then show ?thesis
     by (auto intro: eq_fps_cos)
 qed
 
 lemma fps_sin_even: "fps_sin (- c) = - fps_sin c"
   by (simp add: fps_eq_iff fps_sin_def)
 
 lemma fps_cos_odd: "fps_cos (- c) = fps_cos c"
   by (simp add: fps_eq_iff fps_cos_def)
 
 definition "fps_tan c = fps_sin c / fps_cos c"
 
 lemma fps_tan_0 [simp]: "fps_tan 0 = 0"
   by (simp add: fps_tan_def)
 
 lemma fps_tan_deriv: "fps_deriv (fps_tan c) = fps_const c / (fps_cos c)\<^sup>2"
 proof -
   have th0: "fps_cos c $ 0 \<noteq> 0" by (simp add: fps_cos_def)
   from this have "fps_cos c \<noteq> 0" by (intro notI) simp
   hence "fps_deriv (fps_tan c) =
            fps_const c * (fps_cos c^2 + fps_sin c^2) / (fps_cos c^2)"
     by (simp add: fps_tan_def fps_divide_deriv power2_eq_square algebra_simps
                   fps_sin_deriv fps_cos_deriv fps_const_neg[symmetric] div_mult_swap
              del: fps_const_neg)
   also note fps_sin_cos_sum_of_squares
   finally show ?thesis by simp
 qed
 
 text \<open>Connection to @{const "fps_exp"} over the complex numbers --- Euler and de Moivre.\<close>
 
 lemma fps_exp_ii_sin_cos: "fps_exp (\<i> * c) = fps_cos c + fps_const \<i> * fps_sin c"
   (is "?l = ?r")
 proof -
   have "?l $ n = ?r $ n" for n
   proof (cases "even n")
     case True
     then obtain m where m: "n = 2 * m" ..
     show ?thesis
       by (simp add: m fps_sin_def fps_cos_def power_mult_distrib power_mult power_minus [of "c ^ 2"])
   next
     case False
     then obtain m where m: "n = 2 * m + 1" ..
     show ?thesis
       by (simp add: m fps_sin_def fps_cos_def power_mult_distrib
         power_mult power_minus [of "c ^ 2"])
   qed
   then show ?thesis
     by (simp add: fps_eq_iff)
 qed
 
 lemma fps_exp_minus_ii_sin_cos: "fps_exp (- (\<i> * c)) = fps_cos c - fps_const \<i> * fps_sin c"
   unfolding minus_mult_right fps_exp_ii_sin_cos by (simp add: fps_sin_even fps_cos_odd)
 
 lemma fps_cos_fps_exp_ii: "fps_cos c = (fps_exp (\<i> * c) + fps_exp (- \<i> * c)) / fps_const 2"
 proof -
   have th: "fps_cos c + fps_cos c = fps_cos c * fps_const 2"
     by (simp add: numeral_fps_const)
   show ?thesis
     unfolding fps_exp_ii_sin_cos minus_mult_commute
     by (simp add: fps_sin_even fps_cos_odd numeral_fps_const fps_divide_unit fps_const_inverse th)
 qed
 
 lemma fps_sin_fps_exp_ii: "fps_sin c = (fps_exp (\<i> * c) - fps_exp (- \<i> * c)) / fps_const (2*\<i>)"
 proof -
   have th: "fps_const \<i> * fps_sin c + fps_const \<i> * fps_sin c = fps_sin c * fps_const (2 * \<i>)"
     by (simp add: fps_eq_iff numeral_fps_const)
   show ?thesis
     unfolding fps_exp_ii_sin_cos minus_mult_commute
     by (simp add: fps_sin_even fps_cos_odd fps_divide_unit fps_const_inverse th)
 qed
 
 lemma fps_tan_fps_exp_ii:
   "fps_tan c = (fps_exp (\<i> * c) - fps_exp (- \<i> * c)) / 
       (fps_const \<i> * (fps_exp (\<i> * c) + fps_exp (- \<i> * c)))"
   unfolding fps_tan_def fps_sin_fps_exp_ii fps_cos_fps_exp_ii
   by (simp add: fps_divide_unit fps_inverse_mult fps_const_inverse)
 
 lemma fps_demoivre:
   "(fps_cos a + fps_const \<i> * fps_sin a)^n =
     fps_cos (of_nat n * a) + fps_const \<i> * fps_sin (of_nat n * a)"
   unfolding fps_exp_ii_sin_cos[symmetric] fps_exp_power_mult
   by (simp add: ac_simps)
 
 
 subsection \<open>Hypergeometric series\<close>
 
 definition "fps_hypergeo as bs (c::'a::field_char_0) =
   Abs_fps (\<lambda>n. (foldl (\<lambda>r a. r* pochhammer a n) 1 as * c^n) /
     (foldl (\<lambda>r b. r * pochhammer b n) 1 bs * of_nat (fact n)))"
 
 lemma fps_hypergeo_nth[simp]: "fps_hypergeo as bs c $ n =
   (foldl (\<lambda>r a. r* pochhammer a n) 1 as * c^n) /
     (foldl (\<lambda>r b. r * pochhammer b n) 1 bs * of_nat (fact n))"
   by (simp add: fps_hypergeo_def)
 
 lemma foldl_mult_start:
   fixes v :: "'a::comm_ring_1"
   shows "foldl (\<lambda>r x. r * f x) v as * x = foldl (\<lambda>r x. r * f x) (v * x) as "
   by (induct as arbitrary: x v) (auto simp add: algebra_simps)
 
 lemma foldr_mult_foldl:
   fixes v :: "'a::comm_ring_1"
   shows "foldr (\<lambda>x r. r * f x) as v = foldl (\<lambda>r x. r * f x) v as"
   by (induct as arbitrary: v) (simp_all add: foldl_mult_start)
 
 lemma fps_hypergeo_nth_alt:
   "fps_hypergeo as bs c $ n = foldr (\<lambda>a r. r * pochhammer a n) as (c ^ n) /
     foldr (\<lambda>b r. r * pochhammer b n) bs (of_nat (fact n))"
   by (simp add: foldl_mult_start foldr_mult_foldl)
 
 lemma fps_hypergeo_fps_exp[simp]: "fps_hypergeo [] [] c = fps_exp c"
   by (simp add: fps_eq_iff)
 
 lemma fps_hypergeo_1_0[simp]: "fps_hypergeo [1] [] c = 1/(1 - fps_const c * fps_X)"
 proof -
   let ?a = "(Abs_fps (\<lambda>n. 1)) oo (fps_const c * fps_X)"
   have th0: "(fps_const c * fps_X) $ 0 = 0" by simp
   show ?thesis unfolding gp[OF th0, symmetric]
     by (simp add: fps_eq_iff pochhammer_fact[symmetric]
       fps_compose_nth power_mult_distrib if_distrib cong del: if_weak_cong)
 qed
 
 lemma fps_hypergeo_B[simp]: "fps_hypergeo [-a] [] (- 1) = fps_binomial a"
   by (simp add: fps_eq_iff gbinomial_pochhammer algebra_simps)
 
 lemma fps_hypergeo_0[simp]: "fps_hypergeo as bs c $ 0 = 1"
 proof -
   have "foldl (\<lambda>(r::'a) (a::'a). r) 1 as = 1" for as
     by (induction as) auto
   then show ?thesis
     by auto
 qed
 
 lemma foldl_prod_prod:
   "foldl (\<lambda>(r::'b::comm_ring_1) (x::'a::comm_ring_1). r * f x) v as * foldl (\<lambda>r x. r * g x) w as =
     foldl (\<lambda>r x. r * f x * g x) (v * w) as"
   by (induct as arbitrary: v w) (simp_all add: algebra_simps)
 
 
 lemma fps_hypergeo_rec:
   "fps_hypergeo as bs c $ Suc n = ((foldl (\<lambda>r a. r* (a + of_nat n)) c as) /
     (foldl (\<lambda>r b. r * (b + of_nat n)) (of_nat (Suc n)) bs )) * fps_hypergeo as bs c $ n"
   apply (simp add: foldl_mult_start del: of_nat_Suc of_nat_add fact_Suc)
   unfolding foldl_prod_prod[unfolded foldl_mult_start] pochhammer_Suc
   by (simp add: algebra_simps)
 
 lemma fps_XD_nth[simp]: "fps_XD a $ n = of_nat n * a$n"
   by (simp add: fps_XD_def)
 
 lemma fps_XD_0th[simp]: "fps_XD a $ 0 = 0"
   by simp
 lemma fps_XD_Suc[simp]:" fps_XD a $ Suc n = of_nat (Suc n) * a $ Suc n"
   by simp
 
 definition "fps_XDp c a = fps_XD a + fps_const c * a"
 
 lemma fps_XDp_nth[simp]: "fps_XDp c a $ n = (c + of_nat n) * a$n"
   by (simp add: fps_XDp_def algebra_simps)
 
 lemma fps_XDp_commute: "fps_XDp b \<circ> fps_XDp (c::'a::comm_ring_1) = fps_XDp c \<circ> fps_XDp b"
   by (simp add: fps_XDp_def fun_eq_iff fps_eq_iff algebra_simps)
 
 lemma fps_XDp0 [simp]: "fps_XDp 0 = fps_XD"
   by (simp add: fun_eq_iff fps_eq_iff)
 
 lemma fps_XDp_fps_integral [simp]:
   fixes  a :: "'a::{division_ring,ring_char_0} fps"
   shows  "fps_XDp 0 (fps_integral a c) = fps_X * a"
   using  fps_deriv_fps_integral[of a c]
   by     (simp add: fps_XD_def)
 
 lemma fps_hypergeo_minus_nat:
   "fps_hypergeo [- of_nat n] [- of_nat (n + m)] (c::'a::field_char_0) $ k =
     (if k \<le> n then
       pochhammer (- of_nat n) k * c ^ k / (pochhammer (- of_nat (n + m)) k * of_nat (fact k))
      else 0)"
   "fps_hypergeo [- of_nat m] [- of_nat (m + n)] (c::'a::field_char_0) $ k =
     (if k \<le> m then
       pochhammer (- of_nat m) k * c ^ k / (pochhammer (- of_nat (m + n)) k * of_nat (fact k))
      else 0)"
   by (simp_all add: pochhammer_eq_0_iff)
 
 lemma pochhammer_rec_if: "pochhammer a n = (if n = 0 then 1 else a * pochhammer (a + 1) (n - 1))"
   by (cases n) (simp_all add: pochhammer_rec)
 
 lemma fps_XDp_foldr_nth [simp]: "foldr (\<lambda>c r. fps_XDp c \<circ> r) cs (\<lambda>c. fps_XDp c a) c0 $ n =
     foldr (\<lambda>c r. (c + of_nat n) * r) cs (c0 + of_nat n) * a$n"
   by (induct cs arbitrary: c0) (simp_all add: algebra_simps)
 
 lemma genric_fps_XDp_foldr_nth:
   assumes f: "\<forall>n c a. f c a $ n = (of_nat n + k c) * a$n"
   shows "foldr (\<lambda>c r. f c \<circ> r) cs (\<lambda>c. g c a) c0 $ n =
     foldr (\<lambda>c r. (k c + of_nat n) * r) cs (g c0 a $ n)"
   by (induct cs arbitrary: c0) (simp_all add: algebra_simps f)
 
 lemma dist_less_imp_nth_equal:
   assumes "dist f g < inverse (2 ^ i)"
     and"j \<le> i"
   shows "f $ j = g $ j"
 proof (rule ccontr)
   assume "f $ j \<noteq> g $ j"
   hence "f \<noteq> g" by auto
   with assms have "i < subdegree (f - g)"
     by (simp add: if_split_asm dist_fps_def)
   also have "\<dots> \<le> j"
     using \<open>f $ j \<noteq> g $ j\<close> by (intro subdegree_leI) simp_all
   finally show False using \<open>j \<le> i\<close> by simp
 qed
 
 lemma nth_equal_imp_dist_less:
   assumes "\<And>j. j \<le> i \<Longrightarrow> f $ j = g $ j"
   shows "dist f g < inverse (2 ^ i)"
 proof (cases "f = g")
   case True
   then show ?thesis by simp
 next
   case False
   with assms have "dist f g = inverse (2 ^ subdegree (f - g))"
     by (simp add: if_split_asm dist_fps_def)
   moreover
   from assms and False have "i < subdegree (f - g)"
     by (intro subdegree_greaterI) simp_all
   ultimately show ?thesis by simp
 qed
 
 lemma dist_less_eq_nth_equal: "dist f g < inverse (2 ^ i) \<longleftrightarrow> (\<forall>j \<le> i. f $ j = g $ j)"
   using dist_less_imp_nth_equal nth_equal_imp_dist_less by blast
 
 instance fps :: (comm_ring_1) complete_space
 proof
   fix fps_X :: "nat \<Rightarrow> 'a fps"
   assume "Cauchy fps_X"
   obtain M where M: "\<forall>i. \<forall>m \<ge> M i. \<forall>j \<le> i. fps_X (M i) $ j = fps_X m $ j"
   proof -
     have "\<exists>M. \<forall>m \<ge> M. \<forall>j\<le>i. fps_X M $ j = fps_X m $ j" for i
     proof -
       have "0 < inverse ((2::real)^i)" by simp
       from metric_CauchyD[OF \<open>Cauchy fps_X\<close> this] dist_less_imp_nth_equal
       show ?thesis by blast
     qed
     then show ?thesis using that by metis
   qed
 
   show "convergent fps_X"
   proof (rule convergentI)
     show "fps_X \<longlonglongrightarrow> Abs_fps (\<lambda>i. fps_X (M i) $ i)"
       unfolding tendsto_iff
     proof safe
       fix e::real assume e: "0 < e"
       have "(\<lambda>n. inverse (2 ^ n) :: real) \<longlonglongrightarrow> 0" by (rule LIMSEQ_inverse_realpow_zero) simp_all
       from this and e have "eventually (\<lambda>i. inverse (2 ^ i) < e) sequentially"
         by (rule order_tendstoD)
       then obtain i where "inverse (2 ^ i) < e"
         by (auto simp: eventually_sequentially)
       have "eventually (\<lambda>x. M i \<le> x) sequentially"
         by (auto simp: eventually_sequentially)
       then show "eventually (\<lambda>x. dist (fps_X x) (Abs_fps (\<lambda>i. fps_X (M i) $ i)) < e) sequentially"
       proof eventually_elim
         fix x
         assume x: "M i \<le> x"
         have "fps_X (M i) $ j = fps_X (M j) $ j" if "j \<le> i" for j
           using M that by (metis nat_le_linear)
         with x have "dist (fps_X x) (Abs_fps (\<lambda>j. fps_X (M j) $ j)) < inverse (2 ^ i)"
           using M by (force simp: dist_less_eq_nth_equal)
         also note \<open>inverse (2 ^ i) < e\<close>
         finally show "dist (fps_X x) (Abs_fps (\<lambda>j. fps_X (M j) $ j)) < e" .
       qed
     qed
   qed
 qed
 
 (* TODO: Figure out better notation for this thing *)
 no_notation fps_nth (infixl "$" 75)
 
 bundle fps_notation
 begin
 notation fps_nth (infixl "$" 75)
 end
 
 end
diff --git a/src/HOL/Computational_Algebra/Normalized_Fraction.thy b/src/HOL/Computational_Algebra/Normalized_Fraction.thy
--- a/src/HOL/Computational_Algebra/Normalized_Fraction.thy
+++ b/src/HOL/Computational_Algebra/Normalized_Fraction.thy
@@ -1,364 +1,416 @@
 (*  Title:      HOL/Computational_Algebra/Normalized_Fraction.thy
     Author:     Manuel Eberl
 *)
 
 theory Normalized_Fraction
 imports 
   Main 
   Euclidean_Algorithm
   Fraction_Field
 begin
 
 definition quot_to_fract :: "'a :: {idom} \<times> 'a \<Rightarrow> 'a fract" where
   "quot_to_fract = (\<lambda>(a,b). Fraction_Field.Fract a b)"
 
 definition normalize_quot :: "'a :: {ring_gcd,idom_divide,semiring_gcd_mult_normalize} \<times> 'a \<Rightarrow> 'a \<times> 'a" where
   "normalize_quot = 
      (\<lambda>(a,b). if b = 0 then (0,1) else let d = gcd a b * unit_factor b in (a div d, b div d))" 
 
 lemma normalize_quot_zero [simp]:
   "normalize_quot (a, 0) = (0, 1)"
   by (simp add: normalize_quot_def)
 
 lemma normalize_quot_proj:
   "fst (normalize_quot (a, b)) = a div (gcd a b * unit_factor b)"
   "snd (normalize_quot (a, b)) = normalize b div gcd a b" if "b \<noteq> 0"
   using that by (simp_all add: normalize_quot_def Let_def mult.commute [of _ "unit_factor b"] dvd_div_mult2_eq mult_unit_dvd_iff')
 
 definition normalized_fracts :: "('a :: {ring_gcd,idom_divide} \<times> 'a) set" where
   "normalized_fracts = {(a,b). coprime a b \<and> unit_factor b = 1}"
   
 lemma not_normalized_fracts_0_denom [simp]: "(a, 0) \<notin> normalized_fracts"
   by (auto simp: normalized_fracts_def)
 
 lemma unit_factor_snd_normalize_quot [simp]:
   "unit_factor (snd (normalize_quot x)) = 1"
   by (simp add: normalize_quot_def case_prod_unfold Let_def dvd_unit_factor_div
                 mult_unit_dvd_iff unit_factor_mult unit_factor_gcd)
   
 lemma snd_normalize_quot_nonzero [simp]: "snd (normalize_quot x) \<noteq> 0"
   using unit_factor_snd_normalize_quot[of x] 
   by (auto simp del: unit_factor_snd_normalize_quot)
   
 lemma normalize_quot_aux:
   fixes a b
   assumes "b \<noteq> 0"
   defines "d \<equiv> gcd a b * unit_factor b"
   shows   "a = fst (normalize_quot (a,b)) * d" "b = snd (normalize_quot (a,b)) * d"
           "d dvd a" "d dvd b" "d \<noteq> 0"
 proof -
   from assms show "d dvd a" "d dvd b"
     by (simp_all add: d_def mult_unit_dvd_iff)
   thus "a = fst (normalize_quot (a,b)) * d" "b = snd (normalize_quot (a,b)) * d" "d \<noteq> 0"
     by (auto simp: normalize_quot_def Let_def d_def \<open>b \<noteq> 0\<close>)
 qed
 
 lemma normalize_quotE:
   assumes "b \<noteq> 0"
   obtains d where "a = fst (normalize_quot (a,b)) * d" "b = snd (normalize_quot (a,b)) * d"
                   "d dvd a" "d dvd b" "d \<noteq> 0"
   using that[OF normalize_quot_aux[OF assms]] .
   
 lemma normalize_quotE':
   assumes "snd x \<noteq> 0"
   obtains d where "fst x = fst (normalize_quot x) * d" "snd x = snd (normalize_quot x) * d"
                   "d dvd fst x" "d dvd snd x" "d \<noteq> 0"
 proof -
-  from normalize_quotE[OF assms, of "fst x"] guess d .
-  from this show ?thesis unfolding prod.collapse by (intro that[of d])
+  from normalize_quotE[OF assms, of "fst x"] obtain d where
+    "fst x = fst (normalize_quot (fst x, snd x)) * d"
+    "snd x = snd (normalize_quot (fst x, snd x)) * d"
+    "d dvd fst x"
+    "d dvd snd x"
+    "d \<noteq> 0" .
+  then show ?thesis unfolding prod.collapse by (intro that[of d])
 qed
   
 lemma coprime_normalize_quot:
   "coprime (fst (normalize_quot x)) (snd (normalize_quot x))"
   by (simp add: normalize_quot_def case_prod_unfold div_mult_unit2)
     (metis coprime_mult_self_right_iff div_gcd_coprime unit_div_mult_self unit_factor_is_unit)
 
 lemma normalize_quot_in_normalized_fracts [simp]: "normalize_quot x \<in> normalized_fracts"
   by (simp add: normalized_fracts_def coprime_normalize_quot case_prod_unfold)
 
 lemma normalize_quot_eq_iff:
   assumes "b \<noteq> 0" "d \<noteq> 0"
   shows   "normalize_quot (a,b) = normalize_quot (c,d) \<longleftrightarrow> a * d = b * c"
 proof -
   define x y where "x = normalize_quot (a,b)" and "y = normalize_quot (c,d)" 
   from normalize_quotE[OF assms(1), of a] normalize_quotE[OF assms(2), of c]
     obtain d1 d2 
       where "a = fst x * d1" "b = snd x * d1" "c = fst y * d2" "d = snd y * d2" "d1 \<noteq> 0" "d2 \<noteq> 0"
     unfolding x_def y_def by metis
   hence "a * d = b * c \<longleftrightarrow> fst x * snd y = snd x * fst y" by simp
   also have "\<dots> \<longleftrightarrow> fst x = fst y \<and> snd x = snd y"
     by (intro coprime_crossproduct') (simp_all add: x_def y_def coprime_normalize_quot)
   also have "\<dots> \<longleftrightarrow> x = y" using prod_eqI by blast
   finally show "x = y \<longleftrightarrow> a * d = b * c" ..
 qed
 
 lemma normalize_quot_eq_iff':
   assumes "snd x \<noteq> 0" "snd y \<noteq> 0"
   shows   "normalize_quot x = normalize_quot y \<longleftrightarrow> fst x * snd y = snd x * fst y"
   using assms by (cases x, cases y, hypsubst) (subst normalize_quot_eq_iff, simp_all)
 
 lemma normalize_quot_id: "x \<in> normalized_fracts \<Longrightarrow> normalize_quot x = x"
   by (auto simp: normalized_fracts_def normalize_quot_def case_prod_unfold)
 
 lemma normalize_quot_idem [simp]: "normalize_quot (normalize_quot x) = normalize_quot x"
   by (rule normalize_quot_id) simp_all
 
 lemma fractrel_iff_normalize_quot_eq:
   "fractrel x y \<longleftrightarrow> normalize_quot x = normalize_quot y \<and> snd x \<noteq> 0 \<and> snd y \<noteq> 0"
   by (cases x, cases y) (auto simp: fractrel_def normalize_quot_eq_iff)
   
 lemma fractrel_normalize_quot_left:
   assumes "snd x \<noteq> 0"
   shows   "fractrel (normalize_quot x) y \<longleftrightarrow> fractrel x y"
   using assms by (subst (1 2) fractrel_iff_normalize_quot_eq) auto
 
 lemma fractrel_normalize_quot_right:
   assumes "snd x \<noteq> 0"
   shows   "fractrel y (normalize_quot x) \<longleftrightarrow> fractrel y x"
   using assms by (subst (1 2) fractrel_iff_normalize_quot_eq) auto
 
   
 lift_definition quot_of_fract :: 
   "'a :: {ring_gcd,idom_divide,semiring_gcd_mult_normalize} fract \<Rightarrow> 'a \<times> 'a" 
     is normalize_quot
   by (subst (asm) fractrel_iff_normalize_quot_eq) simp_all
   
 lemma quot_to_fract_quot_of_fract [simp]: "quot_to_fract (quot_of_fract x) = x"
   unfolding quot_to_fract_def
 proof transfer
   fix x :: "'a \<times> 'a" assume rel: "fractrel x x"
   define x' where "x' = normalize_quot x"
   obtain a b where [simp]: "x = (a, b)" by (cases x)
   from rel have "b \<noteq> 0" by simp
-  from normalize_quotE[OF this, of a] guess d .
+  from normalize_quotE[OF this, of a] obtain d
+    where
+      "a = fst (normalize_quot (a, b)) * d"
+      "b = snd (normalize_quot (a, b)) * d"
+      "d dvd a"
+      "d dvd b"
+      "d \<noteq> 0" .
   hence "a = fst x' * d" "b = snd x' * d" "d \<noteq> 0" "snd x' \<noteq> 0" by (simp_all add: x'_def)
   thus "fractrel (case x' of (a, b) \<Rightarrow> if b = 0 then (0, 1) else (a, b)) x"
     by (auto simp add: case_prod_unfold)
 qed
 
 lemma quot_of_fract_quot_to_fract: "quot_of_fract (quot_to_fract x) = normalize_quot x"
 proof (cases "snd x = 0")
   case True
   thus ?thesis unfolding quot_to_fract_def
     by transfer (simp add: case_prod_unfold normalize_quot_def)
 next
   case False
   thus ?thesis unfolding quot_to_fract_def by transfer (simp add: case_prod_unfold)
 qed
 
 lemma quot_of_fract_quot_to_fract': 
   "x \<in> normalized_fracts \<Longrightarrow> quot_of_fract (quot_to_fract x) = x"
   unfolding quot_to_fract_def by transfer (auto simp: normalize_quot_id)
 
 lemma quot_of_fract_in_normalized_fracts [simp]: "quot_of_fract x \<in> normalized_fracts"
   by transfer simp
 
 lemma normalize_quotI:
   assumes "a * d = b * c" "b \<noteq> 0" "(c, d) \<in> normalized_fracts"
   shows   "normalize_quot (a, b) = (c, d)"
 proof -
   from assms have "normalize_quot (a, b) = normalize_quot (c, d)"
     by (subst normalize_quot_eq_iff) auto
   also have "\<dots> = (c, d)" by (intro normalize_quot_id) fact
   finally show ?thesis .
 qed
 
 lemma td_normalized_fract:
   "type_definition quot_of_fract quot_to_fract normalized_fracts"
   by standard (simp_all add: quot_of_fract_quot_to_fract')
 
 lemma quot_of_fract_add_aux:
   assumes "snd x \<noteq> 0" "snd y \<noteq> 0" 
   shows   "(fst x * snd y + fst y * snd x) * (snd (normalize_quot x) * snd (normalize_quot y)) =
              snd x * snd y * (fst (normalize_quot x) * snd (normalize_quot y) +
              snd (normalize_quot x) * fst (normalize_quot y))"
 proof -
-  from normalize_quotE'[OF assms(1)] guess d . note d = this
-  from normalize_quotE'[OF assms(2)] guess e . note e = this
+  from normalize_quotE'[OF assms(1)] obtain d
+    where d:
+      "fst x = fst (normalize_quot x) * d"
+      "snd x = snd (normalize_quot x) * d"
+      "d dvd fst x"
+      "d dvd snd x"
+      "d \<noteq> 0" .
+  from normalize_quotE'[OF assms(2)] obtain e
+    where e:
+      "fst y = fst (normalize_quot y) * e"
+      "snd y = snd (normalize_quot y) * e"
+      "e dvd fst y"
+      "e dvd snd y"
+      "e \<noteq> 0" .
   show ?thesis by (simp_all add: d e algebra_simps)
 qed
 
 
 locale fract_as_normalized_quot
 begin
 setup_lifting td_normalized_fract
 end
 
 
 lemma quot_of_fract_add:
   "quot_of_fract (x + y) = 
      (let (a,b) = quot_of_fract x; (c,d) = quot_of_fract y
       in  normalize_quot (a * d + b * c, b * d))"
   by transfer (insert quot_of_fract_add_aux, 
                simp_all add: Let_def case_prod_unfold normalize_quot_eq_iff)
 
 lemma quot_of_fract_uminus:
   "quot_of_fract (-x) = (let (a,b) = quot_of_fract x in (-a, b))"
   by transfer (auto simp: case_prod_unfold Let_def normalize_quot_def dvd_neg_div mult_unit_dvd_iff)
 
 lemma quot_of_fract_diff:
   "quot_of_fract (x - y) = 
      (let (a,b) = quot_of_fract x; (c,d) = quot_of_fract y
       in  normalize_quot (a * d - b * c, b * d))" (is "_ = ?rhs")
 proof -
   have "x - y = x + -y" by simp
   also have "quot_of_fract \<dots> = ?rhs"
     by (simp only: quot_of_fract_add quot_of_fract_uminus Let_def case_prod_unfold) simp_all
   finally show ?thesis .
 qed
 
 lemma normalize_quot_mult_coprime:
   assumes "coprime a b" "coprime c d" "unit_factor b = 1" "unit_factor d = 1"
   defines "e \<equiv> fst (normalize_quot (a, d))" and "f \<equiv> snd (normalize_quot (a, d))"
      and  "g \<equiv> fst (normalize_quot (c, b))" and "h \<equiv> snd (normalize_quot (c, b))"
   shows   "normalize_quot (a * c, b * d) = (e * g, f * h)"
 proof (rule normalize_quotI)
   from assms have "gcd a b = 1" "gcd c d = 1"
     by simp_all
   from assms have "b \<noteq> 0" "d \<noteq> 0" by auto
   with assms have "normalize b = b" "normalize d = d"
     by (auto intro: normalize_unit_factor_eqI)
-  from normalize_quotE [OF \<open>b \<noteq> 0\<close>, of c] guess k .
+  from normalize_quotE [OF \<open>b \<noteq> 0\<close>, of c] obtain k
+    where
+      "c = fst (normalize_quot (c, b)) * k"
+      "b = snd (normalize_quot (c, b)) * k"
+      "k dvd c" "k dvd b" "k \<noteq> 0" .
   note k = this [folded \<open>gcd a b = 1\<close> \<open>gcd c d = 1\<close> assms(3) assms(4)]
-  from normalize_quotE [OF \<open>d \<noteq> 0\<close>, of a] guess l .
+  from normalize_quotE [OF \<open>d \<noteq> 0\<close>, of a] obtain l
+    where "a = fst (normalize_quot (a, d)) * l"
+      "d = snd (normalize_quot (a, d)) * l"
+      "l dvd a" "l dvd d" "l \<noteq> 0" .
   note l = this [folded \<open>gcd a b = 1\<close> \<open>gcd c d = 1\<close> assms(3) assms(4)]
   from k l show "a * c * (f * h) = b * d * (e * g)"
     by (metis e_def f_def g_def h_def mult.commute mult.left_commute)
   from assms have [simp]: "unit_factor f = 1" "unit_factor h = 1"
     by simp_all
   from assms have "coprime e f" "coprime g h" by (simp_all add: coprime_normalize_quot)
   with k l assms(1,2) \<open>b \<noteq> 0\<close> \<open>d \<noteq> 0\<close> \<open>unit_factor b = 1\<close> \<open>unit_factor d = 1\<close>
     \<open>normalize b = b\<close> \<open>normalize d = d\<close>
   show "(e * g, f * h) \<in> normalized_fracts"
     by (simp add: normalized_fracts_def unit_factor_mult e_def f_def g_def h_def
       coprime_normalize_quot dvd_unit_factor_div unit_factor_gcd)
       (metis coprime_mult_left_iff coprime_mult_right_iff)
 qed (insert assms(3,4), auto)
 
 lemma normalize_quot_mult:
   assumes "snd x \<noteq> 0" "snd y \<noteq> 0"
   shows   "normalize_quot (fst x * fst y, snd x * snd y) = normalize_quot 
              (fst (normalize_quot x) * fst (normalize_quot y),
               snd (normalize_quot x) * snd (normalize_quot y))"
 proof -
-  from normalize_quotE'[OF assms(1)] guess d . note d = this
-  from normalize_quotE'[OF assms(2)] guess e . note e = this
+  from normalize_quotE'[OF assms(1)] obtain d where d:
+    "fst x = fst (normalize_quot x) * d"
+    "snd x = snd (normalize_quot x) * d"
+    "d dvd fst x"
+    "d dvd snd x"
+    "d \<noteq> 0" .
+  from normalize_quotE'[OF assms(2)] obtain e where e:
+    "fst y = fst (normalize_quot y) * e"
+    "snd y = snd (normalize_quot y) * e"
+    "e dvd fst y"
+    "e dvd snd y"
+    "e \<noteq> 0" .
   show ?thesis by (simp_all add: d e algebra_simps normalize_quot_eq_iff)
 qed
 
 lemma quot_of_fract_mult:
   "quot_of_fract (x * y) = 
      (let (a,b) = quot_of_fract x; (c,d) = quot_of_fract y;
           (e,f) = normalize_quot (a,d); (g,h) = normalize_quot (c,b)
       in  (e*g, f*h))"
   by transfer
      (simp add: split_def Let_def coprime_normalize_quot normalize_quot_mult normalize_quot_mult_coprime)
   
 lemma normalize_quot_0 [simp]: 
     "normalize_quot (0, x) = (0, 1)" "normalize_quot (x, 0) = (0, 1)"
   by (simp_all add: normalize_quot_def)
   
 lemma normalize_quot_eq_0_iff [simp]: "fst (normalize_quot x) = 0 \<longleftrightarrow> fst x = 0 \<or> snd x = 0"
   by (auto simp: normalize_quot_def case_prod_unfold Let_def div_mult_unit2 dvd_div_eq_0_iff)
   
 lemma fst_quot_of_fract_0_imp: "fst (quot_of_fract x) = 0 \<Longrightarrow> snd (quot_of_fract x) = 1"
   by transfer auto
 
 lemma normalize_quot_swap:
   assumes "a \<noteq> 0" "b \<noteq> 0"
   defines "a' \<equiv> fst (normalize_quot (a, b))" and "b' \<equiv> snd (normalize_quot (a, b))"
   shows   "normalize_quot (b, a) = (b' div unit_factor a', a' div unit_factor a')"
 proof (rule normalize_quotI)
-  from normalize_quotE[OF assms(2), of a] guess d . note d = this [folded assms(3,4)]
+  from normalize_quotE[OF assms(2), of a] obtain d where
+    "a = fst (normalize_quot (a, b)) * d"
+    "b = snd (normalize_quot (a, b)) * d"
+    "d dvd a" "d dvd b" "d \<noteq> 0" .
+  note d = this [folded assms(3,4)]
   show "b * (a' div unit_factor a') = a * (b' div unit_factor a')"
     using assms(1,2) d 
     by (simp add: div_unit_factor [symmetric] unit_div_mult_swap mult_ac del: div_unit_factor)
   have "coprime a' b'" by (simp add: a'_def b'_def coprime_normalize_quot)
   thus "(b' div unit_factor a', a' div unit_factor a') \<in> normalized_fracts"
     using assms(1,2) d
     by (auto simp add: normalized_fracts_def ac_simps dvd_div_unit_iff elim: coprime_imp_coprime)
 qed fact+
   
 lemma quot_of_fract_inverse:
   "quot_of_fract (inverse x) = 
      (let (a,b) = quot_of_fract x; d = unit_factor a 
       in  if d = 0 then (0, 1) else (b div d, a div d))"
 proof (transfer, goal_cases)
   case (1 x)
   from normalize_quot_swap[of "fst x" "snd x"] show ?case
     by (auto simp: Let_def case_prod_unfold)
 qed
 
 lemma normalize_quot_div_unit_left:
   fixes x y u
   assumes "is_unit u"
   defines "x' \<equiv> fst (normalize_quot (x, y))" and "y' \<equiv> snd (normalize_quot (x, y))"
   shows "normalize_quot (x div u, y) = (x' div u, y')"
 proof (cases "y = 0")
   case False
   define v where "v = 1 div u"
   with \<open>is_unit u\<close> have "is_unit v" and u: "\<And>a. a div u = a * v"
     by simp_all
   from \<open>is_unit v\<close> have "coprime v = top"
     by (simp add: fun_eq_iff is_unit_left_imp_coprime)
-  from normalize_quotE[OF False, of x] guess d .
+  from normalize_quotE[OF False, of x] obtain d where
+    "x = fst (normalize_quot (x, y)) * d"
+    "y = snd (normalize_quot (x, y)) * d"
+    "d dvd x" "d dvd y" "d \<noteq> 0" .
   note d = this[folded assms(2,3)]
   from assms have "coprime x' y'" "unit_factor y' = 1"
     by (simp_all add: coprime_normalize_quot)
   with d \<open>coprime v = top\<close> have "normalize_quot (x * v, y) = (x' * v, y')"
     by (auto simp: normalized_fracts_def intro: normalize_quotI)
   then show ?thesis
     by (simp add: u)
 qed (simp_all add: assms)
 
 lemma normalize_quot_div_unit_right:
   fixes x y u
   assumes "is_unit u"
   defines "x' \<equiv> fst (normalize_quot (x, y))" and "y' \<equiv> snd (normalize_quot (x, y))"
   shows "normalize_quot (x, y div u) = (x' * u, y')"
 proof (cases "y = 0")
   case False
-  from normalize_quotE[OF this, of x] guess d . note d = this[folded assms(2,3)]
+  from normalize_quotE[OF this, of x]
+  obtain d where d:
+    "x = fst (normalize_quot (x, y)) * d"
+    "y = snd (normalize_quot (x, y)) * d"
+    "d dvd x" "d dvd y" "d \<noteq> 0" .
+  note d = this[folded assms(2,3)]
   from assms have "coprime x' y'" "unit_factor y' = 1" by (simp_all add: coprime_normalize_quot)
   with d \<open>is_unit u\<close> show ?thesis
     by (auto simp add: normalized_fracts_def is_unit_left_imp_coprime unit_div_eq_0_iff intro: normalize_quotI)
 qed (simp_all add: assms)
 
 lemma normalize_quot_normalize_left:
   fixes x y u
   defines "x' \<equiv> fst (normalize_quot (x, y))" and "y' \<equiv> snd (normalize_quot (x, y))"
   shows "normalize_quot (normalize x, y) = (x' div unit_factor x, y')"
   using normalize_quot_div_unit_left[of "unit_factor x" x y]
   by (cases "x = 0") (simp_all add: assms)
   
 lemma normalize_quot_normalize_right:
   fixes x y u
   defines "x' \<equiv> fst (normalize_quot (x, y))" and "y' \<equiv> snd (normalize_quot (x, y))"
   shows "normalize_quot (x, normalize y) = (x' * unit_factor y, y')"
   using normalize_quot_div_unit_right[of "unit_factor y" x y]
   by (cases "y = 0") (simp_all add: assms)
   
 lemma quot_of_fract_0 [simp]: "quot_of_fract 0 = (0, 1)"
   by transfer auto
 
 lemma quot_of_fract_1 [simp]: "quot_of_fract 1 = (1, 1)"
   by transfer (rule normalize_quotI, simp_all add: normalized_fracts_def)
 
 lemma quot_of_fract_divide:
   "quot_of_fract (x / y) = (if y = 0 then (0, 1) else
      (let (a,b) = quot_of_fract x; (c,d) = quot_of_fract y;
           (e,f) = normalize_quot (a,c); (g,h) = normalize_quot (d,b)
       in  (e * g, f * h)))" (is "_ = ?rhs")
 proof (cases "y = 0")
   case False
   hence A: "fst (quot_of_fract y) \<noteq> 0" by transfer auto
   have "x / y = x * inverse y" by (simp add: divide_inverse)
   also from False A have "quot_of_fract \<dots> = ?rhs"
     by (simp only: quot_of_fract_mult quot_of_fract_inverse)
        (simp_all add: Let_def case_prod_unfold fst_quot_of_fract_0_imp
           normalize_quot_div_unit_left normalize_quot_div_unit_right 
           normalize_quot_normalize_right normalize_quot_normalize_left)
   finally show ?thesis .
 qed simp_all
 
 end
diff --git a/src/HOL/Computational_Algebra/Polynomial.thy b/src/HOL/Computational_Algebra/Polynomial.thy
--- a/src/HOL/Computational_Algebra/Polynomial.thy
+++ b/src/HOL/Computational_Algebra/Polynomial.thy
@@ -1,5019 +1,5022 @@
 (*  Title:      HOL/Computational_Algebra/Polynomial.thy
     Author:     Brian Huffman
     Author:     Clemens Ballarin
     Author:     Amine Chaieb
     Author:     Florian Haftmann
 *)
 
 section \<open>Polynomials as type over a ring structure\<close>
 
 theory Polynomial
 imports
   Complex_Main
   "HOL-Library.More_List"
   "HOL-Library.Infinite_Set"
   Factorial_Ring
 begin
 
 subsection \<open>Auxiliary: operations for lists (later) representing coefficients\<close>
 
 definition cCons :: "'a::zero \<Rightarrow> 'a list \<Rightarrow> 'a list"  (infixr "##" 65)
   where "x ## xs = (if xs = [] \<and> x = 0 then [] else x # xs)"
 
 lemma cCons_0_Nil_eq [simp]: "0 ## [] = []"
   by (simp add: cCons_def)
 
 lemma cCons_Cons_eq [simp]: "x ## y # ys = x # y # ys"
   by (simp add: cCons_def)
 
 lemma cCons_append_Cons_eq [simp]: "x ## xs @ y # ys = x # xs @ y # ys"
   by (simp add: cCons_def)
 
 lemma cCons_not_0_eq [simp]: "x \<noteq> 0 \<Longrightarrow> x ## xs = x # xs"
   by (simp add: cCons_def)
 
 lemma strip_while_not_0_Cons_eq [simp]:
   "strip_while (\<lambda>x. x = 0) (x # xs) = x ## strip_while (\<lambda>x. x = 0) xs"
 proof (cases "x = 0")
   case False
   then show ?thesis by simp
 next
   case True
   show ?thesis
   proof (induct xs rule: rev_induct)
     case Nil
     with True show ?case by simp
   next
     case (snoc y ys)
     then show ?case
       by (cases "y = 0") (simp_all add: append_Cons [symmetric] del: append_Cons)
   qed
 qed
 
 lemma tl_cCons [simp]: "tl (x ## xs) = xs"
   by (simp add: cCons_def)
 
 
 subsection \<open>Definition of type \<open>poly\<close>\<close>
 
 typedef (overloaded) 'a poly = "{f :: nat \<Rightarrow> 'a::zero. \<forall>\<^sub>\<infinity> n. f n = 0}"
   morphisms coeff Abs_poly
   by (auto intro!: ALL_MOST)
 
 setup_lifting type_definition_poly
 
 lemma poly_eq_iff: "p = q \<longleftrightarrow> (\<forall>n. coeff p n = coeff q n)"
   by (simp add: coeff_inject [symmetric] fun_eq_iff)
 
 lemma poly_eqI: "(\<And>n. coeff p n = coeff q n) \<Longrightarrow> p = q"
   by (simp add: poly_eq_iff)
 
 lemma MOST_coeff_eq_0: "\<forall>\<^sub>\<infinity> n. coeff p n = 0"
   using coeff [of p] by simp
 
 
 subsection \<open>Degree of a polynomial\<close>
 
 definition degree :: "'a::zero poly \<Rightarrow> nat"
   where "degree p = (LEAST n. \<forall>i>n. coeff p i = 0)"
 
 lemma coeff_eq_0:
   assumes "degree p < n"
   shows "coeff p n = 0"
 proof -
   have "\<exists>n. \<forall>i>n. coeff p i = 0"
     using MOST_coeff_eq_0 by (simp add: MOST_nat)
   then have "\<forall>i>degree p. coeff p i = 0"
     unfolding degree_def by (rule LeastI_ex)
   with assms show ?thesis by simp
 qed
 
 lemma le_degree: "coeff p n \<noteq> 0 \<Longrightarrow> n \<le> degree p"
   by (erule contrapos_np, rule coeff_eq_0, simp)
 
 lemma degree_le: "\<forall>i>n. coeff p i = 0 \<Longrightarrow> degree p \<le> n"
   unfolding degree_def by (erule Least_le)
 
 lemma less_degree_imp: "n < degree p \<Longrightarrow> \<exists>i>n. coeff p i \<noteq> 0"
   unfolding degree_def by (drule not_less_Least, simp)
 
 
 subsection \<open>The zero polynomial\<close>
 
 instantiation poly :: (zero) zero
 begin
 
 lift_definition zero_poly :: "'a poly"
   is "\<lambda>_. 0"
   by (rule MOST_I) simp
 
 instance ..
 
 end
 
 lemma coeff_0 [simp]: "coeff 0 n = 0"
   by transfer rule
 
 lemma degree_0 [simp]: "degree 0 = 0"
   by (rule order_antisym [OF degree_le le0]) simp
 
 lemma leading_coeff_neq_0:
   assumes "p \<noteq> 0"
   shows "coeff p (degree p) \<noteq> 0"
 proof (cases "degree p")
   case 0
   from \<open>p \<noteq> 0\<close> obtain n where "coeff p n \<noteq> 0"
     by (auto simp add: poly_eq_iff)
   then have "n \<le> degree p"
     by (rule le_degree)
   with \<open>coeff p n \<noteq> 0\<close> and \<open>degree p = 0\<close> show "coeff p (degree p) \<noteq> 0"
     by simp
 next
   case (Suc n)
   from \<open>degree p = Suc n\<close> have "n < degree p"
     by simp
   then have "\<exists>i>n. coeff p i \<noteq> 0"
     by (rule less_degree_imp)
   then obtain i where "n < i" and "coeff p i \<noteq> 0"
     by blast
   from \<open>degree p = Suc n\<close> and \<open>n < i\<close> have "degree p \<le> i"
     by simp
   also from \<open>coeff p i \<noteq> 0\<close> have "i \<le> degree p"
     by (rule le_degree)
   finally have "degree p = i" .
   with \<open>coeff p i \<noteq> 0\<close> show "coeff p (degree p) \<noteq> 0" by simp
 qed
 
 lemma leading_coeff_0_iff [simp]: "coeff p (degree p) = 0 \<longleftrightarrow> p = 0"
   by (cases "p = 0") (simp_all add: leading_coeff_neq_0)
 
 lemma eq_zero_or_degree_less:
   assumes "degree p \<le> n" and "coeff p n = 0"
   shows "p = 0 \<or> degree p < n"
 proof (cases n)
   case 0
   with \<open>degree p \<le> n\<close> and \<open>coeff p n = 0\<close> have "coeff p (degree p) = 0"
     by simp
   then have "p = 0" by simp
   then show ?thesis ..
 next
   case (Suc m)
   from \<open>degree p \<le> n\<close> have "\<forall>i>n. coeff p i = 0"
     by (simp add: coeff_eq_0)
   with \<open>coeff p n = 0\<close> have "\<forall>i\<ge>n. coeff p i = 0"
     by (simp add: le_less)
   with \<open>n = Suc m\<close> have "\<forall>i>m. coeff p i = 0"
     by (simp add: less_eq_Suc_le)
   then have "degree p \<le> m"
     by (rule degree_le)
   with \<open>n = Suc m\<close> have "degree p < n"
     by (simp add: less_Suc_eq_le)
   then show ?thesis ..
 qed
 
 lemma coeff_0_degree_minus_1: "coeff rrr dr = 0 \<Longrightarrow> degree rrr \<le> dr \<Longrightarrow> degree rrr \<le> dr - 1"
   using eq_zero_or_degree_less by fastforce
 
 
 subsection \<open>List-style constructor for polynomials\<close>
 
 lift_definition pCons :: "'a::zero \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   is "\<lambda>a p. case_nat a (coeff p)"
   by (rule MOST_SucD) (simp add: MOST_coeff_eq_0)
 
 lemmas coeff_pCons = pCons.rep_eq
 
 lemma coeff_pCons_0 [simp]: "coeff (pCons a p) 0 = a"
   by transfer simp
 
 lemma coeff_pCons_Suc [simp]: "coeff (pCons a p) (Suc n) = coeff p n"
   by (simp add: coeff_pCons)
 
 lemma degree_pCons_le: "degree (pCons a p) \<le> Suc (degree p)"
   by (rule degree_le) (simp add: coeff_eq_0 coeff_pCons split: nat.split)
 
 lemma degree_pCons_eq: "p \<noteq> 0 \<Longrightarrow> degree (pCons a p) = Suc (degree p)"
   by (simp add: degree_pCons_le le_antisym le_degree)
 
 lemma degree_pCons_0: "degree (pCons a 0) = 0"
 proof -
   have "degree (pCons a 0) \<le> Suc 0"
     by (metis (no_types) degree_0 degree_pCons_le)
   then show ?thesis
     by (metis coeff_0 coeff_pCons_Suc degree_0 eq_zero_or_degree_less less_Suc0)
 qed
 
 lemma degree_pCons_eq_if [simp]: "degree (pCons a p) = (if p = 0 then 0 else Suc (degree p))"
   by (simp add: degree_pCons_0 degree_pCons_eq)
 
 lemma pCons_0_0 [simp]: "pCons 0 0 = 0"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma pCons_eq_iff [simp]: "pCons a p = pCons b q \<longleftrightarrow> a = b \<and> p = q"
 proof safe
   assume "pCons a p = pCons b q"
   then have "coeff (pCons a p) 0 = coeff (pCons b q) 0"
     by simp
   then show "a = b"
     by simp
 next
   assume "pCons a p = pCons b q"
   then have "coeff (pCons a p) (Suc n) = coeff (pCons b q) (Suc n)" for n
     by simp
   then show "p = q"
     by (simp add: poly_eq_iff)
 qed
 
 lemma pCons_eq_0_iff [simp]: "pCons a p = 0 \<longleftrightarrow> a = 0 \<and> p = 0"
   using pCons_eq_iff [of a p 0 0] by simp
 
 lemma pCons_cases [cases type: poly]:
   obtains (pCons) a q where "p = pCons a q"
 proof
   show "p = pCons (coeff p 0) (Abs_poly (\<lambda>n. coeff p (Suc n)))"
     by transfer
       (simp_all add: MOST_inj[where f=Suc and P="\<lambda>n. p n = 0" for p] fun_eq_iff Abs_poly_inverse
         split: nat.split)
 qed
 
 lemma pCons_induct [case_names 0 pCons, induct type: poly]:
   assumes zero: "P 0"
   assumes pCons: "\<And>a p. a \<noteq> 0 \<or> p \<noteq> 0 \<Longrightarrow> P p \<Longrightarrow> P (pCons a p)"
   shows "P p"
 proof (induct p rule: measure_induct_rule [where f=degree])
   case (less p)
   obtain a q where "p = pCons a q" by (rule pCons_cases)
   have "P q"
   proof (cases "q = 0")
     case True
     then show "P q" by (simp add: zero)
   next
     case False
     then have "degree (pCons a q) = Suc (degree q)"
       by (rule degree_pCons_eq)
     with \<open>p = pCons a q\<close> have "degree q < degree p"
       by simp
     then show "P q"
       by (rule less.hyps)
   qed
   have "P (pCons a q)"
   proof (cases "a \<noteq> 0 \<or> q \<noteq> 0")
     case True
     with \<open>P q\<close> show ?thesis by (auto intro: pCons)
   next
     case False
     with zero show ?thesis by simp
   qed
   with \<open>p = pCons a q\<close> show ?case
     by simp
 qed
 
 lemma degree_eq_zeroE:
   fixes p :: "'a::zero poly"
   assumes "degree p = 0"
   obtains a where "p = pCons a 0"
 proof -
   obtain a q where p: "p = pCons a q"
     by (cases p)
   with assms have "q = 0"
     by (cases "q = 0") simp_all
   with p have "p = pCons a 0"
     by simp
   then show thesis ..
 qed
 
 
 subsection \<open>Quickcheck generator for polynomials\<close>
 
 quickcheck_generator poly constructors: "0 :: _ poly", pCons
 
 
 subsection \<open>List-style syntax for polynomials\<close>
 
 syntax "_poly" :: "args \<Rightarrow> 'a poly"  ("[:(_):]")
 translations
   "[:x, xs:]" \<rightleftharpoons> "CONST pCons x [:xs:]"
   "[:x:]" \<rightleftharpoons> "CONST pCons x 0"
   "[:x:]" \<leftharpoondown> "CONST pCons x (_constrain 0 t)"
 
 
 subsection \<open>Representation of polynomials by lists of coefficients\<close>
 
 primrec Poly :: "'a::zero list \<Rightarrow> 'a poly"
   where
     [code_post]: "Poly [] = 0"
   | [code_post]: "Poly (a # as) = pCons a (Poly as)"
 
 lemma Poly_replicate_0 [simp]: "Poly (replicate n 0) = 0"
   by (induct n) simp_all
 
 lemma Poly_eq_0: "Poly as = 0 \<longleftrightarrow> (\<exists>n. as = replicate n 0)"
   by (induct as) (auto simp add: Cons_replicate_eq)
 
 lemma Poly_append_replicate_zero [simp]: "Poly (as @ replicate n 0) = Poly as"
   by (induct as) simp_all
 
 lemma Poly_snoc_zero [simp]: "Poly (as @ [0]) = Poly as"
   using Poly_append_replicate_zero [of as 1] by simp
 
 lemma Poly_cCons_eq_pCons_Poly [simp]: "Poly (a ## p) = pCons a (Poly p)"
   by (simp add: cCons_def)
 
 lemma Poly_on_rev_starting_with_0 [simp]: "hd as = 0 \<Longrightarrow> Poly (rev (tl as)) = Poly (rev as)"
   by (cases as) simp_all
 
 lemma degree_Poly: "degree (Poly xs) \<le> length xs"
   by (induct xs) simp_all
 
 lemma coeff_Poly_eq [simp]: "coeff (Poly xs) = nth_default 0 xs"
   by (induct xs) (simp_all add: fun_eq_iff coeff_pCons split: nat.splits)
 
 definition coeffs :: "'a poly \<Rightarrow> 'a::zero list"
   where "coeffs p = (if p = 0 then [] else map (\<lambda>i. coeff p i) [0 ..< Suc (degree p)])"
 
 lemma coeffs_eq_Nil [simp]: "coeffs p = [] \<longleftrightarrow> p = 0"
   by (simp add: coeffs_def)
 
 lemma not_0_coeffs_not_Nil: "p \<noteq> 0 \<Longrightarrow> coeffs p \<noteq> []"
   by simp
 
 lemma coeffs_0_eq_Nil [simp]: "coeffs 0 = []"
   by simp
 
 lemma coeffs_pCons_eq_cCons [simp]: "coeffs (pCons a p) = a ## coeffs p"
 proof -
   have *: "\<forall>m\<in>set ms. m > 0 \<Longrightarrow> map (case_nat x f) ms = map f (map (\<lambda>n. n - 1) ms)"
     for ms :: "nat list" and f :: "nat \<Rightarrow> 'a" and x :: "'a"
     by (induct ms) (auto split: nat.split)
   show ?thesis
     by (simp add: * coeffs_def upt_conv_Cons coeff_pCons map_decr_upt del: upt_Suc)
 qed
 
 lemma length_coeffs: "p \<noteq> 0 \<Longrightarrow> length (coeffs p) = degree p + 1"
   by (simp add: coeffs_def)
 
 lemma coeffs_nth: "p \<noteq> 0 \<Longrightarrow> n \<le> degree p \<Longrightarrow> coeffs p ! n = coeff p n"
   by (auto simp: coeffs_def simp del: upt_Suc)
 
 lemma coeff_in_coeffs: "p \<noteq> 0 \<Longrightarrow> n \<le> degree p \<Longrightarrow> coeff p n \<in> set (coeffs p)"
   using coeffs_nth [of p n, symmetric] by (simp add: length_coeffs)
 
 lemma not_0_cCons_eq [simp]: "p \<noteq> 0 \<Longrightarrow> a ## coeffs p = a # coeffs p"
   by (simp add: cCons_def)
 
 lemma Poly_coeffs [simp, code abstype]: "Poly (coeffs p) = p"
   by (induct p) auto
 
 lemma coeffs_Poly [simp]: "coeffs (Poly as) = strip_while (HOL.eq 0) as"
 proof (induct as)
   case Nil
   then show ?case by simp
 next
   case (Cons a as)
   from replicate_length_same [of as 0] have "(\<forall>n. as \<noteq> replicate n 0) \<longleftrightarrow> (\<exists>a\<in>set as. a \<noteq> 0)"
     by (auto dest: sym [of _ as])
   with Cons show ?case by auto
 qed
 
 lemma no_trailing_coeffs [simp]:
   "no_trailing (HOL.eq 0) (coeffs p)"
   by (induct p)  auto
 
 lemma strip_while_coeffs [simp]:
   "strip_while (HOL.eq 0) (coeffs p) = coeffs p"
   by simp
 
 lemma coeffs_eq_iff: "p = q \<longleftrightarrow> coeffs p = coeffs q"
   (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then show ?Q by simp
 next
   assume ?Q
   then have "Poly (coeffs p) = Poly (coeffs q)" by simp
   then show ?P by simp
 qed
 
 lemma nth_default_coeffs_eq: "nth_default 0 (coeffs p) = coeff p"
   by (simp add: fun_eq_iff coeff_Poly_eq [symmetric])
 
 lemma [code]: "coeff p = nth_default 0 (coeffs p)"
   by (simp add: nth_default_coeffs_eq)
 
 lemma coeffs_eqI:
   assumes coeff: "\<And>n. coeff p n = nth_default 0 xs n"
   assumes zero: "no_trailing (HOL.eq 0) xs"
   shows "coeffs p = xs"
 proof -
   from coeff have "p = Poly xs"
     by (simp add: poly_eq_iff)
   with zero show ?thesis by simp
 qed
 
 lemma degree_eq_length_coeffs [code]: "degree p = length (coeffs p) - 1"
   by (simp add: coeffs_def)
 
 lemma length_coeffs_degree: "p \<noteq> 0 \<Longrightarrow> length (coeffs p) = Suc (degree p)"
   by (induct p) (auto simp: cCons_def)
 
 lemma [code abstract]: "coeffs 0 = []"
   by (fact coeffs_0_eq_Nil)
 
 lemma [code abstract]: "coeffs (pCons a p) = a ## coeffs p"
   by (fact coeffs_pCons_eq_cCons)
 
 lemma set_coeffs_subset_singleton_0_iff [simp]:
   "set (coeffs p) \<subseteq> {0} \<longleftrightarrow> p = 0"
   by (auto simp add: coeffs_def intro: classical)
 
 lemma set_coeffs_not_only_0 [simp]:
   "set (coeffs p) \<noteq> {0}"
   by (auto simp add: set_eq_subset)
 
 lemma forall_coeffs_conv:
   "(\<forall>n. P (coeff p n)) \<longleftrightarrow> (\<forall>c \<in> set (coeffs p). P c)" if "P 0"
   using that by (auto simp add: coeffs_def)
     (metis atLeastLessThan_iff coeff_eq_0 not_less_iff_gr_or_eq zero_le)
 
 instantiation poly :: ("{zero, equal}") equal
 begin
 
 definition [code]: "HOL.equal (p::'a poly) q \<longleftrightarrow> HOL.equal (coeffs p) (coeffs q)"
 
 instance
   by standard (simp add: equal equal_poly_def coeffs_eq_iff)
 
 end
 
 lemma [code nbe]: "HOL.equal (p :: _ poly) p \<longleftrightarrow> True"
   by (fact equal_refl)
 
 definition is_zero :: "'a::zero poly \<Rightarrow> bool"
   where [code]: "is_zero p \<longleftrightarrow> List.null (coeffs p)"
 
 lemma is_zero_null [code_abbrev]: "is_zero p \<longleftrightarrow> p = 0"
   by (simp add: is_zero_def null_def)
 
 
 subsubsection \<open>Reconstructing the polynomial from the list\<close>
   \<comment> \<open>contributed by Sebastiaan J.C. Joosten and René Thiemann\<close>
 
 definition poly_of_list :: "'a::comm_monoid_add list \<Rightarrow> 'a poly"
   where [simp]: "poly_of_list = Poly"
 
 lemma poly_of_list_impl [code abstract]: "coeffs (poly_of_list as) = strip_while (HOL.eq 0) as"
   by simp
 
 
 subsection \<open>Fold combinator for polynomials\<close>
 
 definition fold_coeffs :: "('a::zero \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a poly \<Rightarrow> 'b \<Rightarrow> 'b"
   where "fold_coeffs f p = foldr f (coeffs p)"
 
 lemma fold_coeffs_0_eq [simp]: "fold_coeffs f 0 = id"
   by (simp add: fold_coeffs_def)
 
 lemma fold_coeffs_pCons_eq [simp]: "f 0 = id \<Longrightarrow> fold_coeffs f (pCons a p) = f a \<circ> fold_coeffs f p"
   by (simp add: fold_coeffs_def cCons_def fun_eq_iff)
 
 lemma fold_coeffs_pCons_0_0_eq [simp]: "fold_coeffs f (pCons 0 0) = id"
   by (simp add: fold_coeffs_def)
 
 lemma fold_coeffs_pCons_coeff_not_0_eq [simp]:
   "a \<noteq> 0 \<Longrightarrow> fold_coeffs f (pCons a p) = f a \<circ> fold_coeffs f p"
   by (simp add: fold_coeffs_def)
 
 lemma fold_coeffs_pCons_not_0_0_eq [simp]:
   "p \<noteq> 0 \<Longrightarrow> fold_coeffs f (pCons a p) = f a \<circ> fold_coeffs f p"
   by (simp add: fold_coeffs_def)
 
 
 subsection \<open>Canonical morphism on polynomials -- evaluation\<close>
 
 definition poly :: \<open>'a::comm_semiring_0 poly \<Rightarrow> 'a \<Rightarrow> 'a\<close>
   where \<open>poly p a = horner_sum id a (coeffs p)\<close>
 
 lemma poly_eq_fold_coeffs:
   \<open>poly p = fold_coeffs (\<lambda>a f x. a + x * f x) p (\<lambda>x. 0)\<close>
   by (induction p) (auto simp add: fun_eq_iff poly_def)
 
 lemma poly_0 [simp]: "poly 0 x = 0"
   by (simp add: poly_def)
 
 lemma poly_pCons [simp]: "poly (pCons a p) x = a + x * poly p x"
   by (cases "p = 0 \<and> a = 0") (auto simp add: poly_def)
 
 lemma poly_altdef: "poly p x = (\<Sum>i\<le>degree p. coeff p i * x ^ i)"
   for x :: "'a::{comm_semiring_0,semiring_1}"
 proof (induction p rule: pCons_induct)
   case 0
   then show ?case
     by simp
 next
   case (pCons a p)
   show ?case
   proof (cases "p = 0")
     case True
     then show ?thesis by simp
   next
     case False
     let ?p' = "pCons a p"
     note poly_pCons[of a p x]
     also note pCons.IH
     also have "a + x * (\<Sum>i\<le>degree p. coeff p i * x ^ i) =
         coeff ?p' 0 * x^0 + (\<Sum>i\<le>degree p. coeff ?p' (Suc i) * x^Suc i)"
       by (simp add: field_simps sum_distrib_left coeff_pCons)
     also note sum.atMost_Suc_shift[symmetric]
     also note degree_pCons_eq[OF \<open>p \<noteq> 0\<close>, of a, symmetric]
     finally show ?thesis .
   qed
 qed
 
 lemma poly_0_coeff_0: "poly p 0 = coeff p 0"
   by (cases p) (auto simp: poly_altdef)
 
 
 subsection \<open>Monomials\<close>
 
 lift_definition monom :: "'a \<Rightarrow> nat \<Rightarrow> 'a::zero poly"
   is "\<lambda>a m n. if m = n then a else 0"
   by (simp add: MOST_iff_cofinite)
 
 lemma coeff_monom [simp]: "coeff (monom a m) n = (if m = n then a else 0)"
   by transfer rule
 
 lemma monom_0: "monom a 0 = pCons a 0"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma monom_Suc: "monom a (Suc n) = pCons 0 (monom a n)"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma monom_eq_0 [simp]: "monom 0 n = 0"
   by (rule poly_eqI) simp
 
 lemma monom_eq_0_iff [simp]: "monom a n = 0 \<longleftrightarrow> a = 0"
   by (simp add: poly_eq_iff)
 
 lemma monom_eq_iff [simp]: "monom a n = monom b n \<longleftrightarrow> a = b"
   by (simp add: poly_eq_iff)
 
 lemma degree_monom_le: "degree (monom a n) \<le> n"
   by (rule degree_le, simp)
 
 lemma degree_monom_eq: "a \<noteq> 0 \<Longrightarrow> degree (monom a n) = n"
   by (metis coeff_monom leading_coeff_0_iff)
 
 lemma coeffs_monom [code abstract]:
   "coeffs (monom a n) = (if a = 0 then [] else replicate n 0 @ [a])"
   by (induct n) (simp_all add: monom_0 monom_Suc)
 
 lemma fold_coeffs_monom [simp]: "a \<noteq> 0 \<Longrightarrow> fold_coeffs f (monom a n) = f 0 ^^ n \<circ> f a"
   by (simp add: fold_coeffs_def coeffs_monom fun_eq_iff)
 
 lemma poly_monom: "poly (monom a n) x = a * x ^ n"
   for a x :: "'a::comm_semiring_1"
   by (cases "a = 0", simp_all) (induct n, simp_all add: mult.left_commute poly_eq_fold_coeffs)
 
 lemma monom_eq_iff': "monom c n = monom d m \<longleftrightarrow>  c = d \<and> (c = 0 \<or> n = m)"
   by (auto simp: poly_eq_iff)
 
 lemma monom_eq_const_iff: "monom c n = [:d:] \<longleftrightarrow> c = d \<and> (c = 0 \<or> n = 0)"
   using monom_eq_iff'[of c n d 0] by (simp add: monom_0)
 
 
 subsection \<open>Leading coefficient\<close>
 
 abbreviation lead_coeff:: "'a::zero poly \<Rightarrow> 'a"
   where "lead_coeff p \<equiv> coeff p (degree p)"
 
 lemma lead_coeff_pCons[simp]:
   "p \<noteq> 0 \<Longrightarrow> lead_coeff (pCons a p) = lead_coeff p"
   "p = 0 \<Longrightarrow> lead_coeff (pCons a p) = a"
   by auto
 
 lemma lead_coeff_monom [simp]: "lead_coeff (monom c n) = c"
   by (cases "c = 0") (simp_all add: degree_monom_eq)
 
 lemma last_coeffs_eq_coeff_degree:
   "last (coeffs p) = lead_coeff p" if "p \<noteq> 0"
   using that by (simp add: coeffs_def)
 
 
 subsection \<open>Addition and subtraction\<close>
 
 instantiation poly :: (comm_monoid_add) comm_monoid_add
 begin
 
 lift_definition plus_poly :: "'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   is "\<lambda>p q n. coeff p n + coeff q n"
 proof -
   fix q p :: "'a poly"
   show "\<forall>\<^sub>\<infinity>n. coeff p n + coeff q n = 0"
     using MOST_coeff_eq_0[of p] MOST_coeff_eq_0[of q] by eventually_elim simp
 qed
 
 lemma coeff_add [simp]: "coeff (p + q) n = coeff p n + coeff q n"
   by (simp add: plus_poly.rep_eq)
 
 instance
 proof
   fix p q r :: "'a poly"
   show "(p + q) + r = p + (q + r)"
     by (simp add: poly_eq_iff add.assoc)
   show "p + q = q + p"
     by (simp add: poly_eq_iff add.commute)
   show "0 + p = p"
     by (simp add: poly_eq_iff)
 qed
 
 end
 
 instantiation poly :: (cancel_comm_monoid_add) cancel_comm_monoid_add
 begin
 
 lift_definition minus_poly :: "'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   is "\<lambda>p q n. coeff p n - coeff q n"
 proof -
   fix q p :: "'a poly"
   show "\<forall>\<^sub>\<infinity>n. coeff p n - coeff q n = 0"
     using MOST_coeff_eq_0[of p] MOST_coeff_eq_0[of q] by eventually_elim simp
 qed
 
 lemma coeff_diff [simp]: "coeff (p - q) n = coeff p n - coeff q n"
   by (simp add: minus_poly.rep_eq)
 
 instance
 proof
   fix p q r :: "'a poly"
   show "p + q - p = q"
     by (simp add: poly_eq_iff)
   show "p - q - r = p - (q + r)"
     by (simp add: poly_eq_iff diff_diff_eq)
 qed
 
 end
 
 instantiation poly :: (ab_group_add) ab_group_add
 begin
 
 lift_definition uminus_poly :: "'a poly \<Rightarrow> 'a poly"
   is "\<lambda>p n. - coeff p n"
 proof -
   fix p :: "'a poly"
   show "\<forall>\<^sub>\<infinity>n. - coeff p n = 0"
     using MOST_coeff_eq_0 by simp
 qed
 
 lemma coeff_minus [simp]: "coeff (- p) n = - coeff p n"
   by (simp add: uminus_poly.rep_eq)
 
 instance
 proof
   fix p q :: "'a poly"
   show "- p + p = 0"
     by (simp add: poly_eq_iff)
   show "p - q = p + - q"
     by (simp add: poly_eq_iff)
 qed
 
 end
 
 lemma add_pCons [simp]: "pCons a p + pCons b q = pCons (a + b) (p + q)"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma minus_pCons [simp]: "- pCons a p = pCons (- a) (- p)"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma diff_pCons [simp]: "pCons a p - pCons b q = pCons (a - b) (p - q)"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma degree_add_le_max: "degree (p + q) \<le> max (degree p) (degree q)"
   by (rule degree_le) (auto simp add: coeff_eq_0)
 
 lemma degree_add_le: "degree p \<le> n \<Longrightarrow> degree q \<le> n \<Longrightarrow> degree (p + q) \<le> n"
   by (auto intro: order_trans degree_add_le_max)
 
 lemma degree_add_less: "degree p < n \<Longrightarrow> degree q < n \<Longrightarrow> degree (p + q) < n"
   by (auto intro: le_less_trans degree_add_le_max)
 
 lemma degree_add_eq_right: assumes "degree p < degree q" shows "degree (p + q) = degree q"
 proof (cases "q = 0")
   case False
   show ?thesis
   proof (rule order_antisym)
     show "degree (p + q) \<le> degree q"
       by (simp add: assms degree_add_le order.strict_implies_order)
     show "degree q \<le> degree (p + q)"
       by (simp add: False assms coeff_eq_0 le_degree)
   qed
 qed (use assms in auto)
 
 lemma degree_add_eq_left: "degree q < degree p \<Longrightarrow> degree (p + q) = degree p"
   using degree_add_eq_right [of q p] by (simp add: add.commute)
 
 lemma degree_minus [simp]: "degree (- p) = degree p"
   by (simp add: degree_def)
 
 lemma lead_coeff_add_le: "degree p < degree q \<Longrightarrow> lead_coeff (p + q) = lead_coeff q"
   by (metis coeff_add coeff_eq_0 monoid_add_class.add.left_neutral degree_add_eq_right)
 
 lemma lead_coeff_minus: "lead_coeff (- p) = - lead_coeff p"
   by (metis coeff_minus degree_minus)
 
 lemma degree_diff_le_max: "degree (p - q) \<le> max (degree p) (degree q)"
   for p q :: "'a::ab_group_add poly"
   using degree_add_le [where p=p and q="-q"] by simp
 
 lemma degree_diff_le: "degree p \<le> n \<Longrightarrow> degree q \<le> n \<Longrightarrow> degree (p - q) \<le> n"
   for p q :: "'a::ab_group_add poly"
   using degree_add_le [of p n "- q"] by simp
 
 lemma degree_diff_less: "degree p < n \<Longrightarrow> degree q < n \<Longrightarrow> degree (p - q) < n"
   for p q :: "'a::ab_group_add poly"
   using degree_add_less [of p n "- q"] by simp
 
 lemma add_monom: "monom a n + monom b n = monom (a + b) n"
   by (rule poly_eqI) simp
 
 lemma diff_monom: "monom a n - monom b n = monom (a - b) n"
   by (rule poly_eqI) simp
 
 lemma minus_monom: "- monom a n = monom (- a) n"
   by (rule poly_eqI) simp
 
 lemma coeff_sum: "coeff (\<Sum>x\<in>A. p x) i = (\<Sum>x\<in>A. coeff (p x) i)"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma monom_sum: "monom (\<Sum>x\<in>A. a x) n = (\<Sum>x\<in>A. monom (a x) n)"
   by (rule poly_eqI) (simp add: coeff_sum)
 
 fun plus_coeffs :: "'a::comm_monoid_add list \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where
     "plus_coeffs xs [] = xs"
   | "plus_coeffs [] ys = ys"
   | "plus_coeffs (x # xs) (y # ys) = (x + y) ## plus_coeffs xs ys"
 
 lemma coeffs_plus_eq_plus_coeffs [code abstract]:
   "coeffs (p + q) = plus_coeffs (coeffs p) (coeffs q)"
 proof -
   have *: "nth_default 0 (plus_coeffs xs ys) n = nth_default 0 xs n + nth_default 0 ys n"
     for xs ys :: "'a list" and n
   proof (induct xs ys arbitrary: n rule: plus_coeffs.induct)
     case (3 x xs y ys n)
     then show ?case
       by (cases n) (auto simp add: cCons_def)
   qed simp_all
   have **: "no_trailing (HOL.eq 0) (plus_coeffs xs ys)"
     if "no_trailing (HOL.eq 0) xs" and "no_trailing (HOL.eq 0) ys"
     for xs ys :: "'a list"
     using that by (induct xs ys rule: plus_coeffs.induct) (simp_all add: cCons_def)
   show ?thesis
     by (rule coeffs_eqI) (auto simp add: * nth_default_coeffs_eq intro: **)
 qed
 
 lemma coeffs_uminus [code abstract]:
   "coeffs (- p) = map uminus (coeffs p)"
 proof -
   have eq_0: "HOL.eq 0 \<circ> uminus = HOL.eq (0::'a)"
     by (simp add: fun_eq_iff)
   show ?thesis
     by (rule coeffs_eqI) (simp_all add: nth_default_map_eq nth_default_coeffs_eq no_trailing_map eq_0)
 qed
 
 lemma [code]: "p - q = p + - q"
   for p q :: "'a::ab_group_add poly"
   by (fact diff_conv_add_uminus)
 
 lemma poly_add [simp]: "poly (p + q) x = poly p x + poly q x"
 proof (induction p arbitrary: q)
   case (pCons a p)
   then show ?case
     by (cases q) (simp add: algebra_simps)
 qed auto
 
 lemma poly_minus [simp]: "poly (- p) x = - poly p x"
   for x :: "'a::comm_ring"
   by (induct p) simp_all
 
 lemma poly_diff [simp]: "poly (p - q) x = poly p x - poly q x"
   for x :: "'a::comm_ring"
   using poly_add [of p "- q" x] by simp
 
 lemma poly_sum: "poly (\<Sum>k\<in>A. p k) x = (\<Sum>k\<in>A. poly (p k) x)"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma degree_sum_le: "finite S \<Longrightarrow> (\<And>p. p \<in> S \<Longrightarrow> degree (f p) \<le> n) \<Longrightarrow> degree (sum f S) \<le> n"
 proof (induct S rule: finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert p S)
   then have "degree (sum f S) \<le> n" "degree (f p) \<le> n"
     by auto
   then show ?case
     unfolding sum.insert[OF insert(1-2)] by (metis degree_add_le)
 qed
 
 lemma poly_as_sum_of_monoms':
   assumes "degree p \<le> n"
   shows "(\<Sum>i\<le>n. monom (coeff p i) i) = p"
 proof -
   have eq: "\<And>i. {..n} \<inter> {i} = (if i \<le> n then {i} else {})"
     by auto
   from assms show ?thesis
     by (simp add: poly_eq_iff coeff_sum coeff_eq_0 sum.If_cases eq
         if_distrib[where f="\<lambda>x. x * a" for a])
 qed
 
 lemma poly_as_sum_of_monoms: "(\<Sum>i\<le>degree p. monom (coeff p i) i) = p"
   by (intro poly_as_sum_of_monoms' order_refl)
 
 lemma Poly_snoc: "Poly (xs @ [x]) = Poly xs + monom x (length xs)"
   by (induct xs) (simp_all add: monom_0 monom_Suc)
 
 
 subsection \<open>Multiplication by a constant, polynomial multiplication and the unit polynomial\<close>
 
 lift_definition smult :: "'a::comm_semiring_0 \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   is "\<lambda>a p n. a * coeff p n"
 proof -
   fix a :: 'a and p :: "'a poly"
   show "\<forall>\<^sub>\<infinity> i. a * coeff p i = 0"
     using MOST_coeff_eq_0[of p] by eventually_elim simp
 qed
 
 lemma coeff_smult [simp]: "coeff (smult a p) n = a * coeff p n"
   by (simp add: smult.rep_eq)
 
 lemma degree_smult_le: "degree (smult a p) \<le> degree p"
   by (rule degree_le) (simp add: coeff_eq_0)
 
 lemma smult_smult [simp]: "smult a (smult b p) = smult (a * b) p"
   by (rule poly_eqI) (simp add: mult.assoc)
 
 lemma smult_0_right [simp]: "smult a 0 = 0"
   by (rule poly_eqI) simp
 
 lemma smult_0_left [simp]: "smult 0 p = 0"
   by (rule poly_eqI) simp
 
 lemma smult_1_left [simp]: "smult (1::'a::comm_semiring_1) p = p"
   by (rule poly_eqI) simp
 
 lemma smult_add_right: "smult a (p + q) = smult a p + smult a q"
   by (rule poly_eqI) (simp add: algebra_simps)
 
 lemma smult_add_left: "smult (a + b) p = smult a p + smult b p"
   by (rule poly_eqI) (simp add: algebra_simps)
 
 lemma smult_minus_right [simp]: "smult a (- p) = - smult a p"
   for a :: "'a::comm_ring"
   by (rule poly_eqI) simp
 
 lemma smult_minus_left [simp]: "smult (- a) p = - smult a p"
   for a :: "'a::comm_ring"
   by (rule poly_eqI) simp
 
 lemma smult_diff_right: "smult a (p - q) = smult a p - smult a q"
   for a :: "'a::comm_ring"
   by (rule poly_eqI) (simp add: algebra_simps)
 
 lemma smult_diff_left: "smult (a - b) p = smult a p - smult b p"
   for a b :: "'a::comm_ring"
   by (rule poly_eqI) (simp add: algebra_simps)
 
 lemmas smult_distribs =
   smult_add_left smult_add_right
   smult_diff_left smult_diff_right
 
 lemma smult_pCons [simp]: "smult a (pCons b p) = pCons (a * b) (smult a p)"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma smult_monom: "smult a (monom b n) = monom (a * b) n"
   by (induct n) (simp_all add: monom_0 monom_Suc)
 
 lemma smult_Poly: "smult c (Poly xs) = Poly (map ((*) c) xs)"
   by (auto simp: poly_eq_iff nth_default_def)
 
 lemma degree_smult_eq [simp]: "degree (smult a p) = (if a = 0 then 0 else degree p)"
   for a :: "'a::{comm_semiring_0,semiring_no_zero_divisors}"
   by (cases "a = 0") (simp_all add: degree_def)
 
 lemma smult_eq_0_iff [simp]: "smult a p = 0 \<longleftrightarrow> a = 0 \<or> p = 0"
   for a :: "'a::{comm_semiring_0,semiring_no_zero_divisors}"
   by (simp add: poly_eq_iff)
 
 lemma coeffs_smult [code abstract]:
   "coeffs (smult a p) = (if a = 0 then [] else map (Groups.times a) (coeffs p))"
   for p :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
 proof -
   have eq_0: "HOL.eq 0 \<circ> times a = HOL.eq (0::'a)" if "a \<noteq> 0"
     using that by (simp add: fun_eq_iff)
   show ?thesis
     by (rule coeffs_eqI) (auto simp add: no_trailing_map nth_default_map_eq nth_default_coeffs_eq eq_0)
 qed
 
 lemma smult_eq_iff:
   fixes b :: "'a :: field"
   assumes "b \<noteq> 0"
   shows "smult a p = smult b q \<longleftrightarrow> smult (a / b) p = q"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   also from assms have "smult (inverse b) \<dots> = q"
     by simp
   finally show ?rhs
     by (simp add: field_simps)
 next
   assume ?rhs
   with assms show ?lhs by auto
 qed
 
 instantiation poly :: (comm_semiring_0) comm_semiring_0
 begin
 
 definition "p * q = fold_coeffs (\<lambda>a p. smult a q + pCons 0 p) p 0"
 
 lemma mult_poly_0_left: "(0::'a poly) * q = 0"
   by (simp add: times_poly_def)
 
 lemma mult_pCons_left [simp]: "pCons a p * q = smult a q + pCons 0 (p * q)"
   by (cases "p = 0 \<and> a = 0") (auto simp add: times_poly_def)
 
 lemma mult_poly_0_right: "p * (0::'a poly) = 0"
   by (induct p) (simp_all add: mult_poly_0_left)
 
 lemma mult_pCons_right [simp]: "p * pCons a q = smult a p + pCons 0 (p * q)"
   by (induct p) (simp_all add: mult_poly_0_left algebra_simps)
 
 lemmas mult_poly_0 = mult_poly_0_left mult_poly_0_right
 
 lemma mult_smult_left [simp]: "smult a p * q = smult a (p * q)"
   by (induct p) (simp_all add: mult_poly_0 smult_add_right)
 
 lemma mult_smult_right [simp]: "p * smult a q = smult a (p * q)"
   by (induct q) (simp_all add: mult_poly_0 smult_add_right)
 
 lemma mult_poly_add_left: "(p + q) * r = p * r + q * r"
   for p q r :: "'a poly"
   by (induct r) (simp_all add: mult_poly_0 smult_distribs algebra_simps)
 
 instance
 proof
   fix p q r :: "'a poly"
   show 0: "0 * p = 0"
     by (rule mult_poly_0_left)
   show "p * 0 = 0"
     by (rule mult_poly_0_right)
   show "(p + q) * r = p * r + q * r"
     by (rule mult_poly_add_left)
   show "(p * q) * r = p * (q * r)"
     by (induct p) (simp_all add: mult_poly_0 mult_poly_add_left)
   show "p * q = q * p"
     by (induct p) (simp_all add: mult_poly_0)
 qed
 
 end
 
 lemma coeff_mult_degree_sum:
   "coeff (p * q) (degree p + degree q) = coeff p (degree p) * coeff q (degree q)"
   by (induct p) (simp_all add: coeff_eq_0)
 
 instance poly :: ("{comm_semiring_0,semiring_no_zero_divisors}") semiring_no_zero_divisors
 proof
   fix p q :: "'a poly"
   assume "p \<noteq> 0" and "q \<noteq> 0"
   have "coeff (p * q) (degree p + degree q) = coeff p (degree p) * coeff q (degree q)"
     by (rule coeff_mult_degree_sum)
   also from \<open>p \<noteq> 0\<close> \<open>q \<noteq> 0\<close> have "coeff p (degree p) * coeff q (degree q) \<noteq> 0"
     by simp
   finally have "\<exists>n. coeff (p * q) n \<noteq> 0" ..
   then show "p * q \<noteq> 0"
     by (simp add: poly_eq_iff)
 qed
 
 instance poly :: (comm_semiring_0_cancel) comm_semiring_0_cancel ..
 
 lemma coeff_mult: "coeff (p * q) n = (\<Sum>i\<le>n. coeff p i * coeff q (n-i))"
 proof (induct p arbitrary: n)
   case 0
   show ?case by simp
 next
   case (pCons a p n)
   then show ?case
     by (cases n) (simp_all add: sum.atMost_Suc_shift del: sum.atMost_Suc)
 qed
 
 lemma degree_mult_le: "degree (p * q) \<le> degree p + degree q"
 proof (rule degree_le)
   show "\<forall>i>degree p + degree q. coeff (p * q) i = 0"
     by (induct p) (simp_all add: coeff_eq_0 coeff_pCons split: nat.split)
 qed
 
 lemma mult_monom: "monom a m * monom b n = monom (a * b) (m + n)"
   by (induct m) (simp add: monom_0 smult_monom, simp add: monom_Suc)
 
 instantiation poly :: (comm_semiring_1) comm_semiring_1
 begin
 
 lift_definition one_poly :: "'a poly"
   is "\<lambda>n. of_bool (n = 0)"
   by (rule MOST_SucD) simp
 
 lemma coeff_1 [simp]:
   "coeff 1 n = of_bool (n = 0)"
   by (simp add: one_poly.rep_eq)
 
 lemma one_pCons:
   "1 = [:1:]"
   by (simp add: poly_eq_iff coeff_pCons split: nat.splits)
 
 lemma pCons_one:
   "[:1:] = 1"
   by (simp add: one_pCons)
 
 instance
   by standard (simp_all add: one_pCons)
 
 end
 
 lemma poly_1 [simp]:
   "poly 1 x = 1"
   by (simp add: one_pCons)
 
 lemma one_poly_eq_simps [simp]:
   "1 = [:1:] \<longleftrightarrow> True"
   "[:1:] = 1 \<longleftrightarrow> True"
   by (simp_all add: one_pCons)
 
 lemma degree_1 [simp]:
   "degree 1 = 0"
   by (simp add: one_pCons)
 
 lemma coeffs_1_eq [simp, code abstract]:
   "coeffs 1 = [1]"
   by (simp add: one_pCons)
 
 lemma smult_one [simp]:
   "smult c 1 = [:c:]"
   by (simp add: one_pCons)
 
 lemma monom_eq_1 [simp]:
   "monom 1 0 = 1"
   by (simp add: monom_0 one_pCons)
 
 lemma monom_eq_1_iff:
   "monom c n = 1 \<longleftrightarrow> c = 1 \<and> n = 0"
   using monom_eq_const_iff [of c n 1] by auto
 
 lemma monom_altdef:
   "monom c n = smult c ([:0, 1:] ^ n)"
   by (induct n) (simp_all add: monom_0 monom_Suc)
 
 instance poly :: ("{comm_semiring_1,semiring_1_no_zero_divisors}") semiring_1_no_zero_divisors ..
 instance poly :: (comm_ring) comm_ring ..
 instance poly :: (comm_ring_1) comm_ring_1 ..
 instance poly :: (comm_ring_1) comm_semiring_1_cancel ..
 
 lemma degree_power_le: "degree (p ^ n) \<le> degree p * n"
   by (induct n) (auto intro: order_trans degree_mult_le)
 
 lemma coeff_0_power: "coeff (p ^ n) 0 = coeff p 0 ^ n"
   by (induct n) (simp_all add: coeff_mult)
 
 lemma poly_smult [simp]: "poly (smult a p) x = a * poly p x"
   by (induct p) (simp_all add: algebra_simps)
 
 lemma poly_mult [simp]: "poly (p * q) x = poly p x * poly q x"
   by (induct p) (simp_all add: algebra_simps)
 
 lemma poly_power [simp]: "poly (p ^ n) x = poly p x ^ n"
   for p :: "'a::comm_semiring_1 poly"
   by (induct n) simp_all
 
 lemma poly_prod: "poly (\<Prod>k\<in>A. p k) x = (\<Prod>k\<in>A. poly (p k) x)"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma degree_prod_sum_le: "finite S \<Longrightarrow> degree (prod f S) \<le> sum (degree \<circ> f) S"
 proof (induct S rule: finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert a S)
   show ?case
     unfolding prod.insert[OF insert(1-2)] sum.insert[OF insert(1-2)]
     by (rule le_trans[OF degree_mult_le]) (use insert in auto)
 qed
 
 lemma coeff_0_prod_list: "coeff (prod_list xs) 0 = prod_list (map (\<lambda>p. coeff p 0) xs)"
   by (induct xs) (simp_all add: coeff_mult)
 
 lemma coeff_monom_mult: "coeff (monom c n * p) k = (if k < n then 0 else c * coeff p (k - n))"
 proof -
   have "coeff (monom c n * p) k = (\<Sum>i\<le>k. (if n = i then c else 0) * coeff p (k - i))"
     by (simp add: coeff_mult)
   also have "\<dots> = (\<Sum>i\<le>k. (if n = i then c * coeff p (k - i) else 0))"
     by (intro sum.cong) simp_all
   also have "\<dots> = (if k < n then 0 else c * coeff p (k - n))"
     by simp
   finally show ?thesis .
 qed
 
 lemma monom_1_dvd_iff': "monom 1 n dvd p \<longleftrightarrow> (\<forall>k<n. coeff p k = 0)"
 proof
   assume "monom 1 n dvd p"
   then obtain r where "p = monom 1 n * r"
     by (rule dvdE)
   then show "\<forall>k<n. coeff p k = 0"
     by (simp add: coeff_mult)
 next
   assume zero: "(\<forall>k<n. coeff p k = 0)"
   define r where "r = Abs_poly (\<lambda>k. coeff p (k + n))"
   have "\<forall>\<^sub>\<infinity>k. coeff p (k + n) = 0"
     by (subst cofinite_eq_sequentially, subst eventually_sequentially_seg,
         subst cofinite_eq_sequentially [symmetric]) transfer
   then have coeff_r [simp]: "coeff r k = coeff p (k + n)" for k
     unfolding r_def by (subst poly.Abs_poly_inverse) simp_all
   have "p = monom 1 n * r"
     by (rule poly_eqI, subst coeff_monom_mult) (simp_all add: zero)
   then show "monom 1 n dvd p" by simp
 qed
 
 
 subsection \<open>Mapping polynomials\<close>
 
 definition map_poly :: "('a :: zero \<Rightarrow> 'b :: zero) \<Rightarrow> 'a poly \<Rightarrow> 'b poly"
   where "map_poly f p = Poly (map f (coeffs p))"
 
 lemma map_poly_0 [simp]: "map_poly f 0 = 0"
   by (simp add: map_poly_def)
 
 lemma map_poly_1: "map_poly f 1 = [:f 1:]"
   by (simp add: map_poly_def)
 
 lemma map_poly_1' [simp]: "f 1 = 1 \<Longrightarrow> map_poly f 1 = 1"
   by (simp add: map_poly_def one_pCons)
 
 lemma coeff_map_poly:
   assumes "f 0 = 0"
   shows "coeff (map_poly f p) n = f (coeff p n)"
   by (auto simp: assms map_poly_def nth_default_def coeffs_def not_less Suc_le_eq coeff_eq_0
       simp del: upt_Suc)
 
 lemma coeffs_map_poly [code abstract]:
   "coeffs (map_poly f p) = strip_while ((=) 0) (map f (coeffs p))"
   by (simp add: map_poly_def)
 
 lemma coeffs_map_poly':
   assumes "\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
   shows "coeffs (map_poly f p) = map f (coeffs p)"
   using assms
   by (auto simp add: coeffs_map_poly strip_while_idem_iff
     last_coeffs_eq_coeff_degree no_trailing_unfold last_map)
 
 lemma set_coeffs_map_poly:
   "(\<And>x. f x = 0 \<longleftrightarrow> x = 0) \<Longrightarrow> set (coeffs (map_poly f p)) = f ` set (coeffs p)"
   by (simp add: coeffs_map_poly')
 
 lemma degree_map_poly:
   assumes "\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
   shows "degree (map_poly f p) = degree p"
   by (simp add: degree_eq_length_coeffs coeffs_map_poly' assms)
 
 lemma map_poly_eq_0_iff:
   assumes "f 0 = 0" "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
   shows "map_poly f p = 0 \<longleftrightarrow> p = 0"
 proof -
   have "(coeff (map_poly f p) n = 0) = (coeff p n = 0)" for n
   proof -
     have "coeff (map_poly f p) n = f (coeff p n)"
       by (simp add: coeff_map_poly assms)
     also have "\<dots> = 0 \<longleftrightarrow> coeff p n = 0"
     proof (cases "n < length (coeffs p)")
       case True
       then have "coeff p n \<in> set (coeffs p)"
         by (auto simp: coeffs_def simp del: upt_Suc)
       with assms show "f (coeff p n) = 0 \<longleftrightarrow> coeff p n = 0"
         by auto
     next
       case False
       then show ?thesis
         by (auto simp: assms length_coeffs nth_default_coeffs_eq [symmetric] nth_default_def)
     qed
     finally show ?thesis .
   qed
   then show ?thesis by (auto simp: poly_eq_iff)
 qed
 
 lemma map_poly_smult:
   assumes "f 0 = 0""\<And>c x. f (c * x) = f c * f x"
   shows "map_poly f (smult c p) = smult (f c) (map_poly f p)"
   by (intro poly_eqI) (simp_all add: assms coeff_map_poly)
 
 lemma map_poly_pCons:
   assumes "f 0 = 0"
   shows "map_poly f (pCons c p) = pCons (f c) (map_poly f p)"
   by (intro poly_eqI) (simp_all add: assms coeff_map_poly coeff_pCons split: nat.splits)
 
 lemma map_poly_map_poly:
   assumes "f 0 = 0" "g 0 = 0"
   shows "map_poly f (map_poly g p) = map_poly (f \<circ> g) p"
   by (intro poly_eqI) (simp add: coeff_map_poly assms)
 
 lemma map_poly_id [simp]: "map_poly id p = p"
   by (simp add: map_poly_def)
 
 lemma map_poly_id' [simp]: "map_poly (\<lambda>x. x) p = p"
   by (simp add: map_poly_def)
 
 lemma map_poly_cong:
   assumes "(\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = g x)"
   shows "map_poly f p = map_poly g p"
 proof -
   from assms have "map f (coeffs p) = map g (coeffs p)"
     by (intro map_cong) simp_all
   then show ?thesis
     by (simp only: coeffs_eq_iff coeffs_map_poly)
 qed
 
 lemma map_poly_monom: "f 0 = 0 \<Longrightarrow> map_poly f (monom c n) = monom (f c) n"
   by (intro poly_eqI) (simp_all add: coeff_map_poly)
 
 lemma map_poly_idI:
   assumes "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = x"
   shows "map_poly f p = p"
   using map_poly_cong[OF assms, of _ id] by simp
 
 lemma map_poly_idI':
   assumes "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = x"
   shows "p = map_poly f p"
   using map_poly_cong[OF assms, of _ id] by simp
 
 lemma smult_conv_map_poly: "smult c p = map_poly (\<lambda>x. c * x) p"
   by (intro poly_eqI) (simp_all add: coeff_map_poly)
 
 
 subsection \<open>Conversions\<close>
 
 lemma of_nat_poly:
   "of_nat n = [:of_nat n:]"
   by (induct n) (simp_all add: one_pCons)
 
 lemma of_nat_monom:
   "of_nat n = monom (of_nat n) 0"
   by (simp add: of_nat_poly monom_0)
 
 lemma degree_of_nat [simp]:
   "degree (of_nat n) = 0"
   by (simp add: of_nat_poly)
 
 lemma lead_coeff_of_nat [simp]:
   "lead_coeff (of_nat n) = of_nat n"
   by (simp add: of_nat_poly)
 
 lemma of_int_poly:
   "of_int k = [:of_int k:]"
   by (simp only: of_int_of_nat of_nat_poly) simp
 
 lemma of_int_monom:
   "of_int k = monom (of_int k) 0"
   by (simp add: of_int_poly monom_0)
 
 lemma degree_of_int [simp]:
   "degree (of_int k) = 0"
   by (simp add: of_int_poly)
 
 lemma lead_coeff_of_int [simp]:
   "lead_coeff (of_int k) = of_int k"
   by (simp add: of_int_poly)
 
 lemma numeral_poly: "numeral n = [:numeral n:]"
 proof -
   have "numeral n = of_nat (numeral n)"
     by simp
   also have "\<dots> = [:of_nat (numeral n):]"
     by (simp add: of_nat_poly)
   finally show ?thesis
     by simp
 qed
 
 lemma numeral_monom:
   "numeral n = monom (numeral n) 0"
   by (simp add: numeral_poly monom_0)
 
 lemma degree_numeral [simp]:
   "degree (numeral n) = 0"
   by (simp add: numeral_poly)
 
 lemma lead_coeff_numeral [simp]:
   "lead_coeff (numeral n) = numeral n"
   by (simp add: numeral_poly)
 
 
 subsection \<open>Lemmas about divisibility\<close>
 
 lemma dvd_smult:
   assumes "p dvd q"
   shows "p dvd smult a q"
 proof -
   from assms obtain k where "q = p * k" ..
   then have "smult a q = p * smult a k" by simp
   then show "p dvd smult a q" ..
 qed
 
 lemma dvd_smult_cancel: "p dvd smult a q \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> p dvd q"
   for a :: "'a::field"
   by (drule dvd_smult [where a="inverse a"]) simp
 
 lemma dvd_smult_iff: "a \<noteq> 0 \<Longrightarrow> p dvd smult a q \<longleftrightarrow> p dvd q"
   for a :: "'a::field"
   by (safe elim!: dvd_smult dvd_smult_cancel)
 
 lemma smult_dvd_cancel:
   assumes "smult a p dvd q"
   shows "p dvd q"
 proof -
   from assms obtain k where "q = smult a p * k" ..
   then have "q = p * smult a k" by simp
   then show "p dvd q" ..
 qed
 
 lemma smult_dvd: "p dvd q \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> smult a p dvd q"
   for a :: "'a::field"
   by (rule smult_dvd_cancel [where a="inverse a"]) simp
 
 lemma smult_dvd_iff: "smult a p dvd q \<longleftrightarrow> (if a = 0 then q = 0 else p dvd q)"
   for a :: "'a::field"
   by (auto elim: smult_dvd smult_dvd_cancel)
 
 lemma is_unit_smult_iff: "smult c p dvd 1 \<longleftrightarrow> c dvd 1 \<and> p dvd 1"
 proof -
   have "smult c p = [:c:] * p" by simp
   also have "\<dots> dvd 1 \<longleftrightarrow> c dvd 1 \<and> p dvd 1"
   proof safe
     assume *: "[:c:] * p dvd 1"
     then show "p dvd 1"
       by (rule dvd_mult_right)
     from * obtain q where q: "1 = [:c:] * p * q"
       by (rule dvdE)
     have "c dvd c * (coeff p 0 * coeff q 0)"
       by simp
     also have "\<dots> = coeff ([:c:] * p * q) 0"
       by (simp add: mult.assoc coeff_mult)
     also note q [symmetric]
     finally have "c dvd coeff 1 0" .
     then show "c dvd 1" by simp
   next
     assume "c dvd 1" "p dvd 1"
     from this(1) obtain d where "1 = c * d"
       by (rule dvdE)
     then have "1 = [:c:] * [:d:]"
       by (simp add: one_pCons ac_simps)
     then have "[:c:] dvd 1"
       by (rule dvdI)
     from mult_dvd_mono[OF this \<open>p dvd 1\<close>] show "[:c:] * p dvd 1"
       by simp
   qed
   finally show ?thesis .
 qed
 
 
 subsection \<open>Polynomials form an integral domain\<close>
 
 instance poly :: (idom) idom ..
 
 instance poly :: ("{ring_char_0, comm_ring_1}") ring_char_0
   by standard (auto simp add: of_nat_poly intro: injI)
 
 lemma degree_mult_eq: "p \<noteq> 0 \<Longrightarrow> q \<noteq> 0 \<Longrightarrow> degree (p * q) = degree p + degree q"
   for p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   by (rule order_antisym [OF degree_mult_le le_degree]) (simp add: coeff_mult_degree_sum)
 
 lemma degree_prod_eq_sum_degree:
   fixes A :: "'a set"
   and f :: "'a \<Rightarrow> 'b::idom poly"
   assumes f0: "\<forall>i\<in>A. f i \<noteq> 0"
   shows "degree (\<Prod>i\<in>A. (f i)) = (\<Sum>i\<in>A. degree (f i))"
   using assms
   by (induction A rule: infinite_finite_induct) (auto simp: degree_mult_eq)
 
 lemma degree_mult_eq_0:
   "degree (p * q) = 0 \<longleftrightarrow> p = 0 \<or> q = 0 \<or> (p \<noteq> 0 \<and> q \<noteq> 0 \<and> degree p = 0 \<and> degree q = 0)"
   for p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   by (auto simp: degree_mult_eq)
 
 lemma degree_power_eq: "p \<noteq> 0 \<Longrightarrow> degree ((p :: 'a :: idom poly) ^ n) = n * degree p"
   by (induction n) (simp_all add: degree_mult_eq)
 
 lemma degree_mult_right_le:
   fixes p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   assumes "q \<noteq> 0"
   shows "degree p \<le> degree (p * q)"
   using assms by (cases "p = 0") (simp_all add: degree_mult_eq)
 
 lemma coeff_degree_mult: "coeff (p * q) (degree (p * q)) = coeff q (degree q) * coeff p (degree p)"
   for p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   by (cases "p = 0 \<or> q = 0") (auto simp: degree_mult_eq coeff_mult_degree_sum mult_ac)
 
 lemma dvd_imp_degree_le: "p dvd q \<Longrightarrow> q \<noteq> 0 \<Longrightarrow> degree p \<le> degree q"
   for p q :: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
   by (erule dvdE, hypsubst, subst degree_mult_eq) auto
 
 lemma divides_degree:
   fixes p q :: "'a ::{comm_semiring_1,semiring_no_zero_divisors} poly"
   assumes "p dvd q"
   shows "degree p \<le> degree q \<or> q = 0"
   by (metis dvd_imp_degree_le assms)
 
 lemma const_poly_dvd_iff:
   fixes c :: "'a::{comm_semiring_1,semiring_no_zero_divisors}"
   shows "[:c:] dvd p \<longleftrightarrow> (\<forall>n. c dvd coeff p n)"
 proof (cases "c = 0 \<or> p = 0")
   case True
   then show ?thesis
     by (auto intro!: poly_eqI)
 next
   case False
   show ?thesis
   proof
     assume "[:c:] dvd p"
     then show "\<forall>n. c dvd coeff p n"
       by (auto elim!: dvdE simp: coeffs_def)
   next
     assume *: "\<forall>n. c dvd coeff p n"
     define mydiv where "mydiv x y = (SOME z. x = y * z)" for x y :: 'a
     have mydiv: "x = y * mydiv x y" if "y dvd x" for x y
       using that unfolding mydiv_def dvd_def by (rule someI_ex)
     define q where "q = Poly (map (\<lambda>a. mydiv a c) (coeffs p))"
     from False * have "p = q * [:c:]"
       by (intro poly_eqI)
         (auto simp: q_def nth_default_def not_less length_coeffs_degree coeffs_nth
           intro!: coeff_eq_0 mydiv)
     then show "[:c:] dvd p"
       by (simp only: dvd_triv_right)
   qed
 qed
 
 lemma const_poly_dvd_const_poly_iff [simp]: "[:a:] dvd [:b:] \<longleftrightarrow> a dvd b"
   for a b :: "'a::{comm_semiring_1,semiring_no_zero_divisors}"
   by (subst const_poly_dvd_iff) (auto simp: coeff_pCons split: nat.splits)
 
 lemma lead_coeff_mult: "lead_coeff (p * q) = lead_coeff p * lead_coeff q"
   for p q :: "'a::{comm_semiring_0, semiring_no_zero_divisors} poly"
   by (cases "p = 0 \<or> q = 0") (auto simp: coeff_mult_degree_sum degree_mult_eq)
 
 lemma lead_coeff_prod: "lead_coeff (prod f A) = (\<Prod>x\<in>A. lead_coeff (f x))"
   for f :: "'a \<Rightarrow> 'b::{comm_semiring_1, semiring_no_zero_divisors} poly"
   by (induction A rule: infinite_finite_induct) (auto simp: lead_coeff_mult)
 
 lemma lead_coeff_smult: "lead_coeff (smult c p) = c * lead_coeff p"
   for p :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
 proof -
   have "smult c p = [:c:] * p" by simp
   also have "lead_coeff \<dots> = c * lead_coeff p"
     by (subst lead_coeff_mult) simp_all
   finally show ?thesis .
 qed
 
 lemma lead_coeff_1 [simp]: "lead_coeff 1 = 1"
   by simp
 
 lemma lead_coeff_power: "lead_coeff (p ^ n) = lead_coeff p ^ n"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
   by (induct n) (simp_all add: lead_coeff_mult)
 
 
 subsection \<open>Polynomials form an ordered integral domain\<close>
 
 definition pos_poly :: "'a::linordered_semidom poly \<Rightarrow> bool"
   where "pos_poly p \<longleftrightarrow> 0 < coeff p (degree p)"
 
 lemma pos_poly_pCons: "pos_poly (pCons a p) \<longleftrightarrow> pos_poly p \<or> (p = 0 \<and> 0 < a)"
   by (simp add: pos_poly_def)
 
 lemma not_pos_poly_0 [simp]: "\<not> pos_poly 0"
   by (simp add: pos_poly_def)
 
 lemma pos_poly_add: "pos_poly p \<Longrightarrow> pos_poly q \<Longrightarrow> pos_poly (p + q)"
 proof (induction p arbitrary: q)
   case (pCons a p)
   then show ?case
     by (cases q; force simp add: pos_poly_pCons add_pos_pos)
 qed auto
 
 lemma pos_poly_mult: "pos_poly p \<Longrightarrow> pos_poly q \<Longrightarrow> pos_poly (p * q)"
   by (simp add: pos_poly_def coeff_degree_mult)
 
 lemma pos_poly_total: "p = 0 \<or> pos_poly p \<or> pos_poly (- p)"
   for p :: "'a::linordered_idom poly"
   by (induct p) (auto simp: pos_poly_pCons)
 
 lemma pos_poly_coeffs [code]: "pos_poly p \<longleftrightarrow> (let as = coeffs p in as \<noteq> [] \<and> last as > 0)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs
     by (auto simp add: pos_poly_def last_coeffs_eq_coeff_degree)
 next
   assume ?lhs
   then have *: "0 < coeff p (degree p)"
     by (simp add: pos_poly_def)
   then have "p \<noteq> 0"
     by auto
   with * show ?rhs
     by (simp add: last_coeffs_eq_coeff_degree)
 qed
 
 instantiation poly :: (linordered_idom) linordered_idom
 begin
 
 definition "x < y \<longleftrightarrow> pos_poly (y - x)"
 
 definition "x \<le> y \<longleftrightarrow> x = y \<or> pos_poly (y - x)"
 
 definition "\<bar>x::'a poly\<bar> = (if x < 0 then - x else x)"
 
 definition "sgn (x::'a poly) = (if x = 0 then 0 else if 0 < x then 1 else - 1)"
 
 instance
 proof
   fix x y z :: "'a poly"
   show "x < y \<longleftrightarrow> x \<le> y \<and> \<not> y \<le> x"
     unfolding less_eq_poly_def less_poly_def
     using pos_poly_add by force
   then show "x \<le> y \<Longrightarrow> y \<le> x \<Longrightarrow> x = y"
     using less_eq_poly_def less_poly_def by force
   show "x \<le> x"
     by (simp add: less_eq_poly_def)
   show "x \<le> y \<Longrightarrow> y \<le> z \<Longrightarrow> x \<le> z"
     using less_eq_poly_def pos_poly_add by fastforce
   show "x \<le> y \<Longrightarrow> z + x \<le> z + y"
     by (simp add: less_eq_poly_def)
   show "x \<le> y \<or> y \<le> x"
     unfolding less_eq_poly_def
     using pos_poly_total [of "x - y"]
     by auto
   show "x < y \<Longrightarrow> 0 < z \<Longrightarrow> z * x < z * y"
     by (simp add: less_poly_def right_diff_distrib [symmetric] pos_poly_mult)
   show "\<bar>x\<bar> = (if x < 0 then - x else x)"
     by (rule abs_poly_def)
   show "sgn x = (if x = 0 then 0 else if 0 < x then 1 else - 1)"
     by (rule sgn_poly_def)
 qed
 
 end
 
 text \<open>TODO: Simplification rules for comparisons\<close>
 
 
 subsection \<open>Synthetic division and polynomial roots\<close>
 
 subsubsection \<open>Synthetic division\<close>
 
 text \<open>Synthetic division is simply division by the linear polynomial \<^term>\<open>x - c\<close>.\<close>
 
 definition synthetic_divmod :: "'a::comm_semiring_0 poly \<Rightarrow> 'a \<Rightarrow> 'a poly \<times> 'a"
   where "synthetic_divmod p c = fold_coeffs (\<lambda>a (q, r). (pCons r q, a + c * r)) p (0, 0)"
 
 definition synthetic_div :: "'a::comm_semiring_0 poly \<Rightarrow> 'a \<Rightarrow> 'a poly"
   where "synthetic_div p c = fst (synthetic_divmod p c)"
 
 lemma synthetic_divmod_0 [simp]: "synthetic_divmod 0 c = (0, 0)"
   by (simp add: synthetic_divmod_def)
 
 lemma synthetic_divmod_pCons [simp]:
   "synthetic_divmod (pCons a p) c = (\<lambda>(q, r). (pCons r q, a + c * r)) (synthetic_divmod p c)"
   by (cases "p = 0 \<and> a = 0") (auto simp add: synthetic_divmod_def)
 
 lemma synthetic_div_0 [simp]: "synthetic_div 0 c = 0"
   by (simp add: synthetic_div_def)
 
 lemma synthetic_div_unique_lemma: "smult c p = pCons a p \<Longrightarrow> p = 0"
   by (induct p arbitrary: a) simp_all
 
 lemma snd_synthetic_divmod: "snd (synthetic_divmod p c) = poly p c"
   by (induct p) (simp_all add: split_def)
 
 lemma synthetic_div_pCons [simp]:
   "synthetic_div (pCons a p) c = pCons (poly p c) (synthetic_div p c)"
   by (simp add: synthetic_div_def split_def snd_synthetic_divmod)
 
 lemma synthetic_div_eq_0_iff: "synthetic_div p c = 0 \<longleftrightarrow> degree p = 0"
 proof (induct p)
   case 0
   then show ?case by simp
 next
   case (pCons a p)
   then show ?case by (cases p) simp
 qed
 
 lemma degree_synthetic_div: "degree (synthetic_div p c) = degree p - 1"
   by (induct p) (simp_all add: synthetic_div_eq_0_iff)
 
 lemma synthetic_div_correct:
   "p + smult c (synthetic_div p c) = pCons (poly p c) (synthetic_div p c)"
   by (induct p) simp_all
 
 lemma synthetic_div_unique: "p + smult c q = pCons r q \<Longrightarrow> r = poly p c \<and> q = synthetic_div p c"
 proof (induction p arbitrary: q r)
   case 0
   then show ?case
     using synthetic_div_unique_lemma by fastforce
 next
   case (pCons a p)
   then show ?case
     by (cases q; force)
 qed
 
 lemma synthetic_div_correct': "[:-c, 1:] * synthetic_div p c + [:poly p c:] = p"
   for c :: "'a::comm_ring_1"
   using synthetic_div_correct [of p c] by (simp add: algebra_simps)
 
 
 subsubsection \<open>Polynomial roots\<close>
 
 lemma poly_eq_0_iff_dvd: "poly p c = 0 \<longleftrightarrow> [:- c, 1:] dvd p"
   (is "?lhs \<longleftrightarrow> ?rhs")
   for c :: "'a::comm_ring_1"
 proof
   assume ?lhs
   with synthetic_div_correct' [of c p] have "p = [:-c, 1:] * synthetic_div p c" by simp
   then show ?rhs ..
 next
   assume ?rhs
   then obtain k where "p = [:-c, 1:] * k" by (rule dvdE)
   then show ?lhs by simp
 qed
 
 lemma dvd_iff_poly_eq_0: "[:c, 1:] dvd p \<longleftrightarrow> poly p (- c) = 0"
   for c :: "'a::comm_ring_1"
   by (simp add: poly_eq_0_iff_dvd)
 
 lemma poly_roots_finite: "p \<noteq> 0 \<Longrightarrow> finite {x. poly p x = 0}"
   for p :: "'a::{comm_ring_1,ring_no_zero_divisors} poly"
 proof (induct n \<equiv> "degree p" arbitrary: p)
   case 0
   then obtain a where "a \<noteq> 0" and "p = [:a:]"
     by (cases p) (simp split: if_splits)
   then show "finite {x. poly p x = 0}"
     by simp
 next
   case (Suc n)
   show "finite {x. poly p x = 0}"
   proof (cases "\<exists>x. poly p x = 0")
     case False
     then show "finite {x. poly p x = 0}" by simp
   next
     case True
     then obtain a where "poly p a = 0" ..
     then have "[:-a, 1:] dvd p"
       by (simp only: poly_eq_0_iff_dvd)
     then obtain k where k: "p = [:-a, 1:] * k" ..
     with \<open>p \<noteq> 0\<close> have "k \<noteq> 0"
       by auto
     with k have "degree p = Suc (degree k)"
       by (simp add: degree_mult_eq del: mult_pCons_left)
     with \<open>Suc n = degree p\<close> have "n = degree k"
       by simp
     from this \<open>k \<noteq> 0\<close> have "finite {x. poly k x = 0}"
       by (rule Suc.hyps)
     then have "finite (insert a {x. poly k x = 0})"
       by simp
     then show "finite {x. poly p x = 0}"
       by (simp add: k Collect_disj_eq del: mult_pCons_left)
   qed
 qed
 
 lemma poly_eq_poly_eq_iff: "poly p = poly q \<longleftrightarrow> p = q"
   (is "?lhs \<longleftrightarrow> ?rhs")
   for p q :: "'a::{comm_ring_1,ring_no_zero_divisors,ring_char_0} poly"
 proof
   assume ?rhs
   then show ?lhs by simp
 next
   assume ?lhs
   have "poly p = poly 0 \<longleftrightarrow> p = 0" for p :: "'a poly"
   proof (cases "p = 0")
     case False
     then show ?thesis
       by (auto simp add: infinite_UNIV_char_0 dest: poly_roots_finite)
   qed auto
   from \<open>?lhs\<close> and this [of "p - q"] show ?rhs
     by auto
 qed
 
 lemma poly_all_0_iff_0: "(\<forall>x. poly p x = 0) \<longleftrightarrow> p = 0"
   for p :: "'a::{ring_char_0,comm_ring_1,ring_no_zero_divisors} poly"
   by (auto simp add: poly_eq_poly_eq_iff [symmetric])
 
 
 subsubsection \<open>Order of polynomial roots\<close>
 
 definition order :: "'a::idom \<Rightarrow> 'a poly \<Rightarrow> nat"
   where "order a p = (LEAST n. \<not> [:-a, 1:] ^ Suc n dvd p)"
 
 lemma coeff_linear_power: "coeff ([:a, 1:] ^ n) n = 1"
   for a :: "'a::comm_semiring_1"
 proof (induct n)
   case (Suc n)
   have "degree ([:a, 1:] ^ n) \<le> 1 * n"
     by (metis One_nat_def degree_pCons_eq_if degree_power_le one_neq_zero one_pCons)
   then have "coeff ([:a, 1:] ^ n) (Suc n) = 0"
     by (simp add: coeff_eq_0)
   then show ?case
     using Suc.hyps by fastforce
 qed auto
 
 lemma degree_linear_power: "degree ([:a, 1:] ^ n) = n"
   for a :: "'a::comm_semiring_1"
 proof (rule order_antisym)
   show "degree ([:a, 1:] ^ n) \<le> n"
     by (metis One_nat_def degree_pCons_eq_if degree_power_le mult.left_neutral one_neq_zero one_pCons)
 qed (simp add: coeff_linear_power le_degree)
 
 lemma order_1: "[:-a, 1:] ^ order a p dvd p"
 proof (cases "p = 0")
   case False
   show ?thesis
   proof (cases "order a p")
     case (Suc n)
     then show ?thesis
       by (metis lessI not_less_Least order_def)
   qed auto
 qed auto
 
 lemma order_2:
   assumes "p \<noteq> 0"
   shows "\<not> [:-a, 1:] ^ Suc (order a p) dvd p"
 proof -
   have False if "[:- a, 1:] ^ Suc (degree p) dvd p"
     using dvd_imp_degree_le [OF that]
     by (metis Suc_n_not_le_n assms degree_linear_power)
   then show ?thesis
     unfolding order_def
     by (metis (no_types, lifting) LeastI)
 qed
 
 lemma order: "p \<noteq> 0 \<Longrightarrow> [:-a, 1:] ^ order a p dvd p \<and> \<not> [:-a, 1:] ^ Suc (order a p) dvd p"
   by (rule conjI [OF order_1 order_2])
 
 lemma order_degree:
   assumes p: "p \<noteq> 0"
   shows "order a p \<le> degree p"
 proof -
   have "order a p = degree ([:-a, 1:] ^ order a p)"
     by (simp only: degree_linear_power)
   also from order_1 p have "\<dots> \<le> degree p"
     by (rule dvd_imp_degree_le)
   finally show ?thesis .
 qed
 
 lemma order_root: "poly p a = 0 \<longleftrightarrow> p = 0 \<or> order a p \<noteq> 0" (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     by (metis One_nat_def order_2 poly_eq_0_iff_dvd power_one_right)
   show "?rhs \<Longrightarrow> ?lhs"
     by (meson dvd_power dvd_trans neq0_conv order_1 poly_0 poly_eq_0_iff_dvd)
 qed
 
 lemma order_0I: "poly p a \<noteq> 0 \<Longrightarrow> order a p = 0"
   by (subst (asm) order_root) auto
 
 lemma order_unique_lemma:
   fixes p :: "'a::idom poly"
   assumes "[:-a, 1:] ^ n dvd p" "\<not> [:-a, 1:] ^ Suc n dvd p"
   shows "order a p = n"
   unfolding Polynomial.order_def
   by (metis (mono_tags, lifting) Least_equality assms not_less_eq_eq power_le_dvd)
 
 lemma order_mult:
   assumes "p * q \<noteq> 0" shows "order a (p * q) = order a p + order a q"
 proof -
   define i where "i \<equiv> order a p"
   define j where "j \<equiv> order a q"
   define t where "t \<equiv> [:-a, 1:]"
   have t_dvd_iff: "\<And>u. t dvd u \<longleftrightarrow> poly u a = 0"
     by (simp add: t_def dvd_iff_poly_eq_0)
   have dvd: "t ^ i dvd p" "t ^ j dvd q" and "\<not> t ^ Suc i dvd p" "\<not> t ^ Suc j dvd q"
     using assms i_def j_def order_1 order_2 t_def by auto
   then have "\<not> t ^ Suc(i + j) dvd p * q"
     by (elim dvdE) (simp add: power_add t_dvd_iff)
   moreover have "t ^ (i + j) dvd p * q"
     using dvd by (simp add: mult_dvd_mono power_add)
   ultimately show "order a (p * q) = i + j"
     using order_unique_lemma t_def by blast
 qed
 
 
 lemma order_smult:
   assumes "c \<noteq> 0"
   shows "order x (smult c p) = order x p"
 proof (cases "p = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   have "smult c p = [:c:] * p" by simp
   also from assms False have "order x \<dots> = order x [:c:] + order x p"
     by (subst order_mult) simp_all
   also have "order x [:c:] = 0"
     by (rule order_0I) (use assms in auto)
   finally show ?thesis
     by simp
 qed
 
 text \<open>Next three lemmas contributed by Wenda Li\<close>
 lemma order_1_eq_0 [simp]:"order x 1 = 0"
   by (metis order_root poly_1 zero_neq_one)
 
 lemma order_uminus[simp]: "order x (-p) = order x p"
   by (metis neg_equal_0_iff_equal order_smult smult_1_left smult_minus_left)
 
 lemma order_power_n_n: "order a ([:-a,1:]^n)=n"
 proof (induct n) (*might be proved more concisely using nat_less_induct*)
   case 0
   then show ?case
     by (metis order_root poly_1 power_0 zero_neq_one)
 next
   case (Suc n)
   have "order a ([:- a, 1:] ^ Suc n) = order a ([:- a, 1:] ^ n) + order a [:-a,1:]"
     by (metis (no_types, opaque_lifting) One_nat_def add_Suc_right monoid_add_class.add.right_neutral
       one_neq_zero order_mult pCons_eq_0_iff power_add power_eq_0_iff power_one_right)
   moreover have "order a [:-a,1:] = 1"
     unfolding order_def
   proof (rule Least_equality, rule notI)
     assume "[:- a, 1:] ^ Suc 1 dvd [:- a, 1:]"
     then have "degree ([:- a, 1:] ^ Suc 1) \<le> degree ([:- a, 1:])"
       by (rule dvd_imp_degree_le) auto
     then show False
       by auto
   next
     fix y
     assume *: "\<not> [:- a, 1:] ^ Suc y dvd [:- a, 1:]"
     show "1 \<le> y"
     proof (rule ccontr)
       assume "\<not> 1 \<le> y"
       then have "y = 0" by auto
       then have "[:- a, 1:] ^ Suc y dvd [:- a, 1:]" by auto
       with * show False by auto
     qed
   qed
   ultimately show ?case
     using Suc by auto
 qed
 
 lemma order_0_monom [simp]: "c \<noteq> 0 \<Longrightarrow> order 0 (monom c n) = n"
   using order_power_n_n[of 0 n] by (simp add: monom_altdef order_smult)
 
 lemma dvd_imp_order_le: "q \<noteq> 0 \<Longrightarrow> p dvd q \<Longrightarrow> Polynomial.order a p \<le> Polynomial.order a q"
   by (auto simp: order_mult elim: dvdE)
 
 text \<open>Now justify the standard squarefree decomposition, i.e. \<open>f / gcd f f'\<close>.\<close>
 
 lemma order_divides: "[:-a, 1:] ^ n dvd p \<longleftrightarrow> p = 0 \<or> n \<le> order a p"
   by (meson dvd_0_right not_less_eq_eq order_1 order_2 power_le_dvd)
 
 lemma order_decomp:
   assumes "p \<noteq> 0"
   shows "\<exists>q. p = [:- a, 1:] ^ order a p * q \<and> \<not> [:- a, 1:] dvd q"
 proof -
   from assms have *: "[:- a, 1:] ^ order a p dvd p"
     and **: "\<not> [:- a, 1:] ^ Suc (order a p) dvd p"
     by (auto dest: order)
   from * obtain q where q: "p = [:- a, 1:] ^ order a p * q" ..
   with ** have "\<not> [:- a, 1:] ^ Suc (order a p) dvd [:- a, 1:] ^ order a p * q"
     by simp
   then have "\<not> [:- a, 1:] ^ order a p * [:- a, 1:] dvd [:- a, 1:] ^ order a p * q"
     by simp
   with idom_class.dvd_mult_cancel_left [of "[:- a, 1:] ^ order a p" "[:- a, 1:]" q]
   have "\<not> [:- a, 1:] dvd q" by auto
   with q show ?thesis by blast
 qed
 
 lemma monom_1_dvd_iff: "p \<noteq> 0 \<Longrightarrow> monom 1 n dvd p \<longleftrightarrow> n \<le> order 0 p"
   using order_divides[of 0 n p] by (simp add: monom_altdef)
 
 
 subsection \<open>Additional induction rules on polynomials\<close>
 
 text \<open>
   An induction rule for induction over the roots of a polynomial with a certain property.
   (e.g. all positive roots)
 \<close>
 lemma poly_root_induct [case_names 0 no_roots root]:
   fixes p :: "'a :: idom poly"
   assumes "Q 0"
     and "\<And>p. (\<And>a. P a \<Longrightarrow> poly p a \<noteq> 0) \<Longrightarrow> Q p"
     and "\<And>a p. P a \<Longrightarrow> Q p \<Longrightarrow> Q ([:a, -1:] * p)"
   shows "Q p"
 proof (induction "degree p" arbitrary: p rule: less_induct)
   case (less p)
   show ?case
   proof (cases "p = 0")
     case True
     with assms(1) show ?thesis by simp
   next
     case False
     show ?thesis
     proof (cases "\<exists>a. P a \<and> poly p a = 0")
       case False
       then show ?thesis by (intro assms(2)) blast
     next
       case True
       then obtain a where a: "P a" "poly p a = 0"
         by blast
       then have "-[:-a, 1:] dvd p"
         by (subst minus_dvd_iff) (simp add: poly_eq_0_iff_dvd)
       then obtain q where q: "p = [:a, -1:] * q" by (elim dvdE) simp
       with False have "q \<noteq> 0" by auto
       have "degree p = Suc (degree q)"
         by (subst q, subst degree_mult_eq) (simp_all add: \<open>q \<noteq> 0\<close>)
       then have "Q q" by (intro less) simp
       with a(1) have "Q ([:a, -1:] * q)"
         by (rule assms(3))
       with q show ?thesis by simp
     qed
   qed
 qed
 
 lemma dropWhile_replicate_append:
   "dropWhile ((=) a) (replicate n a @ ys) = dropWhile ((=) a) ys"
   by (induct n) simp_all
 
 lemma Poly_append_replicate_0: "Poly (xs @ replicate n 0) = Poly xs"
   by (subst coeffs_eq_iff) (simp_all add: strip_while_def dropWhile_replicate_append)
 
 text \<open>
   An induction rule for simultaneous induction over two polynomials,
   prepending one coefficient in each step.
 \<close>
 lemma poly_induct2 [case_names 0 pCons]:
   assumes "P 0 0" "\<And>a p b q. P p q \<Longrightarrow> P (pCons a p) (pCons b q)"
   shows "P p q"
 proof -
   define n where "n = max (length (coeffs p)) (length (coeffs q))"
   define xs where "xs = coeffs p @ (replicate (n - length (coeffs p)) 0)"
   define ys where "ys = coeffs q @ (replicate (n - length (coeffs q)) 0)"
   have "length xs = length ys"
     by (simp add: xs_def ys_def n_def)
   then have "P (Poly xs) (Poly ys)"
     by (induct rule: list_induct2) (simp_all add: assms)
   also have "Poly xs = p"
     by (simp add: xs_def Poly_append_replicate_0)
   also have "Poly ys = q"
     by (simp add: ys_def Poly_append_replicate_0)
   finally show ?thesis .
 qed
 
 
 subsection \<open>Composition of polynomials\<close>
 
 (* Several lemmas contributed by René Thiemann and Akihisa Yamada *)
 
 definition pcompose :: "'a::comm_semiring_0 poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "pcompose p q = fold_coeffs (\<lambda>a c. [:a:] + q * c) p 0"
 
 notation pcompose (infixl "\<circ>\<^sub>p" 71)
 
 lemma pcompose_0 [simp]: "pcompose 0 q = 0"
   by (simp add: pcompose_def)
 
 lemma pcompose_pCons: "pcompose (pCons a p) q = [:a:] + q * pcompose p q"
   by (cases "p = 0 \<and> a = 0") (auto simp add: pcompose_def)
 
 lemma pcompose_1: "pcompose 1 p = 1"
   for p :: "'a::comm_semiring_1 poly"
   by (auto simp: one_pCons pcompose_pCons)
 
 lemma poly_pcompose: "poly (pcompose p q) x = poly p (poly q x)"
   by (induct p) (simp_all add: pcompose_pCons)
 
 lemma degree_pcompose_le: "degree (pcompose p q) \<le> degree p * degree q"
 proof (induction p)
   case (pCons a p)
   then show ?case
   proof (clarsimp simp add: pcompose_pCons)
     assume "degree (p \<circ>\<^sub>p q) \<le> degree p * degree q" "p \<noteq> 0"
     then have "degree (q * p \<circ>\<^sub>p q) \<le> degree q + degree p * degree q"
       by (meson add_le_cancel_left degree_mult_le dual_order.trans pCons.IH)
     then show "degree ([:a:] + q * p \<circ>\<^sub>p q) \<le> degree q + degree p * degree q"
       by (simp add: degree_add_le)
   qed
 qed auto
 
 lemma pcompose_add: "pcompose (p + q) r = pcompose p r + pcompose q r"
   for p q r :: "'a::{comm_semiring_0, ab_semigroup_add} poly"
 proof (induction p q rule: poly_induct2)
   case 0
   then show ?case by simp
 next
   case (pCons a p b q)
   have "pcompose (pCons a p + pCons b q) r = [:a + b:] + r * pcompose p r + r * pcompose q r"
     by (simp_all add: pcompose_pCons pCons.IH algebra_simps)
   also have "[:a + b:] = [:a:] + [:b:]" by simp
   also have "\<dots> + r * pcompose p r + r * pcompose q r = pcompose (pCons a p) r + pcompose (pCons b q) r"
     by (simp only: pcompose_pCons add_ac)
   finally show ?case .
 qed
 
 lemma pcompose_uminus: "pcompose (-p) r = -pcompose p r"
   for p r :: "'a::comm_ring poly"
   by (induct p) (simp_all add: pcompose_pCons)
 
 lemma pcompose_diff: "pcompose (p - q) r = pcompose p r - pcompose q r"
   for p q r :: "'a::comm_ring poly"
   using pcompose_add[of p "-q"] by (simp add: pcompose_uminus)
 
 lemma pcompose_smult: "pcompose (smult a p) r = smult a (pcompose p r)"
   for p r :: "'a::comm_semiring_0 poly"
   by (induct p) (simp_all add: pcompose_pCons pcompose_add smult_add_right)
 
 lemma pcompose_mult: "pcompose (p * q) r = pcompose p r * pcompose q r"
   for p q r :: "'a::comm_semiring_0 poly"
   by (induct p arbitrary: q) (simp_all add: pcompose_add pcompose_smult pcompose_pCons algebra_simps)
 
 lemma pcompose_assoc: "pcompose p (pcompose q r) = pcompose (pcompose p q) r"
   for p q r :: "'a::comm_semiring_0 poly"
   by (induct p arbitrary: q) (simp_all add: pcompose_pCons pcompose_add pcompose_mult)
 
 lemma pcompose_idR[simp]: "pcompose p [: 0, 1 :] = p"
   for p :: "'a::comm_semiring_1 poly"
   by (induct p) (simp_all add: pcompose_pCons)
 
 lemma pcompose_sum: "pcompose (sum f A) p = sum (\<lambda>i. pcompose (f i) p) A"
   by (induct A rule: infinite_finite_induct) (simp_all add: pcompose_1 pcompose_add)
 
 lemma pcompose_prod: "pcompose (prod f A) p = prod (\<lambda>i. pcompose (f i) p) A"
   by (induct A rule: infinite_finite_induct) (simp_all add: pcompose_1 pcompose_mult)
 
 lemma pcompose_const [simp]: "pcompose [:a:] q = [:a:]"
   by (subst pcompose_pCons) simp
 
 lemma pcompose_0': "pcompose p 0 = [:coeff p 0:]"
   by (induct p) (auto simp add: pcompose_pCons)
 
 lemma degree_pcompose: "degree (pcompose p q) = degree p * degree q"
   for p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
 proof (induct p)
   case 0
   then show ?case by auto
 next
   case (pCons a p)
   consider "degree (q * pcompose p q) = 0" | "degree (q * pcompose p q) > 0"
     by blast
   then show ?case
   proof cases
     case prems: 1
     show ?thesis
     proof (cases "p = 0")
       case True
       then show ?thesis by auto
     next
       case False
       from prems have "degree q = 0 \<or> pcompose p q = 0"
         by (auto simp add: degree_mult_eq_0)
       moreover have False if "pcompose p q = 0" "degree q \<noteq> 0"
       proof -
         from pCons.hyps(2) that have "degree p = 0"
           by auto
         then obtain a1 where "p = [:a1:]"
           by (metis degree_pCons_eq_if old.nat.distinct(2) pCons_cases)
         with \<open>pcompose p q = 0\<close> \<open>p \<noteq> 0\<close> show False
           by auto
       qed
       ultimately have "degree (pCons a p) * degree q = 0"
         by auto
       moreover have "degree (pcompose (pCons a p) q) = 0"
       proof -
         from prems have "0 = max (degree [:a:]) (degree (q * pcompose p q))"
           by simp
         also have "\<dots> \<ge> degree ([:a:] + q * pcompose p q)"
           by (rule degree_add_le_max)
         finally show ?thesis
           by (auto simp add: pcompose_pCons)
       qed
       ultimately show ?thesis by simp
     qed
   next
     case prems: 2
     then have "p \<noteq> 0" "q \<noteq> 0" "pcompose p q \<noteq> 0"
       by auto
     from prems degree_add_eq_right [of "[:a:]"]
     have "degree (pcompose (pCons a p) q) = degree (q * pcompose p q)"
       by (auto simp: pcompose_pCons)
     with pCons.hyps(2) degree_mult_eq[OF \<open>q\<noteq>0\<close> \<open>pcompose p q\<noteq>0\<close>] show ?thesis
       by auto
   qed
 qed
 
 lemma pcompose_eq_0:
   fixes p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   assumes "pcompose p q = 0" "degree q > 0"
   shows "p = 0"
 proof -
   from assms degree_pcompose [of p q] have "degree p = 0"
     by auto
   then obtain a where "p = [:a:]"
     by (metis degree_pCons_eq_if gr0_conv_Suc neq0_conv pCons_cases)
   with assms(1) have "a = 0"
     by auto
   with \<open>p = [:a:]\<close> show ?thesis
     by simp
 qed
 
 lemma lead_coeff_comp:
   fixes p q :: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
   assumes "degree q > 0"
   shows "lead_coeff (pcompose p q) = lead_coeff p * lead_coeff q ^ (degree p)"
 proof (induct p)
   case 0
   then show ?case by auto
 next
   case (pCons a p)
   consider "degree (q * pcompose p q) = 0" | "degree (q * pcompose p q) > 0"
     by blast
   then show ?case
   proof cases
     case prems: 1
     then have "pcompose p q = 0"
       by (metis assms degree_0 degree_mult_eq_0 neq0_conv)
     with pcompose_eq_0[OF _ \<open>degree q > 0\<close>] have "p = 0"
       by simp
     then show ?thesis
       by auto
   next
     case prems: 2
     then have "degree [:a:] < degree (q * pcompose p q)"
       by simp
     then have "lead_coeff ([:a:] + q * p \<circ>\<^sub>p q) = lead_coeff (q * p \<circ>\<^sub>p q)"
       by (rule lead_coeff_add_le)
     then have "lead_coeff (pcompose (pCons a p) q) = lead_coeff (q * pcompose p q)"
       by (simp add: pcompose_pCons)
     also have "\<dots> = lead_coeff q * (lead_coeff p * lead_coeff q ^ degree p)"
       using pCons.hyps(2) lead_coeff_mult[of q "pcompose p q"] by simp
     also have "\<dots> = lead_coeff p * lead_coeff q ^ (degree p + 1)"
       by (auto simp: mult_ac)
     finally show ?thesis by auto
   qed
 qed
 
 
 subsection \<open>Closure properties of coefficients\<close>
 
 
 context
   fixes R :: "'a :: comm_semiring_1 set"
   assumes R_0: "0 \<in> R"
   assumes R_plus: "\<And>x y. x \<in> R \<Longrightarrow> y \<in> R \<Longrightarrow> x + y \<in> R"
   assumes R_mult: "\<And>x y. x \<in> R \<Longrightarrow> y \<in> R \<Longrightarrow> x * y \<in> R"
 begin
 
 lemma coeff_mult_semiring_closed:
   assumes "\<And>i. coeff p i \<in> R" "\<And>i. coeff q i \<in> R"
   shows   "coeff (p * q) i \<in> R"
 proof -
   have R_sum: "sum f A \<in> R" if "\<And>x. x \<in> A \<Longrightarrow> f x \<in> R" for A and f :: "nat \<Rightarrow> 'a"
     using that by (induction A rule: infinite_finite_induct) (auto intro: R_0 R_plus)
   show ?thesis
     unfolding coeff_mult by (auto intro!: R_sum R_mult assms)
 qed
 
 lemma coeff_pcompose_semiring_closed:
   assumes "\<And>i. coeff p i \<in> R" "\<And>i. coeff q i \<in> R"
   shows   "coeff (pcompose p q) i \<in> R"
   using assms(1)
 proof (induction p arbitrary: i)
   case (pCons a p i)
   have [simp]: "a \<in> R"
     using pCons.prems[of 0] by auto
   have "coeff p i \<in> R" for i
     using pCons.prems[of "Suc i"] by auto
   hence "coeff (p \<circ>\<^sub>p q) i \<in> R" for i
     using pCons.prems by (intro pCons.IH)
   thus ?case
     by (auto simp: pcompose_pCons coeff_pCons split: nat.splits
              intro!: assms R_plus coeff_mult_semiring_closed)
 qed auto
 
 end
 
 
 subsection \<open>Shifting polynomials\<close>
 
 definition poly_shift :: "nat \<Rightarrow> 'a::zero poly \<Rightarrow> 'a poly"
   where "poly_shift n p = Abs_poly (\<lambda>i. coeff p (i + n))"
 
 lemma nth_default_drop: "nth_default x (drop n xs) m = nth_default x xs (m + n)"
   by (auto simp add: nth_default_def add_ac)
 
 lemma nth_default_take: "nth_default x (take n xs) m = (if m < n then nth_default x xs m else x)"
   by (auto simp add: nth_default_def add_ac)
 
 lemma coeff_poly_shift: "coeff (poly_shift n p) i = coeff p (i + n)"
 proof -
   from MOST_coeff_eq_0[of p] obtain m where "\<forall>k>m. coeff p k = 0"
     by (auto simp: MOST_nat)
   then have "\<forall>k>m. coeff p (k + n) = 0"
     by auto
   then have "\<forall>\<^sub>\<infinity>k. coeff p (k + n) = 0"
     by (auto simp: MOST_nat)
   then show ?thesis
     by (simp add: poly_shift_def poly.Abs_poly_inverse)
 qed
 
 lemma poly_shift_id [simp]: "poly_shift 0 = (\<lambda>x. x)"
   by (simp add: poly_eq_iff fun_eq_iff coeff_poly_shift)
 
 lemma poly_shift_0 [simp]: "poly_shift n 0 = 0"
   by (simp add: poly_eq_iff coeff_poly_shift)
 
 lemma poly_shift_1: "poly_shift n 1 = (if n = 0 then 1 else 0)"
   by (simp add: poly_eq_iff coeff_poly_shift)
 
 lemma poly_shift_monom: "poly_shift n (monom c m) = (if m \<ge> n then monom c (m - n) else 0)"
   by (auto simp add: poly_eq_iff coeff_poly_shift)
 
 lemma coeffs_shift_poly [code abstract]:
   "coeffs (poly_shift n p) = drop n (coeffs p)"
 proof (cases "p = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then show ?thesis
     by (intro coeffs_eqI)
       (simp_all add: coeff_poly_shift nth_default_drop nth_default_coeffs_eq)
 qed
 
 
 subsection \<open>Truncating polynomials\<close>
 
 definition poly_cutoff
   where "poly_cutoff n p = Abs_poly (\<lambda>k. if k < n then coeff p k else 0)"
 
 lemma coeff_poly_cutoff: "coeff (poly_cutoff n p) k = (if k < n then coeff p k else 0)"
   unfolding poly_cutoff_def
   by (subst poly.Abs_poly_inverse) (auto simp: MOST_nat intro: exI[of _ n])
 
 lemma poly_cutoff_0 [simp]: "poly_cutoff n 0 = 0"
   by (simp add: poly_eq_iff coeff_poly_cutoff)
 
 lemma poly_cutoff_1 [simp]: "poly_cutoff n 1 = (if n = 0 then 0 else 1)"
   by (simp add: poly_eq_iff coeff_poly_cutoff)
 
 lemma coeffs_poly_cutoff [code abstract]:
   "coeffs (poly_cutoff n p) = strip_while ((=) 0) (take n (coeffs p))"
 proof (cases "strip_while ((=) 0) (take n (coeffs p)) = []")
   case True
   then have "coeff (poly_cutoff n p) k = 0" for k
     unfolding coeff_poly_cutoff
     by (auto simp: nth_default_coeffs_eq [symmetric] nth_default_def set_conv_nth)
   then have "poly_cutoff n p = 0"
     by (simp add: poly_eq_iff)
   then show ?thesis
     by (subst True) simp_all
 next
   case False
   have "no_trailing ((=) 0) (strip_while ((=) 0) (take n (coeffs p)))"
     by simp
   with False have "last (strip_while ((=) 0) (take n (coeffs p))) \<noteq> 0"
     unfolding no_trailing_unfold by auto
   then show ?thesis
     by (intro coeffs_eqI)
       (simp_all add: coeff_poly_cutoff nth_default_take nth_default_coeffs_eq)
 qed
 
 
 subsection \<open>Reflecting polynomials\<close>
 
 definition reflect_poly :: "'a::zero poly \<Rightarrow> 'a poly"
   where "reflect_poly p = Poly (rev (coeffs p))"
 
 lemma coeffs_reflect_poly [code abstract]:
   "coeffs (reflect_poly p) = rev (dropWhile ((=) 0) (coeffs p))"
   by (simp add: reflect_poly_def)
 
 lemma reflect_poly_0 [simp]: "reflect_poly 0 = 0"
   by (simp add: reflect_poly_def)
 
 lemma reflect_poly_1 [simp]: "reflect_poly 1 = 1"
   by (simp add: reflect_poly_def one_pCons)
 
 lemma coeff_reflect_poly:
   "coeff (reflect_poly p) n = (if n > degree p then 0 else coeff p (degree p - n))"
   by (cases "p = 0")
     (auto simp add: reflect_poly_def nth_default_def
       rev_nth degree_eq_length_coeffs coeffs_nth not_less
       dest: le_imp_less_Suc)
 
 lemma coeff_0_reflect_poly_0_iff [simp]: "coeff (reflect_poly p) 0 = 0 \<longleftrightarrow> p = 0"
   by (simp add: coeff_reflect_poly)
 
 lemma reflect_poly_at_0_eq_0_iff [simp]: "poly (reflect_poly p) 0 = 0 \<longleftrightarrow> p = 0"
   by (simp add: coeff_reflect_poly poly_0_coeff_0)
 
 lemma reflect_poly_pCons':
   "p \<noteq> 0 \<Longrightarrow> reflect_poly (pCons c p) = reflect_poly p + monom c (Suc (degree p))"
   by (intro poly_eqI)
     (auto simp: coeff_reflect_poly coeff_pCons not_less Suc_diff_le split: nat.split)
 
 lemma reflect_poly_const [simp]: "reflect_poly [:a:] = [:a:]"
   by (cases "a = 0") (simp_all add: reflect_poly_def)
 
 lemma poly_reflect_poly_nz:
   "x \<noteq> 0 \<Longrightarrow> poly (reflect_poly p) x = x ^ degree p * poly p (inverse x)"
   for x :: "'a::field"
   by (induct rule: pCons_induct) (simp_all add: field_simps reflect_poly_pCons' poly_monom)
 
 lemma coeff_0_reflect_poly [simp]: "coeff (reflect_poly p) 0 = lead_coeff p"
   by (simp add: coeff_reflect_poly)
 
 lemma poly_reflect_poly_0 [simp]: "poly (reflect_poly p) 0 = lead_coeff p"
   by (simp add: poly_0_coeff_0)
 
 lemma reflect_poly_reflect_poly [simp]: "coeff p 0 \<noteq> 0 \<Longrightarrow> reflect_poly (reflect_poly p) = p"
   by (cases p rule: pCons_cases) (simp add: reflect_poly_def )
 
 lemma degree_reflect_poly_le: "degree (reflect_poly p) \<le> degree p"
   by (simp add: degree_eq_length_coeffs coeffs_reflect_poly length_dropWhile_le diff_le_mono)
 
 lemma reflect_poly_pCons: "a \<noteq> 0 \<Longrightarrow> reflect_poly (pCons a p) = Poly (rev (a # coeffs p))"
   by (subst coeffs_eq_iff) (simp add: coeffs_reflect_poly)
 
 lemma degree_reflect_poly_eq [simp]: "coeff p 0 \<noteq> 0 \<Longrightarrow> degree (reflect_poly p) = degree p"
   by (cases p rule: pCons_cases) (simp add: reflect_poly_pCons degree_eq_length_coeffs)
 
 (* TODO: does this work with zero divisors as well? Probably not. *)
 lemma reflect_poly_mult: "reflect_poly (p * q) = reflect_poly p * reflect_poly q"
   for p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
 proof (cases "p = 0 \<or> q = 0")
   case False
   then have [simp]: "p \<noteq> 0" "q \<noteq> 0" by auto
   show ?thesis
   proof (rule poly_eqI)
     show "coeff (reflect_poly (p * q)) i = coeff (reflect_poly p * reflect_poly q) i" for i
     proof (cases "i \<le> degree (p * q)")
       case True
       define A where "A = {..i} \<inter> {i - degree q..degree p}"
       define B where "B = {..degree p} \<inter> {degree p - i..degree (p*q) - i}"
       let ?f = "\<lambda>j. degree p - j"
 
       from True have "coeff (reflect_poly (p * q)) i = coeff (p * q) (degree (p * q) - i)"
         by (simp add: coeff_reflect_poly)
       also have "\<dots> = (\<Sum>j\<le>degree (p * q) - i. coeff p j * coeff q (degree (p * q) - i - j))"
         by (simp add: coeff_mult)
       also have "\<dots> = (\<Sum>j\<in>B. coeff p j * coeff q (degree (p * q) - i - j))"
         by (intro sum.mono_neutral_right) (auto simp: B_def degree_mult_eq not_le coeff_eq_0)
       also from True have "\<dots> = (\<Sum>j\<in>A. coeff p (degree p - j) * coeff q (degree q - (i - j)))"
         by (intro sum.reindex_bij_witness[of _ ?f ?f])
           (auto simp: A_def B_def degree_mult_eq add_ac)
       also have "\<dots> =
         (\<Sum>j\<le>i.
           if j \<in> {i - degree q..degree p}
           then coeff p (degree p - j) * coeff q (degree q - (i - j))
           else 0)"
         by (subst sum.inter_restrict [symmetric]) (simp_all add: A_def)
       also have "\<dots> = coeff (reflect_poly p * reflect_poly q) i"
         by (fastforce simp: coeff_mult coeff_reflect_poly intro!: sum.cong)
       finally show ?thesis .
     qed (auto simp: coeff_mult coeff_reflect_poly coeff_eq_0 degree_mult_eq intro!: sum.neutral)
   qed
 qed auto
 
 lemma reflect_poly_smult: "reflect_poly (smult c p) = smult c (reflect_poly p)"
   for p :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   using reflect_poly_mult[of "[:c:]" p] by simp
 
 lemma reflect_poly_power: "reflect_poly (p ^ n) = reflect_poly p ^ n"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
   by (induct n) (simp_all add: reflect_poly_mult)
 
 lemma reflect_poly_prod: "reflect_poly (prod f A) = prod (\<lambda>x. reflect_poly (f x)) A"
   for f :: "_ \<Rightarrow> _::{comm_semiring_0,semiring_no_zero_divisors} poly"
   by (induct A rule: infinite_finite_induct) (simp_all add: reflect_poly_mult)
 
 lemma reflect_poly_prod_list: "reflect_poly (prod_list xs) = prod_list (map reflect_poly xs)"
   for xs :: "_::{comm_semiring_0,semiring_no_zero_divisors} poly list"
   by (induct xs) (simp_all add: reflect_poly_mult)
 
 lemma reflect_poly_Poly_nz:
   "no_trailing (HOL.eq 0) xs \<Longrightarrow> reflect_poly (Poly xs) = Poly (rev xs)"
   by (simp add: reflect_poly_def)
 
 lemmas reflect_poly_simps =
   reflect_poly_0 reflect_poly_1 reflect_poly_const reflect_poly_smult reflect_poly_mult
   reflect_poly_power reflect_poly_prod reflect_poly_prod_list
 
 
 subsection \<open>Derivatives\<close>
 
 function pderiv :: "('a :: {comm_semiring_1,semiring_no_zero_divisors}) poly \<Rightarrow> 'a poly"
   where "pderiv (pCons a p) = (if p = 0 then 0 else p + pCons 0 (pderiv p))"
   by (auto intro: pCons_cases)
 
 termination pderiv
   by (relation "measure degree") simp_all
 
 declare pderiv.simps[simp del]
 
 lemma pderiv_0 [simp]: "pderiv 0 = 0"
   using pderiv.simps [of 0 0] by simp
 
 lemma pderiv_pCons: "pderiv (pCons a p) = p + pCons 0 (pderiv p)"
   by (simp add: pderiv.simps)
 
 lemma pderiv_1 [simp]: "pderiv 1 = 0"
   by (simp add: one_pCons pderiv_pCons)
 
 lemma pderiv_of_nat [simp]: "pderiv (of_nat n) = 0"
   and pderiv_numeral [simp]: "pderiv (numeral m) = 0"
   by (simp_all add: of_nat_poly numeral_poly pderiv_pCons)
 
 lemma coeff_pderiv: "coeff (pderiv p) n = of_nat (Suc n) * coeff p (Suc n)"
   by (induct p arbitrary: n)
     (auto simp add: pderiv_pCons coeff_pCons algebra_simps split: nat.split)
 
 fun pderiv_coeffs_code :: "'a::{comm_semiring_1,semiring_no_zero_divisors} \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where
     "pderiv_coeffs_code f (x # xs) = cCons (f * x) (pderiv_coeffs_code (f+1) xs)"
   | "pderiv_coeffs_code f [] = []"
 
 definition pderiv_coeffs :: "'a::{comm_semiring_1,semiring_no_zero_divisors} list \<Rightarrow> 'a list"
   where "pderiv_coeffs xs = pderiv_coeffs_code 1 (tl xs)"
 
 (* Efficient code for pderiv contributed by René Thiemann and Akihisa Yamada *)
 lemma pderiv_coeffs_code:
   "nth_default 0 (pderiv_coeffs_code f xs) n = (f + of_nat n) * nth_default 0 xs n"
 proof (induct xs arbitrary: f n)
   case Nil
   then show ?case by simp
 next
   case (Cons x xs)
   show ?case
   proof (cases n)
     case 0
     then show ?thesis
       by (cases "pderiv_coeffs_code (f + 1) xs = [] \<and> f * x = 0") (auto simp: cCons_def)
   next
     case n: (Suc m)
     show ?thesis
     proof (cases "pderiv_coeffs_code (f + 1) xs = [] \<and> f * x = 0")
       case False
       then have "nth_default 0 (pderiv_coeffs_code f (x # xs)) n =
           nth_default 0 (pderiv_coeffs_code (f + 1) xs) m"
         by (auto simp: cCons_def n)
       also have "\<dots> = (f + of_nat n) * nth_default 0 xs m"
         by (simp add: Cons n add_ac)
       finally show ?thesis
         by (simp add: n)
     next
       case True
       have empty: "pderiv_coeffs_code g xs = [] \<Longrightarrow> g + of_nat m = 0 \<or> nth_default 0 xs m = 0" for g
       proof (induct xs arbitrary: g m)
         case Nil
         then show ?case by simp
       next
         case (Cons x xs)
         from Cons(2) have empty: "pderiv_coeffs_code (g + 1) xs = []" and g: "g = 0 \<or> x = 0"
           by (auto simp: cCons_def split: if_splits)
         note IH = Cons(1)[OF empty]
         from IH[of m] IH[of "m - 1"] g show ?case
           by (cases m) (auto simp: field_simps)
       qed
       from True have "nth_default 0 (pderiv_coeffs_code f (x # xs)) n = 0"
         by (auto simp: cCons_def n)
       moreover from True have "(f + of_nat n) * nth_default 0 (x # xs) n = 0"
         by (simp add: n) (use empty[of "f+1"] in \<open>auto simp: field_simps\<close>)
       ultimately show ?thesis by simp
     qed
   qed
 qed
 
 lemma coeffs_pderiv_code [code abstract]: "coeffs (pderiv p) = pderiv_coeffs (coeffs p)"
   unfolding pderiv_coeffs_def
 proof (rule coeffs_eqI, unfold pderiv_coeffs_code coeff_pderiv, goal_cases)
   case (1 n)
   have id: "coeff p (Suc n) = nth_default 0 (map (\<lambda>i. coeff p (Suc i)) [0..<degree p]) n"
     by (cases "n < degree p") (auto simp: nth_default_def coeff_eq_0)
   show ?case
     unfolding coeffs_def map_upt_Suc by (auto simp: id)
 next
   case 2
   obtain n :: 'a and xs where defs: "tl (coeffs p) = xs" "1 = n"
     by simp
   from 2 show ?case
     unfolding defs by (induct xs arbitrary: n) (auto simp: cCons_def)
 qed
 
 lemma pderiv_eq_0_iff: "pderiv p = 0 \<longleftrightarrow> degree p = 0"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors,semiring_char_0} poly"
 proof (cases "degree p")
   case 0
   then show ?thesis
     by (metis degree_eq_zeroE pderiv.simps)
 next
   case (Suc n)
   then show ?thesis
     using coeff_0 coeff_pderiv degree_0 leading_coeff_0_iff mult_eq_0_iff nat.distinct(1) of_nat_eq_0_iff
     by (metis coeff_0 coeff_pderiv degree_0 leading_coeff_0_iff mult_eq_0_iff nat.distinct(1) of_nat_eq_0_iff)
 qed
 
 lemma degree_pderiv: "degree (pderiv p) = degree p - 1"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors,semiring_char_0} poly"
 proof -
   have "degree p - 1 \<le> degree (pderiv p)"
   proof (cases "degree p")
     case (Suc n)
     then show ?thesis
       by (metis coeff_pderiv degree_0 diff_Suc_1 le_degree leading_coeff_0_iff mult_eq_0_iff nat.distinct(1) of_nat_eq_0_iff)
   qed auto
   moreover have "\<forall>i>degree p - 1. coeff (pderiv p) i = 0"
     by (simp add: coeff_eq_0 coeff_pderiv)
   ultimately show ?thesis
     using order_antisym [OF degree_le] by blast
 qed
 
 lemma not_dvd_pderiv:
   fixes p :: "'a::{comm_semiring_1,semiring_no_zero_divisors,semiring_char_0} poly"
   assumes "degree p \<noteq> 0"
   shows "\<not> p dvd pderiv p"
 proof
   assume dvd: "p dvd pderiv p"
   then obtain q where p: "pderiv p = p * q"
     unfolding dvd_def by auto
   from dvd have le: "degree p \<le> degree (pderiv p)"
     by (simp add: assms dvd_imp_degree_le pderiv_eq_0_iff)
   from assms and this [unfolded degree_pderiv]
     show False by auto
 qed
 
 lemma dvd_pderiv_iff [simp]: "p dvd pderiv p \<longleftrightarrow> degree p = 0"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors,semiring_char_0} poly"
   using not_dvd_pderiv[of p] by (auto simp: pderiv_eq_0_iff [symmetric])
 
 lemma pderiv_singleton [simp]: "pderiv [:a:] = 0"
   by (simp add: pderiv_pCons)
 
 lemma pderiv_add: "pderiv (p + q) = pderiv p + pderiv q"
   by (rule poly_eqI) (simp add: coeff_pderiv algebra_simps)
 
 lemma pderiv_minus: "pderiv (- p :: 'a :: idom poly) = - pderiv p"
   by (rule poly_eqI) (simp add: coeff_pderiv algebra_simps)
 
 lemma pderiv_diff: "pderiv ((p :: _ :: idom poly) - q) = pderiv p - pderiv q"
   by (rule poly_eqI) (simp add: coeff_pderiv algebra_simps)
 
 lemma pderiv_smult: "pderiv (smult a p) = smult a (pderiv p)"
   by (rule poly_eqI) (simp add: coeff_pderiv algebra_simps)
 
 lemma pderiv_mult: "pderiv (p * q) = p * pderiv q + q * pderiv p"
   by (induct p) (auto simp: pderiv_add pderiv_smult pderiv_pCons algebra_simps)
 
 lemma pderiv_power_Suc: "pderiv (p ^ Suc n) = smult (of_nat (Suc n)) (p ^ n) * pderiv p"
 proof (induction n)
   case (Suc n)
   then show ?case
     by (simp add: pderiv_mult smult_add_left algebra_simps)
 qed auto
 
 lemma pderiv_pcompose: "pderiv (pcompose p q) = pcompose (pderiv p) q * pderiv q"
   by (induction p rule: pCons_induct)
      (auto simp: pcompose_pCons pderiv_add pderiv_mult pderiv_pCons pcompose_add algebra_simps)
 
 lemma pderiv_prod: "pderiv (prod f (as)) = (\<Sum>a\<in>as. prod f (as - {a}) * pderiv (f a))"
 proof (induct as rule: infinite_finite_induct)
   case (insert a as)
   then have id: "prod f (insert a as) = f a * prod f as"
     "\<And>g. sum g (insert a as) = g a + sum g as"
     "insert a as - {a} = as"
     by auto
   have "prod f (insert a as - {b}) = f a * prod f (as - {b})" if "b \<in> as" for b
   proof -
     from \<open>a \<notin> as\<close> that have *: "insert a as - {b} = insert a (as - {b})"
       by auto
     show ?thesis
       unfolding * by (subst prod.insert) (use insert in auto)
   qed
   then show ?case
     unfolding id pderiv_mult insert(3) sum_distrib_left
     by (auto simp add: ac_simps intro!: sum.cong)
 qed auto
 
 lemma DERIV_pow2: "DERIV (\<lambda>x. x ^ Suc n) x :> real (Suc n) * (x ^ n)"
   by (rule DERIV_cong, rule DERIV_pow) simp
 declare DERIV_pow2 [simp] DERIV_pow [simp]
 
 lemma DERIV_add_const: "DERIV f x :> D \<Longrightarrow> DERIV (\<lambda>x. a + f x :: 'a::real_normed_field) x :> D"
   by (rule DERIV_cong, rule DERIV_add) auto
 
 lemma poly_DERIV [simp]: "DERIV (\<lambda>x. poly p x) x :> poly (pderiv p) x"
   by (induct p) (auto intro!: derivative_eq_intros simp add: pderiv_pCons)
 
 lemma poly_isCont[simp]:
   fixes x::"'a::real_normed_field"
   shows "isCont (\<lambda>x. poly p x) x"
 by (rule poly_DERIV [THEN DERIV_isCont])
 
 lemma tendsto_poly [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. poly p (f x)) \<longlongrightarrow> poly p a) F"
   for f :: "_ \<Rightarrow> 'a::real_normed_field"
   by (rule isCont_tendsto_compose [OF poly_isCont])
 
 lemma continuous_within_poly: "continuous (at z within s) (poly p)"
   for z :: "'a::{real_normed_field}"
   by (simp add: continuous_within tendsto_poly)
 
 lemma continuous_poly [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. poly p (f x))"
   for f :: "_ \<Rightarrow> 'a::real_normed_field"
   unfolding continuous_def by (rule tendsto_poly)
 
 lemma continuous_on_poly [continuous_intros]:
   fixes p :: "'a :: {real_normed_field} poly"
   assumes "continuous_on A f"
   shows "continuous_on A (\<lambda>x. poly p (f x))"
   by (metis DERIV_continuous_on assms continuous_on_compose2 poly_DERIV subset_UNIV)
 
 text \<open>Consequences of the derivative theorem above.\<close>
 
 lemma poly_differentiable[simp]: "(\<lambda>x. poly p x) differentiable (at x)"
   for x :: real
   by (simp add: real_differentiable_def) (blast intro: poly_DERIV)
 
 lemma poly_IVT_pos: "a < b \<Longrightarrow> poly p a < 0 \<Longrightarrow> 0 < poly p b \<Longrightarrow> \<exists>x. a < x \<and> x < b \<and> poly p x = 0"
   for a b :: real
   using IVT [of "poly p" a 0 b] by (auto simp add: order_le_less)
 
 lemma poly_IVT_neg: "a < b \<Longrightarrow> 0 < poly p a \<Longrightarrow> poly p b < 0 \<Longrightarrow> \<exists>x. a < x \<and> x < b \<and> poly p x = 0"
   for a b :: real
   using poly_IVT_pos [where p = "- p"] by simp
 
 lemma poly_IVT: "a < b \<Longrightarrow> poly p a * poly p b < 0 \<Longrightarrow> \<exists>x>a. x < b \<and> poly p x = 0"
   for p :: "real poly"
   by (metis less_not_sym mult_less_0_iff poly_IVT_neg poly_IVT_pos)
 
 lemma poly_MVT: "a < b \<Longrightarrow> \<exists>x. a < x \<and> x < b \<and> poly p b - poly p a = (b - a) * poly (pderiv p) x"
   for a b :: real
   by (simp add: MVT2)
 
 lemma poly_MVT':
   fixes a b :: real
   assumes "{min a b..max a b} \<subseteq> A"
   shows "\<exists>x\<in>A. poly p b - poly p a = (b - a) * poly (pderiv p) x"
 proof (cases a b rule: linorder_cases)
   case less
-  from poly_MVT[OF less, of p] guess x by (elim exE conjE)
+  from poly_MVT[OF less, of p] obtain x
+    where "a < x" "x < b" "poly p b - poly p a = (b - a) * poly (pderiv p) x"
+    by auto
   then show ?thesis by (intro bexI[of _ x]) (auto intro!: subsetD[OF assms])
 next
   case greater
-  from poly_MVT[OF greater, of p] guess x by (elim exE conjE)
+  from poly_MVT[OF greater, of p] obtain x
+    where "b < x" "x < a" "poly p a - poly p b = (a - b) * poly (pderiv p) x" by auto
   then show ?thesis by (intro bexI[of _ x]) (auto simp: algebra_simps intro!: subsetD[OF assms])
 qed (use assms in auto)
 
 lemma poly_pinfty_gt_lc:
   fixes p :: "real poly"
   assumes "lead_coeff p > 0"
   shows "\<exists>n. \<forall> x \<ge> n. poly p x \<ge> lead_coeff p"
   using assms
 proof (induct p)
   case 0
   then show ?case by auto
 next
   case (pCons a p)
   from this(1) consider "a \<noteq> 0" "p = 0" | "p \<noteq> 0" by auto
   then show ?case
   proof cases
     case 1
     then show ?thesis by auto
   next
     case 2
     with pCons obtain n1 where gte_lcoeff: "\<forall>x\<ge>n1. lead_coeff p \<le> poly p x"
       by auto
     from pCons(3) \<open>p \<noteq> 0\<close> have gt_0: "lead_coeff p > 0" by auto
     define n where "n = max n1 (1 + \<bar>a\<bar> / lead_coeff p)"
     have "lead_coeff (pCons a p) \<le> poly (pCons a p) x" if "n \<le> x" for x
     proof -
       from gte_lcoeff that have "lead_coeff p \<le> poly p x"
         by (auto simp: n_def)
       with gt_0 have "\<bar>a\<bar> / lead_coeff p \<ge> \<bar>a\<bar> / poly p x" and "poly p x > 0"
         by (auto intro: frac_le)
       with \<open>n \<le> x\<close>[unfolded n_def] have "x \<ge> 1 + \<bar>a\<bar> / poly p x"
         by auto
       with \<open>lead_coeff p \<le> poly p x\<close> \<open>poly p x > 0\<close> \<open>p \<noteq> 0\<close>
       show "lead_coeff (pCons a p) \<le> poly (pCons a p) x"
         by (auto simp: field_simps)
     qed
     then show ?thesis by blast
   qed
 qed
 
 lemma lemma_order_pderiv1:
   "pderiv ([:- a, 1:] ^ Suc n * q) = [:- a, 1:] ^ Suc n * pderiv q +
     smult (of_nat (Suc n)) (q * [:- a, 1:] ^ n)"
   by (simp only: pderiv_mult pderiv_power_Suc) (simp del: power_Suc of_nat_Suc add: pderiv_pCons)
 
 lemma lemma_order_pderiv:
   fixes p :: "'a :: field_char_0 poly"
   assumes n: "0 < n"
     and pd: "pderiv p \<noteq> 0"
     and pe: "p = [:- a, 1:] ^ n * q"
     and nd: "\<not> [:- a, 1:] dvd q"
   shows "n = Suc (order a (pderiv p))"
 proof -
   from assms have "pderiv ([:- a, 1:] ^ n * q) \<noteq> 0"
     by auto
   from assms obtain n' where "n = Suc n'" "0 < Suc n'" "pderiv ([:- a, 1:] ^ Suc n' * q) \<noteq> 0"
     by (cases n) auto
   have "order a (pderiv ([:- a, 1:] ^ Suc n' * q)) = n'"
   proof (rule order_unique_lemma)
     show "[:- a, 1:] ^ n' dvd pderiv ([:- a, 1:] ^ Suc n' * q)"
       unfolding lemma_order_pderiv1
     proof (rule dvd_add)
       show "[:- a, 1:] ^ n' dvd [:- a, 1:] ^ Suc n' * pderiv q"
         by (metis dvdI dvd_mult2 power_Suc2)
       show "[:- a, 1:] ^ n' dvd smult (of_nat (Suc n')) (q * [:- a, 1:] ^ n')"
         by (metis dvd_smult dvd_triv_right)
     qed
     have "k dvd k * pderiv q + smult (of_nat (Suc n')) l \<Longrightarrow> k dvd l" for k l
       by (auto simp del: of_nat_Suc simp: dvd_add_right_iff dvd_smult_iff)
     then show "\<not> [:- a, 1:] ^ Suc n' dvd pderiv ([:- a, 1:] ^ Suc n' * q)"
       unfolding lemma_order_pderiv1
       by (metis nd dvd_mult_cancel_right power_not_zero pCons_eq_0_iff power_Suc zero_neq_one)
   qed
   then show ?thesis
     by (metis \<open>n = Suc n'\<close> pe)
 qed
 
 lemma order_pderiv: "order a p = Suc (order a (pderiv p))"
   if "pderiv p \<noteq> 0" "order a p \<noteq> 0"
   for p :: "'a::field_char_0 poly"
 proof (cases "p = 0")
   case False
   obtain q where "p = [:- a, 1:] ^ order a p * q \<and> \<not> [:- a, 1:] dvd q"
     using False order_decomp by blast
   then show ?thesis
     using lemma_order_pderiv that by blast
 qed (use that in auto)
 
 lemma poly_squarefree_decomp_order:
   fixes p :: "'a::field_char_0 poly"
   assumes "pderiv p \<noteq> 0"
     and p: "p = q * d"
     and p': "pderiv p = e * d"
     and d: "d = r * p + s * pderiv p"
   shows "order a q = (if order a p = 0 then 0 else 1)"
 proof (rule classical)
   assume 1: "\<not> ?thesis"
   from \<open>pderiv p \<noteq> 0\<close> have "p \<noteq> 0" by auto
   with p have "order a p = order a q + order a d"
     by (simp add: order_mult)
   with 1 have "order a p \<noteq> 0"
     by (auto split: if_splits)
   from \<open>pderiv p \<noteq> 0\<close> \<open>pderiv p = e * d\<close> have oapp: "order a (pderiv p) = order a e + order a d"
     by (simp add: order_mult)
   from \<open>pderiv p \<noteq> 0\<close> \<open>order a p \<noteq> 0\<close> have oap: "order a p = Suc (order a (pderiv p))"
     by (rule order_pderiv)
   from \<open>p \<noteq> 0\<close> \<open>p = q * d\<close> have "d \<noteq> 0"
     by simp
   have "[:- a, 1:] ^ order a (pderiv p) dvd r * p"
     by (metis dvd_trans dvd_triv_right oap order_1 power_Suc)
   then have "([:-a, 1:] ^ (order a (pderiv p))) dvd d"
     by (simp add: d order_1)
   with \<open>d \<noteq> 0\<close> have "order a (pderiv p) \<le> order a d"
     by (simp add: order_divides)
   show ?thesis
     using \<open>order a p = order a q + order a d\<close>
       and oapp oap
       and \<open>order a (pderiv p) \<le> order a d\<close>
     by auto
 qed
 
 lemma poly_squarefree_decomp_order2:
   "pderiv p \<noteq> 0 \<Longrightarrow> p = q * d \<Longrightarrow> pderiv p = e * d \<Longrightarrow>
     d = r * p + s * pderiv p \<Longrightarrow> \<forall>a. order a q = (if order a p = 0 then 0 else 1)"
   for p :: "'a::field_char_0 poly"
   by (blast intro: poly_squarefree_decomp_order)
 
 lemma order_pderiv2:
   "pderiv p \<noteq> 0 \<Longrightarrow> order a p \<noteq> 0 \<Longrightarrow> order a (pderiv p) = n \<longleftrightarrow> order a p = Suc n"
   for p :: "'a::field_char_0 poly"
   by (auto dest: order_pderiv)
 
 definition rsquarefree :: "'a::idom poly \<Rightarrow> bool"
   where "rsquarefree p \<longleftrightarrow> p \<noteq> 0 \<and> (\<forall>a. order a p = 0 \<or> order a p = 1)"
 
 lemma pderiv_iszero: "pderiv p = 0 \<Longrightarrow> \<exists>h. p = [:h:]"
   for p :: "'a::{semidom,semiring_char_0} poly"
   by (cases p) (auto simp: pderiv_eq_0_iff split: if_splits)
 
 lemma rsquarefree_roots: "rsquarefree p \<longleftrightarrow> (\<forall>a. \<not> (poly p a = 0 \<and> poly (pderiv p) a = 0))"
   for p :: "'a::field_char_0 poly"
 proof (cases "p = 0")
   case False
   show ?thesis
   proof (cases "pderiv p = 0")
     case True
     with \<open>p \<noteq> 0\<close> pderiv_iszero show ?thesis
       by (force simp add: order_0I rsquarefree_def)
   next
     case False
     with \<open>p \<noteq> 0\<close> order_pderiv2 show ?thesis
       by (force simp add: rsquarefree_def order_root)
   qed
 qed (simp add: rsquarefree_def)
 
 lemma poly_squarefree_decomp:
   fixes p :: "'a::field_char_0 poly"
   assumes "pderiv p \<noteq> 0"
     and "p = q * d"
     and "pderiv p = e * d"
     and "d = r * p + s * pderiv p"
   shows "rsquarefree q \<and> (\<forall>a. poly q a = 0 \<longleftrightarrow> poly p a = 0)"
 proof -
   from \<open>pderiv p \<noteq> 0\<close> have "p \<noteq> 0" by auto
   with \<open>p = q * d\<close> have "q \<noteq> 0" by simp
   from assms have "\<forall>a. order a q = (if order a p = 0 then 0 else 1)"
     by (rule poly_squarefree_decomp_order2)
   with \<open>p \<noteq> 0\<close> \<open>q \<noteq> 0\<close> show ?thesis
     by (simp add: rsquarefree_def order_root)
 qed
 
 
 subsection \<open>Algebraic numbers\<close>
 
 text \<open>
   Algebraic numbers can be defined in two equivalent ways: all real numbers that are
   roots of rational polynomials or of integer polynomials. The Algebraic-Numbers AFP entry
   uses the rational definition, but we need the integer definition.
 
   The equivalence is obvious since any rational polynomial can be multiplied with the
   LCM of its coefficients, yielding an integer polynomial with the same roots.
 \<close>
 
 definition algebraic :: "'a :: field_char_0 \<Rightarrow> bool"
   where "algebraic x \<longleftrightarrow> (\<exists>p. (\<forall>i. coeff p i \<in> \<int>) \<and> p \<noteq> 0 \<and> poly p x = 0)"
 
 lemma algebraicI: "(\<And>i. coeff p i \<in> \<int>) \<Longrightarrow> p \<noteq> 0 \<Longrightarrow> poly p x = 0 \<Longrightarrow> algebraic x"
   unfolding algebraic_def by blast
 
 lemma algebraicE:
   assumes "algebraic x"
   obtains p where "\<And>i. coeff p i \<in> \<int>" "p \<noteq> 0" "poly p x = 0"
   using assms unfolding algebraic_def by blast
 
 lemma algebraic_altdef: "algebraic x \<longleftrightarrow> (\<exists>p. (\<forall>i. coeff p i \<in> \<rat>) \<and> p \<noteq> 0 \<and> poly p x = 0)"
   for p :: "'a::field_char_0 poly"
 proof safe
   fix p
   assume rat: "\<forall>i. coeff p i \<in> \<rat>" and root: "poly p x = 0" and nz: "p \<noteq> 0"
   define cs where "cs = coeffs p"
   from rat have "\<forall>c\<in>range (coeff p). \<exists>c'. c = of_rat c'"
     unfolding Rats_def by blast
   then obtain f where f: "coeff p i = of_rat (f (coeff p i))" for i
     by (subst (asm) bchoice_iff) blast
   define cs' where "cs' = map (quotient_of \<circ> f) (coeffs p)"
   define d where "d = Lcm (set (map snd cs'))"
   define p' where "p' = smult (of_int d) p"
 
   have "coeff p' n \<in> \<int>" for n
   proof (cases "n \<le> degree p")
     case True
     define c where "c = coeff p n"
     define a where "a = fst (quotient_of (f (coeff p n)))"
     define b where "b = snd (quotient_of (f (coeff p n)))"
     have b_pos: "b > 0"
       unfolding b_def using quotient_of_denom_pos' by simp
     have "coeff p' n = of_int d * coeff p n"
       by (simp add: p'_def)
     also have "coeff p n = of_rat (of_int a / of_int b)"
       unfolding a_def b_def
       by (subst quotient_of_div [of "f (coeff p n)", symmetric]) (simp_all add: f [symmetric])
     also have "of_int d * \<dots> = of_rat (of_int (a*d) / of_int b)"
       by (simp add: of_rat_mult of_rat_divide)
     also from nz True have "b \<in> snd ` set cs'"
       by (force simp: cs'_def o_def b_def coeffs_def simp del: upt_Suc)
     then have "b dvd (a * d)"
       by (simp add: d_def)
     then have "of_int (a * d) / of_int b \<in> (\<int> :: rat set)"
       by (rule of_int_divide_in_Ints)
     then have "of_rat (of_int (a * d) / of_int b) \<in> \<int>" by (elim Ints_cases) auto
     finally show ?thesis .
   next
     case False
     then show ?thesis
       by (auto simp: p'_def not_le coeff_eq_0)
   qed
   moreover have "set (map snd cs') \<subseteq> {0<..}"
     unfolding cs'_def using quotient_of_denom_pos' by (auto simp: coeffs_def simp del: upt_Suc)
   then have "d \<noteq> 0"
     unfolding d_def by (induct cs') simp_all
   with nz have "p' \<noteq> 0" by (simp add: p'_def)
   moreover from root have "poly p' x = 0"
     by (simp add: p'_def)
   ultimately show "algebraic x"
     unfolding algebraic_def by blast
 next
   assume "algebraic x"
   then obtain p where p: "coeff p i \<in> \<int>" "poly p x = 0" "p \<noteq> 0" for i
     by (force simp: algebraic_def)
   moreover have "coeff p i \<in> \<int> \<Longrightarrow> coeff p i \<in> \<rat>" for i
     by (elim Ints_cases) simp
   ultimately show "\<exists>p. (\<forall>i. coeff p i \<in> \<rat>) \<and> p \<noteq> 0 \<and> poly p x = 0" by auto
 qed
 
 
 subsection \<open>Algebraic integers\<close>
 
 inductive algebraic_int :: "'a :: field \<Rightarrow> bool" where
   "\<lbrakk>lead_coeff p = 1; \<forall>i. coeff p i \<in> \<int>; poly p x = 0\<rbrakk> \<Longrightarrow> algebraic_int x"
 
 lemma algebraic_int_altdef_ipoly:
   fixes x :: "'a :: field_char_0"
   shows "algebraic_int x \<longleftrightarrow> (\<exists>p. poly (map_poly of_int p) x = 0 \<and> lead_coeff p = 1)"
 proof
   assume "algebraic_int x"
   then obtain p where p: "lead_coeff p = 1" "\<forall>i. coeff p i \<in> \<int>" "poly p x = 0"
     by (auto elim: algebraic_int.cases)
   define the_int where "the_int = (\<lambda>x::'a. THE r. x = of_int r)"
   define p' where "p' = map_poly the_int p"
   have of_int_the_int: "of_int (the_int x) = x" if "x \<in> \<int>" for x
     unfolding the_int_def by (rule sym, rule theI') (insert that, auto simp: Ints_def)
   have the_int_0_iff: "the_int x = 0 \<longleftrightarrow> x = 0" if "x \<in> \<int>" for x
     using of_int_the_int[OF that] by auto
   have [simp]: "the_int 0 = 0"
     by (subst the_int_0_iff) auto
   have "map_poly of_int p' = map_poly (of_int \<circ> the_int) p"
     by (simp add: p'_def map_poly_map_poly)
   also from p of_int_the_int have "\<dots> = p"
     by (subst poly_eq_iff) (auto simp: coeff_map_poly)
   finally have p_p': "map_poly of_int p' = p" .
 
   show "(\<exists>p. poly (map_poly of_int p) x = 0 \<and> lead_coeff p = 1)"
   proof (intro exI conjI notI)
     from p show "poly (map_poly of_int p') x = 0" by (simp add: p_p')
   next
     show "lead_coeff p' = 1"
       using p by (simp flip: p_p' add: degree_map_poly coeff_map_poly)
   qed
 next
   assume "\<exists>p. poly (map_poly of_int p) x = 0 \<and> lead_coeff p = 1"
   then obtain p where p: "poly (map_poly of_int p) x = 0" "lead_coeff p = 1"
     by auto
   define p' where "p' = (map_poly of_int p :: 'a poly)"
   from p have "lead_coeff p' = 1" "poly p' x = 0" "\<forall>i. coeff p' i \<in> \<int>"
     by (auto simp: p'_def coeff_map_poly degree_map_poly)
   thus "algebraic_int x"
     by (intro algebraic_int.intros)
 qed
 
 theorem rational_algebraic_int_is_int:
   assumes "algebraic_int x" and "x \<in> \<rat>"
   shows   "x \<in> \<int>"
 proof -
   from assms(2) obtain a b where ab: "b > 0" "Rings.coprime a b" and x_eq: "x = of_int a / of_int b"
     by (auto elim: Rats_cases')
   from \<open>b > 0\<close> have [simp]: "b \<noteq> 0"
     by auto
   from assms(1) obtain p
     where p: "lead_coeff p = 1" "\<forall>i. coeff p i \<in> \<int>" "poly p x = 0"
     by (auto simp: algebraic_int.simps)
 
   define q :: "'a poly" where "q = [:-of_int a, of_int b:]"
   have "poly q x = 0" "q \<noteq> 0" "\<forall>i. coeff q i \<in> \<int>"
     by (auto simp: x_eq q_def coeff_pCons split: nat.splits)
   define n where "n = degree p"
   have "n > 0"
     using p by (intro Nat.gr0I) (auto simp: n_def elim!: degree_eq_zeroE)
   have "(\<Sum>i<n. coeff p i * of_int (a ^ i * b ^ (n - i - 1))) \<in> \<int>"
     using p by auto
   then obtain R where R: "of_int R = (\<Sum>i<n. coeff p i * of_int (a ^ i * b ^ (n - i - 1)))"
     by (auto simp: Ints_def)
   have [simp]: "coeff p n = 1"
     using p by (auto simp: n_def)
 
   have "0 = poly p x * of_int b ^ n"
     using p by simp
   also have "\<dots> = (\<Sum>i\<le>n. coeff p i * x ^ i * of_int b ^ n)"
     by (simp add: poly_altdef n_def sum_distrib_right)
   also have "\<dots> = (\<Sum>i\<le>n. coeff p i * of_int (a ^ i * b ^ (n - i)))"
     by (intro sum.cong) (auto simp: x_eq field_simps simp flip: power_add)
   also have "{..n} = insert n {..<n}"
     using \<open>n > 0\<close> by auto
   also have "(\<Sum>i\<in>\<dots>. coeff p i * of_int (a ^ i * b ^ (n - i))) =
                coeff p n * of_int (a ^ n) + (\<Sum>i<n. coeff p i * of_int (a ^ i * b ^ (n - i)))"
     by (subst sum.insert) auto
   also have "(\<Sum>i<n. coeff p i * of_int (a ^ i * b ^ (n - i))) =
              (\<Sum>i<n. coeff p i * of_int (a ^ i * b * b ^ (n - i - 1)))"
     by (intro sum.cong) (auto simp flip: power_add power_Suc simp: Suc_diff_Suc)
   also have "\<dots> = of_int (b * R)"
     by (simp add: R sum_distrib_left sum_distrib_right mult_ac)
   finally have "of_int (a ^ n) = (-of_int (b * R) :: 'a)"
     by (auto simp: add_eq_0_iff)
   hence "a ^ n = -b * R"
     by (simp flip: of_int_mult of_int_power of_int_minus)
   hence "b dvd a ^ n"
     by simp
   with \<open>Rings.coprime a b\<close> have "b dvd 1"
     by (meson coprime_power_left_iff dvd_refl not_coprimeI)
   with x_eq and \<open>b > 0\<close> show ?thesis
     by auto
 qed
 
 lemma algebraic_int_imp_algebraic [dest]: "algebraic_int x \<Longrightarrow> algebraic x"
   by (auto simp: algebraic_int.simps algebraic_def)
 
 lemma int_imp_algebraic_int:
   assumes "x \<in> \<int>"
   shows   "algebraic_int x"
 proof
   show "\<forall>i. coeff [:-x, 1:] i \<in> \<int>"
     using assms by (auto simp: coeff_pCons split: nat.splits)
 qed auto
 
 lemma algebraic_int_0 [simp, intro]: "algebraic_int 0"
   and algebraic_int_1 [simp, intro]: "algebraic_int 1"
   and algebraic_int_numeral [simp, intro]: "algebraic_int (numeral n)"
   and algebraic_int_of_nat [simp, intro]: "algebraic_int (of_nat k)"
   and algebraic_int_of_int [simp, intro]: "algebraic_int (of_int m)"
   by (simp_all add: int_imp_algebraic_int)
 
 lemma algebraic_int_ii [simp, intro]: "algebraic_int \<i>"
 proof
   show "poly [:1, 0, 1:] \<i> = 0"
     by simp
 qed (auto simp: coeff_pCons split: nat.splits)
 
 lemma algebraic_int_minus [intro]:
   assumes "algebraic_int x"
   shows   "algebraic_int (-x)"
 proof -
   from assms obtain p where p: "lead_coeff p = 1" "\<forall>i. coeff p i \<in> \<int>" "poly p x = 0"
     by (auto simp: algebraic_int.simps)
   define s where "s = (if even (degree p) then 1 else -1 :: 'a)"
 
   define q where "q = Polynomial.smult s (pcompose p [:0, -1:])"
   have "lead_coeff q = s * lead_coeff (pcompose p [:0, -1:])"
     by (simp add: q_def)
   also have "lead_coeff (pcompose p [:0, -1:]) = lead_coeff p * (- 1) ^ degree p"
     by (subst lead_coeff_comp) auto
   finally have "poly q (-x) = 0" and "lead_coeff q = 1"
     using p by (auto simp: q_def poly_pcompose s_def)
   moreover have "coeff q i \<in> \<int>" for i
   proof -
     have "coeff (pcompose p [:0, -1:]) i \<in> \<int>"
       using p by (intro coeff_pcompose_semiring_closed) (auto simp: coeff_pCons split: nat.splits)
     thus ?thesis by (simp add: q_def s_def)
   qed
   ultimately show ?thesis
     by (auto simp: algebraic_int.simps)
 qed
 
 lemma algebraic_int_minus_iff [simp]:
   "algebraic_int (-x) \<longleftrightarrow> algebraic_int (x :: 'a :: field_char_0)"
   using algebraic_int_minus[of x] algebraic_int_minus[of "-x"] by auto
 
 lemma algebraic_int_inverse [intro]:
   assumes "poly p x = 0" and "\<forall>i. coeff p i \<in> \<int>" and "coeff p 0 = 1"
   shows   "algebraic_int (inverse x)"
 proof
   from assms have [simp]: "x \<noteq> 0"
     by (auto simp: poly_0_coeff_0)
   show "poly (reflect_poly p) (inverse x) = 0"
     using assms by (simp add: poly_reflect_poly_nz)
 qed (use assms in \<open>auto simp: coeff_reflect_poly\<close>)
 
 lemma algebraic_int_root:
   assumes "algebraic_int y"
       and "poly p x = y" and "\<forall>i. coeff p i \<in> \<int>" and "lead_coeff p = 1" and "degree p > 0"
   shows   "algebraic_int x"
 proof -
   from assms obtain q where q: "poly q y = 0" "\<forall>i. coeff q i \<in> \<int>" "lead_coeff q = 1"
     by (auto simp: algebraic_int.simps)
   show ?thesis
   proof
     from assms q show "lead_coeff (pcompose q p) = 1"
       by (subst lead_coeff_comp) auto
     from assms q show "\<forall>i. coeff (pcompose q p) i \<in> \<int>"
       by (intro allI coeff_pcompose_semiring_closed) auto
     show "poly (pcompose q p) x = 0"
       using assms q by (simp add: poly_pcompose)
   qed
 qed
 
 lemma algebraic_int_abs_real [simp]:
   "algebraic_int \<bar>x :: real\<bar> \<longleftrightarrow> algebraic_int x"
   by (auto simp: abs_if)
 
 lemma algebraic_int_nth_root_real [intro]:
   assumes "algebraic_int x"
   shows   "algebraic_int (root n x)"
 proof (cases "n = 0")
   case False
   show ?thesis
   proof (rule algebraic_int_root)
     show "poly (monom 1 n) (root n x) = (if even n then \<bar>x\<bar> else x)"
       using sgn_power_root[of n x] False
       by (auto simp add: poly_monom sgn_if split: if_splits)
   qed (use False assms in \<open>auto simp: degree_monom_eq\<close>)
 qed auto
 
 lemma algebraic_int_sqrt [intro]: "algebraic_int x \<Longrightarrow> algebraic_int (sqrt x)"
   by (auto simp: sqrt_def)
 
 lemma algebraic_int_csqrt [intro]: "algebraic_int x \<Longrightarrow> algebraic_int (csqrt x)"
   by (rule algebraic_int_root[where p = "monom 1 2"])
      (auto simp: poly_monom degree_monom_eq)
 
 lemma poly_map_poly_cnj [simp]: "poly (map_poly cnj p) x = cnj (poly p (cnj x))"
   by (induction p) (auto simp: map_poly_pCons)
 
 lemma algebraic_int_cnj [intro]:
   assumes "algebraic_int x"
   shows   "algebraic_int (cnj x)"
 proof -
   from assms obtain p where p: "lead_coeff p = 1" "\<forall>i. coeff p i \<in> \<int>" "poly p x = 0"
     by (auto simp: algebraic_int.simps)
   show ?thesis
   proof
     show "poly (map_poly cnj p) (cnj x) = 0"
       using p by simp
     show "lead_coeff (map_poly cnj p) = 1"
       using p by (simp add: coeff_map_poly degree_map_poly)
     show "\<forall>i. coeff (map_poly cnj p) i \<in> \<int>"
       using p by (auto simp: coeff_map_poly)
   qed
 qed
 
 lemma algebraic_int_cnj_iff [simp]: "algebraic_int (cnj x) \<longleftrightarrow> algebraic_int x"
   using algebraic_int_cnj[of x] algebraic_int_cnj[of "cnj x"] by auto
 
 lemma algebraic_int_of_real [intro]:
   assumes "algebraic_int x"
   shows   "algebraic_int (of_real x)"
 proof -
   from assms obtain p where p: "poly p x = 0" "\<forall>i. coeff p i \<in> \<int>" "lead_coeff p = 1"
     by (auto simp: algebraic_int.simps)
   show "algebraic_int (of_real x :: 'a)"
   proof
     have "poly (map_poly of_real p) (of_real x) = (of_real (poly p x) :: 'a)"
       by (induction p) (auto simp: map_poly_pCons)
     thus "poly (map_poly of_real p) (of_real x) = (0 :: 'a)"
       using p by simp
   qed (use p in \<open>auto simp: coeff_map_poly degree_map_poly\<close>)
 qed
 
 lemma algebraic_int_of_real_iff [simp]:
   "algebraic_int (of_real x :: 'a :: {field_char_0, real_algebra_1}) \<longleftrightarrow> algebraic_int x"
 proof
   assume "algebraic_int (of_real x :: 'a)"
   then obtain p
     where p: "poly (map_poly of_int p) (of_real x :: 'a) = 0" "lead_coeff p = 1"
     by (auto simp: algebraic_int_altdef_ipoly)
   show "algebraic_int x"
     unfolding algebraic_int_altdef_ipoly
   proof (intro exI[of _ p] conjI)
     have "of_real (poly (map_poly real_of_int p) x) = poly (map_poly of_int p) (of_real x :: 'a)"
       by (induction p) (auto simp: map_poly_pCons)
     also note p(1)
     finally show "poly (map_poly real_of_int p) x = 0" by simp
   qed (use p in auto)
 qed auto
 
 
 subsection \<open>Division of polynomials\<close>
 
 subsubsection \<open>Division in general\<close>
 
 instantiation poly :: (idom_divide) idom_divide
 begin
 
 fun divide_poly_main :: "'a \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a poly"
   where
     "divide_poly_main lc q r d dr (Suc n) =
       (let cr = coeff r dr; a = cr div lc; mon = monom a n in
         if False \<or> a * lc = cr then \<comment> \<open>\<open>False \<or>\<close> is only because of problem in function-package\<close>
           divide_poly_main
             lc
             (q + mon)
             (r - mon * d)
             d (dr - 1) n else 0)"
   | "divide_poly_main lc q r d dr 0 = q"
 
 definition divide_poly :: "'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "divide_poly f g =
     (if g = 0 then 0
      else
       divide_poly_main (coeff g (degree g)) 0 f g (degree f)
         (1 + length (coeffs f) - length (coeffs g)))"
 
 lemma divide_poly_main:
   assumes d: "d \<noteq> 0" "lc = coeff d (degree d)"
     and "degree (d * r) \<le> dr" "divide_poly_main lc q (d * r) d dr n = q'"
     and "n = 1 + dr - degree d \<or> dr = 0 \<and> n = 0 \<and> d * r = 0"
   shows "q' = q + r"
   using assms(3-)
 proof (induct n arbitrary: q r dr)
   case (Suc n)
   let ?rr = "d * r"
   let ?a = "coeff ?rr dr"
   let ?qq = "?a div lc"
   define b where [simp]: "b = monom ?qq n"
   let ?rrr =  "d * (r - b)"
   let ?qqq = "q + b"
   note res = Suc(3)
   from Suc(4) have dr: "dr = n + degree d" by auto
   from d have lc: "lc \<noteq> 0" by auto
   have "coeff (b * d) dr = coeff b n * coeff d (degree d)"
   proof (cases "?qq = 0")
     case True
     then show ?thesis by simp
   next
     case False
     then have n: "n = degree b"
       by (simp add: degree_monom_eq)
     show ?thesis
       unfolding n dr by (simp add: coeff_mult_degree_sum)
   qed
   also have "\<dots> = lc * coeff b n"
     by (simp add: d)
   finally have c2: "coeff (b * d) dr = lc * coeff b n" .
   have rrr: "?rrr = ?rr - b * d"
     by (simp add: field_simps)
   have c1: "coeff (d * r) dr = lc * coeff r n"
   proof (cases "degree r = n")
     case True
     with Suc(2) show ?thesis
       unfolding dr using coeff_mult_degree_sum[of d r] d by (auto simp: ac_simps)
   next
     case False
     from dr Suc(2) have "degree r \<le> n"
       by auto
         (metis add.commute add_le_cancel_left d(1) degree_0 degree_mult_eq
           diff_is_0_eq diff_zero le_cases)
     with False have r_n: "degree r < n"
       by auto
     then have right: "lc * coeff r n = 0"
       by (simp add: coeff_eq_0)
     have "coeff (d * r) dr = coeff (d * r) (degree d + n)"
       by (simp add: dr ac_simps)
     also from r_n have "\<dots> = 0"
       by (metis False Suc.prems(1) add.commute add_left_imp_eq coeff_degree_mult coeff_eq_0
         coeff_mult_degree_sum degree_mult_le dr le_eq_less_or_eq)
     finally show ?thesis
       by (simp only: right)
   qed
   have c0: "coeff ?rrr dr = 0"
     and id: "lc * (coeff (d * r) dr div lc) = coeff (d * r) dr"
     unfolding rrr coeff_diff c2
     unfolding b_def coeff_monom coeff_smult c1 using lc by auto
   from res[unfolded divide_poly_main.simps[of lc q] Let_def] id
   have res: "divide_poly_main lc ?qqq ?rrr d (dr - 1) n = q'"
     by (simp del: divide_poly_main.simps add: field_simps)
   note IH = Suc(1)[OF _ res]
   from Suc(4) have dr: "dr = n + degree d" by auto
   from Suc(2) have deg_rr: "degree ?rr \<le> dr" by auto
   have deg_bd: "degree (b * d) \<le> dr"
     unfolding dr b_def by (rule order.trans[OF degree_mult_le]) (auto simp: degree_monom_le)
   have "degree ?rrr \<le> dr"
     unfolding rrr by (rule degree_diff_le[OF deg_rr deg_bd])
   with c0 have deg_rrr: "degree ?rrr \<le> (dr - 1)"
     by (rule coeff_0_degree_minus_1)
   have "n = 1 + (dr - 1) - degree d \<or> dr - 1 = 0 \<and> n = 0 \<and> ?rrr = 0"
   proof (cases dr)
     case 0
     with Suc(4) have 0: "dr = 0" "n = 0" "degree d = 0"
       by auto
     with deg_rrr have "degree ?rrr = 0"
       by simp
     from degree_eq_zeroE[OF this] obtain a where rrr: "?rrr = [:a:]"
       by metis
     show ?thesis
       unfolding 0 using c0 unfolding rrr 0 by simp
   next
     case _: Suc
     with Suc(4) show ?thesis by auto
   qed
   from IH[OF deg_rrr this] show ?case
     by simp
 next
   case 0
   show ?case
   proof (cases "r = 0")
     case True
     with 0 show ?thesis by auto
   next
     case False
     from d False have "degree (d * r) = degree d + degree r"
       by (subst degree_mult_eq) auto
     with 0 d show ?thesis by auto
   qed
 qed
 
 lemma divide_poly_main_0: "divide_poly_main 0 0 r d dr n = 0"
 proof (induct n arbitrary: r d dr)
   case 0
   then show ?case by simp
 next
   case Suc
   show ?case
     unfolding divide_poly_main.simps[of _ _ r] Let_def
     by (simp add: Suc del: divide_poly_main.simps)
 qed
 
 lemma divide_poly:
   assumes g: "g \<noteq> 0"
   shows "(f * g) div g = (f :: 'a poly)"
 proof -
   have len: "length (coeffs f) = Suc (degree f)" if "f \<noteq> 0" for f :: "'a poly"
     using that unfolding degree_eq_length_coeffs by auto
   have "divide_poly_main (coeff g (degree g)) 0 (g * f) g (degree (g * f))
     (1 + length (coeffs (g * f)) - length (coeffs  g)) = (f * g) div g"
     by (simp add: divide_poly_def Let_def ac_simps)
   note main = divide_poly_main[OF g refl le_refl this]
   have "(f * g) div g = 0 + f"
   proof (rule main, goal_cases)
     case 1
     show ?case
     proof (cases "f = 0")
       case True
       with g show ?thesis
         by (auto simp: degree_eq_length_coeffs)
     next
       case False
       with g have fg: "g * f \<noteq> 0" by auto
       show ?thesis
         unfolding len[OF fg] len[OF g] by auto
     qed
   qed
   then show ?thesis by simp
 qed
 
 lemma divide_poly_0: "f div 0 = 0"
   for f :: "'a poly"
   by (simp add: divide_poly_def Let_def divide_poly_main_0)
 
 instance
   by standard (auto simp: divide_poly divide_poly_0)
 
 end
 
 instance poly :: (idom_divide) algebraic_semidom ..
 
 lemma div_const_poly_conv_map_poly:
   assumes "[:c:] dvd p"
   shows "p div [:c:] = map_poly (\<lambda>x. x div c) p"
 proof (cases "c = 0")
   case True
   then show ?thesis
     by (auto intro!: poly_eqI simp: coeff_map_poly)
 next
   case False
   from assms obtain q where p: "p = [:c:] * q" by (rule dvdE)
   moreover {
     have "smult c q = [:c:] * q"
       by simp
     also have "\<dots> div [:c:] = q"
       by (rule nonzero_mult_div_cancel_left) (use False in auto)
     finally have "smult c q div [:c:] = q" .
   }
   ultimately show ?thesis by (intro poly_eqI) (auto simp: coeff_map_poly False)
 qed
 
 lemma is_unit_monom_0:
   fixes a :: "'a::field"
   assumes "a \<noteq> 0"
   shows "is_unit (monom a 0)"
 proof
   from assms show "1 = monom a 0 * monom (inverse a) 0"
     by (simp add: mult_monom)
 qed
 
 lemma is_unit_triv: "a \<noteq> 0 \<Longrightarrow> is_unit [:a:]"
   for a :: "'a::field"
   by (simp add: is_unit_monom_0 monom_0 [symmetric])
 
 lemma is_unit_iff_degree:
   fixes p :: "'a::field poly"
   assumes "p \<noteq> 0"
   shows "is_unit p \<longleftrightarrow> degree p = 0"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then obtain a where "p = [:a:]"
     by (rule degree_eq_zeroE)
   with assms show ?lhs
     by (simp add: is_unit_triv)
 next
   assume ?lhs
   then obtain q where "q \<noteq> 0" "p * q = 1" ..
   then have "degree (p * q) = degree 1"
     by simp
   with \<open>p \<noteq> 0\<close> \<open>q \<noteq> 0\<close> have "degree p + degree q = 0"
     by (simp add: degree_mult_eq)
   then show ?rhs by simp
 qed
 
 lemma is_unit_pCons_iff: "is_unit (pCons a p) \<longleftrightarrow> p = 0 \<and> a \<noteq> 0"
   for p :: "'a::field poly"
   by (cases "p = 0") (auto simp: is_unit_triv is_unit_iff_degree)
 
 lemma is_unit_monom_trivial: "is_unit p \<Longrightarrow> monom (coeff p (degree p)) 0 = p"
   for p :: "'a::field poly"
   by (cases p) (simp_all add: monom_0 is_unit_pCons_iff)
 
 lemma is_unit_const_poly_iff: "[:c:] dvd 1 \<longleftrightarrow> c dvd 1"
   for c :: "'a::{comm_semiring_1,semiring_no_zero_divisors}"
   by (auto simp: one_pCons)
 
 lemma is_unit_polyE:
   fixes p :: "'a :: {comm_semiring_1,semiring_no_zero_divisors} poly"
   assumes "p dvd 1"
   obtains c where "p = [:c:]" "c dvd 1"
 proof -
   from assms obtain q where "1 = p * q"
     by (rule dvdE)
   then have "p \<noteq> 0" and "q \<noteq> 0"
     by auto
   from \<open>1 = p * q\<close> have "degree 1 = degree (p * q)"
     by simp
   also from \<open>p \<noteq> 0\<close> and \<open>q \<noteq> 0\<close> have "\<dots> = degree p + degree q"
     by (simp add: degree_mult_eq)
   finally have "degree p = 0" by simp
   with degree_eq_zeroE obtain c where c: "p = [:c:]" .
   with \<open>p dvd 1\<close> have "c dvd 1"
     by (simp add: is_unit_const_poly_iff)
   with c show thesis ..
 qed
 
 lemma is_unit_polyE':
   fixes p :: "'a::field poly"
   assumes "is_unit p"
   obtains a where "p = monom a 0" and "a \<noteq> 0"
 proof -
   obtain a q where "p = pCons a q"
     by (cases p)
   with assms have "p = [:a:]" and "a \<noteq> 0"
     by (simp_all add: is_unit_pCons_iff)
   with that show thesis by (simp add: monom_0)
 qed
 
 lemma is_unit_poly_iff: "p dvd 1 \<longleftrightarrow> (\<exists>c. p = [:c:] \<and> c dvd 1)"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
   by (auto elim: is_unit_polyE simp add: is_unit_const_poly_iff)
 
 
 subsubsection \<open>Pseudo-Division\<close>
 
 text \<open>This part is by René Thiemann and Akihisa Yamada.\<close>
 
 fun pseudo_divmod_main ::
   "'a :: comm_ring_1  \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a poly \<times> 'a poly"
   where
     "pseudo_divmod_main lc q r d dr (Suc n) =
       (let
         rr = smult lc r;
         qq = coeff r dr;
         rrr = rr - monom qq n * d;
         qqq = smult lc q + monom qq n
        in pseudo_divmod_main lc qqq rrr d (dr - 1) n)"
   | "pseudo_divmod_main lc q r d dr 0 = (q,r)"
 
 definition pseudo_divmod :: "'a :: comm_ring_1 poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<times> 'a poly"
   where "pseudo_divmod p q \<equiv>
     if q = 0 then (0, p)
     else
       pseudo_divmod_main (coeff q (degree q)) 0 p q (degree p)
         (1 + length (coeffs p) - length (coeffs q))"
 
 lemma pseudo_divmod_main:
   assumes d: "d \<noteq> 0" "lc = coeff d (degree d)"
     and "degree r \<le> dr" "pseudo_divmod_main lc q r d dr n = (q',r')"
     and "n = 1 + dr - degree d \<or> dr = 0 \<and> n = 0 \<and> r = 0"
   shows "(r' = 0 \<or> degree r' < degree d) \<and> smult (lc^n) (d * q + r) = d * q' + r'"
   using assms(3-)
 proof (induct n arbitrary: q r dr)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   let ?rr = "smult lc r"
   let ?qq = "coeff r dr"
   define b where [simp]: "b = monom ?qq n"
   let ?rrr = "?rr - b * d"
   let ?qqq = "smult lc q + b"
   note res = Suc(3)
   from res[unfolded pseudo_divmod_main.simps[of lc q] Let_def]
   have res: "pseudo_divmod_main lc ?qqq ?rrr d (dr - 1) n = (q',r')"
     by (simp del: pseudo_divmod_main.simps)
   from Suc(4) have dr: "dr = n + degree d" by auto
   have "coeff (b * d) dr = coeff b n * coeff d (degree d)"
   proof (cases "?qq = 0")
     case True
     then show ?thesis by auto
   next
     case False
     then have n: "n = degree b"
       by (simp add: degree_monom_eq)
     show ?thesis
       unfolding n dr by (simp add: coeff_mult_degree_sum)
   qed
   also have "\<dots> = lc * coeff b n" by (simp add: d)
   finally have "coeff (b * d) dr = lc * coeff b n" .
   moreover have "coeff ?rr dr = lc * coeff r dr"
     by simp
   ultimately have c0: "coeff ?rrr dr = 0"
     by auto
   from Suc(4) have dr: "dr = n + degree d" by auto
   have deg_rr: "degree ?rr \<le> dr"
     using Suc(2) degree_smult_le dual_order.trans by blast
   have deg_bd: "degree (b * d) \<le> dr"
     unfolding dr by (rule order.trans[OF degree_mult_le]) (auto simp: degree_monom_le)
   have "degree ?rrr \<le> dr"
     using degree_diff_le[OF deg_rr deg_bd] by auto
   with c0 have deg_rrr: "degree ?rrr \<le> (dr - 1)"
     by (rule coeff_0_degree_minus_1)
   have "n = 1 + (dr - 1) - degree d \<or> dr - 1 = 0 \<and> n = 0 \<and> ?rrr = 0"
   proof (cases dr)
     case 0
     with Suc(4) have 0: "dr = 0" "n = 0" "degree d = 0" by auto
     with deg_rrr have "degree ?rrr = 0" by simp
     then have "\<exists>a. ?rrr = [:a:]"
       by (metis degree_pCons_eq_if old.nat.distinct(2) pCons_cases)
     from this obtain a where rrr: "?rrr = [:a:]"
       by auto
     show ?thesis
       unfolding 0 using c0 unfolding rrr 0 by simp
   next
     case _: Suc
     with Suc(4) show ?thesis by auto
   qed
   note IH = Suc(1)[OF deg_rrr res this]
   show ?case
   proof (intro conjI)
     from IH show "r' = 0 \<or> degree r' < degree d"
       by blast
     show "smult (lc ^ Suc n) (d * q + r) = d * q' + r'"
       unfolding IH[THEN conjunct2,symmetric]
       by (simp add: field_simps smult_add_right)
   qed
 qed
 
 lemma pseudo_divmod:
   assumes g: "g \<noteq> 0"
     and *: "pseudo_divmod f g = (q,r)"
   shows "smult (coeff g (degree g) ^ (Suc (degree f) - degree g)) f = g * q + r"  (is ?A)
     and "r = 0 \<or> degree r < degree g"  (is ?B)
 proof -
   from *[unfolded pseudo_divmod_def Let_def]
   have "pseudo_divmod_main (coeff g (degree g)) 0 f g (degree f)
       (1 + length (coeffs f) - length (coeffs g)) = (q, r)"
     by (auto simp: g)
   note main = pseudo_divmod_main[OF _ _ _ this, OF g refl le_refl]
   from g have "1 + length (coeffs f) - length (coeffs g) = 1 + degree f - degree g \<or>
     degree f = 0 \<and> 1 + length (coeffs f) - length (coeffs g) = 0 \<and> f = 0"
     by (cases "f = 0"; cases "coeffs g") (auto simp: degree_eq_length_coeffs)
   note main' = main[OF this]
   then show "r = 0 \<or> degree r < degree g" by auto
   show "smult (coeff g (degree g) ^ (Suc (degree f) - degree g)) f = g * q + r"
     by (subst main'[THEN conjunct2, symmetric], simp add: degree_eq_length_coeffs,
         cases "f = 0"; cases "coeffs g", use g in auto)
 qed
 
 definition "pseudo_mod_main lc r d dr n = snd (pseudo_divmod_main lc 0 r d dr n)"
 
 lemma snd_pseudo_divmod_main:
   "snd (pseudo_divmod_main lc q r d dr n) = snd (pseudo_divmod_main lc q' r d dr n)"
   by (induct n arbitrary: q q' lc r d dr) (simp_all add: Let_def)
 
 definition pseudo_mod :: "'a::{comm_ring_1,semiring_1_no_zero_divisors} poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "pseudo_mod f g = snd (pseudo_divmod f g)"
 
 lemma pseudo_mod:
   fixes f g :: "'a::{comm_ring_1,semiring_1_no_zero_divisors} poly"
   defines "r \<equiv> pseudo_mod f g"
   assumes g: "g \<noteq> 0"
   shows "\<exists>a q. a \<noteq> 0 \<and> smult a f = g * q + r" "r = 0 \<or> degree r < degree g"
 proof -
   let ?cg = "coeff g (degree g)"
   let ?cge = "?cg ^ (Suc (degree f) - degree g)"
   define a where "a = ?cge"
   from r_def[unfolded pseudo_mod_def] obtain q where pdm: "pseudo_divmod f g = (q, r)"
     by (cases "pseudo_divmod f g") auto
   from pseudo_divmod[OF g pdm] have id: "smult a f = g * q + r" and "r = 0 \<or> degree r < degree g"
     by (auto simp: a_def)
   show "r = 0 \<or> degree r < degree g" by fact
   from g have "a \<noteq> 0"
     by (auto simp: a_def)
   with id show "\<exists>a q. a \<noteq> 0 \<and> smult a f = g * q + r"
     by auto
 qed
 
 lemma fst_pseudo_divmod_main_as_divide_poly_main:
   assumes d: "d \<noteq> 0"
   defines lc: "lc \<equiv> coeff d (degree d)"
   shows "fst (pseudo_divmod_main lc q r d dr n) =
     divide_poly_main lc (smult (lc^n) q) (smult (lc^n) r) d dr n"
 proof (induct n arbitrary: q r dr)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   note lc0 = leading_coeff_neq_0[OF d, folded lc]
   then have "pseudo_divmod_main lc q r d dr (Suc n) =
     pseudo_divmod_main lc (smult lc q + monom (coeff r dr) n)
       (smult lc r - monom (coeff r dr) n * d) d (dr - 1) n"
     by (simp add: Let_def ac_simps)
   also have "fst \<dots> = divide_poly_main lc
      (smult (lc^n) (smult lc q + monom (coeff r dr) n))
      (smult (lc^n) (smult lc r - monom (coeff r dr) n * d))
      d (dr - 1) n"
     by (simp only: Suc[unfolded divide_poly_main.simps Let_def])
   also have "\<dots> = divide_poly_main lc (smult (lc ^ Suc n) q) (smult (lc ^ Suc n) r) d dr (Suc n)"
     unfolding smult_monom smult_distribs mult_smult_left[symmetric]
     using lc0 by (simp add: Let_def ac_simps)
   finally show ?case .
 qed
 
 
 subsubsection \<open>Division in polynomials over fields\<close>
 
 lemma pseudo_divmod_field:
   fixes g :: "'a::field poly"
   assumes g: "g \<noteq> 0"
     and *: "pseudo_divmod f g = (q,r)"
   defines "c \<equiv> coeff g (degree g) ^ (Suc (degree f) - degree g)"
   shows "f = g * smult (1/c) q + smult (1/c) r"
 proof -
   from leading_coeff_neq_0[OF g] have c0: "c \<noteq> 0"
     by (auto simp: c_def)
   from pseudo_divmod(1)[OF g *, folded c_def] have "smult c f = g * q + r"
     by auto
   also have "smult (1 / c) \<dots> = g * smult (1 / c) q + smult (1 / c) r"
     by (simp add: smult_add_right)
   finally show ?thesis
     using c0 by auto
 qed
 
 lemma divide_poly_main_field:
   fixes d :: "'a::field poly"
   assumes d: "d \<noteq> 0"
   defines lc: "lc \<equiv> coeff d (degree d)"
   shows "divide_poly_main lc q r d dr n =
     fst (pseudo_divmod_main lc (smult ((1 / lc)^n) q) (smult ((1 / lc)^n) r) d dr n)"
   unfolding lc by (subst fst_pseudo_divmod_main_as_divide_poly_main) (auto simp: d power_one_over)
 
 lemma divide_poly_field:
   fixes f g :: "'a::field poly"
   defines "f' \<equiv> smult ((1 / coeff g (degree g)) ^ (Suc (degree f) - degree g)) f"
   shows "f div g = fst (pseudo_divmod f' g)"
 proof (cases "g = 0")
   case True
   show ?thesis
     unfolding divide_poly_def pseudo_divmod_def Let_def f'_def True
     by (simp add: divide_poly_main_0)
 next
   case False
   from leading_coeff_neq_0[OF False] have "degree f' = degree f"
     by (auto simp: f'_def)
   then show ?thesis
     using length_coeffs_degree[of f'] length_coeffs_degree[of f]
     unfolding divide_poly_def pseudo_divmod_def Let_def
       divide_poly_main_field[OF False]
       length_coeffs_degree[OF False]
       f'_def
     by force
 qed
 
 instantiation poly :: ("{semidom_divide_unit_factor,idom_divide}") normalization_semidom
 begin
 
 definition unit_factor_poly :: "'a poly \<Rightarrow> 'a poly"
   where "unit_factor_poly p = [:unit_factor (lead_coeff p):]"
 
 definition normalize_poly :: "'a poly \<Rightarrow> 'a poly"
   where "normalize p = p div [:unit_factor (lead_coeff p):]"
 
 instance
 proof
   fix p :: "'a poly"
   show "unit_factor p * normalize p = p"
   proof (cases "p = 0")
     case True
     then show ?thesis
       by (simp add: unit_factor_poly_def normalize_poly_def)
   next
     case False
     then have "lead_coeff p \<noteq> 0"
       by simp
     then have *: "unit_factor (lead_coeff p) \<noteq> 0"
       using unit_factor_is_unit [of "lead_coeff p"] by auto
     then have "unit_factor (lead_coeff p) dvd 1"
       by (auto intro: unit_factor_is_unit)
     then have **: "unit_factor (lead_coeff p) dvd c" for c
       by (rule dvd_trans) simp
     have ***: "unit_factor (lead_coeff p) * (c div unit_factor (lead_coeff p)) = c" for c
     proof -
       from ** obtain b where "c = unit_factor (lead_coeff p) * b" ..
       with False * show ?thesis by simp
     qed
     have "p div [:unit_factor (lead_coeff p):] =
       map_poly (\<lambda>c. c div unit_factor (lead_coeff p)) p"
       by (simp add: const_poly_dvd_iff div_const_poly_conv_map_poly **)
     then show ?thesis
       by (simp add: normalize_poly_def unit_factor_poly_def
         smult_conv_map_poly map_poly_map_poly o_def ***)
   qed
 next
   fix p :: "'a poly"
   assume "is_unit p"
   then obtain c where p: "p = [:c:]" "c dvd 1"
     by (auto simp: is_unit_poly_iff)
   then show "unit_factor p = p"
     by (simp add: unit_factor_poly_def monom_0 is_unit_unit_factor)
 next
   fix p :: "'a poly"
   assume "p \<noteq> 0"
   then show "is_unit (unit_factor p)"
     by (simp add: unit_factor_poly_def monom_0 is_unit_poly_iff unit_factor_is_unit)
 next
   fix a b :: "'a poly" assume "is_unit a"
   thus "unit_factor (a * b) = a * unit_factor b"
     by (auto simp: unit_factor_poly_def lead_coeff_mult unit_factor_mult elim!: is_unit_polyE)
 qed (simp_all add: normalize_poly_def unit_factor_poly_def monom_0 lead_coeff_mult unit_factor_mult)
 
 end
 
 instance poly :: ("{semidom_divide_unit_factor,idom_divide,normalization_semidom_multiplicative}")
   normalization_semidom_multiplicative
   by intro_classes (auto simp: unit_factor_poly_def lead_coeff_mult unit_factor_mult)
 
 lemma normalize_poly_eq_map_poly: "normalize p = map_poly (\<lambda>x. x div unit_factor (lead_coeff p)) p"
 proof -
   have "[:unit_factor (lead_coeff p):] dvd p"
     by (metis unit_factor_poly_def unit_factor_self)
   then show ?thesis
     by (simp add: normalize_poly_def div_const_poly_conv_map_poly)
 qed
 
 lemma coeff_normalize [simp]:
   "coeff (normalize p) n = coeff p n div unit_factor (lead_coeff p)"
   by (simp add: normalize_poly_eq_map_poly coeff_map_poly)
 
 class field_unit_factor = field + unit_factor +
   assumes unit_factor_field [simp]: "unit_factor = id"
 begin
 
 subclass semidom_divide_unit_factor
 proof
   fix a
   assume "a \<noteq> 0"
   then have "1 = a * inverse a" by simp
   then have "a dvd 1" ..
   then show "unit_factor a dvd 1" by simp
 qed simp_all
 
 end
 
 lemma unit_factor_pCons:
   "unit_factor (pCons a p) = (if p = 0 then [:unit_factor a:] else unit_factor p)"
   by (simp add: unit_factor_poly_def)
 
 lemma normalize_monom [simp]: "normalize (monom a n) = monom (normalize a) n"
   by (cases "a = 0") (simp_all add: map_poly_monom normalize_poly_eq_map_poly degree_monom_eq)
 
 lemma unit_factor_monom [simp]: "unit_factor (monom a n) = [:unit_factor a:]"
   by (cases "a = 0") (simp_all add: unit_factor_poly_def degree_monom_eq)
 
 lemma normalize_const_poly: "normalize [:c:] = [:normalize c:]"
   by (simp add: normalize_poly_eq_map_poly map_poly_pCons)
 
 lemma normalize_smult:
   fixes c :: "'a :: {normalization_semidom_multiplicative, idom_divide}"
   shows "normalize (smult c p) = smult (normalize c) (normalize p)"
 proof -
   have "smult c p = [:c:] * p" by simp
   also have "normalize \<dots> = smult (normalize c) (normalize p)"
     by (subst normalize_mult) (simp add: normalize_const_poly)
   finally show ?thesis .
 qed
 
 inductive eucl_rel_poly :: "'a::field poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<times> 'a poly \<Rightarrow> bool"
   where
     eucl_rel_poly_by0: "eucl_rel_poly x 0 (0, x)"
   | eucl_rel_poly_dividesI: "y \<noteq> 0 \<Longrightarrow> x = q * y \<Longrightarrow> eucl_rel_poly x y (q, 0)"
   | eucl_rel_poly_remainderI:
       "y \<noteq> 0 \<Longrightarrow> degree r < degree y \<Longrightarrow> x = q * y + r \<Longrightarrow> eucl_rel_poly x y (q, r)"
 
 lemma eucl_rel_poly_iff:
   "eucl_rel_poly x y (q, r) \<longleftrightarrow>
     x = q * y + r \<and> (if y = 0 then q = 0 else r = 0 \<or> degree r < degree y)"
   by (auto elim: eucl_rel_poly.cases
       intro: eucl_rel_poly_by0 eucl_rel_poly_dividesI eucl_rel_poly_remainderI)
 
 lemma eucl_rel_poly_0: "eucl_rel_poly 0 y (0, 0)"
   by (simp add: eucl_rel_poly_iff)
 
 lemma eucl_rel_poly_by_0: "eucl_rel_poly x 0 (0, x)"
   by (simp add: eucl_rel_poly_iff)
 
 lemma eucl_rel_poly_pCons:
   assumes rel: "eucl_rel_poly x y (q, r)"
   assumes y: "y \<noteq> 0"
   assumes b: "b = coeff (pCons a r) (degree y) / coeff y (degree y)"
   shows "eucl_rel_poly (pCons a x) y (pCons b q, pCons a r - smult b y)"
     (is "eucl_rel_poly ?x y (?q, ?r)")
 proof -
   from assms have x: "x = q * y + r" and r: "r = 0 \<or> degree r < degree y"
     by (simp_all add: eucl_rel_poly_iff)
   from b x have "?x = ?q * y + ?r" by simp
   moreover
   have "?r = 0 \<or> degree ?r < degree y"
   proof (rule eq_zero_or_degree_less)
     show "degree ?r \<le> degree y"
     proof (rule degree_diff_le)
       from r show "degree (pCons a r) \<le> degree y"
         by auto
       show "degree (smult b y) \<le> degree y"
         by (rule degree_smult_le)
     qed
     from \<open>y \<noteq> 0\<close> show "coeff ?r (degree y) = 0"
       by (simp add: b)
   qed
   ultimately show ?thesis
     unfolding eucl_rel_poly_iff using \<open>y \<noteq> 0\<close> by simp
 qed
 
 lemma eucl_rel_poly_exists: "\<exists>q r. eucl_rel_poly x y (q, r)"
 proof (cases "y = 0")
   case False
   show ?thesis
   proof (induction x)
     case 0
     then show ?case
       using eucl_rel_poly_0 by blast
   next
     case (pCons a x)
     then show ?case
       using False eucl_rel_poly_pCons by blast
   qed
 qed (use eucl_rel_poly_by0 in blast)
 
 lemma eucl_rel_poly_unique:
   assumes 1: "eucl_rel_poly x y (q1, r1)"
   assumes 2: "eucl_rel_poly x y (q2, r2)"
   shows "q1 = q2 \<and> r1 = r2"
 proof (cases "y = 0")
   assume "y = 0"
   with assms show ?thesis
     by (simp add: eucl_rel_poly_iff)
 next
   assume [simp]: "y \<noteq> 0"
   from 1 have q1: "x = q1 * y + r1" and r1: "r1 = 0 \<or> degree r1 < degree y"
     unfolding eucl_rel_poly_iff by simp_all
   from 2 have q2: "x = q2 * y + r2" and r2: "r2 = 0 \<or> degree r2 < degree y"
     unfolding eucl_rel_poly_iff by simp_all
   from q1 q2 have q3: "(q1 - q2) * y = r2 - r1"
     by (simp add: algebra_simps)
   from r1 r2 have r3: "(r2 - r1) = 0 \<or> degree (r2 - r1) < degree y"
     by (auto intro: degree_diff_less)
   show "q1 = q2 \<and> r1 = r2"
   proof (rule classical)
     assume "\<not> ?thesis"
     with q3 have "q1 \<noteq> q2" and "r1 \<noteq> r2" by auto
     with r3 have "degree (r2 - r1) < degree y" by simp
     also have "degree y \<le> degree (q1 - q2) + degree y" by simp
     also from \<open>q1 \<noteq> q2\<close> have "\<dots> = degree ((q1 - q2) * y)"
       by (simp add: degree_mult_eq)
     also from q3 have "\<dots> = degree (r2 - r1)"
       by simp
     finally have "degree (r2 - r1) < degree (r2 - r1)" .
     then show ?thesis by simp
   qed
 qed
 
 lemma eucl_rel_poly_0_iff: "eucl_rel_poly 0 y (q, r) \<longleftrightarrow> q = 0 \<and> r = 0"
   by (auto dest: eucl_rel_poly_unique intro: eucl_rel_poly_0)
 
 lemma eucl_rel_poly_by_0_iff: "eucl_rel_poly x 0 (q, r) \<longleftrightarrow> q = 0 \<and> r = x"
   by (auto dest: eucl_rel_poly_unique intro: eucl_rel_poly_by_0)
 
 lemmas eucl_rel_poly_unique_div = eucl_rel_poly_unique [THEN conjunct1]
 
 lemmas eucl_rel_poly_unique_mod = eucl_rel_poly_unique [THEN conjunct2]
 
 instantiation poly :: (field) semidom_modulo
 begin
 
 definition modulo_poly :: "'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where mod_poly_def: "f mod g =
     (if g = 0 then f else pseudo_mod (smult ((1 / lead_coeff g) ^ (Suc (degree f) - degree g)) f) g)"
 
 instance
 proof
   fix x y :: "'a poly"
   show "x div y * y + x mod y = x"
   proof (cases "y = 0")
     case True
     then show ?thesis
       by (simp add: divide_poly_0 mod_poly_def)
   next
     case False
     then have "pseudo_divmod (smult ((1 / lead_coeff y) ^ (Suc (degree x) - degree y)) x) y =
         (x div y, x mod y)"
       by (simp add: divide_poly_field mod_poly_def pseudo_mod_def)
     with False pseudo_divmod [OF False this] show ?thesis
       by (simp add: power_mult_distrib [symmetric] ac_simps)
   qed
 qed
 
 end
 
 lemma eucl_rel_poly: "eucl_rel_poly x y (x div y, x mod y)"
   unfolding eucl_rel_poly_iff
 proof
   show "x = x div y * y + x mod y"
     by (simp add: div_mult_mod_eq)
   show "if y = 0 then x div y = 0 else x mod y = 0 \<or> degree (x mod y) < degree y"
   proof (cases "y = 0")
     case True
     then show ?thesis by auto
   next
     case False
     with pseudo_mod[OF this] show ?thesis
       by (simp add: mod_poly_def)
   qed
 qed
 
 lemma div_poly_eq: "eucl_rel_poly x y (q, r) \<Longrightarrow> x div y = q"
   for x :: "'a::field poly"
   by (rule eucl_rel_poly_unique_div [OF eucl_rel_poly])
 
 lemma mod_poly_eq: "eucl_rel_poly x y (q, r) \<Longrightarrow> x mod y = r"
   for x :: "'a::field poly"
   by (rule eucl_rel_poly_unique_mod [OF eucl_rel_poly])
 
 instance poly :: (field) idom_modulo ..
 
 lemma div_pCons_eq:
   "pCons a p div q =
     (if q = 0 then 0
      else pCons (coeff (pCons a (p mod q)) (degree q) / lead_coeff q) (p div q))"
   using eucl_rel_poly_pCons [OF eucl_rel_poly _ refl, of q a p]
   by (auto intro: div_poly_eq)
 
 lemma mod_pCons_eq:
   "pCons a p mod q =
     (if q = 0 then pCons a p
      else pCons a (p mod q) - smult (coeff (pCons a (p mod q)) (degree q) / lead_coeff q) q)"
   using eucl_rel_poly_pCons [OF eucl_rel_poly _ refl, of q a p]
   by (auto intro: mod_poly_eq)
 
 lemma div_mod_fold_coeffs:
   "(p div q, p mod q) =
     (if q = 0 then (0, p)
      else
       fold_coeffs
         (\<lambda>a (s, r).
           let b = coeff (pCons a r) (degree q) / coeff q (degree q)
           in (pCons b s, pCons a r - smult b q)) p (0, 0))"
   by (rule sym, induct p) (auto simp: div_pCons_eq mod_pCons_eq Let_def)
 
 lemma degree_mod_less: "y \<noteq> 0 \<Longrightarrow> x mod y = 0 \<or> degree (x mod y) < degree y"
   using eucl_rel_poly [of x y] unfolding eucl_rel_poly_iff by simp
 
 lemma degree_mod_less': "b \<noteq> 0 \<Longrightarrow> a mod b \<noteq> 0 \<Longrightarrow> degree (a mod b) < degree b"
   using degree_mod_less[of b a] by auto
 
 lemma div_poly_less:
   fixes x :: "'a::field poly"
   assumes "degree x < degree y"
   shows "x div y = 0"
 proof -
   from assms have "eucl_rel_poly x y (0, x)"
     by (simp add: eucl_rel_poly_iff)
   then show "x div y = 0"
     by (rule div_poly_eq)
 qed
 
 lemma mod_poly_less:
   assumes "degree x < degree y"
   shows "x mod y = x"
 proof -
   from assms have "eucl_rel_poly x y (0, x)"
     by (simp add: eucl_rel_poly_iff)
   then show "x mod y = x"
     by (rule mod_poly_eq)
 qed
 
 lemma eucl_rel_poly_smult_left:
   "eucl_rel_poly x y (q, r) \<Longrightarrow> eucl_rel_poly (smult a x) y (smult a q, smult a r)"
   by (simp add: eucl_rel_poly_iff smult_add_right)
 
 lemma div_smult_left: "(smult a x) div y = smult a (x div y)"
   for x y :: "'a::field poly"
   by (rule div_poly_eq, rule eucl_rel_poly_smult_left, rule eucl_rel_poly)
 
 lemma mod_smult_left: "(smult a x) mod y = smult a (x mod y)"
   by (rule mod_poly_eq, rule eucl_rel_poly_smult_left, rule eucl_rel_poly)
 
 lemma poly_div_minus_left [simp]: "(- x) div y = - (x div y)"
   for x y :: "'a::field poly"
   using div_smult_left [of "- 1::'a"] by simp
 
 lemma poly_mod_minus_left [simp]: "(- x) mod y = - (x mod y)"
   for x y :: "'a::field poly"
   using mod_smult_left [of "- 1::'a"] by simp
 
 lemma eucl_rel_poly_add_left:
   assumes "eucl_rel_poly x y (q, r)"
   assumes "eucl_rel_poly x' y (q', r')"
   shows "eucl_rel_poly (x + x') y (q + q', r + r')"
   using assms unfolding eucl_rel_poly_iff
   by (auto simp: algebra_simps degree_add_less)
 
 lemma poly_div_add_left: "(x + y) div z = x div z + y div z"
   for x y z :: "'a::field poly"
   using eucl_rel_poly_add_left [OF eucl_rel_poly eucl_rel_poly]
   by (rule div_poly_eq)
 
 lemma poly_mod_add_left: "(x + y) mod z = x mod z + y mod z"
   for x y z :: "'a::field poly"
   using eucl_rel_poly_add_left [OF eucl_rel_poly eucl_rel_poly]
   by (rule mod_poly_eq)
 
 lemma poly_div_diff_left: "(x - y) div z = x div z - y div z"
   for x y z :: "'a::field poly"
   by (simp only: diff_conv_add_uminus poly_div_add_left poly_div_minus_left)
 
 lemma poly_mod_diff_left: "(x - y) mod z = x mod z - y mod z"
   for x y z :: "'a::field poly"
   by (simp only: diff_conv_add_uminus poly_mod_add_left poly_mod_minus_left)
 
 lemma eucl_rel_poly_smult_right:
   "a \<noteq> 0 \<Longrightarrow> eucl_rel_poly x y (q, r) \<Longrightarrow> eucl_rel_poly x (smult a y) (smult (inverse a) q, r)"
   by (simp add: eucl_rel_poly_iff)
 
 lemma div_smult_right: "a \<noteq> 0 \<Longrightarrow> x div (smult a y) = smult (inverse a) (x div y)"
   for x y :: "'a::field poly"
   by (rule div_poly_eq, erule eucl_rel_poly_smult_right, rule eucl_rel_poly)
 
 lemma mod_smult_right: "a \<noteq> 0 \<Longrightarrow> x mod (smult a y) = x mod y"
   by (rule mod_poly_eq, erule eucl_rel_poly_smult_right, rule eucl_rel_poly)
 
 lemma poly_div_minus_right [simp]: "x div (- y) = - (x div y)"
   for x y :: "'a::field poly"
   using div_smult_right [of "- 1::'a"] by (simp add: nonzero_inverse_minus_eq)
 
 lemma poly_mod_minus_right [simp]: "x mod (- y) = x mod y"
   for x y :: "'a::field poly"
   using mod_smult_right [of "- 1::'a"] by simp
 
 lemma eucl_rel_poly_mult:
   assumes "eucl_rel_poly x y (q, r)" "eucl_rel_poly q z (q', r')"
   shows "eucl_rel_poly x (y * z) (q', y * r' + r)"
 proof (cases "y = 0")
   case True
   with assms eucl_rel_poly_0_iff show ?thesis
     by (force simp add: eucl_rel_poly_iff)
 next
   case False
   show ?thesis
   proof (cases "r' = 0")
     case True
     with assms show ?thesis
       by (auto simp add: eucl_rel_poly_iff degree_mult_eq)
   next
     case False
     with assms \<open>y \<noteq> 0\<close> show ?thesis
       by (auto simp add: eucl_rel_poly_iff degree_add_less degree_mult_eq field_simps)
   qed
 qed
 
 lemma poly_div_mult_right: "x div (y * z) = (x div y) div z"
   for x y z :: "'a::field poly"
   by (rule div_poly_eq, rule eucl_rel_poly_mult, (rule eucl_rel_poly)+)
 
 lemma poly_mod_mult_right: "x mod (y * z) = y * (x div y mod z) + x mod y"
   for x y z :: "'a::field poly"
   by (rule mod_poly_eq, rule eucl_rel_poly_mult, (rule eucl_rel_poly)+)
 
 lemma mod_pCons:
   fixes a :: "'a::field"
     and x y :: "'a::field poly"
   assumes y: "y \<noteq> 0"
   defines "b \<equiv> coeff (pCons a (x mod y)) (degree y) / coeff y (degree y)"
   shows "(pCons a x) mod y = pCons a (x mod y) - smult b y"
   unfolding b_def
   by (rule mod_poly_eq, rule eucl_rel_poly_pCons [OF eucl_rel_poly y refl])
 
 
 subsubsection \<open>List-based versions for fast implementation\<close>
 (* Subsection by:
       Sebastiaan Joosten
       René Thiemann
       Akihisa Yamada
     *)
 fun minus_poly_rev_list :: "'a :: group_add list \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where
     "minus_poly_rev_list (x # xs) (y # ys) = (x - y) # (minus_poly_rev_list xs ys)"
   | "minus_poly_rev_list xs [] = xs"
   | "minus_poly_rev_list [] (y # ys) = []"
 
 fun pseudo_divmod_main_list ::
   "'a::comm_ring_1 \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a list \<times> 'a list"
   where
     "pseudo_divmod_main_list lc q r d (Suc n) =
       (let
         rr = map ((*) lc) r;
         a = hd r;
         qqq = cCons a (map ((*) lc) q);
         rrr = tl (if a = 0 then rr else minus_poly_rev_list rr (map ((*) a) d))
        in pseudo_divmod_main_list lc qqq rrr d n)"
   | "pseudo_divmod_main_list lc q r d 0 = (q, r)"
 
 fun pseudo_mod_main_list :: "'a::comm_ring_1 \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a list"
   where
     "pseudo_mod_main_list lc r d (Suc n) =
       (let
         rr = map ((*) lc) r;
         a = hd r;
         rrr = tl (if a = 0 then rr else minus_poly_rev_list rr (map ((*) a) d))
        in pseudo_mod_main_list lc rrr d n)"
   | "pseudo_mod_main_list lc r d 0 = r"
 
 
 fun divmod_poly_one_main_list ::
     "'a::comm_ring_1 list \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a list \<times> 'a list"
   where
     "divmod_poly_one_main_list q r d (Suc n) =
       (let
         a = hd r;
         qqq = cCons a q;
         rr = tl (if a = 0 then r else minus_poly_rev_list r (map ((*) a) d))
        in divmod_poly_one_main_list qqq rr d n)"
   | "divmod_poly_one_main_list q r d 0 = (q, r)"
 
 fun mod_poly_one_main_list :: "'a::comm_ring_1 list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a list"
   where
     "mod_poly_one_main_list r d (Suc n) =
       (let
         a = hd r;
         rr = tl (if a = 0 then r else minus_poly_rev_list r (map ((*) a) d))
        in mod_poly_one_main_list rr d n)"
   | "mod_poly_one_main_list r d 0 = r"
 
 definition pseudo_divmod_list :: "'a::comm_ring_1 list \<Rightarrow> 'a list \<Rightarrow> 'a list \<times> 'a list"
   where "pseudo_divmod_list p q =
     (if q = [] then ([], p)
      else
       (let rq = rev q;
         (qu,re) = pseudo_divmod_main_list (hd rq) [] (rev p) rq (1 + length p - length q)
        in (qu, rev re)))"
 
 definition pseudo_mod_list :: "'a::comm_ring_1 list \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where "pseudo_mod_list p q =
     (if q = [] then p
      else
       (let
         rq = rev q;
         re = pseudo_mod_main_list (hd rq) (rev p) rq (1 + length p - length q)
        in rev re))"
 
 lemma minus_zero_does_nothing: "minus_poly_rev_list x (map ((*) 0) y) = x"
   for x :: "'a::ring list"
   by (induct x y rule: minus_poly_rev_list.induct) auto
 
 lemma length_minus_poly_rev_list [simp]: "length (minus_poly_rev_list xs ys) = length xs"
   by (induct xs ys rule: minus_poly_rev_list.induct) auto
 
 lemma if_0_minus_poly_rev_list:
   "(if a = 0 then x else minus_poly_rev_list x (map ((*) a) y)) =
     minus_poly_rev_list x (map ((*) a) y)"
   for a :: "'a::ring"
   by(cases "a = 0") (simp_all add: minus_zero_does_nothing)
 
 lemma Poly_append: "Poly (a @ b) = Poly a + monom 1 (length a) * Poly b"
   for a :: "'a::comm_semiring_1 list"
   by (induct a) (auto simp: monom_0 monom_Suc)
 
 lemma minus_poly_rev_list: "length p \<ge> length q \<Longrightarrow>
   Poly (rev (minus_poly_rev_list (rev p) (rev q))) =
     Poly p - monom 1 (length p - length q) * Poly q"
   for p q :: "'a :: comm_ring_1 list"
 proof (induct "rev p" "rev q" arbitrary: p q rule: minus_poly_rev_list.induct)
   case (1 x xs y ys)
   then have "length (rev q) \<le> length (rev p)"
     by simp
   from this[folded 1(2,3)] have ys_xs: "length ys \<le> length xs"
     by simp
   then have *: "Poly (rev (minus_poly_rev_list xs ys)) =
       Poly (rev xs) - monom 1 (length xs - length ys) * Poly (rev ys)"
     by (subst "1.hyps"(1)[of "rev xs" "rev ys", unfolded rev_rev_ident length_rev]) auto
   have "Poly p - monom 1 (length p - length q) * Poly q =
     Poly (rev (rev p)) - monom 1 (length (rev (rev p)) - length (rev (rev q))) * Poly (rev (rev q))"
     by simp
   also have "\<dots> =
       Poly (rev (x # xs)) - monom 1 (length (x # xs) - length (y # ys)) * Poly (rev (y # ys))"
     unfolding 1(2,3) by simp
   also from ys_xs have "\<dots> =
     Poly (rev xs) + monom x (length xs) -
       (monom 1 (length xs - length ys) * Poly (rev ys) + monom y (length xs))"
     by (simp add: Poly_append distrib_left mult_monom smult_monom)
   also have "\<dots> = Poly (rev (minus_poly_rev_list xs ys)) + monom (x - y) (length xs)"
     unfolding * diff_monom[symmetric] by simp
   finally show ?case
     by (simp add: 1(2,3)[symmetric] smult_monom Poly_append)
 qed auto
 
 lemma smult_monom_mult: "smult a (monom b n * f) = monom (a * b) n * f"
   using smult_monom [of a _ n] by (metis mult_smult_left)
 
 lemma head_minus_poly_rev_list:
   "length d \<le> length r \<Longrightarrow> d \<noteq> [] \<Longrightarrow>
     hd (minus_poly_rev_list (map ((*) (last d)) r) (map ((*) (hd r)) (rev d))) = 0"
   for d r :: "'a::comm_ring list"
 proof (induct r)
   case Nil
   then show ?case by simp
 next
   case (Cons a rs)
   then show ?case by (cases "rev d") (simp_all add: ac_simps)
 qed
 
 lemma Poly_map: "Poly (map ((*) a) p) = smult a (Poly p)"
 proof (induct p)
   case Nil
   then show ?case by simp
 next
   case (Cons x xs)
   then show ?case by (cases "Poly xs = 0") auto
 qed
 
 lemma last_coeff_is_hd: "xs \<noteq> [] \<Longrightarrow> coeff (Poly xs) (length xs - 1) = hd (rev xs)"
   by (simp_all add: hd_conv_nth rev_nth nth_default_nth nth_append)
 
 lemma pseudo_divmod_main_list_invar:
   assumes leading_nonzero: "last d \<noteq> 0"
     and lc: "last d = lc"
     and "d \<noteq> []"
     and "pseudo_divmod_main_list lc q (rev r) (rev d) n = (q', rev r')"
     and "n = 1 + length r - length d"
   shows "pseudo_divmod_main lc (monom 1 n * Poly q) (Poly r) (Poly d) (length r - 1) n =
     (Poly q', Poly r')"
   using assms(4-)
 proof (induct n arbitrary: r q)
   case (Suc n)
   from Suc.prems have *: "\<not> Suc (length r) \<le> length d"
     by simp
   with \<open>d \<noteq> []\<close> have "r \<noteq> []"
     using Suc_leI length_greater_0_conv list.size(3) by fastforce
   let ?a = "(hd (rev r))"
   let ?rr = "map ((*) lc) (rev r)"
   let ?rrr = "rev (tl (minus_poly_rev_list ?rr (map ((*) ?a) (rev d))))"
   let ?qq = "cCons ?a (map ((*) lc) q)"
   from * Suc(3) have n: "n = (1 + length r - length d - 1)"
     by simp
   from * have rr_val:"(length ?rrr) = (length r - 1)"
     by auto
   with \<open>r \<noteq> []\<close> * have rr_smaller: "(1 + length r - length d - 1) = (1 + length ?rrr - length d)"
     by auto
   from * have id: "Suc (length r) - length d = Suc (length r - length d)"
     by auto
   from Suc.prems *
   have "pseudo_divmod_main_list lc ?qq (rev ?rrr) (rev d) (1 + length r - length d - 1) = (q', rev r')"
     by (simp add: Let_def if_0_minus_poly_rev_list id)
   with n have v: "pseudo_divmod_main_list lc ?qq (rev ?rrr) (rev d) n = (q', rev r')"
     by auto
   from * have sucrr:"Suc (length r) - length d = Suc (length r - length d)"
     using Suc_diff_le not_less_eq_eq by blast
   from Suc(3) \<open>r \<noteq> []\<close> have n_ok : "n = 1 + (length ?rrr) - length d"
     by simp
   have cong: "\<And>x1 x2 x3 x4 y1 y2 y3 y4. x1 = y1 \<Longrightarrow> x2 = y2 \<Longrightarrow> x3 = y3 \<Longrightarrow> x4 = y4 \<Longrightarrow>
       pseudo_divmod_main lc x1 x2 x3 x4 n = pseudo_divmod_main lc y1 y2 y3 y4 n"
     by simp
   have hd_rev: "coeff (Poly r) (length r - Suc 0) = hd (rev r)"
     using last_coeff_is_hd[OF \<open>r \<noteq> []\<close>] by simp
   show ?case
     unfolding Suc.hyps(1)[OF v n_ok, symmetric] pseudo_divmod_main.simps Let_def
   proof (rule cong[OF _ _ refl], goal_cases)
     case 1
     show ?case
       by (simp add: monom_Suc hd_rev[symmetric] smult_monom Poly_map)
   next
     case 2
     show ?case
     proof (subst Poly_on_rev_starting_with_0, goal_cases)
       show "hd (minus_poly_rev_list (map ((*) lc) (rev r)) (map ((*) (hd (rev r))) (rev d))) = 0"
         by (fold lc, subst head_minus_poly_rev_list, insert * \<open>d \<noteq> []\<close>, auto)
       from * have "length d \<le> length r"
         by simp
       then show "smult lc (Poly r) - monom (coeff (Poly r) (length r - 1)) n * Poly d =
           Poly (rev (minus_poly_rev_list (map ((*) lc) (rev r)) (map ((*) (hd (rev r))) (rev d))))"
         by (fold rev_map) (auto simp add: n smult_monom_mult Poly_map hd_rev [symmetric]
             minus_poly_rev_list)
     qed
   qed simp
 qed simp
 
 lemma pseudo_divmod_impl [code]:
   "pseudo_divmod f g = map_prod poly_of_list poly_of_list (pseudo_divmod_list (coeffs f) (coeffs g))"
     for f g :: "'a::comm_ring_1 poly"
 proof (cases "g = 0")
   case False
   then have "last (coeffs g) \<noteq> 0"
     and "last (coeffs g) = lead_coeff g"
     and "coeffs g \<noteq> []"
     by (simp_all add: last_coeffs_eq_coeff_degree)
   moreover obtain q r where qr: "pseudo_divmod_main_list
     (last (coeffs g)) (rev [])
     (rev (coeffs f)) (rev (coeffs g))
     (1 + length (coeffs f) -
     length (coeffs g)) = (q, rev (rev r))"
     by force
   ultimately have "(Poly q, Poly (rev r)) = pseudo_divmod_main (lead_coeff g) 0 f g
     (length (coeffs f) - Suc 0) (Suc (length (coeffs f)) - length (coeffs g))"
     by (subst pseudo_divmod_main_list_invar [symmetric]) auto
   moreover have "pseudo_divmod_main_list
     (hd (rev (coeffs g))) []
     (rev (coeffs f)) (rev (coeffs g))
     (1 + length (coeffs f) -
     length (coeffs g)) = (q, r)"
     by (metis hd_rev qr rev.simps(1) rev_swap)
   ultimately show ?thesis
     by (simp add: degree_eq_length_coeffs pseudo_divmod_def pseudo_divmod_list_def)
 next
   case True
   then show ?thesis
     by (auto simp add: pseudo_divmod_def pseudo_divmod_list_def)
 qed
 
 lemma pseudo_mod_main_list:
   "snd (pseudo_divmod_main_list l q xs ys n) = pseudo_mod_main_list l xs ys n"
   by (induct n arbitrary: l q xs ys) (auto simp: Let_def)
 
 lemma pseudo_mod_impl[code]: "pseudo_mod f g = poly_of_list (pseudo_mod_list (coeffs f) (coeffs g))"
 proof -
   have snd_case: "\<And>f g p. snd ((\<lambda>(x,y). (f x, g y)) p) = g (snd p)"
     by auto
   show ?thesis
     unfolding pseudo_mod_def pseudo_divmod_impl pseudo_divmod_list_def
       pseudo_mod_list_def Let_def
     by (simp add: snd_case pseudo_mod_main_list)
 qed
 
 
 subsubsection \<open>Improved Code-Equations for Polynomial (Pseudo) Division\<close>
 
 lemma pdivmod_pdivmodrel: "eucl_rel_poly p q (r, s) \<longleftrightarrow> (p div q, p mod q) = (r, s)"
   by (metis eucl_rel_poly eucl_rel_poly_unique)
 
 lemma pdivmod_via_pseudo_divmod:
   "(f div g, f mod g) =
     (if g = 0 then (0, f)
      else
       let
         ilc = inverse (coeff g (degree g));
         h = smult ilc g;
         (q,r) = pseudo_divmod f h
       in (smult ilc q, r))"
   (is "?l = ?r")
 proof (cases "g = 0")
   case True
   then show ?thesis by simp
 next
   case False
   define lc where "lc = inverse (coeff g (degree g))"
   define h where "h = smult lc g"
   from False have h1: "coeff h (degree h) = 1" and lc: "lc \<noteq> 0"
     by (auto simp: h_def lc_def)
   then have h0: "h \<noteq> 0"
     by auto
   obtain q r where p: "pseudo_divmod f h = (q, r)"
     by force
   from False have id: "?r = (smult lc q, r)"
     by (auto simp: Let_def h_def[symmetric] lc_def[symmetric] p)
   from pseudo_divmod[OF h0 p, unfolded h1]
   have f: "f = h * q + r" and r: "r = 0 \<or> degree r < degree h"
     by auto
   from f r h0 have "eucl_rel_poly f h (q, r)"
     by (auto simp: eucl_rel_poly_iff)
   then have "(f div h, f mod h) = (q, r)"
     by (simp add: pdivmod_pdivmodrel)
   with lc have "(f div g, f mod g) = (smult lc q, r)"
     by (auto simp: h_def div_smult_right[OF lc] mod_smult_right[OF lc])
   with id show ?thesis
     by auto
 qed
 
 lemma pdivmod_via_pseudo_divmod_list:
   "(f div g, f mod g) =
     (let cg = coeffs g in
       if cg = [] then (0, f)
       else
         let
           cf = coeffs f;
           ilc = inverse (last cg);
           ch = map ((*) ilc) cg;
           (q, r) = pseudo_divmod_main_list 1 [] (rev cf) (rev ch) (1 + length cf - length cg)
         in (poly_of_list (map ((*) ilc) q), poly_of_list (rev r)))"
 proof -
   note d = pdivmod_via_pseudo_divmod pseudo_divmod_impl pseudo_divmod_list_def
   show ?thesis
   proof (cases "g = 0")
     case True
     with d show ?thesis by auto
   next
     case False
     define ilc where "ilc = inverse (coeff g (degree g))"
     from False have ilc: "ilc \<noteq> 0"
       by (auto simp: ilc_def)
     with False have id: "g = 0 \<longleftrightarrow> False" "coeffs g = [] \<longleftrightarrow> False"
       "last (coeffs g) = coeff g (degree g)"
       "coeffs (smult ilc g) = [] \<longleftrightarrow> False"
       by (auto simp: last_coeffs_eq_coeff_degree)
     have id2: "hd (rev (coeffs (smult ilc g))) = 1"
       by (subst hd_rev, insert id ilc, auto simp: coeffs_smult, subst last_map, auto simp: id ilc_def)
     have id3: "length (coeffs (smult ilc g)) = length (coeffs g)"
       "rev (coeffs (smult ilc g)) = rev (map ((*) ilc) (coeffs g))"
       unfolding coeffs_smult using ilc by auto
     obtain q r where pair:
       "pseudo_divmod_main_list 1 [] (rev (coeffs f)) (rev (map ((*) ilc) (coeffs g)))
         (1 + length (coeffs f) - length (coeffs g)) = (q, r)"
       by force
     show ?thesis
       unfolding d Let_def id if_False ilc_def[symmetric] map_prod_def[symmetric] id2
       unfolding id3 pair map_prod_def split
       by (auto simp: Poly_map)
   qed
 qed
 
 lemma pseudo_divmod_main_list_1: "pseudo_divmod_main_list 1 = divmod_poly_one_main_list"
 proof (intro ext, goal_cases)
   case (1 q r d n)
   have *: "map ((*) 1) xs = xs" for xs :: "'a list"
     by (induct xs) auto
   show ?case
     by (induct n arbitrary: q r d) (auto simp: * Let_def)
 qed
 
 fun divide_poly_main_list :: "'a::idom_divide \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a list"
   where
     "divide_poly_main_list lc q r d (Suc n) =
       (let
         cr = hd r
         in if cr = 0 then divide_poly_main_list lc (cCons cr q) (tl r) d n else let
         a = cr div lc;
         qq = cCons a q;
         rr = minus_poly_rev_list r (map ((*) a) d)
        in if hd rr = 0 then divide_poly_main_list lc qq (tl rr) d n else [])"
   | "divide_poly_main_list lc q r d 0 = q"
 
 lemma divide_poly_main_list_simp [simp]:
   "divide_poly_main_list lc q r d (Suc n) =
     (let
       cr = hd r;
       a = cr div lc;
       qq = cCons a q;
       rr = minus_poly_rev_list r (map ((*) a) d)
      in if hd rr = 0 then divide_poly_main_list lc qq (tl rr) d n else [])"
   by (simp add: Let_def minus_zero_does_nothing)
 
 declare divide_poly_main_list.simps(1)[simp del]
 
 definition divide_poly_list :: "'a::idom_divide poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "divide_poly_list f g =
     (let cg = coeffs g in
       if cg = [] then g
       else
         let
           cf = coeffs f;
           cgr = rev cg
         in poly_of_list (divide_poly_main_list (hd cgr) [] (rev cf) cgr (1 + length cf - length cg)))"
 
 lemmas pdivmod_via_divmod_list = pdivmod_via_pseudo_divmod_list[unfolded pseudo_divmod_main_list_1]
 
 lemma mod_poly_one_main_list: "snd (divmod_poly_one_main_list q r d n) = mod_poly_one_main_list r d n"
   by (induct n arbitrary: q r d) (auto simp: Let_def)
 
 lemma mod_poly_code [code]:
   "f mod g =
     (let cg = coeffs g in
       if cg = [] then f
       else
         let
           cf = coeffs f;
           ilc = inverse (last cg);
           ch = map ((*) ilc) cg;
           r = mod_poly_one_main_list (rev cf) (rev ch) (1 + length cf - length cg)
         in poly_of_list (rev r))"
   (is "_ = ?rhs")
 proof -
   have "snd (f div g, f mod g) = ?rhs"
     unfolding pdivmod_via_divmod_list Let_def mod_poly_one_main_list [symmetric, of _ _ _ Nil]
     by (auto split: prod.splits)
   then show ?thesis by simp
 qed
 
 definition div_field_poly_impl :: "'a :: field poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "div_field_poly_impl f g =
     (let cg = coeffs g in
       if cg = [] then 0
       else
         let
           cf = coeffs f;
           ilc = inverse (last cg);
           ch = map ((*) ilc) cg;
           q = fst (divmod_poly_one_main_list [] (rev cf) (rev ch) (1 + length cf - length cg))
         in poly_of_list ((map ((*) ilc) q)))"
 
 text \<open>We do not declare the following lemma as code equation, since then polynomial division
   on non-fields will no longer be executable. However, a code-unfold is possible, since
   \<open>div_field_poly_impl\<close> is a bit more efficient than the generic polynomial division.\<close>
 lemma div_field_poly_impl[code_unfold]: "(div) = div_field_poly_impl"
 proof (intro ext)
   fix f g :: "'a poly"
   have "fst (f div g, f mod g) = div_field_poly_impl f g"
     unfolding div_field_poly_impl_def pdivmod_via_divmod_list Let_def
     by (auto split: prod.splits)
   then show "f div g =  div_field_poly_impl f g"
     by simp
 qed
 
 lemma divide_poly_main_list:
   assumes lc0: "lc \<noteq> 0"
     and lc: "last d = lc"
     and d: "d \<noteq> []"
     and "n = (1 + length r - length d)"
   shows "Poly (divide_poly_main_list lc q (rev r) (rev d) n) =
     divide_poly_main lc (monom 1 n * Poly q) (Poly r) (Poly d) (length r - 1) n"
   using assms(4-)
 proof (induct "n" arbitrary: r q)
   case (Suc n)
   from Suc.prems have ifCond: "\<not> Suc (length r) \<le> length d"
     by simp
   with d have r: "r \<noteq> []"
     using Suc_leI length_greater_0_conv list.size(3) by fastforce
   then obtain rr lcr where r: "r = rr @ [lcr]"
     by (cases r rule: rev_cases) auto
   from d lc obtain dd where d: "d = dd @ [lc]"
     by (cases d rule: rev_cases) auto
   from Suc(2) ifCond have n: "n = 1 + length rr - length d"
     by (auto simp: r)
   from ifCond have len: "length dd \<le> length rr"
     by (simp add: r d)
   show ?case
   proof (cases "lcr div lc * lc = lcr")
     case False
     with r d show ?thesis
       unfolding Suc(2)[symmetric]
       by (auto simp add: Let_def nth_default_append)
   next
     case True
     with r d have id:
       "?thesis \<longleftrightarrow>
         Poly (divide_poly_main_list lc (cCons (lcr div lc) q)
           (rev (rev (minus_poly_rev_list (rev rr) (rev (map ((*) (lcr div lc)) dd))))) (rev d) n) =
           divide_poly_main lc
             (monom 1 (Suc n) * Poly q + monom (lcr div lc) n)
             (Poly r - monom (lcr div lc) n * Poly d)
             (Poly d) (length rr - 1) n"
       by (cases r rule: rev_cases; cases "d" rule: rev_cases)
         (auto simp add: Let_def rev_map nth_default_append)
     have cong: "\<And>x1 x2 x3 x4 y1 y2 y3 y4. x1 = y1 \<Longrightarrow> x2 = y2 \<Longrightarrow> x3 = y3 \<Longrightarrow> x4 = y4 \<Longrightarrow>
         divide_poly_main lc x1 x2 x3 x4 n = divide_poly_main lc y1 y2 y3 y4 n"
       by simp
     show ?thesis
       unfolding id
     proof (subst Suc(1), simp add: n,
         subst minus_poly_rev_list, force simp: len, rule cong[OF _ _ refl], goal_cases)
       case 2
       have "monom lcr (length rr) = monom (lcr div lc) (length rr - length dd) * monom lc (length dd)"
         by (simp add: mult_monom len True)
       then show ?case unfolding r d Poly_append n ring_distribs
         by (auto simp: Poly_map smult_monom smult_monom_mult)
     qed (auto simp: len monom_Suc smult_monom)
   qed
 qed simp
 
 lemma divide_poly_list[code]: "f div g = divide_poly_list f g"
 proof -
   note d = divide_poly_def divide_poly_list_def
   show ?thesis
   proof (cases "g = 0")
     case True
     show ?thesis by (auto simp: d True)
   next
     case False
     then obtain cg lcg where cg: "coeffs g = cg @ [lcg]"
       by (cases "coeffs g" rule: rev_cases) auto
     with False have id: "(g = 0) = False" "(cg @ [lcg] = []) = False"
       by auto
     from cg False have lcg: "coeff g (degree g) = lcg"
       using last_coeffs_eq_coeff_degree last_snoc by force
     with False have "lcg \<noteq> 0" by auto
     from cg Poly_coeffs [of g] have ltp: "Poly (cg @ [lcg]) = g"
       by auto
     show ?thesis
       unfolding d cg Let_def id if_False poly_of_list_def
       by (subst divide_poly_main_list, insert False cg \<open>lcg \<noteq> 0\<close>)
         (auto simp: lcg ltp, simp add: degree_eq_length_coeffs)
   qed
 qed
 
 
 subsection \<open>Primality and irreducibility in polynomial rings\<close>
 
 lemma prod_mset_const_poly: "(\<Prod>x\<in>#A. [:f x:]) = [:prod_mset (image_mset f A):]"
   by (induct A) (simp_all add: ac_simps)
 
 lemma irreducible_const_poly_iff:
   fixes c :: "'a :: {comm_semiring_1,semiring_no_zero_divisors}"
   shows "irreducible [:c:] \<longleftrightarrow> irreducible c"
 proof
   assume A: "irreducible c"
   show "irreducible [:c:]"
   proof (rule irreducibleI)
     fix a b assume ab: "[:c:] = a * b"
     hence "degree [:c:] = degree (a * b)" by (simp only: )
     also from A ab have "a \<noteq> 0" "b \<noteq> 0" by auto
     hence "degree (a * b) = degree a + degree b" by (simp add: degree_mult_eq)
     finally have "degree a = 0" "degree b = 0" by auto
     then obtain a' b' where ab': "a = [:a':]" "b = [:b':]" by (auto elim!: degree_eq_zeroE)
     from ab have "coeff [:c:] 0 = coeff (a * b) 0" by (simp only: )
     hence "c = a' * b'" by (simp add: ab' mult_ac)
     from A and this have "a' dvd 1 \<or> b' dvd 1" by (rule irreducibleD)
     with ab' show "a dvd 1 \<or> b dvd 1"
       by (auto simp add: is_unit_const_poly_iff)
   qed (insert A, auto simp: irreducible_def is_unit_poly_iff)
 next
   assume A: "irreducible [:c:]"
   then have "c \<noteq> 0" and "\<not> c dvd 1"
     by (auto simp add: irreducible_def is_unit_const_poly_iff)
   then show "irreducible c"
   proof (rule irreducibleI)
     fix a b assume ab: "c = a * b"
     hence "[:c:] = [:a:] * [:b:]" by (simp add: mult_ac)
     from A and this have "[:a:] dvd 1 \<or> [:b:] dvd 1" by (rule irreducibleD)
     then show "a dvd 1 \<or> b dvd 1"
       by (auto simp add: is_unit_const_poly_iff)
   qed
 qed
 
 lemma lift_prime_elem_poly:
   assumes "prime_elem (c :: 'a :: semidom)"
   shows   "prime_elem [:c:]"
 proof (rule prime_elemI)
   fix a b assume *: "[:c:] dvd a * b"
   from * have dvd: "c dvd coeff (a * b) n" for n
     by (subst (asm) const_poly_dvd_iff) blast
   {
     define m where "m = (GREATEST m. \<not>c dvd coeff b m)"
     assume "\<not>[:c:] dvd b"
     hence A: "\<exists>i. \<not>c dvd coeff b i" by (subst (asm) const_poly_dvd_iff) blast
     have B: "\<And>i. \<not>c dvd coeff b i \<Longrightarrow> i \<le> degree b"
       by (auto intro: le_degree)
     have coeff_m: "\<not>c dvd coeff b m" unfolding m_def by (rule GreatestI_ex_nat[OF A B])
     have "i \<le> m" if "\<not>c dvd coeff b i" for i
       unfolding m_def by (metis (mono_tags, lifting) B Greatest_le_nat that)
     hence dvd_b: "c dvd coeff b i" if "i > m" for i using that by force
 
     have "c dvd coeff a i" for i
     proof (induction i rule: nat_descend_induct[of "degree a"])
       case (base i)
       thus ?case by (simp add: coeff_eq_0)
     next
       case (descend i)
       let ?A = "{..i+m} - {i}"
       have "c dvd coeff (a * b) (i + m)" by (rule dvd)
       also have "coeff (a * b) (i + m) = (\<Sum>k\<le>i + m. coeff a k * coeff b (i + m - k))"
         by (simp add: coeff_mult)
       also have "{..i+m} = insert i ?A" by auto
       also have "(\<Sum>k\<in>\<dots>. coeff a k * coeff b (i + m - k)) =
                    coeff a i * coeff b m + (\<Sum>k\<in>?A. coeff a k * coeff b (i + m - k))"
         (is "_ = _ + ?S")
         by (subst sum.insert) simp_all
       finally have eq: "c dvd coeff a i * coeff b m + ?S" .
       moreover have "c dvd ?S"
       proof (rule dvd_sum)
         fix k assume k: "k \<in> {..i+m} - {i}"
         show "c dvd coeff a k * coeff b (i + m - k)"
         proof (cases "k < i")
           case False
           with k have "c dvd coeff a k" by (intro descend.IH) simp
           thus ?thesis by simp
         next
           case True
           hence "c dvd coeff b (i + m - k)" by (intro dvd_b) simp
           thus ?thesis by simp
         qed
       qed
       ultimately have "c dvd coeff a i * coeff b m"
         by (simp add: dvd_add_left_iff)
       with assms coeff_m show "c dvd coeff a i"
         by (simp add: prime_elem_dvd_mult_iff)
     qed
     hence "[:c:] dvd a" by (subst const_poly_dvd_iff) blast
   }
   then show "[:c:] dvd a \<or> [:c:] dvd b" by blast
 next
   from assms show "[:c:] \<noteq> 0" and "\<not> [:c:] dvd 1"
     by (simp_all add: prime_elem_def is_unit_const_poly_iff)
 qed
 
 lemma prime_elem_const_poly_iff:
   fixes c :: "'a :: semidom"
   shows   "prime_elem [:c:] \<longleftrightarrow> prime_elem c"
 proof
   assume A: "prime_elem [:c:]"
   show "prime_elem c"
   proof (rule prime_elemI)
     fix a b assume "c dvd a * b"
     hence "[:c:] dvd [:a:] * [:b:]" by (simp add: mult_ac)
     from A and this have "[:c:] dvd [:a:] \<or> [:c:] dvd [:b:]" by (rule prime_elem_dvd_multD)
     thus "c dvd a \<or> c dvd b" by simp
   qed (insert A, auto simp: prime_elem_def is_unit_poly_iff)
 qed (auto intro: lift_prime_elem_poly)
 
 
 subsection \<open>Content and primitive part of a polynomial\<close>
 
 definition content :: "'a::semiring_gcd poly \<Rightarrow> 'a"
   where "content p = gcd_list (coeffs p)"
 
 lemma content_eq_fold_coeffs [code]: "content p = fold_coeffs gcd p 0"
   by (simp add: content_def Gcd_fin.set_eq_fold fold_coeffs_def foldr_fold fun_eq_iff ac_simps)
 
 lemma content_0 [simp]: "content 0 = 0"
   by (simp add: content_def)
 
 lemma content_1 [simp]: "content 1 = 1"
   by (simp add: content_def)
 
 lemma content_const [simp]: "content [:c:] = normalize c"
   by (simp add: content_def cCons_def)
 
 lemma const_poly_dvd_iff_dvd_content: "[:c:] dvd p \<longleftrightarrow> c dvd content p"
   for c :: "'a::semiring_gcd"
 proof (cases "p = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "[:c:] dvd p \<longleftrightarrow> (\<forall>n. c dvd coeff p n)"
     by (rule const_poly_dvd_iff)
   also have "\<dots> \<longleftrightarrow> (\<forall>a\<in>set (coeffs p). c dvd a)"
   proof safe
     fix n :: nat
     assume "\<forall>a\<in>set (coeffs p). c dvd a"
     then show "c dvd coeff p n"
       by (cases "n \<le> degree p") (auto simp: coeff_eq_0 coeffs_def split: if_splits)
   qed (auto simp: coeffs_def simp del: upt_Suc split: if_splits)
   also have "\<dots> \<longleftrightarrow> c dvd content p"
     by (simp add: content_def dvd_Gcd_fin_iff dvd_mult_unit_iff)
   finally show ?thesis .
 qed
 
 lemma content_dvd [simp]: "[:content p:] dvd p"
   by (subst const_poly_dvd_iff_dvd_content) simp_all
 
 lemma content_dvd_coeff [simp]: "content p dvd coeff p n"
 proof (cases "p = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   then show ?thesis
     by (cases "n \<le> degree p")
       (auto simp add: content_def not_le coeff_eq_0 coeff_in_coeffs intro: Gcd_fin_dvd)
 qed
 
 lemma content_dvd_coeffs: "c \<in> set (coeffs p) \<Longrightarrow> content p dvd c"
   by (simp add: content_def Gcd_fin_dvd)
 
 lemma normalize_content [simp]: "normalize (content p) = content p"
   by (simp add: content_def)
 
 lemma is_unit_content_iff [simp]: "is_unit (content p) \<longleftrightarrow> content p = 1"
 proof
   assume "is_unit (content p)"
   then have "normalize (content p) = 1" by (simp add: is_unit_normalize del: normalize_content)
   then show "content p = 1" by simp
 qed auto
 
 lemma content_smult [simp]:
   fixes c :: "'a :: {normalization_semidom_multiplicative, semiring_gcd}"
   shows "content (smult c p) = normalize c * content p"
   by (simp add: content_def coeffs_smult Gcd_fin_mult normalize_mult)
 
 lemma content_eq_zero_iff [simp]: "content p = 0 \<longleftrightarrow> p = 0"
   by (auto simp: content_def simp: poly_eq_iff coeffs_def)
 
 definition primitive_part :: "'a :: semiring_gcd poly \<Rightarrow> 'a poly"
   where "primitive_part p = map_poly (\<lambda>x. x div content p) p"
 
 lemma primitive_part_0 [simp]: "primitive_part 0 = 0"
   by (simp add: primitive_part_def)
 
 lemma content_times_primitive_part [simp]: "smult (content p) (primitive_part p) = p"
   for p :: "'a :: semiring_gcd poly"
 proof (cases "p = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then show ?thesis
   unfolding primitive_part_def
   by (auto simp: smult_conv_map_poly map_poly_map_poly o_def content_dvd_coeffs
       intro: map_poly_idI)
 qed
 
 lemma primitive_part_eq_0_iff [simp]: "primitive_part p = 0 \<longleftrightarrow> p = 0"
 proof (cases "p = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "primitive_part p = map_poly (\<lambda>x. x div content p) p"
     by (simp add:  primitive_part_def)
   also from False have "\<dots> = 0 \<longleftrightarrow> p = 0"
     by (intro map_poly_eq_0_iff) (auto simp: dvd_div_eq_0_iff content_dvd_coeffs)
   finally show ?thesis
     using False by simp
 qed
 
 lemma content_primitive_part [simp]:
   fixes p :: "'a :: {normalization_semidom_multiplicative, semiring_gcd} poly"
   assumes "p \<noteq> 0"
   shows "content (primitive_part p) = 1"
 proof -
   have "p = smult (content p) (primitive_part p)"
     by simp
   also have "content \<dots> = content (primitive_part p) * content p"
     by (simp del: content_times_primitive_part add: ac_simps)
   finally have "1 * content p = content (primitive_part p) * content p"
     by simp
   then have "1 * content p div content p = content (primitive_part p) * content p div content p"
     by simp
   with assms show ?thesis
     by simp
 qed
 
 lemma content_decompose:
   obtains p' :: "'a :: {normalization_semidom_multiplicative, semiring_gcd} poly"
   where "p = smult (content p) p'" "content p' = 1"
 proof (cases "p = 0")
   case True
   then have "p = smult (content p) 1" "content 1 = 1"
     by simp_all
   then show ?thesis ..
 next
   case False
   then have "p = smult (content p) (primitive_part p)" "content (primitive_part p) = 1"
     by simp_all
   then show ?thesis ..
 qed
 
 lemma content_dvd_contentI [intro]: "p dvd q \<Longrightarrow> content p dvd content q"
   using const_poly_dvd_iff_dvd_content content_dvd dvd_trans by blast
 
 lemma primitive_part_const_poly [simp]: "primitive_part [:x:] = [:unit_factor x:]"
   by (simp add: primitive_part_def map_poly_pCons)
 
 lemma primitive_part_prim: "content p = 1 \<Longrightarrow> primitive_part p = p"
   by (auto simp: primitive_part_def)
 
 lemma degree_primitive_part [simp]: "degree (primitive_part p) = degree p"
 proof (cases "p = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "p = smult (content p) (primitive_part p)"
     by simp
   also from False have "degree \<dots> = degree (primitive_part p)"
     by (subst degree_smult_eq) simp_all
   finally show ?thesis ..
 qed
 
 lemma smult_content_normalize_primitive_part [simp]:
   fixes p :: "'a :: {normalization_semidom_multiplicative, semiring_gcd, idom_divide} poly"
   shows "smult (content p) (normalize (primitive_part p)) = normalize p"
 proof -
   have "smult (content p) (normalize (primitive_part p)) =
       normalize ([:content p:] * primitive_part p)"
     by (subst normalize_mult) (simp_all add: normalize_const_poly)
   also have "[:content p:] * primitive_part p = p" by simp
   finally show ?thesis .
 qed
 
 context
 begin
 
 private
 
 lemma content_1_mult:
   fixes f g :: "'a :: {semiring_gcd, factorial_semiring} poly"
   assumes "content f = 1" "content g = 1"
   shows   "content (f * g) = 1"
 proof (cases "f * g = 0")
   case False
   from assms have "f \<noteq> 0" "g \<noteq> 0" by auto
 
   hence "f * g \<noteq> 0" by auto
   {
     assume "\<not>is_unit (content (f * g))"
     with False have "\<exists>p. p dvd content (f * g) \<and> prime p"
       by (intro prime_divisor_exists) simp_all
     then obtain p where "p dvd content (f * g)" "prime p" by blast
     from \<open>p dvd content (f * g)\<close> have "[:p:] dvd f * g"
       by (simp add: const_poly_dvd_iff_dvd_content)
     moreover from \<open>prime p\<close> have "prime_elem [:p:]" by (simp add: lift_prime_elem_poly)
     ultimately have "[:p:] dvd f \<or> [:p:] dvd g"
       by (simp add: prime_elem_dvd_mult_iff)
     with assms have "is_unit p" by (simp add: const_poly_dvd_iff_dvd_content)
     with \<open>prime p\<close> have False by simp
   }
   hence "is_unit (content (f * g))" by blast
   hence "normalize (content (f * g)) = 1" by (simp add: is_unit_normalize del: normalize_content)
   thus ?thesis by simp
 qed (insert assms, auto)
 
 lemma content_mult:
   fixes p q :: "'a :: {factorial_semiring, semiring_gcd, normalization_semidom_multiplicative} poly"
   shows "content (p * q) = content p * content q"
 proof (cases "p * q = 0")
   case False
   then have "p \<noteq> 0" and "q \<noteq> 0"
     by simp_all
   then have *: "content (primitive_part p * primitive_part q) = 1"
     by (auto intro: content_1_mult)
   have "p * q = smult (content p) (primitive_part p) * smult (content q) (primitive_part q)"
     by simp
   also have "\<dots> = smult (content p * content q) (primitive_part p * primitive_part q)"
     by (metis mult.commute mult_smult_right smult_smult)
   with * show ?thesis
   by (simp add: normalize_mult)
 next
   case True
   then show ?thesis
     by auto
 qed
 
 end
 
 lemma primitive_part_mult:
   fixes p q :: "'a :: {factorial_semiring, semiring_Gcd, ring_gcd, idom_divide,
                        normalization_semidom_multiplicative} poly"
   shows "primitive_part (p * q) = primitive_part p * primitive_part q"
 proof -
   have "primitive_part (p * q) = p * q div [:content (p * q):]"
     by (simp add: primitive_part_def div_const_poly_conv_map_poly)
   also have "\<dots> = (p div [:content p:]) * (q div [:content q:])"
     by (subst div_mult_div_if_dvd) (simp_all add: content_mult mult_ac)
   also have "\<dots> = primitive_part p * primitive_part q"
     by (simp add: primitive_part_def div_const_poly_conv_map_poly)
   finally show ?thesis .
 qed
 
 lemma primitive_part_smult:
   fixes p :: "'a :: {factorial_semiring, semiring_Gcd, ring_gcd, idom_divide,
                      normalization_semidom_multiplicative} poly"
   shows "primitive_part (smult a p) = smult (unit_factor a) (primitive_part p)"
 proof -
   have "smult a p = [:a:] * p" by simp
   also have "primitive_part \<dots> = smult (unit_factor a) (primitive_part p)"
     by (subst primitive_part_mult) simp_all
   finally show ?thesis .
 qed
 
 lemma primitive_part_dvd_primitive_partI [intro]:
   fixes p q :: "'a :: {factorial_semiring, semiring_Gcd, ring_gcd, idom_divide,
                        normalization_semidom_multiplicative} poly"
   shows "p dvd q \<Longrightarrow> primitive_part p dvd primitive_part q"
   by (auto elim!: dvdE simp: primitive_part_mult)
 
 lemma content_prod_mset:
   fixes A :: "'a :: {factorial_semiring, semiring_Gcd, normalization_semidom_multiplicative}
       poly multiset"
   shows "content (prod_mset A) = prod_mset (image_mset content A)"
   by (induction A) (simp_all add: content_mult mult_ac)
 
 lemma content_prod_eq_1_iff:
   fixes p q :: "'a :: {factorial_semiring, semiring_Gcd, normalization_semidom_multiplicative} poly"
   shows "content (p * q) = 1 \<longleftrightarrow> content p = 1 \<and> content q = 1"
 proof safe
   assume A: "content (p * q) = 1"
   {
     fix p q :: "'a poly" assume "content p * content q = 1"
     hence "1 = content p * content q" by simp
     hence "content p dvd 1" by (rule dvdI)
     hence "content p = 1" by simp
   } note B = this
   from A B[of p q] B [of q p] show "content p = 1" "content q = 1"
     by (simp_all add: content_mult mult_ac)
 qed (auto simp: content_mult)
 
 
 no_notation cCons (infixr "##" 65)
 
 end
diff --git a/src/HOL/Computational_Algebra/Polynomial_Factorial.thy b/src/HOL/Computational_Algebra/Polynomial_Factorial.thy
--- a/src/HOL/Computational_Algebra/Polynomial_Factorial.thy
+++ b/src/HOL/Computational_Algebra/Polynomial_Factorial.thy
@@ -1,869 +1,885 @@
 (*  Title:      HOL/Computational_Algebra/Polynomial_Factorial.thy
     Author:     Manuel Eberl
 *)
 
 section \<open>Polynomials, fractions and rings\<close>
 
 theory Polynomial_Factorial
 imports 
   Complex_Main
   Polynomial
   Normalized_Fraction
 begin
 
 subsection \<open>Lifting elements into the field of fractions\<close>
 
 definition to_fract :: "'a :: idom \<Rightarrow> 'a fract"
   where "to_fract x = Fract x 1"
   \<comment> \<open>FIXME: more idiomatic name, abbreviation\<close>
 
 lemma to_fract_0 [simp]: "to_fract 0 = 0"
   by (simp add: to_fract_def eq_fract Zero_fract_def)
 
 lemma to_fract_1 [simp]: "to_fract 1 = 1"
   by (simp add: to_fract_def eq_fract One_fract_def)
 
 lemma to_fract_add [simp]: "to_fract (x + y) = to_fract x + to_fract y"
   by (simp add: to_fract_def)
 
 lemma to_fract_diff [simp]: "to_fract (x - y) = to_fract x - to_fract y"
   by (simp add: to_fract_def)
   
 lemma to_fract_uminus [simp]: "to_fract (-x) = -to_fract x"
   by (simp add: to_fract_def)
   
 lemma to_fract_mult [simp]: "to_fract (x * y) = to_fract x * to_fract y"
   by (simp add: to_fract_def)
 
 lemma to_fract_eq_iff [simp]: "to_fract x = to_fract y \<longleftrightarrow> x = y"
   by (simp add: to_fract_def eq_fract)
   
 lemma to_fract_eq_0_iff [simp]: "to_fract x = 0 \<longleftrightarrow> x = 0"
   by (simp add: to_fract_def Zero_fract_def eq_fract)
 
 lemma snd_quot_of_fract_nonzero [simp]: "snd (quot_of_fract x) \<noteq> 0"
   by transfer simp
 
 lemma Fract_quot_of_fract [simp]: "Fract (fst (quot_of_fract x)) (snd (quot_of_fract x)) = x"
   by transfer (simp del: fractrel_iff, subst fractrel_normalize_quot_left, simp)
 
 lemma to_fract_quot_of_fract:
   assumes "snd (quot_of_fract x) = 1"
   shows   "to_fract (fst (quot_of_fract x)) = x"
 proof -
   have "x = Fract (fst (quot_of_fract x)) (snd (quot_of_fract x))" by simp
   also note assms
   finally show ?thesis by (simp add: to_fract_def)
 qed
 
 lemma snd_quot_of_fract_Fract_whole:
   assumes "y dvd x"
   shows   "snd (quot_of_fract (Fract x y)) = 1"
   using assms by transfer (auto simp: normalize_quot_def Let_def gcd_proj2_if_dvd)
   
 lemma Fract_conv_to_fract: "Fract a b = to_fract a / to_fract b"
   by (simp add: to_fract_def)
 
 lemma quot_of_fract_to_fract [simp]: "quot_of_fract (to_fract x) = (x, 1)"
   unfolding to_fract_def by transfer (simp add: normalize_quot_def)
 
 lemma fst_quot_of_fract_eq_0_iff [simp]: "fst (quot_of_fract x) = 0 \<longleftrightarrow> x = 0"
   by transfer simp
  
 lemma snd_quot_of_fract_to_fract [simp]: "snd (quot_of_fract (to_fract x)) = 1"
   unfolding to_fract_def by (rule snd_quot_of_fract_Fract_whole) simp_all
 
 lemma coprime_quot_of_fract:
   "coprime (fst (quot_of_fract x)) (snd (quot_of_fract x))"
   by transfer (simp add: coprime_normalize_quot)
 
 lemma unit_factor_snd_quot_of_fract: "unit_factor (snd (quot_of_fract x)) = 1"
   using quot_of_fract_in_normalized_fracts[of x] 
   by (simp add: normalized_fracts_def case_prod_unfold)  
 
 lemma unit_factor_1_imp_normalized: "unit_factor x = 1 \<Longrightarrow> normalize x = x"
   by (subst (2) normalize_mult_unit_factor [symmetric, of x])
      (simp del: normalize_mult_unit_factor)
   
 lemma normalize_snd_quot_of_fract: "normalize (snd (quot_of_fract x)) = snd (quot_of_fract x)"
   by (intro unit_factor_1_imp_normalized unit_factor_snd_quot_of_fract)
 
 
 subsection \<open>Lifting polynomial coefficients to the field of fractions\<close>
 
 abbreviation (input) fract_poly 
   where "fract_poly \<equiv> map_poly to_fract"
 
 abbreviation (input) unfract_poly 
   where "unfract_poly \<equiv> map_poly (fst \<circ> quot_of_fract)"
   
 lemma fract_poly_smult [simp]: "fract_poly (smult c p) = smult (to_fract c) (fract_poly p)"
   by (simp add: smult_conv_map_poly map_poly_map_poly o_def)
 
 lemma fract_poly_0 [simp]: "fract_poly 0 = 0"
   by (simp add: poly_eqI coeff_map_poly)
 
 lemma fract_poly_1 [simp]: "fract_poly 1 = 1"
   by (simp add: map_poly_pCons)
 
 lemma fract_poly_add [simp]:
   "fract_poly (p + q) = fract_poly p + fract_poly q"
   by (intro poly_eqI) (simp_all add: coeff_map_poly)
 
 lemma fract_poly_diff [simp]:
   "fract_poly (p - q) = fract_poly p - fract_poly q"
   by (intro poly_eqI) (simp_all add: coeff_map_poly)
 
 lemma to_fract_sum [simp]: "to_fract (sum f A) = sum (\<lambda>x. to_fract (f x)) A"
   by (cases "finite A", induction A rule: finite_induct) simp_all 
 
 lemma fract_poly_mult [simp]:
   "fract_poly (p * q) = fract_poly p * fract_poly q"
   by (intro poly_eqI) (simp_all add: coeff_map_poly coeff_mult)
 
 lemma fract_poly_eq_iff [simp]: "fract_poly p = fract_poly q \<longleftrightarrow> p = q"
   by (auto simp: poly_eq_iff coeff_map_poly)
 
 lemma fract_poly_eq_0_iff [simp]: "fract_poly p = 0 \<longleftrightarrow> p = 0"
   using fract_poly_eq_iff[of p 0] by (simp del: fract_poly_eq_iff)
 
 lemma fract_poly_dvd: "p dvd q \<Longrightarrow> fract_poly p dvd fract_poly q"
   by (auto elim!: dvdE)
 
 lemma prod_mset_fract_poly: 
   "(\<Prod>x\<in>#A. map_poly to_fract (f x)) = fract_poly (prod_mset (image_mset f A))"
   by (induct A) (simp_all add: ac_simps)
   
 lemma is_unit_fract_poly_iff:
   "p dvd 1 \<longleftrightarrow> fract_poly p dvd 1 \<and> content p = 1"
 proof safe
   assume A: "p dvd 1"
   with fract_poly_dvd [of p 1] show "is_unit (fract_poly p)"
     by simp
   from A show "content p = 1"
     by (auto simp: is_unit_poly_iff normalize_1_iff)
 next
   assume A: "fract_poly p dvd 1" and B: "content p = 1"
   from A obtain c where c: "fract_poly p = [:c:]" by (auto simp: is_unit_poly_iff)
   {
     fix n :: nat assume "n > 0"
     have "to_fract (coeff p n) = coeff (fract_poly p) n" by (simp add: coeff_map_poly)
     also note c
     also from \<open>n > 0\<close> have "coeff [:c:] n = 0" by (simp add: coeff_pCons split: nat.splits)
     finally have "coeff p n = 0" by simp
   }
   hence "degree p \<le> 0" by (intro degree_le) simp_all
   with B show "p dvd 1" by (auto simp: is_unit_poly_iff normalize_1_iff elim!: degree_eq_zeroE)
 qed
   
 lemma fract_poly_is_unit: "p dvd 1 \<Longrightarrow> fract_poly p dvd 1"
   using fract_poly_dvd[of p 1] by simp
 
 lemma fract_poly_smult_eqE:
   fixes c :: "'a :: {idom_divide,ring_gcd,semiring_gcd_mult_normalize} fract"
   assumes "fract_poly p = smult c (fract_poly q)"
   obtains a b 
     where "c = to_fract b / to_fract a" "smult a p = smult b q" "coprime a b" "normalize a = a"
 proof -
   define a b where "a = fst (quot_of_fract c)" and "b = snd (quot_of_fract c)"
   have "smult (to_fract a) (fract_poly q) = smult (to_fract b) (fract_poly p)"
     by (subst smult_eq_iff) (simp_all add: a_def b_def Fract_conv_to_fract [symmetric] assms)
   hence "fract_poly (smult a q) = fract_poly (smult b p)" by (simp del: fract_poly_eq_iff)
   hence "smult b p = smult a q" by (simp only: fract_poly_eq_iff)
   moreover have "c = to_fract a / to_fract b" "coprime b a" "normalize b = b"
     by (simp_all add: a_def b_def coprime_quot_of_fract [of c] ac_simps
           normalize_snd_quot_of_fract Fract_conv_to_fract [symmetric])
   ultimately show ?thesis by (intro that[of a b])
 qed
 
 
 subsection \<open>Fractional content\<close>
 
 abbreviation (input) Lcm_coeff_denoms 
     :: "'a :: {semiring_Gcd,idom_divide,ring_gcd,semiring_gcd_mult_normalize} fract poly \<Rightarrow> 'a"
   where "Lcm_coeff_denoms p \<equiv> Lcm (snd ` quot_of_fract ` set (coeffs p))"
   
 definition fract_content :: 
       "'a :: {factorial_semiring,semiring_Gcd,ring_gcd,idom_divide,semiring_gcd_mult_normalize} fract poly \<Rightarrow> 'a fract" where
   "fract_content p = 
      (let d = Lcm_coeff_denoms p in Fract (content (unfract_poly (smult (to_fract d) p))) d)" 
 
 definition primitive_part_fract :: 
       "'a :: {factorial_semiring,semiring_Gcd,ring_gcd,idom_divide,semiring_gcd_mult_normalize} fract poly \<Rightarrow> 'a poly" where
   "primitive_part_fract p = 
      primitive_part (unfract_poly (smult (to_fract (Lcm_coeff_denoms p)) p))"
 
 lemma primitive_part_fract_0 [simp]: "primitive_part_fract 0 = 0"
   by (simp add: primitive_part_fract_def)
 
 lemma fract_content_eq_0_iff [simp]:
   "fract_content p = 0 \<longleftrightarrow> p = 0"
   unfolding fract_content_def Let_def Zero_fract_def
   by (subst eq_fract) (auto simp: Lcm_0_iff map_poly_eq_0_iff)
 
 lemma content_primitive_part_fract [simp]:
   fixes p :: "'a :: {semiring_gcd_mult_normalize,
                      factorial_semiring, ring_gcd, semiring_Gcd,idom_divide} fract poly"
   shows "p \<noteq> 0 \<Longrightarrow> content (primitive_part_fract p) = 1"
   unfolding primitive_part_fract_def
   by (rule content_primitive_part)
      (auto simp: primitive_part_fract_def map_poly_eq_0_iff Lcm_0_iff)  
 
 lemma content_times_primitive_part_fract:
   "smult (fract_content p) (fract_poly (primitive_part_fract p)) = p"
 proof -
   define p' where "p' = unfract_poly (smult (to_fract (Lcm_coeff_denoms p)) p)"
   have "fract_poly p' = 
           map_poly (to_fract \<circ> fst \<circ> quot_of_fract) (smult (to_fract (Lcm_coeff_denoms p)) p)"
     unfolding primitive_part_fract_def p'_def 
     by (subst map_poly_map_poly) (simp_all add: o_assoc)
   also have "\<dots> = smult (to_fract (Lcm_coeff_denoms p)) p"
   proof (intro map_poly_idI, unfold o_apply)
     fix c assume "c \<in> set (coeffs (smult (to_fract (Lcm_coeff_denoms p)) p))"
     then obtain c' where c: "c' \<in> set (coeffs p)" "c = to_fract (Lcm_coeff_denoms p) * c'"
       by (auto simp add: Lcm_0_iff coeffs_smult split: if_splits)
     note c(2)
     also have "c' = Fract (fst (quot_of_fract c')) (snd (quot_of_fract c'))"
       by simp
     also have "to_fract (Lcm_coeff_denoms p) * \<dots> = 
                  Fract (Lcm_coeff_denoms p * fst (quot_of_fract c')) (snd (quot_of_fract c'))"
       unfolding to_fract_def by (subst mult_fract) simp_all
     also have "snd (quot_of_fract \<dots>) = 1"
       by (intro snd_quot_of_fract_Fract_whole dvd_mult2 dvd_Lcm) (insert c(1), auto)
     finally show "to_fract (fst (quot_of_fract c)) = c"
       by (rule to_fract_quot_of_fract)
   qed
   also have "p' = smult (content p') (primitive_part p')" 
     by (rule content_times_primitive_part [symmetric])
   also have "primitive_part p' = primitive_part_fract p"
     by (simp add: primitive_part_fract_def p'_def)
   also have "fract_poly (smult (content p') (primitive_part_fract p)) = 
                smult (to_fract (content p')) (fract_poly (primitive_part_fract p))" by simp
   finally have "smult (to_fract (content p')) (fract_poly (primitive_part_fract p)) =
                       smult (to_fract (Lcm_coeff_denoms p)) p" .
   thus ?thesis
     by (subst (asm) smult_eq_iff)
        (auto simp add: Let_def p'_def Fract_conv_to_fract field_simps Lcm_0_iff fract_content_def)
 qed
 
 lemma fract_content_fract_poly [simp]: "fract_content (fract_poly p) = to_fract (content p)"
 proof -
   have "Lcm_coeff_denoms (fract_poly p) = 1"
     by (auto simp: set_coeffs_map_poly)
   hence "fract_content (fract_poly p) = 
            to_fract (content (map_poly (fst \<circ> quot_of_fract \<circ> to_fract) p))"
     by (simp add: fract_content_def to_fract_def fract_collapse map_poly_map_poly del: Lcm_1_iff)
   also have "map_poly (fst \<circ> quot_of_fract \<circ> to_fract) p = p"
     by (intro map_poly_idI) simp_all
   finally show ?thesis .
 qed
 
 lemma content_decompose_fract:
   fixes p :: "'a :: {factorial_semiring,semiring_Gcd,ring_gcd,idom_divide,
                      semiring_gcd_mult_normalize} fract poly"
   obtains c p' where "p = smult c (map_poly to_fract p')" "content p' = 1"
 proof (cases "p = 0")
   case True
   hence "p = smult 0 (map_poly to_fract 1)" "content 1 = 1" by simp_all
   thus ?thesis ..
 next
   case False
   thus ?thesis
     by (rule that[OF content_times_primitive_part_fract [symmetric] content_primitive_part_fract])
 qed
 
 
 subsection \<open>More properties of content and primitive part\<close>
 
 lemma lift_prime_elem_poly:
   assumes "prime_elem (c :: 'a :: semidom)"
   shows   "prime_elem [:c:]"
 proof (rule prime_elemI)
   fix a b assume *: "[:c:] dvd a * b"
   from * have dvd: "c dvd coeff (a * b) n" for n
     by (subst (asm) const_poly_dvd_iff) blast
   {
     define m where "m = (GREATEST m. \<not>c dvd coeff b m)"
     assume "\<not>[:c:] dvd b"
     hence A: "\<exists>i. \<not>c dvd coeff b i" by (subst (asm) const_poly_dvd_iff) blast
     have B: "\<And>i. \<not>c dvd coeff b i \<Longrightarrow> i \<le> degree b"
       by (auto intro: le_degree)
     have coeff_m: "\<not>c dvd coeff b m" unfolding m_def by (rule GreatestI_ex_nat[OF A B])
     have "i \<le> m" if "\<not>c dvd coeff b i" for i
       unfolding m_def by (blast intro!: Greatest_le_nat that B)
     hence dvd_b: "c dvd coeff b i" if "i > m" for i using that by force
 
     have "c dvd coeff a i" for i
     proof (induction i rule: nat_descend_induct[of "degree a"])
       case (base i)
       thus ?case by (simp add: coeff_eq_0)
     next
       case (descend i)
       let ?A = "{..i+m} - {i}"
       have "c dvd coeff (a * b) (i + m)" by (rule dvd)
       also have "coeff (a * b) (i + m) = (\<Sum>k\<le>i + m. coeff a k * coeff b (i + m - k))"
         by (simp add: coeff_mult)
       also have "{..i+m} = insert i ?A" by auto
       also have "(\<Sum>k\<in>\<dots>. coeff a k * coeff b (i + m - k)) =
                    coeff a i * coeff b m + (\<Sum>k\<in>?A. coeff a k * coeff b (i + m - k))"
         (is "_ = _ + ?S")
         by (subst sum.insert) simp_all
       finally have eq: "c dvd coeff a i * coeff b m + ?S" .
       moreover have "c dvd ?S"
       proof (rule dvd_sum)
         fix k assume k: "k \<in> {..i+m} - {i}"
         show "c dvd coeff a k * coeff b (i + m - k)"
         proof (cases "k < i")
           case False
           with k have "c dvd coeff a k" by (intro descend.IH) simp
           thus ?thesis by simp
         next
           case True
           hence "c dvd coeff b (i + m - k)" by (intro dvd_b) simp
           thus ?thesis by simp
         qed
       qed
       ultimately have "c dvd coeff a i * coeff b m"
         by (simp add: dvd_add_left_iff)
       with assms coeff_m show "c dvd coeff a i"
         by (simp add: prime_elem_dvd_mult_iff)
     qed
     hence "[:c:] dvd a" by (subst const_poly_dvd_iff) blast
   }
   then show "[:c:] dvd a \<or> [:c:] dvd b" by blast
 next
   from assms show "[:c:] \<noteq> 0" and "\<not> [:c:] dvd 1"
     by (simp_all add: prime_elem_def is_unit_const_poly_iff)
 qed
 
 lemma prime_elem_const_poly_iff:
   fixes c :: "'a :: semidom"
   shows   "prime_elem [:c:] \<longleftrightarrow> prime_elem c"
 proof
   assume A: "prime_elem [:c:]"
   show "prime_elem c"
   proof (rule prime_elemI)
     fix a b assume "c dvd a * b"
     hence "[:c:] dvd [:a:] * [:b:]" by (simp add: mult_ac)
     from A and this have "[:c:] dvd [:a:] \<or> [:c:] dvd [:b:]" by (rule prime_elem_dvd_multD)
     thus "c dvd a \<or> c dvd b" by simp
   qed (insert A, auto simp: prime_elem_def is_unit_poly_iff)
 qed (auto intro: lift_prime_elem_poly)
 
 lemma fract_poly_dvdD:
   fixes p :: "'a :: {factorial_semiring,semiring_Gcd,ring_gcd,idom_divide,
                      semiring_gcd_mult_normalize} poly"
   assumes "fract_poly p dvd fract_poly q" "content p = 1"
   shows   "p dvd q"
 proof -
   from assms(1) obtain r where r: "fract_poly q = fract_poly p * r" by (erule dvdE)
-  from content_decompose_fract[of r] guess c r' . note r' = this
+  from content_decompose_fract[of r]
+  obtain c r' where r': "r = smult c (map_poly to_fract r')" "content r' = 1" .
   from r r' have eq: "fract_poly q = smult c (fract_poly (p * r'))" by simp  
-  from fract_poly_smult_eqE[OF this] guess a b . note ab = this
+  from fract_poly_smult_eqE[OF this] obtain a b
+    where ab:
+      "c = to_fract b / to_fract a"
+      "smult a q = smult b (p * r')"
+      "coprime a b"
+      "normalize a = a" .
   have "content (smult a q) = content (smult b (p * r'))" by (simp only: ab(2))
   hence eq': "normalize b = a * content q" by (simp add: assms content_mult r' ab(4))
   have "1 = gcd a (normalize b)" by (simp add: ab)
   also note eq'
   also have "gcd a (a * content q) = a" by (simp add: gcd_proj1_if_dvd ab(4))
   finally have [simp]: "a = 1" by simp
   from eq ab have "q = p * ([:b:] * r')" by simp
   thus ?thesis by (rule dvdI)
 qed
 
 
 subsection \<open>Polynomials over a field are a Euclidean ring\<close>
 
 context
 begin
 
 interpretation field_poly: 
   normalization_euclidean_semiring_multiplicative where zero = "0 :: 'a :: field poly"
     and one = 1 and plus = plus and minus = minus
     and times = times
     and normalize = "\<lambda>p. smult (inverse (lead_coeff p)) p"
     and unit_factor = "\<lambda>p. [:lead_coeff p:]"
     and euclidean_size = "\<lambda>p. if p = 0 then 0 else 2 ^ degree p"
     and divide = divide and modulo = modulo
   rewrites "dvd.dvd (times :: 'a poly \<Rightarrow> _) = Rings.dvd"
     and "comm_monoid_mult.prod_mset times 1 = prod_mset"
     and "comm_semiring_1.irreducible times 1 0 = irreducible"
     and "comm_semiring_1.prime_elem times 1 0 = prime_elem"
 proof -
   show "dvd.dvd (times :: 'a poly \<Rightarrow> _) = Rings.dvd"
     by (simp add: dvd_dict)
   show "comm_monoid_mult.prod_mset times 1 = prod_mset"
     by (simp add: prod_mset_dict)
   show "comm_semiring_1.irreducible times 1 0 = irreducible"
     by (simp add: irreducible_dict)
   show "comm_semiring_1.prime_elem times 1 0 = prime_elem"
     by (simp add: prime_elem_dict)
   show "class.normalization_euclidean_semiring_multiplicative divide plus minus (0 :: 'a poly) times 1
     modulo (\<lambda>p. if p = 0 then 0 else 2 ^ degree p)
     (\<lambda>p. [:lead_coeff p:]) (\<lambda>p. smult (inverse (lead_coeff p)) p)"
   proof (standard, fold dvd_dict)
     fix p :: "'a poly"
     show "[:lead_coeff p:] * smult (inverse (lead_coeff p)) p = p"
       by (cases "p = 0") simp_all
   next
     fix p :: "'a poly" assume "is_unit p"
     then show "[:lead_coeff p:] = p"
       by (elim is_unit_polyE) (auto simp: monom_0 one_poly_def field_simps)
   next
     fix p :: "'a poly" assume "p \<noteq> 0"
     then show "is_unit [:lead_coeff p:]"
       by (simp add: is_unit_pCons_iff)
   next
     fix a b :: "'a poly" assume "is_unit a"
     thus "[:lead_coeff (a * b):] = a * [:lead_coeff b:]"
       by (auto elim!: is_unit_polyE)
   qed (auto simp: lead_coeff_mult Rings.div_mult_mod_eq intro!: degree_mod_less' degree_mult_right_le)
 qed
 
 lemma field_poly_irreducible_imp_prime:
   "prime_elem p" if "irreducible p" for p :: "'a :: field poly"
   using that by (fact field_poly.irreducible_imp_prime_elem)
 
 lemma field_poly_prod_mset_prime_factorization:
   "prod_mset (field_poly.prime_factorization p) = smult (inverse (lead_coeff p)) p"
   if "p \<noteq> 0" for p :: "'a :: field poly"
   using that by (fact field_poly.prod_mset_prime_factorization)
 
 lemma field_poly_in_prime_factorization_imp_prime:
   "prime_elem p" if "p \<in># field_poly.prime_factorization x"
   for p :: "'a :: field poly"
   by (rule field_poly.prime_imp_prime_elem, rule field_poly.in_prime_factors_imp_prime)
     (fact that)
 
 
 subsection \<open>Primality and irreducibility in polynomial rings\<close>
 
 lemma nonconst_poly_irreducible_iff:
   fixes p :: "'a :: {factorial_semiring,semiring_Gcd,ring_gcd,idom_divide,semiring_gcd_mult_normalize} poly"
   assumes "degree p \<noteq> 0"
   shows   "irreducible p \<longleftrightarrow> irreducible (fract_poly p) \<and> content p = 1"
 proof safe
   assume p: "irreducible p"
 
-  from content_decompose[of p] guess p' . note p' = this
+  from content_decompose[of p] obtain p' where p': "p = smult (content p) p'" "content p' = 1" .
   hence "p = [:content p:] * p'" by simp
   from p this have "[:content p:] dvd 1 \<or> p' dvd 1" by (rule irreducibleD)
   moreover have "\<not>p' dvd 1"
   proof
     assume "p' dvd 1"
     hence "degree p = 0" by (subst p') (auto simp: is_unit_poly_iff)
     with assms show False by contradiction
   qed
   ultimately show [simp]: "content p = 1" by (simp add: is_unit_const_poly_iff)
   
   show "irreducible (map_poly to_fract p)"
   proof (rule irreducibleI)
     have "fract_poly p = 0 \<longleftrightarrow> p = 0" by (intro map_poly_eq_0_iff) auto
     with assms show "map_poly to_fract p \<noteq> 0" by auto
   next
     show "\<not>is_unit (fract_poly p)"
     proof
       assume "is_unit (map_poly to_fract p)"
       hence "degree (map_poly to_fract p) = 0"
         by (auto simp: is_unit_poly_iff)
       hence "degree p = 0" by (simp add: degree_map_poly)
       with assms show False by contradiction
    qed
  next
    fix q r assume qr: "fract_poly p = q * r"
-   from content_decompose_fract[of q] guess cg q' . note q = this
-   from content_decompose_fract[of r] guess cr r' . note r = this
+   from content_decompose_fract[of q]
+   obtain cg q' where q: "q = smult cg (map_poly to_fract q')" "content q' = 1" .
+   from content_decompose_fract[of r]
+   obtain cr r' where r: "r = smult cr (map_poly to_fract r')" "content r' = 1" .
    from qr q r p have nz: "cg \<noteq> 0" "cr \<noteq> 0" by auto
    from qr have eq: "fract_poly p = smult (cr * cg) (fract_poly (q' * r'))"
      by (simp add: q r)
-   from fract_poly_smult_eqE[OF this] guess a b . note ab = this
+   from fract_poly_smult_eqE[OF this] obtain a b
+     where ab: "cr * cg = to_fract b / to_fract a"
+       "smult a p = smult b (q' * r')" "coprime a b" "normalize a = a" .
    hence "content (smult a p) = content (smult b (q' * r'))" by (simp only:)
    with ab(4) have a: "a = normalize b" by (simp add: content_mult q r)
    then have "normalize b = gcd a b"
      by simp
    with \<open>coprime a b\<close> have "normalize b = 1"
      by simp
    then have "a = 1" "is_unit b"
      by (simp_all add: a normalize_1_iff)
    
    note eq
    also from ab(1) \<open>a = 1\<close> have "cr * cg = to_fract b" by simp
    also have "smult \<dots> (fract_poly (q' * r')) = fract_poly (smult b (q' * r'))" by simp
    finally have "p = ([:b:] * q') * r'" by (simp del: fract_poly_smult)
    from p and this have "([:b:] * q') dvd 1 \<or> r' dvd 1" by (rule irreducibleD)
    hence "q' dvd 1 \<or> r' dvd 1" by (auto dest: dvd_mult_right simp del: mult_pCons_left)
    hence "fract_poly q' dvd 1 \<or> fract_poly r' dvd 1" by (auto simp: fract_poly_is_unit)
    with q r show "is_unit q \<or> is_unit r"
      by (auto simp add: is_unit_smult_iff dvd_field_iff nz)
  qed
 
 next
 
   assume irred: "irreducible (fract_poly p)" and primitive: "content p = 1"
   show "irreducible p"
   proof (rule irreducibleI)
     from irred show "p \<noteq> 0" by auto
   next
     from irred show "\<not>p dvd 1"
       by (auto simp: irreducible_def dest: fract_poly_is_unit)
   next
     fix q r assume qr: "p = q * r"
     hence "fract_poly p = fract_poly q * fract_poly r" by simp
     from irred and this have "fract_poly q dvd 1 \<or> fract_poly r dvd 1" 
       by (rule irreducibleD)
     with primitive qr show "q dvd 1 \<or> r dvd 1"
       by (auto simp:  content_prod_eq_1_iff is_unit_fract_poly_iff)
   qed
 qed
 
 private lemma irreducible_imp_prime_poly:
   fixes p :: "'a :: {factorial_semiring,semiring_Gcd,ring_gcd,idom_divide,semiring_gcd_mult_normalize} poly"
   assumes "irreducible p"
   shows   "prime_elem p"
 proof (cases "degree p = 0")
   case True
   with assms show ?thesis
     by (auto simp: prime_elem_const_poly_iff irreducible_const_poly_iff
              intro!: irreducible_imp_prime_elem elim!: degree_eq_zeroE)
 next
   case False
   from assms False have irred: "irreducible (fract_poly p)" and primitive: "content p = 1"
     by (simp_all add: nonconst_poly_irreducible_iff)
   from irred have prime: "prime_elem (fract_poly p)" by (rule field_poly_irreducible_imp_prime)
   show ?thesis
   proof (rule prime_elemI)
     fix q r assume "p dvd q * r"
     hence "fract_poly p dvd fract_poly (q * r)" by (rule fract_poly_dvd)
     hence "fract_poly p dvd fract_poly q * fract_poly r" by simp
     from prime and this have "fract_poly p dvd fract_poly q \<or> fract_poly p dvd fract_poly r"
       by (rule prime_elem_dvd_multD)
     with primitive show "p dvd q \<or> p dvd r" by (auto dest: fract_poly_dvdD)
   qed (insert assms, auto simp: irreducible_def)
 qed
 
 lemma degree_primitive_part_fract [simp]:
   "degree (primitive_part_fract p) = degree p"
 proof -
   have "p = smult (fract_content p) (fract_poly (primitive_part_fract p))"
     by (simp add: content_times_primitive_part_fract)
   also have "degree \<dots> = degree (primitive_part_fract p)"
     by (auto simp: degree_map_poly)
   finally show ?thesis ..
 qed
 
 lemma irreducible_primitive_part_fract:
   fixes p :: "'a :: {idom_divide, ring_gcd, factorial_semiring, semiring_Gcd,semiring_gcd_mult_normalize} fract poly"
   assumes "irreducible p"
   shows   "irreducible (primitive_part_fract p)"
 proof -
   from assms have deg: "degree (primitive_part_fract p) \<noteq> 0"
     by (intro notI) 
        (auto elim!: degree_eq_zeroE simp: irreducible_def is_unit_poly_iff dvd_field_iff)
   hence [simp]: "p \<noteq> 0" by auto
 
   note \<open>irreducible p\<close>
   also have "p = [:fract_content p:] * fract_poly (primitive_part_fract p)" 
     by (simp add: content_times_primitive_part_fract)
   also have "irreducible \<dots> \<longleftrightarrow> irreducible (fract_poly (primitive_part_fract p))"
     by (intro irreducible_mult_unit_left) (simp_all add: is_unit_poly_iff dvd_field_iff)
   finally show ?thesis using deg
     by (simp add: nonconst_poly_irreducible_iff)
 qed
 
 lemma prime_elem_primitive_part_fract:
   fixes p :: "'a :: {idom_divide, ring_gcd, factorial_semiring, semiring_Gcd,semiring_gcd_mult_normalize} fract poly"
   shows "irreducible p \<Longrightarrow> prime_elem (primitive_part_fract p)"
   by (intro irreducible_imp_prime_poly irreducible_primitive_part_fract)
 
 lemma irreducible_linear_field_poly:
   fixes a b :: "'a::field"
   assumes "b \<noteq> 0"
   shows "irreducible [:a,b:]"
 proof (rule irreducibleI)
   fix p q assume pq: "[:a,b:] = p * q"
   also from pq assms have "degree \<dots> = degree p + degree q" 
     by (intro degree_mult_eq) auto
   finally have "degree p = 0 \<or> degree q = 0" using assms by auto
   with assms pq show "is_unit p \<or> is_unit q"
     by (auto simp: is_unit_const_poly_iff dvd_field_iff elim!: degree_eq_zeroE)
 qed (insert assms, auto simp: is_unit_poly_iff)
 
 lemma prime_elem_linear_field_poly:
   "(b :: 'a :: field) \<noteq> 0 \<Longrightarrow> prime_elem [:a,b:]"
   by (rule field_poly_irreducible_imp_prime, rule irreducible_linear_field_poly)
 
 lemma irreducible_linear_poly:
   fixes a b :: "'a::{idom_divide,ring_gcd,factorial_semiring,semiring_Gcd,semiring_gcd_mult_normalize}"
   shows "b \<noteq> 0 \<Longrightarrow> coprime a b \<Longrightarrow> irreducible [:a,b:]"
   by (auto intro!: irreducible_linear_field_poly 
            simp:   nonconst_poly_irreducible_iff content_def map_poly_pCons)
 
 lemma prime_elem_linear_poly:
   fixes a b :: "'a::{idom_divide,ring_gcd,factorial_semiring,semiring_Gcd,semiring_gcd_mult_normalize}"
   shows "b \<noteq> 0 \<Longrightarrow> coprime a b \<Longrightarrow> prime_elem [:a,b:]"
   by (rule irreducible_imp_prime_poly, rule irreducible_linear_poly)
 
  
 subsection \<open>Prime factorisation of polynomials\<close>   
 
 private lemma poly_prime_factorization_exists_content_1:
   fixes p :: "'a :: {factorial_semiring,semiring_Gcd,ring_gcd,idom_divide,semiring_gcd_mult_normalize} poly"
   assumes "p \<noteq> 0" "content p = 1"
   shows   "\<exists>A. (\<forall>p. p \<in># A \<longrightarrow> prime_elem p) \<and> prod_mset A = normalize p"
 proof -
   let ?P = "field_poly.prime_factorization (fract_poly p)"
   define c where "c = prod_mset (image_mset fract_content ?P)"
   define c' where "c' = c * to_fract (lead_coeff p)"
   define e where "e = prod_mset (image_mset primitive_part_fract ?P)"
   define A where "A = image_mset (normalize \<circ> primitive_part_fract) ?P"
   have "content e = (\<Prod>x\<in>#field_poly.prime_factorization (map_poly to_fract p). 
                       content (primitive_part_fract x))"
     by (simp add: e_def content_prod_mset multiset.map_comp o_def)
   also have "image_mset (\<lambda>x. content (primitive_part_fract x)) ?P = image_mset (\<lambda>_. 1) ?P"
     by (intro image_mset_cong content_primitive_part_fract) auto
   finally have content_e: "content e = 1"
     by simp    
   
   from \<open>p \<noteq> 0\<close> have "fract_poly p = [:lead_coeff (fract_poly p):] * 
     smult (inverse (lead_coeff (fract_poly p))) (fract_poly p)"
     by simp 
   also have "[:lead_coeff (fract_poly p):] = [:to_fract (lead_coeff p):]" 
     by (simp add: monom_0 degree_map_poly coeff_map_poly)
   also from assms have "smult (inverse (lead_coeff (fract_poly p))) (fract_poly p) = prod_mset ?P" 
     by (subst field_poly_prod_mset_prime_factorization) simp_all
   also have "\<dots> = prod_mset (image_mset id ?P)" by simp
   also have "image_mset id ?P = 
                image_mset (\<lambda>x. [:fract_content x:] * fract_poly (primitive_part_fract x)) ?P"
     by (intro image_mset_cong) (auto simp: content_times_primitive_part_fract)
   also have "prod_mset \<dots> = smult c (fract_poly e)"
     by (subst prod_mset.distrib) (simp_all add: prod_mset_fract_poly prod_mset_const_poly c_def e_def)
   also have "[:to_fract (lead_coeff p):] * \<dots> = smult c' (fract_poly e)"
     by (simp add: c'_def)
   finally have eq: "fract_poly p = smult c' (fract_poly e)" .
   also obtain b where b: "c' = to_fract b" "is_unit b"
   proof -
-    from fract_poly_smult_eqE[OF eq] guess a b . note ab = this
+    from fract_poly_smult_eqE[OF eq]
+    obtain a b where ab:
+      "c' = to_fract b / to_fract a"
+      "smult a p = smult b e"
+      "coprime a b"
+      "normalize a = a" .
     from ab(2) have "content (smult a p) = content (smult b e)" by (simp only: )
     with assms content_e have "a = normalize b" by (simp add: ab(4))
     with ab have ab': "a = 1" "is_unit b"
       by (simp_all add: normalize_1_iff)
     with ab ab' have "c' = to_fract b" by auto
     from this and \<open>is_unit b\<close> show ?thesis by (rule that)
   qed
   hence "smult c' (fract_poly e) = fract_poly (smult b e)" by simp
   finally have "p = smult b e" by (simp only: fract_poly_eq_iff)
   hence "p = [:b:] * e" by simp
   with b have "normalize p = normalize e" 
     by (simp only: normalize_mult) (simp add: is_unit_normalize is_unit_poly_iff)
   also have "normalize e = prod_mset A"
     by (simp add: multiset.map_comp e_def A_def normalize_prod_mset)
   finally have "prod_mset A = normalize p" ..
   
   have "prime_elem p" if "p \<in># A" for p
     using that by (auto simp: A_def prime_elem_primitive_part_fract prime_elem_imp_irreducible 
                         dest!: field_poly_in_prime_factorization_imp_prime )
   from this and \<open>prod_mset A = normalize p\<close> show ?thesis
     by (intro exI[of _ A]) blast
 qed
 
 lemma poly_prime_factorization_exists:
   fixes p :: "'a :: {factorial_semiring,semiring_Gcd,ring_gcd,idom_divide,semiring_gcd_mult_normalize} poly"
   assumes "p \<noteq> 0"
   shows   "\<exists>A. (\<forall>p. p \<in># A \<longrightarrow> prime_elem p) \<and> normalize (prod_mset A) = normalize p"
 proof -
   define B where "B = image_mset (\<lambda>x. [:x:]) (prime_factorization (content p))"
   have "\<exists>A. (\<forall>p. p \<in># A \<longrightarrow> prime_elem p) \<and> prod_mset A = normalize (primitive_part p)"
     by (rule poly_prime_factorization_exists_content_1) (insert assms, simp_all)
-  then guess A by (elim exE conjE) note A = this
+  then obtain A where A: "\<forall>p. p \<in># A \<longrightarrow> prime_elem p" "\<Prod>\<^sub># A = normalize (primitive_part p)"
+    by blast
   have "normalize (prod_mset (A + B)) = normalize (prod_mset A * normalize (prod_mset B))"
     by simp
   also from assms have "normalize (prod_mset B) = normalize [:content p:]"
     by (simp add: prod_mset_const_poly normalize_const_poly prod_mset_prime_factorization_weak B_def)
   also have "prod_mset A = normalize (primitive_part p)"
     using A by simp
   finally have "normalize (prod_mset (A + B)) = normalize (primitive_part p * [:content p:])"
     by simp
   moreover have "\<forall>p. p \<in># B \<longrightarrow> prime_elem p"
     by (auto simp: B_def intro!: lift_prime_elem_poly dest: in_prime_factors_imp_prime)
   ultimately show ?thesis using A by (intro exI[of _ "A + B"]) (auto)
 qed
 
 end
 
 
 subsection \<open>Typeclass instances\<close>
 
 instance poly :: ("{factorial_ring_gcd,semiring_gcd_mult_normalize}") factorial_semiring
   by standard (rule poly_prime_factorization_exists)  
 
 instantiation poly :: ("{factorial_ring_gcd, semiring_gcd_mult_normalize}") factorial_ring_gcd
 begin
 
 definition gcd_poly :: "'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly" where
   [code del]: "gcd_poly = gcd_factorial"
 
 definition lcm_poly :: "'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly" where
   [code del]: "lcm_poly = lcm_factorial"
   
 definition Gcd_poly :: "'a poly set \<Rightarrow> 'a poly" where
  [code del]: "Gcd_poly = Gcd_factorial"
 
 definition Lcm_poly :: "'a poly set \<Rightarrow> 'a poly" where
  [code del]: "Lcm_poly = Lcm_factorial"
  
 instance by standard (simp_all add: gcd_poly_def lcm_poly_def Gcd_poly_def Lcm_poly_def)
 
 end
 
 instance poly :: ("{factorial_ring_gcd, semiring_gcd_mult_normalize}") semiring_gcd_mult_normalize ..
 
 instantiation poly :: ("{field,factorial_ring_gcd,semiring_gcd_mult_normalize}")
    "{unique_euclidean_ring, normalization_euclidean_semiring}"
 begin
 
 definition euclidean_size_poly :: "'a poly \<Rightarrow> nat"
   where "euclidean_size_poly p = (if p = 0 then 0 else 2 ^ degree p)"
 
 definition division_segment_poly :: "'a poly \<Rightarrow> 'a poly"
   where [simp]: "division_segment_poly p = 1"
 
 instance proof
   show "(q * p + r) div p = q" if "p \<noteq> 0"
     and "euclidean_size r < euclidean_size p" for q p r :: "'a poly"
   proof -
     from \<open>p \<noteq> 0\<close> eucl_rel_poly [of r p] have "eucl_rel_poly (r + q * p) p (q + r div p, r mod p)"
       by (simp add: eucl_rel_poly_iff distrib_right)
     then have "(r + q * p) div p = q + r div p"
       by (rule div_poly_eq)
     with that show ?thesis
       by (cases "r = 0") (simp_all add: euclidean_size_poly_def div_poly_less ac_simps)
   qed
 qed (auto simp: euclidean_size_poly_def Rings.div_mult_mod_eq div_poly_less degree_mult_eq power_add
     intro!: degree_mod_less' split: if_splits)
 
 end
 
 instance poly :: ("{field, normalization_euclidean_semiring, factorial_ring_gcd,
                     semiring_gcd_mult_normalize}") euclidean_ring_gcd
   by (rule euclidean_ring_gcd_class.intro, rule factorial_euclidean_semiring_gcdI) standard
 
   
 subsection \<open>Polynomial GCD\<close>
 
 lemma gcd_poly_decompose:
   fixes p q :: "'a :: {factorial_ring_gcd,semiring_gcd_mult_normalize} poly"
   shows "gcd p q = 
            smult (gcd (content p) (content q)) (gcd (primitive_part p) (primitive_part q))"
 proof (rule sym, rule gcdI)
   have "[:gcd (content p) (content q):] * gcd (primitive_part p) (primitive_part q) dvd
           [:content p:] * primitive_part p" by (intro mult_dvd_mono) simp_all
   thus "smult (gcd (content p) (content q)) (gcd (primitive_part p) (primitive_part q)) dvd p"
     by simp
 next
   have "[:gcd (content p) (content q):] * gcd (primitive_part p) (primitive_part q) dvd
           [:content q:] * primitive_part q" by (intro mult_dvd_mono) simp_all
   thus "smult (gcd (content p) (content q)) (gcd (primitive_part p) (primitive_part q)) dvd q"
     by simp
 next
   fix d assume "d dvd p" "d dvd q"
   hence "[:content d:] * primitive_part d dvd 
            [:gcd (content p) (content q):] * gcd (primitive_part p) (primitive_part q)"
     by (intro mult_dvd_mono) auto
   thus "d dvd smult (gcd (content p) (content q)) (gcd (primitive_part p) (primitive_part q))"
     by simp
 qed (auto simp: normalize_smult)
   
 
 lemma gcd_poly_pseudo_mod:
   fixes p q :: "'a :: {factorial_ring_gcd,semiring_gcd_mult_normalize} poly"
   assumes nz: "q \<noteq> 0" and prim: "content p = 1" "content q = 1"
   shows   "gcd p q = gcd q (primitive_part (pseudo_mod p q))"
 proof -
   define r s where "r = fst (pseudo_divmod p q)" and "s = snd (pseudo_divmod p q)"
   define a where "a = [:coeff q (degree q) ^ (Suc (degree p) - degree q):]"
   have [simp]: "primitive_part a = unit_factor a"
     by (simp add: a_def unit_factor_poly_def unit_factor_power monom_0)
   from nz have [simp]: "a \<noteq> 0" by (auto simp: a_def)
   
   have rs: "pseudo_divmod p q = (r, s)" by (simp add: r_def s_def)
   have "gcd (q * r + s) q = gcd q s"
     using gcd_add_mult[of q r s] by (simp add: gcd.commute add_ac mult_ac)
   with pseudo_divmod(1)[OF nz rs]
     have "gcd (p * a) q = gcd q s" by (simp add: a_def)
   also from prim have "gcd (p * a) q = gcd p q"
     by (subst gcd_poly_decompose)
        (auto simp: primitive_part_mult gcd_mult_unit1 primitive_part_prim 
              simp del: mult_pCons_right )
   also from prim have "gcd q s = gcd q (primitive_part s)"
     by (subst gcd_poly_decompose) (simp_all add: primitive_part_prim)
   also have "s = pseudo_mod p q" by (simp add: s_def pseudo_mod_def)
   finally show ?thesis .
 qed
 
 lemma degree_pseudo_mod_less:
   assumes "q \<noteq> 0" "pseudo_mod p q \<noteq> 0"
   shows   "degree (pseudo_mod p q) < degree q"
   using pseudo_mod(2)[of q p] assms by auto
 
 function gcd_poly_code_aux :: "'a :: factorial_ring_gcd poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly" where
   "gcd_poly_code_aux p q = 
      (if q = 0 then normalize p else gcd_poly_code_aux q (primitive_part (pseudo_mod p q)))" 
 by auto
 termination
   by (relation "measure ((\<lambda>p. if p = 0 then 0 else Suc (degree p)) \<circ> snd)")
      (auto simp: degree_pseudo_mod_less)
 
 declare gcd_poly_code_aux.simps [simp del]
 
 lemma gcd_poly_code_aux_correct:
   assumes "content p = 1" "q = 0 \<or> content q = 1"
   shows   "gcd_poly_code_aux p q = gcd p q"
   using assms
 proof (induction p q rule: gcd_poly_code_aux.induct)
   case (1 p q)
   show ?case
   proof (cases "q = 0")
     case True
     thus ?thesis by (subst gcd_poly_code_aux.simps) auto
   next
     case False
     hence "gcd_poly_code_aux p q = gcd_poly_code_aux q (primitive_part (pseudo_mod p q))"
       by (subst gcd_poly_code_aux.simps) simp_all
     also from "1.prems" False 
       have "primitive_part (pseudo_mod p q) = 0 \<or> 
               content (primitive_part (pseudo_mod p q)) = 1"
       by (cases "pseudo_mod p q = 0") auto
     with "1.prems" False 
       have "gcd_poly_code_aux q (primitive_part (pseudo_mod p q)) = 
               gcd q (primitive_part (pseudo_mod p q))"
       by (intro 1) simp_all
     also from "1.prems" False 
       have "\<dots> = gcd p q" by (intro gcd_poly_pseudo_mod [symmetric]) auto
     finally show ?thesis .
   qed
 qed
 
 definition gcd_poly_code 
     :: "'a :: factorial_ring_gcd poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly" 
   where "gcd_poly_code p q = 
            (if p = 0 then normalize q else if q = 0 then normalize p else
               smult (gcd (content p) (content q)) 
                 (gcd_poly_code_aux (primitive_part p) (primitive_part q)))"
 
 lemma gcd_poly_code [code]: "gcd p q = gcd_poly_code p q"
   by (simp add: gcd_poly_code_def gcd_poly_code_aux_correct gcd_poly_decompose [symmetric])
 
 lemma lcm_poly_code [code]: 
   fixes p q :: "'a :: {factorial_ring_gcd,semiring_gcd_mult_normalize} poly"
   shows "lcm p q = normalize (p * q div gcd p q)"
   by (fact lcm_gcd)
 
 lemmas Gcd_poly_set_eq_fold [code] =
   Gcd_set_eq_fold [where ?'a = "'a :: {factorial_ring_gcd,semiring_gcd_mult_normalize} poly"]
 lemmas Lcm_poly_set_eq_fold [code] =
   Lcm_set_eq_fold [where ?'a = "'a :: {factorial_ring_gcd,semiring_gcd_mult_normalize} poly"]
 
 text \<open>Example:
   @{lemma "Lcm {[:1, 2, 3:], [:2, 3, 4:]} = [:[:2:], [:7:], [:16:], [:17:], [:12 :: int:]:]" by eval}
 \<close>
   
 end
diff --git a/src/HOL/Number_Theory/Residue_Primitive_Roots.thy b/src/HOL/Number_Theory/Residue_Primitive_Roots.thy
--- a/src/HOL/Number_Theory/Residue_Primitive_Roots.thy
+++ b/src/HOL/Number_Theory/Residue_Primitive_Roots.thy
@@ -1,1152 +1,1160 @@
 (*
   File:      HOL/Number_Theory/Residue_Primitive_Roots.thy
   Author:    Manuel Eberl
 
   Primitive roots in residue rings: Definition and existence criteria
 *)
 section \<open>Primitive roots in residue rings and Carmichael's function\<close>
 theory Residue_Primitive_Roots
   imports Pocklington
 begin
 
 text \<open>
   This theory develops the notions of primitive roots (generators) in residue rings. It also
   provides a definition and all the basic properties of Carmichael's function $\lambda(n)$, which
   is strongly related to this. The proofs mostly follow Apostol's presentation
 \<close>
 
 subsection \<open>Primitive roots in residue rings\<close>
 
 text \<open>
   A primitive root of a residue ring modulo \<open>n\<close> is an element \<open>g\<close> that \<^emph>\<open>generates\<close> the
   ring, i.\,e.\ such that for each \<open>x\<close> coprime to \<open>n\<close> there exists an \<open>i\<close> such that $x = g^i$.
   A simpler definition is that \<open>g\<close> must have the same order as the cardinality of the
   multiplicative group, which is $\varphi(n)$.
 
   Note that for convenience, this definition does \<^emph>\<open>not\<close> demand \<open>g < n\<close>.
 \<close>
 inductive residue_primroot :: "nat \<Rightarrow> nat \<Rightarrow> bool" where
   "n > 0 \<Longrightarrow> coprime n g \<Longrightarrow> ord n g = totient n \<Longrightarrow> residue_primroot n g"
 
 lemma residue_primroot_def [code]:
   "residue_primroot n x \<longleftrightarrow> n > 0 \<and> coprime n x \<and> ord n x = totient n"
   by (simp add: residue_primroot.simps)
 
 lemma not_residue_primroot_0 [simp]: "~residue_primroot 0 x"
   by (auto simp: residue_primroot_def)
 
 lemma residue_primroot_mod [simp]: "residue_primroot n (x mod n) = residue_primroot n x"
   by (cases "n = 0") (simp_all add: residue_primroot_def)
 
 lemma residue_primroot_cong:
   assumes "[x = x'] (mod n)"
   shows   "residue_primroot n x = residue_primroot n x'"
 proof -
   have "residue_primroot n x = residue_primroot n (x mod n)"
     by simp
   also have "x mod n = x' mod n"
     using assms by (simp add: cong_def)
   also have "residue_primroot n (x' mod n) = residue_primroot n x'"
     by simp
   finally show ?thesis .
 qed
 
 lemma not_residue_primroot_0_right [simp]: "residue_primroot n 0 \<longleftrightarrow> n = 1"
   by (auto simp: residue_primroot_def)
 
 lemma residue_primroot_1_iff: "residue_primroot n (Suc 0) \<longleftrightarrow> n \<in> {1, 2}"
 proof
   assume *: "residue_primroot n (Suc 0)"
   with totient_gt_1[of n] have "n \<le> 2" by (cases "n \<le> 2") (auto simp: residue_primroot_def)
   hence "n \<in> {0, 1, 2}" by auto
   thus "n \<in> {1, 2}" using * by (auto simp: residue_primroot_def)
 qed (auto simp: residue_primroot_def)
 
 
 subsection \<open>Primitive roots modulo a prime\<close>
 
 text \<open>
   For prime \<open>p\<close>, we now analyse the number of elements in the ring $\mathbb{Z}/p\mathbb{Z}$
   whose order is precisely \<open>d\<close> for each \<open>d\<close>.
 \<close>
 context
   fixes n :: nat and \<psi>
   assumes n: "n > 1"
   defines "\<psi> \<equiv> (\<lambda>d. card {x\<in>totatives n. ord n x = d})"
 begin
 
 lemma elements_with_ord_restrict_totatives:
   "d > 0 \<Longrightarrow> {x\<in>{..<n}. ord n x = d} = {x\<in>totatives n. ord n x = d}"
   using n by (auto simp: totatives_def coprime_commute intro!: Nat.gr0I le_neq_trans)
 
 lemma prime_elements_with_ord:
   assumes "\<psi> d \<noteq> 0" and "prime n"
       and a: "a \<in> totatives n" "ord n a = d" "a \<noteq> 1"
   shows   "inj_on (\<lambda>k. a ^ k mod n) {..<d}"
     and   "{x\<in>{..<n}. [x ^ d = 1] (mod n)} = (\<lambda>k. a ^ k mod n) ` {..<d}"
     and   "bij_betw (\<lambda>k. a ^ k mod n) (totatives d) {x\<in>{..<n}. ord n x = d}"
 proof -
   show inj: "inj_on (\<lambda>k. a ^ k mod n) {..<d}"
     using inj_power_mod[of n a] a by (auto simp: totatives_def coprime_commute)
   from a have "d > 0" by (auto simp: totatives_def coprime_commute)
   moreover have "d \<noteq> 1" using a n
     by (auto simp: ord_eq_Suc_0_iff totatives_less cong_def)
   ultimately have d: "d > 1" by simp
 
   have *: "(\<lambda>k. a ^ k mod n) ` {..<d} = {x\<in>{..<n}. [x ^ d = 1] (mod n)}"
   proof (rule card_seteq)
     have "card {x\<in>{..<n}. [x ^ d = 1] (mod n)} \<le> d"
       using assms a by (intro roots_mod_prime_bound) (auto simp: totatives_def coprime_commute)
     also have "\<dots> = card ((\<lambda>k. a ^ k mod n) ` {..<d})"
       using inj by (subst card_image) auto
     finally show "card {x \<in> {..<n}. [x ^ d = 1] (mod n)} \<le> \<dots>" .
   next
     show "(\<lambda>k. a ^ k mod n) ` {..<d} \<subseteq> {x \<in> {..<n}. [x ^ d = 1] (mod n)}"
     proof safe
       fix k assume "k < d"
       have "[(a ^ d) ^ k = 1 ^ k] (mod n)"
         by (intro cong_pow) (use a in \<open>auto simp: ord_divides'\<close>)
       thus "[(a ^ k mod n) ^ d = 1] (mod n)"
         by (simp add: power_mult [symmetric] cong_def power_mod mult.commute)
     qed (use \<open>prime n\<close> in \<open>auto dest: prime_gt_1_nat\<close>)
   qed auto
   thus "{x\<in>{..<n}. [x ^ d = 1] (mod n)} = (\<lambda>k. a ^ k mod n) ` {..<d}" ..
 
   show "bij_betw (\<lambda>k. a ^ k mod n) (totatives d) {x\<in>{..<n}. ord n x = d}"
     unfolding bij_betw_def
   proof (intro conjI inj_on_subset[OF inj] equalityI subsetI)
     fix b assume "b \<in> (\<lambda>k. a ^ k mod n) ` totatives d"
     then obtain k where "b = a ^ k mod n" "k \<in> totatives d" by auto
     thus "b \<in> {b \<in> {..<n}. ord n b = d}"
       using n a by (simp add: ord_power totatives_def coprime_commute)
   next
     fix b assume "b \<in> {x \<in> {..<n}. ord n x = d}"
     hence b: "ord n b = d" "b < n" by auto
     with d have "coprime n b" using ord_eq_0[of n b] by auto
     from b have "b \<in> {x\<in>{..<n}. [x ^ d = 1] (mod n)}"
       by (auto simp: ord_divides')
     with * obtain k where k: "k < d" "b = a ^ k mod n"
       by blast
     with b(2) n a d have "d div gcd k d = ord n b"
       using \<open>coprime n b\<close> by (auto simp: ord_power)
     also have "ord n b = d" by (simp add: b)
     finally have "coprime k d"
       unfolding coprime_iff_gcd_eq_1 using d a by (subst (asm) div_eq_dividend_iff) auto
     with k b d have "k \<in> totatives d" by (auto simp: totatives_def intro!: Nat.gr0I)
     with k show "b \<in> (\<lambda>k. a ^ k mod n) ` totatives d" by blast
   qed (use d n in \<open>auto simp: totatives_less\<close>)
 qed
 
 lemma prime_card_elements_with_ord:
   assumes "\<psi> d \<noteq> 0" and "prime n"
   shows   "\<psi> d = totient d"
 proof (cases "d = 1")
   case True
   have "\<psi> 1 = 1"
     using elements_with_ord_1[of n] n by (simp add: \<psi>_def)
   thus ?thesis using True by simp
 next
   case False
   from assms obtain a where a: "a \<in> totatives n" "ord n a = d"
     by (auto simp: \<psi>_def)
   from a have "d > 0" by (auto intro!: Nat.gr0I simp: ord_eq_0 totatives_def coprime_commute)
   from a and False have "a \<noteq> 1" by auto
   from bij_betw_same_card[OF prime_elements_with_ord(3)[OF assms a this]] show "\<psi> d = totient d"
     using elements_with_ord_restrict_totatives[of d] False a \<open>d > 0\<close>
     by (simp add: \<psi>_def totient_def)
 qed
 
 lemma prime_sum_card_elements_with_ord_eq_totient:
   "(\<Sum>d | d dvd totient n. \<psi> d) = totient n"
 proof -
   have "totient n = card (totatives n)"
     by (simp add: totient_def)
   also have "totatives n = (\<Union>d\<in>{d. d dvd totient n}. {x\<in>totatives n. ord n x = d})"
     by (force simp: order_divides_totient totatives_def coprime_commute)
   also have "card \<dots> = (\<Sum>d | d dvd totient n. \<psi> d)"
     unfolding \<psi>_def using n by (subst card_UN_disjoint) (auto intro!: finite_divisors_nat)
   finally show ?thesis ..
 qed
 
 text \<open>
   We can now show that the number of elements of order \<open>d\<close> is $\varphi(d)$ if $d\mid p - 1$
   and 0 otherwise.
 \<close>
 theorem prime_card_elements_with_ord_eq_totient:
   assumes "prime n"
   shows   "\<psi> d = (if d dvd n - 1 then totient d else 0)"
 proof (cases "d dvd totient n")
   case False
   thus ?thesis using order_divides_totient[of n] assms
     by (auto simp: \<psi>_def totient_prime totatives_def coprime_commute[of n])
 next
   case True
   have "\<psi> d = totient d"
   proof (rule ccontr)
     assume neq: "\<psi> d \<noteq> totient d"
     have le: "\<psi> d \<le> totient d" if "d dvd totient n" for d
       using prime_card_elements_with_ord[of d] assms by (cases "\<psi> d = 0") auto
     from neq and le[of d] and True have less: "\<psi> d < totient d" by auto
   
     have "totient n = (\<Sum>d | d dvd totient n. \<psi> d)"
       using prime_sum_card_elements_with_ord_eq_totient ..
     also have "\<dots> < (\<Sum>d | d dvd totient n. totient d)"
       by (rule sum_strict_mono_ex1)
          (use n le less assms True in \<open>auto intro!: finite_divisors_nat\<close>)
     also have "\<dots> = totient n"
       using totient_divisor_sum .
     finally show False by simp
   qed
   with True show ?thesis using assms by (simp add: totient_prime)
 qed
 
 text \<open>
   As a corollary, we get that the number of primitive roots modulo a prime \<open>p\<close> is
   $\varphi(p - 1)$. Since this number is positive, we also get that there \<^emph>\<open>is\<close> at least
   one primitive root modulo \<open>p\<close>.
 \<close>
 lemma
   assumes "prime n"
   shows   prime_card_primitive_roots:  "card {x\<in>totatives n. ord n x = n - 1} = totient (n - 1)"
                                        "card {x\<in>{..<n}. ord n x = n - 1} = totient (n - 1)"
   and     prime_primitive_root_exists: "\<exists>x. residue_primroot n x"
 proof -
   show *: "card {x\<in>totatives n. ord n x = n - 1} = totient (n - 1)"
     using prime_card_elements_with_ord_eq_totient[of "n - 1"] assms
     by (auto simp: totient_prime \<psi>_def)
   thus "card {x\<in>{..<n}. ord n x = n - 1} = totient (n - 1)"
     using assms n elements_with_ord_restrict_totatives[of "n - 1"] by simp
   
   note *
   also have "totient (n - 1) > 0" using n by auto
   finally show "\<exists>x. residue_primroot n x" using assms prime_gt_1_nat[of n]
     by (subst (asm) card_gt_0_iff)
        (auto simp: residue_primroot_def totient_prime totatives_def coprime_commute)
 qed
 
 end
 
 
 subsection \<open>Primitive roots modulo powers of an odd prime\<close>
 
 text \<open>
   Any primitive root \<open>g\<close> modulo an odd prime \<open>p\<close> is also a primitive root modulo $p^k$ for all
   $k > 0$ if $[g^{p - 1} \neq 1]\ (\text{mod}\ p^2)$. To show this, we first need the
   following lemma.
 \<close>
 lemma residue_primroot_power_prime_power_neq_1:
   assumes "k \<ge> 2"
   assumes p: "prime p" "odd p" and "residue_primroot p g" and "[g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
   shows   "[g ^ totient (p ^ (k - 1)) \<noteq> 1] (mod (p ^ k))"
   using assms(1)
 proof (induction k rule: dec_induct)
   case base
   thus ?case using assms by (simp add: totient_prime)
 next
   case (step k)
   from p have "p > 2"
     using prime_gt_1_nat[of p] by (cases "p = 2") auto
   from assms have g: "g > 0" by (auto intro!: Nat.gr0I)
   have "[g ^ totient (p ^ (k - 1)) = 1] (mod p ^ (k - 1))"
     using assms by (intro euler_theorem)
                    (auto simp: residue_primroot_def totatives_def coprime_commute)
   from cong_to_1_nat[OF this]
     obtain t where *: "g ^ totient (p ^ (k - 1)) - 1 = p ^ (k - 1) * t" by auto
   have t: "g ^ totient (p ^ (k - 1)) = p ^ (k - 1) * t + 1"
     using g by (subst * [symmetric]) auto 
 
   have "\<not>p dvd t"
   proof
     assume "p dvd t"
     then obtain q where [simp]: "t = p * q" by auto
     from t have "g ^ totient (p ^ (k - 1)) = p ^ k * q + 1"
       using \<open>k \<ge> 2\<close> by (cases k) auto
     hence "[g ^ totient (p ^ (k - 1)) = p ^ k * q + 1] (mod p ^ k)"
       by simp
     also have "[p ^ k * q + 1 = 0 * q + 1] (mod p ^ k)"
       by (intro cong_add cong_mult) (auto simp: cong_0_iff)
     finally have "[g ^ totient (p ^ (k - 1)) = 1] (mod p ^ k)"
       by simp
     with step.IH show False by contradiction
   qed
 
   from t have "(g ^ totient (p ^ (k - 1))) ^ p = (p ^ (k - 1) * t + 1) ^ p"
     by (rule arg_cong)
   also have "(g ^ totient (p ^ (k - 1))) ^ p = g ^ (p * totient (p ^ (k - 1)))"
     by (simp add: power_mult [symmetric] mult.commute)
   also have "p * totient (p ^ (k - 1)) = totient (p ^ k)"
     using p \<open>k \<ge> 2\<close> by (simp add: totient_prime_power Suc_diff_Suc flip: power_Suc)
   also have "(p ^ (k - 1) * t + 1) ^ p = (\<Sum>i\<le>p. (p choose i) * t ^ i * p ^ (i * (k - 1)))"
     by (subst binomial) (simp_all add: mult_ac power_mult_distrib power_mult [symmetric])
   finally have "[g ^ totient (p ^ k) = (\<Sum>i\<le>p. (p choose i) * t ^ i * p ^ (i * (k - 1)))]
                   (mod (p ^ Suc k))" (is "[_ = ?rhs] (mod _)") by simp
 
   also have "[?rhs = (\<Sum>i\<le>p. if i \<le> 1 then (p choose i) * t ^ i * p ^ (i * (k - 1)) else 0)]
                (mod (p ^ Suc k))" (is "[sum ?f _ = sum ?g _] (mod _)")
   proof (intro cong_sum)
     fix i assume i: "i \<in> {..p}"
     consider "i \<le> 1" | "i = 2" | "i > 2" by force
     thus "[?f i = ?g i] (mod (p ^ Suc k))"
     proof cases
       assume i: "i > 2"
       have "Suc k \<le> 3 * (k - 1)"
         using \<open>k \<ge> 2\<close> by (simp add: algebra_simps)
       also have "3 * (k - 1) \<le> i * (k - 1)"
         using i by (intro mult_right_mono) auto
       finally have "p ^ Suc k dvd ?f i"
         by (intro dvd_mult le_imp_power_dvd)
       thus "[?f i = ?g i] (mod (p ^ Suc k))"
         by (simp add: cong_0_iff)
     next
       assume [simp]: "i = 2"
       have "?f i = p * (p - 1) div 2 * t\<^sup>2 * p ^ (2 * (k - 1))"
         using choose_two[of p] by simp
       also have "p * (p - 1) div 2 = (p - 1) div 2 * p"
         using \<open>odd p\<close> by (auto elim!: oddE)
       also have "\<dots> * t\<^sup>2 * p ^ (2 * (k - 1)) = (p - 1) div 2 * t\<^sup>2 * (p * p ^ (2 * (k - 1)))"
         by (simp add: algebra_simps)
       also have "p * p ^ (2 * (k - 1)) = p ^ (2 * k - 1)"
         using \<open>k \<ge> 2\<close> by (cases k) auto
       also have "p ^ Suc k dvd (p - 1) div 2 * t\<^sup>2 * p ^ (2 * k - 1)"
         using \<open>k \<ge> 2\<close> by (intro dvd_mult le_imp_power_dvd) auto
       finally show "[?f i = ?g i] (mod (p ^ Suc k))"
         by (simp add: cong_0_iff)
     qed auto
   qed
   also have "(\<Sum>i\<le>p. ?g i) = (\<Sum>i\<le>1. ?f i)"
     using p prime_gt_1_nat[of p] by (intro sum.mono_neutral_cong_right) auto
   also have "\<dots> = 1 + t * p ^ k"
     using choose_two[of p] \<open>k \<ge> 2\<close> by (cases k) simp_all
   finally have eq: "[g ^ totient (p ^ k) = 1 + t * p ^ k] (mod p ^ Suc k)" .
 
   have "[g ^ totient (p ^ k) \<noteq> 1] (mod p ^ Suc k)"
   proof
     assume "[g ^ totient (p ^ k) = 1] (mod p ^ Suc k)"
     hence "[g ^ totient (p ^ k) - g ^ totient (p ^ k) = 1 + t * p ^ k - 1] (mod p ^ Suc k)"
       by (intro cong_diff_nat eq) auto
     hence "[t * p ^ k = 0] (mod p ^ Suc k)"
       by (simp add: cong_sym_eq)
     hence "p * p ^ k dvd t * p ^ k"
       by (simp add: cong_0_iff)
     hence "p dvd t" using \<open>p > 2\<close> by simp
     with \<open>\<not>p dvd t\<close> show False by contradiction
   qed
   thus ?case by simp
 qed
 
 text \<open>
   We can now show that primitive roots modulo \<open>p\<close> with the above condition are
   indeed also primitive roots modulo $p^k$.
 \<close>
 proposition residue_primroot_prime_lift_iff:
   assumes p: "prime p" "odd p" and "residue_primroot p g"
   shows   "(\<forall>k>0. residue_primroot (p ^ k) g) \<longleftrightarrow> [g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
 proof -
   from assms have g: "coprime p g" "ord p g = p - 1"
     by (auto simp: residue_primroot_def totient_prime)
   show ?thesis
   proof
     assume "\<forall>k>0. residue_primroot (p ^ k) g"
     hence "residue_primroot (p\<^sup>2) g" by auto
     hence "ord (p\<^sup>2) g = totient (p\<^sup>2)"
       by (simp_all add: residue_primroot_def)
     thus "[g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
       using g assms prime_gt_1_nat[of p]
       by (auto simp: ord_divides' totient_prime_power)
   next
     assume g': "[g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
 
     have "residue_primroot (p ^ k) g" if "k > 0" for k
     proof (cases "k = 1")
       case False
       with that have k: "k > 1" by simp
       from g have coprime: "coprime (p ^ k) g"
         by (auto simp: totatives_def coprime_commute)
 
       define t where "t = ord (p ^ k) g"
       have "[g ^ t = 1] (mod (p ^ k))"
         by (simp add: t_def ord_divides')
       also have "p ^ k = p * p ^ (k - 1)"
         using k by (cases k) auto
       finally have "[g ^ t = 1] (mod p)"
         by (rule cong_modulus_mult_nat)
       hence "totient p dvd t"
         using g p by (simp add: ord_divides' totient_prime)
       then obtain q where t: "t = totient p * q" by auto
 
       have "t dvd totient (p ^ k)"
         using coprime by (simp add: t_def order_divides_totient)
       with t p k have "q dvd p ^ (k - 1)" using prime_gt_1_nat[of p]
         by (auto simp: totient_prime totient_prime_power)
       then obtain b where b: "b \<le> k - 1" "q = p ^ b"
         using divides_primepow_nat[of p q "k - 1"] p by auto
 
       have "b = k - 1"
       proof (rule ccontr)
         assume "b \<noteq> k - 1"
         with b have "b < k - 1" by simp
         have "t = p ^ b * (p - 1)"
           using b p by (simp add: t totient_prime)
         also have "\<dots> dvd p ^ (k - 2) * (p - 1)"
           using \<open>b < k - 1\<close> by (intro mult_dvd_mono le_imp_power_dvd) auto
         also have "\<dots> = totient (p ^ (k - 1))"
           using k p by (simp add: totient_prime_power numeral_2_eq_2)
         finally have "[g ^ totient (p ^ (k - 1)) = 1] (mod (p ^ k))"
           by (simp add: ord_divides' t_def)
         with residue_primroot_power_prime_power_neq_1[of k p g] p k assms g' show False
           by auto
       qed
       hence "t = totient (p ^ k)"
         using p k by (simp add: t b totient_prime totient_prime_power)
       thus "residue_primroot (p ^ k) g"
         using g one_less_power[of p k] prime_gt_1_nat[of p] p k
         by (simp add: residue_primroot_def t_def)
     qed (use assms in auto)
     thus "\<forall>k>0. residue_primroot (p ^ k) g" by blast
   qed
 qed
 
 text \<open>
   If \<open>p\<close> is an odd prime, there is always a primitive root \<open>g\<close> modulo \<open>p\<close>, and if \<open>g\<close> does not
   fulfil the above assumption required for it to be liftable to $p^k$, we can use $g + p$, which
   is also a primitive root modulo \<open>p\<close> and \<^emph>\<open>does\<close> fulfil the assumption.
 
   This shows that any modulus that is a power of an odd prime has a primitive root.
 \<close>
 theorem residue_primroot_odd_prime_power_exists:
   assumes p: "prime p" "odd p"
   obtains g where "\<forall>k>0. residue_primroot (p ^ k) g"
 proof -
   obtain g where g: "residue_primroot p g"
     using prime_primitive_root_exists[of p] assms prime_gt_1_nat[of p] by auto
 
   have "\<exists>g. residue_primroot p g \<and> [g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
   proof (cases "[g ^ (p - 1) = 1] (mod p\<^sup>2)")
     case True
     define g' where "g' = p + g"
     note g
     also have "residue_primroot p g \<longleftrightarrow> residue_primroot p g'"
       unfolding g'_def by (rule residue_primroot_cong) (auto simp: cong_def)
     finally have g': "residue_primroot p g'" .
 
     have "[g' ^ (p - 1) = (\<Sum>k\<le>p-1. ((p-1) choose k) * g ^ (p - Suc k) * p ^ k)] (mod p\<^sup>2)"
       (is "[_ = ?rhs] (mod _)") by (simp add: g'_def binomial mult_ac)
     also have "[?rhs = (\<Sum>k\<le>p-1. if k \<le> 1 then ((p-1) choose k) *
                                    g ^ (p - Suc k) * p ^ k else 0)] (mod p\<^sup>2)"
       (is "[sum ?f _ = sum ?g _] (mod _)")
     proof (intro cong_sum)
       fix k assume "k \<in> {..p-1}"
       show "[?f k = ?g k] (mod p\<^sup>2)"
       proof (cases "k \<le> 1")
         case False
         have "p\<^sup>2 dvd ?f k"
           using False by (intro dvd_mult le_imp_power_dvd) auto
         thus ?thesis using False by (simp add: cong_0_iff)
       qed auto
     qed
     also have "sum ?g {..p-1} = sum ?f {0, 1}"
       using prime_gt_1_nat[of p] p by (intro sum.mono_neutral_cong_right) auto
     also have "\<dots> = g ^ (p - 1) + p * (p - 1) * g ^ (p - 2)"
       using p by (simp add: numeral_2_eq_2)
     also have "[g ^ (p - 1) + p * (p - 1) * g ^ (p - 2) = 1 + p * (p - 1) * g ^ (p - 2)] (mod p\<^sup>2)"
       by (intro cong_add True) auto
     finally have "[g' ^ (p - 1) = 1 + p * (p - 1) * g ^ (p - 2)] (mod p\<^sup>2)" .
 
     moreover have "[1 + p * (p - 1) * g ^ (p - 2) \<noteq> 1] (mod p\<^sup>2)"
     proof
       assume "[1 + p * (p - 1) * g ^ (p - 2) = 1] (mod p\<^sup>2)"
       hence "[1 + p * (p - 1) * g ^ (p - 2) - 1 = 1 - 1] (mod p\<^sup>2)"
         by (intro cong_diff_nat) auto
       hence "p * p dvd p * ((p - 1) * g ^ (p - 2))"
         by (auto simp: cong_0_iff power2_eq_square)
       hence "p dvd (p - 1) * g ^ (p - 2)"
         using p by simp
       hence "p dvd g ^ (p - 2)"
         using p dvd_imp_le[of p "p - Suc 0"] prime_gt_1_nat[of p]
         by (auto simp: prime_dvd_mult_iff)
       also have "\<dots> dvd g ^ (p - 1)"
         by (intro le_imp_power_dvd) auto
       finally have "[g ^ (p - 1) = 0] (mod p)"
         by (simp add: cong_0_iff)
       hence "[0 = g ^ (p - 1)] (mod p)"
         by (simp add: cong_sym_eq)
 
       also from \<open>residue_primroot p g\<close> have "[g ^ (p - 1) = 1] (mod p)"
         using p by (auto simp: residue_primroot_def ord_divides' totient_prime)
       finally have "[0 = 1] (mod p)" .
       thus False using prime_gt_1_nat[of p] p by (simp add: cong_def)
     qed
 
     ultimately have "[g' ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
       by (simp add: cong_def)
     thus "\<exists>g. residue_primroot p g \<and> [g ^ (p - 1) \<noteq> 1] (mod p\<^sup>2)"
       using g' by blast    
   qed (use g in auto)
   thus ?thesis
     using residue_primroot_prime_lift_iff[OF assms] that by blast
 qed
 
 
 subsection \<open>Carmichael's function\<close>
 
 text \<open>
   Carmichael's function $\lambda(n)$ gives the LCM of the orders of all elements in the
   residue ring modulo $n$ -- or, equivalently, the maximum order, as we will show later.
   Algebraically speaking, it is the exponent of the multiplicative group
   $(\mathbb{Z}/n\mathbb{Z})^*$.
 
   It is not to be confused with Liouville's function, which is also denoted by $\lambda(n)$.
 \<close>
 definition Carmichael where
   "Carmichael n = (LCM a \<in> totatives n. ord n a)"
 
 lemma Carmichael_0 [simp]: "Carmichael 0 = 1"
   by (simp add: Carmichael_def)
 
 lemma Carmichael_1 [simp]: "Carmichael 1 = 1"
   by (simp add: Carmichael_def)
 
 lemma Carmichael_Suc_0 [simp]: "Carmichael (Suc 0) = 1"
   by (simp add: Carmichael_def)
 
 lemma ord_dvd_Carmichael:
   assumes "n > 1" "coprime n k"
   shows   "ord n k dvd Carmichael n"
 proof -
   have "k mod n \<in> totatives n"
     using assms by (auto simp: totatives_def coprime_commute intro!: Nat.gr0I)
   hence "ord n (k mod n) dvd Carmichael n"
     by (simp add: Carmichael_def del: ord_mod)
   thus ?thesis by simp
 qed
 
 lemma Carmichael_divides:
   assumes "Carmichael n dvd k" "coprime n a"
   shows   "[a ^ k = 1] (mod n)"
 proof (cases "n < 2 \<or> a = 1")
   case False
   hence "ord n a dvd Carmichael n"
     using False assms by (intro ord_dvd_Carmichael) auto
   also have "\<dots> dvd k" by fact
   finally have "ord n a dvd k" .
   thus ?thesis using ord_divides by auto
 next
   case True
   then consider "a = 1" | "n = 0" | "n = 1" by force
   thus ?thesis using assms by cases auto
 qed
 
 lemma Carmichael_dvd_totient: "Carmichael n dvd totient n"
   unfolding Carmichael_def
 proof (intro Lcm_least, safe)
   fix a assume "a \<in> totatives n"
   hence "[a ^ totient n = 1] (mod n)"
     by (intro euler_theorem) (auto simp: totatives_def)
   thus "ord n a dvd totient n"
     using ord_divides by blast
 qed
 
 lemma Carmichael_dvd_mono_coprime:
   assumes "coprime m n" "m > 1" "n > 1"
   shows   "Carmichael m dvd Carmichael (m * n)"
   unfolding Carmichael_def[of m]
 proof (intro Lcm_least, safe)
   fix x assume x: "x \<in> totatives m"
   from assms have "totatives n \<noteq> {}" by simp
   then obtain y where y: "y \<in> totatives n" by blast
 
   from binary_chinese_remainder_nat[OF assms(1), of x y]
   obtain z where z: "[z = x] (mod m)" "[z = y] (mod n)" by blast
   have z': "coprime z n" "coprime z m"
     by (rule cong_imp_coprime; use x y z in \<open>force simp: totatives_def cong_sym_eq\<close>)+
 
   from z have "ord m x = ord m z"
     by (intro ord_cong) (auto simp: cong_sym_eq)
   also have "ord m z dvd ord (m * n) z"
     using assms by (auto simp: ord_modulus_mult_coprime)
   also from z' assms have "\<dots> dvd Carmichael (m * n)"
     by (intro ord_dvd_Carmichael) (auto simp: coprime_commute intro!:one_less_mult)
   finally show "ord m x dvd Carmichael (m * n)" .
 qed
 
 text \<open>
   $\lambda$ distributes over the product of coprime numbers similarly to $\varphi$, but
   with LCM instead of multiplication:
 \<close>
 lemma Carmichael_mult_coprime:
   assumes "coprime m n"
   shows   "Carmichael (m * n) = lcm (Carmichael m) (Carmichael n)"
 proof (cases "m \<le> 1 \<or> n \<le> 1")
   case True
   hence "m = 0 \<or> n = 0 \<or> m = 1 \<or> n = 1" by force
   thus ?thesis using assms by auto
 next
   case False
   show ?thesis
   proof (rule dvd_antisym)
     show "Carmichael (m * n) dvd lcm (Carmichael m) (Carmichael n)"
       unfolding Carmichael_def[of "m * n"]
     proof (intro Lcm_least, safe)
       fix x assume x: "x \<in> totatives (m * n)"
       have "ord (m * n) x = lcm (ord m x) (ord n x)"
         using assms x by (subst ord_modulus_mult_coprime) (auto simp: coprime_commute totatives_def)
       also have "\<dots> dvd lcm (Carmichael m) (Carmichael n)"
         using False x
         by (intro lcm_mono ord_dvd_Carmichael) (auto simp: totatives_def coprime_commute)
       finally show "ord (m * n) x dvd \<dots>" .
     qed
   next
     show "lcm (Carmichael m) (Carmichael n) dvd Carmichael (m * n)"
       using Carmichael_dvd_mono_coprime[of m n]
             Carmichael_dvd_mono_coprime[of n m] assms False
       by (auto intro!: lcm_least simp: coprime_commute mult.commute)
   qed
 qed
 
 lemma Carmichael_pos [simp, intro]: "Carmichael n > 0"
   by (auto simp: Carmichael_def ord_eq_0 totatives_def coprime_commute intro!: Nat.gr0I)
 
 lemma Carmichael_nonzero [simp]: "Carmichael n \<noteq> 0"
   by simp
 
 lemma power_Carmichael_eq_1:
   assumes "n > 1" "coprime n x"
   shows   "[x ^ Carmichael n = 1] (mod n)"
   using ord_dvd_Carmichael[of n x] assms
   by (auto simp: ord_divides')
 
 lemma Carmichael_2 [simp]: "Carmichael 2 = 1"
   using Carmichael_dvd_totient[of 2] by simp
 
 lemma Carmichael_4 [simp]: "Carmichael 4 = 2"
 proof -
   have "Carmichael 4 dvd 2"
     using Carmichael_dvd_totient[of 4] by simp
   hence "Carmichael 4 \<le> 2" by (rule dvd_imp_le) auto
   moreover have "Carmichael 4 \<noteq> 1"
     using power_Carmichael_eq_1[of "4::nat" 3]
     unfolding coprime_iff_gcd_eq_1 by (auto simp: gcd_non_0_nat cong_def)
   ultimately show ?thesis
     using Carmichael_pos[of 4] by linarith
 qed
 
 lemma residue_primroot_Carmichael:
   assumes "residue_primroot n g"
   shows   "Carmichael n = totient n"
 proof (cases "n = 1")
   case False
   show ?thesis
   proof (intro dvd_antisym Carmichael_dvd_totient)
     have "ord n g dvd Carmichael n"
       using assms False by (intro ord_dvd_Carmichael) (auto simp: residue_primroot_def)
     thus "totient n dvd Carmichael n"
       using assms by (auto simp: residue_primroot_def)
   qed
 qed auto
 
 lemma Carmichael_odd_prime_power:
   assumes "prime p" "odd p" "k > 0"
   shows   "Carmichael (p ^ k) = p ^ (k - 1) * (p - 1)"
 proof -
   from assms obtain g where "residue_primroot (p ^ k) g"
     using residue_primroot_odd_prime_power_exists[of p] assms by metis
   hence "Carmichael (p ^ k) = totient (p ^ k)"
     by (intro residue_primroot_Carmichael[of "p ^ k" g]) auto
   with assms show ?thesis by (simp add: totient_prime_power)
 qed
 
 lemma Carmichael_prime:
   assumes "prime p"
   shows   "Carmichael p = p - 1"
 proof (cases "even p")
   case True
   with assms have "p = 2"
     using primes_dvd_imp_eq two_is_prime_nat by blast
   thus ?thesis by simp
 next
   case False
   with Carmichael_odd_prime_power[of p 1] assms show ?thesis by simp
 qed
   
 lemma Carmichael_twopow_ge_8:
   assumes "k \<ge> 3"
   shows   "Carmichael (2 ^ k) = 2 ^ (k - 2)"
 proof (intro dvd_antisym)
   have "2 ^ (k - 2) = ord (2 ^ k) (3 :: nat)"
     using ord_twopow_3_5[of k 3] assms by simp
   also have "\<dots> dvd Carmichael (2 ^ k)"
     using assms one_less_power[of "2::nat" k] by (intro ord_dvd_Carmichael) auto
   finally show "2 ^ (k - 2) dvd \<dots>" .
 next
   show "Carmichael (2 ^ k) dvd 2 ^ (k - 2)"
     unfolding Carmichael_def
   proof (intro Lcm_least, safe)
     fix x assume "x \<in> totatives (2 ^ k)"
     hence "odd x" by (auto simp: totatives_def)
     hence "[x ^ 2 ^ (k - 2) = 1] (mod 2 ^ k)"
       using assms ord_twopow_aux[of k x] by auto
     thus "ord (2 ^ k) x dvd 2 ^ (k - 2)"
       by (simp add: ord_divides')
   qed
 qed
 
 lemma Carmichael_twopow:
   "Carmichael (2 ^ k) = (if k \<le> 2 then 2 ^ (k - 1) else 2 ^ (k - 2))"
 proof -
   have "k = 0 \<or> k = 1 \<or> k = 2 \<or> k \<ge> 3" by linarith
   thus ?thesis by (auto simp: Carmichael_twopow_ge_8)
 qed
 
 lemma Carmichael_prime_power:
   assumes "prime p" "k > 0"
   shows   "Carmichael (p ^ k) =
              (if p = 2 \<and> k > 2 then 2 ^ (k - 2) else p ^ (k - 1) * (p - 1))"
 proof (cases "p = 2")
   case True
   thus ?thesis by (simp add: Carmichael_twopow)
 next
   case False
   with assms have "odd p" "p > 2"
     using prime_odd_nat[of p] prime_gt_1_nat[of p] by auto
   thus ?thesis
     using assms Carmichael_odd_prime_power[of p k] by simp
 qed
 
 lemma Carmichael_prod_coprime:
   assumes "finite A" "\<And>i j. i \<in> A \<Longrightarrow> j \<in> A \<Longrightarrow> i \<noteq> j \<Longrightarrow> coprime (f i) (f j)"
   shows   "Carmichael (\<Prod>i\<in>A. f i) = (LCM i\<in>A. Carmichael (f i))"
   using assms by (induction A rule: finite_induct)
                  (simp, simp, subst Carmichael_mult_coprime[OF prod_coprime_right], auto)
 
 text \<open>
   Since $\lambda$ distributes over coprime factors and we know the value of $\lambda(p^k)$
   for prime $p$, we can now give a closed formula for $\lambda(n)$ in terms of the prime
   factorisation of $n$:
 \<close>
 theorem Carmichael_closed_formula:
   "Carmichael n =
      (LCM p\<in>prime_factors n. let k = multiplicity p n
                              in  if p = 2 \<and> k > 2 then 2 ^ (k - 2) else p ^ (k - 1) * (p - 1))"
   (is "_ = Lcm ?A")
 proof (cases "n = 0")
   case False
   hence "n = (\<Prod>p\<in>prime_factors n. p ^ multiplicity p n)"
     using prime_factorization_nat by blast
   also have "Carmichael \<dots> =
                (LCM p\<in>prime_factors n. Carmichael (p ^ multiplicity p n))"
     by (subst Carmichael_prod_coprime) (auto simp: in_prime_factors_iff primes_coprime)
   also have "(\<lambda>p. Carmichael (p ^ multiplicity p n)) ` prime_factors n = ?A"
     by (intro image_cong)
        (auto simp: Let_def Carmichael_prime_power prime_factors_multiplicity)
   finally show ?thesis .
 qed auto
 
 corollary even_Carmichael:
   assumes "n > 2"
   shows   "even (Carmichael n)"
 proof (cases "\<exists>k. n = 2 ^ k")
   case True
   then obtain k where [simp]: "n = 2 ^ k" by auto
   from assms have "k \<noteq> 0" "k \<noteq> 1" by (auto intro!: Nat.gr0I)
   hence "k \<ge> 2" by auto
   thus ?thesis by (auto simp: Carmichael_twopow)
 next
   case False
   from assms have "n \<noteq> 0" by auto
   from False have "\<exists>p\<in>prime_factors n. p \<noteq> 2"
     using assms Ex_other_prime_factor[of n 2] by auto
-  from divide_out_primepow_ex[OF \<open>n \<noteq> 0\<close> this] guess p k n' . note p = this
+  from divide_out_primepow_ex[OF \<open>n \<noteq> 0\<close> this]
+  obtain p k n'
+    where p:
+      "p \<noteq> 2"
+      "prime p"
+      "p dvd n"
+      "\<not> p dvd n'"
+      "0 < k"
+      "n = p ^ k * n'" .
   from p have coprime: "coprime (p ^ k) n'"
     using p prime_imp_coprime by auto
   have "odd p"
     using p primes_dvd_imp_eq[of 2 p] by auto
   have "even (Carmichael (p ^ k))"
     using p \<open>odd p\<close> by (auto simp: Carmichael_prime_power)
   with p coprime show ?thesis
     by (auto simp: Carmichael_mult_coprime intro!: dvd_lcmI1)
 qed
 
 lemma eval_Carmichael:
   assumes "prime_factorization n = A"
   shows     "Carmichael n = (LCM p \<in> set_mset A.
                let k = count A p in if p = 2 \<and> k > 2 then 2 ^ (k - 2) else p ^ (k - 1) * (p - 1))"
   unfolding assms [symmetric] Carmichael_closed_formula
   by (intro arg_cong[where f = Lcm] image_cong) (auto simp: Let_def count_prime_factorization)
 
 text \<open>
   Any residue ring always contains a $\lambda$-root, i.\,e.\ an element whose
   order is $\lambda(n)$.
 \<close>
 theorem Carmichael_root_exists:
   assumes "n > (0::nat)"
   obtains g where "g \<in> totatives n" and "ord n g = Carmichael n"
 proof (cases "n = 1")
   case True
   thus ?thesis by (intro that[of 1]) (auto simp: totatives_def)
 next
   case False
   have primepow: "\<exists>g. coprime (p ^ k) g \<and> ord (p ^ k) g = Carmichael (p ^ k)"
     if pk: "prime p" "k > 0" for p k
   proof (cases "p = 2")
     case [simp]: True
     from \<open>k > 0\<close> consider "k = 1" | "k = 2" | "k \<ge> 3" by force
     thus ?thesis
     proof cases
       assume "k = 1"
       thus ?thesis by (intro exI[of _ 1]) auto
     next
       assume [simp]: "k = 2"
       have "coprime 4 (3::nat)"
         by (auto simp: coprime_iff_gcd_eq_1 gcd_non_0_nat)
       thus ?thesis by (intro exI[of _ 3]) auto
     next
       assume k: "k \<ge> 3"
       have "coprime (2 ^ k :: nat) 3" by auto
       thus ?thesis using k
         by (intro exI[of _ 3]) (auto simp: ord_twopow_3_5 Carmichael_twopow)
     qed
   next
     case False
     hence "odd p" using \<open>prime p\<close>
       using primes_dvd_imp_eq two_is_prime_nat by blast
     then obtain g where "residue_primroot (p ^ k) g"
       using residue_primroot_odd_prime_power_exists[of p] pk by metis
     thus ?thesis using False pk
       by (intro exI[of _ g])
          (auto simp: Carmichael_prime_power residue_primroot_def totient_prime_power)
   qed
 
   define P where "P = prime_factors n"
   define k where "k = (\<lambda>p. multiplicity p n)"
   have "\<forall>p\<in>P. \<exists>g. coprime (p ^ k p) g \<and> ord (p ^ k p) g = Carmichael (p ^ k p)"
     using primepow by (auto simp: P_def k_def prime_factors_multiplicity)
   hence "\<exists>g. \<forall>p\<in>P. coprime (p ^ k p) (g p) \<and> ord (p ^ k p) (g p) = Carmichael (p ^ k p)"
     by (subst (asm) bchoice_iff)
   then obtain g where g: "\<And>p. p \<in> P \<Longrightarrow> coprime (p ^ k p) (g p)"
                          "\<And>p. p \<in> P \<Longrightarrow> ord (p ^ k p) (g p) = Carmichael (p ^ k p)" by metis
   have "\<exists>x. \<forall>i\<in>P. [x = g i] (mod i ^ k i)"
     by (intro chinese_remainder_nat)
        (auto simp: P_def k_def in_prime_factors_iff primes_coprime)
   then obtain x where x: "\<And>p. p \<in> P \<Longrightarrow> [x = g p] (mod p ^ k p)" by metis
 
   have "n = (\<Prod>p\<in>P. p ^ k p)"
     using assms unfolding P_def k_def by (rule prime_factorization_nat)
   also have "ord \<dots> x = (LCM p\<in>P. ord (p ^ k p) x)"
     by (intro ord_modulus_prod_coprime) (auto simp: P_def in_prime_factors_iff primes_coprime)
   also have "(\<lambda>p. ord (p ^ k p) x) ` P = (\<lambda>p. ord (p ^ k p) (g p)) ` P"
     by (intro image_cong ord_cong x) auto
   also have "\<dots> = (\<lambda>p. Carmichael (p ^ k p)) ` P"
     by (intro image_cong g) auto
   also have "Lcm \<dots> = Carmichael (\<Prod>p\<in>P. p ^ k p)"
     by (intro Carmichael_prod_coprime [symmetric])
        (auto simp: P_def in_prime_factors_iff primes_coprime)
   also have "(\<Prod>p\<in>P. p ^ k p) = n"
     using assms unfolding P_def k_def by (rule prime_factorization_nat [symmetric])
   finally have "ord n x = Carmichael n" .
   moreover from this have "coprime n x"
     by (cases "coprime n x") (auto split: if_splits)
   ultimately show ?thesis using assms False
     by (intro that[of "x mod n"])
        (auto simp: totatives_def coprime_commute coprime_absorb_left intro!: Nat.gr0I)
 qed
 
 text \<open>
   This also means that the Carmichael number is not only the LCM of the orders
   of the elements of the residue ring, but indeed the maximum of the orders.
 \<close>
 lemma Carmichael_altdef:
   "Carmichael n = (if n = 0 then 1 else Max (ord n ` totatives n))"
 proof (cases "n = 0")
   case False
   have "Carmichael n = Max (ord n ` totatives n)"
   proof (intro antisym Max.boundedI Max.coboundedI)
     fix k assume k: "k \<in> ord n ` totatives n"
     thus "k \<le> Carmichael n"
     proof (cases "n = 1")
       case False
       with \<open>n \<noteq> 0\<close> have "n > 1" by linarith
       thus ?thesis using k \<open>n \<noteq> 0\<close>
         by (intro dvd_imp_le)
            (auto intro!: ord_dvd_Carmichael simp: totatives_def coprime_commute)
     qed auto
   next
     obtain g where "g \<in> totatives n" and "ord n g = Carmichael n"
       using Carmichael_root_exists[of n] \<open>n \<noteq> 0\<close> by auto
     thus "Carmichael n \<in> ord n ` totatives n" by force
   qed (use \<open>n \<noteq> 0\<close> in auto)
   thus ?thesis using False by simp
 qed auto
 
 
 subsection \<open>Existence of primitive roots for general moduli\<close>
 
 text \<open>
   We now related Carmichael's function to the existence of primitive roots and, in the end,
   use this to show precisely which moduli have primitive roots and which do not.
 
   The first criterion for the existence of a primitive root is this: A primitive root modulo $n$
   exists iff $\lambda(n) = \varphi(n)$.
 \<close>
 lemma Carmichael_eq_totient_imp_primroot:
   assumes "n > 0" and "Carmichael n = totient n"
   shows   "\<exists>g. residue_primroot n g"
 proof -
   from \<open>n > 0\<close> obtain g where "g \<in> totatives n" and "ord n g = Carmichael n"
     using Carmichael_root_exists[of n] by metis
   with assms show ?thesis by (auto simp: residue_primroot_def totatives_def coprime_commute)
 qed
 
 theorem residue_primroot_iff_Carmichael:
   "(\<exists>g. residue_primroot n g) \<longleftrightarrow> Carmichael n = totient n \<and> n > 0"
 proof safe
   fix g assume g: "residue_primroot n g"
   thus "n > 0" by (auto simp: residue_primroot_def)
   have "coprime n g" by (rule ccontr) (use g in \<open>auto simp: residue_primroot_def\<close>)
 
   show "Carmichael n = totient n"
   proof (cases "n = 1")
     case False
     with \<open>n > 0\<close> have "n > 1" by auto
     with \<open>coprime n g\<close> have "ord n g dvd Carmichael n"
       by (intro ord_dvd_Carmichael) auto
     thus ?thesis using g by (intro dvd_antisym Carmichael_dvd_totient)
                             (auto simp: residue_primroot_def)
   qed auto
 qed (use Carmichael_eq_totient_imp_primroot[of n] in auto)
 
 text \<open>
   Any primitive root modulo $mn$ for coprime $m$, $n$ is also a primitive root modulo $m$ and $n$.
   The converse does not hold in general.
 \<close>
 lemma residue_primroot_modulus_mult_coprimeD:
   assumes "coprime m n" and "residue_primroot (m * n) g"
   shows   "residue_primroot m g" "residue_primroot n g"
 proof -
   have *: "m > 0" "n > 0" "coprime m g" "coprime n g"
           "lcm (ord m g) (ord n g) = totient m * totient n"
     using assms
     by (auto simp: residue_primroot_def ord_modulus_mult_coprime totient_mult_coprime)
 
   define a b where "a = totient m div ord m g" and "b = totient n div ord n g"
   have ab: "totient m = ord m g * a" "totient n = ord n g * b"
     using * by (auto simp: a_def b_def order_divides_totient)
 
   have "a = 1" "b = 1" "coprime (ord m g) (ord n g)"
     unfolding coprime_iff_gcd_eq_1 using * by (auto simp: ab lcm_nat_def dvd_div_eq_mult ord_eq_0)
   with ab and * show "residue_primroot m g" "residue_primroot n g"
     by (auto simp: residue_primroot_def)
 qed
 
 text \<open>
   If a primitive root modulo $mn$ exists for coprime $m, n$, then $\lambda(m)$ and $\lambda(n)$
   must also be coprime. This is helpful in establishing that there are no primitive roots
   modulo $mn$ by showing e.\,g.\ that $\lambda(m)$ and $\lambda(n)$ are both even.
 \<close>
 lemma residue_primroot_modulus_mult_coprime_imp_Carmichael_coprime:
   assumes "coprime m n" and "residue_primroot (m * n) g"
   shows   "coprime (Carmichael m) (Carmichael n)"
 proof -
   from residue_primroot_modulus_mult_coprimeD[OF assms]
     have *: "residue_primroot m g" "residue_primroot n g" by auto
   hence [simp]: "Carmichael m = totient m" "Carmichael n = totient n"
     by (simp_all add: residue_primroot_Carmichael)
   from * have mn: "m > 0" "n > 0" by (auto simp: residue_primroot_def)
   
   from assms have "Carmichael (m * n) = totient (m * n) \<and> n > 0"
     using residue_primroot_iff_Carmichael[of "m * n"] by auto
   with assms have "lcm (totient m) (totient n) = totient m * totient n"
     by (simp add: Carmichael_mult_coprime totient_mult_coprime)
   thus ?thesis unfolding coprime_iff_gcd_eq_1 using mn
     by (simp add: lcm_nat_def dvd_div_eq_mult)
 qed
   
 text \<open>
   The following moduli are precisely those that have primitive roots.
 \<close>
 definition cyclic_moduli :: "nat set" where
   "cyclic_moduli = {1, 2, 4} \<union> {p ^ k |p k. prime p \<and> odd p \<and> k > 0} \<union>
                      {2 * p ^ k |p k. prime p \<and> odd p \<and> k > 0}"
 
 theorem residue_primroot_iff_in_cyclic_moduli:
   "(\<exists>g. residue_primroot m g) \<longleftrightarrow> m \<in> cyclic_moduli"
 proof -
   have "(\<exists>g. residue_primroot m g)" if "m \<in> cyclic_moduli"
   using that unfolding cyclic_moduli_def
   by (intro Carmichael_eq_totient_imp_primroot)
      (auto dest: prime_gt_0_nat simp: Carmichael_prime_power totient_prime_power
                  Carmichael_mult_coprime totient_mult_coprime)
 
   moreover have "\<not>(\<exists>g. residue_primroot m g)" if "m \<notin> cyclic_moduli"
   proof (cases "m = 0")
     case False
     with that have [simp]: "m > 0" "m \<noteq> 1" by (auto simp: cyclic_moduli_def)
     show ?thesis
     proof (cases "\<exists>k. m = 2 ^ k")
       case True
       then obtain k where [simp]: "m = 2 ^ k" by auto
       with that have "k \<noteq> 0 \<and> k \<noteq> 1 \<and> k \<noteq> 2" by (auto simp: cyclic_moduli_def)
       hence "k \<ge> 3" by auto
       thus ?thesis by (subst residue_primroot_iff_Carmichael)
                       (auto simp: Carmichael_twopow totient_prime_power)
     next
       case False
       hence "\<exists>p\<in>prime_factors m. p \<noteq> 2"
         using Ex_other_prime_factor[of m 2] by auto
       from divide_out_primepow_ex[OF \<open>m \<noteq> 0\<close> this]
       obtain p k m' where p: "p \<noteq> 2" "prime p" "p dvd m" "\<not>p dvd m'" "0 < k" "m = p ^ k * m'"
         by metis
       have "odd p"
         using p primes_dvd_imp_eq[of 2 p] by auto
       from p have coprime: "coprime (p ^ k) m'"
         using p prime_imp_coprime by auto
       have "m \<in> cyclic_moduli" if "m' = 1"
         using that p \<open>odd p\<close> by (auto simp: cyclic_moduli_def)
       moreover have "m \<in> cyclic_moduli" if "m' = 2"
       proof -
         have "m = 2 * p ^ k" using p that by (simp add: mult.commute)
         thus "m \<in> cyclic_moduli" using p \<open>odd p\<close>
           unfolding cyclic_moduli_def by blast
       qed
       moreover have "m' \<noteq> 0" using p by (intro notI) auto
       ultimately have "m' \<noteq> 0 \<and>m' \<noteq> 1 \<and> m' \<noteq> 2" using that by auto
       hence "m' > 2" by linarith
   
       show ?thesis
       proof
         assume "\<exists>g. residue_primroot m g"
         with coprime p have coprime': "coprime (p - 1) (Carmichael m')"
           using residue_primroot_modulus_mult_coprime_imp_Carmichael_coprime[OF coprime]
           by (auto simp: Carmichael_prime_power)
         moreover have "even (p - 1)" "even (Carmichael m')"
           using \<open>m' > 2\<close> \<open>odd p\<close> by (auto intro!: even_Carmichael)
         ultimately show False by force
       qed
     qed
   qed auto
 
   ultimately show ?thesis by metis
 qed
 
 lemma residue_primroot_is_generator:
   assumes "m > 1" and "residue_primroot m g"
   shows   "bij_betw (\<lambda>i. g ^ i mod m) {..<totient m} (totatives m)"
   unfolding bij_betw_def
 proof
   from assms have [simp]: "ord m g = totient m"
     by (simp add: residue_primroot_def)
   from assms have "coprime m g" by (simp add: residue_primroot_def)
   hence "inj_on (\<lambda>i. g ^ i mod m) {..<ord m g}"
     by (intro inj_power_mod)
   thus inj: "inj_on (\<lambda>i. g ^ i mod m) {..<totient m}"
     by simp
 
   show "(\<lambda>i. g ^ i mod m) ` {..<totient m} = totatives m"
   proof (rule card_subset_eq)
     show "card ((\<lambda>i. g ^ i mod m) ` {..<totient m}) = card (totatives m)"
       using inj by (subst card_image) (auto simp: totient_def)
     show "(\<lambda>i. g ^ i mod m) ` {..<totient m} \<subseteq> totatives m"
       using \<open>m > 1\<close> \<open>coprime m g\<close> power_in_totatives[of m g] by blast
   qed auto
 qed
 
 text \<open>
   Given one primitive root \<open>g\<close>, all the primitive roots are powers $g^i$ for
   $1\leq i \leq \varphi(n)$ with $\text{gcd}(i, \varphi(n)) = 1$.
 \<close>
 theorem residue_primroot_bij_betw_primroots:
   assumes "m > 1" and "residue_primroot m g"
   shows   "bij_betw (\<lambda>i. g ^ i mod m) (totatives (totient m))
                                       {g\<in>totatives m. residue_primroot m g}"
 proof (cases "m = 2")
   case [simp]: True
   have [simp]: "totatives 2 = {1}"
     by (auto simp: totatives_def elim!: oddE)
   from assms have "odd g"
     by (auto simp: residue_primroot_def)
   hence pow_eq: "(\<lambda>i. g ^ i mod m) = (\<lambda>_. 1)"
     by (auto simp: fun_eq_iff mod_2_eq_odd)
   have "{g \<in> totatives m. residue_primroot m g} = {1}"
     by (auto simp: residue_primroot_def)
   thus ?thesis using pow_eq by (auto simp: bij_betw_def)
 next
   case False
   thus ?thesis unfolding bij_betw_def
   proof safe
     from assms False have "m > 2" by auto
     from assms \<open>m > 2\<close> have "totient m > 1" by (intro totient_gt_1) auto
     from assms have [simp]: "ord m g = totient m"
       by (simp add: residue_primroot_def)
     from assms have "coprime m g" by (simp add: residue_primroot_def)
     hence "inj_on (\<lambda>i. g ^ i mod m) {..<ord m g}"
       by (intro inj_power_mod)
     thus "inj_on (\<lambda>i. g ^ i mod m) (totatives (totient m))"
       by (rule inj_on_subset)
          (use assms \<open>totient m > 1\<close> in \<open>auto simp: totatives_less residue_primroot_def\<close>)
 
     {
       fix i assume i: "i \<in> totatives (totient m)"
       from \<open>coprime m g\<close> and \<open>m > 2\<close> show "g ^ i mod m \<in> totatives m"
         by (intro power_in_totatives) auto
       show "residue_primroot m (g ^ i mod m)"
         using i \<open>m > 2\<close> \<open>coprime m g\<close>
         by (auto simp: residue_primroot_def coprime_commute ord_power totatives_def)
     }
     {
       fix x assume x: "x \<in> totatives m" "residue_primroot m x"
       then obtain i where i: "i < totient m" "x = (g ^ i mod m)"
         using assms residue_primroot_is_generator[of m g] by (auto simp: bij_betw_def)
       from i x \<open>m > 2\<close> have "i > 0" by (intro Nat.gr0I) (auto simp: residue_primroot_1_iff)
       have "totient m div gcd i (totient m) = totient m"
         using x i \<open>coprime m g\<close> by (auto simp add: residue_primroot_def ord_power)
       hence "coprime i (totient m)"
         unfolding coprime_iff_gcd_eq_1 using assms by (subst (asm) dvd_div_eq_mult) auto
       with i \<open>i > 0\<close> have "i \<in> totatives (totient m)" by (auto simp: totatives_def)
       thus "x \<in> (\<lambda>i. g ^ i mod m) ` totatives (totient m)" using i by auto
     }
   qed
 qed
 
 text \<open>
   It follows from the above statement that any residue ring modulo \<open>n\<close> that \<^emph>\<open>has\<close> primitive roots
   has exactly $\varphi(\varphi(n))$ of them.
 \<close>
 corollary card_residue_primroots:
   assumes "\<exists>g. residue_primroot m g"
   shows   "card {g\<in>totatives m. residue_primroot m g} = totient (totient m)"
 proof (cases "m = 1")
   case [simp]: True
   have "{g \<in> totatives m. residue_primroot m g} = {1}"
     by (auto simp: residue_primroot_def)
   thus ?thesis by simp
 next
   case False
   from assms obtain g where g: "residue_primroot m g" by auto
   hence "m \<noteq> 0" by (intro notI) auto
   with \<open>m \<noteq> 1\<close> have "m > 1" by linarith
   from this g have "bij_betw (\<lambda>i. g ^ i mod m) (totatives (totient m))
                       {g\<in>totatives m. residue_primroot m g}"
     by (rule residue_primroot_bij_betw_primroots)
   hence "card (totatives (totient m)) = card {g\<in>totatives m. residue_primroot m g}"
     by (rule bij_betw_same_card)
   thus ?thesis by (simp add: totient_def)
 qed
 
 corollary card_residue_primroots':
   "card {g\<in>totatives m. residue_primroot m g} =
      (if m \<in> cyclic_moduli then totient (totient m) else 0)"
   by (simp add: residue_primroot_iff_in_cyclic_moduli [symmetric] card_residue_primroots)
 
 text \<open>
   As an example, we evaluate $\lambda(122200)$ using the prime factorisation.
 \<close>
 lemma "Carmichael 122200 = 1380"
 proof -
   have "prime_factorization (2^3 * 5^2 * 13 * 47) = {#2, 2, 2, 5, 5, 13, 47::nat#}"
     by (intro prime_factorization_eqI) auto
   from eval_Carmichael[OF this] show "Carmichael 122200 = 1380"
     by (simp add: lcm_nat_def gcd_non_0_nat)
 qed
 
 (* TODO: definition of index ("discrete logarithm") *)
 
 end
\ No newline at end of file
diff --git a/src/HOL/Probability/Discrete_Topology.thy b/src/HOL/Probability/Discrete_Topology.thy
--- a/src/HOL/Probability/Discrete_Topology.thy
+++ b/src/HOL/Probability/Discrete_Topology.thy
@@ -1,64 +1,64 @@
 (*  Title:      HOL/Probability/Discrete_Topology.thy
     Author:     Fabian Immler, TU München
 *)
 
 theory Discrete_Topology
 imports "HOL-Analysis.Analysis"
 begin
 
 text \<open>Copy of discrete types with discrete topology. This space is polish.\<close>
 
 typedef 'a discrete = "UNIV::'a set"
 morphisms of_discrete discrete
 ..
 
 instantiation discrete :: (type) metric_space
 begin
 
 definition dist_discrete :: "'a discrete \<Rightarrow> 'a discrete \<Rightarrow> real"
   where "dist_discrete n m = (if n = m then 0 else 1)"
 
 definition uniformity_discrete :: "('a discrete \<times> 'a discrete) filter" where
   "(uniformity::('a discrete \<times> 'a discrete) filter) = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition "open_discrete" :: "'a discrete set \<Rightarrow> bool" where
   "(open::'a discrete set \<Rightarrow> bool) U \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 
 instance proof qed (auto simp: uniformity_discrete_def open_discrete_def dist_discrete_def intro: exI[where x=1])
 end
 
 lemma open_discrete: "open (S :: 'a discrete set)"
   unfolding open_dist dist_discrete_def by (auto intro!: exI[of _ "1 / 2"])
 
 instance discrete :: (type) complete_space
 proof
-  fix X::"nat\<Rightarrow>'a discrete" assume "Cauchy X"
-  hence "\<exists>n. \<forall>m\<ge>n. X n = X m"
+  fix X::"nat\<Rightarrow>'a discrete"
+  assume "Cauchy X"
+  then obtain n where "\<forall>m\<ge>n. X n = X m"
     by (force simp: dist_discrete_def Cauchy_def split: if_split_asm dest:spec[where x=1])
-  then guess n ..
   thus "convergent X"
     by (intro convergentI[where L="X n"] tendstoI eventually_sequentiallyI[of n])
        (simp add: dist_discrete_def)
 qed
 
 instance discrete :: (countable) countable
 proof
   have "inj (\<lambda>c::'a discrete. to_nat (of_discrete c))"
     by (simp add: inj_on_def of_discrete_inject)
   thus "\<exists>f::'a discrete \<Rightarrow> nat. inj f" by blast
 qed
 
 instance discrete :: (countable) second_countable_topology
 proof
   let ?B = "range (\<lambda>n::'a discrete. {n})"
   have "\<And>S. generate_topology ?B (\<Union>x\<in>S. {x})"
     by (intro generate_topology_Union) (auto intro: generate_topology.intros)
   then have "open = generate_topology ?B"
     by (auto intro!: ext simp: open_discrete)
   moreover have "countable ?B" by simp
   ultimately show "\<exists>B::'a discrete set set. countable B \<and> open = generate_topology B" by blast
 qed
 
 instance discrete :: (countable) polish_space ..
 
 end
diff --git a/src/HOL/Probability/Fin_Map.thy b/src/HOL/Probability/Fin_Map.thy
--- a/src/HOL/Probability/Fin_Map.thy
+++ b/src/HOL/Probability/Fin_Map.thy
@@ -1,1335 +1,1351 @@
 (*  Title:      HOL/Probability/Fin_Map.thy
     Author:     Fabian Immler, TU München
 *)
 
 section \<open>Finite Maps\<close>
 
 theory Fin_Map
   imports "HOL-Analysis.Finite_Product_Measure" "HOL-Library.Finite_Map"
 begin
 
 text \<open>The \<^type>\<open>fmap\<close> type can be instantiated to \<^class>\<open>polish_space\<close>, needed for the proof of
   projective limit. \<^const>\<open>extensional\<close> functions are used for the representation in order to
   stay close to the developments of (finite) products \<^const>\<open>Pi\<^sub>E\<close> and their sigma-algebra
   \<^const>\<open>Pi\<^sub>M\<close>.\<close>
 
 type_notation fmap ("(_ \<Rightarrow>\<^sub>F /_)" [22, 21] 21)
 
 unbundle fmap.lifting
 
 
 subsection \<open>Domain and Application\<close>
 
 lift_definition domain::"('i \<Rightarrow>\<^sub>F 'a) \<Rightarrow> 'i set" is dom .
 
 lemma finite_domain[simp, intro]: "finite (domain P)"
   by transfer simp
 
 lift_definition proj :: "('i \<Rightarrow>\<^sub>F 'a) \<Rightarrow> 'i \<Rightarrow> 'a" ("'((_)')\<^sub>F" [0] 1000) is
   "\<lambda>f x. if x \<in> dom f then the (f x) else undefined" .
 
 declare [[coercion proj]]
 
 lemma extensional_proj[simp, intro]: "(P)\<^sub>F \<in> extensional (domain P)"
   by transfer (auto simp: extensional_def)
 
 lemma proj_undefined[simp, intro]: "i \<notin> domain P \<Longrightarrow> P i = undefined"
   using extensional_proj[of P] unfolding extensional_def by auto
 
 lemma finmap_eq_iff: "P = Q \<longleftrightarrow> (domain P = domain Q \<and> (\<forall>i\<in>domain P. P i = Q i))"
   apply transfer
   apply (safe intro!: ext)
   subgoal for P Q x
     by (cases "x \<in> dom P"; cases "P x") (auto dest!: bspec[where x=x])
   done
 
 
 subsection \<open>Constructor of Finite Maps\<close>
 
 lift_definition finmap_of::"'i set \<Rightarrow> ('i \<Rightarrow> 'a) \<Rightarrow> ('i \<Rightarrow>\<^sub>F 'a)" is
   "\<lambda>I f x. if x \<in> I \<and> finite I then Some (f x) else None"
   by (simp add: dom_def)
 
 lemma proj_finmap_of[simp]:
   assumes "finite inds"
   shows "(finmap_of inds f)\<^sub>F = restrict f inds"
   using assms
   by transfer force
 
 lemma domain_finmap_of[simp]:
   assumes "finite inds"
   shows "domain (finmap_of inds f) = inds"
   using assms
   by transfer (auto split: if_splits)
 
 lemma finmap_of_eq_iff[simp]:
   assumes "finite i" "finite j"
   shows "finmap_of i m = finmap_of j n \<longleftrightarrow> i = j \<and> (\<forall>k\<in>i. m k= n k)"
   using assms by (auto simp: finmap_eq_iff)
 
 lemma finmap_of_inj_on_extensional_finite:
   assumes "finite K"
   assumes "S \<subseteq> extensional K"
   shows "inj_on (finmap_of K) S"
 proof (rule inj_onI)
   fix x y::"'a \<Rightarrow> 'b"
   assume "finmap_of K x = finmap_of K y"
   hence "(finmap_of K x)\<^sub>F = (finmap_of K y)\<^sub>F" by simp
   moreover
   assume "x \<in> S" "y \<in> S" hence "x \<in> extensional K" "y \<in> extensional K" using assms by auto
   ultimately
   show "x = y" using assms by (simp add: extensional_restrict)
 qed
 
 subsection \<open>Product set of Finite Maps\<close>
 
 text \<open>This is \<^term>\<open>Pi\<close> for Finite Maps, most of this is copied\<close>
 
 definition Pi' :: "'i set \<Rightarrow> ('i \<Rightarrow> 'a set) \<Rightarrow> ('i \<Rightarrow>\<^sub>F 'a) set" where
   "Pi' I A = { P. domain P = I \<and> (\<forall>i. i \<in> I \<longrightarrow> (P)\<^sub>F i \<in> A i) } "
 
 syntax
   "_Pi'" :: "[pttrn, 'a set, 'b set] => ('a => 'b) set"  ("(3\<Pi>'' _\<in>_./ _)"   10)
 translations
   "\<Pi>' x\<in>A. B" == "CONST Pi' A (\<lambda>x. B)"
 
 subsubsection\<open>Basic Properties of \<^term>\<open>Pi'\<close>\<close>
 
 lemma Pi'_I[intro!]: "domain f = A \<Longrightarrow> (\<And>x. x \<in> A \<Longrightarrow> f x \<in> B x) \<Longrightarrow> f \<in> Pi' A B"
   by (simp add: Pi'_def)
 
 lemma Pi'_I'[simp]: "domain f = A \<Longrightarrow> (\<And>x. x \<in> A \<longrightarrow> f x \<in> B x) \<Longrightarrow> f \<in> Pi' A B"
   by (simp add:Pi'_def)
 
 lemma Pi'_mem: "f\<in> Pi' A B \<Longrightarrow> x \<in> A \<Longrightarrow> f x \<in> B x"
   by (simp add: Pi'_def)
 
 lemma Pi'_iff: "f \<in> Pi' I X \<longleftrightarrow> domain f = I \<and> (\<forall>i\<in>I. f i \<in> X i)"
   unfolding Pi'_def by auto
 
 lemma Pi'E [elim]:
   "f \<in> Pi' A B \<Longrightarrow> (f x \<in> B x \<Longrightarrow> domain f = A \<Longrightarrow> Q) \<Longrightarrow> (x \<notin> A \<Longrightarrow> Q) \<Longrightarrow> Q"
   by(auto simp: Pi'_def)
 
 lemma in_Pi'_cong:
   "domain f = domain g \<Longrightarrow> (\<And> w. w \<in> A \<Longrightarrow> f w = g w) \<Longrightarrow> f \<in> Pi' A B \<longleftrightarrow> g \<in> Pi' A B"
   by (auto simp: Pi'_def)
 
 lemma Pi'_eq_empty[simp]:
   assumes "finite A" shows "(Pi' A B) = {} \<longleftrightarrow> (\<exists>x\<in>A. B x = {})"
   using assms
   apply (simp add: Pi'_def, auto)
   apply (drule_tac x = "finmap_of A (\<lambda>u. SOME y. y \<in> B u)" in spec, auto)
   apply (cut_tac P= "%y. y \<in> B i" in some_eq_ex, auto)
   done
 
 lemma Pi'_mono: "(\<And>x. x \<in> A \<Longrightarrow> B x \<subseteq> C x) \<Longrightarrow> Pi' A B \<subseteq> Pi' A C"
   by (auto simp: Pi'_def)
 
 lemma Pi_Pi': "finite A \<Longrightarrow> (Pi\<^sub>E A B) = proj ` Pi' A B"
   apply (auto simp: Pi'_def Pi_def extensional_def)
   apply (rule_tac x = "finmap_of A (restrict x A)" in image_eqI)
   apply auto
   done
 
 subsection \<open>Topological Space of Finite Maps\<close>
 
 instantiation fmap :: (type, topological_space) topological_space
 begin
 
 definition open_fmap :: "('a \<Rightarrow>\<^sub>F 'b) set \<Rightarrow> bool" where
    [code del]: "open_fmap = generate_topology {Pi' a b|a b. \<forall>i\<in>a. open (b i)}"
 
 lemma open_Pi'I: "(\<And>i. i \<in> I \<Longrightarrow> open (A i)) \<Longrightarrow> open (Pi' I A)"
   by (auto intro: generate_topology.Basis simp: open_fmap_def)
 
 instance using topological_space_generate_topology
   by intro_classes (auto simp: open_fmap_def class.topological_space_def)
 
 end
 
 lemma open_restricted_space:
   shows "open {m. P (domain m)}"
 proof -
   have "{m. P (domain m)} = (\<Union>i \<in> Collect P. {m. domain m = i})" by auto
   also have "open \<dots>"
   proof (rule, safe, cases)
     fix i::"'a set"
     assume "finite i"
     hence "{m. domain m = i} = Pi' i (\<lambda>_. UNIV)" by (auto simp: Pi'_def)
     also have "open \<dots>" by (auto intro: open_Pi'I simp: \<open>finite i\<close>)
     finally show "open {m. domain m = i}" .
   next
     fix i::"'a set"
     assume "\<not> finite i" hence "{m. domain m = i} = {}" by auto
     also have "open \<dots>" by simp
     finally show "open {m. domain m = i}" .
   qed
   finally show ?thesis .
 qed
 
 lemma closed_restricted_space:
   shows "closed {m. P (domain m)}"
   using open_restricted_space[of "\<lambda>x. \<not> P x"]
   unfolding closed_def by (rule back_subst) auto
 
 lemma tendsto_proj: "((\<lambda>x. x) \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. (x)\<^sub>F i) \<longlongrightarrow> (a)\<^sub>F i) F"
   unfolding tendsto_def
 proof safe
   fix S::"'b set"
   let ?S = "Pi' (domain a) (\<lambda>x. if x = i then S else UNIV)"
   assume "open S" hence "open ?S" by (auto intro!: open_Pi'I)
   moreover assume "\<forall>S. open S \<longrightarrow> a \<in> S \<longrightarrow> eventually (\<lambda>x. x \<in> S) F" "a i \<in> S"
   ultimately have "eventually (\<lambda>x. x \<in> ?S) F" by auto
   thus "eventually (\<lambda>x. (x)\<^sub>F i \<in> S) F"
     by eventually_elim (insert \<open>a i \<in> S\<close>, force simp: Pi'_iff split: if_split_asm)
 qed
 
 lemma continuous_proj:
   shows "continuous_on s (\<lambda>x. (x)\<^sub>F i)"
   unfolding continuous_on_def by (safe intro!: tendsto_proj tendsto_ident_at)
 
 instance fmap :: (type, first_countable_topology) first_countable_topology
 proof
   fix x::"'a\<Rightarrow>\<^sub>F'b"
   have "\<forall>i. \<exists>A. countable A \<and> (\<forall>a\<in>A. x i \<in> a) \<and> (\<forall>a\<in>A. open a) \<and>
     (\<forall>S. open S \<and> x i \<in> S \<longrightarrow> (\<exists>a\<in>A. a \<subseteq> S)) \<and> (\<forall>a b. a \<in> A \<longrightarrow> b \<in> A \<longrightarrow> a \<inter> b \<in> A)" (is "\<forall>i. ?th i")
   proof
-    fix i from first_countable_basis_Int_stableE[of "x i"] guess A .
+    fix i from first_countable_basis_Int_stableE[of "x i"]
+    obtain A where
+      "countable A"
+      "\<And>C. C \<in> A \<Longrightarrow> (x)\<^sub>F i \<in> C"
+      "\<And>C. C \<in> A \<Longrightarrow> open C"
+      "\<And>S. open S \<Longrightarrow> (x)\<^sub>F i \<in> S \<Longrightarrow> \<exists>A\<in>A. A \<subseteq> S"
+      "\<And>C D. C \<in> A \<Longrightarrow> D \<in> A \<Longrightarrow> C \<inter> D \<in> A"
+      by auto
     thus "?th i" by (intro exI[where x=A]) simp
   qed
-  then guess A unfolding choice_iff .. note A = this
+  then obtain A
+    where A: "\<forall>i. countable (A i) \<and> Ball (A i) ((\<in>) ((x)\<^sub>F i)) \<and> Ball (A i) open \<and>
+      (\<forall>S. open S \<and> (x)\<^sub>F i \<in> S \<longrightarrow> (\<exists>a\<in>A i. a \<subseteq> S)) \<and> (\<forall>a b. a \<in> A i \<longrightarrow> b \<in> A i \<longrightarrow> a \<inter> b \<in> A i)"
+    by (auto simp: choice_iff)
   hence open_sub: "\<And>i S. i\<in>domain x \<Longrightarrow> open (S i) \<Longrightarrow> x i\<in>(S i) \<Longrightarrow> (\<exists>a\<in>A i. a\<subseteq>(S i))" by auto
   have A_notempty: "\<And>i. i \<in> domain x \<Longrightarrow> A i \<noteq> {}" using open_sub[of _ "\<lambda>_. UNIV"] by auto
   let ?A = "(\<lambda>f. Pi' (domain x) f) ` (Pi\<^sub>E (domain x) A)"
   show "\<exists>A::nat \<Rightarrow> ('a\<Rightarrow>\<^sub>F'b) set. (\<forall>i. x \<in> (A i) \<and> open (A i)) \<and> (\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. A i \<subseteq> S))"
   proof (rule first_countableI[of "?A"], safe)
     show "countable ?A" using A by (simp add: countable_PiE)
   next
     fix S::"('a \<Rightarrow>\<^sub>F 'b) set" assume "open S" "x \<in> S"
     thus "\<exists>a\<in>?A. a \<subseteq> S" unfolding open_fmap_def
     proof (induct rule: generate_topology.induct)
       case UNIV thus ?case by (auto simp add: ex_in_conv PiE_eq_empty_iff A_notempty)
     next
       case (Int a b)
       then obtain f g where
         "f \<in> Pi\<^sub>E (domain x) A" "Pi' (domain x) f \<subseteq> a" "g \<in> Pi\<^sub>E (domain x) A" "Pi' (domain x) g \<subseteq> b"
         by auto
       thus ?case using A
         by (auto simp: Pi'_iff PiE_iff extensional_def Int_stable_def
             intro!: bexI[where x="\<lambda>i. f i \<inter> g i"])
     next
       case (UN B)
       then obtain b where "x \<in> b" "b \<in> B" by auto
       hence "\<exists>a\<in>?A. a \<subseteq> b" using UN by simp
       thus ?case using \<open>b \<in> B\<close> by blast
     next
       case (Basis s)
       then obtain a b where xs: "x\<in> Pi' a b" "s = Pi' a b" "\<And>i. i\<in>a \<Longrightarrow> open (b i)" by auto
       have "\<forall>i. \<exists>a. (i \<in> domain x \<and> open (b i) \<and> (x)\<^sub>F i \<in> b i) \<longrightarrow> (a\<in>A i \<and> a \<subseteq> b i)"
         using open_sub[of _ b] by auto
       then obtain b'
         where "\<And>i. i \<in> domain x \<Longrightarrow> open (b i) \<Longrightarrow> (x)\<^sub>F i \<in> b i \<Longrightarrow> (b' i \<in>A i \<and> b' i \<subseteq> b i)"
           unfolding choice_iff by auto
       with xs have "\<And>i. i \<in> a \<Longrightarrow> (b' i \<in>A i \<and> b' i \<subseteq> b i)" "Pi' a b' \<subseteq> Pi' a b"
         by (auto simp: Pi'_iff intro!: Pi'_mono)
       thus ?case using xs
         by (intro bexI[where x="Pi' a b'"])
           (auto simp: Pi'_iff intro!: image_eqI[where x="restrict b' (domain x)"])
     qed
   qed (insert A,auto simp: PiE_iff intro!: open_Pi'I)
 qed
 
 subsection \<open>Metric Space of Finite Maps\<close>
 
 (* TODO: Product of uniform spaces and compatibility with metric_spaces! *)
 
 instantiation fmap :: (type, metric_space) dist
 begin
 
 definition dist_fmap where
   "dist P Q = Max (range (\<lambda>i. dist ((P)\<^sub>F i) ((Q)\<^sub>F i))) + (if domain P = domain Q then 0 else 1)"
 
 instance ..
 end
 
 instantiation fmap :: (type, metric_space) uniformity_dist
 begin
 
 definition [code del]:
   "(uniformity :: (('a, 'b) fmap \<times> ('a \<Rightarrow>\<^sub>F 'b)) filter) =
     (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 instance
   by standard (rule uniformity_fmap_def)
 end
 
 declare uniformity_Abort[where 'a="('a \<Rightarrow>\<^sub>F 'b::metric_space)", code]
 
 instantiation fmap :: (type, metric_space) metric_space
 begin
 
 lemma finite_proj_image': "x \<notin> domain P \<Longrightarrow> finite ((P)\<^sub>F ` S)"
   by (rule finite_subset[of _ "proj P ` (domain P \<inter> S \<union> {x})"]) auto
 
 lemma finite_proj_image: "finite ((P)\<^sub>F ` S)"
  by (cases "\<exists>x. x \<notin> domain P") (auto intro: finite_proj_image' finite_subset[where B="domain P"])
 
 lemma finite_proj_diag: "finite ((\<lambda>i. d ((P)\<^sub>F i) ((Q)\<^sub>F i)) ` S)"
 proof -
   have "(\<lambda>i. d ((P)\<^sub>F i) ((Q)\<^sub>F i)) ` S = (\<lambda>(i, j). d i j) ` ((\<lambda>i. ((P)\<^sub>F i, (Q)\<^sub>F i)) ` S)" by auto
   moreover have "((\<lambda>i. ((P)\<^sub>F i, (Q)\<^sub>F i)) ` S) \<subseteq> (\<lambda>i. (P)\<^sub>F i) ` S \<times> (\<lambda>i. (Q)\<^sub>F i) ` S" by auto
   moreover have "finite \<dots>" using finite_proj_image[of P S] finite_proj_image[of Q S]
     by (intro finite_cartesian_product) simp_all
   ultimately show ?thesis by (simp add: finite_subset)
 qed
 
 lemma dist_le_1_imp_domain_eq:
   shows "dist P Q < 1 \<Longrightarrow> domain P = domain Q"
   by (simp add: dist_fmap_def finite_proj_diag split: if_split_asm)
 
 lemma dist_proj:
   shows "dist ((x)\<^sub>F i) ((y)\<^sub>F i) \<le> dist x y"
 proof -
   have "dist (x i) (y i) \<le> Max (range (\<lambda>i. dist (x i) (y i)))"
     by (simp add: Max_ge_iff finite_proj_diag)
   also have "\<dots> \<le> dist x y" by (simp add: dist_fmap_def)
   finally show ?thesis .
 qed
 
 lemma dist_finmap_lessI:
   assumes "domain P = domain Q"
   assumes "0 < e"
   assumes "\<And>i. i \<in> domain P \<Longrightarrow> dist (P i) (Q i) < e"
   shows "dist P Q < e"
 proof -
   have "dist P Q = Max (range (\<lambda>i. dist (P i) (Q i)))"
     using assms by (simp add: dist_fmap_def finite_proj_diag)
   also have "\<dots> < e"
   proof (subst Max_less_iff, safe)
     fix i
     show "dist ((P)\<^sub>F i) ((Q)\<^sub>F i) < e" using assms
       by (cases "i \<in> domain P") simp_all
   qed (simp add: finite_proj_diag)
   finally show ?thesis .
 qed
 
 instance
 proof
   fix S::"('a \<Rightarrow>\<^sub>F 'b) set"
   have *: "open S = (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)" (is "_ = ?od")
   proof
     assume "open S"
     thus ?od
       unfolding open_fmap_def
     proof (induct rule: generate_topology.induct)
       case UNIV thus ?case by (auto intro: zero_less_one)
     next
       case (Int a b)
       show ?case
       proof safe
         fix x assume x: "x \<in> a" "x \<in> b"
         with Int x obtain e1 e2 where
           "e1>0" "\<forall>y. dist y x < e1 \<longrightarrow> y \<in> a" "e2>0" "\<forall>y. dist y x < e2 \<longrightarrow> y \<in> b" by force
         thus "\<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> a \<inter> b"
           by (auto intro!: exI[where x="min e1 e2"])
       qed
     next
       case (UN K)
       show ?case
       proof safe
         fix x X assume "x \<in> X" and X: "X \<in> K"
         with UN obtain e where "e>0" "\<And>y. dist y x < e \<longrightarrow> y \<in> X" by force
         with X show "\<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> \<Union>K" by auto
       qed
     next
       case (Basis s) then obtain a b where s: "s = Pi' a b" and b: "\<And>i. i\<in>a \<Longrightarrow> open (b i)" by auto
       show ?case
       proof safe
         fix x assume "x \<in> s"
         hence [simp]: "finite a" and a_dom: "a = domain x" using s by (auto simp: Pi'_iff)
         obtain es where es: "\<forall>i \<in> a. es i > 0 \<and> (\<forall>y. dist y (proj x i) < es i \<longrightarrow> y \<in> b i)"
           using b \<open>x \<in> s\<close> by atomize_elim (intro bchoice, auto simp: open_dist s)
         hence in_b: "\<And>i y. i \<in> a \<Longrightarrow> dist y (proj x i) < es i \<Longrightarrow> y \<in> b i" by auto
         show "\<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> s"
         proof (cases, rule, safe)
           assume "a \<noteq> {}"
           show "0 < min 1 (Min (es ` a))" using es by (auto simp: \<open>a \<noteq> {}\<close>)
           fix y assume d: "dist y x < min 1 (Min (es ` a))"
           show "y \<in> s" unfolding s
           proof
             show "domain y = a" using d s \<open>a \<noteq> {}\<close> by (auto simp: dist_le_1_imp_domain_eq a_dom)
             fix i assume i: "i \<in> a"
             hence "dist ((y)\<^sub>F i) ((x)\<^sub>F i) < es i" using d
               by (auto simp: dist_fmap_def \<open>a \<noteq> {}\<close> intro!: le_less_trans[OF dist_proj])
             with i show "y i \<in> b i" by (rule in_b)
           qed
         next
           assume "\<not>a \<noteq> {}"
           thus "\<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> s"
             using s \<open>x \<in> s\<close> by (auto simp: Pi'_def dist_le_1_imp_domain_eq intro!: exI[where x=1])
         qed
       qed
     qed
   next
     assume "\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S"
     then obtain e where e_pos: "\<And>x. x \<in> S \<Longrightarrow> e x > 0" and
       e_in:  "\<And>x y . x \<in> S \<Longrightarrow> dist y x < e x \<Longrightarrow> y \<in> S"
       unfolding bchoice_iff
       by auto
     have S_eq: "S = \<Union>{Pi' a b| a b. \<exists>x\<in>S. domain x = a \<and> b = (\<lambda>i. ball (x i) (e x))}"
     proof safe
       fix x assume "x \<in> S"
       thus "x \<in> \<Union>{Pi' a b| a b. \<exists>x\<in>S. domain x = a \<and> b = (\<lambda>i. ball (x i) (e x))}"
         using e_pos by (auto intro!: exI[where x="Pi' (domain x) (\<lambda>i. ball (x i) (e x))"])
     next
       fix x y
       assume "y \<in> S"
       moreover
       assume "x \<in> (\<Pi>' i\<in>domain y. ball (y i) (e y))"
       hence "dist x y < e y" using e_pos \<open>y \<in> S\<close>
         by (auto simp: dist_fmap_def Pi'_iff finite_proj_diag dist_commute)
       ultimately show "x \<in> S" by (rule e_in)
     qed
     also have "open \<dots>"
       unfolding open_fmap_def
       by (intro generate_topology.UN) (auto intro: generate_topology.Basis)
     finally show "open S" .
   qed
   show "open S = (\<forall>x\<in>S. \<forall>\<^sub>F (x', y) in uniformity. x' = x \<longrightarrow> y \<in> S)"
     unfolding * eventually_uniformity_metric
     by (simp del: split_paired_All add: dist_fmap_def dist_commute eq_commute)
 next
   fix P Q::"'a \<Rightarrow>\<^sub>F 'b"
   have Max_eq_iff: "\<And>A m. finite A \<Longrightarrow> A \<noteq> {} \<Longrightarrow> (Max A = m) = (m \<in> A \<and> (\<forall>a\<in>A. a \<le> m))"
     by (auto intro: Max_in Max_eqI)
   show "dist P Q = 0 \<longleftrightarrow> P = Q"
     by (auto simp: finmap_eq_iff dist_fmap_def Max_ge_iff finite_proj_diag Max_eq_iff
         add_nonneg_eq_0_iff
       intro!: Max_eqI image_eqI[where x=undefined])
 next
   fix P Q R::"'a \<Rightarrow>\<^sub>F 'b"
   let ?dists = "\<lambda>P Q i. dist ((P)\<^sub>F i) ((Q)\<^sub>F i)"
   let ?dpq = "?dists P Q" and ?dpr = "?dists P R" and ?dqr = "?dists Q R"
   let ?dom = "\<lambda>P Q. (if domain P = domain Q then 0 else 1::real)"
   have "dist P Q = Max (range ?dpq) + ?dom P Q"
     by (simp add: dist_fmap_def)
   also obtain t where "t \<in> range ?dpq" "t = Max (range ?dpq)" by (simp add: finite_proj_diag)
   then obtain i where "Max (range ?dpq) = ?dpq i" by auto
   also have "?dpq i \<le> ?dpr i + ?dqr i" by (rule dist_triangle2)
   also have "?dpr i \<le> Max (range ?dpr)" by (simp add: finite_proj_diag)
   also have "?dqr i \<le> Max (range ?dqr)" by (simp add: finite_proj_diag)
   also have "?dom P Q \<le> ?dom P R + ?dom Q R" by simp
   finally show "dist P Q \<le> dist P R + dist Q R" by (simp add: dist_fmap_def ac_simps)
 qed
 
 end
 
 subsection \<open>Complete Space of Finite Maps\<close>
 
 lemma tendsto_finmap:
   fixes f::"nat \<Rightarrow> ('i \<Rightarrow>\<^sub>F ('a::metric_space))"
   assumes ind_f:  "\<And>n. domain (f n) = domain g"
   assumes proj_g:  "\<And>i. i \<in> domain g \<Longrightarrow> (\<lambda>n. (f n) i) \<longlonglongrightarrow> g i"
   shows "f \<longlonglongrightarrow> g"
   unfolding tendsto_iff
 proof safe
   fix e::real assume "0 < e"
   let ?dists = "\<lambda>x i. dist ((f x)\<^sub>F i) ((g)\<^sub>F i)"
   have "eventually (\<lambda>x. \<forall>i\<in>domain g. ?dists x i < e) sequentially"
     using finite_domain[of g] proj_g
   proof induct
     case (insert i G)
     with \<open>0 < e\<close> have "eventually (\<lambda>x. ?dists x i < e) sequentially" by (auto simp add: tendsto_iff)
     moreover
     from insert have "eventually (\<lambda>x. \<forall>i\<in>G. dist ((f x)\<^sub>F i) ((g)\<^sub>F i) < e) sequentially" by simp
     ultimately show ?case by eventually_elim auto
   qed simp
   thus "eventually (\<lambda>x. dist (f x) g < e) sequentially"
     by eventually_elim (auto simp add: dist_fmap_def finite_proj_diag ind_f \<open>0 < e\<close>)
 qed
 
 instance fmap :: (type, complete_space) complete_space
 proof
   fix P::"nat \<Rightarrow> 'a \<Rightarrow>\<^sub>F 'b"
   assume "Cauchy P"
   then obtain Nd where Nd: "\<And>n. n \<ge> Nd \<Longrightarrow> dist (P n) (P Nd) < 1"
     by (force simp: Cauchy_altdef2)
   define d where "d = domain (P Nd)"
   with Nd have dim: "\<And>n. n \<ge> Nd \<Longrightarrow> domain (P n) = d" using dist_le_1_imp_domain_eq by auto
   have [simp]: "finite d" unfolding d_def by simp
   define p where "p i n = P n i" for i n
   define q where "q i = lim (p i)" for i
   define Q where "Q = finmap_of d q"
   have q: "\<And>i. i \<in> d \<Longrightarrow> q i = Q i" by (auto simp add: Q_def Abs_fmap_inverse)
   {
     fix i assume "i \<in> d"
     have "Cauchy (p i)" unfolding Cauchy_altdef2 p_def
     proof safe
       fix e::real assume "0 < e"
       with \<open>Cauchy P\<close> obtain N where N: "\<And>n. n\<ge>N \<Longrightarrow> dist (P n) (P N) < min e 1"
         by (force simp: Cauchy_altdef2 min_def)
       hence "\<And>n. n \<ge> N \<Longrightarrow> domain (P n) = domain (P N)" using dist_le_1_imp_domain_eq by auto
       with dim have dim: "\<And>n. n \<ge> N \<Longrightarrow> domain (P n) = d" by (metis nat_le_linear)
       show "\<exists>N. \<forall>n\<ge>N. dist ((P n) i) ((P N) i) < e"
       proof (safe intro!: exI[where x="N"])
         fix n assume "N \<le> n" have "N \<le> N" by simp
         have "dist ((P n) i) ((P N) i) \<le> dist (P n) (P N)"
           using dim[OF \<open>N \<le> n\<close>]  dim[OF \<open>N \<le> N\<close>] \<open>i \<in> d\<close>
           by (auto intro!: dist_proj)
         also have "\<dots> < e" using N[OF \<open>N \<le> n\<close>] by simp
         finally show "dist ((P n) i) ((P N) i) < e" .
       qed
     qed
     hence "convergent (p i)" by (metis Cauchy_convergent_iff)
     hence "p i \<longlonglongrightarrow> q i" unfolding q_def convergent_def by (metis limI)
   } note p = this
   have "P \<longlonglongrightarrow> Q"
   proof (rule metric_LIMSEQ_I)
     fix e::real assume "0 < e"
     have "\<exists>ni. \<forall>i\<in>d. \<forall>n\<ge>ni i. dist (p i n) (q i) < e"
     proof (safe intro!: bchoice)
       fix i assume "i \<in> d"
       from p[OF \<open>i \<in> d\<close>, THEN metric_LIMSEQ_D, OF \<open>0 < e\<close>]
       show "\<exists>no. \<forall>n\<ge>no. dist (p i n) (q i) < e" .
-    qed then guess ni .. note ni = this
+    qed
+    then obtain ni where ni: "\<forall>i\<in>d. \<forall>n\<ge>ni i. dist (p i n) (q i) < e" ..
     define N where "N = max Nd (Max (ni ` d))"
     show "\<exists>N. \<forall>n\<ge>N. dist (P n) Q < e"
     proof (safe intro!: exI[where x="N"])
       fix n assume "N \<le> n"
       hence dom: "domain (P n) = d" "domain Q = d" "domain (P n) = domain Q"
         using dim by (simp_all add: N_def Q_def dim_def Abs_fmap_inverse)
       show "dist (P n) Q < e"
       proof (rule dist_finmap_lessI[OF dom(3) \<open>0 < e\<close>])
         fix i
         assume "i \<in> domain (P n)"
         hence "ni i \<le> Max (ni ` d)" using dom by simp
         also have "\<dots> \<le> N" by (simp add: N_def)
         finally show "dist ((P n)\<^sub>F i) ((Q)\<^sub>F i) < e" using ni \<open>i \<in> domain (P n)\<close> \<open>N \<le> n\<close> dom
           by (auto simp: p_def q N_def less_imp_le)
       qed
     qed
   qed
   thus "convergent P" by (auto simp: convergent_def)
 qed
 
 subsection \<open>Second Countable Space of Finite Maps\<close>
 
 instantiation fmap :: (countable, second_countable_topology) second_countable_topology
 begin
 
 definition basis_proj::"'b set set"
   where "basis_proj = (SOME B. countable B \<and> topological_basis B)"
 
 lemma countable_basis_proj: "countable basis_proj" and basis_proj: "topological_basis basis_proj"
   unfolding basis_proj_def by (intro is_basis countable_basis)+
 
 definition basis_finmap::"('a \<Rightarrow>\<^sub>F 'b) set set"
   where "basis_finmap = {Pi' I S|I S. finite I \<and> (\<forall>i \<in> I. S i \<in> basis_proj)}"
 
 lemma in_basis_finmapI:
   assumes "finite I" assumes "\<And>i. i \<in> I \<Longrightarrow> S i \<in> basis_proj"
   shows "Pi' I S \<in> basis_finmap"
   using assms unfolding basis_finmap_def by auto
 
 lemma basis_finmap_eq:
   assumes "basis_proj \<noteq> {}"
   shows "basis_finmap = (\<lambda>f. Pi' (domain f) (\<lambda>i. from_nat_into basis_proj ((f)\<^sub>F i))) `
     (UNIV::('a \<Rightarrow>\<^sub>F nat) set)" (is "_ = ?f ` _")
   unfolding basis_finmap_def
 proof safe
   fix I::"'a set" and S::"'a \<Rightarrow> 'b set"
   assume "finite I" "\<forall>i\<in>I. S i \<in> basis_proj"
   hence "Pi' I S = ?f (finmap_of I (\<lambda>x. to_nat_on basis_proj (S x)))"
     by (force simp: Pi'_def countable_basis_proj)
   thus "Pi' I S \<in> range ?f" by simp
 next
   fix x and f::"'a \<Rightarrow>\<^sub>F nat"
   show "\<exists>I S. (\<Pi>' i\<in>domain f. from_nat_into basis_proj ((f)\<^sub>F i)) = Pi' I S \<and>
     finite I \<and> (\<forall>i\<in>I. S i \<in> basis_proj)"
     using assms by (auto intro: from_nat_into)
 qed
 
 lemma basis_finmap_eq_empty: "basis_proj = {} \<Longrightarrow> basis_finmap = {Pi' {} undefined}"
   by (auto simp: Pi'_iff basis_finmap_def)
 
 lemma countable_basis_finmap: "countable basis_finmap"
   by (cases "basis_proj = {}") (auto simp: basis_finmap_eq basis_finmap_eq_empty)
 
 lemma finmap_topological_basis:
   "topological_basis basis_finmap"
 proof (subst topological_basis_iff, safe)
   fix B' assume "B' \<in> basis_finmap"
   thus "open B'"
     by (auto intro!: open_Pi'I topological_basis_open[OF basis_proj]
       simp: topological_basis_def basis_finmap_def Let_def)
 next
   fix O'::"('a \<Rightarrow>\<^sub>F 'b) set" and x
   assume O': "open O'" "x \<in> O'"
   then obtain a where a:
     "x \<in> Pi' (domain x) a" "Pi' (domain x) a \<subseteq> O'" "\<And>i. i\<in>domain x \<Longrightarrow> open (a i)"
     unfolding open_fmap_def
   proof (atomize_elim, induct rule: generate_topology.induct)
     case (Int a b)
     let ?p="\<lambda>a f. x \<in> Pi' (domain x) f \<and> Pi' (domain x) f \<subseteq> a \<and> (\<forall>i. i \<in> domain x \<longrightarrow> open (f i))"
     from Int obtain f g where "?p a f" "?p b g" by auto
     thus ?case by (force intro!: exI[where x="\<lambda>i. f i \<inter> g i"] simp: Pi'_def)
   next
     case (UN k)
     then obtain kk a where "x \<in> kk" "kk \<in> k" "x \<in> Pi' (domain x) a" "Pi' (domain x) a \<subseteq> kk"
       "\<And>i. i\<in>domain x \<Longrightarrow> open (a i)"
       by force
     thus ?case by blast
   qed (auto simp: Pi'_def)
   have "\<exists>B.
     (\<forall>i\<in>domain x. x i \<in> B i \<and> B i \<subseteq> a i \<and> B i \<in> basis_proj)"
   proof (rule bchoice, safe)
     fix i assume "i \<in> domain x"
     hence "open (a i)" "x i \<in> a i" using a by auto
-    from topological_basisE[OF basis_proj this] guess b' .
+    from topological_basisE[OF basis_proj this] obtain b'
+      where "b' \<in> basis_proj" "(x)\<^sub>F i \<in> b'" "b' \<subseteq> a i"
+      by blast
     thus "\<exists>y. x i \<in> y \<and> y \<subseteq> a i \<and> y \<in> basis_proj" by auto
   qed
-  then guess B .. note B = this
+  then obtain B where B: "\<forall>i\<in>domain x. (x)\<^sub>F i \<in> B i \<and> B i \<subseteq> a i \<and> B i \<in> basis_proj"
+    by auto
   define B' where "B' = Pi' (domain x) (\<lambda>i. (B i)::'b set)"
   have "B' \<subseteq> Pi' (domain x) a" using B by (auto intro!: Pi'_mono simp: B'_def)
   also note \<open>\<dots> \<subseteq> O'\<close>
   finally show "\<exists>B'\<in>basis_finmap. x \<in> B' \<and> B' \<subseteq> O'" using B
     by (auto intro!: bexI[where x=B'] Pi'_mono in_basis_finmapI simp: B'_def)
 qed
 
 lemma range_enum_basis_finmap_imp_open:
   assumes "x \<in> basis_finmap"
   shows "open x"
   using finmap_topological_basis assms by (auto simp: topological_basis_def)
 
 instance proof qed (blast intro: finmap_topological_basis countable_basis_finmap topological_basis_imp_subbasis)
 
 end
 
 subsection \<open>Polish Space of Finite Maps\<close>
 
 instance fmap :: (countable, polish_space) polish_space proof qed
 
 
 subsection \<open>Product Measurable Space of Finite Maps\<close>
 
 definition "PiF I M \<equiv>
   sigma (\<Union>J \<in> I. (\<Pi>' j\<in>J. space (M j))) {(\<Pi>' j\<in>J. X j) |X J. J \<in> I \<and> X \<in> (\<Pi> j\<in>J. sets (M j))}"
 
 abbreviation
   "Pi\<^sub>F I M \<equiv> PiF I M"
 
 syntax
   "_PiF" :: "pttrn \<Rightarrow> 'i set \<Rightarrow> 'a measure \<Rightarrow> ('i => 'a) measure"  ("(3\<Pi>\<^sub>F _\<in>_./ _)"  10)
 translations
   "\<Pi>\<^sub>F x\<in>I. M" == "CONST PiF I (%x. M)"
 
 lemma PiF_gen_subset: "{(\<Pi>' j\<in>J. X j) |X J. J \<in> I \<and> X \<in> (\<Pi> j\<in>J. sets (M j))} \<subseteq>
     Pow (\<Union>J \<in> I. (\<Pi>' j\<in>J. space (M j)))"
   by (auto simp: Pi'_def) (blast dest: sets.sets_into_space)
 
 lemma space_PiF: "space (PiF I M) = (\<Union>J \<in> I. (\<Pi>' j\<in>J. space (M j)))"
   unfolding PiF_def using PiF_gen_subset by (rule space_measure_of)
 
 lemma sets_PiF:
   "sets (PiF I M) = sigma_sets (\<Union>J \<in> I. (\<Pi>' j\<in>J. space (M j)))
     {(\<Pi>' j\<in>J. X j) |X J. J \<in> I \<and> X \<in> (\<Pi> j\<in>J. sets (M j))}"
   unfolding PiF_def using PiF_gen_subset by (rule sets_measure_of)
 
 lemma sets_PiF_singleton:
   "sets (PiF {I} M) = sigma_sets (\<Pi>' j\<in>I. space (M j))
     {(\<Pi>' j\<in>I. X j) |X. X \<in> (\<Pi> j\<in>I. sets (M j))}"
   unfolding sets_PiF by simp
 
 lemma in_sets_PiFI:
   assumes "X = (Pi' J S)" "J \<in> I" "\<And>i. i\<in>J \<Longrightarrow> S i \<in> sets (M i)"
   shows "X \<in> sets (PiF I M)"
   unfolding sets_PiF
   using assms by blast
 
 lemma product_in_sets_PiFI:
   assumes "J \<in> I" "\<And>i. i\<in>J \<Longrightarrow> S i \<in> sets (M i)"
   shows "(Pi' J S) \<in> sets (PiF I M)"
   unfolding sets_PiF
   using assms by blast
 
 lemma singleton_space_subset_in_sets:
   fixes J
   assumes "J \<in> I"
   assumes "finite J"
   shows "space (PiF {J} M) \<in> sets (PiF I M)"
   using assms
   by (intro in_sets_PiFI[where J=J and S="\<lambda>i. space (M i)"])
       (auto simp: product_def space_PiF)
 
 lemma singleton_subspace_set_in_sets:
   assumes A: "A \<in> sets (PiF {J} M)"
   assumes "finite J"
   assumes "J \<in> I"
   shows "A \<in> sets (PiF I M)"
   using A[unfolded sets_PiF]
   apply (induct A)
   unfolding sets_PiF[symmetric] unfolding space_PiF[symmetric]
   using assms
   by (auto intro: in_sets_PiFI intro!: singleton_space_subset_in_sets)
 
 lemma finite_measurable_singletonI:
   assumes "finite I"
   assumes "\<And>J. J \<in> I \<Longrightarrow> finite J"
   assumes MN: "\<And>J. J \<in> I \<Longrightarrow> A \<in> measurable (PiF {J} M) N"
   shows "A \<in> measurable (PiF I M) N"
   unfolding measurable_def
 proof safe
   fix y assume "y \<in> sets N"
   have "A -` y \<inter> space (PiF I M) = (\<Union>J\<in>I. A -` y \<inter> space (PiF {J} M))"
     by (auto simp: space_PiF)
   also have "\<dots> \<in> sets (PiF I M)"
   proof (rule sets.finite_UN)
     show "finite I" by fact
     fix J assume "J \<in> I"
     with assms have "finite J" by simp
     show "A -` y \<inter> space (PiF {J} M) \<in> sets (PiF I M)"
       by (rule singleton_subspace_set_in_sets[OF measurable_sets[OF assms(3)]]) fact+
   qed
   finally show "A -` y \<inter> space (PiF I M) \<in> sets (PiF I M)" .
 next
   fix x assume "x \<in> space (PiF I M)" thus "A x \<in> space N"
     using MN[of "domain x"]
     by (auto simp: space_PiF measurable_space Pi'_def)
 qed
 
 lemma countable_finite_comprehension:
   fixes f :: "'a::countable set \<Rightarrow> _"
   assumes "\<And>s. P s \<Longrightarrow> finite s"
   assumes "\<And>s. P s \<Longrightarrow> f s \<in> sets M"
   shows "\<Union>{f s|s. P s} \<in> sets M"
 proof -
   have "\<Union>{f s|s. P s} = (\<Union>n::nat. let s = set (from_nat n) in if P s then f s else {})"
   proof safe
     fix x X s assume *: "x \<in> f s" "P s"
     with assms obtain l where "s = set l" using finite_list by blast
     with * show "x \<in> (\<Union>n. let s = set (from_nat n) in if P s then f s else {})" using \<open>P s\<close>
       by (auto intro!: exI[where x="to_nat l"])
   next
     fix x n assume "x \<in> (let s = set (from_nat n) in if P s then f s else {})"
     thus "x \<in> \<Union>{f s|s. P s}" using assms by (auto simp: Let_def split: if_split_asm)
   qed
   hence "\<Union>{f s|s. P s} = (\<Union>n. let s = set (from_nat n) in if P s then f s else {})" by simp
   also have "\<dots> \<in> sets M" using assms by (auto simp: Let_def)
   finally show ?thesis .
 qed
 
 lemma space_subset_in_sets:
   fixes J::"'a::countable set set"
   assumes "J \<subseteq> I"
   assumes "\<And>j. j \<in> J \<Longrightarrow> finite j"
   shows "space (PiF J M) \<in> sets (PiF I M)"
 proof -
   have "space (PiF J M) = \<Union>{space (PiF {j} M)|j. j \<in> J}"
     unfolding space_PiF by blast
   also have "\<dots> \<in> sets (PiF I M)" using assms
     by (intro countable_finite_comprehension) (auto simp: singleton_space_subset_in_sets)
   finally show ?thesis .
 qed
 
 lemma subspace_set_in_sets:
   fixes J::"'a::countable set set"
   assumes A: "A \<in> sets (PiF J M)"
   assumes "J \<subseteq> I"
   assumes "\<And>j. j \<in> J \<Longrightarrow> finite j"
   shows "A \<in> sets (PiF I M)"
   using A[unfolded sets_PiF]
   apply (induct A)
   unfolding sets_PiF[symmetric] unfolding space_PiF[symmetric]
   using assms
   by (auto intro: in_sets_PiFI intro!: space_subset_in_sets)
 
 lemma countable_measurable_PiFI:
   fixes I::"'a::countable set set"
   assumes MN: "\<And>J. J \<in> I \<Longrightarrow> finite J \<Longrightarrow> A \<in> measurable (PiF {J} M) N"
   shows "A \<in> measurable (PiF I M) N"
   unfolding measurable_def
 proof safe
   fix y assume "y \<in> sets N"
   have "A -` y = (\<Union>{A -` y \<inter> {x. domain x = J}|J. finite J})" by auto
   { fix x::"'a \<Rightarrow>\<^sub>F 'b"
     from finite_list[of "domain x"] obtain xs where "set xs = domain x" by auto
     hence "\<exists>n. domain x = set (from_nat n)"
       by (intro exI[where x="to_nat xs"]) auto }
   hence "A -` y \<inter> space (PiF I M) = (\<Union>n. A -` y \<inter> space (PiF ({set (from_nat n)}\<inter>I) M))"
     by (auto simp: space_PiF Pi'_def)
   also have "\<dots> \<in> sets (PiF I M)"
     apply (intro sets.Int sets.countable_nat_UN subsetI, safe)
     apply (case_tac "set (from_nat i) \<in> I")
     apply simp_all
     apply (rule singleton_subspace_set_in_sets[OF measurable_sets[OF MN]])
     using assms \<open>y \<in> sets N\<close>
     apply (auto simp: space_PiF)
     done
   finally show "A -` y \<inter> space (PiF I M) \<in> sets (PiF I M)" .
 next
   fix x assume "x \<in> space (PiF I M)" thus "A x \<in> space N"
     using MN[of "domain x"] by (auto simp: space_PiF measurable_space Pi'_def)
 qed
 
 lemma measurable_PiF:
   assumes f: "\<And>x. x \<in> space N \<Longrightarrow> domain (f x) \<in> I \<and> (\<forall>i\<in>domain (f x). (f x) i \<in> space (M i))"
   assumes S: "\<And>J S. J \<in> I \<Longrightarrow> (\<And>i. i \<in> J \<Longrightarrow> S i \<in> sets (M i)) \<Longrightarrow>
     f -` (Pi' J S) \<inter> space N \<in> sets N"
   shows "f \<in> measurable N (PiF I M)"
   unfolding PiF_def
   using PiF_gen_subset
   apply (rule measurable_measure_of)
   using f apply force
   apply (insert S, auto)
   done
 
 lemma restrict_sets_measurable:
   assumes A: "A \<in> sets (PiF I M)" and "J \<subseteq> I"
   shows "A \<inter> {m. domain m \<in> J} \<in> sets (PiF J M)"
   using A[unfolded sets_PiF]
 proof (induct A)
   case (Basic a)
   then obtain K S where S: "a = Pi' K S" "K \<in> I" "(\<forall>i\<in>K. S i \<in> sets (M i))"
     by auto
   show ?case
   proof cases
     assume "K \<in> J"
     hence "a \<inter> {m. domain m \<in> J} \<in> {Pi' K X |X K. K \<in> J \<and> X \<in> (\<Pi> j\<in>K. sets (M j))}" using S
       by (auto intro!: exI[where x=K] exI[where x=S] simp: Pi'_def)
     also have "\<dots> \<subseteq> sets (PiF J M)" unfolding sets_PiF by auto
     finally show ?thesis .
   next
     assume "K \<notin> J"
     hence "a \<inter> {m. domain m \<in> J} = {}" using S by (auto simp: Pi'_def)
     also have "\<dots> \<in> sets (PiF J M)" by simp
     finally show ?thesis .
   qed
 next
   case (Union a)
   have "\<Union>(a ` UNIV) \<inter> {m. domain m \<in> J} = (\<Union>i. (a i \<inter> {m. domain m \<in> J}))"
     by simp
   also have "\<dots> \<in> sets (PiF J M)" using Union by (intro sets.countable_nat_UN) auto
   finally show ?case .
 next
   case (Compl a)
   have "(space (PiF I M) - a) \<inter> {m. domain m \<in> J} = (space (PiF J M) - (a \<inter> {m. domain m \<in> J}))"
     using \<open>J \<subseteq> I\<close> by (auto simp: space_PiF Pi'_def)
   also have "\<dots> \<in> sets (PiF J M)" using Compl by auto
   finally show ?case by (simp add: space_PiF)
 qed simp
 
 lemma measurable_finmap_of:
   assumes f: "\<And>i. (\<exists>x \<in> space N. i \<in> J x) \<Longrightarrow> (\<lambda>x. f x i) \<in> measurable N (M i)"
   assumes J: "\<And>x. x \<in> space N \<Longrightarrow> J x \<in> I" "\<And>x. x \<in> space N \<Longrightarrow> finite (J x)"
   assumes JN: "\<And>S. {x. J x = S} \<inter> space N \<in> sets N"
   shows "(\<lambda>x. finmap_of (J x) (f x)) \<in> measurable N (PiF I M)"
 proof (rule measurable_PiF)
   fix x assume "x \<in> space N"
   with J[of x] measurable_space[OF f]
   show "domain (finmap_of (J x) (f x)) \<in> I \<and>
         (\<forall>i\<in>domain (finmap_of (J x) (f x)). (finmap_of (J x) (f x)) i \<in> space (M i))"
     by auto
 next
   fix K S assume "K \<in> I" and *: "\<And>i. i \<in> K \<Longrightarrow> S i \<in> sets (M i)"
   with J have eq: "(\<lambda>x. finmap_of (J x) (f x)) -` Pi' K S \<inter> space N =
     (if \<exists>x \<in> space N. K = J x \<and> finite K then if K = {} then {x \<in> space N. J x = K}
       else (\<Inter>i\<in>K. (\<lambda>x. f x i) -` S i \<inter> {x \<in> space N. J x = K}) else {})"
     by (auto simp: Pi'_def)
   have r: "{x \<in> space N. J x = K} = space N \<inter> ({x. J x = K} \<inter> space N)" by auto
   show "(\<lambda>x. finmap_of (J x) (f x)) -` Pi' K S \<inter> space N \<in> sets N"
     unfolding eq r
     apply (simp del: INT_simps add: )
     apply (intro conjI impI sets.finite_INT JN sets.Int[OF sets.top])
     apply simp apply assumption
     apply (subst Int_assoc[symmetric])
     apply (rule sets.Int)
     apply (intro measurable_sets[OF f] *) apply force apply assumption
     apply (intro JN)
     done
 qed
 
 lemma measurable_PiM_finmap_of:
   assumes "finite J"
   shows "finmap_of J \<in> measurable (Pi\<^sub>M J M) (PiF {J} M)"
   apply (rule measurable_finmap_of)
   apply (rule measurable_component_singleton)
   apply simp
   apply rule
   apply (rule \<open>finite J\<close>)
   apply simp
   done
 
 lemma proj_measurable_singleton:
   assumes "A \<in> sets (M i)"
   shows "(\<lambda>x. (x)\<^sub>F i) -` A \<inter> space (PiF {I} M) \<in> sets (PiF {I} M)"
 proof cases
   assume "i \<in> I"
   hence "(\<lambda>x. (x)\<^sub>F i) -` A \<inter> space (PiF {I} M) =
     Pi' I (\<lambda>x. if x = i then A else space (M x))"
     using sets.sets_into_space[OF ] \<open>A \<in> sets (M i)\<close> assms
     by (auto simp: space_PiF Pi'_def)
   thus ?thesis  using assms \<open>A \<in> sets (M i)\<close>
     by (intro in_sets_PiFI) auto
 next
   assume "i \<notin> I"
   hence "(\<lambda>x. (x)\<^sub>F i) -` A \<inter> space (PiF {I} M) =
     (if undefined \<in> A then space (PiF {I} M) else {})" by (auto simp: space_PiF Pi'_def)
   thus ?thesis by simp
 qed
 
 lemma measurable_proj_singleton:
   assumes "i \<in> I"
   shows "(\<lambda>x. (x)\<^sub>F i) \<in> measurable (PiF {I} M) (M i)"
   by (unfold measurable_def, intro CollectI conjI ballI proj_measurable_singleton assms)
      (insert \<open>i \<in> I\<close>, auto simp: space_PiF)
 
 lemma measurable_proj_countable:
   fixes I::"'a::countable set set"
   assumes "y \<in> space (M i)"
   shows "(\<lambda>x. if i \<in> domain x then (x)\<^sub>F i else y) \<in> measurable (PiF I M) (M i)"
 proof (rule countable_measurable_PiFI)
   fix J assume "J \<in> I" "finite J"
   show "(\<lambda>x. if i \<in> domain x then x i else y) \<in> measurable (PiF {J} M) (M i)"
     unfolding measurable_def
   proof safe
     fix z assume "z \<in> sets (M i)"
     have "(\<lambda>x. if i \<in> domain x then x i else y) -` z \<inter> space (PiF {J} M) =
       (\<lambda>x. if i \<in> J then (x)\<^sub>F i else y) -` z \<inter> space (PiF {J} M)"
       by (auto simp: space_PiF Pi'_def)
     also have "\<dots> \<in> sets (PiF {J} M)" using \<open>z \<in> sets (M i)\<close> \<open>finite J\<close>
       by (cases "i \<in> J") (auto intro!: measurable_sets[OF measurable_proj_singleton])
     finally show "(\<lambda>x. if i \<in> domain x then x i else y) -` z \<inter> space (PiF {J} M) \<in>
       sets (PiF {J} M)" .
   qed (insert \<open>y \<in> space (M i)\<close>, auto simp: space_PiF Pi'_def)
 qed
 
 lemma measurable_restrict_proj:
   assumes "J \<in> II" "finite J"
   shows "finmap_of J \<in> measurable (PiM J M) (PiF II M)"
   using assms
   by (intro measurable_finmap_of measurable_component_singleton) auto
 
 lemma measurable_proj_PiM:
   fixes J K ::"'a::countable set" and I::"'a set set"
   assumes "finite J" "J \<in> I"
   assumes "x \<in> space (PiM J M)"
   shows "proj \<in> measurable (PiF {J} M) (PiM J M)"
 proof (rule measurable_PiM_single)
   show "proj \<in> space (PiF {J} M) \<rightarrow> (\<Pi>\<^sub>E i \<in> J. space (M i))"
     using assms by (auto simp add: space_PiM space_PiF extensional_def sets_PiF Pi'_def)
 next
   fix A i assume A: "i \<in> J" "A \<in> sets (M i)"
   show "{\<omega> \<in> space (PiF {J} M). (\<omega>)\<^sub>F i \<in> A} \<in> sets (PiF {J} M)"
   proof
     have "{\<omega> \<in> space (PiF {J} M). (\<omega>)\<^sub>F i \<in> A} =
       (\<lambda>\<omega>. (\<omega>)\<^sub>F i) -` A \<inter> space (PiF {J} M)" by auto
     also have "\<dots> \<in> sets (PiF {J} M)"
       using assms A by (auto intro: measurable_sets[OF measurable_proj_singleton] simp: space_PiM)
     finally show ?thesis .
   qed simp
 qed
 
 lemma space_PiF_singleton_eq_product:
   assumes "finite I"
   shows "space (PiF {I} M) = (\<Pi>' i\<in>I. space (M i))"
   by (auto simp: product_def space_PiF assms)
 
 text \<open>adapted from @{thm sets_PiM_single}\<close>
 
 lemma sets_PiF_single:
   assumes "finite I" "I \<noteq> {}"
   shows "sets (PiF {I} M) =
     sigma_sets (\<Pi>' i\<in>I. space (M i))
       {{f\<in>\<Pi>' i\<in>I. space (M i). f i \<in> A} | i A. i \<in> I \<and> A \<in> sets (M i)}"
     (is "_ = sigma_sets ?\<Omega> ?R")
   unfolding sets_PiF_singleton
 proof (rule sigma_sets_eqI)
   interpret R: sigma_algebra ?\<Omega> "sigma_sets ?\<Omega> ?R" by (rule sigma_algebra_sigma_sets) auto
   fix A assume "A \<in> {Pi' I X |X. X \<in> (\<Pi> j\<in>I. sets (M j))}"
   then obtain X where X: "A = Pi' I X" "X \<in> (\<Pi> j\<in>I. sets (M j))" by auto
   show "A \<in> sigma_sets ?\<Omega> ?R"
   proof -
     from \<open>I \<noteq> {}\<close> X have "A = (\<Inter>j\<in>I. {f\<in>space (PiF {I} M). f j \<in> X j})"
       using sets.sets_into_space
       by (auto simp: space_PiF product_def) blast
     also have "\<dots> \<in> sigma_sets ?\<Omega> ?R"
       using X \<open>I \<noteq> {}\<close> assms by (intro R.finite_INT) (auto simp: space_PiF)
     finally show "A \<in> sigma_sets ?\<Omega> ?R" .
   qed
 next
   fix A assume "A \<in> ?R"
   then obtain i B where A: "A = {f\<in>\<Pi>' i\<in>I. space (M i). f i \<in> B}" "i \<in> I" "B \<in> sets (M i)"
     by auto
   then have "A = (\<Pi>' j \<in> I. if j = i then B else space (M j))"
     using sets.sets_into_space[OF A(3)]
     apply (auto simp: Pi'_iff split: if_split_asm)
     apply blast
     done
   also have "\<dots> \<in> sigma_sets ?\<Omega> {Pi' I X |X. X \<in> (\<Pi> j\<in>I. sets (M j))}"
     using A
     by (intro sigma_sets.Basic )
        (auto intro: exI[where x="\<lambda>j. if j = i then B else space (M j)"])
   finally show "A \<in> sigma_sets ?\<Omega> {Pi' I X |X. X \<in> (\<Pi> j\<in>I. sets (M j))}" .
 qed
 
 text \<open>adapted from @{thm PiE_cong}\<close>
 
 lemma Pi'_cong:
   assumes "finite I"
   assumes "\<And>i. i \<in> I \<Longrightarrow> f i = g i"
   shows "Pi' I f = Pi' I g"
 using assms by (auto simp: Pi'_def)
 
 text \<open>adapted from @{thm Pi_UN}\<close>
 
 lemma Pi'_UN:
   fixes A :: "nat \<Rightarrow> 'i \<Rightarrow> 'a set"
   assumes "finite I"
   assumes mono: "\<And>i n m. i \<in> I \<Longrightarrow> n \<le> m \<Longrightarrow> A n i \<subseteq> A m i"
   shows "(\<Union>n. Pi' I (A n)) = Pi' I (\<lambda>i. \<Union>n. A n i)"
 proof (intro set_eqI iffI)
   fix f assume "f \<in> Pi' I (\<lambda>i. \<Union>n. A n i)"
   then have "\<forall>i\<in>I. \<exists>n. f i \<in> A n i" "domain f = I" by (auto simp: \<open>finite I\<close> Pi'_def)
   from bchoice[OF this(1)] obtain n where n: "\<And>i. i \<in> I \<Longrightarrow> f i \<in> (A (n i) i)" by auto
   obtain k where k: "\<And>i. i \<in> I \<Longrightarrow> n i \<le> k"
     using \<open>finite I\<close> finite_nat_set_iff_bounded_le[of "n`I"] by auto
   have "f \<in> Pi' I (\<lambda>i. A k i)"
   proof
     fix i assume "i \<in> I"
     from mono[OF this, of "n i" k] k[OF this] n[OF this] \<open>domain f = I\<close> \<open>i \<in> I\<close>
     show "f i \<in> A k i " by (auto simp: \<open>finite I\<close>)
   qed (simp add: \<open>domain f = I\<close> \<open>finite I\<close>)
   then show "f \<in> (\<Union>n. Pi' I (A n))" by auto
 qed (auto simp: Pi'_def \<open>finite I\<close>)
 
 text \<open>adapted from @{thm sets_PiM_sigma}\<close>
 
 lemma sigma_fprod_algebra_sigma_eq:
   fixes E :: "'i \<Rightarrow> 'a set set" and S :: "'i \<Rightarrow> nat \<Rightarrow> 'a set"
   assumes [simp]: "finite I" "I \<noteq> {}"
     and S_union: "\<And>i. i \<in> I \<Longrightarrow> (\<Union>j. S i j) = space (M i)"
     and S_in_E: "\<And>i. i \<in> I \<Longrightarrow> range (S i) \<subseteq> E i"
   assumes E_closed: "\<And>i. i \<in> I \<Longrightarrow> E i \<subseteq> Pow (space (M i))"
     and E_generates: "\<And>i. i \<in> I \<Longrightarrow> sets (M i) = sigma_sets (space (M i)) (E i)"
   defines "P == { Pi' I F | F. \<forall>i\<in>I. F i \<in> E i }"
   shows "sets (PiF {I} M) = sigma_sets (space (PiF {I} M)) P"
 proof
   let ?P = "sigma (space (Pi\<^sub>F {I} M)) P"
-  from \<open>finite I\<close>[THEN ex_bij_betw_finite_nat] guess T ..
+  from \<open>finite I\<close>[THEN ex_bij_betw_finite_nat] obtain T where "bij_betw T I {0..<card I}" ..
   then have T: "\<And>i. i \<in> I \<Longrightarrow> T i < card I" "\<And>i. i\<in>I \<Longrightarrow> the_inv_into I T (T i) = i"
     by (auto simp add: bij_betw_def set_eq_iff image_iff the_inv_into_f_f simp del: \<open>finite I\<close>)
   have P_closed: "P \<subseteq> Pow (space (Pi\<^sub>F {I} M))"
     using E_closed by (auto simp: space_PiF P_def Pi'_iff subset_eq)
   then have space_P: "space ?P = (\<Pi>' i\<in>I. space (M i))"
     by (simp add: space_PiF)
   have "sets (PiF {I} M) =
       sigma_sets (space ?P) {{f \<in> \<Pi>' i\<in>I. space (M i). f i \<in> A} |i A. i \<in> I \<and> A \<in> sets (M i)}"
     using sets_PiF_single[of I M] by (simp add: space_P)
   also have "\<dots> \<subseteq> sets (sigma (space (PiF {I} M)) P)"
   proof (safe intro!: sets.sigma_sets_subset)
     fix i A assume "i \<in> I" and A: "A \<in> sets (M i)"
     have "(\<lambda>x. (x)\<^sub>F i) \<in> measurable ?P (sigma (space (M i)) (E i))"
     proof (subst measurable_iff_measure_of)
       show "E i \<subseteq> Pow (space (M i))" using \<open>i \<in> I\<close> by fact
       from space_P \<open>i \<in> I\<close> show "(\<lambda>x. (x)\<^sub>F i) \<in> space ?P \<rightarrow> space (M i)"
         by auto
       show "\<forall>A\<in>E i. (\<lambda>x. (x)\<^sub>F i) -` A \<inter> space ?P \<in> sets ?P"
       proof
         fix A assume A: "A \<in> E i"
         from T have *: "\<exists>xs. length xs = card I
           \<and> (\<forall>j\<in>I. (g)\<^sub>F j \<in> (if i = j then A else S j (xs ! T j)))"
           if "domain g = I" and "\<forall>j\<in>I. (g)\<^sub>F j \<in> (if i = j then A else S j (f j))" for g f
           using that by (auto intro!: exI [of _ "map (\<lambda>n. f (the_inv_into I T n)) [0..<card I]"])
         from A have "(\<lambda>x. (x)\<^sub>F i) -` A \<inter> space ?P = (\<Pi>' j\<in>I. if i = j then A else space (M j))"
           using E_closed \<open>i \<in> I\<close> by (auto simp: space_P Pi_iff subset_eq split: if_split_asm)
         also have "\<dots> = (\<Pi>' j\<in>I. \<Union>n. if i = j then A else S j n)"
           by (intro Pi'_cong) (simp_all add: S_union)
         also have "\<dots> = {g. domain g = I \<and> (\<exists>f. \<forall>j\<in>I. (g)\<^sub>F j \<in> (if i = j then A else S j (f j)))}"
           by (rule set_eqI) (simp del: if_image_distrib add: Pi'_iff bchoice_iff)
         also have "\<dots> = (\<Union>xs\<in>{xs. length xs = card I}. \<Pi>' j\<in>I. if i = j then A else S j (xs ! T j))"
           using * by (auto simp add: Pi'_iff split del: if_split)
         also have "\<dots> \<in> sets ?P"
         proof (safe intro!: sets.countable_UN)
           fix xs show "(\<Pi>' j\<in>I. if i = j then A else S j (xs ! T j)) \<in> sets ?P"
             using A S_in_E
             by (simp add: P_closed)
                (auto simp: P_def subset_eq intro!: exI[of _ "\<lambda>j. if i = j then A else S j (xs ! T j)"])
         qed
         finally show "(\<lambda>x. (x)\<^sub>F i) -` A \<inter> space ?P \<in> sets ?P"
           using P_closed by simp
       qed
     qed
     from measurable_sets[OF this, of A] A \<open>i \<in> I\<close> E_closed
     have "(\<lambda>x. (x)\<^sub>F i) -` A \<inter> space ?P \<in> sets ?P"
       by (simp add: E_generates)
     also have "(\<lambda>x. (x)\<^sub>F i) -` A \<inter> space ?P = {f \<in> \<Pi>' i\<in>I. space (M i). f i \<in> A}"
       using P_closed by (auto simp: space_PiF)
     finally show "\<dots> \<in> sets ?P" .
   qed
   finally show "sets (PiF {I} M) \<subseteq> sigma_sets (space (PiF {I} M)) P"
     by (simp add: P_closed)
   show "sigma_sets (space (PiF {I} M)) P \<subseteq> sets (PiF {I} M)"
     using \<open>finite I\<close> \<open>I \<noteq> {}\<close>
     by (auto intro!: sets.sigma_sets_subset product_in_sets_PiFI simp: E_generates P_def)
 qed
 
 lemma product_open_generates_sets_PiF_single:
   assumes "I \<noteq> {}"
   assumes [simp]: "finite I"
   shows "sets (PiF {I} (\<lambda>_. borel::'b::second_countable_topology measure)) =
     sigma_sets (space (PiF {I} (\<lambda>_. borel))) {Pi' I F |F. (\<forall>i\<in>I. F i \<in> Collect open)}"
 proof -
-  from open_countable_basisE[OF open_UNIV] guess S::"'b set set" . note S = this
+  from open_countable_basisE[OF open_UNIV] obtain S::"'b set set"
+    where S: "S \<subseteq> (SOME B. countable B \<and> topological_basis B)" "UNIV = \<Union> S"
+    by auto
   show ?thesis
   proof (rule sigma_fprod_algebra_sigma_eq)
     show "finite I" by simp
     show "I \<noteq> {}" by fact
     define S' where "S' = from_nat_into S"
     show "(\<Union>j. S' j) = space borel"
       using S
       apply (auto simp add: from_nat_into countable_basis_proj S'_def basis_proj_def)
       apply (metis (lifting, mono_tags) UNIV_I UnionE basis_proj_def countable_basis_proj countable_subset from_nat_into_surj)
       done
     show "range S' \<subseteq> Collect open"
       using S
       apply (auto simp add: from_nat_into countable_basis_proj S'_def)
       apply (metis UNIV_not_empty Union_empty from_nat_into subsetD topological_basis_open[OF basis_proj] basis_proj_def)
       done
     show "Collect open \<subseteq> Pow (space borel)" by simp
     show "sets borel = sigma_sets (space borel) (Collect open)"
       by (simp add: borel_def)
   qed
 qed
 
 lemma finmap_UNIV[simp]: "(\<Union>J\<in>Collect finite. \<Pi>' j\<in>J. UNIV) = UNIV" by auto
 
 lemma borel_eq_PiF_borel:
   shows "(borel :: ('i::countable \<Rightarrow>\<^sub>F 'a::polish_space) measure) =
     PiF (Collect finite) (\<lambda>_. borel :: 'a measure)"
   unfolding borel_def PiF_def
 proof (rule measure_eqI, clarsimp, rule sigma_sets_eqI)
   fix a::"('i \<Rightarrow>\<^sub>F 'a) set" assume "a \<in> Collect open" hence "open a" by simp
   then obtain B' where B': "B'\<subseteq>basis_finmap" "a = \<Union>B'"
     using finmap_topological_basis by (force simp add: topological_basis_def)
   have "a \<in> sigma UNIV {Pi' J X |X J. finite J \<and> X \<in> J \<rightarrow> sigma_sets UNIV (Collect open)}"
     unfolding \<open>a = \<Union>B'\<close>
   proof (rule sets.countable_Union)
     from B' countable_basis_finmap show "countable B'" by (metis countable_subset)
   next
     show "B' \<subseteq> sets (sigma UNIV
       {Pi' J X |X J. finite J \<and> X \<in> J \<rightarrow> sigma_sets UNIV (Collect open)})" (is "_ \<subseteq> sets ?s")
     proof
       fix x assume "x \<in> B'" with B' have "x \<in> basis_finmap" by auto
       then obtain J X where "x = Pi' J X" "finite J" "X \<in> J \<rightarrow> sigma_sets UNIV (Collect open)"
         by (auto simp: basis_finmap_def topological_basis_open[OF basis_proj])
       thus "x \<in> sets ?s" by auto
     qed
   qed
   thus "a \<in> sigma_sets UNIV {Pi' J X |X J. finite J \<and> X \<in> J \<rightarrow> sigma_sets UNIV (Collect open)}"
     by simp
 next
   fix b::"('i \<Rightarrow>\<^sub>F 'a) set"
   assume "b \<in> {Pi' J X |X J. finite J \<and> X \<in> J \<rightarrow> sigma_sets UNIV (Collect open)}"
   hence b': "b \<in> sets (Pi\<^sub>F (Collect finite) (\<lambda>_. borel))" by (auto simp: sets_PiF borel_def)
   let ?b = "\<lambda>J. b \<inter> {x. domain x = J}"
   have "b = \<Union>((\<lambda>J. ?b J) ` Collect finite)" by auto
   also have "\<dots> \<in> sets borel"
   proof (rule sets.countable_Union, safe)
     fix J::"'i set" assume "finite J"
     { assume ef: "J = {}"
       have "?b J \<in> sets borel"
       proof cases
         assume "?b J \<noteq> {}"
         then obtain f where "f \<in> b" "domain f = {}" using ef by auto
         hence "?b J = {f}" using \<open>J = {}\<close>
           by (auto simp: finmap_eq_iff)
         also have "{f} \<in> sets borel" by simp
         finally show ?thesis .
       qed simp
     } moreover {
       assume "J \<noteq> ({}::'i set)"
       have "(?b J) = b \<inter> {m. domain m \<in> {J}}" by auto
       also have "\<dots> \<in> sets (PiF {J} (\<lambda>_. borel))"
         using b' by (rule restrict_sets_measurable) (auto simp: \<open>finite J\<close>)
       also have "\<dots> = sigma_sets (space (PiF {J} (\<lambda>_. borel)))
         {Pi' (J) F |F. (\<forall>j\<in>J. F j \<in> Collect open)}"
         (is "_ = sigma_sets _ ?P")
        by (rule product_open_generates_sets_PiF_single[OF \<open>J \<noteq> {}\<close> \<open>finite J\<close>])
       also have "\<dots> \<subseteq> sigma_sets UNIV (Collect open)"
         by (intro sigma_sets_mono'') (auto intro!: open_Pi'I simp: space_PiF)
       finally have "(?b J) \<in> sets borel" by (simp add: borel_def)
     } ultimately show "(?b J) \<in> sets borel" by blast
   qed (simp add: countable_Collect_finite)
   finally show "b \<in> sigma_sets UNIV (Collect open)" by (simp add: borel_def)
 qed (simp add: emeasure_sigma borel_def PiF_def)
 
 subsection \<open>Isomorphism between Functions and Finite Maps\<close>
 
 lemma measurable_finmap_compose:
   shows "(\<lambda>m. compose J m f) \<in> measurable (PiM (f ` J) (\<lambda>_. M)) (PiM J (\<lambda>_. M))"
   unfolding compose_def by measurable
 
 lemma measurable_compose_inv:
   assumes inj: "\<And>j. j \<in> J \<Longrightarrow> f' (f j) = j"
   shows "(\<lambda>m. compose (f ` J) m f') \<in> measurable (PiM J (\<lambda>_. M)) (PiM (f ` J) (\<lambda>_. M))"
   unfolding compose_def by (rule measurable_restrict) (auto simp: inj)
 
 locale function_to_finmap =
   fixes J::"'a set" and f :: "'a \<Rightarrow> 'b::countable" and f'
   assumes [simp]: "finite J"
   assumes inv: "i \<in> J \<Longrightarrow> f' (f i) = i"
 begin
 
 text \<open>to measure finmaps\<close>
 
 definition "fm = (finmap_of (f ` J)) o (\<lambda>g. compose (f ` J) g f')"
 
 lemma domain_fm[simp]: "domain (fm x) = f ` J"
   unfolding fm_def by simp
 
 lemma fm_restrict[simp]: "fm (restrict y J) = fm y"
   unfolding fm_def by (auto simp: compose_def inv intro: restrict_ext)
 
 lemma fm_product:
   assumes "\<And>i. space (M i) = UNIV"
   shows "fm -` Pi' (f ` J) S \<inter> space (Pi\<^sub>M J M) = (\<Pi>\<^sub>E j \<in> J. S (f j))"
   using assms
   by (auto simp: inv fm_def compose_def space_PiM Pi'_def)
 
 lemma fm_measurable:
   assumes "f ` J \<in> N"
   shows "fm \<in> measurable (Pi\<^sub>M J (\<lambda>_. M)) (Pi\<^sub>F N (\<lambda>_. M))"
   unfolding fm_def
 proof (rule measurable_comp, rule measurable_compose_inv)
   show "finmap_of (f ` J) \<in> measurable (Pi\<^sub>M (f ` J) (\<lambda>_. M)) (PiF N (\<lambda>_. M)) "
     using assms by (intro measurable_finmap_of measurable_component_singleton) auto
 qed (simp_all add: inv)
 
 lemma proj_fm:
   assumes "x \<in> J"
   shows "fm m (f x) = m x"
   using assms by (auto simp: fm_def compose_def o_def inv)
 
 lemma inj_on_compose_f': "inj_on (\<lambda>g. compose (f ` J) g f') (extensional J)"
 proof (rule inj_on_inverseI)
   fix x::"'a \<Rightarrow> 'c" assume "x \<in> extensional J"
   thus "(\<lambda>x. compose J x f) (compose (f ` J) x f') = x"
     by (auto simp: compose_def inv extensional_def)
 qed
 
 lemma inj_on_fm:
   assumes "\<And>i. space (M i) = UNIV"
   shows "inj_on fm (space (Pi\<^sub>M J M))"
   using assms
   apply (auto simp: fm_def space_PiM PiE_def)
   apply (rule comp_inj_on)
   apply (rule inj_on_compose_f')
   apply (rule finmap_of_inj_on_extensional_finite)
   apply simp
   apply (auto)
   done
 
 text \<open>to measure functions\<close>
 
 definition "mf = (\<lambda>g. compose J g f) o proj"
 
 lemma mf_fm:
   assumes "x \<in> space (Pi\<^sub>M J (\<lambda>_. M))"
   shows "mf (fm x) = x"
 proof -
   have "mf (fm x) \<in> extensional J"
     by (auto simp: mf_def extensional_def compose_def)
   moreover
   have "x \<in> extensional J" using assms sets.sets_into_space
     by (force simp: space_PiM PiE_def)
   moreover
   { fix i assume "i \<in> J"
     hence "mf (fm x) i = x i"
       by (auto simp: inv mf_def compose_def fm_def)
   }
   ultimately
   show ?thesis by (rule extensionalityI)
 qed
 
 lemma mf_measurable:
   assumes "space M = UNIV"
   shows "mf \<in> measurable (PiF {f ` J} (\<lambda>_. M)) (PiM J (\<lambda>_. M))"
   unfolding mf_def
 proof (rule measurable_comp, rule measurable_proj_PiM)
   show "(\<lambda>g. compose J g f) \<in> measurable (Pi\<^sub>M (f ` J) (\<lambda>x. M)) (Pi\<^sub>M J (\<lambda>_. M))"
     by (rule measurable_finmap_compose)
 qed (auto simp add: space_PiM extensional_def assms)
 
 lemma fm_image_measurable:
   assumes "space M = UNIV"
   assumes "X \<in> sets (Pi\<^sub>M J (\<lambda>_. M))"
   shows "fm ` X \<in> sets (PiF {f ` J} (\<lambda>_. M))"
 proof -
   have "fm ` X = (mf) -` X \<inter> space (PiF {f ` J} (\<lambda>_. M))"
   proof safe
     fix x assume "x \<in> X"
     with mf_fm[of x] sets.sets_into_space[OF assms(2)] show "fm x \<in> mf -` X" by auto
     show "fm x \<in> space (PiF {f ` J} (\<lambda>_. M))" by (simp add: space_PiF assms)
   next
     fix y x
     assume x: "mf y \<in> X"
     assume y: "y \<in> space (PiF {f ` J} (\<lambda>_. M))"
     thus "y \<in> fm ` X"
       by (intro image_eqI[OF _ x], unfold finmap_eq_iff)
          (auto simp: space_PiF fm_def mf_def compose_def inv Pi'_def)
   qed
   also have "\<dots> \<in> sets (PiF {f ` J} (\<lambda>_. M))"
     using assms
     by (intro measurable_sets[OF mf_measurable]) auto
   finally show ?thesis .
 qed
 
 lemma fm_image_measurable_finite:
   assumes "space M = UNIV"
   assumes "X \<in> sets (Pi\<^sub>M J (\<lambda>_. M::'c measure))"
   shows "fm ` X \<in> sets (PiF (Collect finite) (\<lambda>_. M::'c measure))"
   using fm_image_measurable[OF assms]
   by (rule subspace_set_in_sets) (auto simp: finite_subset)
 
 text \<open>measure on finmaps\<close>
 
 definition "mapmeasure M N = distr M (PiF (Collect finite) N) (fm)"
 
 lemma sets_mapmeasure[simp]: "sets (mapmeasure M N) = sets (PiF (Collect finite) N)"
   unfolding mapmeasure_def by simp
 
 lemma space_mapmeasure[simp]: "space (mapmeasure M N) = space (PiF (Collect finite) N)"
   unfolding mapmeasure_def by simp
 
 lemma mapmeasure_PiF:
   assumes s1: "space M = space (Pi\<^sub>M J (\<lambda>_. N))"
   assumes s2: "sets M = sets (Pi\<^sub>M J (\<lambda>_. N))"
   assumes "space N = UNIV"
   assumes "X \<in> sets (PiF (Collect finite) (\<lambda>_. N))"
   shows "emeasure (mapmeasure M (\<lambda>_. N)) X = emeasure M ((fm -` X \<inter> extensional J))"
   using assms
   by (auto simp: measurable_cong_sets[OF s2 refl] mapmeasure_def emeasure_distr
     fm_measurable space_PiM PiE_def)
 
 lemma mapmeasure_PiM:
   fixes N::"'c measure"
   assumes s1: "space M = space (Pi\<^sub>M J (\<lambda>_. N))"
   assumes s2: "sets M = (Pi\<^sub>M J (\<lambda>_. N))"
   assumes N: "space N = UNIV"
   assumes X: "X \<in> sets M"
   shows "emeasure M X = emeasure (mapmeasure M (\<lambda>_. N)) (fm ` X)"
   unfolding mapmeasure_def
 proof (subst emeasure_distr, subst measurable_cong_sets[OF s2 refl], rule fm_measurable)
   have "X \<subseteq> space (Pi\<^sub>M J (\<lambda>_. N))" using assms by (simp add: sets.sets_into_space)
   from assms inj_on_fm[of "\<lambda>_. N"] subsetD[OF this] have "fm -` fm ` X \<inter> space (Pi\<^sub>M J (\<lambda>_. N)) = X"
     by (auto simp: vimage_image_eq inj_on_def)
   thus "emeasure M X = emeasure M (fm -` fm ` X \<inter> space M)" using s1
     by simp
   show "fm ` X \<in> sets (PiF (Collect finite) (\<lambda>_. N))"
     by (rule fm_image_measurable_finite[OF N X[simplified s2]])
 qed simp
 
 end
 
 end
diff --git a/src/HOL/Probability/Independent_Family.thy b/src/HOL/Probability/Independent_Family.thy
--- a/src/HOL/Probability/Independent_Family.thy
+++ b/src/HOL/Probability/Independent_Family.thy
@@ -1,1400 +1,1408 @@
 (*  Title:      HOL/Probability/Independent_Family.thy
     Author:     Johannes Hölzl, TU München
     Author:     Sudeep Kanav, TU München
 *)
 
 section \<open>Independent families of events, event sets, and random variables\<close>
 
 theory Independent_Family
   imports Infinite_Product_Measure
 begin
 
 definition (in prob_space)
   "indep_sets F I \<longleftrightarrow> (\<forall>i\<in>I. F i \<subseteq> events) \<and>
     (\<forall>J\<subseteq>I. J \<noteq> {} \<longrightarrow> finite J \<longrightarrow> (\<forall>A\<in>Pi J F. prob (\<Inter>j\<in>J. A j) = (\<Prod>j\<in>J. prob (A j))))"
 
 definition (in prob_space)
   "indep_set A B \<longleftrightarrow> indep_sets (case_bool A B) UNIV"
 
 definition (in prob_space)
   indep_events_def_alt: "indep_events A I \<longleftrightarrow> indep_sets (\<lambda>i. {A i}) I"
 
 lemma (in prob_space) indep_events_def:
   "indep_events A I \<longleftrightarrow> (A`I \<subseteq> events) \<and>
     (\<forall>J\<subseteq>I. J \<noteq> {} \<longrightarrow> finite J \<longrightarrow> prob (\<Inter>j\<in>J. A j) = (\<Prod>j\<in>J. prob (A j)))"
   unfolding indep_events_def_alt indep_sets_def
   apply (simp add: Ball_def Pi_iff image_subset_iff_funcset)
   apply (intro conj_cong refl arg_cong[where f=All] ext imp_cong)
   apply auto
   done
 
 lemma (in prob_space) indep_eventsI:
   "(\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M) \<Longrightarrow> (\<And>J. J \<subseteq> I \<Longrightarrow> finite J \<Longrightarrow> J \<noteq> {} \<Longrightarrow> prob (\<Inter>i\<in>J. F i) = (\<Prod>i\<in>J. prob (F i))) \<Longrightarrow> indep_events F I"
   by (auto simp: indep_events_def)
 
 definition (in prob_space)
   "indep_event A B \<longleftrightarrow> indep_events (case_bool A B) UNIV"
 
 lemma (in prob_space) indep_sets_cong:
   "I = J \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> F i = G i) \<Longrightarrow> indep_sets F I \<longleftrightarrow> indep_sets G J"
   by (simp add: indep_sets_def, intro conj_cong all_cong imp_cong ball_cong) blast+
 
 lemma (in prob_space) indep_events_finite_index_events:
   "indep_events F I \<longleftrightarrow> (\<forall>J\<subseteq>I. J \<noteq> {} \<longrightarrow> finite J \<longrightarrow> indep_events F J)"
   by (auto simp: indep_events_def)
 
 lemma (in prob_space) indep_sets_finite_index_sets:
   "indep_sets F I \<longleftrightarrow> (\<forall>J\<subseteq>I. J \<noteq> {} \<longrightarrow> finite J \<longrightarrow> indep_sets F J)"
 proof (intro iffI allI impI)
   assume *: "\<forall>J\<subseteq>I. J \<noteq> {} \<longrightarrow> finite J \<longrightarrow> indep_sets F J"
   show "indep_sets F I" unfolding indep_sets_def
   proof (intro conjI ballI allI impI)
     fix i assume "i \<in> I"
     with *[THEN spec, of "{i}"] show "F i \<subseteq> events"
       by (auto simp: indep_sets_def)
   qed (insert *, auto simp: indep_sets_def)
 qed (auto simp: indep_sets_def)
 
 lemma (in prob_space) indep_sets_mono_index:
   "J \<subseteq> I \<Longrightarrow> indep_sets F I \<Longrightarrow> indep_sets F J"
   unfolding indep_sets_def by auto
 
 lemma (in prob_space) indep_sets_mono_sets:
   assumes indep: "indep_sets F I"
   assumes mono: "\<And>i. i\<in>I \<Longrightarrow> G i \<subseteq> F i"
   shows "indep_sets G I"
 proof -
   have "(\<forall>i\<in>I. F i \<subseteq> events) \<Longrightarrow> (\<forall>i\<in>I. G i \<subseteq> events)"
     using mono by auto
   moreover have "\<And>A J. J \<subseteq> I \<Longrightarrow> A \<in> (\<Pi> j\<in>J. G j) \<Longrightarrow> A \<in> (\<Pi> j\<in>J. F j)"
     using mono by (auto simp: Pi_iff)
   ultimately show ?thesis
     using indep by (auto simp: indep_sets_def)
 qed
 
 lemma (in prob_space) indep_sets_mono:
   assumes indep: "indep_sets F I"
   assumes mono: "J \<subseteq> I" "\<And>i. i\<in>J \<Longrightarrow> G i \<subseteq> F i"
   shows "indep_sets G J"
   apply (rule indep_sets_mono_sets)
   apply (rule indep_sets_mono_index)
   apply (fact +)
   done
 
 lemma (in prob_space) indep_setsI:
   assumes "\<And>i. i \<in> I \<Longrightarrow> F i \<subseteq> events"
     and "\<And>A J. J \<noteq> {} \<Longrightarrow> J \<subseteq> I \<Longrightarrow> finite J \<Longrightarrow> (\<forall>j\<in>J. A j \<in> F j) \<Longrightarrow> prob (\<Inter>j\<in>J. A j) = (\<Prod>j\<in>J. prob (A j))"
   shows "indep_sets F I"
   using assms unfolding indep_sets_def by (auto simp: Pi_iff)
 
 lemma (in prob_space) indep_setsD:
   assumes "indep_sets F I" and "J \<subseteq> I" "J \<noteq> {}" "finite J" "\<forall>j\<in>J. A j \<in> F j"
   shows "prob (\<Inter>j\<in>J. A j) = (\<Prod>j\<in>J. prob (A j))"
   using assms unfolding indep_sets_def by auto
 
 lemma (in prob_space) indep_setI:
   assumes ev: "A \<subseteq> events" "B \<subseteq> events"
     and indep: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> B \<Longrightarrow> prob (a \<inter> b) = prob a * prob b"
   shows "indep_set A B"
   unfolding indep_set_def
 proof (rule indep_setsI)
   fix F J assume "J \<noteq> {}" "J \<subseteq> UNIV"
     and F: "\<forall>j\<in>J. F j \<in> (case j of True \<Rightarrow> A | False \<Rightarrow> B)"
   have "J \<in> Pow UNIV" by auto
   with F \<open>J \<noteq> {}\<close> indep[of "F True" "F False"]
   show "prob (\<Inter>j\<in>J. F j) = (\<Prod>j\<in>J. prob (F j))"
     unfolding UNIV_bool Pow_insert by (auto simp: ac_simps)
 qed (auto split: bool.split simp: ev)
 
 lemma (in prob_space) indep_setD:
   assumes indep: "indep_set A B" and ev: "a \<in> A" "b \<in> B"
   shows "prob (a \<inter> b) = prob a * prob b"
   using indep[unfolded indep_set_def, THEN indep_setsD, of UNIV "case_bool a b"] ev
   by (simp add: ac_simps UNIV_bool)
 
 lemma (in prob_space)
   assumes indep: "indep_set A B"
   shows indep_setD_ev1: "A \<subseteq> events"
     and indep_setD_ev2: "B \<subseteq> events"
   using indep unfolding indep_set_def indep_sets_def UNIV_bool by auto
 
 lemma (in prob_space) indep_sets_Dynkin:
   assumes indep: "indep_sets F I"
   shows "indep_sets (\<lambda>i. Dynkin (space M) (F i)) I"
     (is "indep_sets ?F I")
 proof (subst indep_sets_finite_index_sets, intro allI impI ballI)
   fix J assume "finite J" "J \<subseteq> I" "J \<noteq> {}"
   with indep have "indep_sets F J"
     by (subst (asm) indep_sets_finite_index_sets) auto
   { fix J K assume "indep_sets F K"
     let ?G = "\<lambda>S i. if i \<in> S then ?F i else F i"
     assume "finite J" "J \<subseteq> K"
     then have "indep_sets (?G J) K"
     proof induct
       case (insert j J)
       moreover define G where "G = ?G J"
       ultimately have G: "indep_sets G K" "\<And>i. i \<in> K \<Longrightarrow> G i \<subseteq> events" and "j \<in> K"
         by (auto simp: indep_sets_def)
       let ?D = "{E\<in>events. indep_sets (G(j := {E})) K }"
       { fix X assume X: "X \<in> events"
         assume indep: "\<And>J A. J \<noteq> {} \<Longrightarrow> J \<subseteq> K \<Longrightarrow> finite J \<Longrightarrow> j \<notin> J \<Longrightarrow> (\<forall>i\<in>J. A i \<in> G i)
           \<Longrightarrow> prob ((\<Inter>i\<in>J. A i) \<inter> X) = prob X * (\<Prod>i\<in>J. prob (A i))"
         have "indep_sets (G(j := {X})) K"
         proof (rule indep_setsI)
           fix i assume "i \<in> K" then show "(G(j:={X})) i \<subseteq> events"
             using G X by auto
         next
           fix A J assume J: "J \<noteq> {}" "J \<subseteq> K" "finite J" "\<forall>i\<in>J. A i \<in> (G(j := {X})) i"
           show "prob (\<Inter>j\<in>J. A j) = (\<Prod>j\<in>J. prob (A j))"
           proof cases
             assume "j \<in> J"
             with J have "A j = X" by auto
             show ?thesis
             proof cases
               assume "J = {j}" then show ?thesis by simp
             next
               assume "J \<noteq> {j}"
               have "prob (\<Inter>i\<in>J. A i) = prob ((\<Inter>i\<in>J-{j}. A i) \<inter> X)"
                 using \<open>j \<in> J\<close> \<open>A j = X\<close> by (auto intro!: arg_cong[where f=prob] split: if_split_asm)
               also have "\<dots> = prob X * (\<Prod>i\<in>J-{j}. prob (A i))"
               proof (rule indep)
                 show "J - {j} \<noteq> {}" "J - {j} \<subseteq> K" "finite (J - {j})" "j \<notin> J - {j}"
                   using J \<open>J \<noteq> {j}\<close> \<open>j \<in> J\<close> by auto
                 show "\<forall>i\<in>J - {j}. A i \<in> G i"
                   using J by auto
               qed
               also have "\<dots> = prob (A j) * (\<Prod>i\<in>J-{j}. prob (A i))"
                 using \<open>A j = X\<close> by simp
               also have "\<dots> = (\<Prod>i\<in>J. prob (A i))"
                 unfolding prod.insert_remove[OF \<open>finite J\<close>, symmetric, of "\<lambda>i. prob  (A i)"]
                 using \<open>j \<in> J\<close> by (simp add: insert_absorb)
               finally show ?thesis .
             qed
           next
             assume "j \<notin> J"
             with J have "\<forall>i\<in>J. A i \<in> G i" by (auto split: if_split_asm)
             with J show ?thesis
               by (intro indep_setsD[OF G(1)]) auto
           qed
         qed }
       note indep_sets_insert = this
       have "Dynkin_system (space M) ?D"
       proof (rule Dynkin_systemI', simp_all cong del: indep_sets_cong, safe)
         show "indep_sets (G(j := {{}})) K"
           by (rule indep_sets_insert) auto
       next
         fix X assume X: "X \<in> events" and G': "indep_sets (G(j := {X})) K"
         show "indep_sets (G(j := {space M - X})) K"
         proof (rule indep_sets_insert)
           fix J A assume J: "J \<noteq> {}" "J \<subseteq> K" "finite J" "j \<notin> J" and A: "\<forall>i\<in>J. A i \<in> G i"
           then have A_sets: "\<And>i. i\<in>J \<Longrightarrow> A i \<in> events"
             using G by auto
           have "prob ((\<Inter>j\<in>J. A j) \<inter> (space M - X)) =
               prob ((\<Inter>j\<in>J. A j) - (\<Inter>i\<in>insert j J. (A(j := X)) i))"
             using A_sets sets.sets_into_space[of _ M] X \<open>J \<noteq> {}\<close>
             by (auto intro!: arg_cong[where f=prob] split: if_split_asm)
           also have "\<dots> = prob (\<Inter>j\<in>J. A j) - prob (\<Inter>i\<in>insert j J. (A(j := X)) i)"
             using J \<open>J \<noteq> {}\<close> \<open>j \<notin> J\<close> A_sets X sets.sets_into_space
             by (auto intro!: finite_measure_Diff sets.finite_INT split: if_split_asm)
           finally have "prob ((\<Inter>j\<in>J. A j) \<inter> (space M - X)) =
               prob (\<Inter>j\<in>J. A j) - prob (\<Inter>i\<in>insert j J. (A(j := X)) i)" .
           moreover {
             have "prob (\<Inter>j\<in>J. A j) = (\<Prod>j\<in>J. prob (A j))"
               using J A \<open>finite J\<close> by (intro indep_setsD[OF G(1)]) auto
             then have "prob (\<Inter>j\<in>J. A j) = prob (space M) * (\<Prod>i\<in>J. prob (A i))"
               using prob_space by simp }
           moreover {
             have "prob (\<Inter>i\<in>insert j J. (A(j := X)) i) = (\<Prod>i\<in>insert j J. prob ((A(j := X)) i))"
               using J A \<open>j \<in> K\<close> by (intro indep_setsD[OF G']) auto
             then have "prob (\<Inter>i\<in>insert j J. (A(j := X)) i) = prob X * (\<Prod>i\<in>J. prob (A i))"
               using \<open>finite J\<close> \<open>j \<notin> J\<close> by (auto intro!: prod.cong) }
           ultimately have "prob ((\<Inter>j\<in>J. A j) \<inter> (space M - X)) = (prob (space M) - prob X) * (\<Prod>i\<in>J. prob (A i))"
             by (simp add: field_simps)
           also have "\<dots> = prob (space M - X) * (\<Prod>i\<in>J. prob (A i))"
             using X A by (simp add: finite_measure_compl)
           finally show "prob ((\<Inter>j\<in>J. A j) \<inter> (space M - X)) = prob (space M - X) * (\<Prod>i\<in>J. prob (A i))" .
         qed (insert X, auto)
       next
         fix F :: "nat \<Rightarrow> 'a set" assume disj: "disjoint_family F" and "range F \<subseteq> ?D"
         then have F: "\<And>i. F i \<in> events" "\<And>i. indep_sets (G(j:={F i})) K" by auto
         show "indep_sets (G(j := {\<Union>k. F k})) K"
         proof (rule indep_sets_insert)
           fix J A assume J: "j \<notin> J" "J \<noteq> {}" "J \<subseteq> K" "finite J" and A: "\<forall>i\<in>J. A i \<in> G i"
           then have A_sets: "\<And>i. i\<in>J \<Longrightarrow> A i \<in> events"
             using G by auto
           have "prob ((\<Inter>j\<in>J. A j) \<inter> (\<Union>k. F k)) = prob (\<Union>k. (\<Inter>i\<in>insert j J. (A(j := F k)) i))"
             using \<open>J \<noteq> {}\<close> \<open>j \<notin> J\<close> \<open>j \<in> K\<close> by (auto intro!: arg_cong[where f=prob] split: if_split_asm)
           moreover have "(\<lambda>k. prob (\<Inter>i\<in>insert j J. (A(j := F k)) i)) sums prob (\<Union>k. (\<Inter>i\<in>insert j J. (A(j := F k)) i))"
           proof (rule finite_measure_UNION)
             show "disjoint_family (\<lambda>k. \<Inter>i\<in>insert j J. (A(j := F k)) i)"
               using disj by (rule disjoint_family_on_bisimulation) auto
             show "range (\<lambda>k. \<Inter>i\<in>insert j J. (A(j := F k)) i) \<subseteq> events"
               using A_sets F \<open>finite J\<close> \<open>J \<noteq> {}\<close> \<open>j \<notin> J\<close> by (auto intro!: sets.Int)
           qed
           moreover { fix k
             from J A \<open>j \<in> K\<close> have "prob (\<Inter>i\<in>insert j J. (A(j := F k)) i) = prob (F k) * (\<Prod>i\<in>J. prob (A i))"
               by (subst indep_setsD[OF F(2)]) (auto intro!: prod.cong split: if_split_asm)
             also have "\<dots> = prob (F k) * prob (\<Inter>i\<in>J. A i)"
               using J A \<open>j \<in> K\<close> by (subst indep_setsD[OF G(1)]) auto
             finally have "prob (\<Inter>i\<in>insert j J. (A(j := F k)) i) = prob (F k) * prob (\<Inter>i\<in>J. A i)" . }
           ultimately have "(\<lambda>k. prob (F k) * prob (\<Inter>i\<in>J. A i)) sums (prob ((\<Inter>j\<in>J. A j) \<inter> (\<Union>k. F k)))"
             by simp
           moreover
           have "(\<lambda>k. prob (F k) * prob (\<Inter>i\<in>J. A i)) sums (prob (\<Union>k. F k) * prob (\<Inter>i\<in>J. A i))"
             using disj F(1) by (intro finite_measure_UNION sums_mult2) auto
           then have "(\<lambda>k. prob (F k) * prob (\<Inter>i\<in>J. A i)) sums (prob (\<Union>k. F k) * (\<Prod>i\<in>J. prob (A i)))"
             using J A \<open>j \<in> K\<close> by (subst indep_setsD[OF G(1), symmetric]) auto
           ultimately
           show "prob ((\<Inter>j\<in>J. A j) \<inter> (\<Union>k. F k)) = prob (\<Union>k. F k) * (\<Prod>j\<in>J. prob (A j))"
             by (auto dest!: sums_unique)
         qed (insert F, auto)
       qed (insert sets.sets_into_space, auto)
       then have mono: "Dynkin (space M) (G j) \<subseteq> {E \<in> events. indep_sets (G(j := {E})) K}"
       proof (rule Dynkin_system.Dynkin_subset, safe)
         fix X assume "X \<in> G j"
         then show "X \<in> events" using G \<open>j \<in> K\<close> by auto
         from \<open>indep_sets G K\<close>
         show "indep_sets (G(j := {X})) K"
           by (rule indep_sets_mono_sets) (insert \<open>X \<in> G j\<close>, auto)
       qed
       have "indep_sets (G(j:=?D)) K"
       proof (rule indep_setsI)
         fix i assume "i \<in> K" then show "(G(j := ?D)) i \<subseteq> events"
           using G(2) by auto
       next
         fix A J assume J: "J\<noteq>{}" "J \<subseteq> K" "finite J" and A: "\<forall>i\<in>J. A i \<in> (G(j := ?D)) i"
         show "prob (\<Inter>j\<in>J. A j) = (\<Prod>j\<in>J. prob (A j))"
         proof cases
           assume "j \<in> J"
           with A have indep: "indep_sets (G(j := {A j})) K" by auto
           from J A show ?thesis
             by (intro indep_setsD[OF indep]) auto
         next
           assume "j \<notin> J"
           with J A have "\<forall>i\<in>J. A i \<in> G i" by (auto split: if_split_asm)
           with J show ?thesis
             by (intro indep_setsD[OF G(1)]) auto
         qed
       qed
       then have "indep_sets (G(j := Dynkin (space M) (G j))) K"
         by (rule indep_sets_mono_sets) (insert mono, auto)
       then show ?case
         by (rule indep_sets_mono_sets) (insert \<open>j \<in> K\<close> \<open>j \<notin> J\<close>, auto simp: G_def)
     qed (insert \<open>indep_sets F K\<close>, simp) }
   from this[OF \<open>indep_sets F J\<close> \<open>finite J\<close> subset_refl]
   show "indep_sets ?F J"
     by (rule indep_sets_mono_sets) auto
 qed
 
 lemma (in prob_space) indep_sets_sigma:
   assumes indep: "indep_sets F I"
   assumes stable: "\<And>i. i \<in> I \<Longrightarrow> Int_stable (F i)"
   shows "indep_sets (\<lambda>i. sigma_sets (space M) (F i)) I"
 proof -
   from indep_sets_Dynkin[OF indep]
   show ?thesis
   proof (rule indep_sets_mono_sets, subst sigma_eq_Dynkin, simp_all add: stable)
     fix i assume "i \<in> I"
     with indep have "F i \<subseteq> events" by (auto simp: indep_sets_def)
     with sets.sets_into_space show "F i \<subseteq> Pow (space M)" by auto
   qed
 qed
 
 lemma (in prob_space) indep_sets_sigma_sets_iff:
   assumes "\<And>i. i \<in> I \<Longrightarrow> Int_stable (F i)"
   shows "indep_sets (\<lambda>i. sigma_sets (space M) (F i)) I \<longleftrightarrow> indep_sets F I"
 proof
   assume "indep_sets F I" then show "indep_sets (\<lambda>i. sigma_sets (space M) (F i)) I"
     by (rule indep_sets_sigma) fact
 next
   assume "indep_sets (\<lambda>i. sigma_sets (space M) (F i)) I" then show "indep_sets F I"
     by (rule indep_sets_mono_sets) (intro subsetI sigma_sets.Basic)
 qed
 
 definition (in prob_space)
   indep_vars_def2: "indep_vars M' X I \<longleftrightarrow>
     (\<forall>i\<in>I. random_variable (M' i) (X i)) \<and>
     indep_sets (\<lambda>i. { X i -` A \<inter> space M | A. A \<in> sets (M' i)}) I"
 
 definition (in prob_space)
   "indep_var Ma A Mb B \<longleftrightarrow> indep_vars (case_bool Ma Mb) (case_bool A B) UNIV"
 
 lemma (in prob_space) indep_vars_def:
   "indep_vars M' X I \<longleftrightarrow>
     (\<forall>i\<in>I. random_variable (M' i) (X i)) \<and>
     indep_sets (\<lambda>i. sigma_sets (space M) { X i -` A \<inter> space M | A. A \<in> sets (M' i)}) I"
   unfolding indep_vars_def2
   apply (rule conj_cong[OF refl])
   apply (rule indep_sets_sigma_sets_iff[symmetric])
   apply (auto simp: Int_stable_def)
   apply (rule_tac x="A \<inter> Aa" in exI)
   apply auto
   done
 
 lemma (in prob_space) indep_var_eq:
   "indep_var S X T Y \<longleftrightarrow>
     (random_variable S X \<and> random_variable T Y) \<and>
     indep_set
       (sigma_sets (space M) { X -` A \<inter> space M | A. A \<in> sets S})
       (sigma_sets (space M) { Y -` A \<inter> space M | A. A \<in> sets T})"
   unfolding indep_var_def indep_vars_def indep_set_def UNIV_bool
   by (intro arg_cong2[where f="(\<and>)"] arg_cong2[where f=indep_sets] ext)
      (auto split: bool.split)
 
 lemma (in prob_space) indep_sets2_eq:
   "indep_set A B \<longleftrightarrow> A \<subseteq> events \<and> B \<subseteq> events \<and> (\<forall>a\<in>A. \<forall>b\<in>B. prob (a \<inter> b) = prob a * prob b)"
   unfolding indep_set_def
 proof (intro iffI ballI conjI)
   assume indep: "indep_sets (case_bool A B) UNIV"
   { fix a b assume "a \<in> A" "b \<in> B"
     with indep_setsD[OF indep, of UNIV "case_bool a b"]
     show "prob (a \<inter> b) = prob a * prob b"
       unfolding UNIV_bool by (simp add: ac_simps) }
   from indep show "A \<subseteq> events" "B \<subseteq> events"
     unfolding indep_sets_def UNIV_bool by auto
 next
   assume *: "A \<subseteq> events \<and> B \<subseteq> events \<and> (\<forall>a\<in>A. \<forall>b\<in>B. prob (a \<inter> b) = prob a * prob b)"
   show "indep_sets (case_bool A B) UNIV"
   proof (rule indep_setsI)
     fix i show "(case i of True \<Rightarrow> A | False \<Rightarrow> B) \<subseteq> events"
       using * by (auto split: bool.split)
   next
     fix J X assume "J \<noteq> {}" "J \<subseteq> UNIV" and X: "\<forall>j\<in>J. X j \<in> (case j of True \<Rightarrow> A | False \<Rightarrow> B)"
     then have "J = {True} \<or> J = {False} \<or> J = {True,False}"
       by (auto simp: UNIV_bool)
     then show "prob (\<Inter>j\<in>J. X j) = (\<Prod>j\<in>J. prob (X j))"
       using X * by auto
   qed
 qed
 
 lemma (in prob_space) indep_set_sigma_sets:
   assumes "indep_set A B"
   assumes A: "Int_stable A" and B: "Int_stable B"
   shows "indep_set (sigma_sets (space M) A) (sigma_sets (space M) B)"
 proof -
   have "indep_sets (\<lambda>i. sigma_sets (space M) (case i of True \<Rightarrow> A | False \<Rightarrow> B)) UNIV"
   proof (rule indep_sets_sigma)
     show "indep_sets (case_bool A B) UNIV"
       by (rule \<open>indep_set A B\<close>[unfolded indep_set_def])
     fix i show "Int_stable (case i of True \<Rightarrow> A | False \<Rightarrow> B)"
       using A B by (cases i) auto
   qed
   then show ?thesis
     unfolding indep_set_def
     by (rule indep_sets_mono_sets) (auto split: bool.split)
 qed
 
 lemma (in prob_space) indep_eventsI_indep_vars:
   assumes indep: "indep_vars N X I"
   assumes P: "\<And>i. i \<in> I \<Longrightarrow> {x\<in>space (N i). P i x} \<in> sets (N i)"
   shows "indep_events (\<lambda>i. {x\<in>space M. P i (X i x)}) I"
 proof -
   have "indep_sets (\<lambda>i. {X i -` A \<inter> space M |A. A \<in> sets (N i)}) I"
     using indep unfolding indep_vars_def2 by auto
   then show ?thesis
     unfolding indep_events_def_alt
   proof (rule indep_sets_mono_sets)
     fix i assume "i \<in> I"
     then have "{{x \<in> space M. P i (X i x)}} = {X i -` {x\<in>space (N i). P i x} \<inter> space M}"
       using indep by (auto simp: indep_vars_def dest: measurable_space)
     also have "\<dots> \<subseteq> {X i -` A \<inter> space M |A. A \<in> sets (N i)}"
       using P[OF \<open>i \<in> I\<close>] by blast
     finally show "{{x \<in> space M. P i (X i x)}} \<subseteq> {X i -` A \<inter> space M |A. A \<in> sets (N i)}" .
   qed
 qed
 
 lemma (in prob_space) indep_sets_collect_sigma:
   fixes I :: "'j \<Rightarrow> 'i set" and J :: "'j set" and E :: "'i \<Rightarrow> 'a set set"
   assumes indep: "indep_sets E (\<Union>j\<in>J. I j)"
   assumes Int_stable: "\<And>i j. j \<in> J \<Longrightarrow> i \<in> I j \<Longrightarrow> Int_stable (E i)"
   assumes disjoint: "disjoint_family_on I J"
   shows "indep_sets (\<lambda>j. sigma_sets (space M) (\<Union>i\<in>I j. E i)) J"
 proof -
   let ?E = "\<lambda>j. {\<Inter>k\<in>K. E' k| E' K. finite K \<and> K \<noteq> {} \<and> K \<subseteq> I j \<and> (\<forall>k\<in>K. E' k \<in> E k) }"
 
   from indep have E: "\<And>j i. j \<in> J \<Longrightarrow> i \<in> I j \<Longrightarrow> E i \<subseteq> events"
     unfolding indep_sets_def by auto
   { fix j
     let ?S = "sigma_sets (space M) (\<Union>i\<in>I j. E i)"
     assume "j \<in> J"
     from E[OF this] interpret S: sigma_algebra "space M" ?S
       using sets.sets_into_space[of _ M] by (intro sigma_algebra_sigma_sets) auto
 
     have "sigma_sets (space M) (\<Union>i\<in>I j. E i) = sigma_sets (space M) (?E j)"
     proof (rule sigma_sets_eqI)
       fix A assume "A \<in> (\<Union>i\<in>I j. E i)"
-      then guess i ..
+      then obtain i where "i \<in> I j" "A \<in> E i" ..
       then show "A \<in> sigma_sets (space M) (?E j)"
         by (auto intro!: sigma_sets.intros(2-) exI[of _ "{i}"] exI[of _ "\<lambda>i. A"])
     next
       fix A assume "A \<in> ?E j"
       then obtain E' K where "finite K" "K \<noteq> {}" "K \<subseteq> I j" "\<And>k. k \<in> K \<Longrightarrow> E' k \<in> E k"
         and A: "A = (\<Inter>k\<in>K. E' k)"
         by auto
       then have "A \<in> ?S" unfolding A
         by (safe intro!: S.finite_INT) auto
       then show "A \<in> sigma_sets (space M) (\<Union>i\<in>I j. E i)"
         by simp
     qed }
   moreover have "indep_sets (\<lambda>j. sigma_sets (space M) (?E j)) J"
   proof (rule indep_sets_sigma)
     show "indep_sets ?E J"
     proof (intro indep_setsI)
       fix j assume "j \<in> J" with E show "?E j \<subseteq> events" by (force  intro!: sets.finite_INT)
     next
       fix K A assume K: "K \<noteq> {}" "K \<subseteq> J" "finite K"
         and "\<forall>j\<in>K. A j \<in> ?E j"
       then have "\<forall>j\<in>K. \<exists>E' L. A j = (\<Inter>l\<in>L. E' l) \<and> finite L \<and> L \<noteq> {} \<and> L \<subseteq> I j \<and> (\<forall>l\<in>L. E' l \<in> E l)"
         by simp
-      from bchoice[OF this] guess E' ..
+      from bchoice[OF this] obtain E'
+        where "\<forall>x\<in>K. \<exists>L. A x = \<Inter> (E' x ` L) \<and> finite L \<and> L \<noteq> {} \<and> L \<subseteq> I x \<and> (\<forall>l\<in>L. E' x l \<in> E l)"
+        ..
       from bchoice[OF this] obtain L
         where A: "\<And>j. j\<in>K \<Longrightarrow> A j = (\<Inter>l\<in>L j. E' j l)"
         and L: "\<And>j. j\<in>K \<Longrightarrow> finite (L j)" "\<And>j. j\<in>K \<Longrightarrow> L j \<noteq> {}" "\<And>j. j\<in>K \<Longrightarrow> L j \<subseteq> I j"
         and E': "\<And>j l. j\<in>K \<Longrightarrow> l \<in> L j \<Longrightarrow> E' j l \<in> E l"
         by auto
-
       { fix k l j assume "k \<in> K" "j \<in> K" "l \<in> L j" "l \<in> L k"
         have "k = j"
         proof (rule ccontr)
           assume "k \<noteq> j"
           with disjoint \<open>K \<subseteq> J\<close> \<open>k \<in> K\<close> \<open>j \<in> K\<close> have "I k \<inter> I j = {}"
             unfolding disjoint_family_on_def by auto
           with L(2,3)[OF \<open>j \<in> K\<close>] L(2,3)[OF \<open>k \<in> K\<close>]
           show False using \<open>l \<in> L k\<close> \<open>l \<in> L j\<close> by auto
         qed }
       note L_inj = this
 
       define k where "k l = (SOME k. k \<in> K \<and> l \<in> L k)" for l
       { fix x j l assume *: "j \<in> K" "l \<in> L j"
         have "k l = j" unfolding k_def
         proof (rule some_equality)
           fix k assume "k \<in> K \<and> l \<in> L k"
           with * L_inj show "k = j" by auto
         qed (insert *, simp) }
       note k_simp[simp] = this
       let ?E' = "\<lambda>l. E' (k l) l"
       have "prob (\<Inter>j\<in>K. A j) = prob (\<Inter>l\<in>(\<Union>k\<in>K. L k). ?E' l)"
         by (auto simp: A intro!: arg_cong[where f=prob])
       also have "\<dots> = (\<Prod>l\<in>(\<Union>k\<in>K. L k). prob (?E' l))"
         using L K E' by (intro indep_setsD[OF indep]) (simp_all add: UN_mono)
       also have "\<dots> = (\<Prod>j\<in>K. \<Prod>l\<in>L j. prob (E' j l))"
         using K L L_inj by (subst prod.UNION_disjoint) auto
       also have "\<dots> = (\<Prod>j\<in>K. prob (A j))"
         using K L E' by (auto simp add: A intro!: prod.cong indep_setsD[OF indep, symmetric]) blast
       finally show "prob (\<Inter>j\<in>K. A j) = (\<Prod>j\<in>K. prob (A j))" .
     qed
   next
     fix j assume "j \<in> J"
     show "Int_stable (?E j)"
     proof (rule Int_stableI)
       fix a assume "a \<in> ?E j" then obtain Ka Ea
         where a: "a = (\<Inter>k\<in>Ka. Ea k)" "finite Ka" "Ka \<noteq> {}" "Ka \<subseteq> I j" "\<And>k. k\<in>Ka \<Longrightarrow> Ea k \<in> E k" by auto
       fix b assume "b \<in> ?E j" then obtain Kb Eb
         where b: "b = (\<Inter>k\<in>Kb. Eb k)" "finite Kb" "Kb \<noteq> {}" "Kb \<subseteq> I j" "\<And>k. k\<in>Kb \<Longrightarrow> Eb k \<in> E k" by auto
       let ?f = "\<lambda>k. (if k \<in> Ka \<inter> Kb then Ea k \<inter> Eb k else if k \<in> Kb then Eb k else if k \<in> Ka then Ea k else {})"
       have "Ka \<union> Kb = (Ka \<inter> Kb) \<union> (Kb - Ka) \<union> (Ka - Kb)"
         by blast
       moreover have "(\<Inter>x\<in>Ka \<inter> Kb. Ea x \<inter> Eb x) \<inter>
         (\<Inter>x\<in>Kb - Ka. Eb x) \<inter> (\<Inter>x\<in>Ka - Kb. Ea x) = (\<Inter>k\<in>Ka. Ea k) \<inter> (\<Inter>k\<in>Kb. Eb k)"
         by auto
       ultimately have "(\<Inter>k\<in>Ka \<union> Kb. ?f k) = (\<Inter>k\<in>Ka. Ea k) \<inter> (\<Inter>k\<in>Kb. Eb k)" (is "?lhs = ?rhs")
         by (simp only: image_Un Inter_Un_distrib) simp
       then have "a \<inter> b = (\<Inter>k\<in>Ka \<union> Kb. ?f k)"
         by (simp only: a(1) b(1))
       with a b \<open>j \<in> J\<close> Int_stableD[OF Int_stable] show "a \<inter> b \<in> ?E j"
         by (intro CollectI exI[of _ "Ka \<union> Kb"] exI[of _ ?f]) auto
     qed
   qed
   ultimately show ?thesis
     by (simp cong: indep_sets_cong)
 qed
 
 lemma (in prob_space) indep_vars_restrict:
   assumes ind: "indep_vars M' X I" and K: "\<And>j. j \<in> L \<Longrightarrow> K j \<subseteq> I" and J: "disjoint_family_on K L"
   shows "indep_vars (\<lambda>j. PiM (K j) M') (\<lambda>j \<omega>. restrict (\<lambda>i. X i \<omega>) (K j)) L"
   unfolding indep_vars_def
 proof safe
   fix j assume "j \<in> L" then show "random_variable (Pi\<^sub>M (K j) M') (\<lambda>\<omega>. \<lambda>i\<in>K j. X i \<omega>)"
     using K ind by (auto simp: indep_vars_def intro!: measurable_restrict)
 next
   have X: "\<And>i. i \<in> I \<Longrightarrow> X i \<in> measurable M (M' i)"
     using ind by (auto simp: indep_vars_def)
   let ?proj = "\<lambda>j S. {(\<lambda>\<omega>. \<lambda>i\<in>K j. X i \<omega>) -` A \<inter> space M |A. A \<in> S}"
   let ?UN = "\<lambda>j. sigma_sets (space M) (\<Union>i\<in>K j. { X i -` A \<inter> space M| A. A \<in> sets (M' i) })"
   show "indep_sets (\<lambda>i. sigma_sets (space M) (?proj i (sets (Pi\<^sub>M (K i) M')))) L"
   proof (rule indep_sets_mono_sets)
     fix j assume j: "j \<in> L"
     have "sigma_sets (space M) (?proj j (sets (Pi\<^sub>M (K j) M'))) =
       sigma_sets (space M) (sigma_sets (space M) (?proj j (prod_algebra (K j) M')))"
       using j K X[THEN measurable_space] unfolding sets_PiM
       by (subst sigma_sets_vimage_commute) (auto simp add: Pi_iff)
     also have "\<dots> = sigma_sets (space M) (?proj j (prod_algebra (K j) M'))"
       by (rule sigma_sets_sigma_sets_eq) auto
     also have "\<dots> \<subseteq> ?UN j"
     proof (rule sigma_sets_mono, safe del: disjE elim!: prod_algebraE)
       fix J E assume J: "finite J" "J \<noteq> {} \<or> K j = {}"  "J \<subseteq> K j" and E: "\<forall>i. i \<in> J \<longrightarrow> E i \<in> sets (M' i)"
       show "(\<lambda>\<omega>. \<lambda>i\<in>K j. X i \<omega>) -` prod_emb (K j) M' J (Pi\<^sub>E J E) \<inter> space M \<in> ?UN j"
       proof cases
         assume "K j = {}" with J show ?thesis
           by (auto simp add: sigma_sets_empty_eq prod_emb_def)
       next
         assume "K j \<noteq> {}" with J have "J \<noteq> {}"
           by auto
         { interpret sigma_algebra "space M" "?UN j"
             by (rule sigma_algebra_sigma_sets) auto
           have "\<And>A. (\<And>i. i \<in> J \<Longrightarrow> A i \<in> ?UN j) \<Longrightarrow> \<Inter>(A ` J) \<in> ?UN j"
             using \<open>finite J\<close> \<open>J \<noteq> {}\<close> by (rule finite_INT) blast }
         note INT = this
 
         from \<open>J \<noteq> {}\<close> J K E[rule_format, THEN sets.sets_into_space] j
         have "(\<lambda>\<omega>. \<lambda>i\<in>K j. X i \<omega>) -` prod_emb (K j) M' J (Pi\<^sub>E J E) \<inter> space M
           = (\<Inter>i\<in>J. X i -` E i \<inter> space M)"
           apply (subst prod_emb_PiE[OF _ ])
           apply auto []
           apply auto []
           apply (auto simp add: Pi_iff intro!: X[THEN measurable_space])
           apply (erule_tac x=i in ballE)
           apply auto
           done
         also have "\<dots> \<in> ?UN j"
           apply (rule INT)
           apply (rule sigma_sets.Basic)
           using \<open>J \<subseteq> K j\<close> E
           apply auto
           done
         finally show ?thesis .
       qed
     qed
     finally show "sigma_sets (space M) (?proj j (sets (Pi\<^sub>M (K j) M'))) \<subseteq> ?UN j" .
   next
     show "indep_sets ?UN L"
     proof (rule indep_sets_collect_sigma)
       show "indep_sets (\<lambda>i. {X i -` A \<inter> space M |A. A \<in> sets (M' i)}) (\<Union>j\<in>L. K j)"
       proof (rule indep_sets_mono_index)
         show "indep_sets (\<lambda>i. {X i -` A \<inter> space M |A. A \<in> sets (M' i)}) I"
           using ind unfolding indep_vars_def2 by auto
         show "(\<Union>l\<in>L. K l) \<subseteq> I"
           using K by auto
       qed
     next
       fix l i assume "l \<in> L" "i \<in> K l"
       show "Int_stable {X i -` A \<inter> space M |A. A \<in> sets (M' i)}"
         apply (auto simp: Int_stable_def)
         apply (rule_tac x="A \<inter> Aa" in exI)
         apply auto
         done
     qed fact
   qed
 qed
 
 lemma (in prob_space) indep_var_restrict:
   assumes ind: "indep_vars M' X I" and AB: "A \<inter> B = {}" "A \<subseteq> I" "B \<subseteq> I"
   shows "indep_var (PiM A M') (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) A) (PiM B M') (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) B)"
 proof -
   have *:
     "case_bool (Pi\<^sub>M A M') (Pi\<^sub>M B M') = (\<lambda>b. PiM (case_bool A B b) M')"
     "case_bool (\<lambda>\<omega>. \<lambda>i\<in>A. X i \<omega>) (\<lambda>\<omega>. \<lambda>i\<in>B. X i \<omega>) = (\<lambda>b \<omega>. \<lambda>i\<in>case_bool A B b. X i \<omega>)"
     by (simp_all add: fun_eq_iff split: bool.split)
   show ?thesis
     unfolding indep_var_def * using AB
     by (intro indep_vars_restrict[OF ind]) (auto simp: disjoint_family_on_def split: bool.split)
 qed
 
 lemma (in prob_space) indep_vars_subset:
   assumes "indep_vars M' X I" "J \<subseteq> I"
   shows "indep_vars M' X J"
   using assms unfolding indep_vars_def indep_sets_def
   by auto
 
 lemma (in prob_space) indep_vars_cong:
   "I = J \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> X i = Y i) \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> M' i = N' i) \<Longrightarrow> indep_vars M' X I \<longleftrightarrow> indep_vars N' Y J"
   unfolding indep_vars_def2 by (intro conj_cong indep_sets_cong) auto
 
 definition (in prob_space) tail_events where
   "tail_events A = (\<Inter>n. sigma_sets (space M) (\<Union> (A ` {n..})))"
 
 lemma (in prob_space) tail_events_sets:
   assumes A: "\<And>i::nat. A i \<subseteq> events"
   shows "tail_events A \<subseteq> events"
 proof
   fix X assume X: "X \<in> tail_events A"
   let ?A = "(\<Inter>n. sigma_sets (space M) (\<Union> (A ` {n..})))"
   from X have "\<And>n::nat. X \<in> sigma_sets (space M) (\<Union> (A ` {n..}))" by (auto simp: tail_events_def)
   from this[of 0] have "X \<in> sigma_sets (space M) (\<Union>(A ` UNIV))" by simp
   then show "X \<in> events"
     by induct (insert A, auto)
 qed
 
 lemma (in prob_space) sigma_algebra_tail_events:
   assumes "\<And>i::nat. sigma_algebra (space M) (A i)"
   shows "sigma_algebra (space M) (tail_events A)"
   unfolding tail_events_def
 proof (simp add: sigma_algebra_iff2, safe)
   let ?A = "(\<Inter>n. sigma_sets (space M) (\<Union> (A ` {n..})))"
   interpret A: sigma_algebra "space M" "A i" for i by fact
   { fix X x assume "X \<in> ?A" "x \<in> X"
     then have "\<And>n. X \<in> sigma_sets (space M) (\<Union> (A ` {n..}))" by auto
     from this[of 0] have "X \<in> sigma_sets (space M) (\<Union>(A ` UNIV))" by simp
     then have "X \<subseteq> space M"
       by induct (insert A.sets_into_space, auto)
     with \<open>x \<in> X\<close> show "x \<in> space M" by auto }
   { fix F :: "nat \<Rightarrow> 'a set" and n assume "range F \<subseteq> ?A"
     then show "(\<Union>(F ` UNIV)) \<in> sigma_sets (space M) (\<Union> (A ` {n..}))"
       by (intro sigma_sets.Union) auto }
 qed (auto intro!: sigma_sets.Compl sigma_sets.Empty)
 
 lemma (in prob_space) kolmogorov_0_1_law:
   fixes A :: "nat \<Rightarrow> 'a set set"
   assumes "\<And>i::nat. sigma_algebra (space M) (A i)"
   assumes indep: "indep_sets A UNIV"
   and X: "X \<in> tail_events A"
   shows "prob X = 0 \<or> prob X = 1"
 proof -
   have A: "\<And>i. A i \<subseteq> events"
     using indep unfolding indep_sets_def by simp
 
   let ?D = "{D \<in> events. prob (X \<inter> D) = prob X * prob D}"
   interpret A: sigma_algebra "space M" "A i" for i by fact
   interpret T: sigma_algebra "space M" "tail_events A"
     by (rule sigma_algebra_tail_events) fact
   have "X \<subseteq> space M" using T.space_closed X by auto
 
   have X_in: "X \<in> events"
     using tail_events_sets A X by auto
 
   interpret D: Dynkin_system "space M" ?D
   proof (rule Dynkin_systemI)
     fix D assume "D \<in> ?D" then show "D \<subseteq> space M"
       using sets.sets_into_space by auto
   next
     show "space M \<in> ?D"
       using prob_space \<open>X \<subseteq> space M\<close> by (simp add: Int_absorb2)
   next
     fix A assume A: "A \<in> ?D"
     have "prob (X \<inter> (space M - A)) = prob (X - (X \<inter> A))"
       using \<open>X \<subseteq> space M\<close> by (auto intro!: arg_cong[where f=prob])
     also have "\<dots> = prob X - prob (X \<inter> A)"
       using X_in A by (intro finite_measure_Diff) auto
     also have "\<dots> = prob X * prob (space M) - prob X * prob A"
       using A prob_space by auto
     also have "\<dots> = prob X * prob (space M - A)"
       using X_in A sets.sets_into_space
       by (subst finite_measure_Diff) (auto simp: field_simps)
     finally show "space M - A \<in> ?D"
       using A \<open>X \<subseteq> space M\<close> by auto
   next
     fix F :: "nat \<Rightarrow> 'a set" assume dis: "disjoint_family F" and "range F \<subseteq> ?D"
     then have F: "range F \<subseteq> events" "\<And>i. prob (X \<inter> F i) = prob X * prob (F i)"
       by auto
     have "(\<lambda>i. prob (X \<inter> F i)) sums prob (\<Union>i. X \<inter> F i)"
     proof (rule finite_measure_UNION)
       show "range (\<lambda>i. X \<inter> F i) \<subseteq> events"
         using F X_in by auto
       show "disjoint_family (\<lambda>i. X \<inter> F i)"
         using dis by (rule disjoint_family_on_bisimulation) auto
     qed
     with F have "(\<lambda>i. prob X * prob (F i)) sums prob (X \<inter> (\<Union>i. F i))"
       by simp
     moreover have "(\<lambda>i. prob X * prob (F i)) sums (prob X * prob (\<Union>i. F i))"
       by (intro sums_mult finite_measure_UNION F dis)
     ultimately have "prob (X \<inter> (\<Union>i. F i)) = prob X * prob (\<Union>i. F i)"
       by (auto dest!: sums_unique)
     with F show "(\<Union>i. F i) \<in> ?D"
       by auto
   qed
 
   { fix n
     have "indep_sets (\<lambda>b. sigma_sets (space M) (\<Union>m\<in>case_bool {..n} {Suc n..} b. A m)) UNIV"
     proof (rule indep_sets_collect_sigma)
       have *: "(\<Union>b. case b of True \<Rightarrow> {..n} | False \<Rightarrow> {Suc n..}) = UNIV" (is "?U = _")
         by (simp split: bool.split add: set_eq_iff) (metis not_less_eq_eq)
       with indep show "indep_sets A ?U" by simp
       show "disjoint_family (case_bool {..n} {Suc n..})"
         unfolding disjoint_family_on_def by (auto split: bool.split)
       fix m
       show "Int_stable (A m)"
         unfolding Int_stable_def using A.Int by auto
     qed
     also have "(\<lambda>b. sigma_sets (space M) (\<Union>m\<in>case_bool {..n} {Suc n..} b. A m)) =
       case_bool (sigma_sets (space M) (\<Union>m\<in>{..n}. A m)) (sigma_sets (space M) (\<Union>m\<in>{Suc n..}. A m))"
       by (auto intro!: ext split: bool.split)
     finally have indep: "indep_set (sigma_sets (space M) (\<Union>m\<in>{..n}. A m)) (sigma_sets (space M) (\<Union>m\<in>{Suc n..}. A m))"
       unfolding indep_set_def by simp
 
     have "sigma_sets (space M) (\<Union>m\<in>{..n}. A m) \<subseteq> ?D"
     proof (simp add: subset_eq, rule)
       fix D assume D: "D \<in> sigma_sets (space M) (\<Union>m\<in>{..n}. A m)"
       have "X \<in> sigma_sets (space M) (\<Union>m\<in>{Suc n..}. A m)"
         using X unfolding tail_events_def by simp
       from indep_setD[OF indep D this] indep_setD_ev1[OF indep] D
       show "D \<in> events \<and> prob (X \<inter> D) = prob X * prob D"
         by (auto simp add: ac_simps)
     qed }
   then have "(\<Union>n. sigma_sets (space M) (\<Union>m\<in>{..n}. A m)) \<subseteq> ?D" (is "?A \<subseteq> _")
     by auto
 
   note \<open>X \<in> tail_events A\<close>
   also {
     have "\<And>n. sigma_sets (space M) (\<Union>i\<in>{n..}. A i) \<subseteq> sigma_sets (space M) ?A"
       by (intro sigma_sets_subseteq UN_mono) auto
    then have "tail_events A \<subseteq> sigma_sets (space M) ?A"
       unfolding tail_events_def by auto }
   also have "sigma_sets (space M) ?A = Dynkin (space M) ?A"
   proof (rule sigma_eq_Dynkin)
     { fix B n assume "B \<in> sigma_sets (space M) (\<Union>m\<in>{..n}. A m)"
       then have "B \<subseteq> space M"
         by induct (insert A sets.sets_into_space[of _ M], auto) }
     then show "?A \<subseteq> Pow (space M)" by auto
     show "Int_stable ?A"
     proof (rule Int_stableI)
-      fix a assume "a \<in> ?A" then guess n .. note a = this
-      fix b assume "b \<in> ?A" then guess m .. note b = this
+      fix a b assume "a \<in> ?A" "b \<in> ?A" then obtain n m
+        where a: "n \<in> UNIV" "a \<in> sigma_sets (space M) (\<Union> (A ` {..n}))"
+          and b: "m \<in> UNIV" "b \<in> sigma_sets (space M) (\<Union> (A ` {..m}))" by auto
       interpret Amn: sigma_algebra "space M" "sigma_sets (space M) (\<Union>i\<in>{..max m n}. A i)"
         using A sets.sets_into_space[of _ M] by (intro sigma_algebra_sigma_sets) auto
       have "sigma_sets (space M) (\<Union>i\<in>{..n}. A i) \<subseteq> sigma_sets (space M) (\<Union>i\<in>{..max m n}. A i)"
         by (intro sigma_sets_subseteq UN_mono) auto
       with a have "a \<in> sigma_sets (space M) (\<Union>i\<in>{..max m n}. A i)" by auto
       moreover
       have "sigma_sets (space M) (\<Union>i\<in>{..m}. A i) \<subseteq> sigma_sets (space M) (\<Union>i\<in>{..max m n}. A i)"
         by (intro sigma_sets_subseteq UN_mono) auto
       with b have "b \<in> sigma_sets (space M) (\<Union>i\<in>{..max m n}. A i)" by auto
       ultimately have "a \<inter> b \<in> sigma_sets (space M) (\<Union>i\<in>{..max m n}. A i)"
         using Amn.Int[of a b] by simp
       then show "a \<inter> b \<in> (\<Union>n. sigma_sets (space M) (\<Union>i\<in>{..n}. A i))" by auto
     qed
   qed
   also have "Dynkin (space M) ?A \<subseteq> ?D"
     using \<open>?A \<subseteq> ?D\<close> by (auto intro!: D.Dynkin_subset)
   finally show ?thesis by auto
 qed
 
 lemma (in prob_space) borel_0_1_law:
   fixes F :: "nat \<Rightarrow> 'a set"
   assumes F2: "indep_events F UNIV"
   shows "prob (\<Inter>n. \<Union>m\<in>{n..}. F m) = 0 \<or> prob (\<Inter>n. \<Union>m\<in>{n..}. F m) = 1"
 proof (rule kolmogorov_0_1_law[of "\<lambda>i. sigma_sets (space M) { F i }"])
   have F1: "range F \<subseteq> events"
     using F2 by (simp add: indep_events_def subset_eq)
   { fix i show "sigma_algebra (space M) (sigma_sets (space M) {F i})"
       using sigma_algebra_sigma_sets[of "{F i}" "space M"] F1 sets.sets_into_space
       by auto }
   show "indep_sets (\<lambda>i. sigma_sets (space M) {F i}) UNIV"
   proof (rule indep_sets_sigma)
     show "indep_sets (\<lambda>i. {F i}) UNIV"
       unfolding indep_events_def_alt[symmetric] by fact
     fix i show "Int_stable {F i}"
       unfolding Int_stable_def by simp
   qed
   let ?Q = "\<lambda>n. \<Union>i\<in>{n..}. F i"
   show "(\<Inter>n. \<Union>m\<in>{n..}. F m) \<in> tail_events (\<lambda>i. sigma_sets (space M) {F i})"
     unfolding tail_events_def
   proof
     fix j
     interpret S: sigma_algebra "space M" "sigma_sets (space M) (\<Union>i\<in>{j..}. sigma_sets (space M) {F i})"
       using order_trans[OF F1 sets.space_closed]
       by (intro sigma_algebra_sigma_sets) (simp add: sigma_sets_singleton subset_eq)
     have "(\<Inter>n. ?Q n) = (\<Inter>n\<in>{j..}. ?Q n)"
       by (intro decseq_SucI INT_decseq_offset UN_mono) auto
     also have "\<dots> \<in> sigma_sets (space M) (\<Union>i\<in>{j..}. sigma_sets (space M) {F i})"
       using order_trans[OF F1 sets.space_closed]
       by (safe intro!: S.countable_INT S.countable_UN)
          (auto simp: sigma_sets_singleton intro!: sigma_sets.Basic bexI)
     finally show "(\<Inter>n. ?Q n) \<in> sigma_sets (space M) (\<Union>i\<in>{j..}. sigma_sets (space M) {F i})"
       by simp
   qed
 qed
 
 lemma (in prob_space) borel_0_1_law_AE:
   fixes P :: "nat \<Rightarrow> 'a \<Rightarrow> bool"
   assumes "indep_events (\<lambda>m. {x\<in>space M. P m x}) UNIV" (is "indep_events ?P _")
   shows "(AE x in M. infinite {m. P m x}) \<or> (AE x in M. finite {m. P m x})"
 proof -
   have [measurable]: "\<And>m. {x\<in>space M. P m x} \<in> sets M"
     using assms by (auto simp: indep_events_def)
   have *: "(\<Inter>n. \<Union>m\<in>{n..}. {x \<in> space M. P m x}) \<in> events"
     by simp
   from assms have "prob (\<Inter>n. \<Union>m\<in>{n..}. ?P m) = 0 \<or> prob (\<Inter>n. \<Union>m\<in>{n..}. ?P m) = 1"
     by (rule borel_0_1_law)
   also have "prob (\<Inter>n. \<Union>m\<in>{n..}. ?P m) = 1 \<longleftrightarrow> (AE x in M. infinite {m. P m x})"
     using * by (simp add: prob_eq_1)
       (simp add: Bex_def infinite_nat_iff_unbounded_le)
   also have "prob (\<Inter>n. \<Union>m\<in>{n..}. ?P m) = 0 \<longleftrightarrow> (AE x in M. finite {m. P m x})"
     using * by (simp add: prob_eq_0)
       (auto simp add: Ball_def finite_nat_iff_bounded not_less [symmetric])
   finally show ?thesis
     by blast
 qed
 
 lemma (in prob_space) indep_sets_finite:
   assumes I: "I \<noteq> {}" "finite I"
     and F: "\<And>i. i \<in> I \<Longrightarrow> F i \<subseteq> events" "\<And>i. i \<in> I \<Longrightarrow> space M \<in> F i"
   shows "indep_sets F I \<longleftrightarrow> (\<forall>A\<in>Pi I F. prob (\<Inter>j\<in>I. A j) = (\<Prod>j\<in>I. prob (A j)))"
 proof
   assume *: "indep_sets F I"
   from I show "\<forall>A\<in>Pi I F. prob (\<Inter>j\<in>I. A j) = (\<Prod>j\<in>I. prob (A j))"
     by (intro indep_setsD[OF *] ballI) auto
 next
   assume indep: "\<forall>A\<in>Pi I F. prob (\<Inter>j\<in>I. A j) = (\<Prod>j\<in>I. prob (A j))"
   show "indep_sets F I"
   proof (rule indep_setsI[OF F(1)])
     fix A J assume J: "J \<noteq> {}" "J \<subseteq> I" "finite J"
     assume A: "\<forall>j\<in>J. A j \<in> F j"
     let ?A = "\<lambda>j. if j \<in> J then A j else space M"
     have "prob (\<Inter>j\<in>I. ?A j) = prob (\<Inter>j\<in>J. A j)"
       using subset_trans[OF F(1) sets.space_closed] J A
       by (auto intro!: arg_cong[where f=prob] split: if_split_asm) blast
     also
     from A F have "(\<lambda>j. if j \<in> J then A j else space M) \<in> Pi I F" (is "?A \<in> _")
       by (auto split: if_split_asm)
     with indep have "prob (\<Inter>j\<in>I. ?A j) = (\<Prod>j\<in>I. prob (?A j))"
       by auto
     also have "\<dots> = (\<Prod>j\<in>J. prob (A j))"
       unfolding if_distrib prod.If_cases[OF \<open>finite I\<close>]
       using prob_space \<open>J \<subseteq> I\<close> by (simp add: Int_absorb1 prod.neutral_const)
     finally show "prob (\<Inter>j\<in>J. A j) = (\<Prod>j\<in>J. prob (A j))" ..
   qed
 qed
 
 lemma (in prob_space) indep_vars_finite:
   fixes I :: "'i set"
   assumes I: "I \<noteq> {}" "finite I"
     and M': "\<And>i. i \<in> I \<Longrightarrow> sets (M' i) = sigma_sets (space (M' i)) (E i)"
     and rv: "\<And>i. i \<in> I \<Longrightarrow> random_variable (M' i) (X i)"
     and Int_stable: "\<And>i. i \<in> I \<Longrightarrow> Int_stable (E i)"
     and space: "\<And>i. i \<in> I \<Longrightarrow> space (M' i) \<in> E i" and closed: "\<And>i. i \<in> I \<Longrightarrow> E i \<subseteq> Pow (space (M' i))"
   shows "indep_vars M' X I \<longleftrightarrow>
     (\<forall>A\<in>(\<Pi> i\<in>I. E i). prob (\<Inter>j\<in>I. X j -` A j \<inter> space M) = (\<Prod>j\<in>I. prob (X j -` A j \<inter> space M)))"
 proof -
   from rv have X: "\<And>i. i \<in> I \<Longrightarrow> X i \<in> space M \<rightarrow> space (M' i)"
     unfolding measurable_def by simp
 
   { fix i assume "i\<in>I"
     from closed[OF \<open>i \<in> I\<close>]
     have "sigma_sets (space M) {X i -` A \<inter> space M |A. A \<in> sets (M' i)}
       = sigma_sets (space M) {X i -` A \<inter> space M |A. A \<in> E i}"
       unfolding sigma_sets_vimage_commute[OF X, OF \<open>i \<in> I\<close>, symmetric] M'[OF \<open>i \<in> I\<close>]
       by (subst sigma_sets_sigma_sets_eq) auto }
   note sigma_sets_X = this
 
   { fix i assume "i\<in>I"
     have "Int_stable {X i -` A \<inter> space M |A. A \<in> E i}"
     proof (rule Int_stableI)
       fix a assume "a \<in> {X i -` A \<inter> space M |A. A \<in> E i}"
       then obtain A where "a = X i -` A \<inter> space M" "A \<in> E i" by auto
       moreover
       fix b assume "b \<in> {X i -` A \<inter> space M |A. A \<in> E i}"
       then obtain B where "b = X i -` B \<inter> space M" "B \<in> E i" by auto
       moreover
       have "(X i -` A \<inter> space M) \<inter> (X i -` B \<inter> space M) = X i -` (A \<inter> B) \<inter> space M" by auto
       moreover note Int_stable[OF \<open>i \<in> I\<close>]
       ultimately
       show "a \<inter> b \<in> {X i -` A \<inter> space M |A. A \<in> E i}"
         by (auto simp del: vimage_Int intro!: exI[of _ "A \<inter> B"] dest: Int_stableD)
     qed }
   note indep_sets_X = indep_sets_sigma_sets_iff[OF this]
 
   { fix i assume "i \<in> I"
     { fix A assume "A \<in> E i"
       with M'[OF \<open>i \<in> I\<close>] have "A \<in> sets (M' i)" by auto
       moreover
       from rv[OF \<open>i\<in>I\<close>] have "X i \<in> measurable M (M' i)" by auto
       ultimately
       have "X i -` A \<inter> space M \<in> sets M" by (auto intro: measurable_sets) }
     with X[OF \<open>i\<in>I\<close>] space[OF \<open>i\<in>I\<close>]
     have "{X i -` A \<inter> space M |A. A \<in> E i} \<subseteq> events"
       "space M \<in> {X i -` A \<inter> space M |A. A \<in> E i}"
       by (auto intro!: exI[of _ "space (M' i)"]) }
   note indep_sets_finite_X = indep_sets_finite[OF I this]
 
   have "(\<forall>A\<in>\<Pi> i\<in>I. {X i -` A \<inter> space M |A. A \<in> E i}. prob (\<Inter>(A ` I)) = (\<Prod>j\<in>I. prob (A j))) =
     (\<forall>A\<in>\<Pi> i\<in>I. E i. prob ((\<Inter>j\<in>I. X j -` A j) \<inter> space M) = (\<Prod>x\<in>I. prob (X x -` A x \<inter> space M)))"
     (is "?L = ?R")
   proof safe
     fix A assume ?L and A: "A \<in> (\<Pi> i\<in>I. E i)"
     from \<open>?L\<close>[THEN bspec, of "\<lambda>i. X i -` A i \<inter> space M"] A \<open>I \<noteq> {}\<close>
     show "prob ((\<Inter>j\<in>I. X j -` A j) \<inter> space M) = (\<Prod>x\<in>I. prob (X x -` A x \<inter> space M))"
       by (auto simp add: Pi_iff)
   next
     fix A assume ?R and A: "A \<in> (\<Pi> i\<in>I. {X i -` A \<inter> space M |A. A \<in> E i})"
     from A have "\<forall>i\<in>I. \<exists>B. A i = X i -` B \<inter> space M \<and> B \<in> E i" by auto
     from bchoice[OF this] obtain B where B: "\<forall>i\<in>I. A i = X i -` B i \<inter> space M"
       "B \<in> (\<Pi> i\<in>I. E i)" by auto
     from \<open>?R\<close>[THEN bspec, OF B(2)] B(1) \<open>I \<noteq> {}\<close>
     show "prob (\<Inter>(A ` I)) = (\<Prod>j\<in>I. prob (A j))"
       by simp
   qed
   then show ?thesis using \<open>I \<noteq> {}\<close>
     by (simp add: rv indep_vars_def indep_sets_X sigma_sets_X indep_sets_finite_X cong: indep_sets_cong)
 qed
 
 lemma (in prob_space) indep_vars_compose:
   assumes "indep_vars M' X I"
   assumes rv: "\<And>i. i \<in> I \<Longrightarrow> Y i \<in> measurable (M' i) (N i)"
   shows "indep_vars N (\<lambda>i. Y i \<circ> X i) I"
   unfolding indep_vars_def
 proof
   from rv \<open>indep_vars M' X I\<close>
   show "\<forall>i\<in>I. random_variable (N i) (Y i \<circ> X i)"
     by (auto simp: indep_vars_def)
 
   have "indep_sets (\<lambda>i. sigma_sets (space M) {X i -` A \<inter> space M |A. A \<in> sets (M' i)}) I"
     using \<open>indep_vars M' X I\<close> by (simp add: indep_vars_def)
   then show "indep_sets (\<lambda>i. sigma_sets (space M) {(Y i \<circ> X i) -` A \<inter> space M |A. A \<in> sets (N i)}) I"
   proof (rule indep_sets_mono_sets)
     fix i assume "i \<in> I"
     with \<open>indep_vars M' X I\<close> have X: "X i \<in> space M \<rightarrow> space (M' i)"
       unfolding indep_vars_def measurable_def by auto
     { fix A assume "A \<in> sets (N i)"
       then have "\<exists>B. (Y i \<circ> X i) -` A \<inter> space M = X i -` B \<inter> space M \<and> B \<in> sets (M' i)"
         by (intro exI[of _ "Y i -` A \<inter> space (M' i)"])
            (auto simp: vimage_comp intro!: measurable_sets rv \<open>i \<in> I\<close> funcset_mem[OF X]) }
     then show "sigma_sets (space M) {(Y i \<circ> X i) -` A \<inter> space M |A. A \<in> sets (N i)} \<subseteq>
       sigma_sets (space M) {X i -` A \<inter> space M |A. A \<in> sets (M' i)}"
       by (intro sigma_sets_subseteq) (auto simp: vimage_comp)
   qed
 qed
 
 lemma (in prob_space) indep_vars_compose2:
   assumes "indep_vars M' X I"
   assumes rv: "\<And>i. i \<in> I \<Longrightarrow> Y i \<in> measurable (M' i) (N i)"
   shows "indep_vars N (\<lambda>i x. Y i (X i x)) I"
   using indep_vars_compose [OF assms] by (simp add: comp_def)
 
 lemma (in prob_space) indep_var_compose:
   assumes "indep_var M1 X1 M2 X2" "Y1 \<in> measurable M1 N1" "Y2 \<in> measurable M2 N2"
   shows "indep_var N1 (Y1 \<circ> X1) N2 (Y2 \<circ> X2)"
 proof -
   have "indep_vars (case_bool N1 N2) (\<lambda>b. case_bool Y1 Y2 b \<circ> case_bool X1 X2 b) UNIV"
     using assms
     by (intro indep_vars_compose[where M'="case_bool M1 M2"])
        (auto simp: indep_var_def split: bool.split)
   also have "(\<lambda>b. case_bool Y1 Y2 b \<circ> case_bool X1 X2 b) = case_bool (Y1 \<circ> X1) (Y2 \<circ> X2)"
     by (simp add: fun_eq_iff split: bool.split)
   finally show ?thesis
     unfolding indep_var_def .
 qed
 
 lemma (in prob_space) indep_vars_Min:
   fixes X :: "'i \<Rightarrow> 'a \<Rightarrow> real"
   assumes I: "finite I" "i \<notin> I" and indep: "indep_vars (\<lambda>_. borel) X (insert i I)"
   shows "indep_var borel (X i) borel (\<lambda>\<omega>. Min ((\<lambda>i. X i \<omega>)`I))"
 proof -
   have "indep_var
     borel ((\<lambda>f. f i) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) {i}))
     borel ((\<lambda>f. Min (f`I)) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) I))"
     using I by (intro indep_var_compose[OF indep_var_restrict[OF indep]] borel_measurable_Min) auto
   also have "((\<lambda>f. f i) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) {i})) = X i"
     by auto
   also have "((\<lambda>f. Min (f`I)) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) I)) = (\<lambda>\<omega>. Min ((\<lambda>i. X i \<omega>)`I))"
     by (auto cong: rev_conj_cong)
   finally show ?thesis
     unfolding indep_var_def .
 qed
 
 lemma (in prob_space) indep_vars_sum:
   fixes X :: "'i \<Rightarrow> 'a \<Rightarrow> real"
   assumes I: "finite I" "i \<notin> I" and indep: "indep_vars (\<lambda>_. borel) X (insert i I)"
   shows "indep_var borel (X i) borel (\<lambda>\<omega>. \<Sum>i\<in>I. X i \<omega>)"
 proof -
   have "indep_var
     borel ((\<lambda>f. f i) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) {i}))
     borel ((\<lambda>f. \<Sum>i\<in>I. f i) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) I))"
     using I by (intro indep_var_compose[OF indep_var_restrict[OF indep]] ) auto
   also have "((\<lambda>f. f i) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) {i})) = X i"
     by auto
   also have "((\<lambda>f. \<Sum>i\<in>I. f i) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) I)) = (\<lambda>\<omega>. \<Sum>i\<in>I. X i \<omega>)"
     by (auto cong: rev_conj_cong)
   finally show ?thesis .
 qed
 
 lemma (in prob_space) indep_vars_prod:
   fixes X :: "'i \<Rightarrow> 'a \<Rightarrow> real"
   assumes I: "finite I" "i \<notin> I" and indep: "indep_vars (\<lambda>_. borel) X (insert i I)"
   shows "indep_var borel (X i) borel (\<lambda>\<omega>. \<Prod>i\<in>I. X i \<omega>)"
 proof -
   have "indep_var
     borel ((\<lambda>f. f i) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) {i}))
     borel ((\<lambda>f. \<Prod>i\<in>I. f i) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) I))"
     using I by (intro indep_var_compose[OF indep_var_restrict[OF indep]] ) auto
   also have "((\<lambda>f. f i) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) {i})) = X i"
     by auto
   also have "((\<lambda>f. \<Prod>i\<in>I. f i) \<circ> (\<lambda>\<omega>. restrict (\<lambda>i. X i \<omega>) I)) = (\<lambda>\<omega>. \<Prod>i\<in>I. X i \<omega>)"
     by (auto cong: rev_conj_cong)
   finally show ?thesis .
 qed
 
 lemma (in prob_space) indep_varsD_finite:
   assumes X: "indep_vars M' X I"
   assumes I: "I \<noteq> {}" "finite I" "\<And>i. i \<in> I \<Longrightarrow> A i \<in> sets (M' i)"
   shows "prob (\<Inter>i\<in>I. X i -` A i \<inter> space M) = (\<Prod>i\<in>I. prob (X i -` A i \<inter> space M))"
 proof (rule indep_setsD)
   show "indep_sets (\<lambda>i. sigma_sets (space M) {X i -` A \<inter> space M |A. A \<in> sets (M' i)}) I"
     using X by (auto simp: indep_vars_def)
   show "I \<subseteq> I" "I \<noteq> {}" "finite I" using I by auto
   show "\<forall>i\<in>I. X i -` A i \<inter> space M \<in> sigma_sets (space M) {X i -` A \<inter> space M |A. A \<in> sets (M' i)}"
     using I by auto
 qed
 
 lemma (in prob_space) indep_varsD:
   assumes X: "indep_vars M' X I"
   assumes I: "J \<noteq> {}" "finite J" "J \<subseteq> I" "\<And>i. i \<in> J \<Longrightarrow> A i \<in> sets (M' i)"
   shows "prob (\<Inter>i\<in>J. X i -` A i \<inter> space M) = (\<Prod>i\<in>J. prob (X i -` A i \<inter> space M))"
 proof (rule indep_setsD)
   show "indep_sets (\<lambda>i. sigma_sets (space M) {X i -` A \<inter> space M |A. A \<in> sets (M' i)}) I"
     using X by (auto simp: indep_vars_def)
   show "\<forall>i\<in>J. X i -` A i \<inter> space M \<in> sigma_sets (space M) {X i -` A \<inter> space M |A. A \<in> sets (M' i)}"
     using I by auto
 qed fact+
 
 lemma (in prob_space) indep_vars_iff_distr_eq_PiM:
   fixes I :: "'i set" and X :: "'i \<Rightarrow> 'a \<Rightarrow> 'b"
   assumes "I \<noteq> {}"
   assumes rv: "\<And>i. random_variable (M' i) (X i)"
   shows "indep_vars M' X I \<longleftrightarrow>
     distr M (\<Pi>\<^sub>M i\<in>I. M' i) (\<lambda>x. \<lambda>i\<in>I. X i x) = (\<Pi>\<^sub>M i\<in>I. distr M (M' i) (X i))"
 proof -
   let ?P = "\<Pi>\<^sub>M i\<in>I. M' i"
   let ?X = "\<lambda>x. \<lambda>i\<in>I. X i x"
   let ?D = "distr M ?P ?X"
   have X: "random_variable ?P ?X" by (intro measurable_restrict rv)
   interpret D: prob_space ?D by (intro prob_space_distr X)
 
   let ?D' = "\<lambda>i. distr M (M' i) (X i)"
   let ?P' = "\<Pi>\<^sub>M i\<in>I. distr M (M' i) (X i)"
   interpret D': prob_space "?D' i" for i by (intro prob_space_distr rv)
   interpret P: product_prob_space ?D' I ..
 
   show ?thesis
   proof
     assume "indep_vars M' X I"
     show "?D = ?P'"
     proof (rule measure_eqI_generator_eq)
       show "Int_stable (prod_algebra I M')"
         by (rule Int_stable_prod_algebra)
       show "prod_algebra I M' \<subseteq> Pow (space ?P)"
         using prod_algebra_sets_into_space by (simp add: space_PiM)
       show "sets ?D = sigma_sets (space ?P) (prod_algebra I M')"
         by (simp add: sets_PiM space_PiM)
       show "sets ?P' = sigma_sets (space ?P) (prod_algebra I M')"
         by (simp add: sets_PiM space_PiM cong: prod_algebra_cong)
       let ?A = "\<lambda>i. \<Pi>\<^sub>E i\<in>I. space (M' i)"
       show "range ?A \<subseteq> prod_algebra I M'" "(\<Union>i. ?A i) = space (Pi\<^sub>M I M')"
         by (auto simp: space_PiM intro!: space_in_prod_algebra cong: prod_algebra_cong)
       { fix i show "emeasure ?D (\<Pi>\<^sub>E i\<in>I. space (M' i)) \<noteq> \<infinity>" by auto }
     next
       fix E assume E: "E \<in> prod_algebra I M'"
-      from prod_algebraE[OF E] guess J Y . note J = this
-
+      from prod_algebraE[OF E] obtain J Y
+        where J:
+          "E = prod_emb I M' J (Pi\<^sub>E J Y)"
+          "finite J"
+          "J \<noteq> {} \<or> I = {}"
+          "J \<subseteq> I"
+          "\<And>i. i \<in> J \<Longrightarrow> Y i \<in> sets (M' i)"
+        by auto
       from E have "E \<in> sets ?P" by (auto simp: sets_PiM)
       then have "emeasure ?D E = emeasure M (?X -` E \<inter> space M)"
         by (simp add: emeasure_distr X)
       also have "?X -` E \<inter> space M = (\<Inter>i\<in>J. X i -` Y i \<inter> space M)"
         using J \<open>I \<noteq> {}\<close> measurable_space[OF rv] by (auto simp: prod_emb_def PiE_iff split: if_split_asm)
       also have "emeasure M (\<Inter>i\<in>J. X i -` Y i \<inter> space M) = (\<Prod> i\<in>J. emeasure M (X i -` Y i \<inter> space M))"
         using \<open>indep_vars M' X I\<close> J \<open>I \<noteq> {}\<close> using indep_varsD[of M' X I J]
         by (auto simp: emeasure_eq_measure prod_ennreal measure_nonneg prod_nonneg)
       also have "\<dots> = (\<Prod> i\<in>J. emeasure (?D' i) (Y i))"
         using rv J by (simp add: emeasure_distr)
       also have "\<dots> = emeasure ?P' E"
         using P.emeasure_PiM_emb[of J Y] J by (simp add: prod_emb_def)
       finally show "emeasure ?D E = emeasure ?P' E" .
     qed
   next
     assume "?D = ?P'"
     show "indep_vars M' X I" unfolding indep_vars_def
     proof (intro conjI indep_setsI ballI rv)
       fix i show "sigma_sets (space M) {X i -` A \<inter> space M |A. A \<in> sets (M' i)} \<subseteq> events"
         by (auto intro!: sets.sigma_sets_subset measurable_sets rv)
     next
       fix J Y' assume J: "J \<noteq> {}" "J \<subseteq> I" "finite J"
       assume Y': "\<forall>j\<in>J. Y' j \<in> sigma_sets (space M) {X j -` A \<inter> space M |A. A \<in> sets (M' j)}"
       have "\<forall>j\<in>J. \<exists>Y. Y' j = X j -` Y \<inter> space M \<and> Y \<in> sets (M' j)"
       proof
         fix j assume "j \<in> J"
         from Y'[rule_format, OF this] rv[of j]
         show "\<exists>Y. Y' j = X j -` Y \<inter> space M \<and> Y \<in> sets (M' j)"
           by (subst (asm) sigma_sets_vimage_commute[symmetric, of _ _ "space (M' j)"])
              (auto dest: measurable_space simp: sets.sigma_sets_eq)
       qed
       from bchoice[OF this] obtain Y where
         Y: "\<And>j. j \<in> J \<Longrightarrow> Y' j = X j -` Y j \<inter> space M" "\<And>j. j \<in> J \<Longrightarrow> Y j \<in> sets (M' j)" by auto
       let ?E = "prod_emb I M' J (Pi\<^sub>E J Y)"
       from Y have "(\<Inter>j\<in>J. Y' j) = ?X -` ?E \<inter> space M"
         using J \<open>I \<noteq> {}\<close> measurable_space[OF rv] by (auto simp: prod_emb_def PiE_iff split: if_split_asm)
       then have "emeasure M (\<Inter>j\<in>J. Y' j) = emeasure M (?X -` ?E \<inter> space M)"
         by simp
       also have "\<dots> = emeasure ?D ?E"
         using Y  J by (intro emeasure_distr[symmetric] X sets_PiM_I) auto
       also have "\<dots> = emeasure ?P' ?E"
         using \<open>?D = ?P'\<close> by simp
       also have "\<dots> = (\<Prod> i\<in>J. emeasure (?D' i) (Y i))"
         using P.emeasure_PiM_emb[of J Y] J Y by (simp add: prod_emb_def)
       also have "\<dots> = (\<Prod> i\<in>J. emeasure M (Y' i))"
         using rv J Y by (simp add: emeasure_distr)
       finally have "emeasure M (\<Inter>j\<in>J. Y' j) = (\<Prod> i\<in>J. emeasure M (Y' i))" .
       then show "prob (\<Inter>j\<in>J. Y' j) = (\<Prod> i\<in>J. prob (Y' i))"
         by (auto simp: emeasure_eq_measure prod_ennreal measure_nonneg prod_nonneg)
     qed
   qed
 qed
 
 lemma (in prob_space) indep_vars_iff_distr_eq_PiM':
   fixes I :: "'i set" and X :: "'i \<Rightarrow> 'a \<Rightarrow> 'b"
   assumes "I \<noteq> {}"
   assumes rv: "\<And>i. i \<in> I \<Longrightarrow> random_variable (M' i) (X i)"
   shows "indep_vars M' X I \<longleftrightarrow>
            distr M (\<Pi>\<^sub>M i\<in>I. M' i) (\<lambda>x. \<lambda>i\<in>I. X i x) = (\<Pi>\<^sub>M i\<in>I. distr M (M' i) (X i))"
 proof -
   from assms obtain j where j: "j \<in> I"
     by auto
   define N' where "N' = (\<lambda>i. if i \<in> I then M' i else M' j)"
   define Y where "Y = (\<lambda>i. if i \<in> I then X i else X j)"
   have rv: "random_variable (N' i) (Y i)" for i
     using j by (auto simp: N'_def Y_def intro: assms)
 
   have "indep_vars M' X I = indep_vars N' Y I"
     by (intro indep_vars_cong) (auto simp: N'_def Y_def)
   also have "\<dots> \<longleftrightarrow> distr M (\<Pi>\<^sub>M i\<in>I. N' i) (\<lambda>x. \<lambda>i\<in>I. Y i x) = (\<Pi>\<^sub>M i\<in>I. distr M (N' i) (Y i))"
     by (intro indep_vars_iff_distr_eq_PiM rv assms)
   also have "(\<Pi>\<^sub>M i\<in>I. N' i) = (\<Pi>\<^sub>M i\<in>I. M' i)"
     by (intro PiM_cong) (simp_all add: N'_def)
   also have "(\<lambda>x. \<lambda>i\<in>I. Y i x) = (\<lambda>x. \<lambda>i\<in>I. X i x)"
     by (simp_all add: Y_def fun_eq_iff)
   also have "(\<Pi>\<^sub>M i\<in>I. distr M (N' i) (Y i)) = (\<Pi>\<^sub>M i\<in>I. distr M (M' i) (X i))"
     by (intro PiM_cong distr_cong) (simp_all add: N'_def Y_def)
   finally show ?thesis .
 qed
 
 lemma (in prob_space) indep_varD:
   assumes indep: "indep_var Ma A Mb B"
   assumes sets: "Xa \<in> sets Ma" "Xb \<in> sets Mb"
   shows "prob ((\<lambda>x. (A x, B x)) -` (Xa \<times> Xb) \<inter> space M) =
     prob (A -` Xa \<inter> space M) * prob (B -` Xb \<inter> space M)"
 proof -
   have "prob ((\<lambda>x. (A x, B x)) -` (Xa \<times> Xb) \<inter> space M) =
     prob (\<Inter>i\<in>UNIV. (case_bool A B i -` case_bool Xa Xb i \<inter> space M))"
     by (auto intro!: arg_cong[where f=prob] simp: UNIV_bool)
   also have "\<dots> = (\<Prod>i\<in>UNIV. prob (case_bool A B i -` case_bool Xa Xb i \<inter> space M))"
     using indep unfolding indep_var_def
     by (rule indep_varsD) (auto split: bool.split intro: sets)
   also have "\<dots> = prob (A -` Xa \<inter> space M) * prob (B -` Xb \<inter> space M)"
     unfolding UNIV_bool by simp
   finally show ?thesis .
 qed
 
 lemma (in prob_space) prob_indep_random_variable:
   assumes ind[simp]: "indep_var N X N Y"
   assumes [simp]: "A \<in> sets N" "B \<in> sets N"
   shows "\<P>(x in M. X x \<in> A \<and> Y x \<in> B) = \<P>(x in M. X x \<in> A) * \<P>(x in M. Y x \<in> B)"
 proof-
   have  " \<P>(x in M. (X x)\<in>A \<and>  (Y x)\<in> B ) = prob ((\<lambda>x. (X x, Y x)) -` (A \<times> B) \<inter> space M)"
     by (auto intro!: arg_cong[where f= prob])
   also have "...=  prob (X -` A \<inter> space M) * prob (Y -` B \<inter> space M)"
     by (auto intro!: indep_varD[where Ma=N and Mb=N])
   also have "... = \<P>(x in M. X x \<in> A) * \<P>(x in M. Y x \<in> B)"
     by (auto intro!: arg_cong2[where f= "(*)"] arg_cong[where f= prob])
   finally show ?thesis .
 qed
 
 lemma (in prob_space)
   assumes "indep_var S X T Y"
   shows indep_var_rv1: "random_variable S X"
     and indep_var_rv2: "random_variable T Y"
 proof -
   have "\<forall>i\<in>UNIV. random_variable (case_bool S T i) (case_bool X Y i)"
     using assms unfolding indep_var_def indep_vars_def by auto
   then show "random_variable S X" "random_variable T Y"
     unfolding UNIV_bool by auto
 qed
 
 lemma (in prob_space) indep_var_distribution_eq:
   "indep_var S X T Y \<longleftrightarrow> random_variable S X \<and> random_variable T Y \<and>
     distr M S X \<Otimes>\<^sub>M distr M T Y = distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))" (is "_ \<longleftrightarrow> _ \<and> _ \<and> ?S \<Otimes>\<^sub>M ?T = ?J")
 proof safe
   assume "indep_var S X T Y"
   then show rvs: "random_variable S X" "random_variable T Y"
     by (blast dest: indep_var_rv1 indep_var_rv2)+
   then have XY: "random_variable (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))"
     by (rule measurable_Pair)
 
   interpret X: prob_space ?S by (rule prob_space_distr) fact
   interpret Y: prob_space ?T by (rule prob_space_distr) fact
   interpret XY: pair_prob_space ?S ?T ..
   show "?S \<Otimes>\<^sub>M ?T = ?J"
   proof (rule pair_measure_eqI)
     show "sigma_finite_measure ?S" ..
     show "sigma_finite_measure ?T" ..
 
     fix A B assume A: "A \<in> sets ?S" and B: "B \<in> sets ?T"
     have "emeasure ?J (A \<times> B) = emeasure M ((\<lambda>x. (X x, Y x)) -` (A \<times> B) \<inter> space M)"
       using A B by (intro emeasure_distr[OF XY]) auto
     also have "\<dots> = emeasure M (X -` A \<inter> space M) * emeasure M (Y -` B \<inter> space M)"
       using indep_varD[OF \<open>indep_var S X T Y\<close>, of A B] A B
       by (simp add: emeasure_eq_measure measure_nonneg ennreal_mult)
     also have "\<dots> = emeasure ?S A * emeasure ?T B"
       using rvs A B by (simp add: emeasure_distr)
     finally show "emeasure ?S A * emeasure ?T B = emeasure ?J (A \<times> B)" by simp
   qed simp
 next
   assume rvs: "random_variable S X" "random_variable T Y"
   then have XY: "random_variable (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))"
     by (rule measurable_Pair)
 
   let ?S = "distr M S X" and ?T = "distr M T Y"
   interpret X: prob_space ?S by (rule prob_space_distr) fact
   interpret Y: prob_space ?T by (rule prob_space_distr) fact
   interpret XY: pair_prob_space ?S ?T ..
 
   assume "?S \<Otimes>\<^sub>M ?T = ?J"
 
   { fix S and X
     have "Int_stable {X -` A \<inter> space M |A. A \<in> sets S}"
     proof (safe intro!: Int_stableI)
       fix A B assume "A \<in> sets S" "B \<in> sets S"
       then show "\<exists>C. (X -` A \<inter> space M) \<inter> (X -` B \<inter> space M) = (X -` C \<inter> space M) \<and> C \<in> sets S"
         by (intro exI[of _ "A \<inter> B"]) auto
     qed }
   note Int_stable = this
 
   show "indep_var S X T Y" unfolding indep_var_eq
   proof (intro conjI indep_set_sigma_sets Int_stable rvs)
     show "indep_set {X -` A \<inter> space M |A. A \<in> sets S} {Y -` A \<inter> space M |A. A \<in> sets T}"
     proof (safe intro!: indep_setI)
       { fix A assume "A \<in> sets S" then show "X -` A \<inter> space M \<in> sets M"
         using \<open>X \<in> measurable M S\<close> by (auto intro: measurable_sets) }
       { fix A assume "A \<in> sets T" then show "Y -` A \<inter> space M \<in> sets M"
         using \<open>Y \<in> measurable M T\<close> by (auto intro: measurable_sets) }
     next
       fix A B assume ab: "A \<in> sets S" "B \<in> sets T"
       then have "prob ((X -` A \<inter> space M) \<inter> (Y -` B \<inter> space M)) = emeasure ?J (A \<times> B)"
         using XY by (auto simp add: emeasure_distr emeasure_eq_measure measure_nonneg intro!: arg_cong[where f="prob"])
       also have "\<dots> = emeasure (?S \<Otimes>\<^sub>M ?T) (A \<times> B)"
         unfolding \<open>?S \<Otimes>\<^sub>M ?T = ?J\<close> ..
       also have "\<dots> = emeasure ?S A * emeasure ?T B"
         using ab by (simp add: Y.emeasure_pair_measure_Times)
       finally show "prob ((X -` A \<inter> space M) \<inter> (Y -` B \<inter> space M)) =
         prob (X -` A \<inter> space M) * prob (Y -` B \<inter> space M)"
         using rvs ab by (simp add: emeasure_eq_measure emeasure_distr measure_nonneg ennreal_mult[symmetric])
     qed
   qed
 qed
 
 lemma (in prob_space) distributed_joint_indep:
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T"
   assumes X: "distributed M S X Px" and Y: "distributed M T Y Py"
   assumes indep: "indep_var S X T Y"
   shows "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) (\<lambda>(x, y). Px x * Py y)"
   using indep_var_distribution_eq[of S X T Y] indep
   by (intro distributed_joint_indep'[OF S T X Y]) auto
 
 lemma (in prob_space) indep_vars_nn_integral:
   assumes I: "finite I" "indep_vars (\<lambda>_. borel) X I" "\<And>i \<omega>. i \<in> I \<Longrightarrow> 0 \<le> X i \<omega>"
   shows "(\<integral>\<^sup>+\<omega>. (\<Prod>i\<in>I. X i \<omega>) \<partial>M) = (\<Prod>i\<in>I. \<integral>\<^sup>+\<omega>. X i \<omega> \<partial>M)"
 proof cases
   assume "I \<noteq> {}"
   define Y where [abs_def]: "Y i \<omega> = (if i \<in> I then X i \<omega> else 0)" for i \<omega>
   { fix i have "i \<in> I \<Longrightarrow> random_variable borel (X i)"
     using I(2) by (cases "i\<in>I") (auto simp: indep_vars_def) }
   note rv_X = this
 
   { fix i have "random_variable borel (Y i)"
     using I(2) by (cases "i\<in>I") (auto simp: Y_def rv_X) }
   note rv_Y = this[measurable]
 
   interpret Y: prob_space "distr M borel (Y i)" for i
     using I(2) by (cases "i \<in> I") (auto intro!: prob_space_distr simp: indep_vars_def prob_space_return)
   interpret product_sigma_finite "\<lambda>i. distr M borel (Y i)"
     ..
 
   have indep_Y: "indep_vars (\<lambda>i. borel) Y I"
     by (rule indep_vars_cong[THEN iffD1, OF _ _ _ I(2)]) (auto simp: Y_def)
 
   have "(\<integral>\<^sup>+\<omega>. (\<Prod>i\<in>I. X i \<omega>) \<partial>M) = (\<integral>\<^sup>+\<omega>. (\<Prod>i\<in>I. Y i \<omega>) \<partial>M)"
     using I(3) by (auto intro!: nn_integral_cong prod.cong simp add: Y_def max_def)
   also have "\<dots> = (\<integral>\<^sup>+\<omega>. (\<Prod>i\<in>I. \<omega> i) \<partial>distr M (Pi\<^sub>M I (\<lambda>i. borel)) (\<lambda>x. \<lambda>i\<in>I. Y i x))"
     by (subst nn_integral_distr) auto
   also have "\<dots> = (\<integral>\<^sup>+\<omega>. (\<Prod>i\<in>I. \<omega> i) \<partial>Pi\<^sub>M I (\<lambda>i. distr M borel (Y i)))"
     unfolding indep_vars_iff_distr_eq_PiM[THEN iffD1, OF \<open>I \<noteq> {}\<close> rv_Y indep_Y] ..
   also have "\<dots> = (\<Prod>i\<in>I. (\<integral>\<^sup>+\<omega>. \<omega> \<partial>distr M borel (Y i)))"
     by (rule product_nn_integral_prod) (auto intro: \<open>finite I\<close>)
   also have "\<dots> = (\<Prod>i\<in>I. \<integral>\<^sup>+\<omega>. X i \<omega> \<partial>M)"
     by (intro prod.cong nn_integral_cong) (auto simp: nn_integral_distr Y_def rv_X)
   finally show ?thesis .
 qed (simp add: emeasure_space_1)
 
 lemma (in prob_space)
   fixes X :: "'i \<Rightarrow> 'a \<Rightarrow> 'b::{real_normed_field, banach, second_countable_topology}"
   assumes I: "finite I" "indep_vars (\<lambda>_. borel) X I" "\<And>i. i \<in> I \<Longrightarrow> integrable M (X i)"
   shows indep_vars_lebesgue_integral: "(\<integral>\<omega>. (\<Prod>i\<in>I. X i \<omega>) \<partial>M) = (\<Prod>i\<in>I. \<integral>\<omega>. X i \<omega> \<partial>M)" (is ?eq)
     and indep_vars_integrable: "integrable M (\<lambda>\<omega>. (\<Prod>i\<in>I. X i \<omega>))" (is ?int)
 proof (induct rule: case_split)
   assume "I \<noteq> {}"
   define Y where [abs_def]: "Y i \<omega> = (if i \<in> I then X i \<omega> else 0)" for i \<omega>
   { fix i have "i \<in> I \<Longrightarrow> random_variable borel (X i)"
     using I(2) by (cases "i\<in>I") (auto simp: indep_vars_def) }
   note rv_X = this[measurable]
 
   { fix i have "random_variable borel (Y i)"
     using I(2) by (cases "i\<in>I") (auto simp: Y_def rv_X) }
   note rv_Y = this[measurable]
 
   { fix i have "integrable M (Y i)"
     using I(3) by (cases "i\<in>I") (auto simp: Y_def) }
   note int_Y = this
 
   interpret Y: prob_space "distr M borel (Y i)" for i
     using I(2) by (cases "i \<in> I") (auto intro!: prob_space_distr simp: indep_vars_def prob_space_return)
   interpret product_sigma_finite "\<lambda>i. distr M borel (Y i)"
     ..
 
   have indep_Y: "indep_vars (\<lambda>i. borel) Y I"
     by (rule indep_vars_cong[THEN iffD1, OF _ _ _ I(2)]) (auto simp: Y_def)
 
   have "(\<integral>\<omega>. (\<Prod>i\<in>I. X i \<omega>) \<partial>M) = (\<integral>\<omega>. (\<Prod>i\<in>I. Y i \<omega>) \<partial>M)"
     using I(3) by (simp add: Y_def)
   also have "\<dots> = (\<integral>\<omega>. (\<Prod>i\<in>I. \<omega> i) \<partial>distr M (Pi\<^sub>M I (\<lambda>i. borel)) (\<lambda>x. \<lambda>i\<in>I. Y i x))"
     by (subst integral_distr) auto
   also have "\<dots> = (\<integral>\<omega>. (\<Prod>i\<in>I. \<omega> i) \<partial>Pi\<^sub>M I (\<lambda>i. distr M borel (Y i)))"
     unfolding indep_vars_iff_distr_eq_PiM[THEN iffD1, OF \<open>I \<noteq> {}\<close> rv_Y indep_Y] ..
   also have "\<dots> = (\<Prod>i\<in>I. (\<integral>\<omega>. \<omega> \<partial>distr M borel (Y i)))"
     by (rule product_integral_prod) (auto intro: \<open>finite I\<close> simp: integrable_distr_eq int_Y)
   also have "\<dots> = (\<Prod>i\<in>I. \<integral>\<omega>. X i \<omega> \<partial>M)"
     by (intro prod.cong integral_cong)
        (auto simp: integral_distr Y_def rv_X)
   finally show ?eq .
 
   have "integrable (distr M (Pi\<^sub>M I (\<lambda>i. borel)) (\<lambda>x. \<lambda>i\<in>I. Y i x)) (\<lambda>\<omega>. (\<Prod>i\<in>I. \<omega> i))"
     unfolding indep_vars_iff_distr_eq_PiM[THEN iffD1, OF \<open>I \<noteq> {}\<close> rv_Y indep_Y]
     by (intro product_integrable_prod[OF \<open>finite I\<close>])
        (simp add: integrable_distr_eq int_Y)
   then show ?int
     by (simp add: integrable_distr_eq Y_def)
 qed (simp_all add: prob_space)
 
 lemma (in prob_space)
   fixes X1 X2 :: "'a \<Rightarrow> 'b::{real_normed_field, banach, second_countable_topology}"
   assumes "indep_var borel X1 borel X2" "integrable M X1" "integrable M X2"
   shows indep_var_lebesgue_integral: "(\<integral>\<omega>. X1 \<omega> * X2 \<omega> \<partial>M) = (\<integral>\<omega>. X1 \<omega> \<partial>M) * (\<integral>\<omega>. X2 \<omega> \<partial>M)" (is ?eq)
     and indep_var_integrable: "integrable M (\<lambda>\<omega>. X1 \<omega> * X2 \<omega>)" (is ?int)
 unfolding indep_var_def
 proof -
   have *: "(\<lambda>\<omega>. X1 \<omega> * X2 \<omega>) = (\<lambda>\<omega>. \<Prod>i\<in>UNIV. (case_bool X1 X2 i \<omega>))"
     by (simp add: UNIV_bool mult.commute)
   have **: "(\<lambda> _. borel) = case_bool borel borel"
     by (rule ext, metis (full_types) bool.simps(3) bool.simps(4))
   show ?eq
     apply (subst *)
     apply (subst indep_vars_lebesgue_integral)
     apply (auto)
     apply (subst **, subst indep_var_def [symmetric], rule assms)
     apply (simp split: bool.split add: assms)
     by (simp add: UNIV_bool mult.commute)
   show ?int
     apply (subst *)
     apply (rule indep_vars_integrable)
     apply auto
     apply (subst **, subst indep_var_def [symmetric], rule assms)
     by (simp split: bool.split add: assms)
 qed
 
 end
diff --git a/src/HOL/Probability/Information.thy b/src/HOL/Probability/Information.thy
--- a/src/HOL/Probability/Information.thy
+++ b/src/HOL/Probability/Information.thy
@@ -1,1968 +1,1974 @@
 (*  Title:      HOL/Probability/Information.thy
     Author:     Johannes Hölzl, TU München
     Author:     Armin Heller, TU München
 *)
 
 section \<open>Information theory\<close>
 
 theory Information
 imports
   Independent_Family
 begin
 
 lemma log_le: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> x \<le> y \<Longrightarrow> log a x \<le> log a y"
   by (subst log_le_cancel_iff) auto
 
 lemma log_less: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> x < y \<Longrightarrow> log a x < log a y"
   by (subst log_less_cancel_iff) auto
 
 lemma sum_cartesian_product':
   "(\<Sum>x\<in>A \<times> B. f x) = (\<Sum>x\<in>A. sum (\<lambda>y. f (x, y)) B)"
   unfolding sum.cartesian_product by simp
 
 lemma split_pairs:
   "((A, B) = X) \<longleftrightarrow> (fst X = A \<and> snd X = B)" and
   "(X = (A, B)) \<longleftrightarrow> (fst X = A \<and> snd X = B)" by auto
 
 subsection "Information theory"
 
 locale information_space = prob_space +
   fixes b :: real assumes b_gt_1: "1 < b"
 
 context information_space
 begin
 
 text \<open>Introduce some simplification rules for logarithm of base \<^term>\<open>b\<close>.\<close>
 
 lemma log_neg_const:
   assumes "x \<le> 0"
   shows "log b x = log b 0"
 proof -
   { fix u :: real
     have "x \<le> 0" by fact
     also have "0 < exp u"
       using exp_gt_zero .
     finally have "exp u \<noteq> x"
       by auto }
   then show "log b x = log b 0"
     by (simp add: log_def ln_real_def)
 qed
 
 lemma log_mult_eq:
   "log b (A * B) = (if 0 < A * B then log b \<bar>A\<bar> + log b \<bar>B\<bar> else log b 0)"
   using log_mult[of b "\<bar>A\<bar>" "\<bar>B\<bar>"] b_gt_1 log_neg_const[of "A * B"]
   by (auto simp: zero_less_mult_iff mult_le_0_iff)
 
 lemma log_inverse_eq:
   "log b (inverse B) = (if 0 < B then - log b B else log b 0)"
   using log_inverse[of b B] log_neg_const[of "inverse B"] b_gt_1 by simp
 
 lemma log_divide_eq:
   "log b (A / B) = (if 0 < A * B then log b \<bar>A\<bar> - log b \<bar>B\<bar> else log b 0)"
   unfolding divide_inverse log_mult_eq log_inverse_eq abs_inverse
   by (auto simp: zero_less_mult_iff mult_le_0_iff)
 
 lemmas log_simps = log_mult_eq log_inverse_eq log_divide_eq
 
 end
 
 subsection "Kullback$-$Leibler divergence"
 
 text \<open>The Kullback$-$Leibler divergence is also known as relative entropy or
 Kullback$-$Leibler distance.\<close>
 
 definition
   "entropy_density b M N = log b \<circ> enn2real \<circ> RN_deriv M N"
 
 definition
   "KL_divergence b M N = integral\<^sup>L N (entropy_density b M N)"
 
 lemma measurable_entropy_density[measurable]: "entropy_density b M N \<in> borel_measurable M"
   unfolding entropy_density_def by auto
 
 lemma (in sigma_finite_measure) KL_density:
   fixes f :: "'a \<Rightarrow> real"
   assumes "1 < b"
   assumes f[measurable]: "f \<in> borel_measurable M" and nn: "AE x in M. 0 \<le> f x"
   shows "KL_divergence b M (density M f) = (\<integral>x. f x * log b (f x) \<partial>M)"
   unfolding KL_divergence_def
 proof (subst integral_real_density)
   show [measurable]: "entropy_density b M (density M (\<lambda>x. ennreal (f x))) \<in> borel_measurable M"
     using f
     by (auto simp: comp_def entropy_density_def)
   have "density M (RN_deriv M (density M f)) = density M f"
     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 "(\<integral>x. f x * entropy_density b M (density M (\<lambda>x. ennreal (f x))) x \<partial>M) = (\<integral>x. f x * log b (f x) \<partial>M)"
     apply (intro integral_cong_AE)
     apply measurable
     using eq nn
     apply eventually_elim
     apply (auto simp: entropy_density_def)
     done
 qed fact+
 
 lemma (in sigma_finite_measure) KL_density_density:
   fixes f g :: "'a \<Rightarrow> real"
   assumes "1 < b"
   assumes f: "f \<in> borel_measurable M" "AE x in M. 0 \<le> f x"
   assumes g: "g \<in> borel_measurable M" "AE x in M. 0 \<le> g x"
   assumes ac: "AE x in M. f x = 0 \<longrightarrow> g x = 0"
   shows "KL_divergence b (density M f) (density M g) = (\<integral>x. g x * log b (g x / f x) \<partial>M)"
 proof -
   interpret Mf: sigma_finite_measure "density M f"
     using f by (subst sigma_finite_iff_density_finite) auto
   have "KL_divergence b (density M f) (density M g) =
     KL_divergence b (density M f) (density (density M f) (\<lambda>x. g x / f x))"
     using f g ac by (subst density_density_divide) simp_all
   also have "\<dots> = (\<integral>x. (g x / f x) * log b (g x / f x) \<partial>density M f)"
     using f g \<open>1 < b\<close> by (intro Mf.KL_density) (auto simp: AE_density)
   also have "\<dots> = (\<integral>x. g x * log b (g x / f x) \<partial>M)"
     using ac f g \<open>1 < b\<close> by (subst integral_density) (auto intro!: integral_cong_AE)
   finally show ?thesis .
 qed
 
 lemma (in information_space) KL_gt_0:
   fixes D :: "'a \<Rightarrow> real"
   assumes "prob_space (density M D)"
   assumes D: "D \<in> borel_measurable M" "AE x in M. 0 \<le> D x"
   assumes int: "integrable M (\<lambda>x. D x * log b (D x))"
   assumes A: "density M D \<noteq> M"
   shows "0 < KL_divergence b M (density M D)"
 proof -
   interpret N: prob_space "density M D" by fact
 
   obtain A where "A \<in> sets M" "emeasure (density M D) A \<noteq> emeasure M A"
     using measure_eqI[of "density M D" M] \<open>density M D \<noteq> M\<close> by auto
 
   let ?D_set = "{x\<in>space M. D x \<noteq> 0}"
   have [simp, intro]: "?D_set \<in> sets M"
     using D by auto
 
   have D_neg: "(\<integral>\<^sup>+ x. ennreal (- D x) \<partial>M) = 0"
     using D by (subst nn_integral_0_iff_AE) (auto simp: ennreal_neg)
 
   have "(\<integral>\<^sup>+ x. ennreal (D x) \<partial>M) = emeasure (density M D) (space M)"
     using D by (simp add: emeasure_density cong: nn_integral_cong)
   then have D_pos: "(\<integral>\<^sup>+ x. ennreal (D x) \<partial>M) = 1"
     using N.emeasure_space_1 by simp
 
   have "integrable M D"
     using D D_pos D_neg unfolding real_integrable_def real_lebesgue_integral_def by simp_all
   then have "integral\<^sup>L M D = 1"
     using D D_pos D_neg by (simp add: real_lebesgue_integral_def)
 
   have "0 \<le> 1 - measure M ?D_set"
     using prob_le_1 by (auto simp: field_simps)
   also have "\<dots> = (\<integral> x. D x - indicator ?D_set x \<partial>M)"
     using \<open>integrable M D\<close> \<open>integral\<^sup>L M D = 1\<close>
     by (simp add: emeasure_eq_measure)
   also have "\<dots> < (\<integral> x. D x * (ln b * log b (D x)) \<partial>M)"
   proof (rule integral_less_AE)
     show "integrable M (\<lambda>x. D x - indicator ?D_set x)"
       using \<open>integrable M D\<close> by (auto simp: less_top[symmetric])
   next
     from integrable_mult_left(1)[OF int, of "ln b"]
     show "integrable M (\<lambda>x. D x * (ln b * log b (D x)))"
       by (simp add: ac_simps)
   next
     show "emeasure M {x\<in>space M. D x \<noteq> 1 \<and> D x \<noteq> 0} \<noteq> 0"
     proof
       assume eq_0: "emeasure M {x\<in>space M. D x \<noteq> 1 \<and> D x \<noteq> 0} = 0"
       then have disj: "AE x in M. D x = 1 \<or> D x = 0"
         using D(1) by (auto intro!: AE_I[OF subset_refl] sets.sets_Collect)
 
       have "emeasure M {x\<in>space M. D x = 1} = (\<integral>\<^sup>+ x. indicator {x\<in>space M. D x = 1} x \<partial>M)"
         using D(1) by auto
       also have "\<dots> = (\<integral>\<^sup>+ x. ennreal (D x) \<partial>M)"
         using disj by (auto intro!: nn_integral_cong_AE simp: indicator_def one_ennreal_def)
       finally have "AE x in M. D x = 1"
         using D D_pos by (intro AE_I_eq_1) auto
       then have "(\<integral>\<^sup>+x. indicator A x\<partial>M) = (\<integral>\<^sup>+x. ennreal (D x) * indicator A x\<partial>M)"
         by (intro nn_integral_cong_AE) (auto simp: one_ennreal_def[symmetric])
       also have "\<dots> = density M D A"
         using \<open>A \<in> sets M\<close> D by (simp add: emeasure_density)
       finally show False using \<open>A \<in> sets M\<close> \<open>emeasure (density M D) A \<noteq> emeasure M A\<close> by simp
     qed
     show "{x\<in>space M. D x \<noteq> 1 \<and> D x \<noteq> 0} \<in> sets M"
       using D(1) by (auto intro: sets.sets_Collect_conj)
 
     show "AE t in M. t \<in> {x\<in>space M. D x \<noteq> 1 \<and> D x \<noteq> 0} \<longrightarrow>
       D t - indicator ?D_set t \<noteq> D t * (ln b * log b (D t))"
       using D(2)
     proof (eventually_elim, safe)
       fix t assume Dt: "t \<in> space M" "D t \<noteq> 1" "D t \<noteq> 0" "0 \<le> D t"
         and eq: "D t - indicator ?D_set t = D t * (ln b * log b (D t))"
 
       have "D t - 1 = D t - indicator ?D_set t"
         using Dt by simp
       also note eq
       also have "D t * (ln b * log b (D t)) = - D t * ln (1 / D t)"
         using b_gt_1 \<open>D t \<noteq> 0\<close> \<open>0 \<le> D t\<close>
         by (simp add: log_def ln_div less_le)
       finally have "ln (1 / D t) = 1 / D t - 1"
         using \<open>D t \<noteq> 0\<close> by (auto simp: field_simps)
       from ln_eq_minus_one[OF _ this] \<open>D t \<noteq> 0\<close> \<open>0 \<le> D t\<close> \<open>D t \<noteq> 1\<close>
       show False by auto
     qed
 
     show "AE t in M. D t - indicator ?D_set t \<le> D t * (ln b * log b (D t))"
       using D(2) AE_space
     proof eventually_elim
       fix t assume "t \<in> space M" "0 \<le> D t"
       show "D t - indicator ?D_set t \<le> D t * (ln b * log b (D t))"
       proof cases
         assume asm: "D t \<noteq> 0"
         then have "0 < D t" using \<open>0 \<le> D t\<close> by auto
         then have "0 < 1 / D t" by auto
         have "D t - indicator ?D_set t \<le> - D t * (1 / D t - 1)"
           using asm \<open>t \<in> space M\<close> by (simp add: field_simps)
         also have "- D t * (1 / D t - 1) \<le> - D t * ln (1 / D t)"
           using ln_le_minus_one \<open>0 < 1 / D t\<close> by (intro mult_left_mono_neg) auto
         also have "\<dots> = D t * (ln b * log b (D t))"
           using \<open>0 < D t\<close> b_gt_1
           by (simp_all add: log_def ln_div)
         finally show ?thesis by simp
       qed simp
     qed
   qed
   also have "\<dots> = (\<integral> x. ln b * (D x * log b (D x)) \<partial>M)"
     by (simp add: ac_simps)
   also have "\<dots> = ln b * (\<integral> x. D x * log b (D x) \<partial>M)"
     using int by simp
   finally show ?thesis
     using b_gt_1 D by (subst KL_density) (auto simp: zero_less_mult_iff)
 qed
 
 lemma (in sigma_finite_measure) KL_same_eq_0: "KL_divergence b M M = 0"
 proof -
   have "AE x in M. 1 = RN_deriv M M x"
   proof (rule RN_deriv_unique)
     show "density M (\<lambda>x. 1) = M"
       apply (auto intro!: measure_eqI emeasure_density)
       apply (subst emeasure_density)
       apply auto
       done
   qed auto
   then have "AE x in M. log b (enn2real (RN_deriv M M x)) = 0"
     by (elim AE_mp) simp
   from integral_cong_AE[OF _ _ this]
   have "integral\<^sup>L M (entropy_density b M M) = 0"
     by (simp add: entropy_density_def comp_def)
   then show "KL_divergence b M M = 0"
     unfolding KL_divergence_def
     by auto
 qed
 
 lemma (in information_space) KL_eq_0_iff_eq:
   fixes D :: "'a \<Rightarrow> real"
   assumes "prob_space (density M D)"
   assumes D: "D \<in> borel_measurable M" "AE x in M. 0 \<le> D x"
   assumes int: "integrable M (\<lambda>x. D x * log b (D x))"
   shows "KL_divergence b M (density M D) = 0 \<longleftrightarrow> density M D = M"
   using KL_same_eq_0[of b] KL_gt_0[OF assms]
   by (auto simp: less_le)
 
 lemma (in information_space) KL_eq_0_iff_eq_ac:
   fixes D :: "'a \<Rightarrow> real"
   assumes "prob_space N"
   assumes ac: "absolutely_continuous M N" "sets N = sets M"
   assumes int: "integrable N (entropy_density b M N)"
   shows "KL_divergence b M N = 0 \<longleftrightarrow> N = M"
 proof -
   interpret N: prob_space N by fact
   have "finite_measure N" by unfold_locales
-  from real_RN_deriv[OF this ac] guess D . note D = this
+  from real_RN_deriv[OF this ac] obtain D
+    where D:
+      "random_variable borel D"
+      "AE x in M. RN_deriv M N x = ennreal (D x)"
+      "AE x in N. 0 < D x"
+      "\<And>x. 0 \<le> D x"
+    by this auto
 
   have "N = density M (RN_deriv M N)"
     using ac by (rule density_RN_deriv[symmetric])
   also have "\<dots> = density M D"
     using D by (auto intro!: density_cong)
   finally have N: "N = density M D" .
 
   from absolutely_continuous_AE[OF ac(2,1) D(2)] D b_gt_1 ac measurable_entropy_density
   have "integrable N (\<lambda>x. log b (D x))"
     by (intro integrable_cong_AE[THEN iffD2, OF _ _ _ int])
        (auto simp: N entropy_density_def)
   with D b_gt_1 have "integrable M (\<lambda>x. D x * log b (D x))"
     by (subst integrable_real_density[symmetric]) (auto simp: N[symmetric] comp_def)
   with \<open>prob_space N\<close> D show ?thesis
     unfolding N
     by (intro KL_eq_0_iff_eq) auto
 qed
 
 lemma (in information_space) KL_nonneg:
   assumes "prob_space (density M D)"
   assumes D: "D \<in> borel_measurable M" "AE x in M. 0 \<le> D x"
   assumes int: "integrable M (\<lambda>x. D x * log b (D x))"
   shows "0 \<le> KL_divergence b M (density M D)"
   using KL_gt_0[OF assms] by (cases "density M D = M") (auto simp: KL_same_eq_0)
 
 lemma (in sigma_finite_measure) KL_density_density_nonneg:
   fixes f g :: "'a \<Rightarrow> real"
   assumes "1 < b"
   assumes f: "f \<in> borel_measurable M" "AE x in M. 0 \<le> f x" "prob_space (density M f)"
   assumes g: "g \<in> borel_measurable M" "AE x in M. 0 \<le> g x" "prob_space (density M g)"
   assumes ac: "AE x in M. f x = 0 \<longrightarrow> g x = 0"
   assumes int: "integrable M (\<lambda>x. g x * log b (g x / f x))"
   shows "0 \<le> KL_divergence b (density M f) (density M g)"
 proof -
   interpret Mf: prob_space "density M f" by fact
   interpret Mf: information_space "density M f" b by standard fact
   have eq: "density (density M f) (\<lambda>x. g x / f x) = density M g" (is "?DD = _")
     using f g ac by (subst density_density_divide) simp_all
 
   have "0 \<le> KL_divergence b (density M f) (density (density M f) (\<lambda>x. g x / f x))"
   proof (rule Mf.KL_nonneg)
     show "prob_space ?DD" unfolding eq by fact
     from f g show "(\<lambda>x. g x / f x) \<in> borel_measurable (density M f)"
       by auto
     show "AE x in density M f. 0 \<le> g x / f x"
       using f g by (auto simp: AE_density)
     show "integrable (density M f) (\<lambda>x. g x / f x * log b (g x / f x))"
       using \<open>1 < b\<close> f g ac
       by (subst integrable_density)
          (auto intro!: integrable_cong_AE[THEN iffD2, OF _ _ _ int] measurable_If)
   qed
   also have "\<dots> = KL_divergence b (density M f) (density M g)"
     using f g ac by (subst density_density_divide) simp_all
   finally show ?thesis .
 qed
 
 subsection \<open>Finite Entropy\<close>
 
 definition (in information_space) finite_entropy :: "'b measure \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> real) \<Rightarrow> bool"
 where
   "finite_entropy S X f \<longleftrightarrow>
     distributed M S X f \<and>
     integrable S (\<lambda>x. f x * log b (f x)) \<and>
     (\<forall>x\<in>space S. 0 \<le> f x)"
 
 lemma (in information_space) finite_entropy_simple_function:
   assumes X: "simple_function M X"
   shows "finite_entropy (count_space (X`space M)) X (\<lambda>a. measure M {x \<in> space M. X x = a})"
   unfolding finite_entropy_def
 proof safe
   have [simp]: "finite (X ` space M)"
     using X by (auto simp: simple_function_def)
   then show "integrable (count_space (X ` space M))
      (\<lambda>x. prob {xa \<in> space M. X xa = x} * log b (prob {xa \<in> space M. X xa = x}))"
     by (rule integrable_count_space)
   have d: "distributed M (count_space (X ` space M)) X (\<lambda>x. ennreal (if x \<in> X`space M then prob {xa \<in> space M. X xa = x} else 0))"
     by (rule distributed_simple_function_superset[OF X]) (auto intro!: arg_cong[where f=prob])
   show "distributed M (count_space (X ` space M)) X (\<lambda>x. ennreal (prob {xa \<in> space M. X xa = x}))"
     by (rule distributed_cong_density[THEN iffD1, OF _ _ _ d]) auto
 qed (rule measure_nonneg)
 
 lemma ac_fst:
   assumes "sigma_finite_measure T"
   shows "absolutely_continuous S (distr (S \<Otimes>\<^sub>M T) S fst)"
 proof -
   interpret sigma_finite_measure T by fact
   { fix A assume A: "A \<in> sets S" "emeasure S A = 0"
     then have "fst -` A \<inter> space (S \<Otimes>\<^sub>M T) = A \<times> space T"
       by (auto simp: space_pair_measure dest!: sets.sets_into_space)
     with A have "emeasure (S \<Otimes>\<^sub>M T) (fst -` A \<inter> space (S \<Otimes>\<^sub>M T)) = 0"
       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
 qed
 
 lemma ac_snd:
   assumes "sigma_finite_measure T"
   shows "absolutely_continuous T (distr (S \<Otimes>\<^sub>M T) T snd)"
 proof -
   interpret sigma_finite_measure T by fact
   { fix A assume A: "A \<in> sets T" "emeasure T A = 0"
     then have "snd -` A \<inter> space (S \<Otimes>\<^sub>M T) = space S \<times> A"
       by (auto simp: space_pair_measure dest!: sets.sets_into_space)
     with A have "emeasure (S \<Otimes>\<^sub>M T) (snd -` A \<inter> space (S \<Otimes>\<^sub>M T)) = 0"
       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
 qed
 
 lemma (in information_space) finite_entropy_integrable:
   "finite_entropy S X Px \<Longrightarrow> integrable S (\<lambda>x. Px x * log b (Px x))"
   unfolding finite_entropy_def by auto
 
 lemma (in information_space) finite_entropy_distributed:
   "finite_entropy S X Px \<Longrightarrow> distributed M S X Px"
   unfolding finite_entropy_def by auto
 
 lemma (in information_space) finite_entropy_nn:
   "finite_entropy S X Px \<Longrightarrow> x \<in> space S \<Longrightarrow> 0 \<le> Px x"
   by (auto simp: finite_entropy_def)
 
 lemma (in information_space) finite_entropy_measurable:
   "finite_entropy S X Px \<Longrightarrow> Px \<in> S \<rightarrow>\<^sub>M borel"
   using distributed_real_measurable[of S Px M X]
     finite_entropy_nn[of S X Px] finite_entropy_distributed[of S X Px] by auto
 
 lemma (in information_space) subdensity_finite_entropy:
   fixes g :: "'b \<Rightarrow> real" and f :: "'c \<Rightarrow> real"
   assumes T: "T \<in> measurable P Q"
   assumes f: "finite_entropy P X f"
   assumes g: "finite_entropy Q Y g"
   assumes Y: "Y = T \<circ> X"
   shows "AE x in P. g (T x) = 0 \<longrightarrow> f x = 0"
   using subdensity[OF T, of M X "\<lambda>x. ennreal (f x)" Y "\<lambda>x. ennreal (g x)"]
     finite_entropy_distributed[OF f] finite_entropy_distributed[OF g]
     finite_entropy_nn[OF f] finite_entropy_nn[OF g]
     assms
   by auto
 
 lemma (in information_space) finite_entropy_integrable_transform:
   "finite_entropy S X Px \<Longrightarrow> distributed M T Y Py \<Longrightarrow> (\<And>x. x \<in> space T \<Longrightarrow> 0 \<le> Py x) \<Longrightarrow>
     X = (\<lambda>x. f (Y x)) \<Longrightarrow> f \<in> measurable T S \<Longrightarrow> integrable T (\<lambda>x. Py x * log b (Px (f x)))"
   using distributed_transform_integrable[of M T Y Py S X Px f "\<lambda>x. log b (Px x)"]
   using distributed_real_measurable[of S Px M X]
   by (auto simp: finite_entropy_def)
 
 subsection \<open>Mutual Information\<close>
 
 definition (in prob_space)
   "mutual_information b S T X Y =
     KL_divergence b (distr M S X \<Otimes>\<^sub>M distr M T Y) (distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)))"
 
 lemma (in information_space) mutual_information_indep_vars:
   fixes S T X Y
   defines "P \<equiv> distr M S X \<Otimes>\<^sub>M distr M T Y"
   defines "Q \<equiv> distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))"
   shows "indep_var S X T Y \<longleftrightarrow>
     (random_variable S X \<and> random_variable T Y \<and>
       absolutely_continuous P Q \<and> integrable Q (entropy_density b P Q) \<and>
       mutual_information b S T X Y = 0)"
   unfolding indep_var_distribution_eq
 proof safe
   assume rv[measurable]: "random_variable S X" "random_variable T Y"
 
   interpret X: prob_space "distr M S X"
     by (rule prob_space_distr) fact
   interpret Y: prob_space "distr M T Y"
     by (rule prob_space_distr) fact
   interpret XY: pair_prob_space "distr M S X" "distr M T Y" by standard
   interpret P: information_space P b unfolding P_def by standard (rule b_gt_1)
 
   interpret Q: prob_space Q unfolding Q_def
     by (rule prob_space_distr) simp
 
   { assume "distr M S X \<Otimes>\<^sub>M distr M T Y = distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))"
     then have [simp]: "Q = P"  unfolding Q_def P_def by simp
 
     show ac: "absolutely_continuous P Q" by (simp add: absolutely_continuous_def)
     then have ed: "entropy_density b P Q \<in> borel_measurable P"
       by simp
 
     have "AE x in P. 1 = RN_deriv P Q x"
     proof (rule P.RN_deriv_unique)
       show "density P (\<lambda>x. 1) = Q"
         unfolding \<open>Q = P\<close> 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)
     then have "integrable P (entropy_density b P Q) \<longleftrightarrow> integrable Q (\<lambda>x. 0::real)"
       using ed unfolding \<open>Q = P\<close> by (intro integrable_cong_AE) auto
     then show "integrable Q (entropy_density b P Q)" by simp
 
     from ae_0 have "mutual_information b S T X Y = (\<integral>x. 0 \<partial>P)"
       unfolding mutual_information_def KL_divergence_def P_def[symmetric] Q_def[symmetric] \<open>Q = P\<close>
       by (intro integral_cong_AE) auto
     then show "mutual_information b S T X Y = 0"
       by simp }
 
   { assume ac: "absolutely_continuous P Q"
     assume int: "integrable Q (entropy_density b P Q)"
     assume I_eq_0: "mutual_information b S T X Y = 0"
 
     have eq: "Q = P"
     proof (rule P.KL_eq_0_iff_eq_ac[THEN iffD1])
       show "prob_space Q" by unfold_locales
       show "absolutely_continuous P Q" by fact
       show "integrable Q (entropy_density b P Q)" by fact
       show "sets Q = sets P" by (simp add: P_def Q_def sets_pair_measure)
       show "KL_divergence b P Q = 0"
         using I_eq_0 unfolding mutual_information_def by (simp add: P_def Q_def)
     qed
     then show "distr M S X \<Otimes>\<^sub>M distr M T Y = distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))"
       unfolding P_def Q_def .. }
 qed
 
 abbreviation (in information_space)
   mutual_information_Pow ("\<I>'(_ ; _')") where
   "\<I>(X ; Y) \<equiv> mutual_information b (count_space (X`space M)) (count_space (Y`space M)) X Y"
 
 lemma (in information_space)
   fixes Pxy :: "'b \<times> 'c \<Rightarrow> real" and Px :: "'b \<Rightarrow> real" and Py :: "'c \<Rightarrow> real"
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T"
   assumes Fx: "finite_entropy S X Px" and Fy: "finite_entropy T Y Py"
   assumes Fxy: "finite_entropy (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
   defines "f \<equiv> \<lambda>x. Pxy x * log b (Pxy x / (Px (fst x) * Py (snd x)))"
   shows mutual_information_distr': "mutual_information b S T X Y = integral\<^sup>L (S \<Otimes>\<^sub>M T) f" (is "?M = ?R")
     and mutual_information_nonneg': "0 \<le> mutual_information b S T X Y"
 proof -
   have Px: "distributed M S X Px" and Px_nn: "\<And>x. x \<in> space S \<Longrightarrow> 0 \<le> Px x"
     using Fx by (auto simp: finite_entropy_def)
   have Py: "distributed M T Y Py" and Py_nn: "\<And>x. x \<in> space T \<Longrightarrow> 0 \<le> Py x"
     using Fy by (auto simp: finite_entropy_def)
   have Pxy: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
     and Pxy_nn: "\<And>x. x \<in> space (S \<Otimes>\<^sub>M T) \<Longrightarrow> 0 \<le> Pxy x"
       "\<And>x y. x \<in> space S \<Longrightarrow> y \<in> space T \<Longrightarrow> 0 \<le> Pxy (x, y)"
     using Fxy by (auto simp: finite_entropy_def space_pair_measure)
 
   have [measurable]: "Px \<in> S \<rightarrow>\<^sub>M borel"
     using Px Px_nn by (intro distributed_real_measurable)
   have [measurable]: "Py \<in> T \<rightarrow>\<^sub>M borel"
     using Py Py_nn by (intro distributed_real_measurable)
   have measurable_Pxy[measurable]: "Pxy \<in> (S \<Otimes>\<^sub>M T) \<rightarrow>\<^sub>M borel"
     using Pxy Pxy_nn by (intro distributed_real_measurable) (auto simp: space_pair_measure)
 
   have X[measurable]: "random_variable S X"
     using Px by auto
   have Y[measurable]: "random_variable T Y"
     using Py by auto
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret ST: pair_sigma_finite S T ..
   interpret X: prob_space "distr M S X" using X by (rule prob_space_distr)
   interpret Y: prob_space "distr M T Y" using Y by (rule prob_space_distr)
   interpret XY: pair_prob_space "distr M S X" "distr M T Y" ..
   let ?P = "S \<Otimes>\<^sub>M T"
   let ?D = "distr M ?P (\<lambda>x. (X x, Y x))"
 
   { fix A assume "A \<in> sets S"
     with X[THEN measurable_space] Y[THEN measurable_space]
     have "emeasure (distr M S X) A = emeasure ?D (A \<times> space T)"
       by (auto simp: emeasure_distr intro!: arg_cong[where f="emeasure M"]) }
   note marginal_eq1 = this
   { fix A assume "A \<in> sets T"
     with X[THEN measurable_space] Y[THEN measurable_space]
     have "emeasure (distr M T Y) A = emeasure ?D (space S \<times> A)"
       by (auto simp: emeasure_distr intro!: arg_cong[where f="emeasure M"]) }
   note marginal_eq2 = this
 
   have distr_eq: "distr M S X \<Otimes>\<^sub>M distr M T Y = density ?P (\<lambda>x. ennreal (Px (fst x) * Py (snd x)))"
     unfolding Px(1)[THEN distributed_distr_eq_density] Py(1)[THEN distributed_distr_eq_density]
   proof (subst pair_measure_density)
     show "(\<lambda>x. ennreal (Px x)) \<in> borel_measurable S" "(\<lambda>y. ennreal (Py y)) \<in> borel_measurable T"
       using Px Py by (auto simp: distributed_def)
     show "sigma_finite_measure (density T Py)" unfolding Py(1)[THEN distributed_distr_eq_density, symmetric] ..
     show "density (S \<Otimes>\<^sub>M T) (\<lambda>(x, y). ennreal (Px x) * ennreal (Py y)) =
       density (S \<Otimes>\<^sub>M T) (\<lambda>x. ennreal (Px (fst x) * Py (snd x)))"
       using Px_nn Py_nn by (auto intro!: density_cong simp: distributed_def ennreal_mult space_pair_measure)
   qed fact
 
   have M: "?M = KL_divergence b (density ?P (\<lambda>x. ennreal (Px (fst x) * Py (snd x)))) (density ?P (\<lambda>x. ennreal (Pxy x)))"
     unfolding mutual_information_def distr_eq Pxy(1)[THEN distributed_distr_eq_density] ..
 
   from Px Py have f: "(\<lambda>x. Px (fst x) * Py (snd x)) \<in> borel_measurable ?P"
     by (intro borel_measurable_times) (auto intro: distributed_real_measurable measurable_fst'' measurable_snd'')
   have PxPy_nonneg: "AE x in ?P. 0 \<le> Px (fst x) * Py (snd x)"
     using Px_nn Py_nn by (auto simp: space_pair_measure)
 
   have A: "(AE x in ?P. Px (fst x) = 0 \<longrightarrow> Pxy x = 0)"
     by (rule subdensity_real[OF measurable_fst Pxy Px]) (insert Px_nn Pxy_nn, auto simp: space_pair_measure)
   moreover
   have B: "(AE x in ?P. Py (snd x) = 0 \<longrightarrow> 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 \<longrightarrow> Pxy x = 0"
     by eventually_elim auto
 
   show "?M = ?R"
     unfolding M f_def using Pxy_nn Px_nn Py_nn
     by (intro ST.KL_density_density b_gt_1 f PxPy_nonneg ac) (auto simp: space_pair_measure)
 
   have X: "X = fst \<circ> (\<lambda>x. (X x, Y x))" and Y: "Y = snd \<circ> (\<lambda>x. (X x, Y x))"
     by auto
 
   have "integrable (S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Pxy x) - Pxy x * log b (Px (fst x)) - Pxy x * log b (Py (snd x)))"
     using finite_entropy_integrable[OF Fxy]
     using finite_entropy_integrable_transform[OF Fx Pxy, of fst]
     using finite_entropy_integrable_transform[OF Fy Pxy, of snd]
     by (simp add: Pxy_nn)
   moreover have "f \<in> borel_measurable (S \<Otimes>\<^sub>M T)"
     unfolding f_def using Px Py Pxy
     by (auto intro: distributed_real_measurable measurable_fst'' measurable_snd''
       intro!: borel_measurable_times borel_measurable_log borel_measurable_divide)
   ultimately have int: "integrable (S \<Otimes>\<^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
                   less_le)
 
   show "0 \<le> ?M" unfolding M
   proof (intro ST.KL_density_density_nonneg)
     show "prob_space (density (S \<Otimes>\<^sub>M T) (\<lambda>x. ennreal (Pxy x))) "
       unfolding distributed_distr_eq_density[OF Pxy, symmetric]
       using distributed_measurable[OF Pxy] by (rule prob_space_distr)
     show "prob_space (density (S \<Otimes>\<^sub>M T) (\<lambda>x. ennreal (Px (fst x) * Py (snd x))))"
       unfolding distr_eq[symmetric] by unfold_locales
     show "integrable (S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Pxy x / (Px (fst x) * Py (snd x))))"
       using int unfolding f_def .
   qed (insert ac, auto simp: b_gt_1 Px_nn Py_nn Pxy_nn space_pair_measure)
 qed
 
 lemma (in information_space)
   fixes Pxy :: "'b \<times> 'c \<Rightarrow> real" and Px :: "'b \<Rightarrow> real" and Py :: "'c \<Rightarrow> real"
   assumes "sigma_finite_measure S" "sigma_finite_measure T"
   assumes Px: "distributed M S X Px" and Px_nn: "\<And>x. x \<in> space S \<Longrightarrow> 0 \<le> Px x"
     and Py: "distributed M T Y Py" and Py_nn: "\<And>y. y \<in> space T \<Longrightarrow> 0 \<le> Py y"
     and Pxy: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
     and Pxy_nn: "\<And>x y. x \<in> space S \<Longrightarrow> y \<in> space T \<Longrightarrow> 0 \<le> Pxy (x, y)"
   defines "f \<equiv> \<lambda>x. Pxy x * log b (Pxy x / (Px (fst x) * Py (snd x)))"
   shows mutual_information_distr: "mutual_information b S T X Y = integral\<^sup>L (S \<Otimes>\<^sub>M T) f" (is "?M = ?R")
     and mutual_information_nonneg: "integrable (S \<Otimes>\<^sub>M T) f \<Longrightarrow> 0 \<le> mutual_information b S T X Y"
 proof -
   have X[measurable]: "random_variable S X"
     using Px by (auto simp: distributed_def)
   have Y[measurable]: "random_variable T Y"
     using Py by (auto simp: distributed_def)
   have [measurable]: "Px \<in> S \<rightarrow>\<^sub>M borel"
     using Px Px_nn by (intro distributed_real_measurable)
   have [measurable]: "Py \<in> T \<rightarrow>\<^sub>M borel"
     using Py Py_nn by (intro distributed_real_measurable)
   have measurable_Pxy[measurable]: "Pxy \<in> (S \<Otimes>\<^sub>M T) \<rightarrow>\<^sub>M borel"
     using Pxy Pxy_nn by (intro distributed_real_measurable) (auto simp: space_pair_measure)
 
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret ST: pair_sigma_finite S T ..
   interpret X: prob_space "distr M S X" using X by (rule prob_space_distr)
   interpret Y: prob_space "distr M T Y" using Y by (rule prob_space_distr)
   interpret XY: pair_prob_space "distr M S X" "distr M T Y" ..
   let ?P = "S \<Otimes>\<^sub>M T"
   let ?D = "distr M ?P (\<lambda>x. (X x, Y x))"
 
   { fix A assume "A \<in> sets S"
     with X[THEN measurable_space] Y[THEN measurable_space]
     have "emeasure (distr M S X) A = emeasure ?D (A \<times> space T)"
       by (auto simp: emeasure_distr intro!: arg_cong[where f="emeasure M"]) }
   note marginal_eq1 = this
   { fix A assume "A \<in> sets T"
     with X[THEN measurable_space] Y[THEN measurable_space]
     have "emeasure (distr M T Y) A = emeasure ?D (space S \<times> A)"
       by (auto simp: emeasure_distr intro!: arg_cong[where f="emeasure M"]) }
   note marginal_eq2 = this
 
   have distr_eq: "distr M S X \<Otimes>\<^sub>M distr M T Y = density ?P (\<lambda>x. ennreal (Px (fst x) * Py (snd x)))"
     unfolding Px(1)[THEN distributed_distr_eq_density] Py(1)[THEN distributed_distr_eq_density]
   proof (subst pair_measure_density)
     show "(\<lambda>x. ennreal (Px x)) \<in> borel_measurable S" "(\<lambda>y. ennreal (Py y)) \<in> borel_measurable T"
       using Px Py by (auto simp: distributed_def)
     show "sigma_finite_measure (density T Py)" unfolding Py(1)[THEN distributed_distr_eq_density, symmetric] ..
     show "density (S \<Otimes>\<^sub>M T) (\<lambda>(x, y). ennreal (Px x) * ennreal (Py y)) =
       density (S \<Otimes>\<^sub>M T) (\<lambda>x. ennreal (Px (fst x) * Py (snd x)))"
       using Px_nn Py_nn by (auto intro!: density_cong simp: distributed_def ennreal_mult space_pair_measure)
   qed fact
 
   have M: "?M = KL_divergence b (density ?P (\<lambda>x. ennreal (Px (fst x) * Py (snd x)))) (density ?P (\<lambda>x. ennreal (Pxy x)))"
     unfolding mutual_information_def distr_eq Pxy(1)[THEN distributed_distr_eq_density] ..
 
   from Px Py have f: "(\<lambda>x. Px (fst x) * Py (snd x)) \<in> borel_measurable ?P"
     by (intro borel_measurable_times) (auto intro: distributed_real_measurable measurable_fst'' measurable_snd'')
   have PxPy_nonneg: "AE x in ?P. 0 \<le> Px (fst x) * Py (snd x)"
     using Px_nn Py_nn by (auto simp: space_pair_measure)
 
   have "(AE x in ?P. Px (fst x) = 0 \<longrightarrow> Pxy x = 0)"
     by (rule subdensity_real[OF measurable_fst Pxy Px]) (insert Px_nn Pxy_nn, auto simp: space_pair_measure)
   moreover
   have "(AE x in ?P. Py (snd x) = 0 \<longrightarrow> 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 \<longrightarrow> Pxy x = 0"
     by eventually_elim auto
 
   show "?M = ?R"
     unfolding M f_def
     using b_gt_1 f PxPy_nonneg ac Pxy_nn
     by (intro ST.KL_density_density) (auto simp: space_pair_measure)
 
   assume int: "integrable (S \<Otimes>\<^sub>M T) f"
   show "0 \<le> ?M" unfolding M
   proof (intro ST.KL_density_density_nonneg)
     show "prob_space (density (S \<Otimes>\<^sub>M T) (\<lambda>x. ennreal (Pxy x))) "
       unfolding distributed_distr_eq_density[OF Pxy, symmetric]
       using distributed_measurable[OF Pxy] by (rule prob_space_distr)
     show "prob_space (density (S \<Otimes>\<^sub>M T) (\<lambda>x. ennreal (Px (fst x) * Py (snd x))))"
       unfolding distr_eq[symmetric] by unfold_locales
     show "integrable (S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Pxy x / (Px (fst x) * Py (snd x))))"
       using int unfolding f_def .
   qed (insert ac, auto simp: b_gt_1 Px_nn Py_nn Pxy_nn space_pair_measure)
 qed
 
 lemma (in information_space)
   fixes Pxy :: "'b \<times> 'c \<Rightarrow> real" and Px :: "'b \<Rightarrow> real" and Py :: "'c \<Rightarrow> real"
   assumes "sigma_finite_measure S" "sigma_finite_measure T"
   assumes Px[measurable]: "distributed M S X Px" and Px_nn: "\<And>x. x \<in> space S \<Longrightarrow> 0 \<le> Px x"
     and Py[measurable]: "distributed M T Y Py" and Py_nn:  "\<And>x. x \<in> space T \<Longrightarrow> 0 \<le> Py x"
     and Pxy[measurable]: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
     and Pxy_nn: "\<And>x. x \<in> space (S \<Otimes>\<^sub>M T) \<Longrightarrow> 0 \<le> Pxy x"
   assumes ae: "AE x in S. AE y in T. Pxy (x, y) = Px x * Py y"
   shows mutual_information_eq_0: "mutual_information b S T X Y = 0"
 proof -
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret ST: pair_sigma_finite S T ..
   note
     distributed_real_measurable[OF Px_nn Px, measurable]
     distributed_real_measurable[OF Py_nn Py, measurable]
     distributed_real_measurable[OF Pxy_nn Pxy, measurable]
 
   have "AE x in S \<Otimes>\<^sub>M T. Px (fst x) = 0 \<longrightarrow> Pxy x = 0"
     by (rule subdensity_real[OF measurable_fst Pxy Px]) (auto simp: Px_nn Pxy_nn space_pair_measure)
   moreover
   have "AE x in S \<Otimes>\<^sub>M T. Py (snd x) = 0 \<longrightarrow> Pxy x = 0"
     by (rule subdensity_real[OF measurable_snd Pxy Py]) (auto simp: Py_nn Pxy_nn space_pair_measure)
   moreover
   have "AE x in S \<Otimes>\<^sub>M T. Pxy x = Px (fst x) * Py (snd x)"
     by (intro ST.AE_pair_measure) (auto simp: ae intro!: measurable_snd'' measurable_fst'')
   ultimately have "AE x in S \<Otimes>\<^sub>M T. Pxy x * log b (Pxy x / (Px (fst x) * Py (snd x))) = 0"
     by eventually_elim simp
   then have "(\<integral>x. Pxy x * log b (Pxy x / (Px (fst x) * Py (snd x))) \<partial>(S \<Otimes>\<^sub>M T)) = (\<integral>x. 0 \<partial>(S \<Otimes>\<^sub>M T))"
     by (intro integral_cong_AE) auto
   then show ?thesis
     by (subst mutual_information_distr[OF assms(1-8)]) (auto simp add: space_pair_measure)
 qed
 
 lemma (in information_space) mutual_information_simple_distributed:
   assumes X: "simple_distributed M X Px" and Y: "simple_distributed M Y Py"
   assumes XY: "simple_distributed M (\<lambda>x. (X x, Y x)) Pxy"
   shows "\<I>(X ; Y) = (\<Sum>(x, y)\<in>(\<lambda>x. (X x, Y x))`space M. Pxy (x, y) * log b (Pxy (x, y) / (Px x * Py y)))"
 proof (subst mutual_information_distr[OF _ _ simple_distributed[OF X] _ simple_distributed[OF Y] _ simple_distributed_joint[OF XY]])
   note fin = simple_distributed_joint_finite[OF XY, simp]
   show "sigma_finite_measure (count_space (X ` space M))"
     by (simp add: sigma_finite_measure_count_space_finite)
   show "sigma_finite_measure (count_space (Y ` space M))"
     by (simp add: sigma_finite_measure_count_space_finite)
   let ?Pxy = "\<lambda>x. (if x \<in> (\<lambda>x. (X x, Y x)) ` space M then Pxy x else 0)"
   let ?f = "\<lambda>x. ?Pxy x * log b (?Pxy x / (Px (fst x) * Py (snd x)))"
   have "\<And>x. ?f x = (if x \<in> (\<lambda>x. (X x, Y x)) ` space M then Pxy x * log b (Pxy x / (Px (fst x) * Py (snd x))) else 0)"
     by auto
   with fin show "(\<integral> x. ?f x \<partial>(count_space (X ` space M) \<Otimes>\<^sub>M count_space (Y ` space M))) =
     (\<Sum>(x, y)\<in>(\<lambda>x. (X x, Y x)) ` space M. Pxy (x, y) * log b (Pxy (x, y) / (Px x * Py y)))"
     by (auto simp add: pair_measure_count_space lebesgue_integral_count_space_finite sum.If_cases split_beta'
              intro!: sum.cong)
 qed (insert X Y XY, auto simp: simple_distributed_def)
 
 lemma (in information_space)
   fixes Pxy :: "'b \<times> 'c \<Rightarrow> real" and Px :: "'b \<Rightarrow> real" and Py :: "'c \<Rightarrow> real"
   assumes Px: "simple_distributed M X Px" and Py: "simple_distributed M Y Py"
   assumes Pxy: "simple_distributed M (\<lambda>x. (X x, Y x)) Pxy"
   assumes ae: "\<forall>x\<in>space M. Pxy (X x, Y x) = Px (X x) * Py (Y x)"
   shows mutual_information_eq_0_simple: "\<I>(X ; Y) = 0"
 proof (subst mutual_information_simple_distributed[OF Px Py Pxy])
   have "(\<Sum>(x, y)\<in>(\<lambda>x. (X x, Y x)) ` space M. Pxy (x, y) * log b (Pxy (x, y) / (Px x * Py y))) =
     (\<Sum>(x, y)\<in>(\<lambda>x. (X x, Y x)) ` space M. 0)"
     by (intro sum.cong) (auto simp: ae)
   then show "(\<Sum>(x, y)\<in>(\<lambda>x. (X x, Y x)) ` space M.
     Pxy (x, y) * log b (Pxy (x, y) / (Px x * Py y))) = 0" by simp
 qed
 
 subsection \<open>Entropy\<close>
 
 definition (in prob_space) entropy :: "real \<Rightarrow> 'b measure \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> real" where
   "entropy b S X = - KL_divergence b S (distr M S X)"
 
 abbreviation (in information_space)
   entropy_Pow ("\<H>'(_')") where
   "\<H>(X) \<equiv> entropy b (count_space (X`space M)) X"
 
 lemma (in prob_space) distributed_RN_deriv:
   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
 qed
 
 lemma (in information_space)
   fixes X :: "'a \<Rightarrow> 'b"
   assumes X[measurable]: "distributed M MX X f" and nn: "\<And>x. x \<in> space MX \<Longrightarrow> 0 \<le> f x"
   shows entropy_distr: "entropy b MX X = - (\<integral>x. f x * log b (f x) \<partial>MX)" (is ?eq)
 proof -
   note D = distributed_measurable[OF X] distributed_borel_measurable[OF X]
   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)"
     unfolding distributed_distr_eq_density[OF X]
     apply (subst AE_density)
     using D apply simp
     using ae apply eventually_elim
     apply auto
     done
 
   have int_eq: "(\<integral> x. f x * log b (f x) \<partial>MX) = (\<integral> x. log b (f x) \<partial>distr M MX X)"
     unfolding distributed_distr_eq_density[OF X]
     using D
     by (subst integral_density) (auto simp: nn)
 
   show ?eq
     unfolding entropy_def KL_divergence_def entropy_density_def comp_def int_eq neg_equal_iff_equal
     using ae_eq by (intro integral_cong_AE) (auto simp: nn)
 qed
 
 lemma (in information_space) entropy_le:
   fixes Px :: "'b \<Rightarrow> real" and MX :: "'b measure"
   assumes X[measurable]: "distributed M MX X Px" and Px_nn[simp]: "\<And>x. x \<in> space MX \<Longrightarrow> 0 \<le> Px x"
   and fin: "emeasure MX {x \<in> space MX. Px x \<noteq> 0} \<noteq> top"
   and int: "integrable MX (\<lambda>x. - Px x * log b (Px x))"
   shows "entropy b MX X \<le> log b (measure MX {x \<in> space MX. Px x \<noteq> 0})"
 proof -
   note Px = distributed_borel_measurable[OF X]
   interpret X: prob_space "distr M MX X"
     using distributed_measurable[OF X] by (rule prob_space_distr)
 
   have " - log b (measure MX {x \<in> space MX. Px x \<noteq> 0}) =
     - log b (\<integral> x. indicator {x \<in> space MX. Px x \<noteq> 0} x \<partial>MX)"
     using Px Px_nn fin by (auto simp: measure_def)
   also have "- log b (\<integral> x. indicator {x \<in> space MX. Px x \<noteq> 0} x \<partial>MX) = - log b (\<integral> x. 1 / Px x \<partial>distr M MX X)"
   proof -
     have "integral\<^sup>L MX (indicator {x \<in> space MX. Px x \<noteq> 0}) = LINT x|MX. Px x *\<^sub>R (1 / Px x)"
       by (rule Bochner_Integration.integral_cong) auto
     also have "... = LINT x|density MX (\<lambda>x. ennreal (Px x)). 1 / Px x"
       by (rule integral_density [symmetric]) (use Px Px_nn in auto)
     finally show ?thesis
       unfolding distributed_distr_eq_density[OF X] by simp
   qed
   also have "\<dots> \<le> (\<integral> x. - log b (1 / Px x) \<partial>distr M MX X)"
   proof (rule X.jensens_inequality[of "\<lambda>x. 1 / Px x" "{0<..}" 0 1 "\<lambda>x. - log b x"])
     show "AE x in distr M MX X. 1 / Px x \<in> {0<..}"
       unfolding distributed_distr_eq_density[OF X]
       using Px by (auto simp: AE_density)
     have [simp]: "\<And>x. x \<in> space MX \<Longrightarrow> ennreal (if Px x = 0 then 0 else 1) = indicator {x \<in> space MX. Px x \<noteq> 0} x"
       by (auto simp: one_ennreal_def)
     have "(\<integral>\<^sup>+ x. ennreal (- (if Px x = 0 then 0 else 1)) \<partial>MX) = (\<integral>\<^sup>+ x. 0 \<partial>MX)"
       by (intro nn_integral_cong) (auto simp: ennreal_neg)
     then show "integrable (distr M MX X) (\<lambda>x. 1 / Px x)"
       unfolding distributed_distr_eq_density[OF X] using Px
       by (auto simp: nn_integral_density real_integrable_def fin ennreal_neg ennreal_mult[symmetric]
               cong: nn_integral_cong)
     have "integrable MX (\<lambda>x. Px x * log b (1 / Px x)) =
       integrable MX (\<lambda>x. - Px x * log b (Px x))"
       using Px
       by (intro integrable_cong_AE) (auto simp: log_divide_eq less_le)
     then show "integrable (distr M MX X) (\<lambda>x. - log b (1 / Px x))"
       unfolding distributed_distr_eq_density[OF X]
       using Px int
       by (subst integrable_real_density) auto
   qed (auto simp: minus_log_convex[OF b_gt_1])
   also have "\<dots> = (\<integral> x. log b (Px x) \<partial>distr M MX X)"
     unfolding distributed_distr_eq_density[OF X] using Px
     by (intro integral_cong_AE) (auto simp: AE_density log_divide_eq)
   also have "\<dots> = - entropy b MX X"
     unfolding distributed_distr_eq_density[OF X] using Px
     by (subst entropy_distr[OF X]) (auto simp: integral_density)
   finally show ?thesis
     by simp
 qed
 
 lemma (in information_space) entropy_le_space:
   fixes Px :: "'b \<Rightarrow> real" and MX :: "'b measure"
   assumes X: "distributed M MX X Px" and Px_nn[simp]: "\<And>x. x \<in> space MX \<Longrightarrow> 0 \<le> Px x"
   and fin: "finite_measure MX"
   and int: "integrable MX (\<lambda>x. - Px x * log b (Px x))"
   shows "entropy b MX X \<le> log b (measure MX (space MX))"
 proof -
   note Px = distributed_borel_measurable[OF X]
   interpret finite_measure MX by fact
   have "entropy b MX X \<le> log b (measure MX {x \<in> space MX. Px x \<noteq> 0})"
     using int X by (intro entropy_le) auto
   also have "\<dots> \<le> log b (measure MX (space MX))"
     using Px distributed_imp_emeasure_nonzero[OF X]
     by (intro log_le)
        (auto intro!: finite_measure_mono b_gt_1 less_le[THEN iffD2]
              simp: emeasure_eq_measure cong: conj_cong)
   finally show ?thesis .
 qed
 
 lemma (in information_space) entropy_uniform:
   assumes X: "distributed M MX X (\<lambda>x. indicator A x / measure MX A)" (is "distributed _ _ _ ?f")
   shows "entropy b MX X = log b (measure MX A)"
 proof (subst entropy_distr[OF X])
   have [simp]: "emeasure MX A \<noteq> \<infinity>"
     using uniform_distributed_params[OF X] by (auto simp add: measure_def)
   have eq: "(\<integral> x. indicator A x / measure MX A * log b (indicator A x / measure MX A) \<partial>MX) =
     (\<integral> x. (- log b (measure MX A) / measure MX A) * indicator A x \<partial>MX)"
     using uniform_distributed_params[OF X]
     by (intro Bochner_Integration.integral_cong) (auto split: split_indicator simp: log_divide_eq zero_less_measure_iff)
   show "- (\<integral> x. indicator A x / measure MX A * log b (indicator A x / measure MX A) \<partial>MX) =
     log b (measure MX A)"
     unfolding eq using uniform_distributed_params[OF X]
     by (subst Bochner_Integration.integral_mult_right) (auto simp: measure_def less_top[symmetric] intro!: integrable_real_indicator)
 qed simp
 
 lemma (in information_space) entropy_simple_distributed:
   "simple_distributed M X f \<Longrightarrow> \<H>(X) = - (\<Sum>x\<in>X`space M. f x * log b (f x))"
   by (subst entropy_distr[OF simple_distributed])
      (auto simp add: lebesgue_integral_count_space_finite)
 
 lemma (in information_space) entropy_le_card_not_0:
   assumes X: "simple_distributed M X f"
   shows "\<H>(X) \<le> log b (card (X ` space M \<inter> {x. f x \<noteq> 0}))"
 proof -
   let ?X = "count_space (X`space M)"
   have "\<H>(X) \<le> log b (measure ?X {x \<in> space ?X. f x \<noteq> 0})"
     by (rule entropy_le[OF simple_distributed[OF X]])
        (insert X, auto simp: simple_distributed_finite[OF X] subset_eq integrable_count_space emeasure_count_space)
   also have "measure ?X {x \<in> space ?X. f x \<noteq> 0} = card (X ` space M \<inter> {x. f x \<noteq> 0})"
     by (simp_all add: simple_distributed_finite[OF X] subset_eq emeasure_count_space measure_def Int_def)
   finally show ?thesis .
 qed
 
 lemma (in information_space) entropy_le_card:
   assumes X: "simple_distributed M X f"
   shows "\<H>(X) \<le> log b (real (card (X ` space M)))"
 proof -
   let ?X = "count_space (X`space M)"
   have "\<H>(X) \<le> log b (measure ?X (space ?X))"
     by (rule entropy_le_space[OF simple_distributed[OF X]])
        (insert X, auto simp: simple_distributed_finite[OF X] subset_eq integrable_count_space emeasure_count_space finite_measure_count_space)
   also have "measure ?X (space ?X) = card (X ` space M)"
     by (simp_all add: simple_distributed_finite[OF X] subset_eq emeasure_count_space measure_def)
   finally show ?thesis .
 qed
 
 subsection \<open>Conditional Mutual Information\<close>
 
 definition (in prob_space)
   "conditional_mutual_information b MX MY MZ X Y Z \<equiv>
     mutual_information b MX (MY \<Otimes>\<^sub>M MZ) X (\<lambda>x. (Y x, Z x)) -
     mutual_information b MX MZ X Z"
 
 abbreviation (in information_space)
   conditional_mutual_information_Pow ("\<I>'( _ ; _ | _ ')") where
   "\<I>(X ; Y | Z) \<equiv> conditional_mutual_information b
     (count_space (X ` space M)) (count_space (Y ` space M)) (count_space (Z ` space M)) X Y Z"
 
 lemma (in information_space)
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T" and P: "sigma_finite_measure P"
   assumes Px[measurable]: "distributed M S X Px"
     and Px_nn[simp]: "\<And>x. x \<in> space S \<Longrightarrow> 0 \<le> Px x"
   assumes Pz[measurable]: "distributed M P Z Pz"
     and Pz_nn[simp]: "\<And>z. z \<in> space P \<Longrightarrow> 0 \<le> Pz z"
   assumes Pyz[measurable]: "distributed M (T \<Otimes>\<^sub>M P) (\<lambda>x. (Y x, Z x)) Pyz"
     and Pyz_nn[simp]: "\<And>y z. y \<in> space T \<Longrightarrow> z \<in> space P \<Longrightarrow> 0 \<le> Pyz (y, z)"
   assumes Pxz[measurable]: "distributed M (S \<Otimes>\<^sub>M P) (\<lambda>x. (X x, Z x)) Pxz"
     and Pxz_nn[simp]: "\<And>x z. x \<in> space S \<Longrightarrow> z \<in> space P \<Longrightarrow> 0 \<le> Pxz (x, z)"
   assumes Pxyz[measurable]: "distributed M (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) (\<lambda>x. (X x, Y x, Z x)) Pxyz"
     and Pxyz_nn[simp]: "\<And>x y z. x \<in> space S \<Longrightarrow> y \<in> space T \<Longrightarrow> z \<in> space P \<Longrightarrow> 0 \<le> Pxyz (x, y, z)"
   assumes I1: "integrable (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) (\<lambda>(x, y, z). Pxyz (x, y, z) * log b (Pxyz (x, y, z) / (Px x * Pyz (y, z))))"
   assumes I2: "integrable (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) (\<lambda>(x, y, z). Pxyz (x, y, z) * log b (Pxz (x, z) / (Px x * Pz z)))"
   shows conditional_mutual_information_generic_eq: "conditional_mutual_information b S T P X Y Z
     = (\<integral>(x, y, z). Pxyz (x, y, z) * log b (Pxyz (x, y, z) / (Pxz (x, z) * (Pyz (y,z) / Pz z))) \<partial>(S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P))" (is "?eq")
     and conditional_mutual_information_generic_nonneg: "0 \<le> conditional_mutual_information b S T P X Y Z" (is "?nonneg")
 proof -
   have [measurable]: "Px \<in> S \<rightarrow>\<^sub>M borel"
     using Px Px_nn by (intro distributed_real_measurable)
   have [measurable]: "Pz \<in> P \<rightarrow>\<^sub>M borel"
     using Pz Pz_nn by (intro distributed_real_measurable)
   have measurable_Pyz[measurable]: "Pyz \<in> (T \<Otimes>\<^sub>M P) \<rightarrow>\<^sub>M borel"
     using Pyz Pyz_nn by (intro distributed_real_measurable) (auto simp: space_pair_measure)
   have measurable_Pxz[measurable]: "Pxz \<in> (S \<Otimes>\<^sub>M P) \<rightarrow>\<^sub>M borel"
     using Pxz Pxz_nn by (intro distributed_real_measurable) (auto simp: space_pair_measure)
   have measurable_Pxyz[measurable]: "Pxyz \<in> (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) \<rightarrow>\<^sub>M borel"
     using Pxyz Pxyz_nn by (intro distributed_real_measurable) (auto simp: space_pair_measure)
 
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret P: sigma_finite_measure P by fact
   interpret TP: pair_sigma_finite T P ..
   interpret SP: pair_sigma_finite S P ..
   interpret ST: pair_sigma_finite S T ..
   interpret SPT: pair_sigma_finite "S \<Otimes>\<^sub>M P" T ..
   interpret STP: pair_sigma_finite S "T \<Otimes>\<^sub>M P" ..
   interpret TPS: pair_sigma_finite "T \<Otimes>\<^sub>M P" S ..
   have TP: "sigma_finite_measure (T \<Otimes>\<^sub>M P)" ..
   have SP: "sigma_finite_measure (S \<Otimes>\<^sub>M P)" ..
   have YZ: "random_variable (T \<Otimes>\<^sub>M P) (\<lambda>x. (Y x, Z x))"
     using Pyz by (simp add: distributed_measurable)
 
   from Pxz Pxyz have distr_eq: "distr M (S \<Otimes>\<^sub>M P) (\<lambda>x. (X x, Z x)) =
     distr (distr M (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) (\<lambda>x. (X x, Y x, Z x))) (S \<Otimes>\<^sub>M P) (\<lambda>(x, y, z). (x, z))"
     by (simp add: comp_def distr_distr)
 
   have "mutual_information b S P X Z =
     (\<integral>x. Pxz x * log b (Pxz x / (Px (fst x) * Pz (snd x))) \<partial>(S \<Otimes>\<^sub>M P))"
     by (rule mutual_information_distr[OF S P Px Px_nn Pz Pz_nn Pxz Pxz_nn])
   also have "\<dots> = (\<integral>(x,y,z). Pxyz (x,y,z) * log b (Pxz (x,z) / (Px x * Pz z)) \<partial>(S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P))"
     using b_gt_1 Pxz Px Pz
     by (subst distributed_transform_integral[OF Pxyz _ Pxz _, where T="\<lambda>(x, y, z). (x, z)"])
        (auto simp: split_beta' space_pair_measure)
   finally have mi_eq:
     "mutual_information b S P X Z = (\<integral>(x,y,z). Pxyz (x,y,z) * log b (Pxz (x,z) / (Px x * Pz z)) \<partial>(S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P))" .
 
   have ae1: "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P. Px (fst x) = 0 \<longrightarrow> Pxyz x = 0"
     by (intro subdensity_real[of fst, OF _ Pxyz Px]) (auto simp: space_pair_measure)
   moreover have ae2: "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P. Pz (snd (snd x)) = 0 \<longrightarrow> Pxyz x = 0"
     by (intro subdensity_real[of "\<lambda>x. snd (snd x)", OF _ Pxyz Pz]) (auto simp: space_pair_measure)
   moreover have ae3: "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P. Pxz (fst x, snd (snd x)) = 0 \<longrightarrow> Pxyz x = 0"
     by (intro subdensity_real[of "\<lambda>x. (fst x, snd (snd x))", OF _ Pxyz Pxz]) (auto simp: space_pair_measure)
   moreover have ae4: "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P. Pyz (snd x) = 0 \<longrightarrow> Pxyz x = 0"
     by (intro subdensity_real[of snd, OF _ Pxyz Pyz]) (auto simp: space_pair_measure)
   ultimately have ae: "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P.
     Pxyz x * log b (Pxyz x / (Px (fst x) * Pyz (snd x))) -
     Pxyz x * log b (Pxz (fst x, snd (snd x)) / (Px (fst x) * Pz (snd (snd x)))) =
     Pxyz x * log b (Pxyz x * Pz (snd (snd x)) / (Pxz (fst x, snd (snd x)) * Pyz (snd x))) "
     using AE_space
   proof eventually_elim
     case (elim x)
     show ?case
     proof cases
       assume "Pxyz x \<noteq> 0"
       with elim have "0 < Px (fst x)" "0 < Pz (snd (snd x))" "0 < Pxz (fst x, snd (snd x))"
         "0 < Pyz (snd x)" "0 < Pxyz x"
         by (auto simp: space_pair_measure less_le)
       then show ?thesis
         using b_gt_1 by (simp add: log_simps less_imp_le field_simps)
     qed simp
   qed
   with 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 _ Pxyz])
     apply (auto simp: 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)
     done
 
   let ?P = "density (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) Pxyz"
   interpret P: prob_space ?P
     unfolding distributed_distr_eq_density[OF Pxyz, symmetric]
     by (rule prob_space_distr) simp
 
   let ?Q = "density (T \<Otimes>\<^sub>M P) Pyz"
   interpret Q: prob_space ?Q
     unfolding distributed_distr_eq_density[OF Pyz, symmetric]
     by (rule prob_space_distr) simp
 
   let ?f = "\<lambda>(x, y, z). Pxz (x, z) * (Pyz (y, z) / Pz z) / Pxyz (x, y, z)"
 
   from subdensity_real[of snd, OF _ Pyz Pz _ AE_I2 AE_I2]
   have aeX1: "AE x in T \<Otimes>\<^sub>M P. Pz (snd x) = 0 \<longrightarrow> Pyz x = 0"
     by (auto simp: comp_def space_pair_measure)
   have aeX2: "AE x in T \<Otimes>\<^sub>M P. 0 \<le> Pz (snd x)"
     using Pz by (intro TP.AE_pair_measure) (auto simp: comp_def)
 
   have aeX3: "AE y in T \<Otimes>\<^sub>M P. (\<integral>\<^sup>+ x. ennreal (Pxz (x, snd y)) \<partial>S) = ennreal (Pz (snd y))"
     using Pz distributed_marginal_eq_joint2[OF P S Pz Pxz]
     by (intro TP.AE_pair_measure) auto
 
   have "(\<integral>\<^sup>+ x. ?f x \<partial>?P) \<le> (\<integral>\<^sup>+ (x, y, z). Pxz (x, z) * (Pyz (y, z) / Pz z) \<partial>(S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P))"
     by (subst nn_integral_density)
        (auto intro!: nn_integral_mono simp: space_pair_measure ennreal_mult[symmetric])
   also have "\<dots> = (\<integral>\<^sup>+(y, z). (\<integral>\<^sup>+ x. ennreal (Pxz (x, z)) * ennreal (Pyz (y, z) / Pz z) \<partial>S) \<partial>(T \<Otimes>\<^sub>M P))"
     by (subst STP.nn_integral_snd[symmetric])
        (auto simp add: split_beta' ennreal_mult[symmetric] space_pair_measure intro!: nn_integral_cong)
   also have "\<dots> = (\<integral>\<^sup>+x. ennreal (Pyz x) * 1 \<partial>T \<Otimes>\<^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 \<longrightarrow> Pyz (a, b) = 0" "a \<in> space T \<and> b \<in> space P"
       "(\<integral>\<^sup>+ x. ennreal (Pxz (x, b)) \<partial>S) = ennreal (Pz b)"
     then show "(\<integral>\<^sup>+ x. ennreal (Pxz (x, b)) * ennreal (Pyz (a, b) / Pz b) \<partial>S) = ennreal (Pyz (a, b))"
       by (subst nn_integral_multc) (auto split: prod.split simp: ennreal_mult[symmetric])
   qed
   also have "\<dots> = 1"
     using Q.emeasure_space_1 distributed_distr_eq_density[OF Pyz]
     by (subst nn_integral_density[symmetric]) auto
   finally have le1: "(\<integral>\<^sup>+ x. ?f x \<partial>?P) \<le> 1" .
   also have "\<dots> < \<infinity>" by simp
   finally have fin: "(\<integral>\<^sup>+ x. ?f x \<partial>?P) \<noteq> \<infinity>" by simp
 
   have pos: "(\<integral>\<^sup>+x. ?f x \<partial>?P) \<noteq> 0"
     apply (subst nn_integral_density)
     apply (simp_all add: split_beta')
   proof
     let ?g = "\<lambda>x. ennreal (Pxyz x) * (Pxz (fst x, snd (snd x)) * Pyz (snd x) / (Pz (snd (snd x)) * Pxyz x))"
     assume "(\<integral>\<^sup>+x. ?g x \<partial>(S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P)) = 0"
     then have "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P. ?g x = 0"
       by (intro nn_integral_0_iff_AE[THEN iffD1]) auto
     then have "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^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)
     then have "(\<integral>\<^sup>+ x. ennreal (Pxyz x) \<partial>S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) = 0"
       by (subst nn_integral_cong_AE[of _ "\<lambda>x. 0"]) auto
     with P.emeasure_space_1 show False
       by (subst (asm) emeasure_density) (auto cong: nn_integral_cong)
   qed
 
   have neg: "(\<integral>\<^sup>+ x. - ?f x \<partial>?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
 
   have I3: "integrable (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) (\<lambda>(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
 
   have "- log b 1 \<le> - 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 "(\<integral>\<^sup>+ x. - ?f x \<partial>?P) \<noteq> \<infinity>"
         by simp
       from fin show "(\<integral>\<^sup>+ x. ?f x \<partial>?P) \<noteq> \<infinity>"
         by simp
     qed simp
     then have "(\<integral>\<^sup>+ x. ?f x \<partial>?P) = (\<integral>x. ?f x \<partial>?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
     show "0 < (\<integral>x. ?f x \<partial>?P)" "(\<integral>x. ?f x \<partial>?P) \<le> 1"
       by (simp_all add: one_ennreal.rep_eq zero_less_iff_neq_zero[symmetric])
   qed
   also have "- log b (integral\<^sup>L ?P ?f) \<le> (\<integral> x. - log b (?f x) \<partial>?P)"
   proof (rule P.jensens_inequality[where a=0 and b=1 and I="{0<..}"])
     show "AE x in ?P. ?f x \<in> {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)
     show "integrable ?P ?f"
       unfolding real_integrable_def
       using fin neg by (auto simp: split_beta')
     show "integrable ?P (\<lambda>x. - log b (?f x))"
       apply (subst integrable_real_density)
       apply simp
       apply (auto simp: space_pair_measure) []
       apply simp
       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
         less_le space_pair_measure)
       done
   qed (auto simp: b_gt_1 minus_log_convex)
   also have "\<dots> = conditional_mutual_information b S T P X Y Z"
     unfolding \<open>?eq\<close>
     apply (subst integral_real_density)
     apply simp
     apply (auto 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)
     done
   finally show ?nonneg
     by simp
 qed
 
 lemma (in information_space)
   fixes Px :: "_ \<Rightarrow> real"
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T" and P: "sigma_finite_measure P"
   assumes Fx: "finite_entropy S X Px"
   assumes Fz: "finite_entropy P Z Pz"
   assumes Fyz: "finite_entropy (T \<Otimes>\<^sub>M P) (\<lambda>x. (Y x, Z x)) Pyz"
   assumes Fxz: "finite_entropy (S \<Otimes>\<^sub>M P) (\<lambda>x. (X x, Z x)) Pxz"
   assumes Fxyz: "finite_entropy (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) (\<lambda>x. (X x, Y x, Z x)) Pxyz"
   shows conditional_mutual_information_generic_eq': "conditional_mutual_information b S T P X Y Z
     = (\<integral>(x, y, z). Pxyz (x, y, z) * log b (Pxyz (x, y, z) / (Pxz (x, z) * (Pyz (y,z) / Pz z))) \<partial>(S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P))" (is "?eq")
     and conditional_mutual_information_generic_nonneg': "0 \<le> conditional_mutual_information b S T P X Y Z" (is "?nonneg")
 proof -
   note Px = Fx[THEN finite_entropy_distributed, measurable]
   note Pz = Fz[THEN finite_entropy_distributed, measurable]
   note Pyz = Fyz[THEN finite_entropy_distributed, measurable]
   note Pxz = Fxz[THEN finite_entropy_distributed, measurable]
   note Pxyz = Fxyz[THEN finite_entropy_distributed, measurable]
 
   note Px_nn = Fx[THEN finite_entropy_nn]
   note Pz_nn = Fz[THEN finite_entropy_nn]
   note Pyz_nn = Fyz[THEN finite_entropy_nn]
   note Pxz_nn = Fxz[THEN finite_entropy_nn]
   note Pxyz_nn = Fxyz[THEN finite_entropy_nn]
 
   note Px' = Fx[THEN finite_entropy_measurable, measurable]
   note Pz' = Fz[THEN finite_entropy_measurable, measurable]
   note Pyz' = Fyz[THEN finite_entropy_measurable, measurable]
   note Pxz' = Fxz[THEN finite_entropy_measurable, measurable]
   note Pxyz' = Fxyz[THEN finite_entropy_measurable, measurable]
 
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret P: sigma_finite_measure P by fact
   interpret TP: pair_sigma_finite T P ..
   interpret SP: pair_sigma_finite S P ..
   interpret ST: pair_sigma_finite S T ..
   interpret SPT: pair_sigma_finite "S \<Otimes>\<^sub>M P" T ..
   interpret STP: pair_sigma_finite S "T \<Otimes>\<^sub>M P" ..
   interpret TPS: pair_sigma_finite "T \<Otimes>\<^sub>M P" S ..
   have TP: "sigma_finite_measure (T \<Otimes>\<^sub>M P)" ..
   have SP: "sigma_finite_measure (S \<Otimes>\<^sub>M P)" ..
 
   from Pxz Pxyz have distr_eq: "distr M (S \<Otimes>\<^sub>M P) (\<lambda>x. (X x, Z x)) =
     distr (distr M (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) (\<lambda>x. (X x, Y x, Z x))) (S \<Otimes>\<^sub>M P) (\<lambda>(x, y, z). (x, z))"
     by (simp add: distr_distr comp_def)
 
   have "mutual_information b S P X Z =
     (\<integral>x. Pxz x * log b (Pxz x / (Px (fst x) * Pz (snd x))) \<partial>(S \<Otimes>\<^sub>M P))"
     using Px Px_nn Pz Pz_nn Pxz Pxz_nn
     by (rule mutual_information_distr[OF S P]) (auto simp: space_pair_measure)
   also have "\<dots> = (\<integral>(x,y,z). Pxyz (x,y,z) * log b (Pxz (x,z) / (Px x * Pz z)) \<partial>(S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P))"
     using b_gt_1 Pxz Pxz_nn Pxyz Pxyz_nn
     by (subst distributed_transform_integral[OF Pxyz _ Pxz, where T="\<lambda>(x, y, z). (x, z)"])
        (auto simp: split_beta')
   finally have mi_eq:
     "mutual_information b S P X Z = (\<integral>(x,y,z). Pxyz (x,y,z) * log b (Pxz (x,z) / (Px x * Pz z)) \<partial>(S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P))" .
 
   have ae1: "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P. Px (fst x) = 0 \<longrightarrow> Pxyz x = 0"
     by (intro subdensity_finite_entropy[of fst, OF _ Fxyz Fx]) auto
   moreover have ae2: "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P. Pz (snd (snd x)) = 0 \<longrightarrow> Pxyz x = 0"
     by (intro subdensity_finite_entropy[of "\<lambda>x. snd (snd x)", OF _ Fxyz Fz]) auto
   moreover have ae3: "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P. Pxz (fst x, snd (snd x)) = 0 \<longrightarrow> Pxyz x = 0"
     by (intro subdensity_finite_entropy[of "\<lambda>x. (fst x, snd (snd x))", OF _ Fxyz Fxz]) auto
   moreover have ae4: "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P. Pyz (snd x) = 0 \<longrightarrow> Pxyz x = 0"
     by (intro subdensity_finite_entropy[of snd, OF _ Fxyz Fyz]) auto
   ultimately have ae: "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P.
     Pxyz x * log b (Pxyz x / (Px (fst x) * Pyz (snd x))) -
     Pxyz x * log b (Pxz (fst x, snd (snd x)) / (Px (fst x) * Pz (snd (snd x)))) =
     Pxyz x * log b (Pxyz x * Pz (snd (snd x)) / (Pxz (fst x, snd (snd x)) * Pyz (snd x))) "
     using AE_space
   proof eventually_elim
     case (elim x)
     show ?case
     proof cases
       assume "Pxyz x \<noteq> 0"
       with elim have "0 < Px (fst x)" "0 < Pz (snd (snd x))" "0 < Pxz (fst x, snd (snd x))"
         "0 < Pyz (snd x)" "0 < Pxyz x"
         using Px_nn Pz_nn Pxz_nn Pyz_nn Pxyz_nn
         by (auto simp: space_pair_measure less_le)
       then show ?thesis
         using b_gt_1 by (simp add: log_simps less_imp_le field_simps)
     qed simp
   qed
 
   have "integrable (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P)
     (\<lambda>x. Pxyz x * log b (Pxyz x) - Pxyz x * log b (Px (fst x)) - Pxyz x * log b (Pyz (snd x)))"
     using finite_entropy_integrable[OF Fxyz]
     using finite_entropy_integrable_transform[OF Fx Pxyz Pxyz_nn, of fst]
     using finite_entropy_integrable_transform[OF Fyz Pxyz Pxyz_nn, of snd]
     by simp
   moreover have "(\<lambda>(x, y, z). Pxyz (x, y, z) * log b (Pxyz (x, y, z) / (Px x * Pyz (y, z)))) \<in> borel_measurable (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P)"
     using Pxyz Px Pyz by simp
   ultimately have I1: "integrable (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) (\<lambda>(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)
 
   have "integrable (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P)
     (\<lambda>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))))"
     using finite_entropy_integrable_transform[OF Fxz Pxyz Pxyz_nn, of "\<lambda>x. (fst x, snd (snd x))"]
     using finite_entropy_integrable_transform[OF Fx Pxyz Pxyz_nn, of fst]
     using finite_entropy_integrable_transform[OF Fz Pxyz Pxyz_nn, of "snd \<circ> snd"]
     by simp
   moreover have "(\<lambda>(x, y, z). Pxyz (x, y, z) * log b (Pxz (x, z) / (Px x * Pz z))) \<in> borel_measurable (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P)"
     using Pxyz Px Pz
     by auto
   ultimately have I2: "integrable (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) (\<lambda>(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)
 
   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)
     apply (subst Bochner_Integration.integral_diff[symmetric])
     apply (auto intro!: integral_cong_AE simp: split_beta' simp del: Bochner_Integration.integral_diff)
     done
 
   let ?P = "density (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) Pxyz"
   interpret P: prob_space ?P
     unfolding distributed_distr_eq_density[OF Pxyz, symmetric] by (rule prob_space_distr) simp
 
   let ?Q = "density (T \<Otimes>\<^sub>M P) Pyz"
   interpret Q: prob_space ?Q
     unfolding distributed_distr_eq_density[OF Pyz, symmetric] by (rule prob_space_distr) simp
 
   let ?f = "\<lambda>(x, y, z). Pxz (x, z) * (Pyz (y, z) / Pz z) / Pxyz (x, y, z)"
 
   from subdensity_finite_entropy[of snd, OF _ Fyz Fz]
   have aeX1: "AE x in T \<Otimes>\<^sub>M P. Pz (snd x) = 0 \<longrightarrow> Pyz x = 0" by (auto simp: comp_def)
   have aeX2: "AE x in T \<Otimes>\<^sub>M P. 0 \<le> Pz (snd x)"
     using Pz by (intro TP.AE_pair_measure) (auto intro: Pz_nn)
 
   have aeX3: "AE y in T \<Otimes>\<^sub>M P. (\<integral>\<^sup>+ x. ennreal (Pxz (x, snd y)) \<partial>S) = ennreal (Pz (snd y))"
     using Pz distributed_marginal_eq_joint2[OF P S Pz Pxz]
     by (intro TP.AE_pair_measure) (auto )
   have "(\<integral>\<^sup>+ x. ?f x \<partial>?P) \<le> (\<integral>\<^sup>+ (x, y, z). Pxz (x, z) * (Pyz (y, z) / Pz z) \<partial>(S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P))"
     using Px_nn Pz_nn Pxz_nn Pyz_nn Pxyz_nn
     by (subst nn_integral_density)
        (auto intro!: nn_integral_mono simp: space_pair_measure ennreal_mult[symmetric])
   also have "\<dots> = (\<integral>\<^sup>+(y, z). \<integral>\<^sup>+ x. ennreal (Pxz (x, z)) * ennreal (Pyz (y, z) / Pz z) \<partial>S \<partial>T \<Otimes>\<^sub>M P)"
     using Px_nn Pz_nn Pxz_nn Pyz_nn Pxyz_nn
     by (subst STP.nn_integral_snd[symmetric])
        (auto simp add: split_beta' ennreal_mult[symmetric] space_pair_measure intro!: nn_integral_cong)
   also have "\<dots> = (\<integral>\<^sup>+x. ennreal (Pyz x) * 1 \<partial>T \<Otimes>\<^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 \<longrightarrow> Pyz (a, b) = 0" "0 \<le> Pz b" "a \<in> space T \<and> b \<in> space P"
       "(\<integral>\<^sup>+ x. ennreal (Pxz (x, b)) \<partial>S) = ennreal (Pz b)"
     then show "(\<integral>\<^sup>+ x. ennreal (Pxz (x, b)) * ennreal (Pyz (a, b) / Pz b) \<partial>S) = ennreal (Pyz (a, b))"
       using Pyz_nn[of "(a,b)"]
       by (subst nn_integral_multc) (auto simp: space_pair_measure ennreal_mult[symmetric])
   qed
   also have "\<dots> = 1"
     using Q.emeasure_space_1 Pyz_nn distributed_distr_eq_density[OF Pyz]
     by (subst nn_integral_density[symmetric]) auto
   finally have le1: "(\<integral>\<^sup>+ x. ?f x \<partial>?P) \<le> 1" .
   also have "\<dots> < \<infinity>" by simp
   finally have fin: "(\<integral>\<^sup>+ x. ?f x \<partial>?P) \<noteq> \<infinity>" by simp
 
   have "(\<integral>\<^sup>+ x. ?f x \<partial>?P) \<noteq> 0"
     using Pxyz_nn
     apply (subst nn_integral_density)
     apply (simp_all add: split_beta'  ennreal_mult'[symmetric] cong: nn_integral_cong)
   proof
     let ?g = "\<lambda>x. ennreal (if Pxyz x = 0 then 0 else Pxz (fst x, snd (snd x)) * Pyz (snd x) / Pz (snd (snd x)))"
     assume "(\<integral>\<^sup>+ x. ?g x \<partial>(S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P)) = 0"
     then have "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P. ?g x = 0"
       by (intro nn_integral_0_iff_AE[THEN iffD1]) auto
     then have "AE x in S \<Otimes>\<^sub>M T \<Otimes>\<^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,
            auto split: if_split_asm simp: mult_le_0_iff divide_le_0_iff space_pair_measure)
     then have "(\<integral>\<^sup>+ x. ennreal (Pxyz x) \<partial>S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) = 0"
       by (subst nn_integral_cong_AE[of _ "\<lambda>x. 0"]) auto
     with P.emeasure_space_1 show False
       by (subst (asm) emeasure_density) (auto cong: nn_integral_cong)
   qed
   then have pos: "0 < (\<integral>\<^sup>+ x. ?f x \<partial>?P)"
     by (simp add: zero_less_iff_neq_zero)
 
   have neg: "(\<integral>\<^sup>+ x. - ?f x \<partial>?P) = 0"
     using Pz_nn Pxz_nn Pyz_nn Pxyz_nn
     by (intro nn_integral_0_iff_AE[THEN iffD2])
        (auto simp: split_beta' AE_density space_pair_measure intro!: AE_I2 ennreal_neg)
 
   have I3: "integrable (S \<Otimes>\<^sub>M T \<Otimes>\<^sub>M P) (\<lambda>(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
 
   have "- log b 1 \<le> - 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 "(\<integral>\<^sup>+ x. - ?f x \<partial>?P) \<noteq> \<infinity>"
         by simp
       from fin show "(\<integral>\<^sup>+ x. ?f x \<partial>?P) \<noteq> \<infinity>"
         by simp
     qed simp
     then have "(\<integral>\<^sup>+ x. ?f x \<partial>?P) = (\<integral>x. ?f x \<partial>?P)"
       using Pz_nn Pxz_nn Pyz_nn Pxyz_nn
       by (intro nn_integral_eq_integral)
          (auto simp: AE_density space_pair_measure)
     with pos le1
     show "0 < (\<integral>x. ?f x \<partial>?P)" "(\<integral>x. ?f x \<partial>?P) \<le> 1"
       by (simp_all add: )
   qed
   also have "- log b (integral\<^sup>L ?P ?f) \<le> (\<integral> x. - log b (?f x) \<partial>?P)"
   proof (rule P.jensens_inequality[where a=0 and b=1 and I="{0<..}"])
     show "AE x in ?P. ?f x \<in> {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)
     show "integrable ?P ?f"
       unfolding real_integrable_def
       using fin neg by (auto simp: split_beta')
     show "integrable ?P (\<lambda>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
       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
   qed (auto simp: b_gt_1 minus_log_convex)
   also have "\<dots> = conditional_mutual_information b S T P X Y Z"
     unfolding \<open>?eq\<close>
     using Pz_nn Pxz_nn Pyz_nn Pxyz_nn
     apply (subst integral_real_density)
     apply simp
     apply simp
     apply simp
     apply (intro integral_cong_AE)
     using ae1 ae2 ae3 ae4 AE_space
     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
 qed
 
 lemma (in information_space) conditional_mutual_information_eq:
   assumes Pz: "simple_distributed M Z Pz"
   assumes Pyz: "simple_distributed M (\<lambda>x. (Y x, Z x)) Pyz"
   assumes Pxz: "simple_distributed M (\<lambda>x. (X x, Z x)) Pxz"
   assumes Pxyz: "simple_distributed M (\<lambda>x. (X x, Y x, Z x)) Pxyz"
   shows "\<I>(X ; Y | Z) =
    (\<Sum>(x, y, z)\<in>(\<lambda>x. (X x, Y x, Z x))`space M. Pxyz (x, y, z) * log b (Pxyz (x, y, z) / (Pxz (x, z) * (Pyz (y,z) / Pz z))))"
 proof (subst conditional_mutual_information_generic_eq[OF _ _ _ _ _
     simple_distributed[OF Pz] _ simple_distributed_joint[OF Pyz] _ simple_distributed_joint[OF Pxz] _
     simple_distributed_joint2[OF Pxyz]])
   note simple_distributed_joint2_finite[OF Pxyz, simp]
   show "sigma_finite_measure (count_space (X ` space M))"
     by (simp add: sigma_finite_measure_count_space_finite)
   show "sigma_finite_measure (count_space (Y ` space M))"
     by (simp add: sigma_finite_measure_count_space_finite)
   show "sigma_finite_measure (count_space (Z ` space M))"
     by (simp add: sigma_finite_measure_count_space_finite)
   have "count_space (X ` space M) \<Otimes>\<^sub>M count_space (Y ` space M) \<Otimes>\<^sub>M count_space (Z ` space M) =
       count_space (X`space M \<times> Y`space M \<times> Z`space M)"
     (is "?P = ?C")
     by (simp add: pair_measure_count_space)
 
   let ?Px = "\<lambda>x. measure M (X -` {x} \<inter> space M)"
   have "(\<lambda>x. (X x, Z x)) \<in> measurable M (count_space (X ` space M) \<Otimes>\<^sub>M count_space (Z ` space M))"
     using simple_distributed_joint[OF Pxz] by (rule distributed_measurable)
   from measurable_comp[OF this measurable_fst]
   have "random_variable (count_space (X ` space M)) X"
     by (simp add: comp_def)
   then have "simple_function M X"
     unfolding simple_function_def by (auto simp: measurable_count_space_eq2)
   then have "simple_distributed M X ?Px"
     by (rule simple_distributedI) (auto simp: measure_nonneg)
   then show "distributed M (count_space (X ` space M)) X ?Px"
     by (rule simple_distributed)
 
   let ?f = "(\<lambda>x. if x \<in> (\<lambda>x. (X x, Y x, Z x)) ` space M then Pxyz x else 0)"
   let ?g = "(\<lambda>x. if x \<in> (\<lambda>x. (Y x, Z x)) ` space M then Pyz x else 0)"
   let ?h = "(\<lambda>x. if x \<in> (\<lambda>x. (X x, Z x)) ` space M then Pxz x else 0)"
   show
       "integrable ?P (\<lambda>(x, y, z). ?f (x, y, z) * log b (?f (x, y, z) / (?Px x * ?g (y, z))))"
       "integrable ?P (\<lambda>(x, y, z). ?f (x, y, z) * log b (?h (x, z) / (?Px x * Pz z)))"
     by (auto intro!: integrable_count_space simp: pair_measure_count_space)
   let ?i = "\<lambda>x y z. ?f (x, y, z) * log b (?f (x, y, z) / (?h (x, z) * (?g (y, z) / Pz z)))"
   let ?j = "\<lambda>x y z. Pxyz (x, y, z) * log b (Pxyz (x, y, z) / (Pxz (x, z) * (Pyz (y,z) / Pz z)))"
   have "(\<lambda>(x, y, z). ?i x y z) = (\<lambda>x. if x \<in> (\<lambda>x. (X x, Y x, Z x)) ` space M then ?j (fst x) (fst (snd x)) (snd (snd x)) else 0)"
     by (auto intro!: ext)
   then show "(\<integral> (x, y, z). ?i x y z \<partial>?P) = (\<Sum>(x, y, z)\<in>(\<lambda>x. (X x, Y x, Z x)) ` space M. ?j x y z)"
     by (auto intro!: sum.cong simp add: \<open>?P = ?C\<close> lebesgue_integral_count_space_finite simple_distributed_finite sum.If_cases split_beta')
 qed (insert Pz Pyz Pxz Pxyz, auto intro: measure_nonneg)
 
 lemma (in information_space) conditional_mutual_information_nonneg:
   assumes X: "simple_function M X" and Y: "simple_function M Y" and Z: "simple_function M Z"
   shows "0 \<le> \<I>(X ; Y | Z)"
 proof -
   have [simp]: "count_space (X ` space M) \<Otimes>\<^sub>M count_space (Y ` space M) \<Otimes>\<^sub>M count_space (Z ` space M) =
       count_space (X`space M \<times> Y`space M \<times> Z`space M)"
     by (simp add: pair_measure_count_space X Y Z simple_functionD)
   note sf = sigma_finite_measure_count_space_finite[OF simple_functionD(1)]
   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
 qed
 
 subsection \<open>Conditional Entropy\<close>
 
 definition (in prob_space)
   "conditional_entropy b S T X Y = - (\<integral>(x, y). log b (enn2real (RN_deriv (S \<Otimes>\<^sub>M T) (distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))) (x, y)) /
     enn2real (RN_deriv T (distr M T Y) y)) \<partial>distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)))"
 
 abbreviation (in information_space)
   conditional_entropy_Pow ("\<H>'(_ | _')") where
   "\<H>(X | Y) \<equiv> conditional_entropy b (count_space (X`space M)) (count_space (Y`space M)) X Y"
 
 lemma (in information_space) conditional_entropy_generic_eq:
   fixes Pxy :: "_ \<Rightarrow> real" and Py :: "'c \<Rightarrow> real"
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T"
   assumes Py[measurable]: "distributed M T Y Py" and Py_nn[simp]: "\<And>x. x \<in> space T \<Longrightarrow> 0 \<le> Py x"
   assumes Pxy[measurable]: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
     and Pxy_nn[simp]: "\<And>x y. x \<in> space S \<Longrightarrow> y \<in> space T \<Longrightarrow> 0 \<le> Pxy (x, y)"
   shows "conditional_entropy b S T X Y = - (\<integral>(x, y). Pxy (x, y) * log b (Pxy (x, y) / Py y) \<partial>(S \<Otimes>\<^sub>M T))"
 proof -
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret ST: pair_sigma_finite S T ..
 
   have [measurable]: "Py \<in> T \<rightarrow>\<^sub>M borel"
     using Py Py_nn by (intro distributed_real_measurable)
   have measurable_Pxy[measurable]: "Pxy \<in> (S \<Otimes>\<^sub>M T) \<rightarrow>\<^sub>M borel"
     using Pxy Pxy_nn by (intro distributed_real_measurable) (auto simp: space_pair_measure)
 
   have "AE x in density (S \<Otimes>\<^sub>M T) (\<lambda>x. ennreal (Pxy x)). Pxy x = enn2real (RN_deriv (S \<Otimes>\<^sub>M T) (distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))) x)"
     unfolding AE_density[OF distributed_borel_measurable, OF Pxy]
     unfolding distributed_distr_eq_density[OF Pxy]
     using distributed_RN_deriv[OF Pxy]
     by auto
   moreover
   have "AE x in density (S \<Otimes>\<^sub>M T) (\<lambda>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
   ultimately
   have "conditional_entropy b S T X Y = - (\<integral>x. Pxy x * log b (Pxy x / Py (snd x)) \<partial>(S \<Otimes>\<^sub>M T))"
     unfolding conditional_entropy_def neg_equal_iff_equal
     apply (subst integral_real_density[symmetric])
     apply (auto simp: distributed_distr_eq_density[OF Pxy] space_pair_measure
                 intro!: integral_cong_AE)
     done
   then show ?thesis by (simp add: split_beta')
 qed
 
 lemma (in information_space) conditional_entropy_eq_entropy:
   fixes Px :: "'b \<Rightarrow> real" and Py :: "'c \<Rightarrow> real"
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T"
   assumes Py[measurable]: "distributed M T Y Py"
     and Py_nn[simp]: "\<And>x. x \<in> space T \<Longrightarrow> 0 \<le> Py x"
   assumes Pxy[measurable]: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
     and Pxy_nn[simp]: "\<And>x y. x \<in> space S \<Longrightarrow> y \<in> space T \<Longrightarrow> 0 \<le> Pxy (x, y)"
   assumes I1: "integrable (S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Pxy x))"
   assumes I2: "integrable (S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Py (snd x)))"
   shows "conditional_entropy b S T X Y = entropy b (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) - entropy b T Y"
 proof -
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret ST: pair_sigma_finite S T ..
 
   have [measurable]: "Py \<in> T \<rightarrow>\<^sub>M borel"
     using Py Py_nn by (intro distributed_real_measurable)
   have measurable_Pxy[measurable]: "Pxy \<in> (S \<Otimes>\<^sub>M T) \<rightarrow>\<^sub>M borel"
     using Pxy Pxy_nn by (intro distributed_real_measurable) (auto simp: space_pair_measure)
 
   have "entropy b T Y = - (\<integral>y. Py y * log b (Py y) \<partial>T)"
     by (rule entropy_distr[OF Py Py_nn])
   also have "\<dots> = - (\<integral>(x,y). Pxy (x,y) * log b (Py y) \<partial>(S \<Otimes>\<^sub>M T))"
     using b_gt_1
     by (subst distributed_transform_integral[OF Pxy _ Py, where T=snd])
        (auto intro!: Bochner_Integration.integral_cong simp: space_pair_measure)
   finally have e_eq: "entropy b T Y = - (\<integral>(x,y). Pxy (x,y) * log b (Py y) \<partial>(S \<Otimes>\<^sub>M T))" .
 
   have **: "\<And>x. x \<in> space (S \<Otimes>\<^sub>M T) \<Longrightarrow> 0 \<le> Pxy x"
     by (auto simp: space_pair_measure)
 
   have ae2: "AE x in S \<Otimes>\<^sub>M T. Py (snd x) = 0 \<longrightarrow> Pxy x = 0"
     by (intro subdensity_real[of snd, OF _ Pxy Py])
        (auto intro: measurable_Pair simp: space_pair_measure)
   moreover have ae4: "AE x in S \<Otimes>\<^sub>M T. 0 \<le> Py (snd x)"
     using Py by (intro ST.AE_pair_measure) (auto simp: comp_def intro!: measurable_snd'')
   ultimately have "AE x in S \<Otimes>\<^sub>M T. 0 \<le> Pxy x \<and> 0 \<le> Py (snd x) \<and>
     (Pxy x = 0 \<or> (Pxy x \<noteq> 0 \<longrightarrow> 0 < Pxy x \<and> 0 < Py (snd x)))"
     using AE_space by eventually_elim (auto simp: space_pair_measure less_le)
   then have ae: "AE x in S \<Otimes>\<^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)
   have "conditional_entropy b S T X Y =
     - (\<integral>x. Pxy x * log b (Pxy x) - Pxy x * log b (Py (snd x)) \<partial>(S \<Otimes>\<^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
   also have "\<dots> = - (\<integral>x. Pxy x * log b (Pxy x) \<partial>(S \<Otimes>\<^sub>M T)) - - (\<integral>x.  Pxy x * log b (Py (snd x)) \<partial>(S \<Otimes>\<^sub>M T))"
     by (simp add: Bochner_Integration.integral_diff[OF I1 I2])
   finally show ?thesis
     using conditional_entropy_generic_eq[OF S T Py Py_nn Pxy Pxy_nn, simplified]
       entropy_distr[OF Pxy **, simplified] e_eq
     by (simp add: split_beta')
 qed
 
 lemma (in information_space) conditional_entropy_eq_entropy_simple:
   assumes X: "simple_function M X" and Y: "simple_function M Y"
   shows "\<H>(X | Y) = entropy b (count_space (X`space M) \<Otimes>\<^sub>M count_space (Y`space M)) (\<lambda>x. (X x, Y x)) - \<H>(Y)"
 proof -
   have "count_space (X ` space M) \<Otimes>\<^sub>M count_space (Y ` space M) = count_space (X`space M \<times> Y`space M)"
     (is "?P = ?C") using X Y by (simp add: simple_functionD pair_measure_count_space)
   show ?thesis
     by (rule conditional_entropy_eq_entropy sigma_finite_measure_count_space_finite
              simple_functionD  X Y simple_distributed simple_distributedI[OF _ _ refl]
              simple_distributed_joint simple_function_Pair integrable_count_space measure_nonneg)+
        (auto simp: \<open>?P = ?C\<close> measure_nonneg intro!: integrable_count_space simple_functionD  X Y)
 qed
 
 lemma (in information_space) conditional_entropy_eq:
   assumes Y: "simple_distributed M Y Py"
   assumes XY: "simple_distributed M (\<lambda>x. (X x, Y x)) Pxy"
     shows "\<H>(X | Y) = - (\<Sum>(x, y)\<in>(\<lambda>x. (X x, Y x)) ` space M. Pxy (x, y) * log b (Pxy (x, y) / Py y))"
 proof (subst conditional_entropy_generic_eq[OF _ _
   simple_distributed[OF Y] _ simple_distributed_joint[OF XY]])
   have "finite ((\<lambda>x. (X x, Y x))`space M)"
     using XY unfolding simple_distributed_def by auto
   from finite_imageI[OF this, of fst]
   have [simp]: "finite (X`space M)"
     by (simp add: image_comp comp_def)
   note Y[THEN simple_distributed_finite, simp]
   show "sigma_finite_measure (count_space (X ` space M))"
     by (simp add: sigma_finite_measure_count_space_finite)
   show "sigma_finite_measure (count_space (Y ` space M))"
     by (simp add: sigma_finite_measure_count_space_finite)
   let ?f = "(\<lambda>x. if x \<in> (\<lambda>x. (X x, Y x)) ` space M then Pxy x else 0)"
   have "count_space (X ` space M) \<Otimes>\<^sub>M count_space (Y ` space M) = count_space (X`space M \<times> Y`space M)"
     (is "?P = ?C")
     using Y by (simp add: simple_distributed_finite pair_measure_count_space)
   have eq: "(\<lambda>(x, y). ?f (x, y) * log b (?f (x, y) / Py y)) =
     (\<lambda>x. if x \<in> (\<lambda>x. (X x, Y x)) ` space M then Pxy x * log b (Pxy x / Py (snd x)) else 0)"
     by auto
   from Y show "- (\<integral> (x, y). ?f (x, y) * log b (?f (x, y) / Py y) \<partial>?P) =
     - (\<Sum>(x, y)\<in>(\<lambda>x. (X x, Y x)) ` space M. Pxy (x, y) * log b (Pxy (x, y) / Py y))"
     by (auto intro!: sum.cong simp add: \<open>?P = ?C\<close> lebesgue_integral_count_space_finite simple_distributed_finite eq sum.If_cases split_beta')
 qed (insert Y XY, auto)
 
 lemma (in information_space) conditional_mutual_information_eq_conditional_entropy:
   assumes X: "simple_function M X" and Y: "simple_function M Y"
   shows "\<I>(X ; X | Y) = \<H>(X | Y)"
 proof -
   define Py where "Py x = (if x \<in> Y`space M then measure M (Y -` {x} \<inter> space M) else 0)" for x
   define Pxy where "Pxy x =
       (if x \<in> (\<lambda>x. (X x, Y x))`space M then measure M ((\<lambda>x. (X x, Y x)) -` {x} \<inter> space M) else 0)"
     for x
   define Pxxy where "Pxxy x =
       (if x \<in> (\<lambda>x. (X x, X x, Y x))`space M then measure M ((\<lambda>x. (X x, X x, Y x)) -` {x} \<inter> space M)
        else 0)"
     for x
   let ?M = "X`space M \<times> X`space M \<times> Y`space M"
 
   note XY = simple_function_Pair[OF X Y]
   note XXY = simple_function_Pair[OF X XY]
   have Py: "simple_distributed M Y Py"
     using Y by (rule simple_distributedI) (auto simp: Py_def measure_nonneg)
   have Pxy: "simple_distributed M (\<lambda>x. (X x, Y x)) Pxy"
     using XY by (rule simple_distributedI) (auto simp: Pxy_def measure_nonneg)
   have Pxxy: "simple_distributed M (\<lambda>x. (X x, X x, Y x)) Pxxy"
     using XXY by (rule simple_distributedI) (auto simp: Pxxy_def measure_nonneg)
   have eq: "(\<lambda>x. (X x, X x, Y x)) ` space M = (\<lambda>(x, y). (x, x, y)) ` (\<lambda>x. (X x, Y x)) ` space M"
     by auto
   have inj: "\<And>A. inj_on (\<lambda>(x, y). (x, x, y)) A"
     by (auto simp: inj_on_def)
   have Pxxy_eq: "\<And>x y. Pxxy (x, x, y) = Pxy (x, y)"
     by (auto simp: Pxxy_def Pxy_def intro!: arg_cong[where f=prob])
   have "AE x in count_space ((\<lambda>x. (X x, Y x))`space M). Py (snd x) = 0 \<longrightarrow> Pxy x = 0"
     using Py Pxy
     by (intro subdensity_real[of snd, OF _ Pxy[THEN simple_distributed] Py[THEN simple_distributed]])
        (auto intro: measurable_Pair simp: AE_count_space)
   then show ?thesis
     apply (subst conditional_mutual_information_eq[OF Py Pxy Pxy Pxxy])
     apply (subst conditional_entropy_eq[OF Py Pxy])
     apply (auto intro!: sum.cong simp: Pxxy_eq sum_negf[symmetric] eq sum.reindex[OF inj]
                 log_simps zero_less_mult_iff zero_le_mult_iff field_simps mult_less_0_iff AE_count_space)
     using Py[THEN simple_distributed] Pxy[THEN simple_distributed]
     apply (auto simp add: not_le AE_count_space less_le antisym
       simple_distributed_nonneg[OF Py] simple_distributed_nonneg[OF Pxy])
     done
 qed
 
 lemma (in information_space) conditional_entropy_nonneg:
   assumes X: "simple_function M X" and Y: "simple_function M Y" shows "0 \<le> \<H>(X | Y)"
   using conditional_mutual_information_eq_conditional_entropy[OF X Y] conditional_mutual_information_nonneg[OF X X Y]
   by simp
 
 subsection \<open>Equalities\<close>
 
 lemma (in information_space) mutual_information_eq_entropy_conditional_entropy_distr:
   fixes Px :: "'b \<Rightarrow> real" and Py :: "'c \<Rightarrow> real" and Pxy :: "('b \<times> 'c) \<Rightarrow> real"
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T"
   assumes Px[measurable]: "distributed M S X Px"
     and Px_nn[simp]: "\<And>x. x \<in> space S \<Longrightarrow> 0 \<le> Px x"
     and Py[measurable]: "distributed M T Y Py"
     and Py_nn[simp]: "\<And>x. x \<in> space T \<Longrightarrow> 0 \<le> Py x"
     and Pxy[measurable]: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
     and Pxy_nn[simp]: "\<And>x y. x \<in> space S \<Longrightarrow> y \<in> space T \<Longrightarrow> 0 \<le> Pxy (x, y)"
   assumes Ix: "integrable(S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Px (fst x)))"
   assumes Iy: "integrable(S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Py (snd x)))"
   assumes Ixy: "integrable(S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Pxy x))"
   shows  "mutual_information b S T X Y = entropy b S X + entropy b T Y - entropy b (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))"
 proof -
   have [measurable]: "Px \<in> S \<rightarrow>\<^sub>M borel"
     using Px Px_nn by (intro distributed_real_measurable)
   have [measurable]: "Py \<in> T \<rightarrow>\<^sub>M borel"
     using Py Py_nn by (intro distributed_real_measurable)
   have measurable_Pxy[measurable]: "Pxy \<in> (S \<Otimes>\<^sub>M T) \<rightarrow>\<^sub>M borel"
     using Pxy Pxy_nn by (intro distributed_real_measurable) (auto simp: space_pair_measure)
 
   have X: "entropy b S X = - (\<integral>x. Pxy x * log b (Px (fst x)) \<partial>(S \<Otimes>\<^sub>M T))"
     using b_gt_1
     apply (subst entropy_distr[OF Px Px_nn], simp)
     apply (subst distributed_transform_integral[OF Pxy _ Px, where T=fst])
     apply (auto intro!: integral_cong simp: space_pair_measure)
     done
 
   have Y: "entropy b T Y = - (\<integral>x. Pxy x * log b (Py (snd x)) \<partial>(S \<Otimes>\<^sub>M T))"
     using b_gt_1
     apply (subst entropy_distr[OF Py Py_nn], simp)
     apply (subst distributed_transform_integral[OF Pxy _ Py, where T=snd])
     apply (auto intro!: integral_cong simp: space_pair_measure)
     done
 
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret ST: pair_sigma_finite S T ..
   have ST: "sigma_finite_measure (S \<Otimes>\<^sub>M T)" ..
 
   have XY: "entropy b (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) = - (\<integral>x. Pxy x * log b (Pxy x) \<partial>(S \<Otimes>\<^sub>M T))"
     by (subst entropy_distr[OF Pxy]) (auto intro!: integral_cong simp: space_pair_measure)
 
   have "AE x in S \<Otimes>\<^sub>M T. Px (fst x) = 0 \<longrightarrow> Pxy x = 0"
     by (intro subdensity_real[of fst, OF _ Pxy Px]) (auto intro: measurable_Pair simp: space_pair_measure)
   moreover have "AE x in S \<Otimes>\<^sub>M T. Py (snd x) = 0 \<longrightarrow> Pxy x = 0"
     by (intro subdensity_real[of snd, OF _ Pxy Py]) (auto intro: measurable_Pair simp: space_pair_measure)
   moreover have "AE x in S \<Otimes>\<^sub>M T. 0 \<le> Px (fst x)"
     using Px by (intro ST.AE_pair_measure) (auto simp: comp_def intro!: measurable_fst'')
   moreover have "AE x in S \<Otimes>\<^sub>M T. 0 \<le> Py (snd x)"
     using Py by (intro ST.AE_pair_measure) (auto simp: comp_def intro!: measurable_snd'')
   ultimately have "AE x in S \<Otimes>\<^sub>M T. Pxy x * log b (Pxy x) - Pxy x * log b (Px (fst x)) - Pxy x * log b (Py (snd x)) =
     Pxy x * log b (Pxy x / (Px (fst x) * Py (snd x)))"
     (is "AE x in _. ?f x = ?g x")
     using AE_space
   proof eventually_elim
     case (elim x)
     show ?case
     proof cases
       assume "Pxy x \<noteq> 0"
       with elim have "0 < Px (fst x)" "0 < Py (snd x)" "0 < Pxy x"
         by (auto simp: space_pair_measure less_le)
       then show ?thesis
         using b_gt_1 by (simp add: log_simps less_imp_le field_simps)
     qed simp
   qed
 
   have "entropy b S X + entropy b T Y - entropy b (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) = integral\<^sup>L (S \<Otimes>\<^sub>M T) ?f"
     unfolding X Y XY
     apply (subst Bochner_Integration.integral_diff)
     apply (intro Bochner_Integration.integrable_diff Ixy Ix Iy)+
     apply (subst Bochner_Integration.integral_diff)
     apply (intro Ixy Ix Iy)+
     apply (simp add: field_simps)
     done
   also have "\<dots> = integral\<^sup>L (S \<Otimes>\<^sub>M T) ?g"
     using \<open>AE x in _. ?f x = ?g x\<close> by (intro integral_cong_AE) auto
   also have "\<dots> = mutual_information b S T X Y"
     by (rule mutual_information_distr[OF S T Px _ Py _ Pxy _ , symmetric])
        (auto simp: space_pair_measure)
   finally show ?thesis ..
 qed
 
 lemma (in information_space) mutual_information_eq_entropy_conditional_entropy':
   fixes Px :: "'b \<Rightarrow> real" and Py :: "'c \<Rightarrow> real" and Pxy :: "('b \<times> 'c) \<Rightarrow> real"
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T"
   assumes Px: "distributed M S X Px" "\<And>x. x \<in> space S \<Longrightarrow> 0 \<le> Px x"
     and Py: "distributed M T Y Py" "\<And>x. x \<in> space T \<Longrightarrow> 0 \<le> Py x"
   assumes Pxy: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
     "\<And>x. x \<in> space (S \<Otimes>\<^sub>M T) \<Longrightarrow> 0 \<le> Pxy x"
   assumes Ix: "integrable(S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Px (fst x)))"
   assumes Iy: "integrable(S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Py (snd x)))"
   assumes Ixy: "integrable(S \<Otimes>\<^sub>M T) (\<lambda>x. Pxy x * log b (Pxy x))"
   shows  "mutual_information b S T X Y = entropy b S X - conditional_entropy b S T X Y"
   using
     mutual_information_eq_entropy_conditional_entropy_distr[OF S T Px Py Pxy Ix Iy Ixy]
     conditional_entropy_eq_entropy[OF S T Py Pxy Ixy Iy]
   by (simp add: space_pair_measure)
 
 lemma (in information_space) mutual_information_eq_entropy_conditional_entropy:
   assumes sf_X: "simple_function M X" and sf_Y: "simple_function M Y"
   shows  "\<I>(X ; Y) = \<H>(X) - \<H>(X | Y)"
 proof -
   have X: "simple_distributed M X (\<lambda>x. measure M (X -` {x} \<inter> space M))"
     using sf_X by (rule simple_distributedI) (auto simp: measure_nonneg)
   have Y: "simple_distributed M Y (\<lambda>x. measure M (Y -` {x} \<inter> space M))"
     using sf_Y by (rule simple_distributedI) (auto simp: measure_nonneg)
   have sf_XY: "simple_function M (\<lambda>x. (X x, Y x))"
     using sf_X sf_Y by (rule simple_function_Pair)
   then have XY: "simple_distributed M (\<lambda>x. (X x, Y x)) (\<lambda>x. measure M ((\<lambda>x. (X x, Y x)) -` {x} \<inter> space M))"
     by (rule simple_distributedI) (auto simp: measure_nonneg)
   from simple_distributed_joint_finite[OF this, simp]
   have eq: "count_space (X ` space M) \<Otimes>\<^sub>M count_space (Y ` space M) = count_space (X ` space M \<times> Y ` space M)"
     by (simp add: pair_measure_count_space)
 
   have "\<I>(X ; Y) = \<H>(X) + \<H>(Y) - entropy b (count_space (X`space M) \<Otimes>\<^sub>M count_space (Y`space M)) (\<lambda>x. (X x, Y x))"
     using sigma_finite_measure_count_space_finite
       sigma_finite_measure_count_space_finite
       simple_distributed[OF X] measure_nonneg simple_distributed[OF Y] measure_nonneg simple_distributed_joint[OF XY]
     by (rule mutual_information_eq_entropy_conditional_entropy_distr)
        (auto simp: eq integrable_count_space measure_nonneg)
   then show ?thesis
     unfolding conditional_entropy_eq_entropy_simple[OF sf_X sf_Y] by simp
 qed
 
 lemma (in information_space) mutual_information_nonneg_simple:
   assumes sf_X: "simple_function M X" and sf_Y: "simple_function M Y"
   shows  "0 \<le> \<I>(X ; Y)"
 proof -
   have X: "simple_distributed M X (\<lambda>x. measure M (X -` {x} \<inter> space M))"
     using sf_X by (rule simple_distributedI) (auto simp: measure_nonneg)
   have Y: "simple_distributed M Y (\<lambda>x. measure M (Y -` {x} \<inter> space M))"
     using sf_Y by (rule simple_distributedI) (auto simp: measure_nonneg)
 
   have sf_XY: "simple_function M (\<lambda>x. (X x, Y x))"
     using sf_X sf_Y by (rule simple_function_Pair)
   then have XY: "simple_distributed M (\<lambda>x. (X x, Y x)) (\<lambda>x. measure M ((\<lambda>x. (X x, Y x)) -` {x} \<inter> space M))"
     by (rule simple_distributedI) (auto simp: measure_nonneg)
 
   from simple_distributed_joint_finite[OF this, simp]
   have eq: "count_space (X ` space M) \<Otimes>\<^sub>M count_space (Y ` space M) = count_space (X ` space M \<times> Y ` space M)"
     by (simp add: pair_measure_count_space)
 
   show ?thesis
     by (rule mutual_information_nonneg[OF _ _ simple_distributed[OF X] _ simple_distributed[OF Y] _ simple_distributed_joint[OF XY]])
        (simp_all add: eq integrable_count_space sigma_finite_measure_count_space_finite measure_nonneg)
 qed
 
 lemma (in information_space) conditional_entropy_less_eq_entropy:
   assumes X: "simple_function M X" and Z: "simple_function M Z"
   shows "\<H>(X | Z) \<le> \<H>(X)"
 proof -
   have "0 \<le> \<I>(X ; Z)" using X Z by (rule mutual_information_nonneg_simple)
   also have "\<I>(X ; Z) = \<H>(X) - \<H>(X | Z)" using mutual_information_eq_entropy_conditional_entropy[OF assms] .
   finally show ?thesis by auto
 qed
 
 lemma (in information_space)
   fixes Px :: "'b \<Rightarrow> real" and Py :: "'c \<Rightarrow> real" and Pxy :: "('b \<times> 'c) \<Rightarrow> real"
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T"
   assumes Px: "finite_entropy S X Px" and Py: "finite_entropy T Y Py"
   assumes Pxy: "finite_entropy (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
   shows "conditional_entropy b S T X Y \<le> entropy b S X"
 proof -
 
   have "0 \<le> mutual_information b S T X Y"
     by (rule mutual_information_nonneg') fact+
   also have "\<dots> = entropy b S X - conditional_entropy b S T X Y"
     apply (rule mutual_information_eq_entropy_conditional_entropy')
     using assms
     by (auto intro!: finite_entropy_integrable finite_entropy_distributed
       finite_entropy_integrable_transform[OF Px]
       finite_entropy_integrable_transform[OF Py]
       intro: finite_entropy_nn)
   finally show ?thesis by auto
 qed
 
 lemma (in information_space) entropy_chain_rule:
   assumes X: "simple_function M X" and Y: "simple_function M Y"
   shows  "\<H>(\<lambda>x. (X x, Y x)) = \<H>(X) + \<H>(Y|X)"
 proof -
   note XY = simple_distributedI[OF simple_function_Pair[OF X Y] measure_nonneg refl]
   note YX = simple_distributedI[OF simple_function_Pair[OF Y X] measure_nonneg refl]
   note simple_distributed_joint_finite[OF this, simp]
   let ?f = "\<lambda>x. prob ((\<lambda>x. (X x, Y x)) -` {x} \<inter> space M)"
   let ?g = "\<lambda>x. prob ((\<lambda>x. (Y x, X x)) -` {x} \<inter> space M)"
   let ?h = "\<lambda>x. if x \<in> (\<lambda>x. (Y x, X x)) ` space M then prob ((\<lambda>x. (Y x, X x)) -` {x} \<inter> space M) else 0"
   have "\<H>(\<lambda>x. (X x, Y x)) = - (\<Sum>x\<in>(\<lambda>x. (X x, Y x)) ` space M. ?f x * log b (?f x))"
     using XY by (rule entropy_simple_distributed)
   also have "\<dots> = - (\<Sum>x\<in>(\<lambda>(x, y). (y, x)) ` (\<lambda>x. (X x, Y x)) ` space M. ?g x * log b (?g x))"
     by (subst (2) sum.reindex) (auto simp: inj_on_def intro!: sum.cong arg_cong[where f="\<lambda>A. prob A * log b (prob A)"])
   also have "\<dots> = - (\<Sum>x\<in>(\<lambda>x. (Y x, X x)) ` space M. ?h x * log b (?h x))"
     by (auto intro!: sum.cong)
   also have "\<dots> = entropy b (count_space (Y ` space M) \<Otimes>\<^sub>M count_space (X ` space M)) (\<lambda>x. (Y x, X x))"
     by (subst entropy_distr[OF simple_distributed_joint[OF YX]])
        (auto simp: pair_measure_count_space sigma_finite_measure_count_space_finite lebesgue_integral_count_space_finite
              cong del: sum.cong_simp intro!: sum.mono_neutral_left measure_nonneg)
   finally have "\<H>(\<lambda>x. (X x, Y x)) = entropy b (count_space (Y ` space M) \<Otimes>\<^sub>M count_space (X ` space M)) (\<lambda>x. (Y x, X x))" .
   then show ?thesis
     unfolding conditional_entropy_eq_entropy_simple[OF Y X] by simp
 qed
 
 lemma (in information_space) entropy_partition:
   assumes X: "simple_function M X"
   shows "\<H>(X) = \<H>(f \<circ> X) + \<H>(X|f \<circ> X)"
 proof -
   note fX = simple_function_compose[OF X, of f]
   have eq: "(\<lambda>x. ((f \<circ> X) x, X x)) ` space M = (\<lambda>x. (f x, x)) ` X ` space M" by auto
   have inj: "\<And>A. inj_on (\<lambda>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]])
     unfolding eq
     apply (subst sum.reindex[OF inj])
     apply (auto intro!: sum.cong arg_cong[where f="\<lambda>A. prob A * log b (prob A)"])
     done
 qed
 
 corollary (in information_space) entropy_data_processing:
   assumes X: "simple_function M X" shows "\<H>(f \<circ> X) \<le> \<H>(X)"
 proof -
   note fX = simple_function_compose[OF X, of f]
   from X have "\<H>(X) = \<H>(f\<circ>X) + \<H>(X|f\<circ>X)" by (rule entropy_partition)
   then show "\<H>(f \<circ> X) \<le> \<H>(X)"
     by (simp only: conditional_entropy_nonneg [OF X fX] le_add_same_cancel1)
 qed
 
 corollary (in information_space) entropy_of_inj:
   assumes X: "simple_function M X" and inj: "inj_on f (X`space M)"
   shows "\<H>(f \<circ> X) = \<H>(X)"
 proof (rule antisym)
   show "\<H>(f \<circ> X) \<le> \<H>(X)" using entropy_data_processing[OF X] .
 next
   have sf: "simple_function M (f \<circ> X)"
     using X by auto
   have "\<H>(X) = \<H>(the_inv_into (X`space M) f \<circ> (f \<circ> X))"
     unfolding o_assoc
     apply (subst entropy_simple_distributed[OF simple_distributedI[OF X measure_nonneg refl]])
     apply (subst entropy_simple_distributed[OF simple_distributedI[OF simple_function_compose[OF X]], where f="\<lambda>x. prob (X -` {x} \<inter> space M)"])
     apply (auto intro!: sum.cong arg_cong[where f=prob] image_eqI simp: the_inv_into_f_f[OF inj] comp_def measure_nonneg)
     done
   also have "... \<le> \<H>(f \<circ> X)"
     using entropy_data_processing[OF sf] .
   finally show "\<H>(X) \<le> \<H>(f \<circ> X)" .
 qed
 
 end
diff --git a/src/HOL/Probability/Levy.thy b/src/HOL/Probability/Levy.thy
--- a/src/HOL/Probability/Levy.thy
+++ b/src/HOL/Probability/Levy.thy
@@ -1,527 +1,529 @@
 (*  Title:     HOL/Probability/Levy.thy
     Authors:   Jeremy Avigad (CMU)
 *)
 
 section \<open>The Levy inversion theorem, and the Levy continuity theorem.\<close>
 
 theory Levy
   imports Characteristic_Functions Helly_Selection Sinc_Integral
 begin
 
 subsection \<open>The Levy inversion theorem\<close>
 
 (* Actually, this is not needed for us -- but it is useful for other purposes. (See Billingsley.) *)
 lemma Levy_Inversion_aux1:
   fixes a b :: real
   assumes "a \<le> b"
   shows "((\<lambda>t. (iexp (-(t * a)) - iexp (-(t * b))) / (\<i> * t)) \<longlongrightarrow> b - a) (at 0)"
     (is "(?F \<longlongrightarrow> _) (at _)")
 proof -
   have 1: "cmod (?F t - (b - a)) \<le> a^2 / 2 * abs t + b^2 / 2 * abs t" if "t \<noteq> 0" for t
   proof -
     have "cmod (?F t - (b - a)) = cmod (
         (iexp (-(t * a)) - (1 + \<i> * -(t * a))) / (\<i> * t) -
         (iexp (-(t * b)) - (1 + \<i> * -(t * b))) / (\<i> * t))"
            (is "_ = cmod (?one / (\<i> * t) - ?two / (\<i> * t))")
       using \<open>t \<noteq> 0\<close> by (intro arg_cong[where f=norm]) (simp add: field_simps)
     also have "\<dots> \<le> cmod (?one / (\<i> * t)) + cmod (?two / (\<i> * t))"
       by (rule norm_triangle_ineq4)
     also have "cmod (?one / (\<i> * t)) = cmod ?one / abs t"
       by (simp add: norm_divide norm_mult)
     also have "cmod (?two / (\<i> * t)) = cmod ?two / abs t"
       by (simp add: norm_divide norm_mult)
     also have "cmod ?one / abs t + cmod ?two / abs t \<le>
         ((- (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
     also have "\<dots> = a^2 / 2 * abs t + b^2 / 2 * abs t"
       using \<open>t \<noteq> 0\<close> apply (case_tac "t \<ge> 0", simp add: field_simps power2_eq_square)
       using \<open>t \<noteq> 0\<close> by (subst (1 2) abs_of_neg, auto simp add: field_simps power2_eq_square)
     finally show "cmod (?F t - (b - a)) \<le> a^2 / 2 * abs t + b^2 / 2 * abs t" .
   qed
   show ?thesis
     apply (rule LIM_zero_cancel)
     apply (rule tendsto_norm_zero_cancel)
     apply (rule real_LIM_sandwich_zero [OF _ _ 1])
     apply (auto intro!: tendsto_eq_intros)
     done
 qed
 
 lemma Levy_Inversion_aux2:
   fixes a b t :: real
   assumes "a \<le> b" and "t \<noteq> 0"
   shows "cmod ((iexp (t * b) - iexp (t * a)) / (\<i> * t)) \<le> b - a" (is "?F \<le> _")
 proof -
   have "?F = cmod (iexp (t * a) * (iexp (t * (b - a)) - 1) / (\<i> * t))"
     using \<open>t \<noteq> 0\<close> by (intro arg_cong[where f=norm]) (simp add: field_simps exp_diff exp_minus)
   also have "\<dots> = cmod (iexp (t * (b - a)) - 1) / abs t"
     unfolding norm_divide norm_mult norm_exp_i_times using \<open>t \<noteq> 0\<close>
     by (simp add: complex_eq_iff norm_mult)
   also have "\<dots> \<le> abs (t * (b - a)) / abs t"
     using iexp_approx1 [of "t * (b - a)" 0]
     by (intro divide_right_mono) (auto simp add: field_simps eval_nat_numeral)
   also have "\<dots> = b - a"
     using assms by (auto simp add: abs_mult)
   finally show ?thesis .
 qed
 
 (* TODO: refactor! *)
 theorem (in real_distribution) Levy_Inversion:
   fixes a b :: real
   assumes "a \<le> b"
   defines "\<mu> \<equiv> measure M" and "\<phi> \<equiv> char M"
   assumes "\<mu> {a} = 0" and "\<mu> {b} = 0"
   shows "(\<lambda>T. 1 / (2 * pi) * (CLBINT t=-T..T. (iexp (-(t * a)) - iexp (-(t * b))) / (\<i> * t) * \<phi> t))
     \<longlonglongrightarrow> \<mu> {a<..b}"
     (is "(\<lambda>T. 1 / (2 * pi) * (CLBINT t=-T..T. ?F t * \<phi> t)) \<longlonglongrightarrow> of_real (\<mu> {a<..b})")
 proof -
   interpret P: pair_sigma_finite lborel M ..
   from bounded_Si obtain B where Bprop: "\<And>T. abs (Si T) \<le> B" by auto
   from Bprop [of 0] have [simp]: "B \<ge> 0" by auto
   let ?f = "\<lambda>t x :: real. (iexp (t * (x - a)) - iexp(t * (x - b))) / (\<i> * t)"
   { fix T :: real
     assume "T \<ge> 0"
     let ?f' = "\<lambda>(t, x). indicator {-T<..<T} t *\<^sub>R ?f t x"
     { fix x
       have 1: "complex_interval_lebesgue_integrable lborel u v (\<lambda>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)
         apply (intro integrableI_bounded_set_indicator[where B="b - a"] conjI impI)
         apply (auto intro!: AE_I [of _ _ "{0}"] simp: assms)
         done
       have "(CLBINT t. ?f' (t, x)) = (CLBINT t=-T..T. ?f t x)"
         using \<open>T \<ge> 0\<close> by (simp add: interval_lebesgue_integral_def set_lebesgue_integral_def)
       also have "\<dots> = (CLBINT t=-T..(0 :: real). ?f t x) + (CLBINT t=(0 :: real)..T. ?f t x)"
           (is "_ = _ + ?t")
         using 1 by (intro interval_integral_sum[symmetric]) (simp add: min_absorb1 max_absorb2 \<open>T \<ge> 0\<close>)
       also have "(CLBINT t=-T..(0 :: real). ?f t x) = (CLBINT t=(0::real)..T. ?f (-t) x)"
         by (subst interval_integral_reflect) auto
       also have "\<dots> + ?t = (CLBINT t=(0::real)..T. ?f (-t) x + ?f t x)"
         using 1
         by (intro interval_lebesgue_integral_add(2) [symmetric] interval_integrable_mirror[THEN iffD2]) simp_all
       also have "\<dots> = (CLBINT t=(0::real)..T. ((iexp(t * (x - a)) - iexp (-(t * (x - a)))) -
           (iexp(t * (x - b)) - iexp (-(t * (x - b))))) / (\<i> * t))"
         using \<open>T \<ge> 0\<close> by (intro interval_integral_cong) (auto simp add: field_split_simps)
       also have "\<dots> = (CLBINT t=(0::real)..T. complex_of_real(
           2 * (sin (t * (x - a)) / t) - 2 * (sin (t * (x - b)) / t)))"
         using \<open>T \<ge> 0\<close>
         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
       also have "\<dots> = 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 "\<dots> = 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 \<open>T \<ge> 0\<close>])
         done
       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
     have "(CLBINT t=-T..T. ?F t * \<phi> t) =
       (CLBINT t. (CLINT x | M. ?F t * iexp (t * x) * indicator {-T<..<T} t))"
       using \<open>T \<ge> 0\<close> unfolding \<phi>_def char_def interval_lebesgue_integral_def set_lebesgue_integral_def
       by (auto split: split_indicator intro!: Bochner_Integration.integral_cong)
     also have "\<dots> = (CLBINT t. (CLINT x | M. ?f' (t, x)))"
       by (auto intro!: Bochner_Integration.integral_cong simp: field_simps exp_diff exp_minus split: split_indicator)
     also have "\<dots> = (CLINT x | M. (CLBINT t. ?f' (t, x)))"
     proof (intro P.Fubini_integral [symmetric] integrableI_bounded_set [where B="b - a"])
       show "emeasure (lborel \<Otimes>\<^sub>M M) ({- T<..<T} \<times> space M) < \<infinity>"
         using \<open>T \<ge> 0\<close>
         by (subst emeasure_pair_measure_Times)
            (auto simp: ennreal_mult_less_top not_less top_unique)
       show "AE x\<in>{- T<..<T} \<times> space M in lborel \<Otimes>\<^sub>M M. cmod (case x of (t, x) \<Rightarrow> ?f' (t, x)) \<le> b - a"
         using Levy_Inversion_aux2[of "x - b" "x - a" for x] \<open>a \<le> b\<close>
         by (intro AE_I [of _ _ "{0} \<times> UNIV"]) (force simp: emeasure_pair_measure_Times)+
     qed (auto split: split_indicator split_indicator_asm)
     also have "\<dots> = (CLINT x | M. (complex_of_real (2 * (sgn (x - a) *
          Si (T * abs (x - a)) - sgn (x - b) * Si (T * abs (x - b))))))"
        using main_eq by (intro Bochner_Integration.integral_cong, auto)
     also have "\<dots> = complex_of_real (LINT x | M. (2 * (sgn (x - a) *
          Si (T * abs (x - a)) - sgn (x - b) * Si (T * abs (x - b)))))"
        by (rule integral_complex_of_real)
     finally have "(CLBINT t=-T..T. ?F t * \<phi> t) =
         complex_of_real (LINT x | M. (2 * (sgn (x - a) *
          Si (T * abs (x - a)) - sgn (x - b) * Si (T * abs (x - b)))))" .
   } note main_eq2 = this
 
   have "(\<lambda>T :: nat. LINT x | M. (2 * (sgn (x - a) *
          Si (T * abs (x - a)) - sgn (x - b) * Si (T * abs (x - b))))) \<longlonglongrightarrow>
        (LINT x | M. 2 * pi * indicator {a<..b} x)"
   proof (rule integral_dominated_convergence [where w="\<lambda>x. 4 * B"])
     show "integrable M (\<lambda>x. 4 * B)"
       by (rule integrable_const_bound [of _ "4 * B"]) auto
   next
     let ?S = "\<lambda>n::nat. \<lambda>x. sgn (x - a) * Si (n * \<bar>x - a\<bar>) - sgn (x - b) * Si (n * \<bar>x - b\<bar>)"
     { fix n x
       have "norm (?S n x) \<le> norm (sgn (x - a) * Si (n * \<bar>x - a\<bar>)) + norm (sgn (x - b) * Si (n * \<bar>x - b\<bar>))"
         by (rule norm_triangle_ineq4)
       also have "\<dots> \<le> B + B"
         using Bprop by (intro add_mono) (auto simp: abs_mult abs_sgn_eq)
       finally have "norm (2 * ?S n x) \<le> 4 * B"
         by simp }
     then show "\<And>n. AE x in M. norm (2 * ?S n x) \<le> 4 * B"
       by auto
     have "AE x in M. x \<noteq> a" "AE x in M. x \<noteq> b"
       using prob_eq_0[of "{a}"] prob_eq_0[of "{b}"] \<open>\<mu> {a} = 0\<close> \<open>\<mu> {b} = 0\<close> by (auto simp: \<mu>_def)
     then show "AE x in M. (\<lambda>n. 2 * ?S n x) \<longlonglongrightarrow> 2 * pi * indicator {a<..b} x"
     proof eventually_elim
       fix x assume x: "x \<noteq> a" "x \<noteq> b"
       then have "(\<lambda>n. 2 * (sgn (x - a) * Si (\<bar>x - a\<bar> * n) - sgn (x - b) * Si (\<bar>x - b\<bar> * n)))
           \<longlonglongrightarrow> 2 * (sgn (x - a) * (pi / 2) - sgn (x - b) * (pi / 2))"
         by (intro tendsto_intros filterlim_compose[OF Si_at_top]
             filterlim_tendsto_pos_mult_at_top[OF tendsto_const] filterlim_real_sequentially)
            auto
       also have "(\<lambda>n. 2 * (sgn (x - a) * Si (\<bar>x - a\<bar> * n) - sgn (x - b) * Si (\<bar>x - b\<bar> * n))) = (\<lambda>n. 2 * ?S n x)"
         by (auto simp: ac_simps)
       also have "2 * (sgn (x - a) * (pi / 2) - sgn (x - b) * (pi / 2)) = 2 * pi * indicator {a<..b} x"
         using x \<open>a \<le> b\<close> by (auto split: split_indicator)
       finally show "(\<lambda>n. 2 * ?S n x) \<longlonglongrightarrow> 2 * pi * indicator {a<..b} x" .
     qed
   qed simp_all
   also have "(LINT x | M. 2 * pi * indicator {a<..b} x) = 2 * pi * \<mu> {a<..b}"
     by (simp add: \<mu>_def)
   finally have "(\<lambda>T. LINT x | M. (2 * (sgn (x - a) *
          Si (T * abs (x - a)) - sgn (x - b) * Si (T * abs (x - b))))) \<longlonglongrightarrow>
        2 * pi * \<mu> {a<..b}" .
   with main_eq2 show ?thesis
     by (auto intro!: tendsto_eq_intros)
 qed
 
 theorem Levy_uniqueness:
   fixes M1 M2 :: "real measure"
   assumes "real_distribution M1" "real_distribution M2" and
     "char M1 = char M2"
   shows "M1 = M2"
 proof -
   interpret M1: real_distribution M1 by (rule assms)
   interpret M2: real_distribution M2 by (rule assms)
   have "countable ({x. measure M1 {x} \<noteq> 0} \<union> {x. measure M2 {x} \<noteq> 0})"
     by (intro countable_Un M2.countable_support M1.countable_support)
   then have count: "countable {x. measure M1 {x} \<noteq> 0 \<or> measure M2 {x} \<noteq> 0}"
     by (simp add: Un_def)
 
   have "cdf M1 = cdf M2"
   proof (rule ext)
     fix x
     let ?D = "\<lambda>x. \<bar>cdf M1 x - cdf M2 x\<bar>"
 
     { fix \<epsilon> :: real
       assume "\<epsilon> > 0"
       have "(?D \<longlongrightarrow> 0) at_bot"
         using M1.cdf_lim_at_bot M2.cdf_lim_at_bot by (intro tendsto_eq_intros) auto
       then have "eventually (\<lambda>y. ?D y < \<epsilon> / 2 \<and> y \<le> x) at_bot"
         using \<open>\<epsilon> > 0\<close> by (simp only: tendsto_iff dist_real_def diff_0_right eventually_conj eventually_le_at_bot abs_idempotent)
       then obtain M where "\<And>y. y \<le> M \<Longrightarrow> ?D y < \<epsilon> / 2" "M \<le> x"
         unfolding eventually_at_bot_linorder by auto
       with open_minus_countable[OF count, of "{..< M}"] obtain a where
         "measure M1 {a} = 0" "measure M2 {a} = 0" "a < M" "a \<le> x" and 1: "?D a < \<epsilon> / 2"
         by auto
 
       have "(?D \<longlongrightarrow> ?D x) (at_right x)"
         using M1.cdf_is_right_cont [of x] M2.cdf_is_right_cont [of x]
         by (intro tendsto_intros) (auto simp add: continuous_within)
       then have "eventually (\<lambda>y. \<bar>?D y - ?D x\<bar> < \<epsilon> / 2) (at_right x)"
         using \<open>\<epsilon> > 0\<close> by (simp only: tendsto_iff dist_real_def eventually_conj eventually_at_right_less)
       then obtain N where "N > x" "\<And>y. x < y \<Longrightarrow> y < N \<Longrightarrow> \<bar>?D y - ?D x\<bar> < \<epsilon> / 2"
         by (auto simp add: eventually_at_right[OF less_add_one])
       with open_minus_countable[OF count, of "{x <..< N}"] obtain b where "x < b" "b < N"
           "measure M1 {b} = 0" "measure M2 {b} = 0" and 2: "\<bar>?D b - ?D x\<bar> < \<epsilon> / 2"
         by (auto simp: abs_minus_commute)
       from \<open>a \<le> x\<close> \<open>x < b\<close> have "a < b" "a \<le> b" by auto
 
       from \<open>char M1 = char M2\<close>
         M1.Levy_Inversion [OF \<open>a \<le> b\<close> \<open>measure M1 {a} = 0\<close> \<open>measure M1 {b} = 0\<close>]
         M2.Levy_Inversion [OF \<open>a \<le> b\<close> \<open>measure M2 {a} = 0\<close> \<open>measure M2 {b} = 0\<close>]
       have "complex_of_real (measure M1 {a<..b}) = complex_of_real (measure M2 {a<..b})"
         by (intro LIMSEQ_unique) auto
       then have "?D a = ?D b"
         unfolding of_real_eq_iff M1.cdf_diff_eq [OF \<open>a < b\<close>, symmetric] M2.cdf_diff_eq [OF \<open>a < b\<close>, symmetric] by simp
       then have "?D x = \<bar>(?D b - ?D x) - ?D a\<bar>"
         by simp
       also have "\<dots> \<le> \<bar>?D b - ?D x\<bar> + \<bar>?D a\<bar>"
         by (rule abs_triangle_ineq4)
       also have "\<dots> \<le> \<epsilon> / 2 + \<epsilon> / 2"
         using 1 2 by (intro add_mono) auto
       finally have "?D x \<le> \<epsilon>" by simp }
     then show "cdf M1 x = cdf M2 x"
       by (metis abs_le_zero_iff dense_ge eq_iff_diff_eq_0)
   qed
   thus ?thesis
     by (rule cdf_unique [OF \<open>real_distribution M1\<close> \<open>real_distribution M2\<close>])
 qed
 
 
 subsection \<open>The Levy continuity theorem\<close>
 
 theorem levy_continuity1:
   fixes M :: "nat \<Rightarrow> real measure" and M' :: "real measure"
   assumes "\<And>n. real_distribution (M n)" "real_distribution M'" "weak_conv_m M M'"
   shows "(\<lambda>n. char (M n) t) \<longlonglongrightarrow> char M' t"
   unfolding char_def using assms by (rule weak_conv_imp_integral_bdd_continuous_conv) auto
 
 theorem levy_continuity:
   fixes M :: "nat \<Rightarrow> real measure" and M' :: "real measure"
   assumes real_distr_M : "\<And>n. real_distribution (M n)"
     and real_distr_M': "real_distribution M'"
     and char_conv: "\<And>t. (\<lambda>n. char (M n) t) \<longlonglongrightarrow> char M' t"
   shows "weak_conv_m M M'"
 proof -
   interpret Mn: real_distribution "M n" for n by fact
   interpret M': real_distribution M' by fact
 
   have *: "\<And>u x. u > 0 \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> (CLBINT t:{-u..u}. 1 - iexp (t * x)) =
       2 * (u  - sin (u * x) / x)"
   proof -
     fix u :: real and x :: real
     assume "u > 0" and "x \<noteq> 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 "\<dots> = (CLBINT t=-u..0. 1 - iexp (t * x)) + (CLBINT t=0..u. 1 - iexp (t * x))"
       using \<open>u > 0\<close>
       apply (subst interval_integral_sum)
       apply (simp add: min_absorb1 min_absorb2 max_absorb1 max_absorb2)
       apply (rule interval_integrable_isCont)
       apply auto
       done
     also have "\<dots> = (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 "\<dots> = (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
     also have "\<dots> = 2 * u - 2 * sin (u * x) / x"
       by (subst interval_lebesgue_integral_diff)
          (auto intro!: interval_integrable_isCont
                simp: interval_lebesgue_integral_of_real integral_cos [OF \<open>x \<noteq> 0\<close>] mult.commute[of _ x])
     finally show "(CLBINT t:{-u..u}. 1 - iexp (t * x)) = 2 * (u  - sin (u * x) / x)"
       by (simp add: field_simps)
   qed
   have main_bound: "\<And>u n. u > 0 \<Longrightarrow> Re (CLBINT t:{-u..u}. 1 - char (M n) t) \<ge>
     u * measure (M n) {x. abs x \<ge> 2 / u}"
   proof -
     fix u :: real and n
     assume "u > 0"
     interpret P: pair_sigma_finite "M n" lborel ..
     (* TODO: put this in the real_distribution locale as a simp rule? *)
     have Mn1 [simp]: "measure (M n) UNIV = 1" by (metis Mn.prob_space Mn.space_eq_univ)
     (* TODO: make this automatic somehow? *)
     have Mn2 [simp]: "\<And>x. complex_integrable (M n) (\<lambda>t. exp (\<i> * complex_of_real (x * t)))"
       by (rule Mn.integrable_const_bound [where B = 1], auto)
     have Mn3: "set_integrable (M n \<Otimes>\<^sub>M lborel) (UNIV \<times> {- u..u}) (\<lambda>a. 1 - exp (\<i> * complex_of_real (snd a * fst a)))"
       using \<open>0 < u\<close>
       unfolding set_integrable_def
       by (intro integrableI_bounded_set_indicator [where B="2"])
          (auto simp: lborel.emeasure_pair_measure_Times ennreal_mult_less_top not_less top_unique
                split: split_indicator
                intro!: order_trans [OF norm_triangle_ineq4])
     have "(CLBINT t:{-u..u}. 1 - char (M n) t) =
         (CLBINT t:{-u..u}. (CLINT x | M n. 1 - iexp (t * x)))"
       unfolding char_def by (rule set_lebesgue_integral_cong, auto simp del: of_real_mult)
     also have "\<dots> = (CLBINT t. (CLINT x | M n. indicator {-u..u} t *\<^sub>R (1 - iexp (t * x))))"
       unfolding set_lebesgue_integral_def
       by (rule Bochner_Integration.integral_cong) (auto split: split_indicator)
     also have "\<dots> = (CLINT x | M n. (CLBINT t:{-u..u}. 1 - iexp (t * x)))"
       using Mn3 by (subst P.Fubini_integral) (auto simp: indicator_times split_beta' set_integrable_def set_lebesgue_integral_def)
     also have "\<dots> = (CLINT x | M n. (if x = 0 then 0 else 2 * (u  - sin (u * x) / x)))"
       using \<open>u > 0\<close> by (intro Bochner_Integration.integral_cong, auto simp add: * simp del: of_real_mult)
     also have "\<dots> = (LINT x | M n. (if x = 0 then 0 else 2 * (u  - sin (u * x) / x)))"
       by (rule integral_complex_of_real)
     finally have "Re (CLBINT t:{-u..u}. 1 - char (M n) t) =
        (LINT x | M n. (if x = 0 then 0 else 2 * (u  - sin (u * x) / x)))" by simp
     also have "\<dots> \<ge> (LINT x : {x. abs x \<ge> 2 / u} | M n. u)"
     proof -
       have "complex_integrable (M n) (\<lambda>x. CLBINT t:{-u..u}. 1 - iexp (snd (x, t) * fst (x, t)))"
         using Mn3 unfolding set_integrable_def set_lebesgue_integral_def
         by (intro P.integrable_fst) (simp add: indicator_times split_beta')
       hence "complex_integrable (M n) (\<lambda>x. if x = 0 then 0 else 2 * (u  - sin (u * x) / x))"
         using \<open>u > 0\<close>
         unfolding set_integrable_def
         by (subst integrable_cong) (auto simp add: * simp del: of_real_mult)
       hence **: "integrable (M n) (\<lambda>x. if x = 0 then 0 else 2 * (u  - sin (u * x) / x))"
         unfolding complex_of_real_integrable_eq .
       have "2 * sin x \<le> x" if "2 \<le> x" for x :: real
         by (rule order_trans[OF _ \<open>2 \<le> x\<close>]) auto
       moreover have "x \<le> 2 * sin x" if "x \<le> - 2" for x :: real
         by (rule order_trans[OF \<open>x \<le> - 2\<close>]) auto
       moreover have "x < 0 \<Longrightarrow> x \<le> sin x" for x :: real
         using sin_x_le_x[of "-x"] by simp
       ultimately show ?thesis
         using \<open>u > 0\<close> unfolding set_lebesgue_integral_def
         by (intro integral_mono [OF _ **])
            (auto simp: divide_simps sin_x_le_x mult.commute[of u] mult_neg_pos top_unique less_top[symmetric]
                  split: split_indicator)
     qed
     also (xtrans) have "(LINT x : {x. abs x \<ge> 2 / u} | M n. u) = u * measure (M n) {x. abs x \<ge> 2 / u}"
       unfolding set_lebesgue_integral_def
       by (simp add: Mn.emeasure_eq_measure)
     finally show "Re (CLBINT t:{-u..u}. 1 - char (M n) t) \<ge> u * measure (M n) {x. abs x \<ge> 2 / u}" .
   qed
 
   have tight_aux: "\<And>\<epsilon>. \<epsilon> > 0 \<Longrightarrow> \<exists>a b. a < b \<and> (\<forall>n. 1 - \<epsilon> < measure (M n) {a<..b})"
   proof -
     fix \<epsilon> :: real
     assume "\<epsilon> > 0"
     note M'.isCont_char [of 0]
     hence "\<exists>d>0. \<forall>t. abs t < d \<longrightarrow> cmod (char M' t - 1) < \<epsilon> / 4"
       apply (subst (asm) continuous_at_eps_delta)
       apply (drule_tac x = "\<epsilon> / 4" in spec)
       using \<open>\<epsilon> > 0\<close> by (auto simp add: dist_real_def dist_complex_def M'.char_zero)
     then obtain d where "d > 0 \<and> (\<forall>t. (abs t < d \<longrightarrow> cmod (char M' t - 1) < \<epsilon> / 4))" ..
     hence d0: "d > 0" and d1: "\<And>t. abs t < d \<Longrightarrow> cmod (char M' t - 1) < \<epsilon> / 4" by auto
     have 1: "\<And>x. cmod (1 - char M' x) \<le> 2"
       by (rule order_trans [OF norm_triangle_ineq4], auto simp add: M'.cmod_char_le_1)
     then have 2: "\<And>u v. complex_set_integrable lborel {u..v} (\<lambda>x. 1 - char M' x)"
       unfolding set_integrable_def
       by (intro integrableI_bounded_set_indicator[where B=2]) (auto simp: emeasure_lborel_Icc_eq)
     have 3: "\<And>u v. integrable lborel (\<lambda>x. indicat_real {u..v} x *\<^sub>R cmod (1 - char M' x))"
       by (intro borel_integrable_compact[OF compact_Icc] continuous_at_imp_continuous_on
                 continuous_intros ballI M'.isCont_char continuous_intros)
     have "cmod (CLBINT t:{-d/2..d/2}. 1 - char M' t) \<le> LBINT t:{-d/2..d/2}. cmod (1 - char M' t)"
       unfolding set_lebesgue_integral_def
       using integral_norm_bound[of _ "\<lambda>x. indicator {u..v} x *\<^sub>R (1 - char M' x)" for u v] by simp
     also have 4: "\<dots> \<le> LBINT t:{-d/2..d/2}. \<epsilon> / 4"
       unfolding set_lebesgue_integral_def
       apply (rule integral_mono [OF 3])
        apply (simp add: emeasure_lborel_Icc_eq)
       apply (case_tac "x \<in> {-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
     also from d0 4 have "\<dots> = d * \<epsilon> / 4"
       unfolding set_lebesgue_integral_def by simp
     finally have bound: "cmod (CLBINT t:{-d/2..d/2}. 1 - char M' t) \<le> d * \<epsilon> / 4" .
     have "cmod (1 - char (M n) x) \<le> 2" for n x
       by (rule order_trans [OF norm_triangle_ineq4], auto simp add: Mn.cmod_char_le_1)
     then have "(\<lambda>n. CLBINT t:{-d/2..d/2}. 1 - char (M n) t) \<longlonglongrightarrow> (CLBINT t:{-d/2..d/2}. 1 - char M' t)"
       unfolding set_lebesgue_integral_def
       apply (intro integral_dominated_convergence[where w="\<lambda>x. indicator {-d/2..d/2} x *\<^sub>R 2"])
       apply (auto intro!: char_conv tendsto_intros
                   simp: emeasure_lborel_Icc_eq
                   split: split_indicator)
       done
     hence "eventually (\<lambda>n. cmod ((CLBINT t:{-d/2..d/2}. 1 - char (M n) t) -
         (CLBINT t:{-d/2..d/2}. 1 - char M' t)) < d * \<epsilon> / 4) sequentially"
       using d0 \<open>\<epsilon> > 0\<close> apply (subst (asm) tendsto_iff)
       by (subst (asm) dist_complex_def, drule spec, erule mp, auto)
     hence "\<exists>N. \<forall>n \<ge> N. cmod ((CLBINT t:{-d/2..d/2}. 1 - char (M n) t) -
         (CLBINT t:{-d/2..d/2}. 1 - char M' t)) < d * \<epsilon> / 4" by (simp add: eventually_sequentially)
-    then guess N ..
+    then obtain N
+      where "\<forall>n\<ge>N. cmod ((CLBINT t:{- d / 2..d / 2}. 1 - char (M n) t) -
+        (CLBINT t:{- d / 2..d / 2}. 1 - char M' t)) < d * \<epsilon> / 4" ..
     hence N: "\<And>n. n \<ge> N \<Longrightarrow> cmod ((CLBINT t:{-d/2..d/2}. 1 - char (M n) t) -
         (CLBINT t:{-d/2..d/2}. 1 - char M' t)) < d * \<epsilon> / 4" by auto
     { fix n
       assume "n \<ge> N"
       have "cmod (CLBINT t:{-d/2..d/2}. 1 - char (M n) t) =
         cmod ((CLBINT t:{-d/2..d/2}. 1 - char (M n) t) - (CLBINT t:{-d/2..d/2}. 1 - char M' t)
           + (CLBINT t:{-d/2..d/2}. 1 - char M' t))" by simp
       also have "\<dots> \<le> cmod ((CLBINT t:{-d/2..d/2}. 1 - char (M n) t) -
           (CLBINT t:{-d/2..d/2}. 1 - char M' t)) + cmod(CLBINT t:{-d/2..d/2}. 1 - char M' t)"
         by (rule norm_triangle_ineq)
       also have "\<dots> < d * \<epsilon> / 4 + d * \<epsilon> / 4"
         by (rule add_less_le_mono [OF N [OF \<open>n \<ge> N\<close>] bound])
       also have "\<dots> = d * \<epsilon> / 2" by auto
       finally have "cmod (CLBINT t:{-d/2..d/2}. 1 - char (M n) t) < d * \<epsilon> / 2" .
       hence "d * \<epsilon> / 2 > Re (CLBINT t:{-d/2..d/2}. 1 - char (M n) t)"
         by (rule order_le_less_trans [OF complex_Re_le_cmod])
       hence "d * \<epsilon> / 2 > Re (CLBINT t:{-(d/2)..d/2}. 1 - char (M n) t)" (is "_ > ?lhs") by simp
       also have "?lhs \<ge> (d / 2) * measure (M n) {x. abs x \<ge> 2 / (d / 2)}"
         using d0 by (intro main_bound, simp)
       finally (xtrans) have "d * \<epsilon> / 2 > (d / 2) * measure (M n) {x. abs x \<ge> 2 / (d / 2)}" .
       with d0 \<open>\<epsilon> > 0\<close> have "\<epsilon> > measure (M n) {x. abs x \<ge> 2 / (d / 2)}" by (simp add: field_simps)
       hence "\<epsilon> > 1 - measure (M n) (UNIV - {x. abs x \<ge> 2 / (d / 2)})"
         apply (subst Mn.borel_UNIV [symmetric])
         by (subst Mn.prob_compl, auto)
       also have "UNIV - {x. abs x \<ge> 2 / (d / 2)} = {x. -(4 / d) < x \<and> x < (4 / d)}"
         using d0 apply (auto simp add: field_simps)
         (* very annoying -- this should be automatic *)
         apply (case_tac "x \<ge> 0", auto simp add: field_simps)
         apply (subgoal_tac "0 \<le> x * d", arith, rule mult_nonneg_nonneg, auto)
         apply (case_tac "x \<ge> 0", auto simp add: field_simps)
         apply (subgoal_tac "x * d \<le> 0", arith)
         apply (rule mult_nonpos_nonneg, auto)
         by (case_tac "x \<ge> 0", auto simp add: field_simps)
       finally have "measure (M n) {x. -(4 / d) < x \<and> x < (4 / d)} > 1 - \<epsilon>"
         by auto
     } note 6 = this
     { fix n :: nat
       have *: "(UN (k :: nat). {- real k<..real k}) = UNIV"
         by (auto, metis leI le_less_trans less_imp_le minus_less_iff reals_Archimedean2)
       have "(\<lambda>k. measure (M n) {- real k<..real k}) \<longlonglongrightarrow>
           measure (M n) (UN (k :: nat). {- real k<..real k})"
         by (rule Mn.finite_Lim_measure_incseq, auto simp add: incseq_def)
       hence "(\<lambda>k. measure (M n) {- real k<..real k}) \<longlonglongrightarrow> 1"
         using Mn.prob_space unfolding * Mn.borel_UNIV by simp
       hence "eventually (\<lambda>k. measure (M n) {- real k<..real k} > 1 - \<epsilon>) sequentially"
         apply (elim order_tendstoD (1))
         using \<open>\<epsilon> > 0\<close> by auto
     } note 7 = this
     { fix n :: nat
       have "eventually (\<lambda>k. \<forall>m < n. measure (M m) {- real k<..real k} > 1 - \<epsilon>) sequentially"
         (is "?P n")
       proof (induct n)
         case (Suc n) with 7[of n] show ?case
           by eventually_elim (auto simp add: less_Suc_eq)
       qed simp
     } note 8 = this
     from 8 [of N] have "\<exists>K :: nat. \<forall>k \<ge> K. \<forall>m<N. 1 - \<epsilon> <
         Sigma_Algebra.measure (M m) {- real k<..real k}"
       by (auto simp add: eventually_sequentially)
     hence "\<exists>K :: nat. \<forall>m<N. 1 - \<epsilon> < Sigma_Algebra.measure (M m) {- real K<..real K}" by auto
     then obtain K :: nat where
       "\<forall>m<N. 1 - \<epsilon> < Sigma_Algebra.measure (M m) {- real K<..real K}" ..
     hence K: "\<And>m. m < N \<Longrightarrow> 1 - \<epsilon> < Sigma_Algebra.measure (M m) {- real K<..real K}"
       by auto
     let ?K' = "max K (4 / d)"
     have "-?K' < ?K' \<and> (\<forall>n. 1 - \<epsilon> < measure (M n) {-?K'<..?K'})"
       using d0 apply auto
       apply (rule max.strict_coboundedI2, auto)
     proof -
       fix n
       show " 1 - \<epsilon> < 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)
     qed
     thus "\<exists>a b. a < b \<and> (\<forall>n. 1 - \<epsilon> < measure (M n) {a<..b})" by (intro exI)
   qed
   have tight: "tight M"
     by (auto simp: tight_def intro: assms tight_aux)
   show ?thesis
   proof (rule tight_subseq_weak_converge [OF real_distr_M real_distr_M' tight])
     fix s \<nu>
     assume s: "strict_mono (s :: nat \<Rightarrow> nat)"
     assume nu: "weak_conv_m (M \<circ> s) \<nu>"
     assume *: "real_distribution \<nu>"
     have 2: "\<And>n. real_distribution ((M \<circ> s) n)" unfolding comp_def by (rule assms)
     have 3: "\<And>t. (\<lambda>n. char ((M \<circ> s) n) t) \<longlonglongrightarrow> char \<nu> t" by (intro levy_continuity1 [OF 2 * nu])
     have 4: "\<And>t. (\<lambda>n. char ((M \<circ> s) n) t) = ((\<lambda>n. char (M n) t) \<circ> s)" by (rule ext, simp)
     have 5: "\<And>t. (\<lambda>n. char ((M \<circ> s) n) t) \<longlonglongrightarrow> char M' t"
       by (subst 4, rule LIMSEQ_subseq_LIMSEQ [OF _ s], rule assms)
     hence "char \<nu> = char M'" by (intro ext, intro LIMSEQ_unique [OF 3 5])
     hence "\<nu> = M'" by (rule Levy_uniqueness [OF * \<open>real_distribution M'\<close>])
     thus "weak_conv_m (M \<circ> s) M'"
       by (elim subst) (rule nu)
   qed
 qed
 
 end
diff --git a/src/HOL/Probability/Probability_Measure.thy b/src/HOL/Probability/Probability_Measure.thy
--- a/src/HOL/Probability/Probability_Measure.thy
+++ b/src/HOL/Probability/Probability_Measure.thy
@@ -1,1305 +1,1320 @@
 (*  Title:      HOL/Probability/Probability_Measure.thy
     Author:     Johannes Hölzl, TU München
     Author:     Armin Heller, TU München
 *)
 
 section \<open>Probability measure\<close>
 
 theory Probability_Measure
   imports "HOL-Analysis.Analysis"
 begin
 
 locale prob_space = finite_measure +
   assumes emeasure_space_1: "emeasure M (space M) = 1"
 
 lemma prob_spaceI[Pure.intro!]:
   assumes *: "emeasure M (space M) = 1"
   shows "prob_space M"
 proof -
   interpret finite_measure M
   proof
     show "emeasure M (space M) \<noteq> \<infinity>" using * by simp
   qed
   show "prob_space M" by standard fact
 qed
 
 lemma prob_space_imp_sigma_finite: "prob_space M \<Longrightarrow> sigma_finite_measure M"
   unfolding prob_space_def finite_measure_def by simp
 
 abbreviation (in prob_space) "events \<equiv> sets M"
 abbreviation (in prob_space) "prob \<equiv> measure M"
 abbreviation (in prob_space) "random_variable M' X \<equiv> X \<in> measurable M M'"
 abbreviation (in prob_space) "expectation \<equiv> integral\<^sup>L M"
 abbreviation (in prob_space) "variance X \<equiv> integral\<^sup>L M (\<lambda>x. (X x - expectation X)\<^sup>2)"
 
 lemma (in prob_space) finite_measure [simp]: "finite_measure M"
   by unfold_locales
 
 lemma (in prob_space) prob_space_distr:
   assumes f: "f \<in> measurable M M'" shows "prob_space (distr M M' f)"
 proof (rule prob_spaceI)
   have "f -` space M' \<inter> space M = space M" using f by (auto dest: measurable_space)
   with f show "emeasure (distr M M' f) (space (distr M M' f)) = 1"
     by (auto simp: emeasure_distr emeasure_space_1)
 qed
 
 lemma prob_space_distrD:
   assumes f: "f \<in> measurable M N" and M: "prob_space (distr M N f)" shows "prob_space M"
 proof
   interpret M: prob_space "distr M N f" by fact
   have "f -` space N \<inter> space M = space M"
     using f[THEN measurable_space] by auto
   then show "emeasure M (space M) = 1"
     using M.emeasure_space_1 by (simp add: emeasure_distr[OF f])
 qed
 
 lemma (in prob_space) prob_space: "prob (space M) = 1"
   using emeasure_space_1 unfolding measure_def by (simp add: one_ennreal.rep_eq)
 
 lemma (in prob_space) prob_le_1[simp, intro]: "prob A \<le> 1"
   using bounded_measure[of A] by (simp add: prob_space)
 
 lemma (in prob_space) not_empty: "space M \<noteq> {}"
   using prob_space by auto
 
 lemma (in prob_space) emeasure_eq_1_AE:
   "S \<in> sets M \<Longrightarrow> AE x in M. x \<in> S \<Longrightarrow> emeasure M S = 1"
   by (subst emeasure_eq_AE[where B="space M"]) (auto simp: emeasure_space_1)
 
 lemma (in prob_space) emeasure_le_1: "emeasure M S \<le> 1"
   unfolding ennreal_1[symmetric] emeasure_eq_measure by (subst ennreal_le_iff) auto
 
 lemma (in prob_space) emeasure_ge_1_iff: "emeasure M A \<ge> 1 \<longleftrightarrow> emeasure M A = 1"
   by (rule iffI, intro antisym emeasure_le_1) simp_all
 
 lemma (in prob_space) AE_iff_emeasure_eq_1:
   assumes [measurable]: "Measurable.pred M P"
   shows "(AE x in M. P x) \<longleftrightarrow> emeasure M {x\<in>space M. P x} = 1"
 proof -
   have *: "{x \<in> space M. \<not> P x} = space M - {x\<in>space M. P x}"
     by auto
   show ?thesis
     by (auto simp add: ennreal_minus_eq_0 * emeasure_compl emeasure_space_1 AE_iff_measurable[OF _ refl]
              intro: antisym emeasure_le_1)
 qed
 
 lemma (in prob_space) measure_le_1: "emeasure M X \<le> 1"
   using emeasure_space[of M X] by (simp add: emeasure_space_1)
 
 lemma (in prob_space) measure_ge_1_iff: "measure M A \<ge> 1 \<longleftrightarrow> measure M A = 1"
   by (auto intro!: antisym)
 
 lemma (in prob_space) AE_I_eq_1:
   assumes "emeasure M {x\<in>space M. P x} = 1" "{x\<in>space M. P x} \<in> sets M"
   shows "AE x in M. P x"
 proof (rule AE_I)
   show "emeasure M (space M - {x \<in> space M. P x}) = 0"
     using assms emeasure_space_1 by (simp add: emeasure_compl)
 qed (insert assms, auto)
 
 lemma prob_space_restrict_space:
   "S \<in> sets M \<Longrightarrow> emeasure M S = 1 \<Longrightarrow> prob_space (restrict_space M S)"
   by (intro prob_spaceI)
      (simp add: emeasure_restrict_space space_restrict_space)
 
 lemma (in prob_space) prob_compl:
   assumes A: "A \<in> events"
   shows "prob (space M - A) = 1 - prob A"
   using finite_measure_compl[OF A] by (simp add: prob_space)
 
 lemma (in prob_space) AE_in_set_eq_1:
   assumes A[measurable]: "A \<in> events" shows "(AE x in M. x \<in> A) \<longleftrightarrow> prob A = 1"
 proof -
   have *: "{x\<in>space M. x \<in> A} = A"
     using A[THEN sets.sets_into_space] by auto
   show ?thesis
     by (subst AE_iff_emeasure_eq_1) (auto simp: emeasure_eq_measure *)
 qed
 
 lemma (in prob_space) AE_False: "(AE x in M. False) \<longleftrightarrow> False"
 proof
   assume "AE x in M. False"
   then have "AE x in M. x \<in> {}" by simp
   then show False
     by (subst (asm) AE_in_set_eq_1) auto
 qed simp
 
 lemma (in prob_space) AE_prob_1:
   assumes "prob A = 1" shows "AE x in M. x \<in> A"
 proof -
   from \<open>prob A = 1\<close> have "A \<in> events"
     by (metis measure_notin_sets zero_neq_one)
   with AE_in_set_eq_1 assms show ?thesis by simp
 qed
 
 lemma (in prob_space) AE_const[simp]: "(AE x in M. P) \<longleftrightarrow> P"
   by (cases P) (auto simp: AE_False)
 
 lemma (in prob_space) ae_filter_bot: "ae_filter M \<noteq> bot"
   by (simp add: trivial_limit_def)
 
 lemma (in prob_space) AE_contr:
   assumes ae: "AE \<omega> in M. P \<omega>" "AE \<omega> in M. \<not> P \<omega>"
   shows False
 proof -
   from ae have "AE \<omega> in M. False" by eventually_elim auto
   then show False by auto
 qed
 
 lemma (in prob_space) integral_ge_const:
   fixes c :: real
   shows "integrable M f \<Longrightarrow> (AE x in M. c \<le> f x) \<Longrightarrow> c \<le> (\<integral>x. f x \<partial>M)"
   using integral_mono_AE[of M "\<lambda>x. c" f] prob_space by simp
 
 lemma (in prob_space) integral_le_const:
   fixes c :: real
   shows "integrable M f \<Longrightarrow> (AE x in M. f x \<le> c) \<Longrightarrow> (\<integral>x. f x \<partial>M) \<le> c"
   using integral_mono_AE[of M f "\<lambda>x. c"] prob_space by simp
 
 lemma (in prob_space) nn_integral_ge_const:
   "(AE x in M. c \<le> f x) \<Longrightarrow> c \<le> (\<integral>\<^sup>+x. f x \<partial>M)"
   using nn_integral_mono_AE[of "\<lambda>x. c" f M] emeasure_space_1
   by (simp split: if_split_asm)
 
 lemma (in prob_space) expectation_less:
   fixes X :: "_ \<Rightarrow> real"
   assumes [simp]: "integrable M X"
   assumes gt: "AE x in M. X x < b"
   shows "expectation X < b"
 proof -
   have "expectation X < expectation (\<lambda>x. b)"
     using gt emeasure_space_1
     by (intro integral_less_AE_space) auto
   then show ?thesis using prob_space by simp
 qed
 
 lemma (in prob_space) expectation_greater:
   fixes X :: "_ \<Rightarrow> real"
   assumes [simp]: "integrable M X"
   assumes gt: "AE x in M. a < X x"
   shows "a < expectation X"
 proof -
   have "expectation (\<lambda>x. a) < expectation X"
     using gt emeasure_space_1
     by (intro integral_less_AE_space) auto
   then show ?thesis using prob_space by simp
 qed
 
 lemma (in prob_space) jensens_inequality:
   fixes q :: "real \<Rightarrow> real"
   assumes X: "integrable M X" "AE x in M. X x \<in> I"
   assumes I: "I = {a <..< b} \<or> I = {a <..} \<or> I = {..< b} \<or> I = UNIV"
   assumes q: "integrable M (\<lambda>x. q (X x))" "convex_on I q"
   shows "q (expectation X) \<le> expectation (\<lambda>x. q (X x))"
 proof -
   let ?F = "\<lambda>x. Inf ((\<lambda>t. (q x - q t) / (x - t)) ` ({x<..} \<inter> I))"
   from X(2) AE_False have "I \<noteq> {}" by auto
 
   from I have "open I" by auto
 
   note I
   moreover
   { assume "I \<subseteq> {a <..}"
     with X have "a < expectation X"
       by (intro expectation_greater) auto }
   moreover
   { assume "I \<subseteq> {..< b}"
     with X have "expectation X < b"
       by (intro expectation_less) auto }
   ultimately have "expectation X \<in> I"
     by (elim disjE)  (auto simp: subset_eq)
   moreover
   { fix y assume y: "y \<in> I"
     with q(2) \<open>open I\<close> have "Sup ((\<lambda>x. q x + ?F x * (y - x)) ` I) = q y"
       by (auto intro!: cSup_eq_maximum convex_le_Inf_differential image_eqI [OF _ y] simp: interior_open) }
   ultimately have "q (expectation X) = Sup ((\<lambda>x. q x + ?F x * (expectation X - x)) ` I)"
     by simp
   also have "\<dots> \<le> expectation (\<lambda>w. q (X w))"
   proof (rule cSup_least)
     show "(\<lambda>x. q x + ?F x * (expectation X - x)) ` I \<noteq> {}"
       using \<open>I \<noteq> {}\<close> by auto
   next
     fix k assume "k \<in> (\<lambda>x. q x + ?F x * (expectation X - x)) ` I"
-    then guess x .. note x = this
+    then obtain x
+      where x: "k = q x + (INF t\<in>{x<..} \<inter> I. (q x - q t) / (x - t)) * (expectation X - x)" "x \<in> I" ..
     have "q x + ?F x * (expectation X  - x) = expectation (\<lambda>w. q x + ?F x * (X w - x))"
       using prob_space by (simp add: X)
     also have "\<dots> \<le> expectation (\<lambda>w. q (X w))"
       using \<open>x \<in> I\<close> \<open>open I\<close> X(2)
       apply (intro integral_mono_AE Bochner_Integration.integrable_add Bochner_Integration.integrable_mult_right Bochner_Integration.integrable_diff
                 integrable_const X q)
       apply (elim eventually_mono)
       apply (intro convex_le_Inf_differential)
       apply (auto simp: interior_open q)
       done
     finally show "k \<le> expectation (\<lambda>w. q (X w))" using x by auto
   qed
   finally show "q (expectation X) \<le> expectation (\<lambda>x. q (X x))" .
 qed
 
 subsection  \<open>Introduce binder for probability\<close>
 
 syntax
   "_prob" :: "pttrn \<Rightarrow> logic \<Rightarrow> logic \<Rightarrow> logic" (\<open>('\<P>'((/_ in _./ _)'))\<close>)
 
 translations
   "\<P>(x in M. P)" => "CONST measure M {x \<in> CONST space M. P}"
 
 print_translation \<open>
   let
     fun to_pattern (Const (\<^const_syntax>\<open>Pair\<close>, _) $ l $ r) =
       Syntax.const \<^const_syntax>\<open>Pair\<close> :: to_pattern l @ to_pattern r
     | to_pattern (t as (Const (\<^syntax_const>\<open>_bound\<close>, _)) $ _) = [t]
 
     fun mk_pattern ((t, n) :: xs) = mk_patterns n xs |>> curry list_comb t
     and mk_patterns 0 xs = ([], xs)
     | mk_patterns n xs =
       let
         val (t, xs') = mk_pattern xs
         val (ts, xs'') = mk_patterns (n - 1) xs'
       in
         (t :: ts, xs'')
       end
 
     fun unnest_tuples
       (Const (\<^syntax_const>\<open>_pattern\<close>, _) $
         t1 $
         (t as (Const (\<^syntax_const>\<open>_pattern\<close>, _) $ _ $ _)))
       = let
         val (_ $ t2 $ t3) = unnest_tuples t
       in
         Syntax.const \<^syntax_const>\<open>_pattern\<close> $
           unnest_tuples t1 $
           (Syntax.const \<^syntax_const>\<open>_patterns\<close> $ t2 $ t3)
       end
     | unnest_tuples pat = pat
 
     fun tr' [sig_alg, Const (\<^const_syntax>\<open>Collect\<close>, _) $ t] =
       let
         val bound_dummyT = Const (\<^syntax_const>\<open>_bound\<close>, dummyT)
 
         fun go pattern elem
           (Const (\<^const_syntax>\<open>conj\<close>, _) $
             (Const (\<^const_syntax>\<open>Set.member\<close>, _) $ elem' $ (Const (\<^const_syntax>\<open>space\<close>, _) $ sig_alg')) $
             u)
           = let
               val _ = if sig_alg aconv sig_alg' andalso to_pattern elem' = rev elem then () else raise Match;
               val (pat, rest) = mk_pattern (rev pattern);
               val _ = case rest of [] => () | _ => raise Match
             in
               Syntax.const \<^syntax_const>\<open>_prob\<close> $ unnest_tuples pat $ sig_alg $ u
             end
         | go pattern elem (Abs abs) =
             let
               val (x as (_ $ tx), t) = Syntax_Trans.atomic_abs_tr' abs
             in
               go ((x, 0) :: pattern) (bound_dummyT $ tx :: elem) t
             end
         | go pattern elem (Const (\<^const_syntax>\<open>case_prod\<close>, _) $ t) =
             go
               ((Syntax.const \<^syntax_const>\<open>_pattern\<close>, 2) :: pattern)
               (Syntax.const \<^const_syntax>\<open>Pair\<close> :: elem)
               t
       in
         go [] [] t
       end
   in
     [(\<^const_syntax>\<open>Sigma_Algebra.measure\<close>, K tr')]
   end
 \<close>
 
 definition
   "cond_prob M P Q = \<P>(\<omega> in M. P \<omega> \<and> Q \<omega>) / \<P>(\<omega> in M. Q \<omega>)"
 
 syntax
   "_conditional_prob" :: "pttrn \<Rightarrow> logic \<Rightarrow> logic \<Rightarrow> logic \<Rightarrow> logic" (\<open>('\<P>'(_ in _. _ \<bar>/ _'))\<close>)
 
 translations
   "\<P>(x in M. P \<bar> Q)" => "CONST cond_prob M (\<lambda>x. P) (\<lambda>x. Q)"
 
 lemma (in prob_space) AE_E_prob:
   assumes ae: "AE x in M. P x"
   obtains S where "S \<subseteq> {x \<in> space M. P x}" "S \<in> events" "prob S = 1"
 proof -
-  from ae[THEN AE_E] guess N .
+  from ae[THEN AE_E] obtain N
+    where "{x \<in> space M. \<not> P x} \<subseteq> N" "emeasure M N = 0" "N \<in> events" by auto
   then show thesis
     by (intro that[of "space M - N"])
        (auto simp: prob_compl prob_space emeasure_eq_measure measure_nonneg)
 qed
 
 lemma (in prob_space) prob_neg: "{x\<in>space M. P x} \<in> events \<Longrightarrow> \<P>(x in M. \<not> P x) = 1 - \<P>(x in M. P x)"
   by (auto intro!: arg_cong[where f=prob] simp add: prob_compl[symmetric])
 
 lemma (in prob_space) prob_eq_AE:
   "(AE x in M. P x \<longleftrightarrow> Q x) \<Longrightarrow> {x\<in>space M. P x} \<in> events \<Longrightarrow> {x\<in>space M. Q x} \<in> events \<Longrightarrow> \<P>(x in M. P x) = \<P>(x in M. Q x)"
   by (rule finite_measure_eq_AE) auto
 
 lemma (in prob_space) prob_eq_0_AE:
   assumes not: "AE x in M. \<not> P x" shows "\<P>(x in M. P x) = 0"
 proof cases
   assume "{x\<in>space M. P x} \<in> events"
   with not have "\<P>(x in M. P x) = \<P>(x in M. False)"
     by (intro prob_eq_AE) auto
   then show ?thesis by simp
 qed (simp add: measure_notin_sets)
 
 lemma (in prob_space) prob_Collect_eq_0:
   "{x \<in> space M. P x} \<in> sets M \<Longrightarrow> \<P>(x in M. P x) = 0 \<longleftrightarrow> (AE x in M. \<not> P x)"
   using AE_iff_measurable[OF _ refl, of M "\<lambda>x. \<not> P x"] by (simp add: emeasure_eq_measure measure_nonneg)
 
 lemma (in prob_space) prob_Collect_eq_1:
   "{x \<in> space M. P x} \<in> sets M \<Longrightarrow> \<P>(x in M. P x) = 1 \<longleftrightarrow> (AE x in M. P x)"
   using AE_in_set_eq_1[of "{x\<in>space M. P x}"] by simp
 
 lemma (in prob_space) prob_eq_0:
   "A \<in> sets M \<Longrightarrow> prob A = 0 \<longleftrightarrow> (AE x in M. x \<notin> A)"
   using AE_iff_measurable[OF _ refl, of M "\<lambda>x. x \<notin> A"]
   by (auto simp add: emeasure_eq_measure Int_def[symmetric] measure_nonneg)
 
 lemma (in prob_space) prob_eq_1:
   "A \<in> sets M \<Longrightarrow> prob A = 1 \<longleftrightarrow> (AE x in M. x \<in> A)"
   using AE_in_set_eq_1[of A] by simp
 
 lemma (in prob_space) prob_sums:
   assumes P: "\<And>n. {x\<in>space M. P n x} \<in> events"
   assumes Q: "{x\<in>space M. Q x} \<in> events"
   assumes ae: "AE x in M. (\<forall>n. P n x \<longrightarrow> Q x) \<and> (Q x \<longrightarrow> (\<exists>!n. P n x))"
   shows "(\<lambda>n. \<P>(x in M. P n x)) sums \<P>(x in M. Q x)"
 proof -
-  from ae[THEN AE_E_prob] guess S . note S = this
+  from ae[THEN AE_E_prob] obtain S
+    where S:
+      "S \<subseteq> {x \<in> space M. (\<forall>n. P n x \<longrightarrow> Q x) \<and> (Q x \<longrightarrow> (\<exists>!n. P n x))}"
+      "S \<in> events"
+      "prob S = 1"
+    by auto
   then have disj: "disjoint_family (\<lambda>n. {x\<in>space M. P n x} \<inter> S)"
     by (auto simp: disjoint_family_on_def)
   from S have ae_S:
     "AE x in M. x \<in> {x\<in>space M. Q x} \<longleftrightarrow> x \<in> (\<Union>n. {x\<in>space M. P n x} \<inter> S)"
     "\<And>n. AE x in M. x \<in> {x\<in>space M. P n x} \<longleftrightarrow> x \<in> {x\<in>space M. P n x} \<inter> S"
     using ae by (auto dest!: AE_prob_1)
   from ae_S have *:
     "\<P>(x in M. Q x) = prob (\<Union>n. {x\<in>space M. P n x} \<inter> S)"
     using P Q S by (intro finite_measure_eq_AE) auto
   from ae_S have **:
     "\<And>n. \<P>(x in M. P n x) = prob ({x\<in>space M. P n x} \<inter> S)"
     using P Q S by (intro finite_measure_eq_AE) auto
   show ?thesis
     unfolding * ** using S P disj
     by (intro finite_measure_UNION) auto
 qed
 
 lemma (in prob_space) prob_sum:
   assumes [simp, intro]: "finite I"
   assumes P: "\<And>n. n \<in> I \<Longrightarrow> {x\<in>space M. P n x} \<in> events"
   assumes Q: "{x\<in>space M. Q x} \<in> events"
   assumes ae: "AE x in M. (\<forall>n\<in>I. P n x \<longrightarrow> Q x) \<and> (Q x \<longrightarrow> (\<exists>!n\<in>I. P n x))"
   shows "\<P>(x in M. Q x) = (\<Sum>n\<in>I. \<P>(x in M. P n x))"
 proof -
-  from ae[THEN AE_E_prob] guess S . note S = this
+  from ae[THEN AE_E_prob] obtain S
+    where S:
+      "S \<subseteq> {x \<in> space M. (\<forall>n\<in>I. P n x \<longrightarrow> Q x) \<and> (Q x \<longrightarrow> (\<exists>!n. n \<in> I \<and> P n x))}"
+      "S \<in> events"
+      "prob S = 1"
+    by auto
   then have disj: "disjoint_family_on (\<lambda>n. {x\<in>space M. P n x} \<inter> S) I"
     by (auto simp: disjoint_family_on_def)
   from S have ae_S:
     "AE x in M. x \<in> {x\<in>space M. Q x} \<longleftrightarrow> x \<in> (\<Union>n\<in>I. {x\<in>space M. P n x} \<inter> S)"
     "\<And>n. n \<in> I \<Longrightarrow> AE x in M. x \<in> {x\<in>space M. P n x} \<longleftrightarrow> x \<in> {x\<in>space M. P n x} \<inter> S"
     using ae by (auto dest!: AE_prob_1)
   from ae_S have *:
     "\<P>(x in M. Q x) = prob (\<Union>n\<in>I. {x\<in>space M. P n x} \<inter> S)"
     using P Q S by (intro finite_measure_eq_AE) (auto intro!: sets.Int)
   from ae_S have **:
     "\<And>n. n \<in> I \<Longrightarrow> \<P>(x in M. P n x) = prob ({x\<in>space M. P n x} \<inter> S)"
     using P Q S by (intro finite_measure_eq_AE) auto
   show ?thesis
     using S P disj
     by (auto simp add: * ** simp del: UN_simps intro!: finite_measure_finite_Union)
 qed
 
 lemma (in prob_space) prob_EX_countable:
   assumes sets: "\<And>i. i \<in> I \<Longrightarrow> {x\<in>space M. P i x} \<in> sets M" and I: "countable I"
   assumes disj: "AE x in M. \<forall>i\<in>I. \<forall>j\<in>I. P i x \<longrightarrow> P j x \<longrightarrow> i = j"
   shows "\<P>(x in M. \<exists>i\<in>I. P i x) = (\<integral>\<^sup>+i. \<P>(x in M. P i x) \<partial>count_space I)"
 proof -
   let ?N= "\<lambda>x. \<exists>!i\<in>I. P i x"
   have "ennreal (\<P>(x in M. \<exists>i\<in>I. P i x)) = \<P>(x in M. (\<exists>i\<in>I. P i x \<and> ?N x))"
     unfolding ennreal_inj[OF measure_nonneg measure_nonneg]
   proof (rule prob_eq_AE)
     show "AE x in M. (\<exists>i\<in>I. P i x) = (\<exists>i\<in>I. P i x \<and> ?N x)"
       using disj by eventually_elim blast
   qed (auto intro!: sets.sets_Collect_countable_Ex' sets.sets_Collect_conj sets.sets_Collect_countable_Ex1' I sets)+
   also have "\<P>(x in M. (\<exists>i\<in>I. P i x \<and> ?N x)) = emeasure M (\<Union>i\<in>I. {x\<in>space M. P i x \<and> ?N x})"
     unfolding emeasure_eq_measure by (auto intro!: arg_cong[where f=prob] simp: measure_nonneg)
   also have "\<dots> = (\<integral>\<^sup>+i. emeasure M {x\<in>space M. P i x \<and> ?N x} \<partial>count_space I)"
     by (rule emeasure_UN_countable)
        (auto intro!: sets.sets_Collect_countable_Ex' sets.sets_Collect_conj sets.sets_Collect_countable_Ex1' I sets
              simp: disjoint_family_on_def)
   also have "\<dots> = (\<integral>\<^sup>+i. \<P>(x in M. P i x) \<partial>count_space I)"
     unfolding emeasure_eq_measure using disj
     by (intro nn_integral_cong ennreal_inj[THEN iffD2] prob_eq_AE)
        (auto intro!: sets.sets_Collect_countable_Ex' sets.sets_Collect_conj sets.sets_Collect_countable_Ex1' I sets measure_nonneg)+
   finally show ?thesis .
 qed
 
 lemma (in prob_space) cond_prob_eq_AE:
   assumes P: "AE x in M. Q x \<longrightarrow> P x \<longleftrightarrow> P' x" "{x\<in>space M. P x} \<in> events" "{x\<in>space M. P' x} \<in> events"
   assumes Q: "AE x in M. Q x \<longleftrightarrow> Q' x" "{x\<in>space M. Q x} \<in> events" "{x\<in>space M. Q' x} \<in> events"
   shows "cond_prob M P Q = cond_prob M P' Q'"
   using P Q
   by (auto simp: cond_prob_def intro!: arg_cong2[where f="(/)"] prob_eq_AE sets.sets_Collect_conj)
 
 
 lemma (in prob_space) joint_distribution_Times_le_fst:
   "random_variable MX X \<Longrightarrow> random_variable MY Y \<Longrightarrow> A \<in> sets MX \<Longrightarrow> B \<in> sets MY
     \<Longrightarrow> emeasure (distr M (MX \<Otimes>\<^sub>M MY) (\<lambda>x. (X x, Y x))) (A \<times> B) \<le> emeasure (distr M MX X) A"
   by (auto simp: emeasure_distr measurable_pair_iff comp_def intro!: emeasure_mono measurable_sets)
 
 lemma (in prob_space) joint_distribution_Times_le_snd:
   "random_variable MX X \<Longrightarrow> random_variable MY Y \<Longrightarrow> A \<in> sets MX \<Longrightarrow> B \<in> sets MY
     \<Longrightarrow> emeasure (distr M (MX \<Otimes>\<^sub>M MY) (\<lambda>x. (X x, Y x))) (A \<times> B) \<le> emeasure (distr M MY Y) B"
   by (auto simp: emeasure_distr measurable_pair_iff comp_def intro!: emeasure_mono measurable_sets)
 
 lemma (in prob_space) variance_eq:
   fixes X :: "'a \<Rightarrow> real"
   assumes [simp]: "integrable M X"
   assumes [simp]: "integrable M (\<lambda>x. (X x)\<^sup>2)"
   shows "variance X = expectation (\<lambda>x. (X x)\<^sup>2) - (expectation X)\<^sup>2"
   by (simp add: field_simps prob_space power2_diff power2_eq_square[symmetric])
 
 lemma (in prob_space) variance_positive: "0 \<le> variance (X::'a \<Rightarrow> real)"
   by (intro integral_nonneg_AE) (auto intro!: integral_nonneg_AE)
 
 lemma (in prob_space) variance_mean_zero:
   "expectation X = 0 \<Longrightarrow> variance X = expectation (\<lambda>x. (X x)^2)"
   by simp
 
 theorem%important (in prob_space) Chebyshev_inequality:
   assumes [measurable]: "random_variable borel f"
   assumes "integrable M (\<lambda>x. f x ^ 2)"
   defines "\<mu> \<equiv> expectation f"
   assumes "a > 0"
   shows "prob {x\<in>space M. \<bar>f x - \<mu>\<bar> \<ge> a} \<le> variance f / a\<^sup>2"
   unfolding \<mu>_def
 proof (rule second_moment_method)
   have integrable: "integrable M f"
     using assms by (blast dest: square_integrable_imp_integrable)
   show "integrable M (\<lambda>x. (f x - expectation f)\<^sup>2)"
     using assms integrable unfolding power2_eq_square ring_distribs
     by (intro Bochner_Integration.integrable_diff) auto
 qed (use assms in auto)
 
 locale pair_prob_space = pair_sigma_finite M1 M2 + M1: prob_space M1 + M2: prob_space M2 for M1 M2
 
 sublocale pair_prob_space \<subseteq> P?: prob_space "M1 \<Otimes>\<^sub>M M2"
 proof
   show "emeasure (M1 \<Otimes>\<^sub>M M2) (space (M1 \<Otimes>\<^sub>M M2)) = 1"
     by (simp add: M2.emeasure_pair_measure_Times M1.emeasure_space_1 M2.emeasure_space_1 space_pair_measure)
 qed
 
 locale product_prob_space = product_sigma_finite M for M :: "'i \<Rightarrow> 'a measure" +
   fixes I :: "'i set"
   assumes prob_space: "\<And>i. prob_space (M i)"
 
 sublocale product_prob_space \<subseteq> M?: prob_space "M i" for i
   by (rule prob_space)
 
 locale finite_product_prob_space = finite_product_sigma_finite M I + product_prob_space M I for M I
 
 sublocale finite_product_prob_space \<subseteq> prob_space "\<Pi>\<^sub>M i\<in>I. M i"
 proof
   show "emeasure (\<Pi>\<^sub>M i\<in>I. M i) (space (\<Pi>\<^sub>M i\<in>I. M i)) = 1"
     by (simp add: measure_times M.emeasure_space_1 prod.neutral_const space_PiM)
 qed
 
 lemma (in finite_product_prob_space) prob_times:
   assumes X: "\<And>i. i \<in> I \<Longrightarrow> X i \<in> sets (M i)"
   shows "prob (\<Pi>\<^sub>E i\<in>I. X i) = (\<Prod>i\<in>I. M.prob i (X i))"
 proof -
   have "ennreal (measure (\<Pi>\<^sub>M i\<in>I. M i) (\<Pi>\<^sub>E i\<in>I. X i)) = emeasure (\<Pi>\<^sub>M i\<in>I. M i) (\<Pi>\<^sub>E i\<in>I. X i)"
     using X by (simp add: emeasure_eq_measure)
   also have "\<dots> = (\<Prod>i\<in>I. emeasure (M i) (X i))"
     using measure_times X by simp
   also have "\<dots> = ennreal (\<Prod>i\<in>I. measure (M i) (X i))"
     using X by (simp add: M.emeasure_eq_measure prod_ennreal measure_nonneg)
   finally show ?thesis by (simp add: measure_nonneg prod_nonneg)
 qed
 
 lemma product_prob_spaceI:
   assumes "\<And>i. prob_space (M i)"
   shows   "product_prob_space M"
   unfolding product_prob_space_def product_prob_space_axioms_def product_sigma_finite_def
 proof safe
   fix i
   interpret prob_space "M i"
     by (rule assms)
   show "sigma_finite_measure (M i)" "prob_space (M i)"
     by unfold_locales
 qed
 
 subsection \<open>Distributions\<close>
 
 definition distributed :: "'a measure \<Rightarrow> 'b measure \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> ennreal) \<Rightarrow> bool"
 where
   "distributed M N X f \<longleftrightarrow>
   distr M N X = density N f \<and> f \<in> borel_measurable N \<and> X \<in> measurable M N"
 
 lemma
   assumes "distributed M N X f"
   shows distributed_distr_eq_density: "distr M N X = density N f"
     and distributed_measurable: "X \<in> measurable M N"
     and distributed_borel_measurable: "f \<in> borel_measurable N"
   using assms by (simp_all add: distributed_def)
 
 lemma
   assumes D: "distributed M N X f"
   shows distributed_measurable'[measurable_dest]:
       "g \<in> measurable L M \<Longrightarrow> (\<lambda>x. X (g x)) \<in> measurable L N"
     and distributed_borel_measurable'[measurable_dest]:
       "h \<in> measurable L N \<Longrightarrow> (\<lambda>x. f (h x)) \<in> borel_measurable L"
   using distributed_measurable[OF D] distributed_borel_measurable[OF D]
   by simp_all
 
 lemma distributed_real_measurable:
   "(\<And>x. x \<in> space N \<Longrightarrow> 0 \<le> f x) \<Longrightarrow> distributed M N X (\<lambda>x. ennreal (f x)) \<Longrightarrow> f \<in> borel_measurable N"
   by (simp_all add: distributed_def)
 
 lemma distributed_real_measurable':
   "(\<And>x. x \<in> space N \<Longrightarrow> 0 \<le> f x) \<Longrightarrow> distributed M N X (\<lambda>x. ennreal (f x)) \<Longrightarrow>
     h \<in> measurable L N \<Longrightarrow> (\<lambda>x. f (h x)) \<in> borel_measurable L"
   using distributed_real_measurable[measurable] by simp
 
 lemma joint_distributed_measurable1:
   "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) f \<Longrightarrow> h1 \<in> measurable N M \<Longrightarrow> (\<lambda>x. X (h1 x)) \<in> measurable N S"
   by simp
 
 lemma joint_distributed_measurable2:
   "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) f \<Longrightarrow> h2 \<in> measurable N M \<Longrightarrow> (\<lambda>x. Y (h2 x)) \<in> measurable N T"
   by simp
 
 lemma distributed_count_space:
   assumes X: "distributed M (count_space A) X P" and a: "a \<in> A" and A: "finite A"
   shows "P a = emeasure M (X -` {a} \<inter> space M)"
 proof -
   have "emeasure M (X -` {a} \<inter> space M) = emeasure (distr M (count_space A) X) {a}"
     using X a A by (simp add: emeasure_distr)
   also have "\<dots> = emeasure (density (count_space A) P) {a}"
     using X by (simp add: distributed_distr_eq_density)
   also have "\<dots> = (\<integral>\<^sup>+x. P a * indicator {a} x \<partial>count_space A)"
     using X a by (auto simp add: emeasure_density distributed_def indicator_def intro!: nn_integral_cong)
   also have "\<dots> = P a"
     using X a by (subst nn_integral_cmult_indicator) (auto simp: distributed_def one_ennreal_def[symmetric] AE_count_space)
   finally show ?thesis ..
 qed
 
 lemma distributed_cong_density:
   "(AE x in N. f x = g x) \<Longrightarrow> g \<in> borel_measurable N \<Longrightarrow> f \<in> borel_measurable N \<Longrightarrow>
     distributed M N X f \<longleftrightarrow> distributed M N X g"
   by (auto simp: distributed_def intro!: density_cong)
 
 lemma (in prob_space) distributed_imp_emeasure_nonzero:
   assumes X: "distributed M MX X Px"
   shows "emeasure MX {x \<in> space MX. Px x \<noteq> 0} \<noteq> 0"
 proof
   note Px = distributed_borel_measurable[OF X]
   interpret X: prob_space "distr M MX X"
     using distributed_measurable[OF X] by (rule prob_space_distr)
 
   assume "emeasure MX {x \<in> space MX. Px x \<noteq> 0} = 0"
   with Px have "AE x in MX. Px x = 0"
     by (intro AE_I[OF subset_refl]) (auto simp: borel_measurable_ennreal_iff)
   moreover
   from X.emeasure_space_1 have "(\<integral>\<^sup>+x. Px x \<partial>MX) = 1"
     unfolding distributed_distr_eq_density[OF X] using Px
     by (subst (asm) emeasure_density)
        (auto simp: borel_measurable_ennreal_iff intro!: integral_cong cong: nn_integral_cong)
   ultimately show False
     by (simp add: nn_integral_cong_AE)
 qed
 
 lemma subdensity:
   assumes T: "T \<in> measurable P Q"
   assumes f: "distributed M P X f"
   assumes g: "distributed M Q Y g"
   assumes Y: "Y = T \<circ> X"
   shows "AE x in P. g (T x) = 0 \<longrightarrow> f x = 0"
 proof -
   have "{x\<in>space Q. g x = 0} \<in> null_sets (distr M Q (T \<circ> X))"
     using g Y by (auto simp: null_sets_density_iff distributed_def)
   also have "distr M Q (T \<circ> X) = distr (distr M P X) Q T"
     using T f[THEN distributed_measurable] by (rule distr_distr[symmetric])
   finally have "T -` {x\<in>space Q. g x = 0} \<inter> space P \<in> null_sets (distr M P X)"
     using T by (subst (asm) null_sets_distr_iff) auto
   also have "T -` {x\<in>space Q. g x = 0} \<inter> space P = {x\<in>space P. g (T x) = 0}"
     using T by (auto dest: measurable_space)
   finally show ?thesis
     using f g by (auto simp add: null_sets_density_iff distributed_def)
 qed
 
 lemma subdensity_real:
   fixes g :: "'a \<Rightarrow> real" and f :: "'b \<Rightarrow> real"
   assumes T: "T \<in> measurable P Q"
   assumes f: "distributed M P X f"
   assumes g: "distributed M Q Y g"
   assumes Y: "Y = T \<circ> X"
   shows "(AE x in P. 0 \<le> g (T x)) \<Longrightarrow> (AE x in P. 0 \<le> f x) \<Longrightarrow> AE x in P. g (T x) = 0 \<longrightarrow> f x = 0"
   using subdensity[OF T, of M X "\<lambda>x. ennreal (f x)" Y "\<lambda>x. ennreal (g x)"] assms
   by auto
 
 lemma distributed_emeasure:
   "distributed M N X f \<Longrightarrow> A \<in> sets N \<Longrightarrow> emeasure M (X -` A \<inter> space M) = (\<integral>\<^sup>+x. f x * indicator A x \<partial>N)"
   by (auto simp: distributed_distr_eq_density[symmetric] emeasure_density[symmetric] emeasure_distr)
 
 lemma distributed_nn_integral:
   "distributed M N X f \<Longrightarrow> g \<in> borel_measurable N \<Longrightarrow> (\<integral>\<^sup>+x. f x * g x \<partial>N) = (\<integral>\<^sup>+x. g (X x) \<partial>M)"
   by (auto simp: distributed_distr_eq_density[symmetric] nn_integral_density[symmetric] nn_integral_distr)
 
 lemma distributed_integral:
   "distributed M N X f \<Longrightarrow> g \<in> borel_measurable N \<Longrightarrow> (\<And>x. x \<in> space N \<Longrightarrow> 0 \<le> f x) \<Longrightarrow>
     (\<integral>x. f x * g x \<partial>N) = (\<integral>x. g (X x) \<partial>M)"
   supply distributed_real_measurable[measurable]
   by (auto simp: distributed_distr_eq_density[symmetric] integral_real_density[symmetric] integral_distr)
 
 lemma distributed_transform_integral:
   assumes Px: "distributed M N X Px" "\<And>x. x \<in> space N \<Longrightarrow> 0 \<le> Px x"
   assumes "distributed M P Y Py" "\<And>x. x \<in> space P \<Longrightarrow> 0 \<le> Py x"
   assumes Y: "Y = T \<circ> X" and T: "T \<in> measurable N P" and f: "f \<in> borel_measurable P"
   shows "(\<integral>x. Py x * f x \<partial>P) = (\<integral>x. Px x * f (T x) \<partial>N)"
 proof -
   have "(\<integral>x. Py x * f x \<partial>P) = (\<integral>x. f (Y x) \<partial>M)"
     by (rule distributed_integral) fact+
   also have "\<dots> = (\<integral>x. f (T (X x)) \<partial>M)"
     using Y by simp
   also have "\<dots> = (\<integral>x. Px x * f (T x) \<partial>N)"
     using measurable_comp[OF T f] Px by (intro distributed_integral[symmetric]) (auto simp: comp_def)
   finally show ?thesis .
 qed
 
 lemma (in prob_space) distributed_unique:
   assumes Px: "distributed M S X Px"
   assumes Py: "distributed M S X Py"
   shows "AE x in S. Px x = Py x"
 proof -
   interpret X: prob_space "distr M S X"
     using Px by (intro prob_space_distr) simp
   have "sigma_finite_measure (distr M S X)" ..
   with sigma_finite_density_unique[of Px S Py ] Px Py
   show ?thesis
     by (auto simp: distributed_def)
 qed
 
 lemma (in prob_space) distributed_jointI:
   assumes "sigma_finite_measure S" "sigma_finite_measure T"
   assumes X[measurable]: "X \<in> measurable M S" and Y[measurable]: "Y \<in> measurable M T"
   assumes [measurable]: "f \<in> borel_measurable (S \<Otimes>\<^sub>M T)" and f: "AE x in S \<Otimes>\<^sub>M T. 0 \<le> f x"
   assumes eq: "\<And>A B. A \<in> sets S \<Longrightarrow> B \<in> sets T \<Longrightarrow>
     emeasure M {x \<in> space M. X x \<in> A \<and> Y x \<in> B} = (\<integral>\<^sup>+x. (\<integral>\<^sup>+y. f (x, y) * indicator B y \<partial>T) * indicator A x \<partial>S)"
   shows "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) f"
   unfolding distributed_def
 proof safe
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret ST: pair_sigma_finite S T ..
 
-  from ST.sigma_finite_up_in_pair_measure_generator guess F :: "nat \<Rightarrow> ('b \<times> 'c) set" .. note F = this
+  from ST.sigma_finite_up_in_pair_measure_generator
+  obtain F :: "nat \<Rightarrow> ('b \<times> 'c) set"
+    where F: "range F \<subseteq> {A \<times> B |A B. A \<in> sets S \<and> B \<in> sets T} \<and> incseq F \<and>
+      \<Union> (range F) = space S \<times> space T \<and> (\<forall>i. emeasure (S \<Otimes>\<^sub>M T) (F i) \<noteq> \<infinity>)" ..
   let ?E = "{a \<times> b |a b. a \<in> sets S \<and> b \<in> sets T}"
   let ?P = "S \<Otimes>\<^sub>M T"
   show "distr M ?P (\<lambda>x. (X x, Y x)) = density ?P f" (is "?L = ?R")
   proof (rule measure_eqI_generator_eq[OF Int_stable_pair_measure_generator[of S T]])
     show "?E \<subseteq> Pow (space ?P)"
       using sets.space_closed[of S] sets.space_closed[of T] by (auto simp: space_pair_measure)
     show "sets ?L = sigma_sets (space ?P) ?E"
       by (simp add: sets_pair_measure space_pair_measure)
     then show "sets ?R = sigma_sets (space ?P) ?E"
       by simp
   next
     interpret L: prob_space ?L
       by (rule prob_space_distr) (auto intro!: measurable_Pair)
     show "range F \<subseteq> ?E" "(\<Union>i. F i) = space ?P" "\<And>i. emeasure ?L (F i) \<noteq> \<infinity>"
       using F by (auto simp: space_pair_measure)
   next
     fix E assume "E \<in> ?E"
     then obtain A B where E[simp]: "E = A \<times> B"
       and A[measurable]: "A \<in> sets S" and B[measurable]: "B \<in> sets T" by auto
     have "emeasure ?L E = emeasure M {x \<in> space M. X x \<in> A \<and> Y x \<in> B}"
       by (auto intro!: arg_cong[where f="emeasure M"] simp add: emeasure_distr measurable_Pair)
     also have "\<dots> = (\<integral>\<^sup>+x. (\<integral>\<^sup>+y. (f (x, y) * indicator B y) * indicator A x \<partial>T) \<partial>S)"
       using f by (auto simp add: eq nn_integral_multc intro!: nn_integral_cong)
     also have "\<dots> = emeasure ?R E"
       by (auto simp add: emeasure_density T.nn_integral_fst[symmetric]
                intro!: nn_integral_cong split: split_indicator)
     finally show "emeasure ?L E = emeasure ?R E" .
   qed
 qed (auto simp: f)
 
 lemma (in prob_space) distributed_swap:
   assumes "sigma_finite_measure S" "sigma_finite_measure T"
   assumes Pxy: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
   shows "distributed M (T \<Otimes>\<^sub>M S) (\<lambda>x. (Y x, X x)) (\<lambda>(x, y). Pxy (y, x))"
 proof -
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret ST: pair_sigma_finite S T ..
   interpret TS: pair_sigma_finite T S ..
 
   note Pxy[measurable]
   show ?thesis
     apply (subst TS.distr_pair_swap)
     unfolding distributed_def
   proof safe
     let ?D = "distr (S \<Otimes>\<^sub>M T) (T \<Otimes>\<^sub>M S) (\<lambda>(x, y). (y, x))"
     show 1: "(\<lambda>(x, y). Pxy (y, x)) \<in> borel_measurable ?D"
       by auto
     show 2: "random_variable (distr (S \<Otimes>\<^sub>M T) (T \<Otimes>\<^sub>M S) (\<lambda>(x, y). (y, x))) (\<lambda>x. (Y x, X x))"
       using Pxy by auto
     { fix A assume A: "A \<in> sets (T \<Otimes>\<^sub>M S)"
       let ?B = "(\<lambda>(x, y). (y, x)) -` A \<inter> space (S \<Otimes>\<^sub>M T)"
       from sets.sets_into_space[OF A]
       have "emeasure M ((\<lambda>x. (Y x, X x)) -` A \<inter> space M) =
         emeasure M ((\<lambda>x. (X x, Y x)) -` ?B \<inter> space M)"
         by (auto intro!: arg_cong2[where f=emeasure] simp: space_pair_measure)
       also have "\<dots> = (\<integral>\<^sup>+ x. Pxy x * indicator ?B x \<partial>(S \<Otimes>\<^sub>M T))"
         using Pxy A by (intro distributed_emeasure) auto
       finally have "emeasure M ((\<lambda>x. (Y x, X x)) -` A \<inter> space M) =
         (\<integral>\<^sup>+ x. Pxy x * indicator A (snd x, fst x) \<partial>(S \<Otimes>\<^sub>M T))"
         by (auto intro!: nn_integral_cong split: split_indicator) }
     note * = this
     show "distr M ?D (\<lambda>x. (Y x, X x)) = density ?D (\<lambda>(x, y). Pxy (y, x))"
       apply (intro measure_eqI)
       apply (simp_all add: emeasure_distr[OF 2] emeasure_density[OF 1])
       apply (subst nn_integral_distr)
       apply (auto intro!: * simp: comp_def split_beta)
       done
   qed
 qed
 
 lemma (in prob_space) distr_marginal1:
   assumes "sigma_finite_measure S" "sigma_finite_measure T"
   assumes Pxy: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
   defines "Px \<equiv> \<lambda>x. (\<integral>\<^sup>+z. Pxy (x, z) \<partial>T)"
   shows "distributed M S X Px"
   unfolding distributed_def
 proof safe
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret ST: pair_sigma_finite S T ..
 
   note Pxy[measurable]
   show X: "X \<in> measurable M S" by simp
 
   show borel: "Px \<in> borel_measurable S"
     by (auto intro!: T.nn_integral_fst simp: Px_def)
 
   interpret Pxy: prob_space "distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))"
     by (intro prob_space_distr) simp
 
   show "distr M S X = density S Px"
   proof (rule measure_eqI)
     fix A assume A: "A \<in> sets (distr M S X)"
     with X measurable_space[of Y M T]
     have "emeasure (distr M S X) A = emeasure (distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))) (A \<times> space T)"
       by (auto simp add: emeasure_distr intro!: arg_cong[where f="emeasure M"])
     also have "\<dots> = emeasure (density (S \<Otimes>\<^sub>M T) Pxy) (A \<times> space T)"
       using Pxy by (simp add: distributed_def)
     also have "\<dots> = \<integral>\<^sup>+ x. \<integral>\<^sup>+ y. Pxy (x, y) * indicator (A \<times> space T) (x, y) \<partial>T \<partial>S"
       using A borel Pxy
       by (simp add: emeasure_density T.nn_integral_fst[symmetric])
     also have "\<dots> = \<integral>\<^sup>+ x. Px x * indicator A x \<partial>S"
     proof (rule nn_integral_cong)
       fix x assume "x \<in> space S"
       moreover have eq: "\<And>y. y \<in> space T \<Longrightarrow> indicator (A \<times> space T) (x, y) = indicator A x"
         by (auto simp: indicator_def)
       ultimately have "(\<integral>\<^sup>+ y. Pxy (x, y) * indicator (A \<times> space T) (x, y) \<partial>T) = (\<integral>\<^sup>+ y. Pxy (x, y) \<partial>T) * indicator A x"
         by (simp add: eq nn_integral_multc cong: nn_integral_cong)
       also have "(\<integral>\<^sup>+ y. Pxy (x, y) \<partial>T) = Px x"
         by (simp add: Px_def)
       finally show "(\<integral>\<^sup>+ y. Pxy (x, y) * indicator (A \<times> space T) (x, y) \<partial>T) = Px x * indicator A x" .
     qed
     finally show "emeasure (distr M S X) A = emeasure (density S Px) A"
       using A borel Pxy by (simp add: emeasure_density)
   qed simp
 qed
 
 lemma (in prob_space) distr_marginal2:
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T"
   assumes Pxy: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
   shows "distributed M T Y (\<lambda>y. (\<integral>\<^sup>+x. Pxy (x, y) \<partial>S))"
   using distr_marginal1[OF T S distributed_swap[OF S T]] Pxy by simp
 
 lemma (in prob_space) distributed_marginal_eq_joint1:
   assumes T: "sigma_finite_measure T"
   assumes S: "sigma_finite_measure S"
   assumes Px: "distributed M S X Px"
   assumes Pxy: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
   shows "AE x in S. Px x = (\<integral>\<^sup>+y. Pxy (x, y) \<partial>T)"
   using Px distr_marginal1[OF S T Pxy] by (rule distributed_unique)
 
 lemma (in prob_space) distributed_marginal_eq_joint2:
   assumes T: "sigma_finite_measure T"
   assumes S: "sigma_finite_measure S"
   assumes Py: "distributed M T Y Py"
   assumes Pxy: "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) Pxy"
   shows "AE y in T. Py y = (\<integral>\<^sup>+x. Pxy (x, y) \<partial>S)"
   using Py distr_marginal2[OF S T Pxy] by (rule distributed_unique)
 
 lemma (in prob_space) distributed_joint_indep':
   assumes S: "sigma_finite_measure S" and T: "sigma_finite_measure T"
   assumes X[measurable]: "distributed M S X Px" and Y[measurable]: "distributed M T Y Py"
   assumes indep: "distr M S X \<Otimes>\<^sub>M distr M T Y = distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))"
   shows "distributed M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) (\<lambda>(x, y). Px x * Py y)"
   unfolding distributed_def
 proof safe
   interpret S: sigma_finite_measure S by fact
   interpret T: sigma_finite_measure T by fact
   interpret ST: pair_sigma_finite S T ..
 
   interpret X: prob_space "density S Px"
     unfolding distributed_distr_eq_density[OF X, symmetric]
     by (rule prob_space_distr) simp
   have sf_X: "sigma_finite_measure (density S Px)" ..
 
   interpret Y: prob_space "density T Py"
     unfolding distributed_distr_eq_density[OF Y, symmetric]
     by (rule prob_space_distr) simp
   have sf_Y: "sigma_finite_measure (density T Py)" ..
 
   show "distr M (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x)) = density (S \<Otimes>\<^sub>M T) (\<lambda>(x, y). Px x * Py y)"
     unfolding indep[symmetric] distributed_distr_eq_density[OF X] distributed_distr_eq_density[OF Y]
     using distributed_borel_measurable[OF X]
     using distributed_borel_measurable[OF Y]
     by (rule pair_measure_density[OF _ _ T sf_Y])
 
   show "random_variable (S \<Otimes>\<^sub>M T) (\<lambda>x. (X x, Y x))" by auto
 
   show Pxy: "(\<lambda>(x, y). Px x * Py y) \<in> borel_measurable (S \<Otimes>\<^sub>M T)" by auto
 qed
 
 lemma distributed_integrable:
   "distributed M N X f \<Longrightarrow> g \<in> borel_measurable N \<Longrightarrow> (\<And>x. x \<in> space N \<Longrightarrow> 0 \<le> f x) \<Longrightarrow>
     integrable N (\<lambda>x. f x * g x) \<longleftrightarrow> integrable M (\<lambda>x. g (X x))"
   supply distributed_real_measurable[measurable]
   by (auto simp: distributed_distr_eq_density[symmetric] integrable_real_density[symmetric] integrable_distr_eq)
 
 lemma distributed_transform_integrable:
   assumes Px: "distributed M N X Px" "\<And>x. x \<in> space N \<Longrightarrow> 0 \<le> Px x"
   assumes "distributed M P Y Py" "\<And>x. x \<in> space P \<Longrightarrow> 0 \<le> Py x"
   assumes Y: "Y = (\<lambda>x. T (X x))" and T: "T \<in> measurable N P" and f: "f \<in> borel_measurable P"
   shows "integrable P (\<lambda>x. Py x * f x) \<longleftrightarrow> integrable N (\<lambda>x. Px x * f (T x))"
 proof -
   have "integrable P (\<lambda>x. Py x * f x) \<longleftrightarrow> integrable M (\<lambda>x. f (Y x))"
     by (rule distributed_integrable) fact+
   also have "\<dots> \<longleftrightarrow> integrable M (\<lambda>x. f (T (X x)))"
     using Y by simp
   also have "\<dots> \<longleftrightarrow> integrable N (\<lambda>x. Px x * f (T x))"
     using measurable_comp[OF T f] Px by (intro distributed_integrable[symmetric]) (auto simp: comp_def)
   finally show ?thesis .
 qed
 
 lemma distributed_integrable_var:
   fixes X :: "'a \<Rightarrow> real"
   shows "distributed M lborel X (\<lambda>x. ennreal (f x)) \<Longrightarrow> (\<And>x. 0 \<le> f x) \<Longrightarrow>
     integrable lborel (\<lambda>x. f x * x) \<Longrightarrow> integrable M X"
   using distributed_integrable[of M lborel X f "\<lambda>x. x"] by simp
 
 lemma (in prob_space) distributed_variance:
   fixes f::"real \<Rightarrow> real"
   assumes D: "distributed M lborel X f" and [simp]: "\<And>x. 0 \<le> f x"
   shows "variance X = (\<integral>x. x\<^sup>2 * f (x + expectation X) \<partial>lborel)"
 proof (subst distributed_integral[OF D, symmetric])
   show "(\<integral> x. f x * (x - expectation X)\<^sup>2 \<partial>lborel) = (\<integral> x. x\<^sup>2 * f (x + expectation X) \<partial>lborel)"
     by (subst lborel_integral_real_affine[where c=1 and t="expectation X"])  (auto simp: ac_simps)
 qed simp_all
 
 lemma (in prob_space) variance_affine:
   fixes f::"real \<Rightarrow> real"
   assumes [arith]: "b \<noteq> 0"
   assumes D[intro]: "distributed M lborel X f"
   assumes [simp]: "prob_space (density lborel f)"
   assumes I[simp]: "integrable M X"
   assumes I2[simp]: "integrable M (\<lambda>x. (X x)\<^sup>2)"
   shows "variance (\<lambda>x. a + b * X x) = b\<^sup>2 * variance X"
   by (subst variance_eq)
      (auto simp: power2_sum power_mult_distrib prob_space variance_eq right_diff_distrib)
 
 definition
   "simple_distributed M X f \<longleftrightarrow>
     (\<forall>x. 0 \<le> f x) \<and>
     distributed M (count_space (X`space M)) X (\<lambda>x. ennreal (f x)) \<and>
     finite (X`space M)"
 
 lemma simple_distributed_nonneg[dest]: "simple_distributed M X f \<Longrightarrow> 0 \<le> f x"
   by (auto simp: simple_distributed_def)
 
 lemma simple_distributed:
   "simple_distributed M X Px \<Longrightarrow> distributed M (count_space (X`space M)) X Px"
   unfolding simple_distributed_def by auto
 
 lemma simple_distributed_finite[dest]: "simple_distributed M X P \<Longrightarrow> finite (X`space M)"
   by (simp add: simple_distributed_def)
 
 lemma (in prob_space) distributed_simple_function_superset:
   assumes X: "simple_function M X" "\<And>x. x \<in> X ` space M \<Longrightarrow> P x = measure M (X -` {x} \<inter> space M)"
   assumes A: "X`space M \<subseteq> A" "finite A"
   defines "S \<equiv> count_space A" and "P' \<equiv> (\<lambda>x. if x \<in> X`space M then P x else 0)"
   shows "distributed M S X P'"
   unfolding distributed_def
 proof safe
   show "(\<lambda>x. ennreal (P' x)) \<in> borel_measurable S" unfolding S_def by simp
   show "distr M S X = density S P'"
   proof (rule measure_eqI_finite)
     show "sets (distr M S X) = Pow A" "sets (density S P') = Pow A"
       using A unfolding S_def by auto
     show "finite A" by fact
     fix a assume a: "a \<in> A"
     then have "a \<notin> X`space M \<Longrightarrow> X -` {a} \<inter> space M = {}" by auto
     with A a X have "emeasure (distr M S X) {a} = P' a"
       by (subst emeasure_distr)
          (auto simp add: S_def P'_def simple_functionD emeasure_eq_measure measurable_count_space_eq2
                intro!: arg_cong[where f=prob])
     also have "\<dots> = (\<integral>\<^sup>+x. ennreal (P' a) * indicator {a} x \<partial>S)"
       using A X a
       by (subst nn_integral_cmult_indicator)
          (auto simp: S_def P'_def simple_distributed_def simple_functionD measure_nonneg)
     also have "\<dots> = (\<integral>\<^sup>+x. ennreal (P' x) * indicator {a} x \<partial>S)"
       by (auto simp: indicator_def intro!: nn_integral_cong)
     also have "\<dots> = emeasure (density S P') {a}"
       using a A by (intro emeasure_density[symmetric]) (auto simp: S_def)
     finally show "emeasure (distr M S X) {a} = emeasure (density S P') {a}" .
   qed
   show "random_variable S X"
     using X(1) A by (auto simp: measurable_def simple_functionD S_def)
 qed
 
 lemma (in prob_space) simple_distributedI:
   assumes X: "simple_function M X"
     "\<And>x. 0 \<le> P x"
     "\<And>x. x \<in> X ` space M \<Longrightarrow> P x = measure M (X -` {x} \<inter> space M)"
   shows "simple_distributed M X P"
   unfolding simple_distributed_def
 proof (safe intro!: X)
   have "distributed M (count_space (X ` space M)) X (\<lambda>x. ennreal (if x \<in> X`space M then P x else 0))"
     (is "?A")
     using simple_functionD[OF X(1)] by (intro distributed_simple_function_superset[OF X(1,3)]) auto
   also have "?A \<longleftrightarrow> distributed M (count_space (X ` space M)) X (\<lambda>x. ennreal (P x))"
     by (rule distributed_cong_density) auto
   finally show "\<dots>" .
 qed (rule simple_functionD[OF X(1)])
 
 lemma simple_distributed_joint_finite:
   assumes X: "simple_distributed M (\<lambda>x. (X x, Y x)) Px"
   shows "finite (X ` space M)" "finite (Y ` space M)"
 proof -
   have "finite ((\<lambda>x. (X x, Y x)) ` space M)"
     using X by (auto simp: simple_distributed_def simple_functionD)
   then have "finite (fst ` (\<lambda>x. (X x, Y x)) ` space M)" "finite (snd ` (\<lambda>x. (X x, Y x)) ` space M)"
     by auto
   then show fin: "finite (X ` space M)" "finite (Y ` space M)"
     by (auto simp: image_image)
 qed
 
 lemma simple_distributed_joint2_finite:
   assumes X: "simple_distributed M (\<lambda>x. (X x, Y x, Z x)) Px"
   shows "finite (X ` space M)" "finite (Y ` space M)" "finite (Z ` space M)"
 proof -
   have "finite ((\<lambda>x. (X x, Y x, Z x)) ` space M)"
     using X by (auto simp: simple_distributed_def simple_functionD)
   then have "finite (fst ` (\<lambda>x. (X x, Y x, Z x)) ` space M)"
     "finite ((fst \<circ> snd) ` (\<lambda>x. (X x, Y x, Z x)) ` space M)"
     "finite ((snd \<circ> snd) ` (\<lambda>x. (X x, Y x, Z x)) ` space M)"
     by auto
   then show fin: "finite (X ` space M)" "finite (Y ` space M)" "finite (Z ` space M)"
     by (auto simp: image_image)
 qed
 
 lemma simple_distributed_simple_function:
   "simple_distributed M X Px \<Longrightarrow> simple_function M X"
   unfolding simple_distributed_def distributed_def
   by (auto simp: simple_function_def measurable_count_space_eq2)
 
 lemma simple_distributed_measure:
   "simple_distributed M X P \<Longrightarrow> a \<in> X`space M \<Longrightarrow> P a = measure M (X -` {a} \<inter> space M)"
   using distributed_count_space[of M "X`space M" X P a, symmetric]
   by (auto simp: simple_distributed_def measure_def)
 
 lemma (in prob_space) simple_distributed_joint:
   assumes X: "simple_distributed M (\<lambda>x. (X x, Y x)) Px"
   defines "S \<equiv> count_space (X`space M) \<Otimes>\<^sub>M count_space (Y`space M)"
   defines "P \<equiv> (\<lambda>x. if x \<in> (\<lambda>x. (X x, Y x))`space M then Px x else 0)"
   shows "distributed M S (\<lambda>x. (X x, Y x)) P"
 proof -
   from simple_distributed_joint_finite[OF X, simp]
   have S_eq: "S = count_space (X`space M \<times> Y`space M)"
     by (simp add: S_def pair_measure_count_space)
   show ?thesis
     unfolding S_eq P_def
   proof (rule distributed_simple_function_superset)
     show "simple_function M (\<lambda>x. (X x, Y x))"
       using X by (rule simple_distributed_simple_function)
     fix x assume "x \<in> (\<lambda>x. (X x, Y x)) ` space M"
     from simple_distributed_measure[OF X this]
     show "Px x = prob ((\<lambda>x. (X x, Y x)) -` {x} \<inter> space M)" .
   qed auto
 qed
 
 lemma (in prob_space) simple_distributed_joint2:
   assumes X: "simple_distributed M (\<lambda>x. (X x, Y x, Z x)) Px"
   defines "S \<equiv> count_space (X`space M) \<Otimes>\<^sub>M count_space (Y`space M) \<Otimes>\<^sub>M count_space (Z`space M)"
   defines "P \<equiv> (\<lambda>x. if x \<in> (\<lambda>x. (X x, Y x, Z x))`space M then Px x else 0)"
   shows "distributed M S (\<lambda>x. (X x, Y x, Z x)) P"
 proof -
   from simple_distributed_joint2_finite[OF X, simp]
   have S_eq: "S = count_space (X`space M \<times> Y`space M \<times> Z`space M)"
     by (simp add: S_def pair_measure_count_space)
   show ?thesis
     unfolding S_eq P_def
   proof (rule distributed_simple_function_superset)
     show "simple_function M (\<lambda>x. (X x, Y x, Z x))"
       using X by (rule simple_distributed_simple_function)
     fix x assume "x \<in> (\<lambda>x. (X x, Y x, Z x)) ` space M"
     from simple_distributed_measure[OF X this]
     show "Px x = prob ((\<lambda>x. (X x, Y x, Z x)) -` {x} \<inter> space M)" .
   qed auto
 qed
 
 lemma (in prob_space) simple_distributed_sum_space:
   assumes X: "simple_distributed M X f"
   shows "sum f (X`space M) = 1"
 proof -
   from X have "sum f (X`space M) = prob (\<Union>i\<in>X`space M. X -` {i} \<inter> space M)"
     by (subst finite_measure_finite_Union)
        (auto simp add: disjoint_family_on_def simple_distributed_measure simple_distributed_simple_function simple_functionD
              intro!: sum.cong arg_cong[where f="prob"])
   also have "\<dots> = prob (space M)"
     by (auto intro!: arg_cong[where f=prob])
   finally show ?thesis
     using emeasure_space_1 by (simp add: emeasure_eq_measure)
 qed
 
 lemma (in prob_space) distributed_marginal_eq_joint_simple:
   assumes Px: "simple_function M X"
   assumes Py: "simple_distributed M Y Py"
   assumes Pxy: "simple_distributed M (\<lambda>x. (X x, Y x)) Pxy"
   assumes y: "y \<in> Y`space M"
   shows "Py y = (\<Sum>x\<in>X`space M. if (x, y) \<in> (\<lambda>x. (X x, Y x)) ` space M then Pxy (x, y) else 0)"
 proof -
   note Px = simple_distributedI[OF Px measure_nonneg refl]
   have "AE y in count_space (Y ` space M). ennreal (Py y) =
        \<integral>\<^sup>+ x. ennreal (if (x, y) \<in> (\<lambda>x. (X x, Y x)) ` space M then Pxy (x, y) else 0) \<partial>count_space (X ` space M)"
     using sigma_finite_measure_count_space_finite sigma_finite_measure_count_space_finite
       simple_distributed[OF Py] simple_distributed_joint[OF Pxy]
     by (rule distributed_marginal_eq_joint2)
        (auto intro: Py Px simple_distributed_finite)
   then have "ennreal (Py y) =
     (\<Sum>x\<in>X`space M. ennreal (if (x, y) \<in> (\<lambda>x. (X x, Y x)) ` space M then Pxy (x, y) else 0))"
     using y Px[THEN simple_distributed_finite]
     by (auto simp: AE_count_space nn_integral_count_space_finite)
   also have "\<dots> = (\<Sum>x\<in>X`space M. if (x, y) \<in> (\<lambda>x. (X x, Y x)) ` space M then Pxy (x, y) else 0)"
     using Pxy by (intro sum_ennreal) auto
   finally show ?thesis
     using simple_distributed_nonneg[OF Py] simple_distributed_nonneg[OF Pxy]
     by (subst (asm) ennreal_inj) (auto intro!: sum_nonneg)
 qed
 
 lemma distributedI_real:
   fixes f :: "'a \<Rightarrow> real"
   assumes gen: "sets M1 = sigma_sets (space M1) E" and "Int_stable E"
     and A: "range A \<subseteq> E" "(\<Union>i::nat. A i) = space M1" "\<And>i. emeasure (distr M M1 X) (A i) \<noteq> \<infinity>"
     and X: "X \<in> measurable M M1"
     and f: "f \<in> borel_measurable M1" "AE x in M1. 0 \<le> f x"
     and eq: "\<And>A. A \<in> E \<Longrightarrow> emeasure M (X -` A \<inter> space M) = (\<integral>\<^sup>+ x. f x * indicator A x \<partial>M1)"
   shows "distributed M M1 X f"
   unfolding distributed_def
 proof (intro conjI)
   show "distr M M1 X = density M1 f"
   proof (rule measure_eqI_generator_eq[where A=A])
     { fix A assume A: "A \<in> E"
       then have "A \<in> sigma_sets (space M1) E" by auto
       then have "A \<in> sets M1"
         using gen by simp
       with f A eq[of A] X show "emeasure (distr M M1 X) A = emeasure (density M1 f) A"
         by (auto simp add: emeasure_distr emeasure_density ennreal_indicator
                  intro!: nn_integral_cong split: split_indicator) }
     note eq_E = this
     show "Int_stable E" by fact
     { fix e assume "e \<in> E"
       then have "e \<in> sigma_sets (space M1) E" by auto
       then have "e \<in> sets M1" unfolding gen .
       then have "e \<subseteq> space M1" by (rule sets.sets_into_space) }
     then show "E \<subseteq> Pow (space M1)" by auto
     show "sets (distr M M1 X) = sigma_sets (space M1) E"
       "sets (density M1 (\<lambda>x. ennreal (f x))) = sigma_sets (space M1) E"
       unfolding gen[symmetric] by auto
   qed fact+
 qed (insert X f, auto)
 
 lemma distributedI_borel_atMost:
   fixes f :: "real \<Rightarrow> real"
   assumes [measurable]: "X \<in> borel_measurable M"
     and [measurable]: "f \<in> borel_measurable borel" and f[simp]: "AE x in lborel. 0 \<le> f x"
     and g_eq: "\<And>a. (\<integral>\<^sup>+x. f x * indicator {..a} x \<partial>lborel)  = ennreal (g a)"
     and M_eq: "\<And>a. emeasure M {x\<in>space M. X x \<le> a} = ennreal (g a)"
   shows "distributed M lborel X f"
 proof (rule distributedI_real)
   show "sets (lborel::real measure) = sigma_sets (space lborel) (range atMost)"
     by (simp add: borel_eq_atMost)
   show "Int_stable (range atMost :: real set set)"
     by (auto simp: Int_stable_def)
   have vimage_eq: "\<And>a. (X -` {..a} \<inter> space M) = {x\<in>space M. X x \<le> a}" by auto
   define A where "A i = {.. real i}" for i :: nat
   then show "range A \<subseteq> range atMost" "(\<Union>i. A i) = space lborel"
     "\<And>i. emeasure (distr M lborel X) (A i) \<noteq> \<infinity>"
     by (auto simp: real_arch_simple emeasure_distr vimage_eq M_eq)
 
   fix A :: "real set" assume "A \<in> range atMost"
   then obtain a where A: "A = {..a}" by auto
   show "emeasure M (X -` A \<inter> space M) = (\<integral>\<^sup>+x. f x * indicator A x \<partial>lborel)"
     unfolding vimage_eq A M_eq g_eq ..
 qed auto
 
 lemma (in prob_space) uniform_distributed_params:
   assumes X: "distributed M MX X (\<lambda>x. indicator A x / measure MX A)"
   shows "A \<in> sets MX" "measure MX A \<noteq> 0"
 proof -
   interpret X: prob_space "distr M MX X"
     using distributed_measurable[OF X] by (rule prob_space_distr)
 
   show "measure MX A \<noteq> 0"
   proof
     assume "measure MX A = 0"
     with X.emeasure_space_1 X.prob_space distributed_distr_eq_density[OF X]
     show False
       by (simp add: emeasure_density zero_ennreal_def[symmetric])
   qed
   with measure_notin_sets[of A MX] show "A \<in> sets MX"
     by blast
 qed
 
 lemma prob_space_uniform_measure:
   assumes A: "emeasure M A \<noteq> 0" "emeasure M A \<noteq> \<infinity>"
   shows "prob_space (uniform_measure M A)"
 proof
   show "emeasure (uniform_measure M A) (space (uniform_measure M A)) = 1"
     using emeasure_uniform_measure[OF emeasure_neq_0_sets[OF A(1)], of "space M"]
     using sets.sets_into_space[OF emeasure_neq_0_sets[OF A(1)]] A
     by (simp add: Int_absorb2 less_top)
 qed
 
 lemma prob_space_uniform_count_measure: "finite A \<Longrightarrow> A \<noteq> {} \<Longrightarrow> prob_space (uniform_count_measure A)"
   by standard (auto simp: emeasure_uniform_count_measure space_uniform_count_measure one_ennreal_def)
 
 lemma (in prob_space) measure_uniform_measure_eq_cond_prob:
   assumes [measurable]: "Measurable.pred M P" "Measurable.pred M Q"
   shows "\<P>(x in uniform_measure M {x\<in>space M. Q x}. P x) = \<P>(x in M. P x \<bar> Q x)"
 proof cases
   assume Q: "measure M {x\<in>space M. Q x} = 0"
   then have *: "AE x in M. \<not> Q x"
     by (simp add: prob_eq_0)
   then have "density M (\<lambda>x. indicator {x \<in> space M. Q x} x / emeasure M {x \<in> space M. Q x}) = density M (\<lambda>x. 0)"
     by (intro density_cong) auto
   with * show ?thesis
     unfolding uniform_measure_def
     by (simp add: emeasure_density measure_def cond_prob_def emeasure_eq_0_AE)
 next
   assume Q: "measure M {x\<in>space M. Q x} \<noteq> 0"
   then show "\<P>(x in uniform_measure M {x \<in> space M. Q x}. P x) = cond_prob M P Q"
     by (subst measure_uniform_measure)
        (auto simp: emeasure_eq_measure cond_prob_def measure_nonneg intro!: arg_cong[where f=prob])
 qed
 
 lemma prob_space_point_measure:
   "finite S \<Longrightarrow> (\<And>s. s \<in> S \<Longrightarrow> 0 \<le> p s) \<Longrightarrow> (\<Sum>s\<in>S. p s) = 1 \<Longrightarrow> prob_space (point_measure S p)"
   by (rule prob_spaceI) (simp add: space_point_measure emeasure_point_measure_finite)
 
 lemma (in prob_space) distr_pair_fst: "distr (N \<Otimes>\<^sub>M M) N fst = N"
 proof (intro measure_eqI)
   fix A assume A: "A \<in> sets (distr (N \<Otimes>\<^sub>M M) N fst)"
   from A have "emeasure (distr (N \<Otimes>\<^sub>M M) N fst) A = emeasure (N \<Otimes>\<^sub>M M) (A \<times> space M)"
     by (auto simp add: emeasure_distr space_pair_measure dest: sets.sets_into_space intro!: arg_cong2[where f=emeasure])
   with A show "emeasure (distr (N \<Otimes>\<^sub>M M) N fst) A = emeasure N A"
     by (simp add: emeasure_pair_measure_Times emeasure_space_1)
 qed simp
 
 lemma (in product_prob_space) distr_reorder:
   assumes "inj_on t J" "t \<in> J \<rightarrow> K" "finite K"
   shows "distr (PiM K M) (Pi\<^sub>M J (\<lambda>x. M (t x))) (\<lambda>\<omega>. \<lambda>n\<in>J. \<omega> (t n)) = PiM J (\<lambda>x. M (t x))"
 proof (rule product_sigma_finite.PiM_eqI)
   show "product_sigma_finite (\<lambda>x. M (t x))" ..
   have "t`J \<subseteq> K" using assms by auto
   then show [simp]: "finite J"
     by (rule finite_imageD[OF finite_subset]) fact+
   fix A assume A: "\<And>i. i \<in> J \<Longrightarrow> A i \<in> sets (M (t i))"
   moreover have "((\<lambda>\<omega>. \<lambda>n\<in>J. \<omega> (t n)) -` Pi\<^sub>E J A \<inter> space (Pi\<^sub>M K M)) =
     (\<Pi>\<^sub>E i\<in>K. if i \<in> t`J then A (the_inv_into J t i) else space (M i))"
     using A A[THEN sets.sets_into_space] \<open>t \<in> J \<rightarrow> K\<close> \<open>inj_on t J\<close>
     by (subst prod_emb_Pi[symmetric]) (auto simp: space_PiM PiE_iff the_inv_into_f_f prod_emb_def)
   ultimately show "distr (Pi\<^sub>M K M) (Pi\<^sub>M J (\<lambda>x. M (t x))) (\<lambda>\<omega>. \<lambda>n\<in>J. \<omega> (t n)) (Pi\<^sub>E J A) = (\<Prod>i\<in>J. M (t i) (A i))"
     using assms
     apply (subst emeasure_distr)
     apply (auto intro!: sets_PiM_I_finite simp: Pi_iff)
     apply (subst emeasure_PiM)
     apply (auto simp: the_inv_into_f_f \<open>inj_on t J\<close> prod.reindex[OF \<open>inj_on t J\<close>]
       if_distrib[where f="emeasure (M _)"] prod.If_cases emeasure_space_1 Int_absorb1 \<open>t`J \<subseteq> K\<close>)
     done
 qed simp
 
 lemma (in product_prob_space) distr_restrict:
   "J \<subseteq> K \<Longrightarrow> finite K \<Longrightarrow> (\<Pi>\<^sub>M i\<in>J. M i) = distr (\<Pi>\<^sub>M i\<in>K. M i) (\<Pi>\<^sub>M i\<in>J. M i) (\<lambda>f. restrict f J)"
   using distr_reorder[of "\<lambda>x. x" J K] by (simp add: Pi_iff subset_eq)
 
 lemma (in product_prob_space) emeasure_prod_emb[simp]:
   assumes L: "J \<subseteq> L" "finite L" and X: "X \<in> sets (Pi\<^sub>M J M)"
   shows "emeasure (Pi\<^sub>M L M) (prod_emb L M J X) = emeasure (Pi\<^sub>M J M) X"
   by (subst distr_restrict[OF L])
      (simp add: prod_emb_def space_PiM emeasure_distr measurable_restrict_subset L X)
 
 lemma emeasure_distr_restrict:
   assumes "I \<subseteq> K" and Q[measurable_cong]: "sets Q = sets (PiM K M)" and A[measurable]: "A \<in> sets (PiM I M)"
   shows "emeasure (distr Q (PiM I M) (\<lambda>\<omega>. restrict \<omega> I)) A = emeasure Q (prod_emb K M I A)"
   using \<open>I\<subseteq>K\<close> sets_eq_imp_space_eq[OF Q]
   by (subst emeasure_distr)
      (auto simp: measurable_cong_sets[OF Q] prod_emb_def space_PiM[symmetric] intro!: measurable_restrict)
 
 lemma (in prob_space) prob_space_completion: "prob_space (completion M)"
   by (rule prob_spaceI) (simp add: emeasure_space_1)
 
 lemma distr_PiM_finite_prob_space:
   assumes fin: "finite I"
   assumes "product_prob_space M"
   assumes "product_prob_space M'"
   assumes [measurable]: "\<And>i. i \<in> I \<Longrightarrow> f \<in> measurable (M i) (M' i)"
   shows   "distr (PiM I M) (PiM I M') (compose I f) = PiM I (\<lambda>i. distr (M i) (M' i) f)"
 proof -
   interpret M: product_prob_space M by fact
   interpret M': product_prob_space M' by fact
   define N where "N = (\<lambda>i. if i \<in> I then distr (M i) (M' i) f else M' i)"
   have [intro]: "prob_space (N i)" for i
     by (auto simp: N_def intro!: M.M.prob_space_distr M'.prob_space)
 
   interpret N: product_prob_space N
     by (intro product_prob_spaceI) (auto simp: N_def M'.prob_space intro: M.M.prob_space_distr)
 
   have "distr (PiM I M) (PiM I M') (compose I f) = PiM I N"
   proof (rule N.PiM_eqI)
     have N_events_eq: "sets (Pi\<^sub>M I N) = sets (Pi\<^sub>M I M')"
       unfolding N_def by (intro sets_PiM_cong) auto
     also have "\<dots> = sets (distr (Pi\<^sub>M I M) (Pi\<^sub>M I M') (compose I f))"
       by simp
     finally show "sets (distr (Pi\<^sub>M I M) (Pi\<^sub>M I M') (compose I f)) = sets (Pi\<^sub>M I N)"  ..
 
     fix A assume A: "\<And>i. i \<in> I \<Longrightarrow> A i \<in> N.M.events i"
     have "emeasure (distr (Pi\<^sub>M I M) (Pi\<^sub>M I M') (compose I f)) (Pi\<^sub>E I A) =
           emeasure (Pi\<^sub>M I M) (compose I f -` Pi\<^sub>E I A \<inter> space (Pi\<^sub>M I M))"
     proof (intro emeasure_distr)
       show "compose I f \<in> Pi\<^sub>M I M \<rightarrow>\<^sub>M Pi\<^sub>M I M'"
         unfolding compose_def by measurable
       show "Pi\<^sub>E I A \<in> sets (Pi\<^sub>M I M')"
         unfolding N_events_eq [symmetric] by (intro sets_PiM_I_finite fin A)
     qed
     also have "compose I f -` Pi\<^sub>E I A \<inter> space (Pi\<^sub>M I M) = Pi\<^sub>E I (\<lambda>i. f -` A i \<inter> space (M i))"
       using A by (auto simp: space_PiM PiE_def Pi_def extensional_def N_def compose_def)
     also have "emeasure (Pi\<^sub>M I M) (Pi\<^sub>E I (\<lambda>i. f -` A i \<inter> space (M i))) =
           (\<Prod>i\<in>I. emeasure (M i) (f -` A i \<inter> space (M i)))"
       using A by (intro M.emeasure_PiM fin) (auto simp: N_def)
     also have "\<dots> = (\<Prod>i\<in>I. emeasure (distr (M i) (M' i) f) (A i))"
       using A by (intro prod.cong emeasure_distr [symmetric]) (auto simp: N_def)
     also have "\<dots> = (\<Prod>i\<in>I. emeasure (N i) (A i))"
       unfolding N_def by (intro prod.cong) (auto simp: N_def)
     finally show "emeasure (distr (Pi\<^sub>M I M) (Pi\<^sub>M I M') (compose I f)) (Pi\<^sub>E I A) = \<dots>" .
   qed fact+
   also have "PiM I N = PiM I (\<lambda>i. distr (M i) (M' i) f)"
     by (intro PiM_cong) (auto simp: N_def)
   finally show ?thesis .
 qed
 
 end
diff --git a/src/HOL/Probability/Projective_Limit.thy b/src/HOL/Probability/Projective_Limit.thy
--- a/src/HOL/Probability/Projective_Limit.thy
+++ b/src/HOL/Probability/Projective_Limit.thy
@@ -1,483 +1,487 @@
 (*  Title:      HOL/Probability/Projective_Limit.thy
     Author:     Fabian Immler, TU München
 *)
 
 section \<open>Projective Limit\<close>
 
 theory Projective_Limit
 imports
   Fin_Map
   Infinite_Product_Measure
   "HOL-Library.Diagonal_Subsequence"
 begin
 
 subsection \<open>Sequences of Finite Maps in Compact Sets\<close>
 
 locale finmap_seqs_into_compact =
   fixes K::"nat \<Rightarrow> (nat \<Rightarrow>\<^sub>F 'a::metric_space) set" and f::"nat \<Rightarrow> (nat \<Rightarrow>\<^sub>F 'a)" and M
   assumes compact: "\<And>n. compact (K n)"
   assumes f_in_K: "\<And>n. K n \<noteq> {}"
   assumes domain_K: "\<And>n. k \<in> K n \<Longrightarrow> domain k = domain (f n)"
   assumes proj_in_K:
     "\<And>t n m. m \<ge> n \<Longrightarrow> t \<in> domain (f n) \<Longrightarrow> (f m)\<^sub>F t \<in> (\<lambda>k. (k)\<^sub>F t) ` K n"
 begin
 
 lemma proj_in_K': "(\<exists>n. \<forall>m \<ge> n. (f m)\<^sub>F t \<in> (\<lambda>k. (k)\<^sub>F t) ` K n)"
   using proj_in_K f_in_K
 proof cases
   obtain k where "k \<in> K (Suc 0)" using f_in_K by auto
   assume "\<forall>n. t \<notin> domain (f n)"
   thus ?thesis
     by (auto intro!: exI[where x=1] image_eqI[OF _ \<open>k \<in> K (Suc 0)\<close>]
       simp: domain_K[OF \<open>k \<in> K (Suc 0)\<close>])
 qed blast
 
 lemma proj_in_KE:
   obtains n where "\<And>m. m \<ge> n \<Longrightarrow> (f m)\<^sub>F t \<in> (\<lambda>k. (k)\<^sub>F t) ` K n"
   using proj_in_K' by blast
 
 lemma compact_projset:
   shows "compact ((\<lambda>k. (k)\<^sub>F i) ` K n)"
   using continuous_proj compact by (rule compact_continuous_image)
 
 end
 
 lemma compactE':
   fixes S :: "'a :: metric_space set"
   assumes "compact S" "\<forall>n\<ge>m. f n \<in> S"
   obtains l r where "l \<in> S" "strict_mono (r::nat\<Rightarrow>nat)" "((f \<circ> r) \<longlongrightarrow> l) sequentially"
 proof atomize_elim
   have "strict_mono ((+) m)" by (simp add: strict_mono_def)
   have "\<forall>n. (f o (\<lambda>i. m + i)) n \<in> S" using assms by auto
-  from seq_compactE[OF \<open>compact S\<close>[unfolded compact_eq_seq_compact_metric] this] guess l r .
+  from seq_compactE[OF \<open>compact S\<close>[unfolded compact_eq_seq_compact_metric] this]
+  obtain l r where "l \<in> S" "strict_mono r" "(f \<circ> (+) m \<circ> r) \<longlonglongrightarrow> l" by blast
   hence "l \<in> S" "strict_mono ((\<lambda>i. m + i) o r) \<and> (f \<circ> ((\<lambda>i. m + i) o r)) \<longlonglongrightarrow> l"
     using strict_mono_o[OF \<open>strict_mono ((+) m)\<close> \<open>strict_mono r\<close>] by (auto simp: o_def)
   thus "\<exists>l r. l \<in> S \<and> strict_mono r \<and> (f \<circ> r) \<longlonglongrightarrow> l" by blast
 qed
 
 sublocale finmap_seqs_into_compact \<subseteq> subseqs "\<lambda>n s. (\<exists>l. (\<lambda>i. ((f o s) i)\<^sub>F n) \<longlonglongrightarrow> l)"
 proof
   fix n and s :: "nat \<Rightarrow> nat"
   assume "strict_mono s"
-  from proj_in_KE[of n] guess n0 . note n0 = this
+  from proj_in_KE[of n] obtain n0 where n0: "\<And>m. n0 \<le> m \<Longrightarrow> (f m)\<^sub>F n \<in> (\<lambda>k. (k)\<^sub>F n) ` K n0"
+    by blast
   have "\<forall>i \<ge> n0. ((f \<circ> s) i)\<^sub>F n \<in> (\<lambda>k. (k)\<^sub>F n) ` K n0"
   proof safe
     fix i assume "n0 \<le> i"
     also have "\<dots> \<le> s i" by (rule seq_suble) fact
     finally have "n0 \<le> s i" .
     with n0 show "((f \<circ> s) i)\<^sub>F n \<in> (\<lambda>k. (k)\<^sub>F n) ` K n0 "
       by auto
   qed
-  from compactE'[OF compact_projset this] guess ls rs .
+  then obtain ls rs
+    where "ls \<in> (\<lambda>k. (k)\<^sub>F n) ` K n0" "strict_mono rs" "((\<lambda>i. ((f \<circ> s) i)\<^sub>F n) \<circ> rs) \<longlonglongrightarrow> ls"
+    by (rule compactE'[OF compact_projset])
   thus "\<exists>r'. strict_mono r' \<and> (\<exists>l. (\<lambda>i. ((f \<circ> (s \<circ> r')) i)\<^sub>F n) \<longlonglongrightarrow> l)" by (auto simp: o_def)
 qed
 
 lemma (in finmap_seqs_into_compact) diagonal_tendsto: "\<exists>l. (\<lambda>i. (f (diagseq i))\<^sub>F n) \<longlonglongrightarrow> l"
 proof -
   obtain l where "(\<lambda>i. ((f o (diagseq o (+) (Suc n))) i)\<^sub>F n) \<longlonglongrightarrow> l"
   proof (atomize_elim, rule diagseq_holds)
     fix r s n
     assume "strict_mono (r :: nat \<Rightarrow> nat)"
     assume "\<exists>l. (\<lambda>i. ((f \<circ> s) i)\<^sub>F n) \<longlonglongrightarrow> l"
     then obtain l where "((\<lambda>i. (f i)\<^sub>F n) o s) \<longlonglongrightarrow> l"
       by (auto simp: o_def)
     hence "((\<lambda>i. (f i)\<^sub>F n) o s o r) \<longlonglongrightarrow> l" using \<open>strict_mono r\<close>
       by (rule LIMSEQ_subseq_LIMSEQ)
     thus "\<exists>l. (\<lambda>i. ((f \<circ> (s \<circ> r)) i)\<^sub>F n) \<longlonglongrightarrow> l" by (auto simp add: o_def)
   qed
   hence "(\<lambda>i. ((f (diagseq (i + Suc n))))\<^sub>F n) \<longlonglongrightarrow> l" by (simp add: ac_simps)
   hence "(\<lambda>i. (f (diagseq i))\<^sub>F n) \<longlonglongrightarrow> l" by (rule LIMSEQ_offset)
   thus ?thesis ..
 qed
 
 subsection \<open>Daniell-Kolmogorov Theorem\<close>
 
 text \<open>Existence of Projective Limit\<close>
 
 locale polish_projective = projective_family I P "\<lambda>_. borel::'a::polish_space measure"
   for I::"'i set" and P
 begin
 
 lemma emeasure_lim_emb:
   assumes X: "J \<subseteq> I" "finite J" "X \<in> sets (\<Pi>\<^sub>M i\<in>J. borel)"
   shows "lim (emb I J X) = P J X"
 proof (rule emeasure_lim)
   write mu_G ("\<mu>G")
   interpret generator: algebra "space (PiM I (\<lambda>i. borel))" generator
     by (rule algebra_generator)
 
   fix J and B :: "nat \<Rightarrow> ('i \<Rightarrow> 'a) set"
   assume J: "\<And>n. finite (J n)" "\<And>n. J n \<subseteq> I" "\<And>n. B n \<in> sets (\<Pi>\<^sub>M i\<in>J n. borel)" "incseq J"
     and B: "decseq (\<lambda>n. emb I (J n) (B n))"
     and "0 < (INF i. P (J i) (B i))" (is "0 < ?a")
   moreover have "?a \<le> 1"
     using J by (auto intro!: INF_lower2[of 0] prob_space_P[THEN prob_space.measure_le_1])
   ultimately obtain r where r: "?a = ennreal r" "0 < r" "r \<le> 1"
     by (cases "?a") (auto simp: top_unique)
   define Z where "Z n = emb I (J n) (B n)" for n
   have Z_mono: "n \<le> m \<Longrightarrow> Z m \<subseteq> Z n" for n m
     unfolding Z_def using B[THEN antimonoD, of n m] .
   have J_mono: "\<And>n m. n \<le> m \<Longrightarrow> J n \<subseteq> J m"
     using \<open>incseq J\<close> by (force simp: incseq_def)
   note [simp] = \<open>\<And>n. finite (J n)\<close>
   interpret prob_space "P (J i)" for i using J prob_space_P by simp
 
   have P_eq[simp]:
       "sets (P (J i)) = sets (\<Pi>\<^sub>M i\<in>J i. borel)" "space (P (J i)) = space (\<Pi>\<^sub>M i\<in>J i. borel)" for i
     using J by (auto simp: sets_P space_P)
 
   have "Z i \<in> generator" for i
     unfolding Z_def by (auto intro!: generator.intros J)
 
   have countable_UN_J: "countable (\<Union>n. J n)" by (simp add: countable_finite)
   define Utn where "Utn = to_nat_on (\<Union>n. J n)"
   interpret function_to_finmap "J n" Utn "from_nat_into (\<Union>n. J n)" for n
     by unfold_locales (auto simp: Utn_def intro: from_nat_into_to_nat_on[OF countable_UN_J])
   have inj_on_Utn: "inj_on Utn (\<Union>n. J n)"
     unfolding Utn_def using countable_UN_J by (rule inj_on_to_nat_on)
   hence inj_on_Utn_J: "\<And>n. inj_on Utn (J n)" by (rule subset_inj_on) auto
   define P' where "P' n = mapmeasure n (P (J n)) (\<lambda>_. borel)" for n
   interpret P': prob_space "P' n" for n
     unfolding P'_def mapmeasure_def using J
     by (auto intro!: prob_space_distr fm_measurable simp: measurable_cong_sets[OF sets_P])
 
   let ?SUP = "\<lambda>n. SUP K \<in> {K. K \<subseteq> fm n ` (B n) \<and> compact K}. emeasure (P' n) K"
   { fix n
     have "emeasure (P (J n)) (B n) = emeasure (P' n) (fm n ` (B n))"
       using J by (auto simp: P'_def mapmeasure_PiM space_P sets_P)
     also
     have "\<dots> = ?SUP n"
     proof (rule inner_regular)
       show "sets (P' n) = sets borel" by (simp add: borel_eq_PiF_borel P'_def)
     next
       show "fm n ` B n \<in> sets borel"
         unfolding borel_eq_PiF_borel by (auto simp: P'_def fm_image_measurable_finite sets_P J(3))
     qed simp
     finally have *: "emeasure (P (J n)) (B n) = ?SUP n" .
     have "?SUP n \<noteq> \<infinity>"
       unfolding *[symmetric] by simp
     note * this
   } note R = this
   have "\<forall>n. \<exists>K. emeasure (P (J n)) (B n) - emeasure (P' n) K \<le> 2 powr (-n) * ?a \<and> compact K \<and> K \<subseteq> fm n ` B n"
   proof
     fix n show "\<exists>K. emeasure (P (J n)) (B n) - emeasure (P' n) K \<le> ennreal (2 powr - real n) * ?a \<and>
         compact K \<and> K \<subseteq> fm n ` B n"
       unfolding R[of n]
     proof (rule ccontr)
       assume H: "\<nexists>K'. ?SUP n - emeasure (P' n) K' \<le> ennreal (2 powr - real n)  * ?a \<and>
         compact K' \<and> K' \<subseteq> fm n ` B n"
       have "?SUP n + 0 < ?SUP n + 2 powr (-n) * ?a"
         using R[of n] unfolding ennreal_add_left_cancel_less ennreal_zero_less_mult_iff
         by (auto intro: \<open>0 < ?a\<close>)
       also have "\<dots> = (SUP K\<in>{K. K \<subseteq> fm n ` B n \<and> compact K}. emeasure (P' n) K + 2 powr (-n) * ?a)"
         by (rule ennreal_SUP_add_left[symmetric]) auto
       also have "\<dots> \<le> ?SUP n"
       proof (intro SUP_least)
         fix K assume "K \<in> {K. K \<subseteq> fm n ` B n \<and> compact K}"
         with H have "2 powr (-n) * ?a < ?SUP n - emeasure (P' n) K"
           by auto
         then show "emeasure (P' n) K + (2 powr (-n)) * ?a \<le> ?SUP n"
           by (subst (asm) less_diff_eq_ennreal) (auto simp: less_top[symmetric] R(1)[symmetric] ac_simps)
       qed
       finally show False by simp
     qed
   qed
   then obtain K' where K':
     "\<And>n. emeasure (P (J n)) (B n) - emeasure (P' n) (K' n) \<le> ennreal (2 powr - real n) * ?a"
     "\<And>n. compact (K' n)" "\<And>n. K' n \<subseteq> fm n ` B n"
     unfolding choice_iff by blast
   define K where "K n = fm n -` K' n \<inter> space (Pi\<^sub>M (J n) (\<lambda>_. borel))" for n
   have K_sets: "\<And>n. K n \<in> sets (Pi\<^sub>M (J n) (\<lambda>_. borel))"
     unfolding K_def
     using compact_imp_closed[OF \<open>compact (K' _)\<close>]
     by (intro measurable_sets[OF fm_measurable, of _ "Collect finite"])
        (auto simp: borel_eq_PiF_borel[symmetric])
   have K_B: "\<And>n. K n \<subseteq> B n"
   proof
     fix x n assume "x \<in> K n"
     then have fm_in: "fm n x \<in> fm n ` B n"
       using K' by (force simp: K_def)
     show "x \<in> B n"
       using \<open>x \<in> K n\<close> K_sets sets.sets_into_space J(1,2,3)[of n] inj_on_image_mem_iff[OF inj_on_fm]
     by (metis (no_types) Int_iff K_def fm_in space_borel)
   qed
   define Z' where "Z' n = emb I (J n) (K n)" for n
   have Z': "\<And>n. Z' n \<subseteq> Z n"
     unfolding Z'_def Z_def
   proof (rule prod_emb_mono, safe)
     fix n x assume "x \<in> K n"
     hence "fm n x \<in> K' n" "x \<in> space (Pi\<^sub>M (J n) (\<lambda>_. borel))"
       by (simp_all add: K_def space_P)
     note this(1)
     also have "K' n \<subseteq> fm n ` B n" by (simp add: K')
     finally have "fm n x \<in> fm n ` B n" .
     thus "x \<in> B n"
     proof safe
       fix y assume y: "y \<in> B n"
       hence "y \<in> space (Pi\<^sub>M (J n) (\<lambda>_. borel))" using J sets.sets_into_space[of "B n" "P (J n)"]
         by (auto simp add: space_P sets_P)
       assume "fm n x = fm n y"
       note inj_onD[OF inj_on_fm[OF space_borel],
         OF \<open>fm n x = fm n y\<close> \<open>x \<in> space _\<close> \<open>y \<in> space _\<close>]
       with y show "x \<in> B n" by simp
     qed
   qed
   have "\<And>n. Z' n \<in> generator" using J K'(2) unfolding Z'_def
     by (auto intro!: generator.intros measurable_sets[OF fm_measurable[of _ "Collect finite"]]
              simp: K_def borel_eq_PiF_borel[symmetric] compact_imp_closed)
   define Y where "Y n = (\<Inter>i\<in>{1..n}. Z' i)" for n
   hence "\<And>n k. Y (n + k) \<subseteq> Y n" by (induct_tac k) (auto simp: Y_def)
   hence Y_mono: "\<And>n m. n \<le> m \<Longrightarrow> Y m \<subseteq> Y n" by (auto simp: le_iff_add)
   have Y_Z': "\<And>n. n \<ge> 1 \<Longrightarrow> Y n \<subseteq> Z' n" by (auto simp: Y_def)
   hence Y_Z: "\<And>n. n \<ge> 1 \<Longrightarrow> Y n \<subseteq> Z n" using Z' by auto
 
   have Y_notempty: "\<And>n. n \<ge> 1 \<Longrightarrow> (Y n) \<noteq> {}"
   proof -
     fix n::nat assume "n \<ge> 1" hence "Y n \<subseteq> Z n" by fact
     have "Y n = (\<Inter>i\<in>{1..n}. emb I (J n) (emb (J n) (J i) (K i)))" using J J_mono
       by (auto simp: Y_def Z'_def)
     also have "\<dots> = prod_emb I (\<lambda>_. borel) (J n) (\<Inter>i\<in>{1..n}. emb (J n) (J i) (K i))"
       using \<open>n \<ge> 1\<close>
       by (subst prod_emb_INT) auto
     finally
     have Y_emb:
       "Y n = prod_emb I (\<lambda>_. borel) (J n) (\<Inter>i\<in>{1..n}. prod_emb (J n) (\<lambda>_. borel) (J i) (K i))" .
     hence "Y n \<in> generator" using J J_mono K_sets \<open>n \<ge> 1\<close>
       by (auto simp del: prod_emb_INT intro!: generator.intros)
     have *: "\<mu>G (Z n) = P (J n) (B n)"
       unfolding Z_def using J by (intro mu_G_spec) auto
     then have "\<mu>G (Z n) \<noteq> \<infinity>" by auto
     note *
     moreover have *: "\<mu>G (Y n) = P (J n) (\<Inter>i\<in>{Suc 0..n}. prod_emb (J n) (\<lambda>_. borel) (J i) (K i))"
       unfolding Y_emb using J J_mono K_sets \<open>n \<ge> 1\<close> by (subst mu_G_spec) auto
     then have "\<mu>G (Y n) \<noteq> \<infinity>" by auto
     note *
     moreover have "\<mu>G (Z n - Y n) =
         P (J n) (B n - (\<Inter>i\<in>{Suc 0..n}. prod_emb (J n) (\<lambda>_. borel) (J i) (K i)))"
       unfolding Z_def Y_emb prod_emb_Diff[symmetric] using J J_mono K_sets \<open>n \<ge> 1\<close>
       by (subst mu_G_spec) (auto intro!: sets.Diff)
     ultimately
     have "\<mu>G (Z n) - \<mu>G (Y n) = \<mu>G (Z n - Y n)"
       using J J_mono K_sets \<open>n \<ge> 1\<close>
       by (simp only: emeasure_eq_measure Z_def)
          (auto dest!: bspec[where x=n] intro!: measure_Diff[symmetric] subsetD[OF K_B]
                intro!: arg_cong[where f=ennreal]
                simp: extensional_restrict emeasure_eq_measure prod_emb_iff sets_P space_P
                      ennreal_minus measure_nonneg)
     also have subs: "Z n - Y n \<subseteq> (\<Union>i\<in>{1..n}. (Z i - Z' i))"
       using \<open>n \<ge> 1\<close> unfolding Y_def UN_extend_simps(7) by (intro UN_mono Diff_mono Z_mono order_refl) auto
     have "Z n - Y n \<in> generator" "(\<Union>i\<in>{1..n}. (Z i - Z' i)) \<in> generator"
       using \<open>Z' _ \<in> generator\<close> \<open>Z _ \<in> generator\<close> \<open>Y _ \<in> generator\<close> by auto
     hence "\<mu>G (Z n - Y n) \<le> \<mu>G (\<Union>i\<in>{1..n}. (Z i - Z' i))"
       using subs generator.additive_increasing[OF positive_mu_G additive_mu_G]
       unfolding increasing_def by auto
     also have "\<dots> \<le> (\<Sum> i\<in>{1..n}. \<mu>G (Z i - Z' i))" using \<open>Z _ \<in> generator\<close> \<open>Z' _ \<in> generator\<close>
       by (intro generator.subadditive[OF positive_mu_G additive_mu_G]) auto
     also have "\<dots> \<le> (\<Sum> i\<in>{1..n}. 2 powr -real i * ?a)"
     proof (rule sum_mono)
       fix i assume "i \<in> {1..n}" hence "i \<le> n" by simp
       have "\<mu>G (Z i - Z' i) = \<mu>G (prod_emb I (\<lambda>_. borel) (J i) (B i - K i))"
         unfolding Z'_def Z_def by simp
       also have "\<dots> = P (J i) (B i - K i)"
         using J K_sets by (subst mu_G_spec) auto
       also have "\<dots> = P (J i) (B i) - P (J i) (K i)"
         using K_sets J \<open>K _ \<subseteq> B _\<close> by (simp add: emeasure_Diff)
       also have "\<dots> = P (J i) (B i) - P' i (K' i)"
         unfolding K_def P'_def
         by (auto simp: mapmeasure_PiF borel_eq_PiF_borel[symmetric]
           compact_imp_closed[OF \<open>compact (K' _)\<close>] space_PiM PiE_def)
       also have "\<dots> \<le> ennreal (2 powr - real i) * ?a" using K'(1)[of i] .
       finally show "\<mu>G (Z i - Z' i) \<le> (2 powr - real i) * ?a" .
     qed
     also have "\<dots> = ennreal ((\<Sum> i\<in>{1..n}. (2 powr -enn2real i)) * enn2real ?a)"
       using r by (simp add: sum_distrib_right ennreal_mult[symmetric])
     also have "\<dots> < ennreal (1 * enn2real ?a)"
     proof (intro ennreal_lessI mult_strict_right_mono)
       have "(\<Sum>i = 1..n. 2 powr - real i) = (\<Sum>i = 1..<Suc n. (1/2) ^ i)"
         by (rule sum.cong) (auto simp: powr_realpow powr_divide power_divide powr_minus_divide)
       also have "{1..<Suc n} = {..<Suc n} - {0}" by auto
       also have "sum ((^) (1 / 2::real)) ({..<Suc n} - {0}) =
         sum ((^) (1 / 2)) ({..<Suc n}) - 1" by (auto simp: sum_diff1)
       also have "\<dots> < 1" by (subst geometric_sum) auto
       finally show "(\<Sum>i = 1..n. 2 powr - enn2real i) < 1" by simp
     qed (auto simp: r enn2real_positive_iff)
     also have "\<dots> = ?a" by (auto simp: r)
     also have "\<dots> \<le> \<mu>G (Z n)"
       using J by (auto intro: INF_lower simp: Z_def mu_G_spec)
     finally have "\<mu>G (Z n) - \<mu>G (Y n) < \<mu>G (Z n)" .
     hence R: "\<mu>G (Z n) < \<mu>G (Z n) + \<mu>G (Y n)"
       using \<open>\<mu>G (Y n) \<noteq> \<infinity>\<close> by (auto simp: zero_less_iff_neq_zero)
     then have "\<mu>G (Y n) > 0"
       by simp
     thus "Y n \<noteq> {}" using positive_mu_G by (auto simp add: positive_def)
   qed
   hence "\<forall>n\<in>{1..}. \<exists>y. y \<in> Y n" by auto
   then obtain y where y: "\<And>n. n \<ge> 1 \<Longrightarrow> y n \<in> Y n" unfolding bchoice_iff by force
   {
     fix t and n m::nat
     assume "1 \<le> n" "n \<le> m" hence "1 \<le> m" by simp
     from Y_mono[OF \<open>m \<ge> n\<close>] y[OF \<open>1 \<le> m\<close>] have "y m \<in> Y n" by auto
     also have "\<dots> \<subseteq> Z' n" using Y_Z'[OF \<open>1 \<le> n\<close>] .
     finally
     have "fm n (restrict (y m) (J n)) \<in> K' n"
       unfolding Z'_def K_def prod_emb_iff by (simp add: Z'_def K_def prod_emb_iff)
     moreover have "finmap_of (J n) (restrict (y m) (J n)) = finmap_of (J n) (y m)"
       using J by (simp add: fm_def)
     ultimately have "fm n (y m) \<in> K' n" by simp
   } note fm_in_K' = this
   interpret finmap_seqs_into_compact "\<lambda>n. K' (Suc n)" "\<lambda>k. fm (Suc k) (y (Suc k))" borel
   proof
     fix n show "compact (K' n)" by fact
   next
     fix n
     from Y_mono[of n "Suc n"] y[of "Suc n"] have "y (Suc n) \<in> Y (Suc n)" by auto
     also have "\<dots> \<subseteq> Z' (Suc n)" using Y_Z' by auto
     finally
     have "fm (Suc n) (restrict (y (Suc n)) (J (Suc n))) \<in> K' (Suc n)"
       unfolding Z'_def K_def prod_emb_iff by (simp add: Z'_def K_def prod_emb_iff)
     thus "K' (Suc n) \<noteq> {}" by auto
     fix k
     assume "k \<in> K' (Suc n)"
     with K'[of "Suc n"] sets.sets_into_space have "k \<in> fm (Suc n) ` B (Suc n)" by auto
     then obtain b where "k = fm (Suc n) b" by auto
     thus "domain k = domain (fm (Suc n) (y (Suc n)))"
       by (simp_all add: fm_def)
   next
     fix t and n m::nat
     assume "n \<le> m" hence "Suc n \<le> Suc m" by simp
     assume "t \<in> domain (fm (Suc n) (y (Suc n)))"
     then obtain j where j: "t = Utn j" "j \<in> J (Suc n)" by auto
     hence "j \<in> J (Suc m)" using J_mono[OF \<open>Suc n \<le> Suc m\<close>] by auto
     have img: "fm (Suc n) (y (Suc m)) \<in> K' (Suc n)" using \<open>n \<le> m\<close>
       by (intro fm_in_K') simp_all
     show "(fm (Suc m) (y (Suc m)))\<^sub>F t \<in> (\<lambda>k. (k)\<^sub>F t) ` K' (Suc n)"
       apply (rule image_eqI[OF _ img])
       using \<open>j \<in> J (Suc n)\<close> \<open>j \<in> J (Suc m)\<close>
       unfolding j by (subst proj_fm, auto)+
   qed
   have "\<forall>t. \<exists>z. (\<lambda>i. (fm (Suc (diagseq i)) (y (Suc (diagseq i))))\<^sub>F t) \<longlonglongrightarrow> z"
     using diagonal_tendsto ..
   then obtain z where z:
     "\<And>t. (\<lambda>i. (fm (Suc (diagseq i)) (y (Suc (diagseq i))))\<^sub>F t) \<longlonglongrightarrow> z t"
     unfolding choice_iff by blast
   {
     fix n :: nat assume "n \<ge> 1"
     have "\<And>i. domain (fm n (y (Suc (diagseq i)))) = domain (finmap_of (Utn ` J n) z)"
       by simp
     moreover
     {
       fix t
       assume t: "t \<in> domain (finmap_of (Utn ` J n) z)"
       hence "t \<in> Utn ` J n" by simp
       then obtain j where j: "t = Utn j" "j \<in> J n" by auto
       have "(\<lambda>i. (fm n (y (Suc (diagseq i))))\<^sub>F t) \<longlonglongrightarrow> z t"
         apply (subst (2) tendsto_iff, subst eventually_sequentially)
       proof safe
         fix e :: real assume "0 < e"
         { fix i and x :: "'i \<Rightarrow> 'a" assume i: "i \<ge> n"
           assume "t \<in> domain (fm n x)"
           hence "t \<in> domain (fm i x)" using J_mono[OF \<open>i \<ge> n\<close>] by auto
           with i have "(fm i x)\<^sub>F t = (fm n x)\<^sub>F t"
             using j by (auto simp: proj_fm dest!: inj_onD[OF inj_on_Utn])
         } note index_shift = this
         have I: "\<And>i. i \<ge> n \<Longrightarrow> Suc (diagseq i) \<ge> n"
           apply (rule le_SucI)
           apply (rule order_trans) apply simp
           apply (rule seq_suble[OF subseq_diagseq])
           done
         from z
         have "\<exists>N. \<forall>i\<ge>N. dist ((fm (Suc (diagseq i)) (y (Suc (diagseq i))))\<^sub>F t) (z t) < e"
           unfolding tendsto_iff eventually_sequentially using \<open>0 < e\<close> by auto
         then obtain N where N: "\<And>i. i \<ge> N \<Longrightarrow>
           dist ((fm (Suc (diagseq i)) (y (Suc (diagseq i))))\<^sub>F t) (z t) < e" by auto
         show "\<exists>N. \<forall>na\<ge>N. dist ((fm n (y (Suc (diagseq na))))\<^sub>F t) (z t) < e "
         proof (rule exI[where x="max N n"], safe)
           fix na assume "max N n \<le> na"
           hence  "dist ((fm n (y (Suc (diagseq na))))\<^sub>F t) (z t) =
                   dist ((fm (Suc (diagseq na)) (y (Suc (diagseq na))))\<^sub>F t) (z t)" using t
             by (subst index_shift[OF I]) auto
           also have "\<dots> < e" using \<open>max N n \<le> na\<close> by (intro N) simp
           finally show "dist ((fm n (y (Suc (diagseq na))))\<^sub>F t) (z t) < e" .
         qed
       qed
       hence "(\<lambda>i. (fm n (y (Suc (diagseq i))))\<^sub>F t) \<longlonglongrightarrow> (finmap_of (Utn ` J n) z)\<^sub>F t"
         by (simp add: tendsto_intros)
     } ultimately
     have "(\<lambda>i. fm n (y (Suc (diagseq i)))) \<longlonglongrightarrow> finmap_of (Utn ` J n) z"
       by (rule tendsto_finmap)
     hence "((\<lambda>i. fm n (y (Suc (diagseq i)))) o (\<lambda>i. i + n)) \<longlonglongrightarrow> finmap_of (Utn ` J n) z"
       by (rule LIMSEQ_subseq_LIMSEQ) (simp add: strict_mono_def)
     moreover
     have "(\<forall>i. ((\<lambda>i. fm n (y (Suc (diagseq i)))) o (\<lambda>i. i + n)) i \<in> K' n)"
       apply (auto simp add: o_def intro!: fm_in_K' \<open>1 \<le> n\<close> le_SucI)
       apply (rule le_trans)
       apply (rule le_add2)
       using seq_suble[OF subseq_diagseq]
       apply auto
       done
     moreover
     from \<open>compact (K' n)\<close> have "closed (K' n)" by (rule compact_imp_closed)
     ultimately
     have "finmap_of (Utn ` J n) z \<in> K' n"
       unfolding closed_sequential_limits by blast
     also have "finmap_of (Utn ` J n) z  = fm n (\<lambda>i. z (Utn i))"
       unfolding finmap_eq_iff
     proof clarsimp
       fix i assume i: "i \<in> J n"
       hence "from_nat_into (\<Union>n. J n) (Utn i) = i"
         unfolding Utn_def
         by (subst from_nat_into_to_nat_on[OF countable_UN_J]) auto
       with i show "z (Utn i) = (fm n (\<lambda>i. z (Utn i)))\<^sub>F (Utn i)"
         by (simp add: finmap_eq_iff fm_def compose_def)
     qed
     finally have "fm n (\<lambda>i. z (Utn i)) \<in> K' n" .
     moreover
     let ?J = "\<Union>n. J n"
     have "(?J \<inter> J n) = J n" by auto
     ultimately have "restrict (\<lambda>i. z (Utn i)) (?J \<inter> J n) \<in> K n"
       unfolding K_def by (auto simp: space_P space_PiM)
     hence "restrict (\<lambda>i. z (Utn i)) ?J \<in> Z' n" unfolding Z'_def
       using J by (auto simp: prod_emb_def PiE_def extensional_def)
     also have "\<dots> \<subseteq> Z n" using Z' by simp
     finally have "restrict (\<lambda>i. z (Utn i)) ?J \<in> Z n" .
   } note in_Z = this
   hence "(\<Inter>i\<in>{1..}. Z i) \<noteq> {}" by auto
   thus "(\<Inter>i. Z i) \<noteq> {}"
     using INT_decseq_offset[OF antimonoI[OF Z_mono]] by simp
 qed fact+
 
 lemma measure_lim_emb:
   "J \<subseteq> I \<Longrightarrow> finite J \<Longrightarrow> X \<in> sets (\<Pi>\<^sub>M i\<in>J. borel) \<Longrightarrow> measure lim (emb I J X) = measure (P J) X"
   unfolding measure_def by (subst emeasure_lim_emb) auto
 
 end
 
 hide_const (open) PiF
 hide_const (open) Pi\<^sub>F
 hide_const (open) Pi'
 hide_const (open) finmap_of
 hide_const (open) proj
 hide_const (open) domain
 hide_const (open) basis_finmap
 
 sublocale polish_projective \<subseteq> P: prob_space lim
 proof
   have *: "emb I {} {\<lambda>x. undefined} = space (\<Pi>\<^sub>M i\<in>I. borel)"
     by (auto simp: prod_emb_def space_PiM)
   interpret prob_space "P {}"
     using prob_space_P by simp
   show "emeasure lim (space lim) = 1"
     using emeasure_lim_emb[of "{}" "{\<lambda>x. undefined}"] emeasure_space_1
     by (simp add: * PiM_empty space_P)
 qed
 
 locale polish_product_prob_space =
   product_prob_space "\<lambda>_. borel::('a::polish_space) measure" I for I::"'i set"
 
 sublocale polish_product_prob_space \<subseteq> P: polish_projective I "\<lambda>J. PiM J (\<lambda>_. borel::('a) measure)"
   ..
 
 lemma (in polish_product_prob_space) limP_eq_PiM: "lim = PiM I (\<lambda>_. borel)"
   by (rule PiM_eq) (auto simp: emeasure_PiM emeasure_lim_emb)
 
 end
diff --git a/src/HOL/Probability/Stopping_Time.thy b/src/HOL/Probability/Stopping_Time.thy
--- a/src/HOL/Probability/Stopping_Time.thy
+++ b/src/HOL/Probability/Stopping_Time.thy
@@ -1,262 +1,263 @@
 (* Author: Johannes Hölzl <hoelzl@in.tum.de> *)
 
 section \<open>Stopping times\<close>
 
 theory Stopping_Time
   imports "HOL-Analysis.Analysis"
 begin
 
 subsection \<open>Stopping Time\<close>
 
 text \<open>This is also called strong stopping time. Then stopping time is T with alternative is
   \<open>T x < t\<close> measurable.\<close>
 
 definition stopping_time :: "('t::linorder \<Rightarrow> 'a measure) \<Rightarrow> ('a \<Rightarrow> 't) \<Rightarrow> bool"
 where
   "stopping_time F T = (\<forall>t. Measurable.pred (F t) (\<lambda>x. T x \<le> t))"
 
 lemma stopping_time_cong: "(\<And>t x. x \<in> space (F t) \<Longrightarrow> T x = S x) \<Longrightarrow> stopping_time F T = stopping_time F S"
   unfolding stopping_time_def by (intro arg_cong[where f=All] ext measurable_cong) simp
 
 lemma stopping_timeD: "stopping_time F T \<Longrightarrow> Measurable.pred (F t) (\<lambda>x. T x \<le> t)"
   by (auto simp: stopping_time_def)
 
 lemma stopping_timeD2: "stopping_time F T \<Longrightarrow> Measurable.pred (F t) (\<lambda>x. t < T x)"
   unfolding not_le[symmetric] by (auto intro: stopping_timeD Measurable.pred_intros_logic)
 
 lemma stopping_timeI[intro?]: "(\<And>t. Measurable.pred (F t) (\<lambda>x. T x \<le> t)) \<Longrightarrow> stopping_time F T"
   by (auto simp: stopping_time_def)
 
 lemma measurable_stopping_time:
   fixes T :: "'a \<Rightarrow> 't::{linorder_topology, second_countable_topology}"
   assumes T: "stopping_time F T"
     and M: "\<And>t. sets (F t) \<subseteq> sets M" "\<And>t. space (F t) = space M"
   shows "T \<in> M \<rightarrow>\<^sub>M borel"
 proof (rule borel_measurableI_le)
   show "{x \<in> space M. T x \<le> t} \<in> sets M" for t
     using stopping_timeD[OF T] M by (auto simp: Measurable.pred_def)
 qed
 
 lemma stopping_time_const: "stopping_time F (\<lambda>x. c)"
   by (auto simp: stopping_time_def)
 
 lemma stopping_time_min:
   "stopping_time F T \<Longrightarrow> stopping_time F S \<Longrightarrow> stopping_time F (\<lambda>x. min (T x) (S x))"
   by (auto simp: stopping_time_def min_le_iff_disj intro!: pred_intros_logic)
 
 lemma stopping_time_max:
   "stopping_time F T \<Longrightarrow> stopping_time F S \<Longrightarrow> stopping_time F (\<lambda>x. max (T x) (S x))"
   by (auto simp: stopping_time_def intro!: pred_intros_logic)
 
 section \<open>Filtration\<close>
 
 locale filtration =
   fixes \<Omega> :: "'a set" and F :: "'t::{linorder_topology, second_countable_topology} \<Rightarrow> 'a measure"
   assumes space_F: "\<And>i. space (F i) = \<Omega>"
   assumes sets_F_mono: "\<And>i j. i \<le> j \<Longrightarrow> sets (F i) \<le> sets (F j)"
 begin
 
 subsection \<open>$\sigma$-algebra of a Stopping Time\<close>
 
 definition pre_sigma :: "('a \<Rightarrow> 't) \<Rightarrow> 'a measure"
 where
   "pre_sigma T = sigma \<Omega> {A. \<forall>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)}"
 
 lemma space_pre_sigma: "space (pre_sigma T) = \<Omega>"
   unfolding pre_sigma_def using sets.space_closed[of "F _"]
   by (intro space_measure_of) (auto simp: space_F)
 
 lemma measure_pre_sigma[simp]: "emeasure (pre_sigma T) = (\<lambda>_. 0)"
   by (simp add: pre_sigma_def emeasure_sigma)
 
 lemma sigma_algebra_pre_sigma:
   assumes T: "stopping_time F T"
   shows "sigma_algebra \<Omega> {A. \<forall>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)}"
   unfolding sigma_algebra_iff2
 proof (intro sigma_algebra_iff2[THEN iffD2] conjI ballI allI impI CollectI)
   show "{A. \<forall>t. {\<omega> \<in> A. T \<omega> \<le> t} \<in> sets (F t)} \<subseteq> Pow \<Omega>"
     using sets.space_closed[of "F _"] by (auto simp: space_F)
 next
   fix A t assume "A \<in> {A. \<forall>t. {\<omega> \<in> A. T \<omega> \<le> t} \<in> sets (F t)}"
   then have "{\<omega> \<in> space (F t). T \<omega> \<le> t} - {\<omega> \<in> A. T \<omega> \<le> t} \<in> sets (F t)"
     using T stopping_timeD[measurable] by auto
   also have "{\<omega> \<in> space (F t). T \<omega> \<le> t} - {\<omega> \<in> A. T \<omega> \<le> t} = {\<omega> \<in> \<Omega> - A. T \<omega> \<le> t}"
     by (auto simp: space_F)
   finally show "{\<omega> \<in> \<Omega> - A. T \<omega> \<le> t} \<in> sets (F t)" .
 next
   fix AA :: "nat \<Rightarrow> 'a set" and t assume "range AA \<subseteq> {A. \<forall>t. {\<omega> \<in> A. T \<omega> \<le> t} \<in> sets (F t)}"
   then have "(\<Union>i. {\<omega> \<in> AA i. T \<omega> \<le> t}) \<in> sets (F t)" for t
     by auto
   also have "(\<Union>i. {\<omega> \<in> AA i. T \<omega> \<le> t}) = {\<omega> \<in> \<Union>(AA ` UNIV). T \<omega> \<le> t}"
     by auto
   finally show "{\<omega> \<in> \<Union>(AA ` UNIV). T \<omega> \<le> t} \<in> sets (F t)" .
 qed auto
 
 lemma sets_pre_sigma: "stopping_time F T \<Longrightarrow> sets (pre_sigma T) = {A. \<forall>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)}"
   unfolding pre_sigma_def by (rule sigma_algebra.sets_measure_of_eq[OF sigma_algebra_pre_sigma])
 
 lemma sets_pre_sigmaI: "stopping_time F T \<Longrightarrow> (\<And>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)) \<Longrightarrow> A \<in> sets (pre_sigma T)"
   unfolding sets_pre_sigma by auto
 
 lemma pred_pre_sigmaI:
   assumes T: "stopping_time F T"
   shows "(\<And>t. Measurable.pred (F t) (\<lambda>\<omega>. P \<omega> \<and> T \<omega> \<le> t)) \<Longrightarrow> Measurable.pred (pre_sigma T) P"
   unfolding pred_def space_F space_pre_sigma by (intro sets_pre_sigmaI[OF T]) simp
 
 lemma sets_pre_sigmaD: "stopping_time F T \<Longrightarrow> A \<in> sets (pre_sigma T) \<Longrightarrow> {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)"
   unfolding sets_pre_sigma by auto
 
 lemma stopping_time_le_const: "stopping_time F T \<Longrightarrow> s \<le> t \<Longrightarrow> Measurable.pred (F t) (\<lambda>\<omega>. T \<omega> \<le> s)"
   using stopping_timeD[of F T] sets_F_mono[of _ t] by (auto simp: pred_def space_F)
 
 lemma measurable_stopping_time_pre_sigma:
   assumes T: "stopping_time F T" shows "T \<in> pre_sigma T \<rightarrow>\<^sub>M borel"
 proof (intro borel_measurableI_le sets_pre_sigmaI[OF T])
   fix t t'
   have "{\<omega>\<in>space (F (min t' t)). T \<omega> \<le> min t' t} \<in> sets (F (min t' t))"
     using T unfolding pred_def[symmetric] by (rule stopping_timeD)
   also have "\<dots> \<subseteq> sets (F t)"
     by (rule sets_F_mono) simp
   finally show "{\<omega> \<in> {x \<in> space (pre_sigma T). T x \<le> t'}. T \<omega> \<le> t} \<in> sets (F t)"
     by (simp add: space_pre_sigma space_F)
 qed
 
 lemma mono_pre_sigma:
   assumes T: "stopping_time F T" and S: "stopping_time F S"
     and le: "\<And>\<omega>. \<omega> \<in> \<Omega> \<Longrightarrow> T \<omega> \<le> S \<omega>"
   shows "sets (pre_sigma T) \<subseteq> sets (pre_sigma S)"
   unfolding sets_pre_sigma[OF S] sets_pre_sigma[OF T]
 proof safe
   interpret sigma_algebra \<Omega> "{A. \<forall>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)}"
     using T by (rule sigma_algebra_pre_sigma)
   fix A t assume A: "\<forall>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)"
   then have "A \<subseteq> \<Omega>"
     using sets_into_space by auto
   from A have "{\<omega>\<in>A. T \<omega> \<le> t} \<inter> {\<omega>\<in>space (F t). S \<omega> \<le> t} \<in> sets (F t)"
     using stopping_timeD[OF S] by (auto simp: pred_def)
   also have "{\<omega>\<in>A. T \<omega> \<le> t} \<inter> {\<omega>\<in>space (F t). S \<omega> \<le> t} = {\<omega>\<in>A. S \<omega> \<le> t}"
     using \<open>A \<subseteq> \<Omega>\<close> sets_into_space[of A] le by (auto simp: space_F intro: order_trans)
   finally show "{\<omega>\<in>A. S \<omega> \<le> t} \<in> sets (F t)"
     by auto
 qed
 
 lemma stopping_time_less_const:
   assumes T: "stopping_time F T" shows "Measurable.pred (F t) (\<lambda>\<omega>. T \<omega> < t)"
 proof -
-  guess D :: "'t set" by (rule countable_dense_setE)
-  note D = this
+  obtain D :: "'t set"
+    where D: "countable D" "\<And>X. open X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>d\<in>D. d \<in> X"
+  using countable_dense_setE by auto
   show ?thesis
   proof cases
     assume *: "\<forall>t'<t. \<exists>t''. t' < t'' \<and> t'' < t"
     { fix t' assume "t' < t"
       with * have "{t' <..< t} \<noteq> {}"
         by fastforce
       with D(2)[OF _ this]
       have "\<exists>d\<in>D. t'< d \<and> d < t"
         by auto }
     note ** = this
 
     show ?thesis
     proof (rule measurable_cong[THEN iffD2])
       show "T \<omega> < t \<longleftrightarrow> (\<exists>r\<in>{r\<in>D. r < t}. T \<omega> \<le> r)" for \<omega>
         by (auto dest: ** intro: less_imp_le)
       show "Measurable.pred (F t) (\<lambda>w. \<exists>r\<in>{r \<in> D. r < t}. T w \<le> r)"
         by (intro measurable_pred_countable stopping_time_le_const[OF T] countable_Collect D) auto
     qed
   next
     assume "\<not> (\<forall>t'<t. \<exists>t''. t' < t'' \<and> t'' < t)"
     then obtain t' where t': "t' < t" "\<And>t''. t'' < t \<Longrightarrow> t'' \<le> t'"
       by (auto simp: not_less[symmetric])
     show ?thesis
     proof (rule measurable_cong[THEN iffD2])
       show "T \<omega> < t \<longleftrightarrow> T \<omega> \<le> t'" for \<omega>
         using t' by auto
       show "Measurable.pred (F t) (\<lambda>w. T w \<le> t')"
         using \<open>t'<t\<close> by (intro stopping_time_le_const[OF T]) auto
     qed
   qed
 qed
 
 lemma stopping_time_eq_const: "stopping_time F T \<Longrightarrow> Measurable.pred (F t) (\<lambda>\<omega>. T \<omega> = t)"
   unfolding eq_iff using stopping_time_less_const[of T t]
   by (intro pred_intros_logic stopping_time_le_const) (auto simp: not_less[symmetric] )
 
 lemma stopping_time_less:
   assumes T: "stopping_time F T" and S: "stopping_time F S"
   shows "Measurable.pred (pre_sigma T) (\<lambda>\<omega>. T \<omega> < S \<omega>)"
 proof (rule pred_pre_sigmaI[OF T])
   fix t
   obtain D :: "'t set"
     where [simp]: "countable D" and semidense_D: "\<And>x y. x < y \<Longrightarrow> (\<exists>b\<in>D. x \<le> b \<and> b < y)"
     using countable_separating_set_linorder2 by auto
   show "Measurable.pred (F t) (\<lambda>\<omega>. T \<omega> < S \<omega> \<and> T \<omega> \<le> t)"
   proof (rule measurable_cong[THEN iffD2])
     let ?f = "\<lambda>\<omega>. if T \<omega> = t then \<not> S \<omega> \<le> t else \<exists>s\<in>{s\<in>D. s \<le> t}. T \<omega> \<le> s \<and> \<not> (S \<omega> \<le> s)"
     { fix \<omega> assume "T \<omega> \<le> t" "T \<omega> \<noteq> t" "T \<omega> < S \<omega>"
       then have "T \<omega> < min t (S \<omega>)"
         by auto
       then obtain r where "r \<in> D" "T \<omega> \<le> r" "r < min t (S \<omega>)"
         by (metis semidense_D)
       then have "\<exists>s\<in>{s\<in>D. s \<le> t}. T \<omega> \<le> s \<and> s < S \<omega>"
         by auto }
     then show "(T \<omega> < S \<omega> \<and> T \<omega> \<le> t) = ?f \<omega>" for \<omega>
       by (auto simp: not_le)
     show "Measurable.pred (F t) ?f"
       by (intro pred_intros_logic measurable_If measurable_pred_countable countable_Collect
                 stopping_time_le_const predE stopping_time_eq_const T S)
          auto
   qed
 qed
 
 end
 
 lemma stopping_time_SUP_enat:
   fixes T :: "nat \<Rightarrow> ('a \<Rightarrow> enat)"
   shows "(\<And>i. stopping_time F (T i)) \<Longrightarrow> stopping_time F (SUP i. T i)"
   unfolding stopping_time_def SUP_apply SUP_le_iff by (auto intro!: pred_intros_countable)
 
 lemma less_eSuc_iff: "a < eSuc b \<longleftrightarrow> (a \<le> b \<and> a \<noteq> \<infinity>)"
   by (cases a) auto
 
 lemma stopping_time_Inf_enat:
   fixes F :: "enat \<Rightarrow> 'a measure"
   assumes F: "filtration \<Omega> F"
   assumes P: "\<And>i. Measurable.pred (F i) (P i)"
   shows "stopping_time F (\<lambda>\<omega>. Inf {i. P i \<omega>})"
 proof (rule stopping_timeI, cases)
   fix t :: enat assume "t = \<infinity>" then show "Measurable.pred (F t) (\<lambda>\<omega>. Inf {i. P i \<omega>} \<le> t)"
     by auto
 next
   fix t :: enat assume "t \<noteq> \<infinity>"
   moreover
   { fix i \<omega> assume "Inf {i. P i \<omega>} \<le> t"
     with \<open>t \<noteq> \<infinity>\<close> have "(\<exists>i\<le>t. P i \<omega>)"
       unfolding Inf_le_iff by (cases t) (auto elim!: allE[of _ "eSuc t"] simp: less_eSuc_iff) }
   ultimately have *: "\<And>\<omega>. Inf {i. P i \<omega>} \<le> t \<longleftrightarrow> (\<exists>i\<in>{..t}. P i \<omega>)"
     by (auto intro!: Inf_lower2)
   show "Measurable.pred (F t) (\<lambda>\<omega>. Inf {i. P i \<omega>} \<le> t)"
     unfolding * using filtration.sets_F_mono[OF F, of _ t] P
     by (intro pred_intros_countable_bounded) (auto simp: pred_def filtration.space_F[OF F])
 qed
 
 lemma stopping_time_Inf_nat:
   fixes F :: "nat \<Rightarrow> 'a measure"
   assumes F: "filtration \<Omega> F"
   assumes P: "\<And>i. Measurable.pred (F i) (P i)" and wf: "\<And>i \<omega>. \<omega> \<in> \<Omega> \<Longrightarrow> \<exists>n. P n \<omega>"
   shows "stopping_time F (\<lambda>\<omega>. Inf {i. P i \<omega>})"
   unfolding stopping_time_def
 proof (intro allI, subst measurable_cong)
   fix t \<omega> assume "\<omega> \<in> space (F t)"
   then have "\<omega> \<in> \<Omega>"
     using filtration.space_F[OF F] by auto
   from wf[OF this] have "((LEAST n. P n \<omega>) \<le> t) = (\<exists>i\<le>t. P i \<omega>)"
     by (rule LeastI2_wellorder_ex) auto
   then show "(Inf {i. P i \<omega>} \<le> t) = (\<exists>i\<in>{..t}. P i \<omega>)"
     by (simp add: Inf_nat_def Bex_def)
 next
   fix t from P show "Measurable.pred (F t) (\<lambda>w. \<exists>i\<in>{..t}. P i w)"
     using filtration.sets_F_mono[OF F, of _ t]
     by (intro pred_intros_countable_bounded) (auto simp: pred_def filtration.space_F[OF F])
 qed
 
 end