diff --git a/thys/DiscretePricing/Fair_Price.thy b/thys/DiscretePricing/Fair_Price.thy
--- a/thys/DiscretePricing/Fair_Price.thy
+++ b/thys/DiscretePricing/Fair_Price.thy
@@ -1,3522 +1,3522 @@
 (*  Title:      Fair_Price.thy
     Author:     Mnacho Echenim, Univ. Grenoble Alpes
 *)
 
 section \<open>Fair Prices\<close>
 
 text  \<open>This section contains the formalization of financial notions, such as markets, price processes, portfolios,
 arbitrages, fair prices, etc. It also defines risk-neutral probability spaces, and proves the main result about the fair
 price of a derivative in a risk-neutral probability space, namely that this fair price is equal to the expectation of
 the discounted value of the derivative's payoff.\<close>
 
 theory Fair_Price imports Filtration Martingale Geometric_Random_Walk
 begin
 
 subsection \<open>Preliminary results\<close>
 
 lemma (in prob_space) finite_borel_measurable_integrable:
   assumes "f\<in> borel_measurable M"
   and "finite (f`(space M))"
   shows "integrable M f"
 proof -
   have "simple_function M f" using assms by (simp add: simple_function_borel_measurable)
   moreover have "emeasure M {y \<in> space M. f y \<noteq> 0} \<noteq> \<infinity>" by simp
   ultimately have "Bochner_Integration.simple_bochner_integrable M f"
     using Bochner_Integration.simple_bochner_integrable.simps by blast
   hence "has_bochner_integral M f (Bochner_Integration.simple_bochner_integral M f)"
     using has_bochner_integral_simple_bochner_integrable by auto
   thus ?thesis using integrable.simps by auto
 qed
 
 
 subsubsection \<open>On the almost everywhere filter\<close>
 
 lemma AE_eq_trans[trans]:
   assumes "AE x in M. A x = B x"
   and "AE x in M. B x = C x"
   shows "AE x in M. A x = C x"
   using assms  by auto
 
 
 abbreviation AEeq where "AEeq M X Y \<equiv> AE w in M. X w = Y w"
 
 
 
 lemma AE_add:
   assumes "AE w in M. f w = g w"
   and "AE w in M. f' w = g' w"
 shows "AE w in M. f w + f' w = g w + g' w" using assms by auto
 
 
 lemma AE_sum:
   assumes "finite I"
   and  "\<forall> i\<in>I. AE w in M. f i w = g i w"
   shows "AE w in M. (\<Sum>i\<in> I. f i w) = (\<Sum>i\<in> I. g i w)" using assms(1) subset_refl[of I]
 proof (induct rule: finite_subset_induct)
   case empty
   then show ?case by simp
 next
   case (insert a F)
   have "AEeq M (f a) (g a)" using assms(2) insert.hyps(2) by auto
   have "AE w in M. (\<Sum>i\<in> insert a F. f i w) = f a w + (\<Sum>i\<in> F. f i w)"
     by (simp add: insert.hyps(1) insert.hyps(3))
   also have "AE w in M. f a w + (\<Sum>i\<in> F. f i w) = g a w + (\<Sum>i\<in> F. f i w)"
     using \<open>AEeq M (f a) (g a)\<close> by auto
   also have "AE w in M. g a w + (\<Sum>i\<in> F. f i w) = g a w + (\<Sum>i\<in> F. g i w)"
     using insert.hyps(4) by auto
   also have "AE w in M. g a w + (\<Sum>i\<in> F. g i w) = (\<Sum>i\<in> insert a F. g i w)"
     by (simp add: insert.hyps(1) insert.hyps(3))
   finally show ?case by auto
 qed
 
 
 lemma AE_eq_cst:
   assumes "AE w in M. (\<lambda>w. c) w = (\<lambda>w. d) w"
   and "emeasure M (space M) \<noteq> 0"
   shows "c = d"
 proof (rule ccontr)
   assume "c \<noteq> d"
   from \<open>AE w in M. (\<lambda>w. c) w = (\<lambda>w. d) w\<close> obtain N where Nprops: "{w\<in> space M. \<not>(\<lambda>w. c) w = (\<lambda>w. d) w} \<subseteq> N" "N\<in> sets M" "emeasure M N = 0"
     by (force elim:AE_E)
   have "\<forall>w\<in> space M. (\<lambda>w. c) w \<noteq> (\<lambda>w. d) w" using \<open>c\<noteq> d\<close> by simp
   hence "{w\<in> space M. (\<lambda>w. c) w \<noteq> (\<lambda>w. d) w} = space M" by auto
   hence "space M\<subseteq> N" using Nprops by auto
   thus False using \<open>emeasure M N = 0\<close> assms
     by (meson Nprops(2) \<open>emeasure M (space M) \<noteq> 0\<close> \<open>emeasure M N = 0\<close> \<open>space M \<subseteq> N\<close> emeasure_eq_0)
 qed
 
 subsubsection \<open>On conditional expectations\<close>
 
 lemma (in prob_space) subalgebra_sigma_finite:
   assumes "subalgebra M N"
   shows "sigma_finite_subalgebra M N" unfolding sigma_finite_subalgebra_def by (simp add: assms prob_space_axioms prob_space_imp_sigma_finite prob_space_restr_to_subalg)
 
 
 
 lemma (in prob_space) trivial_subalg_cond_expect_AE:
   assumes "subalgebra M N"
   and "sets N = {{}, space M}"
   and "integrable M f"
 shows "AE x in M. real_cond_exp M N f x = (\<lambda>x. expectation f) x"
 proof (intro sigma_finite_subalgebra.real_cond_exp_charact)
   show "sigma_finite_subalgebra M N" by (simp add: assms(1) subalgebra_sigma_finite)
   show "integrable M f" using assms by simp
   show "integrable M (\<lambda>x. expectation f)" by auto
   show "(\<lambda>x. expectation f) \<in> borel_measurable N" by simp
-  show "\<And>A. A \<in> sets N \<Longrightarrow> set_lebesgue_integral M A f = \<integral>x\<in>A. expectation f\<partial>M"
+  show "\<And>A. A \<in> sets N \<Longrightarrow> set_lebesgue_integral M A f = (\<integral>x\<in>A. expectation f\<partial>M)"
   proof -
     fix A
     assume "A \<in> sets N"
-    show "set_lebesgue_integral M A f = \<integral>x\<in>A. expectation f\<partial>M"
+    show "set_lebesgue_integral M A f = (\<integral>x\<in>A. expectation f\<partial>M)"
     proof (cases "A = {}")
       case True
       thus ?thesis by (simp add: set_lebesgue_integral_def)
     next
       case False
       hence "A = space M" using assms \<open>A\<in> sets N\<close> by auto
       have "set_lebesgue_integral M A f = expectation f" using \<open>A = space M\<close>
         by (metis (mono_tags, lifting) Bochner_Integration.integral_cong indicator_simps(1)
                   scaleR_one set_lebesgue_integral_def)
-      also have "... =\<integral>x\<in>A. expectation f\<partial>M" using \<open>A = space M\<close>
+      also have "... = (\<integral>x\<in>A. expectation f\<partial>M)" using \<open>A = space M\<close>
         by (auto simp add:prob_space set_lebesgue_integral_def)
       finally show ?thesis .
     qed
   qed
 qed
 
 lemma (in prob_space) triv_subalg_borel_eq:
   assumes "subalgebra M F"
   and "sets F = {{}, space M}"
   and "AE x in M. f x = (c::'b::{t2_space})"
   and "f\<in> borel_measurable F"
 shows "\<forall>x\<in> space M. f x = c"
 proof
   fix x
   assume "x\<in> space M"
   have "space M = space F" using assms by (simp add:subalgebra_def)
   hence "x\<in> space F" using \<open>x\<in> space M\<close> by simp
   have "space M \<noteq> {}" by (simp add:not_empty)
   hence "\<exists>d. \<forall>y\<in> space F. f y = d" by (metis assms(1) assms(2) assms(4) subalgebra_def triv_measurable_cst)
   from this obtain d where "\<forall>y \<in>space F. f y = d" by auto
   hence "f x = d" using \<open>x\<in> space F\<close> by simp
   also have "... = c"
   proof (rule ccontr)
     assume "d\<noteq> c"
     from \<open>AE x in M. f x= c\<close> obtain N where Nprops: "{x\<in> space M. \<not>f x = c} \<subseteq> N" "N\<in> sets M" "emeasure M N = 0"
       by (force elim:AE_E)
     have "space M \<subseteq> {x\<in> space M. \<not>f x = c}" using \<open>\<forall>y \<in>space F. f y = d\<close> \<open>space M = space F\<close> \<open>d\<noteq> c\<close> by auto
     hence "space M\<subseteq> N" using Nprops by auto
     thus False using \<open>emeasure M N = 0\<close> emeasure_space_1  Nprops(2) emeasure_mono by fastforce
   qed
   finally show "f x = c" .
 qed
 
 
 
 lemma (in prob_space) trivial_subalg_cond_expect_eq:
   assumes "subalgebra M N"
   and "sets N = {{}, space M}"
   and "integrable M f"
 shows "\<forall>x\<in> space M. real_cond_exp M N f x = expectation f"
 proof (rule triv_subalg_borel_eq)
   show "subalgebra M N" "sets N = {{}, space M}" using assms by auto
   show "real_cond_exp M N f \<in> borel_measurable N" by simp
   show "AE x in M. real_cond_exp M N f x = expectation f"
     by (rule trivial_subalg_cond_expect_AE, (auto simp add:assms))
 qed
 
 
 
 lemma (in sigma_finite_subalgebra) real_cond_exp_cong':
   assumes "\<forall>w \<in> space M. f w = g w"
   and "f\<in> borel_measurable M"
 shows "AE w in M. real_cond_exp M F f w = real_cond_exp M F g w"
 proof (rule real_cond_exp_cong)
   show "AE w in M. f w = g w" using assms by simp
   show "f\<in> borel_measurable M" using assms by simp
   show "g\<in> borel_measurable M" using assms by (metis measurable_cong)
 qed
 
 lemma (in sigma_finite_subalgebra) real_cond_exp_bsum :
   fixes f::"'b \<Rightarrow> 'a \<Rightarrow> real"
   assumes [measurable]: "\<And>i. i\<in>I \<Longrightarrow> integrable M (f i)"
   shows "AE x in M. real_cond_exp M F (\<lambda>x. \<Sum>i\<in>I. f i x) x = (\<Sum>i\<in>I. real_cond_exp M F (f i) x)"
 proof (rule real_cond_exp_charact)
   fix A assume [measurable]: "A \<in> sets F"
   then have A_meas [measurable]: "A \<in> sets M" by (meson subsetD subalg subalgebra_def)
 
   have *: "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>x. indicator A x * f i x)"
     using integrable_mult_indicator[OF \<open>A \<in> sets M\<close> assms(1)]  by auto
   have **: "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>x. indicator A x * real_cond_exp M F (f i) x)"
     using integrable_mult_indicator[OF \<open>A \<in> sets M\<close> real_cond_exp_int(1)[OF assms(1)]]  by auto
   have inti: "\<And>i. i \<in> I \<Longrightarrow>(\<integral>x. indicator A x * f i x \<partial>M) = (\<integral>x. indicator A x * real_cond_exp M F (f i) x \<partial>M)" using
       real_cond_exp_intg(2)[symmetric,of "indicator A" ]
     using "*" \<open>A \<in> sets F\<close> assms borel_measurable_indicator by blast
   have "(\<integral>x\<in>A. (\<Sum>i\<in>I. f i x)\<partial>M) = (\<integral>x. (\<Sum>i\<in>I. indicator A x * f i x)\<partial>M)"
     by (simp add: sum_distrib_left set_lebesgue_integral_def)
   also have "... = (\<Sum>i\<in>I. (\<integral>x. indicator A x * f i x \<partial>M))" using Bochner_Integration.integral_sum[of I M "\<lambda>i x. indicator A x * f i x"] *
     by simp
   also have "... = (\<Sum>i\<in>I. (\<integral>x. indicator A x * real_cond_exp M F (f i) x \<partial>M))"
     using inti by auto
   also have "... = (\<integral>x. (\<Sum>i\<in>I. indicator A x * real_cond_exp M F (f i) x)\<partial>M)"
     by (rule Bochner_Integration.integral_sum[symmetric], simp add: **)
   also have "... = (\<integral>x\<in>A. (\<Sum>i\<in>I. real_cond_exp M F (f i) x)\<partial>M)"
     by (simp add: sum_distrib_left set_lebesgue_integral_def)
   finally show "(\<integral>x\<in>A. (\<Sum>i\<in>I. f i x)\<partial>M) = (\<integral>x\<in>A. (\<Sum>i\<in>I. real_cond_exp M F (f i) x)\<partial>M)" by auto
 qed (auto simp add: assms real_cond_exp_int(1)[OF assms(1)])
 
 subsection \<open>Financial formalizations\<close>
 
 subsubsection \<open>Markets\<close>
 
 
 
 definition stk_strict_subs::"'c set \<Rightarrow> bool" where
 "stk_strict_subs S \<longleftrightarrow> S \<noteq> UNIV"
 
 typedef ('a,'c) discrete_market = "{(s::('c set), a::'c \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> real)). stk_strict_subs s}" unfolding stk_strict_subs_def by fastforce
 
 definition prices where
   "prices Mkt = (snd (Rep_discrete_market Mkt))"
 
 definition assets where
 
   "assets Mkt = UNIV"
 
 
 definition stocks where
   "stocks Mkt = (fst (Rep_discrete_market Mkt))"
 
 definition discrete_market_of
 where
   "discrete_market_of S A =
     Abs_discrete_market (if (stk_strict_subs S) then S else {}, A)"
 
 lemma prices_of:
   shows "prices (discrete_market_of S A) = A"
 proof -
   have "stk_strict_subs (if (stk_strict_subs S) then S else {})"
   proof (cases "stk_strict_subs S")
     case True thus ?thesis by simp
   next
     case False thus ?thesis unfolding stk_strict_subs_def by simp
   qed
   hence fct: "((if (stk_strict_subs S) then S else {}), A) \<in> {(s, a). stk_strict_subs s}" by simp
   have "discrete_market_of S A = Abs_discrete_market (if (stk_strict_subs S) then S else {}, A)" unfolding discrete_market_of_def by simp
   hence "Rep_discrete_market (discrete_market_of S A) = (if (stk_strict_subs S) then S else {},A)"
     using Abs_discrete_market_inverse[of "(if (stk_strict_subs S) then S else {}, A)"] fct  by simp
   thus ?thesis unfolding prices_def by simp
 qed
 
 lemma stocks_of:
   assumes "UNIV \<noteq> S"
   shows "stocks (discrete_market_of S A) = S"
 proof -
   have "stk_strict_subs S" using assms unfolding stk_strict_subs_def by simp
   hence fct: "((if (stk_strict_subs S) then S else {}), A) \<in> {(s, a). stk_strict_subs s}" by simp
   have "discrete_market_of S A = Abs_discrete_market (if (stk_strict_subs S) then S else {}, A)" unfolding discrete_market_of_def by simp
   hence "Rep_discrete_market (discrete_market_of S A) = (if (stk_strict_subs S) then S else {},A)"
     using Abs_discrete_market_inverse[of "(if (stk_strict_subs S) then S else {}, A)"] fct  by simp
   thus ?thesis unfolding stocks_def using \<open>stk_strict_subs S\<close> by simp
 qed
 
 lemma mkt_stocks_assets:
   shows "stk_strict_subs (stocks Mkt)" unfolding stocks_def prices_def
   by (metis Rep_discrete_market mem_Collect_eq split_beta')
 
 subsubsection \<open>Quantity processes and portfolios\<close>
 text \<open>These are functions that assign quantities to assets; each quantity is a stochastic process. Basic
 operations are defined on these processes.\<close>
 
 paragraph \<open>Basic operations\<close>
 
 definition qty_empty where
   "qty_empty = (\<lambda> (x::'a) (n::nat) w. 0::real)"
 
 definition qty_single where
   "qty_single asset qt_proc = (qty_empty(asset := qt_proc))"
 
 definition qty_sum::"('b \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> ('b \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> ('b \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real)"  where
   "qty_sum pf1 pf2 = (\<lambda>x n w. pf1 x n w + pf2 x n w)"
 
 definition qty_mult_comp::"('b \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> ('b \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real)"  where
   "qty_mult_comp pf1 qty = (\<lambda>x n w. (pf1 x n w) * (qty n w))"
 
 definition qty_rem_comp::"('b \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> 'b \<Rightarrow> ('b \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real)"  where
   "qty_rem_comp pf1 x = pf1(x:=(\<lambda>n w. 0))"
 
 definition qty_replace_comp where
   "qty_replace_comp pf1 x pf2 = qty_sum (qty_rem_comp pf1 x) (qty_mult_comp pf2 (pf1 x))"
 
 
 paragraph \<open>Support sets\<close>
 
 text \<open>If p x n w is different from 0, this means that this quantity is held on interval ]n-1, n].\<close>
 definition support_set::"('b \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> 'b set" where
   "support_set p = {x. \<exists> n w. p x n w \<noteq> 0}"
 
 lemma qty_empty_support_set:
   shows "support_set qty_empty = {}" unfolding support_set_def qty_empty_def by simp							
 lemma sum_support_set:
   shows "support_set (qty_sum pf1 pf2) \<subseteq> (support_set pf1) \<union> (support_set pf2)"
 proof (intro subsetI, rule ccontr)
   fix x
   assume "x\<in> support_set (qty_sum pf1 pf2)" and "x \<notin> support_set pf1 \<union> support_set pf2" note xprops = this
   hence "\<exists> n w. (qty_sum pf1 pf2) x n w \<noteq> 0" by (simp add: support_set_def)
   from this obtain n w where "(qty_sum pf1 pf2) x n w \<noteq> 0" by auto note nwprops = this
   have "pf1 x n w = 0" "pf2 x n w = 0" using xprops by (auto simp add:support_set_def)
   hence "(qty_sum pf1 pf2) x n w = 0" unfolding qty_sum_def by simp
   thus False using nwprops by simp
 qed
 
 lemma mult_comp_support_set:
 shows "support_set (qty_mult_comp pf1 qty) \<subseteq> (support_set pf1)"
 proof (intro subsetI, rule ccontr)
   fix x
   assume "x\<in> support_set (qty_mult_comp pf1 qty)" and "x \<notin> support_set pf1" note xprops = this
   hence "\<exists> n w. (qty_mult_comp pf1 qty) x n w \<noteq> 0" by (simp add: support_set_def)
   from this obtain n w where "qty_mult_comp pf1 qty x n w \<noteq> 0" by auto note nwprops = this
   have "pf1 x n w = 0" using xprops by (simp add:support_set_def)
   hence "(qty_mult_comp pf1 qty) x n w = 0" unfolding qty_mult_comp_def by simp
   thus False using nwprops by simp
 qed
 
 lemma remove_comp_support_set:
 shows "support_set (qty_rem_comp pf1 x) \<subseteq> ((support_set pf1) - {x})"
 proof (intro subsetI, rule ccontr)
   fix y
   assume "y\<in> support_set (qty_rem_comp pf1 x)" and "y \<notin> support_set pf1 - {x}" note xprops = this
   hence "y\<notin> support_set pf1 \<or> y = x" by simp
   have "\<exists> n w. (qty_rem_comp pf1 x) y n w \<noteq> 0" using xprops by (simp add: support_set_def)
   from this obtain n w where "(qty_rem_comp pf1 x) y n w \<noteq> 0" by auto note nwprops = this
   show False
   proof (cases "y\<notin> support_set pf1")
     case True
     hence "pf1 y n w = 0" using xprops by (simp add:support_set_def)
     hence "(qty_rem_comp pf1 x) x n w = 0" unfolding qty_rem_comp_def by simp
     thus ?thesis using nwprops by (metis \<open>pf1 y n w = 0\<close> fun_upd_apply qty_rem_comp_def)
   next
     case False
     hence "y = x" using \<open>y\<notin> support_set pf1 \<or> y = x\<close> by simp
     hence "(qty_rem_comp pf1 x) x n w = 0" unfolding qty_rem_comp_def by simp
     thus ?thesis using nwprops by (simp add: \<open>y = x\<close>)
   qed
 qed
 
 lemma replace_comp_support_set:
   shows "support_set (qty_replace_comp pf1 x pf2) \<subseteq> (support_set pf1 - {x}) \<union> support_set pf2"
 proof -
   have "support_set (qty_replace_comp pf1 x pf2) \<subseteq> support_set (qty_rem_comp pf1 x) \<union> support_set (qty_mult_comp pf2 (pf1 x))"
     unfolding qty_replace_comp_def by (simp add:sum_support_set)
   also have "... \<subseteq> (support_set pf1 - {x}) \<union> support_set pf2" using remove_comp_support_set mult_comp_support_set
     by (metis sup.mono)
   finally show ?thesis .
 qed
 
 lemma single_comp_support:
   shows "support_set (qty_single asset qty) \<subseteq> {asset}"
 proof
   fix x
   assume "x\<in> support_set (qty_single asset qty)"
   show "x\<in> {asset}"
   proof (rule ccontr)
     assume "x\<notin> {asset}"
     hence "x\<noteq> asset" by auto
     have "\<exists> n w. qty_single asset qty x n w \<noteq> 0" using \<open>x\<in> support_set (qty_single asset qty)\<close>
       by (simp add:support_set_def)
     from this obtain n w where "qty_single asset qty x n w \<noteq> 0" by auto
     thus False using \<open>x\<noteq>asset\<close> by (simp add: qty_single_def qty_empty_def)
   qed
 qed
 
 lemma single_comp_nz_support:
   assumes "\<exists> n w. qty n w\<noteq> 0"
   shows "support_set (qty_single asset qty) = {asset}"
 proof
   show "support_set (qty_single asset qty) \<subseteq> {asset}" by (simp add: single_comp_support)
   have "asset\<in> support_set (qty_single asset qty)" using assms unfolding support_set_def qty_single_def by simp
   thus "{asset} \<subseteq> support_set (qty_single asset qty)" by auto
 qed
 
 paragraph \<open>Portfolios\<close>
 
 definition portfolio where
   "portfolio p \<longleftrightarrow> finite (support_set p)"
 
 
 
 
 definition stock_portfolio :: "('a, 'b) discrete_market \<Rightarrow> ('b \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> bool" where
   "stock_portfolio Mkt p \<longleftrightarrow> portfolio p \<and> support_set p \<subseteq> stocks Mkt"
 
 lemma sum_portfolio:
   assumes "portfolio pf1"
   and "portfolio pf2"
 shows "portfolio (qty_sum pf1 pf2)" unfolding portfolio_def
 proof -
   have "support_set (qty_sum pf1 pf2) \<subseteq> (support_set pf1) \<union> (support_set pf2)"  by (simp add: sum_support_set)
   thus "finite (support_set (qty_sum pf1 pf2))" using assms unfolding portfolio_def using infinite_super by auto
 qed
 
 lemma sum_basic_support_set:
   assumes "stock_portfolio Mkt pf1"
   and "stock_portfolio Mkt pf2"
 shows "stock_portfolio Mkt (qty_sum pf1 pf2)" using assms sum_support_set[of pf1 pf2] unfolding stock_portfolio_def
   by (metis Diff_subset_conv gfp.leq_trans subset_Un_eq sum_portfolio)
 
 lemma mult_comp_portfolio:
   assumes "portfolio pf1"
 shows "portfolio (qty_mult_comp pf1 qty)" unfolding portfolio_def
 proof -
   have "support_set (qty_mult_comp pf1 qty) \<subseteq> (support_set pf1)"  by (simp add: mult_comp_support_set)
   thus "finite (support_set (qty_mult_comp pf1 qty))" using assms unfolding portfolio_def using infinite_super by auto
 qed
 
 lemma mult_comp_basic_support_set:
   assumes "stock_portfolio Mkt pf1"
 shows "stock_portfolio Mkt (qty_mult_comp pf1 qty)" using assms mult_comp_support_set[of pf1] unfolding stock_portfolio_def
   using mult_comp_portfolio by blast
 
 
 
 lemma remove_comp_portfolio:
   assumes "portfolio pf1"
 shows "portfolio (qty_rem_comp pf1 x)" unfolding portfolio_def
 proof -
   have "support_set (qty_rem_comp pf1 x) \<subseteq> (support_set pf1)" using remove_comp_support_set[of pf1 x] by blast
   thus "finite (support_set (qty_rem_comp pf1 x))" using assms unfolding portfolio_def using infinite_super by auto
 qed
 
 lemma remove_comp_basic_support_set:
   assumes "stock_portfolio Mkt pf1"
 shows "stock_portfolio Mkt (qty_mult_comp pf1 qty)" using assms mult_comp_support_set[of pf1] unfolding stock_portfolio_def
   using mult_comp_portfolio by blast
 
 lemma replace_comp_portfolio:
   assumes "portfolio pf1"
   and "portfolio pf2"
 shows "portfolio (qty_replace_comp pf1 x pf2)" unfolding portfolio_def
 proof -
   have "support_set (qty_replace_comp pf1 x pf2) \<subseteq> (support_set pf1) \<union> (support_set pf2)" using replace_comp_support_set[of pf1 x pf2] by blast
   thus "finite (support_set (qty_replace_comp pf1 x pf2))" using assms unfolding portfolio_def using infinite_super by auto
 qed
 
 lemma replace_comp_stocks:
   assumes "support_set pf1 \<subseteq> stocks Mkt \<union> {x}"
   and "support_set pf2 \<subseteq> stocks Mkt"
 shows "support_set (qty_replace_comp pf1 x pf2) \<subseteq> stocks Mkt"
 proof -
   have "support_set (qty_rem_comp pf1 x) \<subseteq> stocks Mkt" using assms(1) remove_comp_support_set by fastforce
   moreover have "support_set (qty_mult_comp pf2 (pf1 x)) \<subseteq> stocks Mkt" using assms mult_comp_support_set by fastforce
   ultimately show ?thesis unfolding qty_replace_comp_def using sum_support_set by fastforce
 qed
 
 
 
 lemma single_comp_portfolio:
   shows "portfolio (qty_single asset qty)"
   by (meson finite.emptyI finite.insertI finite_subset portfolio_def single_comp_support)
 
 paragraph \<open>Value processes\<close>
 
 definition val_process where
   "val_process Mkt p = (if (\<not> (portfolio p)) then (\<lambda> n w. 0)
     else (\<lambda> n w . (sum (\<lambda>x. ((prices Mkt) x n w) * (p x (Suc n) w)) (support_set p))))"
 
 
 
 lemma subset_val_process':
   assumes "finite A"
   and "support_set p \<subseteq> A"
 shows "val_process Mkt p n w = (sum (\<lambda>x. ((prices Mkt) x n w) * (p x (Suc n) w)) A)"
 proof -
   have "portfolio p" using assms unfolding portfolio_def using finite_subset by auto
   have "\<exists>C. (support_set p) \<inter> C = {} \<and> (support_set p) \<union> C = A" using assms(2) by auto
   from this obtain C where "(support_set p) \<inter> C = {}" and "(support_set p) \<union> C = A" by auto note Cprops = this
   have "finite C" using assms \<open>(support_set p) \<union> C = A\<close> by auto
   have "\<forall>x\<in> C. p x (Suc n) w = 0" using Cprops(1) support_set_def by fastforce
   hence "(\<Sum>x\<in> C. ((prices Mkt) x n w) * (p x (Suc n) w)) = 0" by simp
   hence "val_process Mkt p n w = (\<Sum>x\<in> (support_set p). ((prices Mkt) x n w) * (p x (Suc n) w))
     + (\<Sum>x\<in> C. ((prices Mkt) x n w) * (p x (Suc n) w))" unfolding val_process_def using \<open>portfolio p\<close> by simp
   also have "... = (\<Sum> x\<in> A. ((prices Mkt) x n w) * (p x (Suc n) w))"
     using \<open>portfolio p\<close> \<open>finite C\<close> Cprops portfolio_def sum_union_disjoint' by (metis (no_types, lifting))
   finally show "val_process Mkt p n w = (\<Sum> x\<in> A. ((prices Mkt) x n w) * (p x (Suc n) w))" .
 qed
 
 
 lemma sum_val_process:
   assumes "portfolio pf1"
   and "portfolio pf2"
 shows "\<forall>n w. val_process Mkt (qty_sum pf1 pf2) n w = (val_process Mkt pf1) n w + (val_process Mkt pf2) n w"
 proof (intro allI)
   fix n w
   have vp1: "val_process Mkt pf1 n w = (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2). ((prices Mkt) x n w) * (pf1 x (Suc n) w))"
   proof -
     have "finite (support_set pf1 \<union> support_set pf2) \<and> support_set pf1 \<subseteq> support_set pf1 \<union> support_set pf2"
       by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
     then show ?thesis
       by (simp add: subset_val_process')
   qed
   have vp2: "val_process Mkt pf2 n w = (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2). ((prices Mkt) x n w) * (pf2 x (Suc n) w))"
   proof -
     have "finite (support_set pf1 \<union> support_set pf2) \<and> support_set pf2 \<subseteq> support_set pf2 \<union> support_set pf1"
       by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
     then show ?thesis
       by (simp add: subset_val_process')
   qed
   have pf:"portfolio (qty_sum pf1 pf2)" using assms by (simp add:sum_portfolio)
   have fin:"finite (support_set pf1 \<union> support_set pf2)" using assms finite_Un unfolding portfolio_def by auto
   have "(val_process Mkt pf1) n w + (val_process Mkt pf2) n w =
     (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2). ((prices Mkt) x n w) * (pf1 x (Suc n) w)) +
     (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2). ((prices Mkt) x n w) * (pf2 x (Suc n) w))"
     using vp1 vp2 by simp
   also have "... = (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2).
     (((prices Mkt) x n w) * (pf1 x (Suc n) w)) + ((prices Mkt) x n w) * (pf2 x (Suc n) w))"
     by (simp add: sum.distrib)
   also have "... = (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2).
     ((prices Mkt) x n w) * ((pf1 x (Suc n) w) + (pf2 x (Suc n) w)))" by (simp add: distrib_left)
   also have "... = (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2).
     ((prices Mkt) x n w) * ((qty_sum pf1 pf2) x (Suc n) w))" by (simp add: qty_sum_def)
   also have "... = (\<Sum> x\<in> (support_set (qty_sum pf1 pf2)).
     ((prices Mkt) x n w) * ((qty_sum pf1 pf2) x (Suc n) w))" using sum_support_set[of pf1 pf2]
     subset_val_process'[of "support_set pf1\<union> support_set pf2" "qty_sum pf1 pf2"] pf fin unfolding val_process_def by simp
   also have "... = val_process Mkt (qty_sum pf1 pf2) n w" by (metis (no_types, lifting) pf sum.cong val_process_def)
   finally have "(val_process Mkt pf1) n w + (val_process Mkt pf2) n w = val_process Mkt (qty_sum pf1 pf2) n w" .
   thus "val_process Mkt (qty_sum pf1 pf2) n w = (val_process Mkt pf1) n w + (val_process Mkt pf2) n w" ..
 qed
 
 
 lemma mult_comp_val_process:
   assumes "portfolio pf1"
 shows "\<forall>n w. val_process Mkt (qty_mult_comp pf1 qty) n w = ((val_process Mkt pf1) n w) * (qty (Suc n) w)"
 proof (intro allI)
   fix n w
   have pf:"portfolio (qty_mult_comp pf1 qty)" using assms by (simp add:mult_comp_portfolio)
   have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
   have "((val_process Mkt pf1) n w) * (qty (Suc n) w) =
     (\<Sum> x\<in> (support_set pf1). ((prices Mkt) x n w) * (pf1 x (Suc n) w))*(qty (Suc n) w)"
     unfolding val_process_def using assms by simp
   also have "... = (\<Sum> x\<in> (support_set pf1).
     (((prices Mkt) x n w) * (pf1 x (Suc n) w) * (qty (Suc n) w)))" using sum_distrib_right by auto
   also have "... = (\<Sum> x\<in> (support_set pf1).
     ((prices Mkt) x n w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" unfolding qty_mult_comp_def
     by (simp add: mult.commute mult.left_commute)
   also have "... = (\<Sum> x\<in> (support_set (qty_mult_comp pf1 qty)).
     ((prices Mkt) x n w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" using mult_comp_support_set[of pf1]
     subset_val_process'[of "support_set pf1" "qty_mult_comp pf1 qty"] pf fin unfolding val_process_def by simp
   also have "... = val_process Mkt (qty_mult_comp pf1 qty) n w" by (metis (no_types, lifting) pf sum.cong val_process_def)
   finally have "(val_process Mkt pf1) n w * (qty (Suc n) w) = val_process Mkt (qty_mult_comp pf1 qty) n w" .
   thus "val_process Mkt (qty_mult_comp pf1 qty) n w = (val_process Mkt pf1) n w * (qty (Suc n) w)" ..
 qed
 
 
 
 
 
 lemma remove_comp_values:
   assumes "x \<noteq> y"
   shows "\<forall>n w. pf1 x n w = (qty_rem_comp pf1 y) x n w"
 proof (intro allI)
   fix n w
   show "pf1 x n w = (qty_rem_comp pf1 y) x n w" by (simp add: assms qty_rem_comp_def)
 qed
 
 
 
 
 lemma remove_comp_val_process:
   assumes "portfolio pf1"
 shows "\<forall>n w. val_process Mkt (qty_rem_comp pf1 y) n w = ((val_process Mkt pf1) n w) - (prices Mkt y n w)* (pf1 y (Suc n) w)"
 proof (intro allI)
   fix n w
   have pf:"portfolio (qty_rem_comp pf1 y)" using assms by (simp add:remove_comp_portfolio)
   have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
   hence fin2: "finite (support_set pf1 - {y})" by simp
   have "((val_process Mkt pf1) n w)  =
     (\<Sum> x\<in> (support_set pf1). ((prices Mkt) x n w) * (pf1 x (Suc n) w))"
     unfolding val_process_def using assms by simp
   also have "... = (\<Sum> x\<in> (support_set pf1 - {y}).
     (((prices Mkt) x n w) * (pf1 x (Suc n) w))) + (prices Mkt y n w)* (pf1 y (Suc n) w)"
   proof (cases "y\<in> support_set pf1")
     case True
     thus ?thesis by (simp add: fin sum_diff1)
   next
     case False
     hence "pf1 y (Suc n) w = 0" unfolding support_set_def by simp
     thus ?thesis by (simp add: fin sum_diff1)
   qed
   also have "... = (\<Sum> x\<in> (support_set pf1 - {y}).
     ((prices Mkt) x n w) * ((qty_rem_comp pf1 y) x (Suc n) w)) + (prices Mkt y n w)* (pf1 y (Suc n) w)"
   proof -
     have "(\<Sum> x\<in> (support_set pf1 - {y}). (((prices Mkt) x n w) * (pf1 x (Suc n) w))) =
       (\<Sum> x\<in> (support_set pf1 - {y}). ((prices Mkt) x n w) * ((qty_rem_comp pf1 y) x (Suc n) w))"
     proof (rule sum.cong,simp)
       fix x
       assume "x\<in> support_set pf1 - {y}"
       show "prices Mkt x n w * pf1 x (Suc n) w = prices Mkt x n w * qty_rem_comp pf1 y x (Suc n) w" using remove_comp_values
         by (metis DiffD2 \<open>x \<in> support_set pf1 - {y}\<close> singletonI)
     qed
     thus ?thesis by simp
   qed
   also have "... = (val_process Mkt (qty_rem_comp pf1 y) n w) + (prices Mkt y n w)* (pf1 y (Suc n) w)"
     using subset_val_process'[of "support_set pf1 - {y}" "qty_rem_comp pf1 y"] fin2
     by (simp add: remove_comp_support_set)
   finally have "(val_process Mkt pf1) n w =
     (val_process Mkt (qty_rem_comp pf1 y) n w) + (prices Mkt y n w)* (pf1 y (Suc n) w)" .
   thus  "val_process Mkt (qty_rem_comp pf1 y) n w = ((val_process Mkt pf1) n w) - (prices Mkt y n w)* (pf1 y (Suc n) w)" by simp
 qed
 
 
 
 
 lemma replace_comp_val_process:
   assumes "\<forall>n w. prices Mkt x n w = val_process Mkt pf2 n w"
   and "portfolio pf1"
   and "portfolio pf2"
   shows "\<forall>n w. val_process Mkt (qty_replace_comp pf1 x pf2) n w = val_process Mkt pf1 n w"
 proof (intro allI)
   fix n w
   have "val_process Mkt (qty_replace_comp pf1 x pf2) n w = val_process Mkt (qty_rem_comp pf1 x) n w +
     val_process Mkt (qty_mult_comp pf2 (pf1 x)) n w" unfolding qty_replace_comp_def using assms
     sum_val_process[of "qty_rem_comp pf1 x" "qty_mult_comp pf2 (pf1 x)"]
     by (simp add: mult_comp_portfolio remove_comp_portfolio)
   also have "... = val_process Mkt pf1 n w - (prices Mkt x n w * pf1 x (Suc n) w) + val_process Mkt pf2 n w * pf1 x (Suc n) w"
     by (simp add: assms(2) assms(3) mult_comp_val_process remove_comp_val_process)
   also have "... = val_process Mkt pf1 n w" using assms by simp
   finally show "val_process Mkt (qty_replace_comp pf1 x pf2) n w = val_process Mkt pf1 n w" .
 qed
 
 lemma qty_single_val_process:
 shows "val_process Mkt (qty_single asset qty) n w =
     prices Mkt asset n w * qty (Suc n) w"
 proof -
   have "val_process Mkt (qty_single asset qty) n w =
     (sum (\<lambda>x. ((prices Mkt) x n w) * ((qty_single asset qty) x (Suc n) w)) {asset})"
   proof (rule subset_val_process')
     show "finite {asset}" by simp
     show "support_set (qty_single asset qty) \<subseteq> {asset}" by (simp add: single_comp_support)
   qed
   also have "... = prices Mkt asset n w * qty (Suc n) w" unfolding qty_single_def by simp
   finally show ?thesis .
 qed
 
 
 
 subsubsection \<open>Trading strategies\<close>
 
 
 
 
 
 locale disc_equity_market = triv_init_disc_filtr_prob_space +
   fixes Mkt::"('a,'b) discrete_market"
 
 
 paragraph \<open>Discrete predictable processes\<close>
 
 
 
 paragraph \<open>Trading strategy\<close>
 
 definition (in disc_filtr_prob_space) trading_strategy
 where
   "trading_strategy p \<longleftrightarrow> portfolio p \<and> (\<forall>asset \<in> support_set p. borel_predict_stoch_proc F (p asset))"
 
 definition (in disc_filtr_prob_space) support_adapt:: "('a, 'b) discrete_market \<Rightarrow> ('b \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> bool" where
   "support_adapt Mkt pf \<longleftrightarrow> (\<forall> asset \<in> support_set pf. borel_adapt_stoch_proc F (prices Mkt asset))"
 
 lemma (in disc_filtr_prob_space) quantity_adapted:
   assumes "\<forall> asset \<in> support_set p. p asset (Suc n) \<in> borel_measurable (F n)"
   "\<forall>asset \<in> support_set p. prices Mkt asset n \<in> borel_measurable (F n)"
 shows "val_process Mkt p n \<in> borel_measurable (F n)"
 proof (cases "portfolio p")
 case False
   have "val_process Mkt p = (\<lambda> n w. 0)" unfolding val_process_def using False by simp
   thus "?thesis" by simp
 next
   case True
   hence "val_process Mkt p n = (\<lambda>w. \<Sum>x\<in>support_set p. prices Mkt x n w * p x (Suc n) w)"
     unfolding val_process_def using True by simp
   moreover have "(\<lambda>w. \<Sum>x\<in>support_set p. prices Mkt x n w * p x (Suc n) w) \<in> borel_measurable (F n)"
   proof (rule borel_measurable_sum)
     fix asset
     assume "asset\<in> support_set p"
     hence "p asset (Suc n) \<in> borel_measurable (F n)" using assms unfolding trading_strategy_def adapt_stoch_proc_def by simp
     moreover have "prices Mkt asset n \<in> borel_measurable (F n)"
       using \<open>asset \<in> support_set p\<close>  assms(2) unfolding support_adapt_def by (simp add: adapt_stoch_proc_def)
     ultimately show "(\<lambda>x. prices Mkt asset n x * p asset (Suc n) x) \<in> borel_measurable (F n)" by simp
   qed
   ultimately show "val_process Mkt p n \<in> borel_measurable (F n)" by simp
 qed
 
 
 
 lemma (in disc_filtr_prob_space) trading_strategy_adapted:
   assumes "trading_strategy p"
   and "support_adapt Mkt p"
   shows "borel_adapt_stoch_proc F (val_process Mkt p)" unfolding support_adapt_def
 proof (cases "portfolio p")
 case False
   have "val_process Mkt p = (\<lambda> n w. 0)" unfolding val_process_def using False by simp
   thus "borel_adapt_stoch_proc F (val_process Mkt p)"
     by (simp add: constant_process_borel_adapted)
 next
 case True
   show ?thesis unfolding adapt_stoch_proc_def
   proof
     fix n
     have "val_process Mkt p n = (\<lambda>w. \<Sum>x\<in>support_set p. prices Mkt x n w * p x (Suc n) w)"
       unfolding val_process_def using True by simp
     moreover have "(\<lambda>w. \<Sum>x\<in>support_set p. prices Mkt x n w * p x (Suc n) w) \<in> borel_measurable (F n)"
     proof (rule borel_measurable_sum)
       fix asset
       assume "asset\<in> support_set p"
       hence "p asset (Suc n) \<in> borel_measurable (F n)" using assms unfolding trading_strategy_def predict_stoch_proc_def by simp
       moreover have "prices Mkt asset n \<in> borel_measurable (F n)"
         using \<open>asset \<in> support_set p\<close>  assms(2) unfolding support_adapt_def  by (simp add:adapt_stoch_proc_def)
       ultimately show "(\<lambda>x. prices Mkt asset n x * p asset (Suc n) x) \<in> borel_measurable (F n)" by simp
     qed
     ultimately show "val_process Mkt p n \<in> borel_measurable (F n)" by simp
   qed
 qed
 
 
 
 
 lemma (in disc_equity_market) ats_val_process_adapted:
   assumes "trading_strategy p"
 and "support_adapt Mkt p"
   shows "borel_adapt_stoch_proc F (val_process Mkt p)" unfolding support_adapt_def
   by (meson assms(1) assms(2)  subsetCE trading_strategy_adapted)
 
 
 
 lemma (in disc_equity_market) trading_strategy_init:
   assumes "trading_strategy p"
 and "support_adapt Mkt p"
   shows "\<exists>c. \<forall>w \<in> space M. val_process Mkt p 0 w = c" using assms adapted_init ats_val_process_adapted by simp
 
 
 definition (in disc_equity_market) initial_value where
   "initial_value pf = constant_image (val_process Mkt pf 0)"
 
 lemma (in disc_equity_market) initial_valueI:
   assumes "trading_strategy pf"
 and "support_adapt Mkt pf"
   shows "\<forall>w\<in> space M. val_process Mkt pf 0 w = initial_value pf" unfolding initial_value_def
 proof (rule constant_imageI)
   show "\<exists>c. \<forall>w\<in>space M. val_process Mkt pf 0 w = c" using trading_strategy_init assms by simp
 qed
 
 
 lemma (in disc_equity_market) inc_predict_support_trading_strat:
   assumes "trading_strategy pf1"
   shows "\<forall> asset \<in> support_set pf1 \<union> B. borel_predict_stoch_proc F (pf1 asset)"
 proof
   fix asset
   assume "asset \<in> support_set pf1 \<union> B"
   show "borel_predict_stoch_proc F (pf1 asset)"
   proof (cases "asset \<in> support_set pf1")
     case True
     thus ?thesis using assms unfolding trading_strategy_def by simp
   next
     case False
     hence "\<forall>n w. pf1 asset n w = 0" unfolding support_set_def by simp
     show ?thesis unfolding predict_stoch_proc_def
     proof
       show "pf1 asset 0 \<in> measurable (F 0) borel" using \<open>\<forall>n w. pf1 asset n w = 0\<close>
         by (simp add: borel_measurable_const measurable_cong)
     next
       show "\<forall>n. pf1 asset (Suc n) \<in> borel_measurable (F n)"
       proof
         fix n
         have "\<forall>w. pf1 asset (Suc n) w = 0" using \<open>\<forall>n w. pf1 asset n w = 0\<close> by simp
         have "0\<in> space borel" by simp
         thus "pf1 asset (Suc n) \<in> measurable (F n) borel" using measurable_const[of 0 borel "F n"]
           by (metis \<open>0 \<in> space borel \<Longrightarrow> (\<lambda>x. 0) \<in> borel_measurable (F n)\<close> \<open>0 \<in> space borel\<close>
               \<open>\<forall>n w. pf1 asset n w = 0\<close> measurable_cong)
       qed
     qed
   qed
 qed
 
 lemma (in disc_equity_market) inc_predict_support_trading_strat':
   assumes "trading_strategy pf1"
   and "asset \<in> support_set pf1\<union> B"
   shows "borel_predict_stoch_proc F (pf1 asset)"
 proof (cases "asset \<in> support_set pf1")
   case True
   thus ?thesis using assms unfolding trading_strategy_def by simp
 next
   case False
   hence "\<forall>n w. pf1 asset n w = 0" unfolding support_set_def by simp
   show ?thesis unfolding predict_stoch_proc_def
   proof
     show "pf1 asset 0 \<in> measurable (F 0) borel" using \<open>\<forall>n w. pf1 asset n w = 0\<close>
       by (simp add: borel_measurable_const measurable_cong)
   next
     show "\<forall>n. pf1 asset (Suc n) \<in> borel_measurable (F n)"
     proof
       fix n
       have "\<forall>w. pf1 asset (Suc n) w = 0" using \<open>\<forall>n w. pf1 asset n w = 0\<close> by simp
       have "0\<in> space borel" by simp
       thus "pf1 asset (Suc n) \<in> measurable (F n) borel" using measurable_const[of 0 borel "F n"]
         by (metis \<open>0 \<in> space borel \<Longrightarrow> (\<lambda>x. 0) \<in> borel_measurable (F n)\<close> \<open>0 \<in> space borel\<close>
             \<open>\<forall>n w. pf1 asset n w = 0\<close> measurable_cong)
     qed
   qed
 qed
 
 
 
 lemma (in disc_equity_market) inc_support_trading_strat:
   assumes "trading_strategy pf1"
   shows "\<forall> asset \<in> support_set pf1 \<union> B. borel_adapt_stoch_proc F (pf1 asset)" using assms
   by (simp add: inc_predict_support_trading_strat predict_imp_adapt)
 
 lemma (in disc_equity_market) qty_empty_trading_strat:
   shows "trading_strategy qty_empty" unfolding trading_strategy_def 
 proof (intro conjI ballI)
   show "portfolio qty_empty"
     by (metis fun_upd_triv qty_single_def single_comp_portfolio) 
   show "\<And>asset. asset \<in> support_set qty_empty \<Longrightarrow> borel_predict_stoch_proc F (qty_empty asset)"
     using qty_empty_support_set by auto
 qed													  
 
 lemma (in disc_equity_market) sum_trading_strat:
   assumes "trading_strategy pf1"
   and "trading_strategy pf2"
 shows "trading_strategy (qty_sum pf1 pf2)"
 proof -
   have "\<forall> asset \<in> support_set pf1 \<union> support_set pf2. borel_predict_stoch_proc F (pf1 asset)"
     using assms by (simp add: inc_predict_support_trading_strat)
   have "\<forall> asset \<in> support_set pf2 \<union> support_set pf1. borel_predict_stoch_proc F (pf2 asset)"
     using assms by (simp add: inc_predict_support_trading_strat)
   have "\<forall> asset \<in> support_set pf1 \<union> support_set pf2. borel_predict_stoch_proc F ((qty_sum pf1 pf2) asset)"
   proof
     fix asset
     assume "asset \<in> support_set pf1 \<union> support_set pf2"
     show "borel_predict_stoch_proc F (qty_sum pf1 pf2 asset)" unfolding predict_stoch_proc_def qty_sum_def
     proof
       show "(\<lambda>w. pf1 asset 0 w + pf2 asset 0 w) \<in> borel_measurable (F 0)"
       proof -
         have "(\<lambda>w. pf1 asset 0 w) \<in> borel_measurable (F 0)"
         using \<open>\<forall>asset\<in>support_set pf1 \<union> support_set pf2. borel_predict_stoch_proc F (pf1 asset)\<close>
         \<open>asset \<in> support_set pf1 \<union> support_set pf2\<close> predict_stoch_proc_def by blast
         moreover have "(\<lambda>w. pf2 asset 0 w) \<in> borel_measurable (F 0)"
           using \<open>\<forall>asset\<in>support_set pf2 \<union> support_set pf1. borel_predict_stoch_proc F (pf2 asset)\<close>
           \<open>asset \<in> support_set pf1 \<union> support_set pf2\<close> predict_stoch_proc_def by blast
         ultimately show ?thesis by simp
       qed
     next
       show "\<forall>n. (\<lambda>w. pf1 asset (Suc n) w + pf2 asset (Suc n) w) \<in> borel_measurable (F n)"
       proof
         fix n
         have "(\<lambda>w. pf1 asset (Suc n) w) \<in> borel_measurable (F n)"
           using \<open>\<forall>asset\<in>support_set pf1 \<union> support_set pf2. borel_predict_stoch_proc F (pf1 asset)\<close>
           \<open>asset \<in> support_set pf1 \<union> support_set pf2\<close> predict_stoch_proc_def by blast
         moreover have "(\<lambda>w. pf2 asset (Suc n) w) \<in> borel_measurable (F n)"
           using \<open>\<forall>asset\<in>support_set pf2 \<union> support_set pf1. borel_predict_stoch_proc F (pf2 asset)\<close>
           \<open>asset \<in> support_set pf1 \<union> support_set pf2\<close> predict_stoch_proc_def by blast
         ultimately show "(\<lambda>w. pf1 asset (Suc n) w + pf2 asset (Suc n) w) \<in> borel_measurable (F n)" by simp
       qed
     qed
   qed
   thus ?thesis unfolding trading_strategy_def using sum_support_set[of pf1 pf2]
     by (meson assms(1) assms(2) subsetCE sum_portfolio trading_strategy_def)
 qed
 
 lemma (in disc_equity_market) mult_comp_trading_strat:
   assumes "trading_strategy pf1"
   and "borel_predict_stoch_proc F qty"
 shows "trading_strategy (qty_mult_comp pf1 qty)"
 proof -
   have "\<forall> asset \<in> support_set pf1. borel_predict_stoch_proc F (pf1 asset)"
     using assms unfolding trading_strategy_def by simp
   have "\<forall> asset \<in> support_set pf1. borel_predict_stoch_proc F (qty_mult_comp pf1 qty asset)"
     unfolding predict_stoch_proc_def qty_mult_comp_def
   proof (intro ballI conjI)
     fix asset
     assume "asset \<in> support_set pf1"
     show "(\<lambda>w. pf1 asset 0 w * qty 0 w) \<in> borel_measurable (F 0)"
     proof -
       have "(\<lambda>w. pf1 asset 0 w) \<in> borel_measurable (F 0)"
         using \<open>\<forall>asset\<in>support_set pf1. borel_predict_stoch_proc F (pf1 asset)\<close>
         \<open>asset \<in> support_set pf1\<close> predict_stoch_proc_def by auto
       moreover have "(\<lambda>w. qty 0 w) \<in> borel_measurable (F 0)" using assms predict_stoch_proc_def by auto
       ultimately show "(\<lambda>w. pf1 asset 0 w * qty 0 w) \<in> borel_measurable (F 0)" by simp
     qed
     show "\<forall>n. (\<lambda>w. pf1 asset (Suc n) w * qty (Suc n) w) \<in> borel_measurable (F n)"
     proof
       fix n
       have "(\<lambda>w. pf1 asset (Suc n) w) \<in> borel_measurable (F n)"
         using \<open>\<forall>asset\<in>support_set pf1. borel_predict_stoch_proc F (pf1 asset)\<close>
         \<open>asset \<in> support_set pf1\<close> predict_stoch_proc_def by blast
       moreover have "(\<lambda>w. qty (Suc n) w) \<in> borel_measurable (F n)" using assms predict_stoch_proc_def by blast
       ultimately show "(\<lambda>w. pf1 asset (Suc n) w * qty (Suc n) w) \<in> borel_measurable (F n)" by simp
     qed
   qed
   thus ?thesis unfolding trading_strategy_def using mult_comp_support_set[of pf1 qty]
     by (meson assms(1) mult_comp_portfolio subsetCE trading_strategy_def)
 qed
 
 lemma (in disc_equity_market) remove_comp_trading_strat:
   assumes "trading_strategy pf1"
 shows "trading_strategy (qty_rem_comp pf1 x)"
 proof -
   have "\<forall> asset \<in> support_set pf1. borel_predict_stoch_proc F (pf1 asset)"
     using assms unfolding trading_strategy_def by simp
   have "\<forall> asset \<in> support_set pf1. borel_predict_stoch_proc F (qty_rem_comp pf1 x asset)"
     unfolding predict_stoch_proc_def qty_rem_comp_def
   proof (intro ballI conjI)
     fix asset
     assume "asset \<in> support_set pf1"
     show "(pf1(x := \<lambda>n w. 0)) asset 0 \<in> borel_measurable (F 0)"
     proof -
       show "(\<lambda>w. (pf1(x := \<lambda>n w. 0)) asset 0 w) \<in> borel_measurable (F 0)"
       proof (cases "asset = x")
         case True
         thus ?thesis by simp
       next
         case False
         thus "(\<lambda>w. (pf1(x := \<lambda>n w. 0)) asset 0 w) \<in> borel_measurable (F 0)"
           using \<open>\<forall>asset\<in>support_set pf1. borel_predict_stoch_proc F (pf1 asset)\<close>
           \<open>asset \<in> support_set pf1\<close> by (simp add: predict_stoch_proc_def)
       qed
     qed
     show "\<forall>n. (\<lambda>w. (pf1(x := \<lambda>n w. 0)) asset (Suc n) w) \<in> borel_measurable (F n)"
     proof
       fix n
       show "(\<lambda>w. (pf1(x := \<lambda>n w. 0)) asset (Suc n) w) \<in> borel_measurable (F n)"
       proof (cases "asset = x")
         case True
         thus ?thesis by simp
       next
         case False
         thus "(\<lambda>w. (pf1(x := \<lambda>n w. 0)) asset (Suc n) w) \<in> borel_measurable (F n)"
           using \<open>\<forall>asset\<in>support_set pf1. borel_predict_stoch_proc F (pf1 asset)\<close>
           \<open>asset \<in> support_set pf1\<close> by (simp add: predict_stoch_proc_def)
       qed
     qed
   qed
   thus ?thesis unfolding trading_strategy_def using remove_comp_support_set[of pf1 x]
     by (metis Diff_empty assms remove_comp_portfolio subsetCE subset_Diff_insert trading_strategy_def)
 qed
 
 
 lemma (in disc_equity_market) replace_comp_trading_strat:
   assumes "trading_strategy pf1"
   and "trading_strategy pf2"
 shows "trading_strategy (qty_replace_comp pf1 x pf2)" unfolding qty_replace_comp_def
 proof (rule sum_trading_strat)
   show "trading_strategy (qty_rem_comp pf1 x)" using assms by (simp add: remove_comp_trading_strat)
   show "trading_strategy (qty_mult_comp pf2 (pf1 x))"
   proof (cases "x\<in> support_set pf1")
     case True
     hence "borel_predict_stoch_proc F (pf1 x)" using assms unfolding trading_strategy_def by simp
     thus ?thesis using assms by (simp add: mult_comp_trading_strat)
   next
     case False
     thus ?thesis
     proof -
       obtain nn :: "'c \<Rightarrow> ('c \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> nat" and aa :: "'c \<Rightarrow> ('c \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> 'a" where
         "\<forall>x0 x1. (\<exists>v2 v3. x1 x0 v2 v3 \<noteq> 0) = (x1 x0 (nn x0 x1) (aa x0 x1) \<noteq> 0)"
         by moura
       then have "\<forall>f c. (c \<notin> {c. \<exists>n a. f c n a \<noteq> 0} \<or> f c (nn c f) (aa c f) \<noteq> 0) \<and> (c \<in> {c. \<exists>n a. f c n a \<noteq> 0} \<or> (\<forall>n a. f c n a = 0))"
         by auto
       then show ?thesis
       proof -
         have "\<And>f c n a. qty_mult_comp f (pf1 x) (c::'c) n a = 0"
           by (metis False \<open>\<forall>f c. (c \<notin> {c. \<exists>n a. f c n a \<noteq> 0} \<or> f c (nn c f) (aa c f) \<noteq> 0) \<and> (c \<in> {c. \<exists>n a. f c n a \<noteq> 0} \<or> (\<forall>n a. f c n a = 0))\<close> mult.commute mult_zero_left qty_mult_comp_def support_set_def)
         then show ?thesis
           by (metis (no_types) \<open>\<forall>f c. (c \<notin> {c. \<exists>n a. f c n a \<noteq> 0} \<or> f c (nn c f) (aa c f) \<noteq> 0) \<and> (c \<in> {c. \<exists>n a. f c n a \<noteq> 0} \<or> (\<forall>n a. f c n a = 0))\<close> assms(2) mult_comp_portfolio support_set_def trading_strategy_def)
       qed
     qed
   qed
 qed
 
 
 
 subsubsection \<open>Self-financing portfolios\<close>
 
 paragraph \<open>Closing value process\<close>
 
 fun up_cl_proc where
   "up_cl_proc Mkt p 0 = val_process Mkt p 0" |
   "up_cl_proc Mkt p (Suc n) = (\<lambda>w. \<Sum>x\<in>support_set p. prices Mkt x (Suc n) w * p x (Suc n) w)"
 
 
 definition cls_val_process where
 "cls_val_process Mkt p = (if (\<not> (portfolio p)) then (\<lambda> n w. 0)
     else (\<lambda> n w . up_cl_proc Mkt p n w))"
 
 
 
 lemma (in disc_filtr_prob_space) quantity_updated_borel:
   assumes "\<forall>n. \<forall> asset \<in> support_set p. p asset (Suc n) \<in> borel_measurable (F n)"
 and "\<forall>n. \<forall>asset \<in> support_set p. prices Mkt asset n \<in> borel_measurable (F n)"
 shows "\<forall>n. cls_val_process Mkt p n \<in> borel_measurable (F n)"
 proof (cases "portfolio p")
 case False
   have "cls_val_process Mkt p = (\<lambda> n w. 0)" unfolding cls_val_process_def using False by simp
   thus "?thesis" by simp
 next
   case True
   show "\<forall>n. cls_val_process Mkt p n \<in> borel_measurable (F n)"
   proof
     fix n
     show "cls_val_process Mkt p n \<in> borel_measurable (F n)"
     proof (cases "n = 0")
       case False
       hence "\<exists>m. n = Suc m" using old.nat.exhaust by auto
       from this obtain m where "n = Suc m" by auto
       have "cls_val_process Mkt p (Suc m) = (\<lambda>w. \<Sum>x\<in>support_set p. prices Mkt x (Suc m) w * p x (Suc m) w)"
         unfolding cls_val_process_def using True by simp
       moreover have "(\<lambda>w. \<Sum>x\<in>support_set p. prices Mkt x (Suc m) w * p x (Suc m) w) \<in> borel_measurable (F (Suc m))"
       proof (rule borel_measurable_sum)
         fix asset
         assume "asset\<in> support_set p"
         hence "p asset (Suc m) \<in> borel_measurable (F m)" using assms unfolding trading_strategy_def adapt_stoch_proc_def by simp
         hence "p asset (Suc m) \<in> borel_measurable (F (Suc m))"
           using Suc_n_not_le_n increasing_measurable_info nat_le_linear by blast
         moreover have "prices Mkt asset (Suc m) \<in> borel_measurable (F (Suc m))"
           using \<open>asset \<in> support_set p\<close>  assms(2) unfolding support_adapt_def adapt_stoch_proc_def by blast
         ultimately show "(\<lambda>x. prices Mkt asset (Suc m) x * p asset (Suc m) x) \<in> borel_measurable (F (Suc m))" by simp
       qed
       ultimately have "cls_val_process Mkt p (Suc m) \<in> borel_measurable (F (Suc m))" by simp
       thus ?thesis using \<open>n = Suc m\<close> by simp
     next
       case True
       thus "cls_val_process Mkt p n \<in> borel_measurable (F n)"
         by (metis (no_types, lifting) assms(1) assms(2)  quantity_adapted up_cl_proc.simps(1)
             cls_val_process_def val_process_def)
     qed
   qed
 qed
 
 
 lemma (in disc_equity_market) cls_val_process_adapted:
   assumes "trading_strategy p"
 and "support_adapt Mkt p"
   shows "borel_adapt_stoch_proc F (cls_val_process Mkt p)"
 proof (cases "portfolio p")
   case False
     have "cls_val_process Mkt p = (\<lambda> n w. 0)" unfolding cls_val_process_def using False by simp
     thus "borel_adapt_stoch_proc F (cls_val_process Mkt p)"
       by (simp add: constant_process_borel_adapted)
 next
   case True
   show ?thesis unfolding adapt_stoch_proc_def
   proof
     fix n
     show "cls_val_process Mkt p n \<in> borel_measurable (F n)"
     proof (cases "n = 0")
     case True
       thus "cls_val_process Mkt p n \<in> borel_measurable (F n)"
         using up_cl_proc.simps(1) assms
         by (metis (no_types, lifting) adapt_stoch_proc_def ats_val_process_adapted cls_val_process_def
             val_process_def)
     next
     case False
       hence "\<exists>m. Suc m = n" using not0_implies_Suc by blast
       from this obtain m where "Suc m = n" by auto
       hence "cls_val_process Mkt p n = up_cl_proc Mkt p n" unfolding cls_val_process_def using True by simp
       also have "... = (\<lambda>w. \<Sum>x\<in>support_set p. prices Mkt x n w * p x n w)"
         using up_cl_proc.simps(2) \<open>Suc m = n\<close> by auto
       finally have "cls_val_process Mkt p n = (\<lambda>w. \<Sum>x\<in>support_set p. prices Mkt x n w * p x n w)" .
     moreover have "(\<lambda>w. \<Sum>x\<in>support_set p. prices Mkt x n w * p x n w) \<in> borel_measurable (F n)"
     proof (rule borel_measurable_sum)
       fix asset
       assume "asset\<in> support_set p"
       hence "p asset n \<in> borel_measurable (F n)" using assms unfolding trading_strategy_def predict_stoch_proc_def
         using Suc_n_not_le_n \<open>Suc m = n\<close> increasing_measurable_info nat_le_linear by blast
       moreover have "prices Mkt asset n \<in> borel_measurable (F n)" using  assms \<open>asset \<in> support_set p\<close> unfolding support_adapt_def adapt_stoch_proc_def
         using stock_portfolio_def by blast
       ultimately show "(\<lambda>x. prices Mkt asset n x * p asset n x) \<in> borel_measurable (F n)" by simp
     qed
     ultimately show "cls_val_process Mkt p n \<in> borel_measurable (F n)" by simp
     qed
   qed
 qed
 
 lemma subset_cls_val_process:
   assumes "finite A"
   and "support_set p \<subseteq> A"
 shows "\<forall>n w. cls_val_process Mkt p (Suc n) w = (sum (\<lambda>x. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) A)"
 proof (intro allI)
   fix n::nat
   fix w::'b
   have "portfolio p" using assms unfolding portfolio_def using finite_subset by auto
   have "\<exists>C. (support_set p) \<inter> C = {} \<and> (support_set p) \<union> C = A" using assms(2) by auto
   from this obtain C where "(support_set p) \<inter> C = {}" and "(support_set p) \<union> C = A" by auto note Cprops = this
   have "finite C" using assms \<open>(support_set p) \<union> C = A\<close> by auto
   have "\<forall>x\<in> C. p x (Suc n) w = 0" using Cprops(1) support_set_def by fastforce
   hence "(\<Sum>x\<in> C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) = 0" by simp
   hence "cls_val_process Mkt p (Suc n) w = (\<Sum>x\<in> (support_set p). ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))
     + (\<Sum>x\<in> C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" unfolding cls_val_process_def
     using \<open>portfolio p\<close> up_cl_proc.simps(2)[of Mkt p n] by simp
   also have "... = (\<Sum> x\<in> A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))"
     using \<open>portfolio p\<close> \<open>finite C\<close> Cprops portfolio_def sum_union_disjoint' by (metis (no_types, lifting))
   finally show "cls_val_process Mkt p (Suc n) w = (\<Sum> x\<in> A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" .
 qed
 
 lemma subset_cls_val_process':
   assumes "finite A"
   and "support_set p \<subseteq> A"
 shows "cls_val_process Mkt p (Suc n) w = (sum (\<lambda>x. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) A)"
 proof -
   have "portfolio p" using assms unfolding portfolio_def using finite_subset by auto
   have "\<exists>C. (support_set p) \<inter> C = {} \<and> (support_set p) \<union> C = A" using assms(2) by auto
   from this obtain C where "(support_set p) \<inter> C = {}" and "(support_set p) \<union> C = A" by auto note Cprops = this
   have "finite C" using assms \<open>(support_set p) \<union> C = A\<close> by auto
   have "\<forall>x\<in> C. p x (Suc n) w = 0" using Cprops(1) support_set_def by fastforce
   hence "(\<Sum>x\<in> C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) = 0" by simp
   hence "cls_val_process Mkt p (Suc n) w = (\<Sum>x\<in> (support_set p). ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))
     + (\<Sum>x\<in> C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" unfolding cls_val_process_def
     using \<open>portfolio p\<close> up_cl_proc.simps(2)[of Mkt p n] by simp
   also have "... = (\<Sum> x\<in> A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))"
     using \<open>portfolio p\<close> \<open>finite C\<close> Cprops portfolio_def sum_union_disjoint' by (metis (no_types, lifting))
   finally show "cls_val_process Mkt p (Suc n) w = (\<Sum> x\<in> A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" .
 qed
 
 
 
 lemma sum_cls_val_process_Suc:
   assumes "portfolio pf1"
   and "portfolio pf2"
 shows "\<forall>n w. cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
   (cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w"
 proof (intro allI)
   fix n w
   have vp1: "cls_val_process Mkt pf1 (Suc n) w =
     (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))"
   proof -
     have "finite (support_set pf1 \<union> support_set pf2) \<and> support_set pf1 \<subseteq> support_set pf1 \<union> support_set pf2"
       by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
     then show ?thesis
       by (simp add: subset_cls_val_process)
   qed
   have vp2: "cls_val_process Mkt pf2 (Suc n) w = (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf2 x (Suc n) w))"
   proof -
     have "finite (support_set pf1 \<union> support_set pf2) \<and> support_set pf2 \<subseteq> support_set pf2 \<union> support_set pf1"
       by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
     then show ?thesis by (auto simp add: subset_cls_val_process)
   qed
   have pf:"portfolio (qty_sum pf1 pf2)" using assms by (simp add:sum_portfolio)
   have fin:"finite (support_set pf1 \<union> support_set pf2)" using assms finite_Un unfolding portfolio_def by auto
   have "(cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w =
     (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w)) +
     (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf2 x (Suc n) w))"
     using vp1 vp2 by simp
   also have "... = (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2).
     (((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w)) + ((prices Mkt) x (Suc n) w) * (pf2 x (Suc n) w))"
     by (simp add: sum.distrib)
   also have "... = (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2).
     ((prices Mkt) x (Suc n) w) * ((pf1 x (Suc n) w) + (pf2 x (Suc n) w)))" by (simp add: distrib_left)
   also have "... = (\<Sum> x\<in> (support_set pf1)\<union> (support_set pf2).
     ((prices Mkt) x (Suc n) w) * ((qty_sum pf1 pf2) x (Suc n) w))" by (simp add: qty_sum_def)
   also have "... = (\<Sum> x\<in> (support_set (qty_sum pf1 pf2)).
     ((prices Mkt) x (Suc n) w) * ((qty_sum pf1 pf2) x (Suc n) w))" using sum_support_set[of pf1 pf2]
     subset_cls_val_process[of "support_set pf1\<union> support_set pf2" "qty_sum pf1 pf2"] pf fin
     unfolding cls_val_process_def by simp
   also have "... = cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w"
     by (metis (no_types, lifting) pf sum.cong up_cl_proc.simps(2) cls_val_process_def)
   finally have "(cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w =
     cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w" .
   thus "cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
     (cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w" ..
 qed
 
 lemma sum_cls_val_process0:
   assumes "portfolio pf1"
   and "portfolio pf2"
 shows "\<forall>w. cls_val_process Mkt (qty_sum pf1 pf2) 0 w =
   (cls_val_process Mkt pf1) 0 w + (cls_val_process Mkt pf2) 0 w" unfolding cls_val_process_def
   by (simp add: sum_val_process assms(1) assms(2) sum_portfolio)
 
 lemma sum_cls_val_process:
   assumes "portfolio pf1"
   and "portfolio pf2"
 shows "\<forall>n w. cls_val_process Mkt (qty_sum pf1 pf2) n w =
   (cls_val_process Mkt pf1) n w + (cls_val_process Mkt pf2) n w"
   by (metis (no_types, lifting) assms(1) assms(2) sum_cls_val_process0 sum_cls_val_process_Suc up_cl_proc.elims)
 
 lemma mult_comp_cls_val_process0:
   assumes "portfolio pf1"
   shows "\<forall>w. cls_val_process Mkt (qty_mult_comp pf1 qty) 0 w =
   ((cls_val_process Mkt pf1) 0 w) * (qty (Suc 0) w)" unfolding cls_val_process_def
   by (simp add: assms mult_comp_portfolio mult_comp_val_process)
 
 lemma mult_comp_cls_val_process_Suc:
   assumes "portfolio pf1"
   shows "\<forall>n w. cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w =
   ((cls_val_process Mkt pf1) (Suc n) w) * (qty (Suc n) w)"
 proof (intro allI)
   fix n w
   have pf:"portfolio (qty_mult_comp pf1 qty)" using assms by (simp add:mult_comp_portfolio)
   have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
   have "((cls_val_process Mkt pf1) (Suc n) w) * (qty (Suc n) w) =
     (\<Sum> x\<in> (support_set pf1). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))*(qty (Suc n) w)"
     unfolding cls_val_process_def using assms by simp
   also have "... = (\<Sum> x\<in> (support_set pf1).
     (((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w) * (qty (Suc n) w)))" using sum_distrib_right by auto
   also have "... = (\<Sum> x\<in> (support_set pf1).
     ((prices Mkt) x (Suc n) w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" unfolding qty_mult_comp_def
     by (simp add: mult.commute mult.left_commute)
   also have "... = (\<Sum> x\<in> (support_set (qty_mult_comp pf1 qty)).
     ((prices Mkt) x (Suc n) w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" using mult_comp_support_set[of pf1 qty]
     subset_cls_val_process[of "support_set pf1" "qty_mult_comp pf1 qty"] pf fin up_cl_proc.simps(2)
     unfolding cls_val_process_def by simp
   also have "... = cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w"   by (metis (no_types, lifting) pf sum.cong cls_val_process_def up_cl_proc.simps(2))
   finally have "(cls_val_process Mkt pf1) (Suc n) w * (qty (Suc n) w) = cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w" .
   thus "cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w = (cls_val_process Mkt pf1) (Suc n) w * (qty (Suc n) w)" ..
 qed
 
 
 
 
 lemma remove_comp_cls_val_process0:
   assumes "portfolio pf1"
   shows "\<forall>w. cls_val_process Mkt (qty_rem_comp pf1 y) 0 w =
   ((cls_val_process Mkt pf1) 0 w) - (prices Mkt y 0 w)* (pf1 y (Suc 0) w)" unfolding cls_val_process_def
   by (simp add: assms remove_comp_portfolio remove_comp_val_process)
 
 
 lemma remove_comp_cls_val_process_Suc:
   assumes "portfolio pf1"
   shows "\<forall>n w. cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w =
   ((cls_val_process Mkt pf1) (Suc n) w) - (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
 proof (intro allI)
   fix n w
   have pf:"portfolio (qty_rem_comp pf1 y)" using assms by (simp add:remove_comp_portfolio)
   have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
   hence fin2: "finite (support_set pf1 - {y})" by simp
   have "((cls_val_process Mkt pf1) (Suc n) w)  =
     (\<Sum> x\<in> (support_set pf1). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))"
     unfolding cls_val_process_def using assms by simp
   also have "... = (\<Sum> x\<in> (support_set pf1 - {y}).
     (((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
   proof (cases "y\<in> support_set pf1")
     case True
     thus ?thesis by (simp add: fin sum_diff1)
   next
     case False
     hence "pf1 y (Suc n) w = 0" unfolding support_set_def by simp
     thus ?thesis by (simp add: fin sum_diff1)
   qed
   also have "... = (\<Sum> x\<in> (support_set pf1 - {y}).
     ((prices Mkt) x (Suc n) w) * ((qty_rem_comp pf1 y) x (Suc n) w)) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
   proof -
     have "(\<Sum> x\<in> (support_set pf1 - {y}). (((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))) =
       (\<Sum> x\<in> (support_set pf1 - {y}). ((prices Mkt) x (Suc n) w) * ((qty_rem_comp pf1 y) x (Suc n) w))"
     proof (rule sum.cong,simp)
       fix x
       assume "x\<in> support_set pf1 - {y}"
       show "prices Mkt x (Suc n) w * pf1 x (Suc n) w = prices Mkt x (Suc n) w * qty_rem_comp pf1 y x (Suc n) w" using remove_comp_values
         by (metis DiffD2 \<open>x \<in> support_set pf1 - {y}\<close> singletonI)
     qed
     thus ?thesis by simp
   qed
   also have "... = (cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
     using subset_cls_val_process[of "support_set pf1 - {y}" "qty_rem_comp pf1 y"] fin2
     by (simp add: remove_comp_support_set)
   finally have "(cls_val_process Mkt pf1) (Suc n) w =
     (cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)" .
   thus  "cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w =
     ((cls_val_process Mkt pf1) (Suc n) w) - (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)" by simp
 qed
 
 
 
 lemma replace_comp_cls_val_process0:
   assumes "\<forall>w. prices Mkt x 0 w = cls_val_process Mkt pf2 0 w"
   and "portfolio pf1"
   and "portfolio pf2"
 shows "\<forall>w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) 0 w = cls_val_process Mkt pf1 0 w"
 proof
   fix w
   have "cls_val_process Mkt (qty_replace_comp pf1 x pf2) 0 w = cls_val_process Mkt (qty_rem_comp pf1 x) 0 w +
     cls_val_process Mkt (qty_mult_comp pf2 (pf1 x)) 0 w" unfolding qty_replace_comp_def using assms
     sum_cls_val_process0[of "qty_rem_comp pf1 x" "qty_mult_comp pf2 (pf1 x)"]
     by (simp add: mult_comp_portfolio remove_comp_portfolio)
   also have "... = cls_val_process Mkt pf1 0 w - (prices Mkt x 0 w * pf1 x (Suc 0) w) +
     cls_val_process Mkt pf2 0 w * pf1 x (Suc 0) w"
     by (simp add: assms(2) assms(3) mult_comp_cls_val_process0 remove_comp_cls_val_process0)
   also have "... = cls_val_process Mkt pf1 0 w" using assms by simp
   finally show "cls_val_process Mkt (qty_replace_comp pf1 x pf2) 0 w = cls_val_process Mkt pf1 0 w" .
 qed
 
 
 lemma replace_comp_cls_val_process_Suc:
   assumes "\<forall>n w. prices Mkt x (Suc n) w = cls_val_process Mkt pf2 (Suc n) w"
   and "portfolio pf1"
   and "portfolio pf2"
   shows "\<forall>n w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt pf1 (Suc n) w"
 proof (intro allI)
   fix n w
   have "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt (qty_rem_comp pf1 x) (Suc n) w +
     cls_val_process Mkt (qty_mult_comp pf2 (pf1 x)) (Suc n) w" unfolding qty_replace_comp_def using assms
     sum_cls_val_process_Suc[of "qty_rem_comp pf1 x" "qty_mult_comp pf2 (pf1 x)"]
     by (simp add: mult_comp_portfolio remove_comp_portfolio)
   also have "... = cls_val_process Mkt pf1 (Suc n) w - (prices Mkt x (Suc n) w * pf1 x (Suc n) w) +
     cls_val_process Mkt pf2 (Suc n) w * pf1 x (Suc n) w"
     by (simp add: assms(2) assms(3) mult_comp_cls_val_process_Suc remove_comp_cls_val_process_Suc)
   also have "... = cls_val_process Mkt pf1 (Suc n) w" using assms by simp
   finally show "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt pf1 (Suc n) w" .
 qed
 
 
 lemma replace_comp_cls_val_process:
   assumes "\<forall>n w. prices Mkt x n w = cls_val_process Mkt pf2 n w"
   and "portfolio pf1"
   and "portfolio pf2"
   shows "\<forall>n w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) n w = cls_val_process Mkt pf1 n w"
   by (metis (no_types, lifting) assms replace_comp_cls_val_process0 replace_comp_cls_val_process_Suc up_cl_proc.elims)
 
 
 lemma qty_single_updated:
   shows "cls_val_process Mkt (qty_single asset qty) (Suc n) w =
     prices Mkt asset (Suc n) w * qty (Suc n) w"
 proof -
   have "cls_val_process Mkt (qty_single asset qty) (Suc n) w =
     (sum (\<lambda>x. ((prices Mkt) x (Suc n) w) * ((qty_single asset qty) x (Suc n) w)) {asset})"
   proof (rule subset_cls_val_process')
     show "finite {asset}" by simp
     show "support_set (qty_single asset qty) \<subseteq> {asset}" by (simp add: single_comp_support)
   qed
   also have "... = prices Mkt asset (Suc n) w * qty (Suc n) w" unfolding qty_single_def by simp
   finally show ?thesis .
 qed
 
 
 
 paragraph \<open>Self-financing\<close>
 
 definition self_financing where
   "self_financing Mkt p \<longleftrightarrow> (\<forall>n. val_process Mkt p (Suc n) = cls_val_process Mkt p (Suc n))"
 
 
 lemma self_financingE:
   assumes "self_financing Mkt p"
   shows "\<forall>n. val_process Mkt p n = cls_val_process Mkt p n"
 proof
   fix n
   show "val_process Mkt p n = cls_val_process Mkt p n"
   proof (cases "n = 0")
     case False
     thus ?thesis using assms unfolding self_financing_def
       by (metis up_cl_proc.elims)
   next
     case True
     thus ?thesis by (simp add: cls_val_process_def val_process_def)
   qed
 qed
 
 
 
 
 lemma static_portfolio_self_financing:
   assumes "\<forall> x \<in> support_set p. (\<forall>w i. p x i w = p x (Suc i) w)"
   shows "self_financing Mkt p"
 unfolding self_financing_def
 proof (intro allI impI)
   fix n
   show "val_process Mkt p (Suc n) = cls_val_process Mkt p (Suc n)"
   proof (cases "portfolio p")
     case False
     thus ?thesis unfolding val_process_def cls_val_process_def by simp
   next
     case True
     have "\<forall>w. (\<Sum>x\<in> support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w) =
          cls_val_process Mkt p (Suc n) w"
     proof
       fix w
       show "(\<Sum>x\<in> support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w) =
            cls_val_process Mkt p (Suc n) w"
       proof -
         have "(\<Sum>x\<in> support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w) =
             (\<Sum>x\<in> support_set p. prices Mkt x (Suc n) w * p x (Suc n) w)"
         proof (rule sum.cong, simp)
           fix x
           assume "x\<in> support_set p"
           hence "p x (Suc n) w = p x (Suc (Suc n)) w" using assms by blast
           thus "prices Mkt x (Suc n) w * p x (Suc (Suc n)) w = prices Mkt x (Suc n) w * p x (Suc n) w" by simp
         qed
         also have "... = cls_val_process Mkt p (Suc n) w"
            using up_cl_proc.simps(2)[of Mkt p n] by (metis True cls_val_process_def)
         finally show ?thesis .
       qed
     qed
     moreover have "\<forall>w. val_process Mkt p (Suc n) w = (\<Sum>x\<in> support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w)"
       unfolding val_process_def using True by simp
     ultimately show ?thesis by auto
   qed
 qed
 
 
 
 lemma sum_self_financing:
   assumes "portfolio pf1"
   and "portfolio pf2"
   and "self_financing Mkt pf1"
   and "self_financing Mkt pf2"
 shows "self_financing Mkt (qty_sum pf1 pf2)"
 proof -
   have "\<forall> n w. val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
     cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w"
   proof (intro allI)
     fix n w
     have "val_process Mkt (qty_sum pf1 pf2) (Suc n) w = val_process Mkt pf1 (Suc n) w + val_process Mkt pf2 (Suc n) w"
       using assms by (simp add:sum_val_process)
     also have "... = cls_val_process Mkt pf1 (Suc n) w + val_process Mkt pf2 (Suc n) w" using assms
       unfolding self_financing_def by simp
     also have "... = cls_val_process Mkt pf1 (Suc n) w + cls_val_process Mkt pf2 (Suc n) w"
       using assms unfolding self_financing_def by simp
     also have "... = cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w" using assms by (simp add: sum_cls_val_process)
     finally show "val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
       cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w" .
   qed
   thus ?thesis unfolding self_financing_def by auto
 qed
 
 lemma mult_time_constant_self_financing:
   assumes "portfolio pf1"
   and "self_financing Mkt pf1"
   and "\<forall>n w. qty n w = qty (Suc n) w"
 shows "self_financing Mkt (qty_mult_comp pf1 qty)"
 proof -
   have "\<forall> n w. val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w =
     cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w"
   proof (intro allI)
     fix n w
     have "val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w = val_process Mkt pf1 (Suc n) w * qty (Suc n) w"
       using assms by (simp add:mult_comp_val_process)
     also have "... = cls_val_process Mkt pf1 (Suc n) w * qty (Suc n) w" using assms
       unfolding self_financing_def by simp
     also have "... = cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w" using assms
        by (auto simp add: mult_comp_cls_val_process_Suc)
     finally show "val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w =
       cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w" .
   qed
   thus ?thesis unfolding self_financing_def by auto
 qed
 
 
 
 lemma replace_comp_self_financing:
   assumes "\<forall>n w. prices Mkt x n w = cls_val_process Mkt pf2 n w"
   and "portfolio pf1"
   and "portfolio pf2"
   and "self_financing Mkt pf1"
   and "self_financing Mkt pf2"
 shows "self_financing Mkt (qty_replace_comp pf1 x pf2)"
 proof -
   have sfeq: "\<forall>n w. prices Mkt x n w = val_process Mkt pf2 n w" using assms by (simp add: self_financingE)
   have "\<forall> n w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w =
     val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w"
   proof (intro allI)
     fix n w
     have "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt pf1 (Suc n) w"
       using assms by (simp add:replace_comp_cls_val_process)
     also have "... = val_process Mkt pf1 (Suc n) w" using assms unfolding self_financing_def by simp
     also have "... = val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w"
       using assms sfeq by (simp add: replace_comp_val_process self_financing_def)
     finally show "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w =
       val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w" .
   qed
   thus ?thesis unfolding self_financing_def by auto
 qed
 
 
 
 
 paragraph \<open>Make a portfolio self-financing\<close>
 
 fun  remaining_qty where
   init: "remaining_qty Mkt v pf asset 0 = (\<lambda>w. 0)" |
   first:  "remaining_qty Mkt v pf asset (Suc 0) = (\<lambda>w. (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))" |
   step: "remaining_qty Mkt v pf asset (Suc (Suc n)) = (\<lambda>w. (remaining_qty Mkt v pf asset (Suc n) w) +
     (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w))"
 
 lemma (in disc_equity_market) remaining_qty_predict':
   assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
   and "trading_strategy pf"
 and "support_adapt Mkt pf"
 shows "remaining_qty Mkt v pf asset (Suc n) \<in> borel_measurable (F n)"
 proof (induct n)
   case 0
   have "(\<lambda>w. (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))\<in> borel_measurable (F 0)"
   proof (rule borel_measurable_divide)
     have "val_process Mkt pf 0 \<in> borel_measurable (F 0)" using assms
       ats_val_process_adapted by (simp add:adapt_stoch_proc_def)
     thus "(\<lambda>x. v - val_process Mkt pf 0 x) \<in> borel_measurable (F 0)" by simp
     show "prices Mkt asset 0 \<in> borel_measurable (F 0)" using assms unfolding adapt_stoch_proc_def by simp
   qed
   thus ?case by simp
 next
   case (Suc n)
   have "(\<lambda>w. (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/
     (prices Mkt asset (Suc n) w)) \<in> borel_measurable (F (Suc n))"
   proof (rule borel_measurable_divide)
     show "(\<lambda>w. (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)) \<in> borel_measurable (F (Suc n))"
     proof (rule borel_measurable_diff)
       show "(\<lambda>w. (cls_val_process Mkt pf (Suc n) w)) \<in> borel_measurable (F (Suc n))"
         using assms cls_val_process_adapted unfolding adapt_stoch_proc_def by auto
       show "(\<lambda>w. (val_process Mkt pf (Suc n) w)) \<in> borel_measurable (F (Suc n))"
         using assms  ats_val_process_adapted by (simp add:adapt_stoch_proc_def)
     qed
     show "prices Mkt asset (Suc n) \<in> borel_measurable (F (Suc n))" using assms unfolding adapt_stoch_proc_def by simp
   qed
   moreover have "remaining_qty Mkt v pf asset (Suc n) \<in> borel_measurable (F (Suc n))" using Suc
     Suc_n_not_le_n increasing_measurable_info nat_le_linear by blast
   ultimately show ?case using Suc remaining_qty.simps(3)[of Mkt v pf asset n] by simp
 qed
 
 lemma (in disc_equity_market) remaining_qty_predict:
   assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
   and "trading_strategy pf"
 and "support_adapt Mkt pf"
 shows "borel_predict_stoch_proc F (remaining_qty Mkt v pf asset)"  unfolding predict_stoch_proc_def
 proof (intro conjI allI)
   show "remaining_qty Mkt v pf asset 0 \<in> borel_measurable (F 0)" using init by simp
   fix n
   show "remaining_qty Mkt v pf asset (Suc n) \<in> borel_measurable (F n)" using assms by (simp add: remaining_qty_predict')
 qed
 
 
 lemma (in disc_equity_market) remaining_qty_adapt:
   assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
   and "trading_strategy pf"
 and "support_adapt Mkt pf"
 shows "remaining_qty Mkt v pf asset n \<in> borel_measurable (F n)"
   using adapt_stoch_proc_def assms(1) assms(2) predict_imp_adapt remaining_qty_predict
   by (metis assms(3))
 
 
 lemma (in disc_equity_market) remaining_qty_adapted:
   assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
   and "trading_strategy pf"
 and "support_adapt Mkt pf"
 shows "borel_adapt_stoch_proc F (remaining_qty Mkt v pf asset)" using assms unfolding adapt_stoch_proc_def
   using assms remaining_qty_adapt by blast
 
 
 definition self_finance where
   "self_finance Mkt v pf (asset::'a) = qty_sum pf (qty_single asset (remaining_qty Mkt v pf asset))"
 
 
 lemma self_finance_portfolio:
   assumes "portfolio pf"
 shows "portfolio (self_finance Mkt v pf asset)" unfolding self_finance_def
   by (simp add: assms single_comp_portfolio sum_portfolio)
 
 
 lemma self_finance_init:
   assumes "\<forall>w. prices Mkt asset 0 w \<noteq> 0"
   and "portfolio pf"
 shows "val_process Mkt (self_finance Mkt v pf asset) 0 w = v"
 proof -
   define scp where "scp = qty_single asset (remaining_qty Mkt v pf asset)"
   have "val_process Mkt (self_finance Mkt v pf asset) 0 w =
     val_process Mkt pf 0 w +
     val_process Mkt scp 0 w" unfolding scp_def using assms single_comp_portfolio[of asset]
     sum_val_process[of pf "qty_single asset (remaining_qty Mkt v pf asset)" Mkt]
     by (simp add: \<open>\<And>qty. portfolio (qty_single asset qty)\<close> self_finance_def)
   also have "... = val_process Mkt pf 0 w +
     (sum (\<lambda>x. ((prices Mkt) x 0 w) * (scp x (Suc 0) w)) {asset})"
     using subset_val_process'[of "{asset}" scp] unfolding scp_def by (auto simp add:  single_comp_support)
   also have "... = val_process Mkt pf 0 w + prices Mkt asset 0 w * scp asset (Suc 0) w" by auto
   also have "... = val_process Mkt pf 0 w + prices Mkt asset 0 w * (remaining_qty Mkt v pf asset) (Suc 0) w"
     unfolding scp_def qty_single_def by simp
   also have "... = val_process Mkt pf 0 w + prices Mkt asset 0 w * (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w)"
     by simp
   also have "... = val_process Mkt pf 0 w + (v - val_process Mkt pf 0 w)" using assms by simp
   also have "... = v" by simp
   finally show ?thesis .
 qed
 
 
 lemma self_finance_succ:
   assumes "prices Mkt asset (Suc n) w \<noteq> 0"
   and "portfolio pf"
 shows "val_process Mkt (self_finance Mkt v pf asset) (Suc n) w = prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w +
   cls_val_process Mkt pf (Suc n) w"
 proof -
   define scp where "scp = qty_single asset (remaining_qty Mkt v pf asset)"
   have "val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
     val_process Mkt pf (Suc n) w +
     val_process Mkt scp (Suc n) w" unfolding scp_def using assms single_comp_portfolio[of asset]
     sum_val_process[of pf "qty_single asset (remaining_qty Mkt v pf asset)" Mkt]
     by (simp add: \<open>\<And>qty. portfolio (qty_single asset qty)\<close> self_finance_def)
   also have "... = val_process Mkt pf (Suc n) w +
     (sum (\<lambda>x. ((prices Mkt) x (Suc n) w) * (scp x (Suc (Suc n)) w)) {asset})"
     using subset_val_process'[of "{asset}" scp] unfolding scp_def by (auto simp add:  single_comp_support)
   also have "... = val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * scp asset (Suc (Suc n)) w" by auto
   also have "... = val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * (remaining_qty Mkt v pf asset) (Suc (Suc n)) w"
     unfolding scp_def qty_single_def by simp
   also have "... = val_process Mkt pf (Suc n) w +
     prices Mkt asset (Suc n) w *
     (remaining_qty Mkt v pf asset (Suc n) w + (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w))"
     by simp
   also have "... = val_process Mkt pf (Suc n) w +
      prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w +
     prices Mkt asset (Suc n) w * (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w)"
      by (simp add: distrib_left)
   also have "... = val_process Mkt pf (Suc n) w +
      prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w + (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)"
      using assms by simp
   also have "... = prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w + cls_val_process Mkt pf (Suc n) w" by simp
   finally show ?thesis .
 qed
 
 
 lemma self_finance_updated:
   assumes "prices Mkt asset (Suc n) w \<noteq> 0"
   and "portfolio pf"
 shows "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
   cls_val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * (remaining_qty Mkt v pf asset) (Suc n) w"
 proof -
   define scp where "scp = qty_single asset (remaining_qty Mkt v pf asset)"
   have "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
     cls_val_process Mkt pf (Suc n) w +
     cls_val_process Mkt scp (Suc n) w" unfolding scp_def using assms single_comp_portfolio[of asset]
     sum_cls_val_process[of pf "qty_single asset (remaining_qty Mkt v pf asset)" Mkt]
     by (simp add: \<open>\<And>qty. portfolio (qty_single asset qty)\<close> self_finance_def)
   also have "... = cls_val_process Mkt pf (Suc n) w +
     (sum (\<lambda>x. ((prices Mkt) x (Suc n) w) * (scp x (Suc n) w)) {asset})"
     using subset_cls_val_process[of "{asset}" scp] unfolding scp_def by (auto simp add:  single_comp_support)
   also have "... = cls_val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * scp asset (Suc n) w" by auto
   also have "... = cls_val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * (remaining_qty Mkt v pf asset) (Suc n) w"
     unfolding scp_def qty_single_def by simp
   finally show ?thesis .
 qed
 
 lemma self_finance_charact:
   assumes "\<forall> n w. prices Mkt asset (Suc n) w \<noteq> 0"
   and "portfolio pf"
 shows "self_financing Mkt (self_finance Mkt v pf asset)"
 proof-
   have "\<forall>n w. val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
      cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w"
   proof (intro allI)
     fix n w
     show "val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
       cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w" using assms self_finance_succ[of Mkt asset]
       by (simp add: self_finance_updated)
   qed
   thus ?thesis unfolding self_financing_def by auto
 qed
 
 
 subsubsection \<open>Replicating portfolios\<close>
 
 
 definition (in disc_filtr_prob_space) price_structure::"('a \<Rightarrow> real) \<Rightarrow> nat \<Rightarrow> real \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> bool" where
   "price_structure pyf T \<pi> pr \<longleftrightarrow> ((\<forall> w\<in> space M. pr 0 w = \<pi>) \<and> (AE w in M. pr T w = pyf w) \<and> (pr T \<in> borel_measurable (F T)))"
 
 lemma (in disc_filtr_prob_space) price_structure_init:
   assumes "price_structure pyf T \<pi> pr"
   shows "\<forall> w\<in> space M. pr 0 w = \<pi>" using assms unfolding price_structure_def by simp
 
 lemma (in disc_filtr_prob_space) price_structure_borel_measurable:
   assumes "price_structure pyf T \<pi> pr"
   shows "pr T \<in> borel_measurable (F T)" using assms unfolding price_structure_def by simp
 
 lemma (in disc_filtr_prob_space) price_structure_maturity:
   assumes "price_structure pyf T \<pi> pr"
   shows "AE w in M. pr T w = pyf w" using assms unfolding price_structure_def by simp
 
 definition (in disc_equity_market) replicating_portfolio where
   "replicating_portfolio pf der matur  \<longleftrightarrow> (stock_portfolio Mkt pf) \<and> (trading_strategy pf) \<and> (self_financing Mkt pf) \<and>
   (AE w in M. cls_val_process Mkt pf matur w = der w)"
 
 
 definition (in disc_equity_market) is_attainable where
   "is_attainable der matur \<longleftrightarrow> (\<exists> pf. replicating_portfolio pf der matur)"
 
 lemma (in disc_equity_market) replicating_price_process:
   assumes "replicating_portfolio pf der matur"
 and "support_adapt Mkt pf"
   shows "price_structure der matur (initial_value pf) (cls_val_process Mkt pf)"
   unfolding price_structure_def
 proof (intro conjI)
   show "AE w in M. cls_val_process Mkt pf matur w = der w" using assms unfolding replicating_portfolio_def by simp
   show "\<forall>w\<in>space M. cls_val_process Mkt pf 0 w = initial_value pf"
   proof
     fix w
     assume "w\<in> space M"
     thus "cls_val_process Mkt pf 0 w = initial_value pf" unfolding initial_value_def using constant_imageI[of "cls_val_process Mkt pf 0"]
       trading_strategy_init[of pf] assms replicating_portfolio_def [of pf der matur]
       by (simp add: stock_portfolio_def cls_val_process_def)
   qed
   show "cls_val_process Mkt pf matur \<in> borel_measurable (F matur)" using assms unfolding replicating_portfolio_def
     using ats_val_process_adapted[of pf]
     cls_val_process_adapted by (simp add:adapt_stoch_proc_def)
 qed
 
 
 subsubsection \<open>Arbitrages\<close>
 
 
 definition (in disc_filtr_prob_space) arbitrage_process
 where
   "arbitrage_process Mkt p \<longleftrightarrow> (\<exists> m. (self_financing Mkt p) \<and> (trading_strategy p) \<and>
     (\<forall>w \<in> space M. val_process Mkt p 0 w = 0) \<and>
     (AE w in M. 0 \<le> cls_val_process Mkt p m w) \<and>
     0 < \<P>(w in M. cls_val_process Mkt p m w > 0))"
 
 lemma (in disc_filtr_prob_space) arbitrage_processE:
   assumes "arbitrage_process Mkt p"
   shows "(\<exists> m. (self_financing Mkt p) \<and> (trading_strategy p) \<and>
     (\<forall>w \<in> space M. cls_val_process Mkt p 0 w = 0) \<and>
     (AE w in M. 0 \<le> cls_val_process Mkt p m w) \<and>
     0 < \<P>(w in M. cls_val_process Mkt p m w > 0))"
   using assms disc_filtr_prob_space.arbitrage_process_def disc_filtr_prob_space_axioms self_financingE by fastforce
 
 
 
 lemma (in disc_filtr_prob_space) arbitrage_processI:
   assumes "(\<exists> m. (self_financing Mkt p) \<and> (trading_strategy p) \<and>
     (\<forall>w \<in> space M. cls_val_process Mkt p 0 w = 0) \<and>
     (AE w in M. 0 \<le> cls_val_process Mkt p m w) \<and>
     0 < \<P>(w in M. cls_val_process Mkt p m w > 0))"
   shows "arbitrage_process Mkt p" unfolding arbitrage_process_def  using assms
   by (simp add: self_financingE cls_val_process_def)
 
 definition (in disc_filtr_prob_space) viable_market
 where
   "viable_market Mkt  \<longleftrightarrow> (\<forall>p. stock_portfolio Mkt p \<longrightarrow> \<not> arbitrage_process Mkt p)"
 
 lemma (in disc_filtr_prob_space) arbitrage_val_process:
   assumes "arbitrage_process Mkt pf1"
   and "self_financing Mkt pf2"
   and "trading_strategy pf2"
   and "\<forall> n w. cls_val_process Mkt pf1 n w = cls_val_process Mkt pf2 n w"
 shows "arbitrage_process Mkt pf2"
 proof -
   have "(\<exists> m. (self_financing Mkt pf1) \<and> (trading_strategy pf1) \<and>
     (\<forall>w \<in> space M. cls_val_process Mkt pf1 0 w = 0) \<and>
     (AE w in M. 0 \<le> cls_val_process Mkt pf1 m w) \<and>
     0 < \<P>(w in M. cls_val_process Mkt pf1 m w > 0))" using assms arbitrage_processE[of Mkt pf1] by simp
   from this obtain m where "(self_financing Mkt pf1)" and "(trading_strategy pf1)" and
     "(\<forall>w \<in> space M. cls_val_process Mkt pf1 0 w = 0)" and
     "(AE w in M. 0 \<le> cls_val_process Mkt pf1 m w)"
     "0 < \<P>(w in M. cls_val_process Mkt pf1 m w > 0)" by auto
   have ae_eq:"\<forall>w\<in> space M. (cls_val_process Mkt pf1 0 w = 0) = (cls_val_process Mkt pf2 0 w = 0)"
   proof
     fix w
     assume "w\<in> space M"
     show "(cls_val_process Mkt pf1 0 w = 0) = (cls_val_process Mkt pf2 0 w = 0) "
       using  assms  by simp
   qed
   have ae_geq:"almost_everywhere M (\<lambda>w. cls_val_process Mkt pf1 m w \<ge> 0) = almost_everywhere M (\<lambda>w. cls_val_process Mkt pf2 m w \<ge> 0)"
   proof (rule AE_cong)
     fix w
     assume "w\<in> space M"
     show "(cls_val_process Mkt pf1 m w \<ge> 0) = (cls_val_process Mkt pf2 m w \<ge> 0) "
       using  assms by simp
   qed
   have "self_financing Mkt pf2" using assms by simp
   moreover have "trading_strategy pf2" using assms by simp
   moreover have "(\<forall>w \<in> space M. cls_val_process Mkt pf2 0 w = 0)"  using \<open>(\<forall>w \<in> space M. cls_val_process Mkt pf1 0 w = 0)\<close> ae_eq by simp
   moreover have "AE w in M. 0 \<le> cls_val_process Mkt pf2 m w" using \<open>AE w in M. 0 \<le> cls_val_process Mkt pf1 m w\<close> ae_geq by simp
   moreover have "0 < prob {w \<in> space M. 0 < cls_val_process Mkt pf2 m w}"
   proof -
     have "{w \<in> space M. 0 < cls_val_process Mkt pf2 m w} = {w \<in> space M. 0 < cls_val_process Mkt pf1 m w}"
       by (simp add: assms(4))
     thus ?thesis by (simp add: \<open>0 < prob {w \<in> space M. 0 < cls_val_process Mkt pf1 m w}\<close>)
   qed
   ultimately show ?thesis using arbitrage_processI by blast
 qed
 
 
 definition coincides_on where
   "coincides_on Mkt Mkt2 A \<longleftrightarrow> (stocks Mkt = stocks Mkt2 \<and> (\<forall>x. x\<in> A \<longrightarrow> prices Mkt x = prices Mkt2 x))"
 
 lemma coincides_val_process:
   assumes "coincides_on Mkt Mkt2 A"
   and "support_set pf \<subseteq> A"
   shows "\<forall>n w. val_process Mkt pf n w = val_process Mkt2 pf n w"
 proof (intro allI)
   fix n w
   show "val_process Mkt pf n w = val_process Mkt2 pf n w"
   proof (cases "portfolio pf")
     case False
     thus ?thesis unfolding val_process_def by simp
   next
     case True
     hence "val_process Mkt pf n w = (\<Sum>x\<in> support_set pf. prices Mkt x n w * pf x (Suc n) w)" using assms
       unfolding val_process_def  by simp
     also have "... = (\<Sum>x\<in> support_set pf. prices Mkt2 x n w * pf x (Suc n) w)"
     proof (rule sum.cong, simp)
       fix y
       assume "y\<in> support_set pf"
       hence "y\<in> A" using assms unfolding  stock_portfolio_def by auto
       hence "prices Mkt y n w = prices Mkt2 y n w" using assms
         unfolding coincides_on_def by auto
       thus "prices Mkt y n w * pf y (Suc n) w = prices Mkt2 y n w * pf y (Suc n) w" by simp
     qed
     also have "... = val_process Mkt2 pf n w"
       by (metis (mono_tags, lifting) calculation val_process_def)
     finally show "val_process Mkt pf n w = val_process Mkt2 pf n w" .
   qed
 qed
 
 lemma coincides_cls_val_process':
   assumes "coincides_on Mkt Mkt2 A"
   and "support_set pf \<subseteq> A"
   shows "\<forall>n w. cls_val_process Mkt pf (Suc n) w = cls_val_process Mkt2 pf (Suc n) w"
 proof (intro allI)
   fix n w
   show "cls_val_process Mkt pf (Suc n) w = cls_val_process Mkt2 pf (Suc n) w"
   proof (cases "portfolio pf")
     case False
     thus ?thesis unfolding cls_val_process_def by simp
   next
     case True
     hence "cls_val_process Mkt pf (Suc n) w = (\<Sum>x\<in> support_set pf. prices Mkt x (Suc n) w * pf x (Suc n) w)" using assms
       unfolding cls_val_process_def  by simp
     also have "... = (\<Sum>x\<in> support_set pf. prices Mkt2 x (Suc n) w * pf x (Suc n) w)"
     proof (rule sum.cong, simp)
       fix y
       assume "y\<in> support_set pf"
       hence "y\<in> A" using assms unfolding  stock_portfolio_def by auto
       hence "prices Mkt y (Suc n) w = prices Mkt2 y (Suc n) w" using assms
         unfolding coincides_on_def by auto
       thus "prices Mkt y (Suc n) w * pf y (Suc n) w = prices Mkt2 y (Suc n) w * pf y (Suc n) w" by simp
     qed
     also have "... = cls_val_process Mkt2 pf (Suc n) w"
       by (metis (mono_tags, lifting) True  up_cl_proc.simps(2) cls_val_process_def)
     finally show "cls_val_process Mkt pf (Suc n) w = cls_val_process Mkt2 pf (Suc n) w" .
   qed
 qed
 
 lemma coincides_cls_val_process:
   assumes "coincides_on Mkt Mkt2 A"
   and "support_set pf \<subseteq> A"
   shows "\<forall>n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
 proof (intro allI)
   fix n w
   show "cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
   proof (cases "portfolio pf")
     case False
     thus ?thesis unfolding cls_val_process_def by simp
   next
     case True
     show "cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
     proof (induct n)
       case 0
       with assms show ?case
         by (simp add: cls_val_process_def coincides_val_process)
     next
       case Suc
       thus ?case using coincides_cls_val_process' assms by blast
     qed
   qed
 qed
 
 
 lemma (in disc_filtr_prob_space) coincides_on_self_financing:
   assumes "coincides_on Mkt Mkt2 A"
   and "support_set p \<subseteq> A"
   and "self_financing Mkt p"
 shows "self_financing Mkt2 p"
 proof -
   have "\<forall> n w. val_process Mkt2 p (Suc n) w = cls_val_process Mkt2 p (Suc n) w"
   proof (intro allI)
     fix n w
     have "val_process Mkt2 p (Suc n) w = val_process Mkt p (Suc n) w"
       using assms(1) assms(2) coincides_val_process stock_portfolio_def by fastforce
     also have "... = cls_val_process Mkt p (Suc n) w" by (metis \<open>self_financing Mkt p\<close> self_financing_def)
     also have "... = cls_val_process Mkt2 p (Suc n) w"
       using assms(1) assms(2) coincides_cls_val_process stock_portfolio_def by blast
     finally show "val_process Mkt2 p (Suc n) w = cls_val_process Mkt2 p (Suc n) w" .
   qed
   thus "self_financing Mkt2 p" unfolding self_financing_def by auto
 qed
 
 
 lemma (in disc_filtr_prob_space) coincides_on_arbitrage:
   assumes "coincides_on Mkt Mkt2 A"
   and "support_set p \<subseteq> A"
   and "arbitrage_process Mkt p"
 shows "arbitrage_process Mkt2 p"
 proof -
   have "(\<exists> m. (self_financing Mkt p) \<and> (trading_strategy p) \<and>
     (\<forall>w\<in> space M. cls_val_process Mkt p 0 w = 0) \<and>
     (AE w in M. 0 \<le> cls_val_process Mkt p m w) \<and>
     0 < \<P>(w in M. cls_val_process Mkt p m w > 0))" using assms using arbitrage_processE by simp
   from this obtain m where "(self_financing Mkt p)" and "(trading_strategy p)" and
     "(\<forall>w\<in> space M. cls_val_process Mkt p 0 w = 0)" and
     "(AE w in M. 0 \<le> cls_val_process Mkt p m w)"
     "0 < \<P>(w in M. cls_val_process Mkt p m w > 0)" by auto
   have ae_eq:"\<forall>w\<in> space M. (cls_val_process Mkt2 p 0 w = 0) = (cls_val_process Mkt p 0 w = 0)"
   proof
     fix w
     assume "w\<in> space M"
     show "(cls_val_process Mkt2 p 0 w = 0) = (cls_val_process Mkt p 0 w = 0) "
       using  assms coincides_cls_val_process by (metis)
   qed
   have ae_geq:"almost_everywhere M (\<lambda>w. cls_val_process Mkt2 p m w \<ge> 0) = almost_everywhere M (\<lambda>w. cls_val_process Mkt p m w \<ge> 0)"
   proof (rule AE_cong)
     fix w
     assume "w\<in> space M"
     show "(cls_val_process Mkt2 p m w \<ge> 0) = (cls_val_process Mkt p m w \<ge> 0) "
       using  assms coincides_cls_val_process by (metis)
   qed
   have "self_financing Mkt2 p" using assms coincides_on_self_financing
     using \<open>self_financing Mkt p\<close> by blast
   moreover have "trading_strategy p" using \<open>trading_strategy p\<close> .
   moreover have "(\<forall>w\<in> space M. cls_val_process Mkt2 p 0 w = 0)"  using \<open>(\<forall>w\<in> space M. cls_val_process Mkt p 0 w = 0)\<close> ae_eq by simp
   moreover have "AE w in M. 0 \<le> cls_val_process Mkt2 p m w" using \<open>AE w in M. 0 \<le> cls_val_process Mkt p m w\<close> ae_geq by simp
   moreover have "0 < prob {w \<in> space M. 0 < cls_val_process Mkt2 p m w}"
   proof -
     have "{w \<in> space M. 0 < cls_val_process Mkt2 p m w} = {w \<in> space M. 0 < cls_val_process Mkt p m w}"
       by (metis (no_types, lifting) assms(1) assms(2) coincides_cls_val_process)
     thus ?thesis by (simp add: \<open>0 < prob {w \<in> space M. 0 < cls_val_process Mkt p m w}\<close>)
   qed
   ultimately show ?thesis using arbitrage_processI by blast
 qed
 
 
 lemma (in disc_filtr_prob_space) coincides_on_stocks_viable:
   assumes "coincides_on Mkt Mkt2 (stocks Mkt)"
   and "viable_market Mkt"
 shows "viable_market Mkt2" using coincides_on_arbitrage
   by (metis (mono_tags, opaque_lifting) assms(1) assms(2) coincides_on_def stock_portfolio_def viable_market_def)
 
 
 lemma coincides_stocks_val_process:
   assumes "stock_portfolio Mkt pf"
   and "coincides_on Mkt Mkt2 (stocks Mkt)"
 shows "\<forall>n w. val_process Mkt pf n w = val_process Mkt2 pf n w" using assms  unfolding stock_portfolio_def
   by (simp add: coincides_val_process)
 
 lemma coincides_stocks_cls_val_process:
   assumes "stock_portfolio Mkt pf"
   and "coincides_on Mkt Mkt2 (stocks Mkt)"
 shows "\<forall>n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w" using assms  unfolding stock_portfolio_def
     by (simp add: coincides_cls_val_process)
 
 lemma (in disc_filtr_prob_space) coincides_on_adapted_val_process:
   assumes "coincides_on Mkt Mkt2 A"
   and "support_set p \<subseteq> A"
   and "borel_adapt_stoch_proc F (val_process Mkt p)"
 shows "borel_adapt_stoch_proc F (val_process Mkt2 p)" unfolding adapt_stoch_proc_def
 proof
   fix n
   have "val_process Mkt p n \<in> borel_measurable (F n)" using assms unfolding adapt_stoch_proc_def by simp
   moreover have "\<forall>w. val_process Mkt p n w = val_process Mkt2 p n w" using assms coincides_val_process[of Mkt Mkt2 A]
     by auto
   thus "val_process Mkt2 p n \<in> borel_measurable (F n)"
     using calculation by presburger
 qed
 
 lemma (in disc_filtr_prob_space) coincides_on_adapted_cls_val_process:
   assumes "coincides_on Mkt Mkt2 A"
   and "support_set p \<subseteq> A"
   and "borel_adapt_stoch_proc F (cls_val_process Mkt p)"
 shows "borel_adapt_stoch_proc F (cls_val_process Mkt2 p)" unfolding adapt_stoch_proc_def
 proof
   fix n
   have "cls_val_process Mkt p n \<in> borel_measurable (F n)" using assms unfolding adapt_stoch_proc_def by simp
   moreover have "\<forall>w. cls_val_process Mkt p n w = cls_val_process Mkt2 p n w" using assms coincides_cls_val_process[of Mkt Mkt2 A]
     by auto
   thus "cls_val_process Mkt2 p n \<in> borel_measurable (F n)"
     using calculation by presburger
 qed
 
 subsubsection \<open>Fair prices\<close>
 definition (in disc_filtr_prob_space) fair_price where
   "fair_price Mkt \<pi> pyf matur \<longleftrightarrow>
     (\<exists> pr. price_structure pyf matur \<pi> pr \<and>
     (\<forall> x Mkt2 p. (x\<notin> stocks Mkt \<longrightarrow>
       ((coincides_on Mkt Mkt2 (stocks Mkt)) \<and> (prices Mkt2 x = pr) \<and> portfolio p \<and> support_set p \<subseteq> stocks Mkt \<union> {x} \<longrightarrow>
         \<not> arbitrage_process Mkt2 p))))"
 
 
 
 lemma (in disc_filtr_prob_space) fair_priceI:
   assumes "fair_price Mkt \<pi> pyf matur"
   shows "(\<exists> pr. price_structure pyf matur \<pi> pr \<and>
     (\<forall> x. (x\<notin> stocks Mkt \<longrightarrow>
       (\<forall> Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt)) \<and> (prices Mkt2 x = pr) \<and> portfolio p \<and> support_set p \<subseteq> stocks Mkt \<union> {x} \<longrightarrow>
         \<not> arbitrage_process Mkt2 p))))" using assms unfolding fair_price_def by simp
 
 paragraph \<open>Existence when replicating portfolio\<close>
 
 
 lemma (in disc_equity_market) replicating_fair_price:
   assumes "viable_market Mkt"
   and "replicating_portfolio pf der matur"
 and "support_adapt Mkt pf"
 shows "fair_price Mkt (initial_value pf) der matur"
 proof (rule ccontr)
   define \<pi> where  "\<pi> = (initial_value pf)"
   assume "\<not> fair_price Mkt \<pi> der matur"
   hence imps: "\<forall>pr. (price_structure der matur \<pi> pr) \<longrightarrow>  (\<exists> x Mkt2 p. (x\<notin> stocks Mkt \<and>
     (coincides_on Mkt Mkt2 (stocks Mkt)) \<and> (prices Mkt2 x = pr) \<and> portfolio p \<and> support_set p \<subseteq> stocks Mkt \<union> {x} \<and>
      arbitrage_process Mkt2 p))" unfolding fair_price_def by simp
   have "(price_structure der matur \<pi> (cls_val_process Mkt pf))" unfolding \<pi>_def  using replicating_price_process assms by simp
   hence "\<exists> x Mkt2 p. (x\<notin> stocks Mkt \<and>
     (coincides_on Mkt Mkt2 (stocks Mkt)) \<and> (prices Mkt2 x = (cls_val_process Mkt pf)) \<and> portfolio p \<and> support_set p \<subseteq> stocks Mkt \<union> {x} \<and>
      arbitrage_process Mkt2 p)" using imps by simp
   from this obtain x Mkt2 p where "x\<notin> stocks Mkt" and "coincides_on Mkt Mkt2 (stocks Mkt)" and "prices Mkt2 x = cls_val_process Mkt pf"
     and "portfolio p" and "support_set p\<subseteq> stocks Mkt \<union> {x}" and "arbitrage_process Mkt2 p" by auto
   have "\<forall>n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
     using coincides_stocks_cls_val_process[of Mkt pf Mkt2] assms \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close>  unfolding replicating_portfolio_def
     by simp
   have "\<exists>m. self_financing Mkt2 p \<and>
       trading_strategy p \<and>
       (AE w in M. cls_val_process Mkt2 p 0 w = 0) \<and>
       (AE w in M. 0 \<le> cls_val_process Mkt2 p m w) \<and> 0 < prob {w \<in> space M. 0 < cls_val_process Mkt2 p m w}"
     using \<open>arbitrage_process Mkt2 p\<close> using arbitrage_processE[of Mkt2] by simp
   from this obtain m where "self_financing Mkt2 p"
       "trading_strategy p \<and>
       (AE w in M. cls_val_process Mkt2 p 0 w = 0) \<and>
       (AE w in M. 0 \<le> cls_val_process Mkt2 p m w) \<and> 0 < prob {w \<in> space M. 0 < cls_val_process Mkt2 p m w}" by auto note mprop = this
   define eq_stock where "eq_stock = qty_replace_comp p x pf"
   have "\<forall>n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w" using assms unfolding replicating_portfolio_def
       using coincides_cls_val_process
       using \<open>\<forall>n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w\<close> by blast
     hence prx: "\<forall>n w. prices Mkt2 x n w = cls_val_process Mkt2 pf n w" using \<open>prices Mkt2 x = cls_val_process Mkt pf\<close> by simp
   have "stock_portfolio Mkt2 eq_stock"
     by (metis (no_types, lifting) \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> \<open>portfolio p\<close> \<open>support_set p \<subseteq> stocks Mkt \<union> {x}\<close>
         assms(2) coincides_on_def disc_equity_market.replicating_portfolio_def disc_equity_market_axioms eq_stock_def
         replace_comp_portfolio replace_comp_stocks stock_portfolio_def)
   moreover have "arbitrage_process Mkt2 eq_stock"
   proof (rule arbitrage_val_process)
     show "arbitrage_process Mkt2 p" using \<open>arbitrage_process Mkt2 p\<close> .
     show vp: "\<forall>n w. cls_val_process Mkt2 p n w = cls_val_process Mkt2 eq_stock n w" using replace_comp_cls_val_process
         \<open>prices Mkt2 x = cls_val_process Mkt pf\<close> unfolding eq_stock_def
       by (metis (no_types, lifting) \<open>\<forall>n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w\<close> \<open>portfolio p\<close> assms(2) replicating_portfolio_def
           stock_portfolio_def)
     show "trading_strategy eq_stock"
       by (metis \<open>arbitrage_process Mkt2 p\<close> arbitrage_process_def assms(2) eq_stock_def
           replace_comp_trading_strat replicating_portfolio_def)
     show "self_financing Mkt2 eq_stock" unfolding eq_stock_def
     proof (rule replace_comp_self_financing)
       show "portfolio pf" using assms unfolding replicating_portfolio_def stock_portfolio_def by simp
       show "portfolio p" using \<open>portfolio p\<close> .
       show "\<forall>n w. prices Mkt2 x n w = cls_val_process Mkt2 pf n w" using prx .
       show "self_financing Mkt2 p" using \<open>self_financing Mkt2 p\<close> .
       show "self_financing Mkt2 pf" using coincides_on_self_financing[of Mkt Mkt2 "stocks Mkt" pf]
         \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> assms(2) (*disc_equity_market.replicating_portfolio_def
           disc_equity_market_axioms*) unfolding stock_portfolio_def replicating_portfolio_def by auto
     qed
   qed
   moreover have "viable_market Mkt2" using assms coincides_on_stocks_viable[of Mkt Mkt2]
     by (simp add: \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close>)
   ultimately show False unfolding viable_market_def by simp
 qed
 
 
 paragraph \<open>Uniqueness when replicating portfolio\<close>
 
 
 text \<open>The proof of uniqueness requires the existence of a stock that always takes strictly positive values.\<close>
 
 
 locale disc_market_pos_stock = disc_equity_market +
   fixes pos_stock
   assumes in_stock: "pos_stock \<in> stocks Mkt"
   and positive: "\<forall> n w. prices Mkt pos_stock n w > 0"
 and readable: "\<forall> asset\<in> stocks Mkt. borel_adapt_stoch_proc F (prices Mkt asset)"
 
 
 
 
 lemma (in disc_market_pos_stock) pos_stock_borel_adapted:
   shows "borel_adapt_stoch_proc F (prices Mkt pos_stock)"
   using assets_def readable in_stock  by auto
 
 
 definition static_quantities where
   "static_quantities p \<longleftrightarrow> (\<forall>asset \<in> support_set p. \<exists>c::real. p asset = (\<lambda> n w. c))"
 
 lemma (in disc_filtr_prob_space) static_quantities_trading_strat:
   assumes "static_quantities p"
   and "finite (support_set p)"
   shows "trading_strategy p" unfolding trading_strategy_def
 proof (intro conjI ballI)
   show "portfolio p" using assms unfolding portfolio_def by simp
   fix asset
   assume "asset \<in> support_set p"
   hence "\<exists>c. p asset = (\<lambda> n w. c)" using assms unfolding static_quantities_def by simp
   then obtain c where "p asset = (\<lambda> n w. c)" by auto
   show "borel_predict_stoch_proc F (p asset)" unfolding predict_stoch_proc_def
   proof (intro conjI)
     show "p asset 0 \<in> borel_measurable (F 0)" using \<open>p asset = (\<lambda> n w. c)\<close> by simp
     show "\<forall>n. p asset (Suc n) \<in> borel_measurable (F n)"
     proof
     fix n
       have "p asset (Suc n) = (\<lambda> w. c)" using \<open>p asset = (\<lambda> n w. c)\<close> by simp
       thus "p asset (Suc n) \<in> borel_measurable (F n)" by simp
     qed
   qed
 qed
 
 
 
 lemma two_component_support_set:
   assumes "\<exists> n w. a n w \<noteq> 0"
   and "\<exists> n w. b n w\<noteq> 0"
   and "x \<noteq> y"
 shows "support_set ((\<lambda> (x::'b) (n::nat) (w::'a). 0::real)(x:= a, y:= b)) = {x,y}"
 proof
   let ?arb_pf = "(\<lambda> (x::'b) (n::nat) (w::'a). 0::real)(x:= a, y:= b)"
   have "\<exists> n w. ?arb_pf x n w \<noteq> 0" using assms by simp
   moreover have "\<exists>n w. ?arb_pf y n w \<noteq> 0" using assms by simp
   ultimately show "{x, y} \<subseteq> support_set ?arb_pf" unfolding support_set_def by simp
   show "support_set ?arb_pf \<subseteq> {x, y}"
   proof (rule ccontr)
     assume "\<not> support_set ?arb_pf \<subseteq> {x, y}"
     hence "\<exists>z. z\<in> support_set ?arb_pf \<and> z\<notin> {x, y}" by auto
     from this obtain z where "z\<in> support_set ?arb_pf" and "z\<notin> {x, y}" by auto
     have "\<exists>n w. ?arb_pf z n w \<noteq> 0" using \<open>z\<in> support_set ?arb_pf\<close> unfolding support_set_def by simp
     from this obtain n w where "?arb_pf z n w \<noteq> 0" by auto
     have "?arb_pf z n w = 0" using \<open>z\<notin> {x, y}\<close>  by simp
     thus False using \<open>?arb_pf z n w \<noteq> 0\<close> by simp
   qed
 qed
 
 lemma two_component_val_process:
   assumes "arb_pf = ((\<lambda> (x::'b) (n::nat) (w::'a). 0::real)(x:= a, y:= b))"
   and "portfolio arb_pf"
   and "x \<noteq> y"
   and "\<exists> n w. a n w \<noteq> 0"
   and "\<exists> n w. b n w\<noteq> 0"
   shows "val_process Mkt arb_pf n w =
     prices Mkt y n w * b (Suc n) w + prices Mkt x n w * a (Suc n) w"
 proof -
   have "support_set arb_pf = {x,y}" using assms by (simp add:two_component_support_set)
   have "val_process Mkt arb_pf n w = (\<Sum>x\<in>support_set arb_pf. prices Mkt x n w * arb_pf x (Suc n) w)"
         unfolding val_process_def using \<open>portfolio arb_pf\<close> by simp
   also have "... = (\<Sum>x\<in>{x, y}. prices Mkt x n w * arb_pf x (Suc n) w)" using \<open>support_set arb_pf = {x, y}\<close>
         by simp
   also have "... = (\<Sum>x\<in>{y}. prices Mkt x n w * arb_pf x (Suc n) w) + prices Mkt x n w * arb_pf x (Suc n) w"
         using sum.insert[of "{y}" x  "\<lambda>x. prices Mkt x n w * arb_pf x n w"] assms(3) by auto
   also have "... = prices Mkt y n w * arb_pf y (Suc n) w + prices Mkt x n w * arb_pf x (Suc n) w" by simp
   also have "... = prices Mkt y n w * b (Suc n) w + prices Mkt x n w * a (Suc n) w" using assms by auto
   finally show "val_process Mkt arb_pf n w = prices Mkt y n w * b (Suc n) w + prices Mkt x n w * a (Suc n) w" .
 qed
 
 lemma quantity_update_support_set:
   assumes "\<exists>n w. pr n w \<noteq> 0"
   and "x\<notin> support_set p"
 shows "support_set (p(x:=pr)) = support_set p \<union> {x}"
 proof
   show "support_set (p(x := pr)) \<subseteq> support_set p \<union> {x}"
   proof
     fix y
     assume "y\<in> support_set (p(x := pr))"
     show "y \<in> support_set p \<union> {x}"
     proof (rule ccontr)
       assume "\<not>y \<in> support_set p \<union> {x}"
       hence "y \<noteq> x" by simp
       have "\<exists>n w. (p(x := pr)) y n w \<noteq> 0" using \<open>y\<in> support_set (p(x := pr))\<close> unfolding support_set_def by simp
       then obtain n w where nwprop: "(p(x := pr)) y n w \<noteq> 0" by auto
       have "y\<notin> support_set p" using \<open>\<not>y \<in> support_set p \<union> {x}\<close> by simp
       hence "y = x" using nwprop using support_set_def by force
       thus False using \<open>y\<noteq> x\<close> by simp
     qed
   qed
   show "support_set p \<union> {x} \<subseteq> support_set (p(x := pr))"
   proof
     fix y
     assume "y \<in> support_set p \<union> {x}"
     show "y\<in> support_set (p(x := pr))"
     proof (cases "y\<in> support_set p")
       case True
       thus ?thesis
       proof -
         have f1: "y \<in> {b. \<exists>n a. p b n a \<noteq> 0}"
           by (metis True support_set_def)
         then have "y \<noteq> x"
           using assms(2) support_set_def by force
         then show ?thesis
           using f1 by (simp add: support_set_def)
       qed
     next
       case False
       hence "y = x" using \<open>y \<in> support_set p \<union> {x}\<close> by auto
       thus ?thesis using assms by (simp add: support_set_def)
     qed
   qed
 qed
 
 
 lemma fix_asset_price:
   shows "\<exists>x Mkt2. x \<notin> stocks Mkt \<and>
   coincides_on Mkt Mkt2 (stocks Mkt) \<and>
   prices Mkt2 x = pr"
 proof -
   have "\<exists>x. x\<notin> stocks Mkt" by (metis UNIV_eq_I stk_strict_subs_def mkt_stocks_assets)
   from this obtain x where "x\<notin> stocks Mkt" by auto
   let ?res = "discrete_market_of (stocks Mkt) ((prices Mkt)(x:=pr))"
   have "coincides_on Mkt ?res (stocks Mkt)"
   proof -
     have "stocks Mkt = stocks (discrete_market_of (stocks Mkt) ((prices Mkt)(x := pr)))"
       by (metis (no_types) stk_strict_subs_def mkt_stocks_assets stocks_of)
     then show ?thesis
       by (simp add: \<open>x \<notin> stocks Mkt\<close> coincides_on_def prices_of)
   qed
   have "prices ?res x = pr" by (simp add: prices_of)
  show ?thesis
    using \<open>coincides_on Mkt (discrete_market_of (stocks Mkt) ((prices Mkt)(x := pr))) (stocks Mkt)\<close> \<open>prices (discrete_market_of (stocks Mkt) ((prices Mkt)(x := pr))) x = pr\<close> \<open>x \<notin> stocks Mkt\<close> by blast
 qed
 
 
 
 lemma (in disc_market_pos_stock) arbitrage_portfolio_properties:
   assumes "price_structure der matur \<pi> pr"
   and "replicating_portfolio pf der matur"
   and  "(coincides_on Mkt Mkt2 (stocks Mkt))"
   and "(prices Mkt2 x = pr)"
   and "x\<notin> stocks Mkt"
   and "diff_inv = (\<pi> - initial_value pf) / constant_image (prices Mkt pos_stock 0)"
   and "diff_inv \<noteq> 0"
   and "arb_pf = (\<lambda> (x::'b) (n::nat) (w::'a). 0::real)(x:= (\<lambda> n w. -1), pos_stock := (\<lambda> n w. diff_inv))"
   and "contr_pf = qty_sum arb_pf pf"
 shows "self_financing Mkt2 contr_pf"
   and "trading_strategy contr_pf"
   and "\<forall>w\<in> space M. cls_val_process Mkt2 contr_pf 0 w = 0"
   and "0 < diff_inv \<longrightarrow> (AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w)"
   and "diff_inv < 0 \<longrightarrow> (AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w)"
   and "support_set arb_pf = {x, pos_stock}"
   and "portfolio contr_pf"
 proof -
   have "0 < constant_image (prices Mkt pos_stock 0)" using trading_strategy_init
   proof -
     have "borel_adapt_stoch_proc F (prices Mkt pos_stock)" using pos_stock_borel_adapted by simp
     hence "\<exists>c. \<forall>w\<in>space M. prices Mkt pos_stock 0 w = c" using  adapted_init[of "prices Mkt pos_stock"] by simp
     moreover have "\<forall>w\<in> space M. 0 < prices Mkt pos_stock 0 w" using positive by simp
     ultimately show ?thesis using constant_image_pos by simp
   qed
   show "support_set arb_pf = {x, pos_stock}"
   proof -
     have "arb_pf = (\<lambda> (x::'b) (n::nat) (w::'a). 0::real)(x:= (\<lambda> n w. -1), pos_stock := (\<lambda> n w. diff_inv))"
       using \<open>arb_pf = (\<lambda> (x::'b) (n::nat) (w::'a). 0::real)(x:= (\<lambda> n w. -1), pos_stock := (\<lambda> n w. diff_inv))\<close> .
     moreover have "\<exists>n w. diff_inv \<noteq> 0" using assms by simp
     moreover have "x\<noteq> pos_stock" using \<open>x \<notin> stocks Mkt\<close> in_stock by auto
     ultimately show ?thesis by (simp add:two_component_support_set)
   qed
   hence "portfolio arb_pf" unfolding portfolio_def by simp
   have arb_vp:"\<forall>n w. val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * diff_inv - pr n w"
   proof (intro allI)
     fix n w
     have "val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * (\<lambda> n w. diff_inv) n w + prices Mkt2 x n w * (\<lambda> n w. -1) n w"
     proof (rule two_component_val_process)
       show "x\<noteq> pos_stock" using \<open>x \<notin> stocks Mkt\<close> in_stock by auto
       show "arb_pf = (\<lambda>x n w. 0)(x := \<lambda>a b. - 1, pos_stock := \<lambda>a b. diff_inv)" using assms by simp
       show "portfolio arb_pf" using \<open>portfolio arb_pf\<close> by simp
       show "\<exists>n w. - (1::real) \<noteq> 0" by simp
       show "\<exists>n w. diff_inv \<noteq> 0" using assms by auto
     qed
     also have "... = prices Mkt2 pos_stock n w * diff_inv - pr n w" using \<open>prices Mkt2 x = pr\<close> by simp
     finally show "val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * diff_inv - pr n w" .
   qed
   have "static_quantities arb_pf" unfolding static_quantities_def
   proof
     fix asset
     assume "asset \<in> support_set arb_pf"
     thus "\<exists>c. arb_pf asset = (\<lambda>n w. c)"
     proof (cases "asset = x")
       case True
       thus ?thesis using assms by auto
     next
       case False
       hence "asset = pos_stock" using \<open>support_set arb_pf = {x, pos_stock}\<close>
         using \<open>asset \<in> support_set arb_pf\<close> by blast
       thus ?thesis using assms by auto
     qed
   qed
   hence "trading_strategy arb_pf"
     using \<open>portfolio arb_pf\<close> portfolio_def static_quantities_trading_strat by blast
   have "self_financing Mkt2 arb_pf"
         by (simp add: static_portfolio_self_financing \<open>arb_pf = (\<lambda>x n w. 0) (x := \<lambda>n w. -1, pos_stock := \<lambda>n w. diff_inv)\<close>)
   hence arb_uvp: "\<forall>n w. cls_val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * diff_inv - pr n w" using assms arb_vp
     by (simp add:self_financingE)
   show "portfolio contr_pf" using assms
       by (metis \<open>support_set arb_pf = {x, pos_stock}\<close> replicating_portfolio_def
           finite.emptyI finite.insertI portfolio_def stock_portfolio_def sum_portfolio)
   have "support_set contr_pf \<subseteq> stocks Mkt \<union> {x}"
   proof -
     have "support_set contr_pf \<subseteq> support_set arb_pf \<union> support_set pf" using assms
       by (simp add:sum_support_set)
     moreover have "support_set arb_pf \<subseteq> stocks Mkt \<union> {x}" using \<open>support_set arb_pf = {x, pos_stock}\<close> in_stock by simp
     moreover have "support_set pf \<subseteq> stocks Mkt \<union> {x}" using assms unfolding replicating_portfolio_def
       stock_portfolio_def by auto
     ultimately show ?thesis by auto
   qed
   show "self_financing Mkt2 contr_pf"
     proof -
     have "self_financing Mkt2 (qty_sum arb_pf pf)"
     proof (rule sum_self_financing)
       show "portfolio arb_pf"  using  \<open>support_set arb_pf = {x, pos_stock}\<close> unfolding portfolio_def by auto
       show "portfolio pf" using assms unfolding replicating_portfolio_def stock_portfolio_def by auto
       show "self_financing Mkt2 pf" using coincides_on_self_financing
         \<open>(coincides_on Mkt Mkt2 (stocks Mkt))\<close> \<open>(prices Mkt2 x = pr)\<close> assms(2)
         unfolding replicating_portfolio_def stock_portfolio_def  by blast
       show "self_financing Mkt2 arb_pf"
         by (simp add: static_portfolio_self_financing \<open>arb_pf = (\<lambda>x n w. 0) (x := \<lambda>n w. -1, pos_stock := \<lambda>n w. diff_inv)\<close>)
     qed
     thus ?thesis using assms by simp
   qed
   show "trading_strategy contr_pf"
   proof -
     have "trading_strategy (qty_sum arb_pf pf)"
     proof (rule sum_trading_strat)
       show "trading_strategy pf" using assms unfolding replicating_portfolio_def by simp
       show "trading_strategy arb_pf" using \<open>trading_strategy arb_pf\<close> .
     qed
     thus ?thesis using assms by simp
   qed
   show "\<forall>w\<in> space M. cls_val_process Mkt2 contr_pf 0 w = 0"
   proof
     fix w
     assume "w\<in> space M"
     have "cls_val_process Mkt2 contr_pf 0 w = cls_val_process Mkt2 arb_pf 0 w + cls_val_process Mkt2 pf 0 w"
       using sum_cls_val_process0[of arb_pf pf Mkt2]
       using \<open>portfolio arb_pf\<close> assms replicating_portfolio_def stock_portfolio_def by blast
     also have "... = prices Mkt2 pos_stock 0 w * diff_inv - pr 0 w + cls_val_process Mkt2 pf 0 w" using arb_uvp by simp
     also have "... = constant_image (prices Mkt pos_stock 0) * diff_inv - pr 0 w + cls_val_process Mkt2 pf 0 w"
     proof -
       have f1: "prices Mkt pos_stock = prices Mkt2 pos_stock"
         using \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close>  in_stock unfolding coincides_on_def by blast
       have "prices Mkt pos_stock 0 w = constant_image (prices Mkt pos_stock 0)"
         using \<open>w \<in> space M\<close> adapted_init constant_imageI pos_stock_borel_adapted by blast
       then show ?thesis
         using f1 by simp
     qed
     also have "... = (\<pi> - initial_value pf) - pr 0 w + cls_val_process Mkt2 pf 0 w"
       using \<open>0 < constant_image (prices Mkt pos_stock 0)\<close> assms by simp
     also have "... = (\<pi> - initial_value pf) - \<pi> + cls_val_process Mkt2 pf 0 w" using \<open>price_structure der matur \<pi> pr\<close>
       price_structure_init[of der matur \<pi> pr] by (simp add: \<open>w \<in> space M\<close>)
     also have "... = (\<pi> - initial_value pf) - \<pi> + (initial_value pf)" using initial_valueI assms unfolding replicating_portfolio_def
       using \<open>w \<in> space M\<close> coincides_stocks_cls_val_process self_financingE readable
       by (metis (no_types, opaque_lifting) support_adapt_def stock_portfolio_def subsetCE)
     also have "... = 0" by simp
     finally show "cls_val_process Mkt2 contr_pf 0 w = 0" .
   qed
   show "0 < diff_inv \<longrightarrow> (AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w)"
   proof
     assume "0 < diff_inv"
     show "AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w"
     proof (rule AE_mp)
       have "AE w in M. prices Mkt2 x matur w = der w" using \<open>price_structure der matur \<pi> pr\<close> \<open>prices Mkt2 x = pr\<close>
         unfolding price_structure_def by auto
       moreover have "AE w in M. cls_val_process Mkt2 pf matur  w = der w" using assms coincides_stocks_cls_val_process[of Mkt pf Mkt2]
         \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> unfolding replicating_portfolio_def by auto
       ultimately show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w" by auto
       show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w \<longrightarrow> 0 < cls_val_process Mkt2 contr_pf matur w"
       proof (rule AE_I2, rule impI)
         fix w
         assume "w\<in> space M"
         and "prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w"
         have "cls_val_process Mkt2 contr_pf matur w = cls_val_process Mkt2 arb_pf matur w + cls_val_process Mkt2 pf matur w"
           using sum_cls_val_process[of arb_pf pf Mkt2]
           \<open>portfolio arb_pf\<close> assms replicating_portfolio_def stock_portfolio_def by blast
         also have "... = prices Mkt2 pos_stock matur w * diff_inv - pr matur w + cls_val_process Mkt2 pf matur w"
           using arb_uvp by simp
         also have "... = prices Mkt2 pos_stock matur w * diff_inv - prices Mkt2 x matur w + cls_val_process Mkt2 pf matur w"
           using \<open>prices Mkt2 x = pr\<close> by simp
         also have "... = prices Mkt2 pos_stock matur w * diff_inv" using \<open>prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w\<close>
           by simp
         also have "... > 0" using positive \<open>0 < diff_inv\<close>
           by (metis \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> coincides_on_def in_stock mult_pos_pos)
         finally have "cls_val_process Mkt2 contr_pf matur w > 0".
         thus "0 < cls_val_process Mkt2 contr_pf matur w" by simp
       qed
     qed
   qed
   show "diff_inv < 0 \<longrightarrow> (AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w)"
   proof
     assume "diff_inv < 0"
     show "AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w"
     proof (rule AE_mp)
       have "AE w in M. prices Mkt2 x matur w = der w" using \<open>price_structure der matur \<pi> pr\<close> \<open>prices Mkt2 x = pr\<close>
         unfolding price_structure_def by auto
       moreover have "AE w in M. cls_val_process Mkt2 pf matur  w = der w" using assms coincides_stocks_cls_val_process[of Mkt pf Mkt2]
         \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> unfolding replicating_portfolio_def by auto
       ultimately show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w" by auto
       show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w \<longrightarrow> 0 > cls_val_process Mkt2 contr_pf matur w"
       proof (rule AE_I2, rule impI)
         fix w
         assume "w\<in> space M"
         and "prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w"
         have "cls_val_process Mkt2 contr_pf matur w = cls_val_process Mkt2 arb_pf matur w + cls_val_process Mkt2 pf matur w"
           using sum_cls_val_process[of arb_pf pf Mkt2]
           \<open>portfolio arb_pf\<close> assms replicating_portfolio_def stock_portfolio_def by blast
         also have "... = prices Mkt2 pos_stock matur w * diff_inv - pr matur w + cls_val_process Mkt2 pf matur w"
           using arb_uvp by simp
         also have "... = prices Mkt2 pos_stock matur w * diff_inv - prices Mkt2 x matur w + cls_val_process Mkt2 pf matur w"
           using \<open>prices Mkt2 x = pr\<close> by simp
         also have "... = prices Mkt2 pos_stock matur w * diff_inv" using \<open>prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w\<close>
           by simp
         also have "... < 0" using positive \<open>diff_inv < 0\<close>
           by (metis \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> coincides_on_def in_stock mult_pos_neg)
         finally have "cls_val_process Mkt2 contr_pf matur w < 0".
         thus "0 > cls_val_process Mkt2 contr_pf matur w" by simp
       qed
     qed
   qed
 qed
 
 lemma (in disc_equity_market) mult_comp_cls_val_process_measurable':
   assumes "cls_val_process Mkt2 pf n \<in>borel_measurable (F n)"
   and "portfolio pf"
   and "qty n \<in> borel_measurable (F n)"
   and "0 \<noteq> n"
 shows "cls_val_process Mkt2 (qty_mult_comp pf qty) n \<in> borel_measurable (F n)"
 proof -
   have "\<exists>m. n = Suc m" using assms by presburger
   from this obtain m where "n = Suc m" by auto
   hence "cls_val_process Mkt2 (qty_mult_comp pf qty) (Suc m) \<in> borel_measurable (F (Suc m))"
     using  mult_comp_cls_val_process_Suc[of pf Mkt2 qty] borel_measurable_times[of "cls_val_process Mkt2 pf (Suc m)" "F (Suc m)" "qty (Suc m)"]
       assms \<open>n= Suc m\<close> by presburger
   thus ?thesis using \<open>n = Suc m\<close> by simp
 qed
 
 
 lemma (in disc_equity_market) mult_comp_cls_val_process_measurable:
   assumes "\<forall>n. cls_val_process Mkt2 pf n \<in>borel_measurable (F n)"
   and "portfolio pf"
   and "\<forall>n. qty (Suc n) \<in> borel_measurable (F n)"
 shows "\<forall>n. cls_val_process Mkt2 (qty_mult_comp pf qty) n \<in> borel_measurable (F n)"
 proof
   fix n
   show "cls_val_process Mkt2 (qty_mult_comp pf qty) n \<in> borel_measurable (F n)"
   proof (cases "n=0")
     case False
     hence "\<exists>m. n = Suc m" by presburger
     from this obtain m where "n = Suc m" by auto
     have "qty n \<in> borel_measurable (F n)"
     using Suc_n_not_le_n \<open>n = Suc m\<close> assms(3) increasing_measurable_info nat_le_linear by blast
     hence "qty (Suc m) \<in> borel_measurable (F (Suc m))" using \<open>n = Suc m\<close> by simp
     hence "cls_val_process Mkt2 (qty_mult_comp pf qty) (Suc m) \<in> borel_measurable (F (Suc m))"
       using  mult_comp_cls_val_process_Suc[of pf Mkt2 qty] borel_measurable_times[of "cls_val_process Mkt2 pf (Suc m)" "F (Suc m)" "qty (Suc m)"]
         assms \<open>n= Suc m\<close> by presburger
     thus ?thesis using \<open>n = Suc m\<close> by simp
   next
     case True
     have "qty (Suc 0) \<in> borel_measurable (F 0)" using assms by simp
     moreover have "cls_val_process Mkt2 pf 0 \<in> borel_measurable (F 0)" using assms  by simp
     ultimately have "(\<lambda>w. cls_val_process Mkt2 pf 0 w * qty (Suc 0) w) \<in> borel_measurable (F 0)" by simp
     thus ?thesis using assms(2) True mult_comp_cls_val_process0
       by (simp add: \<open>(\<lambda>w. cls_val_process Mkt2 pf 0 w * qty (Suc 0) w) \<in> borel_measurable (F 0)\<close> mult_comp_cls_val_process0 measurable_cong)
   qed
 qed
 
 
 
 
 
 lemma (in disc_equity_market) mult_comp_val_process_measurable:
   assumes "val_process Mkt2 pf n \<in>borel_measurable (F n)"
   and "portfolio pf"
   and "qty (Suc n) \<in> borel_measurable (F n)"
 shows "val_process Mkt2 (qty_mult_comp pf qty) n \<in> borel_measurable (F n)"
   using  mult_comp_val_process[of pf Mkt2 qty] borel_measurable_times[of "val_process Mkt2 pf n" "F n" "qty (Suc n)"]
   assms by presburger
 
 lemma (in disc_market_pos_stock) repl_fair_price_unique:
   assumes "replicating_portfolio pf der matur"
   and "fair_price Mkt \<pi> der matur"
 shows "\<pi> = initial_value pf"
 proof -
   have expr: "(\<exists> pr. price_structure der matur \<pi> pr \<and>
     (\<forall> x. (x\<notin> stocks Mkt \<longrightarrow>
       (\<forall> Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt)) \<and> (prices Mkt2 x = pr) \<and> portfolio p \<and> support_set p \<subseteq> stocks Mkt \<union> {x} \<longrightarrow>
         \<not> arbitrage_process Mkt2 p))))" using assms fair_priceI by simp
   then obtain pr where "price_structure der matur \<pi> pr" and
     xasset: "(\<forall> x. (x\<notin> stocks Mkt \<longrightarrow>
       (\<forall> Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt)) \<and> (prices Mkt2 x = pr) \<and> portfolio p \<and> support_set p \<subseteq> stocks Mkt \<union> {x} \<longrightarrow>
         \<not> arbitrage_process Mkt2 p)))" by auto
   define diff_inv where "diff_inv = (\<pi> - initial_value pf) / constant_image (prices Mkt pos_stock 0)"
   {
     fix x
     assume "x\<notin> stocks Mkt"
     hence mkprop: "(\<forall> Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt)) \<and> (prices Mkt2 x = pr) \<and> portfolio p \<and> support_set p \<subseteq> stocks Mkt \<union> {x} \<longrightarrow>
           \<not> arbitrage_process Mkt2 p)" using xasset by simp
     fix Mkt2
     assume "(coincides_on Mkt Mkt2 (stocks Mkt))" and "(prices Mkt2 x = pr)"
     have "0 < constant_image (prices Mkt pos_stock 0)" using trading_strategy_init
       proof -
         have "borel_adapt_stoch_proc F (prices Mkt pos_stock)" using pos_stock_borel_adapted by simp
         hence "\<exists>c. \<forall>w\<in>space M. prices Mkt pos_stock 0 w = c" using  adapted_init[of "prices Mkt pos_stock"] by simp
         moreover have "\<forall>w\<in> space M. 0 < prices Mkt pos_stock 0 w" using positive by simp
         ultimately show ?thesis using constant_image_pos by simp
       qed
 
     define arb_pf where "arb_pf = (\<lambda> (x::'b) (n::nat) (w::'a). 0::real)(x:= (\<lambda> n w. -1), pos_stock := (\<lambda> n w. diff_inv))"
     define contr_pf where "contr_pf = qty_sum arb_pf pf"
     have 1:"0 \<noteq> diff_inv \<longrightarrow> self_financing Mkt2 contr_pf"
       using arbitrage_portfolio_properties[of der matur \<pi> pr pf Mkt2 x diff_inv arb_pf contr_pf]
       using  \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> \<open>price_structure der matur \<pi> pr\<close> \<open>prices Mkt2 x = pr\<close>
         \<open>x \<notin> stocks Mkt\<close> arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
     have 2:"0 \<noteq> diff_inv \<longrightarrow> trading_strategy contr_pf"
       using arbitrage_portfolio_properties[of der matur \<pi> pr pf Mkt2 x diff_inv arb_pf contr_pf]
       using  \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> \<open>price_structure der matur \<pi> pr\<close> \<open>prices Mkt2 x = pr\<close>
         \<open>x \<notin> stocks Mkt\<close> arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
     have 3:"0 \<noteq> diff_inv \<longrightarrow> (\<forall>w\<in> space M. cls_val_process Mkt2 contr_pf 0 w = 0)"
       using arbitrage_portfolio_properties[of der matur \<pi> pr pf Mkt2 x diff_inv arb_pf contr_pf]
       using  \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> \<open>price_structure der matur \<pi> pr\<close> \<open>prices Mkt2 x = pr\<close>
         \<open>x \<notin> stocks Mkt\<close> arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
     have 4: "0 < diff_inv \<longrightarrow> (AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w)"
       using arbitrage_portfolio_properties[of der matur \<pi> pr pf Mkt2 x diff_inv arb_pf contr_pf]
       using  \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> \<open>price_structure der matur \<pi> pr\<close> \<open>prices Mkt2 x = pr\<close>
         \<open>x \<notin> stocks Mkt\<close> arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
     have 5: "diff_inv < 0 \<longrightarrow> (AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w)"
       using arbitrage_portfolio_properties[of der matur \<pi> pr pf Mkt2 x diff_inv arb_pf contr_pf]
       using  \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> \<open>price_structure der matur \<pi> pr\<close> \<open>prices Mkt2 x = pr\<close>
         \<open>x \<notin> stocks Mkt\<close> arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
     have 6: "0 \<noteq> diff_inv \<longrightarrow> support_set arb_pf = {x, pos_stock}"
       using arbitrage_portfolio_properties[of der matur \<pi> pr pf Mkt2 x diff_inv arb_pf contr_pf]
       using  \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> \<open>price_structure der matur \<pi> pr\<close> \<open>prices Mkt2 x = pr\<close>
         \<open>x \<notin> stocks Mkt\<close> arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
     have 7: "0 \<noteq> diff_inv \<longrightarrow>support_set contr_pf \<subseteq> stocks Mkt \<union> {x}"
     proof -
       have "0 \<noteq> diff_inv \<longrightarrow> support_set contr_pf \<subseteq> support_set arb_pf \<union> support_set pf" unfolding contr_pf_def
         by (simp add:sum_support_set)
       moreover have "0 \<noteq> diff_inv \<longrightarrow>support_set arb_pf \<subseteq> stocks Mkt \<union> {x}" using \<open>0 \<noteq> diff_inv \<longrightarrow> support_set arb_pf = {x, pos_stock}\<close> in_stock by simp
       moreover have "0 \<noteq> diff_inv \<longrightarrow>support_set pf \<subseteq> stocks Mkt \<union> {x}" using assms unfolding replicating_portfolio_def
         stock_portfolio_def by auto
       ultimately show ?thesis by auto
     qed
     have 8:"0 \<noteq> diff_inv \<longrightarrow>portfolio contr_pf"
       using arbitrage_portfolio_properties[of der matur \<pi> pr pf Mkt2 x diff_inv arb_pf contr_pf]
       using  \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> \<open>price_structure der matur \<pi> pr\<close> \<open>prices Mkt2 x = pr\<close>
         \<open>x \<notin> stocks Mkt\<close> arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
     have 9: "0 \<noteq> diff_inv \<longrightarrow> cls_val_process Mkt2 contr_pf matur \<in> borel_measurable (F matur)"
     proof
       assume "0 \<noteq> diff_inv"
       have 10:"\<forall> asset \<in> support_set arb_pf \<union> support_set pf. prices Mkt2 asset matur \<in> borel_measurable (F matur)"
       proof
         fix asset
         assume "asset \<in> support_set arb_pf \<union> support_set pf"
         show "prices Mkt2 asset matur \<in> borel_measurable (F matur)"
         proof (cases "asset \<in> support_set pf")
           case True
           thus ?thesis using assms readable
             by (metis (no_types, lifting)  \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> adapt_stoch_proc_def
                 coincides_on_def disc_equity_market.replicating_portfolio_def
                 disc_equity_market_axioms  stock_portfolio_def subsetCE)
         next
           case False
           hence "asset\<in> support_set arb_pf" using \<open>asset \<in> support_set arb_pf \<union> support_set pf\<close> by auto
           show ?thesis
           proof (cases "asset = x")
             case True
             thus ?thesis
               using \<open>price_structure der matur \<pi> pr\<close> \<open>prices Mkt2 x = pr\<close> price_structure_borel_measurable by blast
           next
             case False
             hence "asset = pos_stock" using \<open>asset\<in> support_set arb_pf\<close> \<open>0 \<noteq> diff_inv \<longrightarrow> support_set arb_pf = {x, pos_stock}\<close>
               \<open>0 \<noteq> diff_inv\<close> by auto
             thus ?thesis
               by (metis \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> adapt_stoch_proc_def coincides_on_def in_stock pos_stock_borel_adapted)
           qed
         qed
       qed
       moreover have "\<forall>asset\<in>support_set contr_pf. contr_pf asset matur \<in> borel_measurable (F matur)"
         using \<open>0 \<noteq> diff_inv \<longrightarrow>trading_strategy contr_pf\<close> \<open>0 \<noteq> diff_inv\<close>
         by (metis adapt_stoch_proc_def disc_filtr_prob_space.predict_imp_adapt disc_filtr_prob_space_axioms trading_strategy_def)
       ultimately show "cls_val_process Mkt2 contr_pf matur \<in> borel_measurable (F matur)"
       proof-
         have "\<forall>asset\<in>support_set contr_pf. contr_pf asset (Suc matur) \<in> borel_measurable (F matur)"
            using \<open>0 \<noteq> diff_inv \<longrightarrow>trading_strategy contr_pf\<close> \<open>0 \<noteq> diff_inv\<close>
            by (simp add: predict_stoch_proc_def trading_strategy_def)
          moreover have "\<forall>asset\<in>support_set contr_pf. prices Mkt2 asset matur \<in> borel_measurable (F matur)" using 10 unfolding contr_pf_def
            using sum_support_set[of arb_pf pf] by auto
          ultimately show ?thesis  by (metis (no_types, lifting) "1" \<open>0 \<noteq> diff_inv\<close> quantity_adapted self_financingE)
       qed
     qed
     {
       assume "0 > diff_inv"
       define opp_pf where "opp_pf = qty_mult_comp contr_pf (\<lambda> n w. -1)"
       have "arbitrage_process Mkt2 opp_pf"
       proof (rule arbitrage_processI, rule exI, intro conjI)
         show "self_financing Mkt2 opp_pf" using 1 \<open>0 > diff_inv\<close> mult_time_constant_self_financing[of contr_pf] 8
           unfolding opp_pf_def by auto
         show "trading_strategy opp_pf" unfolding opp_pf_def
         proof (rule mult_comp_trading_strat)
           show "trading_strategy contr_pf" using 2 \<open>0 > diff_inv\<close> by auto
           show "borel_predict_stoch_proc F (\<lambda>n w. - 1)" by (simp add: constant_process_borel_predictable)
         qed
         show "\<forall>w\<in>space M. cls_val_process Mkt2 opp_pf 0 w = 0"
         proof
           fix w
           assume "w\<in> space M"
           show "cls_val_process Mkt2 opp_pf 0 w = 0" using 3 8 \<open>0 > diff_inv\<close>
             using \<open>w \<in> space M\<close> mult_comp_cls_val_process0 opp_pf_def by fastforce
         qed
         have "AE w in M. 0 < cls_val_process Mkt2 opp_pf matur w"
         proof (rule AE_mp)
           show "AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w" using 5 \<open>0 > diff_inv\<close> by auto
           show "AE w in M. cls_val_process Mkt2 contr_pf matur w < 0 \<longrightarrow> 0 < cls_val_process Mkt2 opp_pf matur w"
           proof
             fix w
             assume "w\<in> space M"
             show "cls_val_process Mkt2 contr_pf matur w < 0 \<longrightarrow> 0 < cls_val_process Mkt2 opp_pf matur w"
             proof
               assume "cls_val_process Mkt2 contr_pf matur w < 0"
               show "0 < cls_val_process Mkt2 opp_pf matur w"
               proof (cases "matur = 0")
                 case False
                 hence "\<exists>m. Suc m = matur" by presburger
                 from this obtain m where "Suc m = matur" by auto
                 hence "0 < cls_val_process Mkt2 opp_pf (Suc m) w" using 3 8 \<open>0 > diff_inv\<close> \<open>w \<in> space M\<close> mult_comp_cls_val_process_Suc  opp_pf_def
                   using \<open>cls_val_process Mkt2 contr_pf matur w < 0\<close> by fastforce
                 thus ?thesis using \<open>Suc m = matur\<close> by simp
               next
                 case True
                 thus ?thesis using 3 8 \<open>0 > diff_inv\<close> \<open>w \<in> space M\<close> mult_comp_cls_val_process0 opp_pf_def
                   using \<open>cls_val_process Mkt2 contr_pf matur w < 0\<close> by auto
               qed
             qed
           qed
         qed
         thus "AE w in M. 0 \<le> cls_val_process Mkt2 opp_pf matur w" by auto
         show "0 < prob {w \<in> space M. 0 < cls_val_process Mkt2 opp_pf matur w}"
         proof -
           let ?P = "{w\<in> space M. 0 < cls_val_process Mkt2 opp_pf matur w}"
           have "cls_val_process Mkt2 opp_pf matur \<in> borel_measurable (F matur)" (*unfolding opp_pf_def *)
           proof -
             have "cls_val_process Mkt2 contr_pf matur \<in> borel_measurable (F matur)" using 9 \<open>0 > diff_inv\<close> by simp
             moreover have "portfolio contr_pf" using 8 \<open>0 > diff_inv\<close> by simp
             moreover have "(\<lambda>w. - 1) \<in> borel_measurable (F matur)" by (simp add:constant_process_borel_adapted)
             ultimately show ?thesis
               using mult_comp_cls_val_process_measurable
             proof -
               have "diff_inv \<noteq> 0"
                 using \<open>diff_inv < 0\<close> by blast
               then have "self_financing Mkt2 contr_pf"
                 by (metis "1")
               then show ?thesis
                 by (metis (no_types) \<open>(\<lambda>w. - 1) \<in> borel_measurable (F matur)\<close> \<open>portfolio contr_pf\<close>
                     \<open>self_financing Mkt2 opp_pf\<close> \<open>cls_val_process Mkt2 contr_pf matur \<in> borel_measurable (F matur)\<close>
                     mult_comp_val_process_measurable opp_pf_def self_financingE)
             qed
           qed
           moreover have "space M = space (F matur)"
             using filtration by (simp add: filtration_def subalgebra_def)
           ultimately have "?P \<in> sets (F matur)" using borel_measurable_iff_greater[of "val_process Mkt2 contr_pf matur" "F matur"]
             by auto
           hence "?P \<in> sets M" by (meson filtration filtration_def subalgebra_def subsetCE)
           hence "measure M ?P = 1" using  prob_Collect_eq_1[of "\<lambda>x. 0 < cls_val_process Mkt2 opp_pf matur x"]
              \<open>AE w in M. 0 < cls_val_process Mkt2 opp_pf matur w\<close> \<open>0 > diff_inv\<close> by blast
           thus ?thesis by simp
         qed
       qed
         have "\<exists> p. portfolio p \<and> support_set p \<subseteq> stocks Mkt \<union> {x} \<and> arbitrage_process Mkt2 p"
         proof(intro exI conjI)
           show "arbitrage_process Mkt2 opp_pf" using \<open>arbitrage_process Mkt2 opp_pf\<close> .
           show "portfolio opp_pf" unfolding opp_pf_def using 8 \<open>0 > diff_inv\<close> by (auto simp add: mult_comp_portfolio)
           show "support_set opp_pf \<subseteq> stocks Mkt \<union> {x}" unfolding opp_pf_def using 7 \<open>0 > diff_inv\<close>
             using mult_comp_support_set by fastforce
         qed
       } note negp = this
       {
         assume "0 < diff_inv"
         have "arbitrage_process Mkt2 contr_pf"
         proof (rule arbitrage_processI, rule exI, intro conjI)
           show "self_financing Mkt2 contr_pf" using 1 \<open>0 < diff_inv\<close> by auto
           show "trading_strategy contr_pf" using 2 \<open>0 < diff_inv\<close> by auto
           show "\<forall>w\<in>space M. cls_val_process Mkt2 contr_pf 0 w = 0" using 3 \<open>0 < diff_inv\<close> by auto
           show "AE w in M. 0 \<le> cls_val_process Mkt2 contr_pf matur w" using 4 \<open>0 < diff_inv\<close> by auto
           show "0 < prob {w \<in> space M. 0 < cls_val_process Mkt2 contr_pf matur w}"
             proof -
               let ?P = "{w\<in> space M. 0 < cls_val_process Mkt2 contr_pf matur w}"
               have "cls_val_process Mkt2 contr_pf matur \<in> borel_measurable (F matur)" using 9 \<open>0 < diff_inv\<close> by auto
               moreover have "space M = space (F matur)"
                 using filtration  by (simp add: filtration_def subalgebra_def)
               ultimately have "?P \<in> sets (F matur)" using borel_measurable_iff_greater[of "val_process Mkt2 contr_pf matur" "F matur"]
                 by auto
               hence "?P \<in> sets M" by (meson filtration filtration_def subalgebra_def subsetCE)
               hence "measure M ?P = 1" using  prob_Collect_eq_1[of "\<lambda>x. 0 < cls_val_process Mkt2 contr_pf matur x"]
                  4 \<open>0 < diff_inv\<close> by blast
               thus ?thesis by simp
             qed
           qed
           have "\<exists> p. portfolio p \<and> support_set p \<subseteq> stocks Mkt \<union> {x} \<and> arbitrage_process Mkt2 p"
           proof(intro exI conjI)
             show "arbitrage_process Mkt2 contr_pf" using \<open>arbitrage_process Mkt2 contr_pf\<close> .
             show "portfolio contr_pf" using 8 \<open>0 < diff_inv\<close> by auto
             show "support_set contr_pf \<subseteq> stocks Mkt \<union> {x}" using 7 \<open>0 < diff_inv\<close> by auto
           qed
       } note posp = this
       have "diff_inv \<noteq> 0 \<longrightarrow> \<not>(\<exists> pr. price_structure der matur \<pi> pr \<and>
         (\<forall> x. (x\<notin> stocks Mkt \<longrightarrow>
           (\<forall> Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt)) \<and> (prices Mkt2 x = pr) \<and> portfolio p \<and> support_set p \<subseteq> stocks Mkt \<union> {x} \<longrightarrow>
             \<not> arbitrage_process Mkt2 p))))"
         using \<open>coincides_on Mkt Mkt2 (stocks Mkt)\<close> \<open>prices Mkt2 x = pr\<close> \<open>x \<notin> stocks Mkt\<close> xasset posp negp by force
   }
   hence "diff_inv = 0" using fix_asset_price expr by metis
   moreover have "constant_image (prices Mkt pos_stock 0) > 0"
     by (simp add: adapted_init constant_image_pos pos_stock_borel_adapted positive)
   ultimately show ?thesis unfolding diff_inv_def by auto
 qed
 
 
 subsection \<open>Risk-neutral probability space\<close>
 
 subsubsection \<open>risk-free rate and discount factor processes\<close>
 
 fun disc_rfr_proc:: "real \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> real"
 where
   rfr_base: "(disc_rfr_proc r) 0 w = 1"|
   rfr_step: "(disc_rfr_proc r) (Suc n) w = (1+r) * (disc_rfr_proc r) n w"
 
 
 lemma disc_rfr_proc_borel_measurable:
   shows "(disc_rfr_proc r) n \<in> borel_measurable M"
 proof (induct n)
 case (Suc n) thus ?case by (simp add:borel_measurable_times)
 qed auto
 
 lemma disc_rfr_proc_nonrandom:
   fixes r::real
   shows "\<And>n. disc_rfr_proc r n \<in> borel_measurable (F 0)" using disc_rfr_proc_borel_measurable by auto
 
 
 lemma (in disc_equity_market) disc_rfr_constant_time:
 shows "\<exists>c. \<forall>w \<in> space (F 0).  (disc_rfr_proc r n) w = c"
 proof (rule triv_measurable_cst)
   show "space (F 0) = space M" using filtration by (simp add:filtration_def subalgebra_def)
   show "sets (F 0) = {{}, space M}" using info_disc_filtr  by (simp add: bot_nat_def init_triv_filt_def)
   show "(disc_rfr_proc r n) \<in> borel_measurable (F 0)" using disc_rfr_proc_nonrandom by blast
   show "space M \<noteq> {}" by (simp add:not_empty)
 qed
 
 
 
 lemma (in disc_filtr_prob_space) disc_rfr_proc_borel_adapted:
   shows "borel_adapt_stoch_proc F (disc_rfr_proc r)"
 unfolding adapt_stoch_proc_def using disc_rfr_proc_nonrandom
          filtration unfolding filtration_def
   by (meson increasing_measurable_info le0)
 
 
 
 lemma disc_rfr_proc_positive:
   assumes "-1 < r"
   shows "\<And>n w . 0 < disc_rfr_proc r n w"
 proof -
   fix n
   fix w::'a
   show "0 < disc_rfr_proc r n w"
   proof (induct n)
   case 0 thus ?case using assms  "disc_rfr_proc.simps" by simp
   next
   case (Suc n) thus ?case using  assms "disc_rfr_proc.simps" by simp
   qed
 qed
 
 
 
 
 
 lemma (in prob_space) disc_rfr_constant_time_pos:
   assumes "-1 < r"
 shows "\<exists>c > 0. \<forall>w \<in> space M.  (disc_rfr_proc r n) w = c"
 proof -
   let ?F = "sigma (space M) {{}, space M}"
   have  ex: "\<exists>c. \<forall>w \<in> space ?F.  (disc_rfr_proc r n) w = c"
   proof (rule triv_measurable_cst)
     show "space ?F = space M" by simp
     show "sets ?F = {{}, space M}" by (meson sigma_algebra.sets_measure_of_eq sigma_algebra_trivial)
     show "(disc_rfr_proc r n) \<in> borel_measurable ?F" using disc_rfr_proc_borel_measurable by blast
     show "space M \<noteq> {}" by (simp add:not_empty)
   qed
   from this obtain c where "\<forall>w \<in> space ?F.  (disc_rfr_proc r n) w = c" by auto note cprops = this
   have "c>0"
   proof -
     have "\<exists> w. w\<in> space M" using subprob_not_empty by blast
     from this obtain w where "w\<in> space M" by auto
     hence "c = disc_rfr_proc r n w" using cprops  by simp
     also have "... > 0" using disc_rfr_proc_positive[of r n] assms by simp
     finally show ?thesis .
   qed
   moreover have "space M = space ?F" by simp
   ultimately show ?thesis using ex using cprops by blast
 qed
 
 
 lemma  disc_rfr_proc_Suc_div:
   assumes "-1 < r"
   shows "\<And>w. disc_rfr_proc r (Suc n) w/disc_rfr_proc r n w = 1+r"
 proof -
   fix w::'a
   show "disc_rfr_proc r (Suc n) w/disc_rfr_proc r n w = 1+r"
     using disc_rfr_proc_positive assms by (metis rfr_step  less_irrefl nonzero_eq_divide_eq)
 qed
 
 definition discount_factor where
   "discount_factor r n = (\<lambda>w. inverse (disc_rfr_proc r n w))"
 
 lemma discount_factor_times_rfr:
   assumes "-1 < r"
   shows "(1+r) * discount_factor r (Suc n) w = discount_factor r n w" unfolding discount_factor_def using assms by simp
 
 lemma discount_factor_borel_measurable:
   shows "discount_factor r n \<in> borel_measurable M" unfolding discount_factor_def
 proof (rule borel_measurable_inverse)
   show "disc_rfr_proc r n \<in> borel_measurable M" by (simp add:disc_rfr_proc_borel_measurable)
 qed
 
 lemma discount_factor_init:
   shows "discount_factor r 0 = (\<lambda>w. 1)" unfolding discount_factor_def by simp
 
 lemma discount_factor_nonrandom:
   shows "discount_factor r n \<in> borel_measurable M" unfolding discount_factor_def
 proof (rule borel_measurable_inverse)
   show "disc_rfr_proc r n \<in> borel_measurable M" by (simp add:disc_rfr_proc_borel_measurable)
 qed
 
 
 lemma discount_factor_positive:
   assumes "-1 < r"
   shows "\<And>n w . 0 < discount_factor r n w" using assms disc_rfr_proc_positive unfolding discount_factor_def by auto
 
 
 lemma (in prob_space) discount_factor_constant_time_pos:
   assumes "-1 < r"
 shows "\<exists>c > 0. \<forall>w \<in> space M.  (discount_factor r n) w = c"  using  disc_rfr_constant_time_pos unfolding discount_factor_def
   by (metis assms inverse_positive_iff_positive)
 
 
 locale rsk_free_asset =
   fixes Mkt r risk_free_asset
   assumes acceptable_rate: "-1 < r"
   and rf_price: "prices Mkt risk_free_asset = disc_rfr_proc r"
   and rf_stock: "risk_free_asset \<in> stocks Mkt"
 
 locale rfr_disc_equity_market = disc_equity_market   + rsk_free_asset +
   assumes rd: "\<forall> asset\<in> stocks Mkt. borel_adapt_stoch_proc F (prices Mkt asset)"
 
 
 
 sublocale rfr_disc_equity_market \<subseteq> disc_market_pos_stock _ _ _ "risk_free_asset"
 by (unfold_locales, (auto simp add: rf_stock rd disc_rfr_proc_positive rf_price acceptable_rate))
 
 subsubsection \<open>Discounted value of a stochastic process\<close>
 
 definition discounted_value where
   "discounted_value r X = (\<lambda> n w. discount_factor r n w * X n w)"
 
 
 
 lemma (in rfr_disc_equity_market) discounted_rfr:
   shows "discounted_value r (prices Mkt risk_free_asset) n w = 1" unfolding discounted_value_def discount_factor_def
   using rf_price by (metis less_irrefl mult.commute positive right_inverse)
 
 lemma  discounted_init:
   shows "\<forall>w. discounted_value r X 0 w = X 0 w" unfolding discounted_value_def by (simp add: discount_factor_init)
 
 lemma  discounted_mult:
   shows "\<forall>n w. discounted_value r (\<lambda>m x. X m x * Y m x) n w = X n w * (discounted_value r Y) n w"
   by (simp add: discounted_value_def)
 
 lemma  discounted_mult':
   shows "discounted_value r (\<lambda>m x. X m x * Y m x) n w = X n w * (discounted_value r Y) n w"
   by (simp add: discounted_value_def)
 
 lemma discounted_mult_times_rfr:
   assumes "-1 < r"
   shows "discounted_value r (\<lambda>m w. (1+r) * X w) (Suc n) w = discounted_value r (\<lambda>m w. X w) n w"
     unfolding discounted_value_def using assms discount_factor_times_rfr discounted_mult
     by (simp add: discount_factor_times_rfr mult.commute)
 
 lemma discounted_cong:
   assumes "\<forall>n w. X n w = Y n w"
   shows "\<forall> n w. discounted_value r X n w = discounted_value r Y n w"
   by (simp add: assms discounted_value_def)
 
 lemma  discounted_cong':
   assumes "X n w = Y n w"
   shows "discounted_value r X n w = discounted_value r Y n w"
   by (simp add: assms discounted_value_def)
 
 lemma discounted_AE_cong:
   assumes "AE w in N. X n w = Y n w"
   shows "AE w in N. discounted_value r X n w = discounted_value r Y n w"
 proof (rule AE_mp)
   show "AE w in N. X n w = Y n w" using assms by simp
   show "AE w in N. X n w = Y n w \<longrightarrow> discounted_value r X n w = discounted_value r Y n w"
   proof
     fix w
     assume "w\<in> space N"
     thus "X n w = Y n w \<longrightarrow> discounted_value r X n w = discounted_value r Y n w " by (simp add:discounted_value_def)
   qed
 qed
 
 
 
 lemma discounted_sum:
   assumes "finite I"
 shows "\<forall>n w. (\<Sum> i\<in> I. (discounted_value r (\<lambda>m x. f i m x)) n w) = (discounted_value r (\<lambda>m x. (\<Sum>i\<in> I. f i m x)) n w)"
   using assms(1) subset_refl[of I]
 proof (induct rule: finite_subset_induct)
   case empty
   then show ?case
     by (simp add: discounted_value_def)
 next
   case (insert a F)
   show ?case
   proof (intro allI)
     fix n w
     have "(\<Sum>i\<in>insert a F. discounted_value r (f i) n w) = discounted_value r (f a) n w + (\<Sum>i\<in>F. discounted_value r (f i) n w)"
       by (simp add: insert.hyps(1) insert.hyps(3))
     also have "... = discounted_value r (f a) n w + discounted_value r (\<lambda>m x. \<Sum>i\<in>F. f i m x) n w" using insert.hyps(4) by simp
     also have "... = discounted_value r (\<lambda>m x. \<Sum>i\<in>insert a F. f i m x) n w"
       by (simp add: discounted_value_def insert.hyps(1) insert.hyps(3) ring_class.ring_distribs(1))
     finally show "(\<Sum>i\<in>insert a F. discounted_value r (f i) n w) = discounted_value r (\<lambda>m x. \<Sum>i\<in>insert a F. f i m x) n w" .
   qed
 qed
 
 lemma  discounted_adapted:
   assumes "borel_adapt_stoch_proc F X"
   shows "borel_adapt_stoch_proc F (discounted_value r X)" unfolding adapt_stoch_proc_def
 proof
   fix t
   show "discounted_value r X t \<in> borel_measurable (F t)" unfolding discounted_value_def
   proof (rule borel_measurable_times)
     show "X t \<in> borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
     show "discount_factor r t \<in> borel_measurable (F t)" using discount_factor_borel_measurable by auto
   qed
 qed
 
 lemma discounted_measurable:
   assumes "X\<in> borel_measurable N"
   shows "discounted_value r (\<lambda>m. X) m \<in> borel_measurable N" unfolding discounted_value_def
 proof (rule borel_measurable_times)
   show "X\<in> borel_measurable N" using assms by simp
   show "discount_factor r m \<in> borel_measurable N" using discount_factor_borel_measurable by auto
 qed
 
 
 lemma (in prob_space) discounted_integrable:
   assumes "integrable N (X n)"
   and "-1 < r"
   and "space N = space M"
   shows "integrable N (discounted_value r X n)" unfolding discounted_value_def
 proof -
   have "\<exists>c> 0. \<forall>w \<in> space M.  (discount_factor r n) w = c" using discount_factor_constant_time_pos assms by simp
   from this obtain c where "c > 0" and "\<forall>w \<in> space M.  (discount_factor r n) w = c" by auto note cprops = this
   hence "\<forall>w \<in> space M. discount_factor r n w = c" using cprops  by simp
   hence "\<forall>w \<in> space N. discount_factor r n w = c" using assms by simp
   thus "integrable N (\<lambda>w. discount_factor r n w * X n w)"
     using \<open>\<forall>w \<in> space N. discount_factor r n w = c\<close> assms
     Bochner_Integration.integrable_cong[of N N "(\<lambda>w. discount_factor r n w * X n w)" "(\<lambda>w. c * X n w)"] by simp
 qed
 
 
 subsubsection \<open>Results on risk-neutral probability spaces\<close>
 
 definition (in rfr_disc_equity_market) risk_neutral_prob where
   "risk_neutral_prob N \<longleftrightarrow> (prob_space N) \<and> (\<forall> asset \<in> stocks Mkt. martingale N F (discounted_value r (prices Mkt asset)))"
 
 
 lemma integrable_val_process:
   assumes "\<forall> asset \<in> support_set pf. integrable M (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w)"
   shows "integrable M (val_process Mkt pf n)"
 proof (cases "portfolio pf")
   case False
   thus ?thesis unfolding val_process_def by simp
 next
   case True
   hence "val_process Mkt pf n = (\<lambda>w. \<Sum>x\<in>support_set pf. prices Mkt x n w * pf x (Suc n) w)"
     unfolding val_process_def by simp
   moreover have "integrable M (\<lambda>w. \<Sum>x\<in>support_set pf. prices Mkt x n w * pf x (Suc n) w)" using assms by simp
   ultimately show ?thesis by simp
 qed
 
 lemma integrable_self_fin_uvp:
   assumes "\<forall> asset \<in> support_set pf. integrable M (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w)"
   and "self_financing Mkt pf"
 shows "integrable M (cls_val_process Mkt pf n)"
 proof -
   have "val_process Mkt pf n = cls_val_process Mkt pf n" using assms by (simp add:self_financingE)
   moreover have "integrable M (val_process Mkt pf n)" using assms by (simp add:integrable_val_process)
   ultimately show ?thesis by simp
 qed
 
 
 
 lemma (in rfr_disc_equity_market) stocks_portfolio_risk_neutral:
   assumes "risk_neutral_prob N"
   and "trading_strategy pf"
   and "subalgebra N M"
   and "support_set pf \<subseteq> stocks Mkt"
   and "\<forall>n. \<forall> asset \<in> support_set pf. integrable N (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
   shows  "\<forall>x \<in> support_set pf. AE w in N.
         (real_cond_exp N (F n) (discounted_value r (\<lambda>m y. prices Mkt x m y * pf x m y) (Suc n))) w =
         discounted_value r (\<lambda>m y. prices Mkt x m y * pf x (Suc m) y) n w"
 proof
   have nsigfin: "\<forall>n. sigma_finite_subalgebra N (F n)" using assms unfolding risk_neutral_prob_def martingale_def subalgebra_def
       using filtration filtration_def risk_neutral_prob_def prob_space.subalgebra_sigma_finite in_stock by metis
   have "disc_filtr_prob_space N F"
   proof -
     have "prob_space N" using assms unfolding risk_neutral_prob_def by simp
     moreover have "disc_filtr N F" using assms subalgebra_filtration
       by (metis (no_types, lifting) filtration disc_filtr_def filtration_def)
     ultimately show ?thesis
       by (simp add: disc_filtr_prob_space_axioms_def disc_filtr_prob_space_def)
   qed
   fix asset
   assume "asset \<in> support_set pf"
   hence "asset \<in> stocks Mkt" using assms by auto
   have "discounted_value r (prices Mkt asset) (Suc n) \<in> borel_measurable M" using assms readable
     by (meson \<open>asset \<in> stocks Mkt\<close> borel_adapt_stoch_proc_borel_measurable discounted_adapted
         rfr_disc_equity_market.risk_neutral_prob_def rfr_disc_equity_market_axioms)
   hence b: "discounted_value r (prices Mkt asset) (Suc n) \<in> borel_measurable N"
       using assms Conditional_Expectation.measurable_from_subalg[of N M _ borel] by auto
   show "AEeq N (real_cond_exp N (F n) (discounted_value r (\<lambda>m y. prices Mkt asset m y * pf asset m y) (Suc n)))
   (discounted_value r (\<lambda>m y. prices Mkt asset m y * pf asset (Suc m) y) n)"
   proof -
     have "AE w in N. (real_cond_exp N (F n) (discounted_value r (\<lambda>m y. prices Mkt asset m y * pf asset m y) (Suc n))) w =
       (real_cond_exp N (F n) (\<lambda>z. pf asset (Suc n) z * discounted_value r (\<lambda>m y. prices Mkt asset m y) (Suc n) z)) w"
     proof (rule sigma_finite_subalgebra.real_cond_exp_cong)
       show "sigma_finite_subalgebra N (F n)" using nsigfin ..
       show "AE w in N. discounted_value r (\<lambda>m y. prices Mkt asset m y * pf asset m y) (Suc n) w =
          pf asset (Suc n) w * discounted_value r (\<lambda>m y. prices Mkt asset m y) (Suc n) w"
         by (simp add: discounted_value_def)
       show "discounted_value r (\<lambda>m y. prices Mkt asset m y * pf asset m y) (Suc n) \<in> borel_measurable N"
       proof -
         have "(\<lambda>y. prices Mkt asset (Suc n) y * pf asset (Suc n) y) \<in> borel_measurable N"
           using assms \<open>asset\<in> support_set pf\<close> by (simp add:borel_measurable_integrable)
         thus ?thesis unfolding discounted_value_def using discount_factor_borel_measurable[of r "Suc n" N] by simp
       qed
       show "(\<lambda>z. pf asset (Suc n) z * discounted_value r (prices Mkt asset) (Suc n) z) \<in> borel_measurable N"
       proof -
         have "pf asset (Suc n) \<in> borel_measurable M" using assms \<open>asset\<in> support_set pf\<close> unfolding trading_strategy_def
           using borel_predict_stoch_proc_borel_measurable[of "pf asset"] by auto
         hence a: "pf asset (Suc n) \<in> borel_measurable N" using assms Conditional_Expectation.measurable_from_subalg[of N M _ borel] by blast
         show ?thesis using a b by simp
       qed
     qed
     also have "AE w in N. (real_cond_exp N (F n) (\<lambda>z. pf asset (Suc n) z * discounted_value r (\<lambda>m y. prices Mkt asset m y) (Suc n) z)) w =
       pf asset (Suc n) w * (real_cond_exp N (F n) (\<lambda>z. discounted_value r (\<lambda>m y. prices Mkt asset m y) (Suc n) z)) w"
     proof (rule sigma_finite_subalgebra.real_cond_exp_mult)
       show "discounted_value r (prices Mkt asset) (Suc n) \<in> borel_measurable N" using b by simp
       show "sigma_finite_subalgebra N (F n)" using nsigfin ..
       show "pf asset (Suc n) \<in> borel_measurable (F n)" using assms \<open>asset\<in> support_set pf\<close> unfolding trading_strategy_def
           predict_stoch_proc_def by auto
       show "integrable N (\<lambda>z. pf asset (Suc n) z * discounted_value r (prices Mkt asset) (Suc n) z)"
       proof -
         have "integrable N (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w)" using assms \<open>asset \<in> support_set pf\<close> by auto
         hence "integrable N (discounted_value r (\<lambda>m w. prices Mkt asset m w * pf asset m w) (Suc n))" using assms
           unfolding risk_neutral_prob_def using acceptable_rate  by (auto simp add:discounted_integrable subalgebra_def)
         thus ?thesis
           by (smt (verit, ccfv_SIG) Bochner_Integration.integrable_cong discounted_value_def mult.assoc mult.commute)
       qed
     qed
     also have "AE w in N.  pf asset (Suc n) w * (real_cond_exp N (F n) (\<lambda>z. discounted_value r (\<lambda>m y. prices Mkt asset m y) (Suc n) z)) w =
             pf asset (Suc n) w * discounted_value r (\<lambda>m y. prices Mkt asset m y) n w"
     proof -
       have "AEeq N (real_cond_exp N (F n) (\<lambda>z. discounted_value r (\<lambda>m y. prices Mkt asset m y) (Suc n) z))
         (\<lambda>z. discounted_value r (\<lambda>m y. prices Mkt asset m y) n z)"
       proof -
         have "martingale N F (discounted_value r (prices Mkt asset))"
           using assms \<open>asset \<in> stocks Mkt\<close> unfolding risk_neutral_prob_def by simp
         moreover have "filtrated_prob_space N F" using \<open>disc_filtr_prob_space N F\<close>
           using assms(2) disc_filtr_prob_space.axioms(1) filtrated_prob_space.intro filtrated_prob_space_axioms.intro filtration prob_space_axioms
           by (metis assms(3) subalgebra_filtration)
         ultimately show ?thesis using martingaleAE[of N F "discounted_value r (prices Mkt asset)" n "Suc n"] assms
           by simp
       qed
       thus ?thesis by auto
     qed
     also have "AE w in N.  pf asset (Suc n) w * discounted_value r (\<lambda>m y. prices Mkt asset m y) n w =
       discounted_value r (\<lambda>m y. pf asset (Suc m) y * prices Mkt asset m y) n w" by (simp add: discounted_value_def)
     also have "AE w in N. discounted_value r (\<lambda>m y. pf asset (Suc m) y * prices Mkt asset m y) n w =
       discounted_value r (\<lambda>m y. prices Mkt asset m y * pf asset (Suc m) y) n w"
       by (simp add: discounted_value_def)
     finally show "AE w in N.
       (real_cond_exp N (F n) (discounted_value r (\<lambda>m y. prices Mkt asset m y * pf asset m y) (Suc n))) w =
       (\<lambda>x. discounted_value r (\<lambda>m y. prices Mkt asset m y * pf asset (Suc m) y) n x) w" .
   qed
 qed
 
 
 
 lemma (in rfr_disc_equity_market) self_fin_trad_strat_mart:
   assumes "risk_neutral_prob N"
   and "filt_equiv F M N"
   and "trading_strategy pf"
   and "self_financing Mkt pf"
 and "stock_portfolio Mkt pf"
   and "\<forall>n. \<forall> asset \<in> support_set pf. integrable N (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w)"
   and "\<forall>n. \<forall> asset \<in> support_set pf. integrable N (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
 shows "martingale N F (discounted_value r (cls_val_process Mkt pf))" (*unfolding martingale_def*)
 proof (rule disc_martingale_charact)
   show nsigfin: "\<forall>n. sigma_finite_subalgebra N (F n)" using filt_equiv_prob_space_subalgebra assms
           using filtration filtration_def risk_neutral_prob_def subalgebra_sigma_finite by fastforce
   show "filtration N F" using assms by (simp  add:filt_equiv_filtration)
   have "borel_adapt_stoch_proc F (discounted_value r (cls_val_process Mkt pf))" using assms discounted_adapted
     cls_val_process_adapted[of pf] stock_portfolio_def
     by (metis (mono_tags, opaque_lifting) support_adapt_def readable subsetCE)
   thus "\<forall>m. discounted_value r (cls_val_process Mkt pf) m \<in> borel_measurable (F m)" unfolding adapt_stoch_proc_def by simp
   show "\<forall>t. integrable N (discounted_value r (cls_val_process Mkt pf) t)"
   proof
     fix t
     have "integrable N (cls_val_process Mkt pf t)" using assms by (simp add: integrable_self_fin_uvp)
     thus "integrable N (discounted_value r (cls_val_process Mkt pf) t)" using assms discounted_integrable acceptable_rate
       by (metis filt_equiv_space)
   qed
   show "\<forall>n. AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
                    discounted_value r (cls_val_process Mkt pf) n w"
   proof
     fix n
     show "AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
                     discounted_value r (cls_val_process Mkt pf) n w"
     proof -
       {
         fix w
         assume "w\<in> space M"
         have "discounted_value r (cls_val_process Mkt pf) (Suc n) w =
                   discount_factor r (Suc n) w * (\<Sum>x\<in>support_set pf. prices Mkt x (Suc n) w * pf x (Suc n) w)"
           unfolding discounted_value_def cls_val_process_def using assms unfolding trading_strategy_def by simp
         also have "... = (\<Sum>x\<in>support_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)"
           by (metis (no_types, lifting) mult.assoc sum.cong sum_distrib_left)
         finally have "discounted_value r (cls_val_process Mkt pf) (Suc n) w =
                   (\<Sum>x\<in>support_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)" .
       }
       hence space: "\<forall>w\<in> space M. discounted_value r (cls_val_process Mkt pf) (Suc n) w =
                 (\<Sum>x\<in>support_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)" by simp
       hence nspace: "\<forall>w\<in> space N. discounted_value r (cls_val_process Mkt pf) (Suc n) w =
                 (\<Sum>x\<in>support_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)" using assms by (simp add:filt_equiv_space)
       have sup_disc: "\<forall>x \<in> support_set pf. AE w in N.
         (real_cond_exp N (F n) (discounted_value r (\<lambda>m y. prices Mkt x m y * pf x m y) (Suc n))) w =
         discounted_value r (\<lambda>m y. prices Mkt x m y * pf x (Suc m) y) n w" using assms
         by (simp add:stocks_portfolio_risk_neutral filt_equiv_imp_subalgebra stock_portfolio_def)
       have "AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
                 real_cond_exp N (F n) (\<lambda>y. \<Sum>x\<in>support_set pf. discounted_value r (\<lambda>m y. prices Mkt x m y * pf x m y) (Suc n) y) w"
       proof (rule sigma_finite_subalgebra.real_cond_exp_cong')
         show "sigma_finite_subalgebra N (F n)" using nsigfin ..
         show "\<forall>w\<in>space N. discounted_value r (cls_val_process Mkt pf) (Suc n) w =
           (\<lambda>y. \<Sum>x\<in>support_set pf. discounted_value r (\<lambda>m y. prices Mkt x m y * pf x m y) (Suc n) y) w"  using nspace
           by (metis (no_types, lifting) discounted_value_def mult.assoc sum.cong)
         show "(discounted_value r (cls_val_process Mkt pf) (Suc n)) \<in> borel_measurable N" using assms
           using \<open>\<forall>t. integrable N (discounted_value r (cls_val_process Mkt pf) t)\<close> by blast
       qed
       also have "AE w in N. real_cond_exp N (F n)
         (\<lambda>y. \<Sum>x\<in>support_set pf. discounted_value r (\<lambda>m y. prices Mkt x m y * pf x m y) (Suc n) y) w =
         (\<Sum>x\<in> support_set pf. (real_cond_exp N (F n) (discounted_value r (\<lambda>m y. prices Mkt x m y * pf x m y) (Suc n))) w)"
       proof (rule sigma_finite_subalgebra.real_cond_exp_bsum)
         show "sigma_finite_subalgebra N (F n)" using filt_equiv_prob_space_subalgebra assms
           using filtration filtration_def risk_neutral_prob_def subalgebra_sigma_finite by fastforce
         fix asset
         assume "asset \<in> support_set pf"
         show "integrable N (discounted_value r (\<lambda>m y. prices Mkt asset m y * pf asset m y) (Suc n))"
         proof (rule discounted_integrable)
           show "integrable N (\<lambda>y. prices Mkt asset (Suc n) y * pf asset (Suc n) y)" using assms \<open>asset\<in> support_set pf\<close> by simp
           show "space N = space M" using assms by (metis filt_equiv_space)
           show "-1 < r" using acceptable_rate by simp
         qed
       qed
       also have "AE w in N.
         (\<Sum>x\<in> support_set pf. (real_cond_exp N (F n) (discounted_value r (\<lambda>m y. prices Mkt x m y * pf x m y) (Suc n))) w) =
         (\<Sum>x\<in> support_set pf. discounted_value r (\<lambda>m y. prices Mkt x m y * pf x (Suc m) y) n w)"
       proof (rule AE_sum)
         show "finite (support_set pf)" using assms(3) portfolio_def trading_strategy_def by auto
         show  "\<forall>x \<in> support_set pf. AE w in N.
         (real_cond_exp N (F n) (discounted_value r (\<lambda>m y. prices Mkt x m y * pf x m y) (Suc n))) w =
         discounted_value r (\<lambda>m y. prices Mkt x m y * pf x (Suc m) y) n w" using sup_disc by simp
       qed
       also have "AE w in N.
         (\<Sum>x\<in> support_set pf. discounted_value r (\<lambda>m y. prices Mkt x m y * pf x (Suc m) y) n w) =
         discounted_value r (cls_val_process Mkt pf) n w"
       proof
         fix w
         assume "w\<in> space N"
         have "(\<Sum>x\<in> support_set pf. discounted_value r (\<lambda>m y. prices Mkt x m y * pf x (Suc m) y) n w) =
           discounted_value r (\<lambda>m y. (\<Sum>x\<in> support_set pf. prices Mkt x m y * pf x (Suc m) y)) n w" using discounted_sum
           assms(3) portfolio_def trading_strategy_def by (simp add: discounted_value_def sum_distrib_left)
         also have "... = discounted_value r (val_process Mkt pf) n w"  unfolding val_process_def
           by (simp add: portfolio_def)
         also have "... = discounted_value r (cls_val_process Mkt pf) n w" using assms
           by (simp add:self_financingE discounted_cong)
         finally show "(\<Sum>x\<in> support_set pf. discounted_value r (\<lambda>m y. prices Mkt x m y * pf x (Suc m) y) n w) =
           discounted_value r (cls_val_process Mkt pf) n w" .
       qed
       finally show "AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
         discounted_value r (cls_val_process Mkt pf) n w" .
     qed
   qed
 qed
 
 lemma (in disc_filtr_prob_space) finite_integrable_vp:
   assumes "\<forall>n. \<forall> asset \<in> support_set pf. finite (prices Mkt asset n `(space M))"
   and "\<forall>n. \<forall> asset \<in> support_set pf. finite (pf asset n `(space M))"
 and "prob_space N"
   and "filt_equiv F M N"
 and "trading_strategy pf"
 and "\<forall>n. \<forall> asset \<in> support_set pf. prices Mkt asset n \<in> borel_measurable M"
 shows  "\<forall>n. \<forall>asset\<in>support_set pf. integrable N (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w)"
 proof (intro allI ballI)
   fix n
   fix asset
   assume "asset\<in>support_set pf"
   show "integrable N (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w)"
   proof (rule prob_space.finite_borel_measurable_integrable)
     show "prob_space N" using assms by simp
     have "finite ((\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) ` space M)"
     proof -
       have "\<forall>y\<in> prices Mkt asset n `(space M). finite ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y)"
         by (metis \<open>asset \<in> support_set pf\<close> assms(2) finite_imageI image_image)
       hence "finite (\<Union> y\<in> prices Mkt asset n `(space M). ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y))"
         using \<open>asset \<in> support_set pf\<close> assms by blast
       moreover have "(\<Union> y\<in> prices Mkt asset n `(space M). ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y)) =
         (\<Union> y\<in> prices Mkt asset n `(space M). (\<lambda>w. y * pf asset (Suc n) w) ` space M)"  by simp
       moreover have "((\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) ` space M) \<subseteq>
         (\<Union> y\<in> prices Mkt asset n `(space M). (\<lambda>w. y * pf asset (Suc n) w) ` space M)"
       proof
         fix x
         assume "x \<in> (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) ` space M"
         show "x \<in> (\<Union>y\<in>prices Mkt asset n ` space M. (\<lambda>w. y * pf asset (Suc n) w) ` space M)"
           using \<open>x \<in> (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) ` space M\<close> by auto
       qed
       ultimately show ?thesis by (simp add:finite_subset)
     qed
     thus "finite ((\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
     have "(\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) \<in> borel_measurable M"
     proof -
       have "prices Mkt asset n \<in> borel_measurable M" using assms \<open>asset \<in> support_set pf\<close> by simp
       moreover have "pf asset (Suc n) \<in> borel_measurable M" using assms unfolding trading_strategy_def
         using \<open>asset \<in> support_set pf\<close> borel_predict_stoch_proc_borel_measurable by blast
       ultimately show ?thesis by simp
     qed
     thus "(\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) \<in> borel_measurable N" using assms by (simp add:filt_equiv_measurable)
   qed
 qed
 
 
 lemma (in disc_filtr_prob_space) finite_integrable_uvp:
   assumes "\<forall>n. \<forall> asset \<in> support_set pf. finite (prices Mkt asset n `(space M))"
   and "\<forall>n. \<forall> asset \<in> support_set pf. finite (pf asset n `(space M))"
 and "prob_space N"
   and "filt_equiv F M N"
 and "trading_strategy pf"
 and "\<forall>n. \<forall> asset \<in> support_set pf. prices Mkt asset n \<in> borel_measurable M"
 shows  "\<forall>n. \<forall>asset\<in>support_set pf. integrable N (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
 proof (intro allI ballI)
   fix n
   fix asset
   assume "asset\<in>support_set pf"
   show "integrable N (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
   proof (rule prob_space.finite_borel_measurable_integrable)
     show "prob_space N" using assms by simp
     have "finite ((\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M)"
     proof -
       have "\<forall>y\<in> prices Mkt asset (Suc n) `(space M). finite ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y)"
         by (metis \<open>asset \<in> support_set pf\<close> assms(2) finite_imageI image_image)
       hence "finite (\<Union> y\<in> prices Mkt asset (Suc n) `(space M). ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y))"
         using \<open>asset \<in> support_set pf\<close> assms by blast
       moreover have "(\<Union> y\<in> prices Mkt asset (Suc n) `(space M). ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y)) =
         (\<Union> y\<in> prices Mkt asset (Suc n) `(space M). (\<lambda>w. y * pf asset (Suc n) w) ` space M)"  by simp
       moreover have "((\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M) \<subseteq>
         (\<Union> y\<in> prices Mkt asset (Suc n) `(space M). (\<lambda>w. y * pf asset (Suc n) w) ` space M)"
       proof
         fix x
         assume "x \<in> (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M"
         show "x \<in> (\<Union>y\<in>prices Mkt asset (Suc n) ` space M. (\<lambda>w. y * pf asset (Suc n) w) ` space M)"
           using \<open>x \<in> (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M\<close> by auto
       qed
       ultimately show ?thesis by (simp add:finite_subset)
     qed
     thus "finite ((\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
     have "(\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) \<in> borel_measurable M"
     proof -
       have "prices Mkt asset (Suc n) \<in> borel_measurable M" using assms
         using \<open>asset \<in> support_set pf\<close> borel_adapt_stoch_proc_borel_measurable by blast
       moreover have "pf asset (Suc n) \<in> borel_measurable M" using assms unfolding trading_strategy_def
         using \<open>asset \<in> support_set pf\<close> borel_predict_stoch_proc_borel_measurable by blast
       ultimately show ?thesis by simp
     qed
     thus "(\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) \<in> borel_measurable N" using assms by (simp add:filt_equiv_measurable)
   qed
 qed
 
 lemma (in rfr_disc_equity_market) self_fin_trad_strat_mart_finite:
   assumes "risk_neutral_prob N"
   and "filt_equiv F M N"
   and "trading_strategy pf"
   and "self_financing Mkt pf"
   and "support_set pf \<subseteq> stocks Mkt"
   and "\<forall>n. \<forall> asset \<in> support_set pf. finite (prices Mkt asset n `(space M))"
   and "\<forall>n. \<forall> asset \<in> support_set pf. finite (pf asset n `(space M))"
 and "\<forall> asset\<in> stocks Mkt. borel_adapt_stoch_proc F (prices Mkt asset)"
 shows "martingale N F (discounted_value r (cls_val_process Mkt pf))"
 proof (rule self_fin_trad_strat_mart, (simp add:assms)+)
   show "\<forall>n. \<forall>asset\<in>support_set pf. integrable N (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w)"
   proof (intro allI ballI)
     fix n
     fix asset
     assume "asset\<in>support_set pf"
     show "integrable N (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w)"
     proof (rule prob_space.finite_borel_measurable_integrable)
       show "prob_space N" using assms unfolding risk_neutral_prob_def by auto
       have "finite ((\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) ` space M)"
       proof -
         have "\<forall>y\<in> prices Mkt asset n `(space M). finite ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y)"
           by (metis \<open>asset \<in> support_set pf\<close> assms(7) finite_imageI image_image)
         hence "finite (\<Union> y\<in> prices Mkt asset n `(space M). ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y))"
           using \<open>asset \<in> support_set pf\<close> assms(6) by blast
         moreover have "(\<Union> y\<in> prices Mkt asset n `(space M). ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y)) =
           (\<Union> y\<in> prices Mkt asset n `(space M). (\<lambda>w. y * pf asset (Suc n) w) ` space M)"  by simp
         moreover have "((\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) ` space M) \<subseteq>
           (\<Union> y\<in> prices Mkt asset n `(space M). (\<lambda>w. y * pf asset (Suc n) w) ` space M)"
         proof
           fix x
           assume "x \<in> (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) ` space M"
           show "x \<in> (\<Union>y\<in>prices Mkt asset n ` space M. (\<lambda>w. y * pf asset (Suc n) w) ` space M)"
             using \<open>x \<in> (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) ` space M\<close> by auto
         qed
         ultimately show ?thesis by (simp add:finite_subset)
       qed
       thus "finite ((\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
       have "(\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) \<in> borel_measurable M"
       proof -
         have "prices Mkt asset n \<in> borel_measurable M" using assms readable
           using \<open>asset \<in> support_set pf\<close> borel_adapt_stoch_proc_borel_measurable by blast
         moreover have "pf asset (Suc n) \<in> borel_measurable M" using assms unfolding trading_strategy_def
           using \<open>asset \<in> support_set pf\<close> borel_predict_stoch_proc_borel_measurable by blast
         ultimately show ?thesis by simp
       qed
       thus "(\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w) \<in> borel_measurable N" using assms by (simp add:filt_equiv_measurable)
     qed
   qed
   show "\<forall>n. \<forall>asset\<in>support_set pf. integrable N (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
   proof (intro allI ballI)
     fix n
     fix asset
     assume "asset\<in>support_set pf"
     show "integrable N (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
     proof (rule prob_space.finite_borel_measurable_integrable)
       show "prob_space N" using assms unfolding risk_neutral_prob_def by auto
       have "finite ((\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M)"
       proof -
         have "\<forall>y\<in> prices Mkt asset (Suc n) `(space M). finite ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y)"
           by (metis \<open>asset \<in> support_set pf\<close> assms(7) finite_imageI image_image)
         hence "finite (\<Union> y\<in> prices Mkt asset (Suc n) `(space M). ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y))"
           using \<open>asset \<in> support_set pf\<close> assms(6) by blast
         moreover have "(\<Union> y\<in> prices Mkt asset (Suc n) `(space M). ((\<lambda> z. (\<lambda>w. z * pf asset (Suc n) w) ` space M) y)) =
           (\<Union> y\<in> prices Mkt asset (Suc n) `(space M). (\<lambda>w. y * pf asset (Suc n) w) ` space M)"  by simp
         moreover have "((\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M) \<subseteq>
           (\<Union> y\<in> prices Mkt asset (Suc n) `(space M). (\<lambda>w. y * pf asset (Suc n) w) ` space M)"
         proof
           fix x
           assume "x \<in> (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M"
           show "x \<in> (\<Union>y\<in>prices Mkt asset (Suc n) ` space M. (\<lambda>w. y * pf asset (Suc n) w) ` space M)"
             using \<open>x \<in> (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M\<close> by auto
         qed
         ultimately show ?thesis by (simp add:finite_subset)
       qed
       thus "finite ((\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
       have "(\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) \<in> borel_measurable M"
       proof -
         have "prices Mkt asset (Suc n) \<in> borel_measurable M" using assms readable
           using \<open>asset \<in> support_set pf\<close> borel_adapt_stoch_proc_borel_measurable by blast
         moreover have "pf asset (Suc n) \<in> borel_measurable M" using assms unfolding trading_strategy_def
           using \<open>asset \<in> support_set pf\<close> borel_predict_stoch_proc_borel_measurable by blast
         ultimately show ?thesis by simp
       qed
       thus "(\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w) \<in> borel_measurable N" using assms by (simp add:filt_equiv_measurable)
     qed
   qed
   show "stock_portfolio Mkt pf" using assms stock_portfolio_def
     by (simp add: stock_portfolio_def trading_strategy_def)
 qed
 
 
 lemma (in rfr_disc_equity_market) replicating_expectation:
   assumes "risk_neutral_prob N"
   and "filt_equiv F M N"
   and "replicating_portfolio pf pyf matur"
   and "\<forall>n. \<forall> asset \<in> support_set pf. integrable N (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w)"
   and "\<forall>n. \<forall> asset \<in> support_set pf. integrable N (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
   and "viable_market Mkt"
   and "sets (F 0) = {{}, space M}"
   and "pyf  \<in> borel_measurable (F matur)"
 shows "fair_price Mkt (prob_space.expectation N (discounted_value r (\<lambda>m. pyf) matur)) pyf matur"
 proof -
   have fn: "filtrated_prob_space N F" using assms
     by (simp add: \<open>pyf \<in> borel_measurable (F matur)\<close> filtrated_prob_space_axioms.intro
         filtrated_prob_space_def risk_neutral_prob_def filt_equiv_filtration)
   have "discounted_value r (cls_val_process Mkt pf) matur \<in> borel_measurable N"
     using assms(3) disc_equity_market.replicating_portfolio_def disc_equity_market_axioms discounted_adapted
     filtrated_prob_space.borel_adapt_stoch_proc_borel_measurable fn cls_val_process_adapted
     by (metis (no_types, opaque_lifting) support_adapt_def readable  stock_portfolio_def subsetCE)
   have "discounted_value r (\<lambda>m. pyf) matur \<in> borel_measurable N"
   proof -
     have "(\<lambda>m. pyf) matur \<in> borel_measurable (F matur)" using assms by simp
     hence "(\<lambda>m. pyf) matur \<in> borel_measurable M"  using filtration filtrationE1 measurable_from_subalg by blast
     hence "(\<lambda>m. pyf) matur \<in> borel_measurable N" using assms by (simp add:filt_equiv_measurable)
     thus ?thesis by (simp add:discounted_measurable)
   qed
   have mpyf: "AE w in M. cls_val_process Mkt pf matur w = pyf w" using assms unfolding replicating_portfolio_def by simp
   have "AE w in N. cls_val_process Mkt pf matur w = pyf w"
   proof (rule filt_equiv_borel_AE_eq)
     show "filt_equiv F M N" using assms by simp
     show "pyf \<in> borel_measurable (F matur)" using assms by simp
     show "AE w in M. cls_val_process Mkt pf matur w = pyf w" using mpyf by simp
     show "cls_val_process Mkt pf matur \<in> borel_measurable (F matur)"
       using assms(3) price_structure_def replicating_price_process
       by (meson support_adapt_def disc_equity_market.replicating_portfolio_def disc_equity_market_axioms readable  stock_portfolio_def subsetCE)
   qed
   hence disc:"AE w in N. discounted_value r (cls_val_process Mkt pf) matur w = discounted_value r (\<lambda>m. pyf) matur w"
     by (simp add:discounted_AE_cong)
   have "AEeq N (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur))
     (real_cond_exp N (F 0) (discounted_value r (\<lambda>m. pyf) matur))"
   proof (rule sigma_finite_subalgebra.real_cond_exp_cong)
     show "sigma_finite_subalgebra N (F 0)"
       using filtrated_prob_space.axioms(1) filtrated_prob_space.filtration fn filtrationE1
         prob_space.subalgebra_sigma_finite by blast
     show "AEeq N (discounted_value r (cls_val_process Mkt pf) matur) (discounted_value r (\<lambda>m. pyf) matur)" using disc by simp
     show "discounted_value r (cls_val_process Mkt pf) matur \<in> borel_measurable N"
       using \<open>discounted_value r (cls_val_process Mkt pf) matur \<in> borel_measurable N\<close> .
     show "discounted_value r (\<lambda>m. pyf) matur \<in> borel_measurable N"
       using \<open>discounted_value r (\<lambda>m. pyf) matur \<in> borel_measurable N\<close> .
   qed
   have "martingale N F (discounted_value r (cls_val_process Mkt pf))" using assms unfolding replicating_portfolio_def
     using self_fin_trad_strat_mart[of N pf] by (simp add: stock_portfolio_def)
   hence "AEeq N (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur))
     (discounted_value r (cls_val_process Mkt pf) 0)" using martingaleAE[of N F "discounted_value r (cls_val_process Mkt pf)" 0 matur]
     fn by simp
   also have "AE w in N. (discounted_value r (cls_val_process Mkt pf) 0 w) = initial_value pf"
   proof
     fix w
     assume "w\<in> space N"
     have "discounted_value r (cls_val_process Mkt pf) 0 w = cls_val_process Mkt pf 0 w" by (simp add:discounted_init)
     also have "... = val_process Mkt pf 0 w" unfolding cls_val_process_def using assms
       unfolding replicating_portfolio_def stock_portfolio_def by simp
     also have "... = initial_value pf" using assms unfolding replicating_portfolio_def using \<open>w\<in> space N\<close>
       by (metis (no_types, lifting) support_adapt_def filt_equiv_space initial_valueI readable stock_portfolio_def subsetCE)
     finally show "discounted_value r (cls_val_process Mkt pf) 0 w = initial_value pf" .
   qed
   finally have "AE w in N. (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur)) w =
     initial_value pf" .
   moreover have "\<forall>w\<in> space N. (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur)) w =
     prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur)"
   proof (rule prob_space.trivial_subalg_cond_expect_eq)
     show "prob_space N" using assms unfolding risk_neutral_prob_def by simp
     show "subalgebra N (F 0)"
       using \<open>prob_space N\<close> filtrated_prob_space.filtration fn filtrationE1 by blast
     show "sets (F 0) = {{}, space N}" using assms by (simp add:filt_equiv_space)
     show "integrable N (discounted_value r (cls_val_process Mkt pf) matur)"
     proof (rule discounted_integrable)
       show "space N = space M" using assms by (simp add:filt_equiv_space)
       show "integrable N (cls_val_process Mkt pf matur)" using assms unfolding replicating_portfolio_def
         by (simp add: integrable_self_fin_uvp)
       show "-1 < r" using acceptable_rate by simp
     qed
   qed
   ultimately have "AE w in N. prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur) =
      initial_value pf" by simp
   hence "prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur) =
     initial_value pf" using assms unfolding risk_neutral_prob_def using  prob_space.emeasure_space_1[of N]
     AE_eq_cst[of _ _ N] by simp
   moreover have "prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur) =
     prob_space.expectation N (discounted_value r (\<lambda>m. pyf) matur)"
   proof (rule integral_cong_AE)
     show "AEeq N (discounted_value r (cls_val_process Mkt pf) matur) (discounted_value r (\<lambda>m. pyf) matur)"
       using disc by simp
     show "discounted_value r (\<lambda>m. pyf) matur \<in> borel_measurable N"
       using \<open>discounted_value r (\<lambda>m. pyf) matur \<in> borel_measurable N\<close> .
     show "discounted_value r (cls_val_process Mkt pf) matur \<in> borel_measurable N"
       using \<open>discounted_value r (cls_val_process Mkt pf) matur \<in> borel_measurable N\<close> .
   qed
   ultimately have "prob_space.expectation N (discounted_value r (\<lambda>m. pyf) matur) = initial_value pf" by simp
   thus ?thesis using assms
     by (metis (full_types) support_adapt_def disc_equity_market.replicating_portfolio_def disc_equity_market_axioms
         readable replicating_fair_price stock_portfolio_def subsetCE)
 qed
 
 
 lemma (in rfr_disc_equity_market) replicating_expectation_finite:
   assumes "risk_neutral_prob N"
   and "filt_equiv F M N"
   and "replicating_portfolio pf pyf matur"
   and "\<forall>n. \<forall> asset \<in> support_set pf. finite (prices Mkt asset n `(space M))"
   and "\<forall>n. \<forall> asset \<in> support_set pf. finite (pf asset n `(space M))"
   and "viable_market Mkt"
   and "sets (F 0) = {{}, space M}"
   and "pyf  \<in> borel_measurable (F matur)"
 shows "fair_price Mkt (prob_space.expectation N (discounted_value r (\<lambda>m. pyf) matur)) pyf matur"
 proof -
   have  "\<forall>n. \<forall> asset \<in> support_set pf. integrable N (\<lambda>w. prices Mkt asset n w * pf asset (Suc n) w)"
   proof (rule finite_integrable_vp, (auto simp add:assms))
     show "prob_space N" using assms unfolding risk_neutral_prob_def by simp
     show "trading_strategy pf" using assms unfolding replicating_portfolio_def by simp
     show "\<And>n asset. asset \<in> support_set pf \<Longrightarrow> random_variable borel (prices Mkt asset n)"
     proof-
       fix n
       fix asset
       assume "asset \<in> support_set pf"
       show "random_variable borel (prices Mkt asset n)"
         using assms unfolding replicating_portfolio_def stock_portfolio_def  adapt_stoch_proc_def using readable
         by (meson \<open>asset \<in> support_set pf\<close> adapt_stoch_proc_borel_measurable subsetCE)
     qed
   qed
   moreover have "\<forall>n. \<forall> asset \<in> support_set pf. integrable N (\<lambda>w. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
   proof (rule finite_integrable_uvp, (auto simp add:assms))
     show "prob_space N" using assms unfolding risk_neutral_prob_def by simp
     show "trading_strategy pf" using assms unfolding replicating_portfolio_def by simp
     show "\<And>n asset. asset \<in> support_set pf \<Longrightarrow> random_variable borel (prices Mkt asset n)"
     proof-
       fix n
       fix asset
       assume "asset \<in> support_set pf"
       show "random_variable borel (prices Mkt asset n)"
         using assms unfolding replicating_portfolio_def stock_portfolio_def  adapt_stoch_proc_def using readable
         by (meson \<open>asset \<in> support_set pf\<close> adapt_stoch_proc_borel_measurable subsetCE)
     qed
   qed
   ultimately show ?thesis using assms replicating_expectation by simp
 qed
 
 
 
 end
\ No newline at end of file
diff --git a/thys/Disintegration/Disintegration.thy b/thys/Disintegration/Disintegration.thy
--- a/thys/Disintegration/Disintegration.thy
+++ b/thys/Disintegration/Disintegration.thy
@@ -1,2524 +1,2525 @@
 (*  Title:   Disintegration.thy
     Author:  Michikazu Hirata, Tokyo Institute of Technology
 *)
 
 section \<open> Disintegration Theorem \<close>
 
 theory Disintegration
   imports "S_Finite_Measure_Monad.Kernels"
           "Lemmas_Disintegration"
 begin
 
 subsection \<open> Definition 14.D.2. (Mixture and Disintegration) \<close>
 context measure_kernel
 begin
 
 definition mixture_of :: "[('a \<times>'b) measure, 'a measure] \<Rightarrow> bool" where
 "mixture_of \<nu> \<mu> \<longleftrightarrow> sets \<nu> = sets (X \<Otimes>\<^sub>M Y) \<and> sets \<mu> = sets X \<and> (\<forall>C\<in>sets (X \<Otimes>\<^sub>M Y). \<nu> C = (\<integral>\<^sup>+x. \<integral>\<^sup>+y. indicator C (x,y) \<partial>(\<kappa> x) \<partial>\<mu>))"
 
 definition disintegration :: "[('a \<times>'b) measure, 'a measure] \<Rightarrow> bool" where
 "disintegration \<nu> \<mu> \<longleftrightarrow> sets \<nu> = sets (X \<Otimes>\<^sub>M Y) \<and> sets \<mu> = sets X \<and> (\<forall>A\<in>sets X. \<forall>B\<in>sets Y. \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x B) \<partial>\<mu>))"
 
 lemma disintegrationI:
   assumes "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "sets \<mu> = sets X"
       and "\<And>A B. A \<in> sets X \<Longrightarrow> B \<in> sets Y \<Longrightarrow> \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x B) \<partial>\<mu>)"
     shows "disintegration \<nu> \<mu>"
   by(simp add: disintegration_def assms)
 
 lemma mixture_of_disintegration:
   assumes "mixture_of \<nu> \<mu>"
   shows "disintegration \<nu> \<mu>"
   unfolding disintegration_def
 proof safe
   fix A B
   assume [simp]:"A \<in> sets X" "B \<in> sets Y"
   have [simp,measurable_cong]: "sets \<mu> = sets X" "space \<mu> = space X"
     using assms by(auto simp: mixture_of_def intro!: sets_eq_imp_space_eq)
   have "A \<times> B \<in> sets (X \<Otimes>\<^sub>M Y)" by simp
   with assms have "\<nu> (A \<times> B) = (\<integral>\<^sup>+x. \<integral>\<^sup>+y. indicator (A \<times> B) (x,y) \<partial>(\<kappa> x) \<partial>\<mu>)"
     by(simp add: mixture_of_def)
   also have "... = (\<integral>\<^sup>+x. \<integral>\<^sup>+y. indicator A x * indicator B y \<partial>(\<kappa> x) \<partial>\<mu>)"
     by(simp add: indicator_times)
   also have "... =  (\<integral>\<^sup>+x\<in>A. (\<kappa> x B) \<partial>\<mu>)"
     by(auto intro!: nn_integral_cong simp: kernel_sets nn_integral_cmult_indicator mult.commute)
-  finally show "emeasure \<nu> (A \<times> B) = \<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) B\<partial>\<mu>" .
+  finally show "emeasure \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) B\<partial>\<mu>)" .
 qed(use assms[simplified mixture_of_def] in auto)
 
 lemma
   shows mixture_of_sets_eq: "mixture_of \<nu> \<mu> \<Longrightarrow> sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "mixture_of \<nu> \<mu> \<Longrightarrow> sets \<mu> = sets X"
     and mixture_of_space_eq: "mixture_of \<nu> \<mu> \<Longrightarrow> space \<nu> = space (X \<Otimes>\<^sub>M Y)" "mixture_of \<nu> \<mu> \<Longrightarrow> space \<mu> = space X"
     and disintegration_sets_eq: "disintegration \<nu> \<mu> \<Longrightarrow> sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "disintegration \<nu> \<mu> \<Longrightarrow> sets \<mu> = sets X"
     and disintegration_space_eq: "disintegration \<nu> \<mu> \<Longrightarrow> space \<nu> = space (X \<Otimes>\<^sub>M Y)" "disintegration \<nu> \<mu> \<Longrightarrow> space \<mu> = space X"
   by(auto simp: mixture_of_def disintegration_def intro!: sets_eq_imp_space_eq)
 
 lemma
   shows mixture_ofD: "mixture_of \<nu> \<mu> \<Longrightarrow> C \<in> sets (X \<Otimes>\<^sub>M Y) \<Longrightarrow> \<nu> C = (\<integral>\<^sup>+x. \<integral>\<^sup>+y. indicator C (x,y) \<partial>(\<kappa> x) \<partial>\<mu>)"
     and disintegrationD: "disintegration \<nu> \<mu> \<Longrightarrow> A \<in> sets X \<Longrightarrow> B \<in> sets Y \<Longrightarrow> \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x B) \<partial>\<mu>)"
   by(auto simp: mixture_of_def disintegration_def)
 
 lemma disintegration_restrict_space:
   assumes "disintegration \<nu> \<mu>" "A \<inter> space X \<in> sets X"
   shows "measure_kernel.disintegration (restrict_space X A) Y \<kappa> (restrict_space \<nu> (A \<times> space Y)) (restrict_space \<mu> A)"
 proof(rule measure_kernel.disintegrationI[OF restrict_measure_kernel[of A]])
   have "sets (restrict_space \<nu> (A \<times> space Y)) = sets (restrict_space (X \<Otimes>\<^sub>M Y) (A \<times> space Y))"
     by(auto simp: disintegration_sets_eq[OF assms(1)] intro!: sets_restrict_space_cong)
   also have "... = sets (restrict_space X A \<Otimes>\<^sub>M Y)"
     using sets_pair_restrict_space[of X A Y "space Y"]
     by simp
   finally show "sets (restrict_space \<nu> (A \<times> space Y)) = sets (restrict_space X A \<Otimes>\<^sub>M Y)" .
 next
   show "sets (restrict_space \<mu> A) = sets (restrict_space X A)"
     by(auto simp: disintegration_sets_eq[OF assms(1)] intro!: sets_restrict_space_cong)
 next
   fix a b
   assume h:"a \<in> sets (restrict_space X A)" "b \<in> sets Y"
   then have "restrict_space \<nu> (A \<times> space Y) (a \<times> b) = \<nu> (a \<times> b)"
     using sets.sets_into_space
     by(auto intro!: emeasure_restrict_space  simp: disintegration_space_eq[OF assms(1)] disintegration_sets_eq[OF assms(1)] sets_restrict_space)
       (metis Sigma_Int_distrib1 assms(2) pair_measureI sets.top space_pair_measure)
   also have "... = (\<integral>\<^sup>+x\<in>a. emeasure (\<kappa> x) b \<partial>\<mu>)"
     using sets_restrict_space_iff[OF assms(2)] h assms(1)
     by(auto simp: disintegration_def)
   also have "... = (\<integral>\<^sup>+x\<in>A. (emeasure (\<kappa> x) b * indicator a x) \<partial>\<mu>)"
     using h(1) by(auto intro!: nn_integral_cong simp: sets_restrict_space)
                  (metis IntD1 indicator_simps(1) indicator_simps(2) mult.comm_neutral mult_zero_right)
   also have "... = (\<integral>\<^sup>+x\<in>a. emeasure (\<kappa> x) b \<partial>restrict_space \<mu> A)"
     by (metis (no_types, lifting) assms disintegration_sets_eq(2) disintegration_space_eq(2) nn_integral_cong nn_integral_restrict_space)
   finally show "restrict_space \<nu> (A \<times> space Y) (a \<times> b) = (\<integral>\<^sup>+x\<in>a. emeasure (\<kappa> x) b \<partial>restrict_space \<mu> A)" .
 qed
 
 end
 
 context subprob_kernel
 begin
 lemma countable_disintegration_AE_unique:
   assumes "countable (space Y)" and [measurable_cong]:"sets Y = Pow (space Y)"
       and "subprob_kernel X Y \<kappa>'" "sigma_finite_measure \<mu>"
       and "disintegration \<nu> \<mu>" "measure_kernel.disintegration X Y \<kappa>' \<nu> \<mu>"
     shows "AE x in \<mu>. \<kappa> x = \<kappa>' x"
 proof -
   interpret \<kappa>': subprob_kernel X Y \<kappa>' by fact
   interpret s: sigma_finite_measure \<mu> by fact
   have sets_eq[measurable_cong]: "sets \<mu> = sets X" "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)"
     using assms(5) by(auto simp: disintegration_def)
   have 1:"AE x in \<mu>. \<forall>y \<in> space Y. \<kappa> x {y} = \<kappa>' x {y}"
     unfolding AE_ball_countable[OF assms(1)]
   proof
     fix y
     assume y: "y \<in> space Y"
     show "AE x in \<mu>. emeasure (\<kappa> x) {y} = emeasure (\<kappa>' x) {y}"
     proof(rule s.sigma_finite)
       fix J :: "nat \<Rightarrow> _"
       assume J:"range J \<subseteq> sets \<mu>" " \<Union> (range J) = space \<mu>" "\<And>i. emeasure \<mu> (J i) \<noteq> \<infinity>"
       from y have [measurable]: "(\<lambda>x. \<kappa> x {y}) \<in> borel_measurable X" "(\<lambda>x. \<kappa>' x {y}) \<in> borel_measurable X"
         using emeasure_measurable \<kappa>'.emeasure_measurable by auto
       define A where "A \<equiv> {x \<in> space \<mu>. \<kappa> x {y} \<le> \<kappa>' x {y}}"
       have [measurable]:"A \<in> sets \<mu>"
         by(auto simp: A_def)
       have A: "\<And>x. x \<in> space \<mu> \<Longrightarrow> x \<notin> A \<Longrightarrow>  \<kappa>' x {y} \<le> \<kappa> x {y}"
         by(auto simp: A_def)
       have 1: "AE x\<in>A in \<mu>. \<kappa> x {y} = \<kappa>' x {y}"
       proof -
         have "AE x in \<mu>. \<forall>n. (x \<in> A \<inter> J n \<longrightarrow> \<kappa> x {y} = \<kappa>' x {y})"
           unfolding AE_all_countable
         proof
           fix n
           have ninf:"(\<integral>\<^sup>+x\<in>A \<inter> J n. (\<kappa> x) {y}\<partial>\<mu>) < \<infinity>"
           proof -
             have "(\<integral>\<^sup>+x\<in>A \<inter> J n. (\<kappa> x) {y}\<partial>\<mu>) \<le> (\<integral>\<^sup>+x\<in>A \<inter> J n. (\<kappa> x) (space Y) \<partial>\<mu>)"
               using kernel_sets y by(auto intro!: nn_integral_mono emeasure_mono simp: indicator_def disintegration_space_eq(2)[OF assms(5)])
             also have "... \<le> (\<integral>\<^sup>+x\<in>A \<inter> J n. 1 \<partial>\<mu>)"
               using subprob_space by(auto intro!: nn_integral_mono simp: indicator_def disintegration_space_eq(2)[OF assms(5)])
             also have "... = \<mu> (A \<inter> J n)"
               using J by simp
             also have "... \<le> \<mu> (J n)"
               using J by (auto intro!: emeasure_mono)
             also have "... < \<infinity>"
               using J(3)[of n] by (simp add: top.not_eq_extremum)
             finally show ?thesis .
           qed
           have "(\<integral>\<^sup>+x. (\<kappa>' x) {y} * indicator (A \<inter> J n) x - (\<kappa> x) {y} * indicator (A \<inter> J n) x \<partial>\<mu>) = (\<integral>\<^sup>+x\<in>A \<inter> J n. (\<kappa>' x) {y} \<partial>\<mu>) - (\<integral>\<^sup>+x\<in>A \<inter> J n. (\<kappa> x) {y}  \<partial>\<mu>)"
             using J ninf by(auto intro!: nn_integral_diff simp: indicator_def A_def)
           also have "... = 0"
           proof -
             have 0: "\<nu> ((A \<inter> J n) \<times> {y}) = (\<integral>\<^sup>+x\<in>A \<inter> J n. (\<kappa> x) {y} \<partial>\<mu>)"
               using J y sets_eq by(auto intro!: disintegrationD[OF assms(5),of "A \<inter> J n" "{y}"])
             have [simp]: "(\<integral>\<^sup>+x\<in>A \<inter> J n. (\<kappa>' x) {y} \<partial>\<mu>) = \<nu> ((A \<inter> J n) \<times> {y})"
               using J y sets_eq by(auto intro!: \<kappa>'.disintegrationD[OF assms(6),of "A \<inter> J n" "{y}",symmetric])
             show ?thesis
               using ninf by (simp add: 0 diff_eq_0_iff_ennreal)
           qed
           finally have assm:"AE x in \<mu>. (\<kappa>' x) {y} * indicator (A \<inter> J n) x - (\<kappa> x) {y} * indicator (A \<inter> J n) x = 0"
             using J by(simp add: nn_integral_0_iff_AE)
           show "AE x\<in>A \<inter> J n in \<mu>. (\<kappa> x) {y} = (\<kappa>' x) {y}"
           proof(rule AE_mp[OF assm])
             show "AE x in \<mu>. emeasure (\<kappa>' x) {y} * indicator (A \<inter> J n) x - emeasure (\<kappa> x) {y} * indicator (A \<inter> J n) x = 0 \<longrightarrow> x \<in> A \<inter> J n \<longrightarrow> emeasure (\<kappa> x) {y} = emeasure (\<kappa>' x) {y}"
             proof -
               {
                 fix x
                 assume h: "(\<kappa>' x) {y} - (\<kappa> x) {y} = 0" "x \<in> A"
                 have "(\<kappa> x) {y} = (\<kappa>' x) {y}"
                   using h(2) by(auto intro!: antisym ennreal_minus_eq_0[OF h(1)] simp: A_def)
               }
               thus ?thesis
                 by(auto simp: indicator_def)
             qed
           qed
         qed
         hence "AE x\<in>A \<inter> (\<Union> (range J))in \<mu>. \<kappa> x {y} = \<kappa>' x {y}"
           by auto
         thus ?thesis
           using J(2) by auto
       qed
       have 2: "AE x\<in> (space \<mu> - A) in \<mu>. \<kappa> x {y} = \<kappa>' x {y}"
       proof -
         have "AE x in \<mu>. \<forall>n. x \<in> (space \<mu> - A) \<inter> J n \<longrightarrow> \<kappa> x {y} = \<kappa>' x {y}"
           unfolding AE_all_countable
         proof
           fix n
           have ninf:"(\<integral>\<^sup>+x\<in>(space \<mu> - A) \<inter> J n. (\<kappa>' x) {y}\<partial>\<mu>) < \<infinity>"
           proof -
             have "(\<integral>\<^sup>+x\<in>(space \<mu> - A) \<inter> J n. (\<kappa>' x) {y}\<partial>\<mu>) \<le> (\<integral>\<^sup>+x\<in>(space \<mu> - A) \<inter> J n. (\<kappa>' x) (space Y) \<partial>\<mu>)"
               using kernel_sets y by(auto intro!: nn_integral_mono emeasure_mono simp: indicator_def disintegration_space_eq(2)[OF assms(5)])
             also have "... \<le> (\<integral>\<^sup>+x\<in>(space \<mu> - A) \<inter> J n. 1 \<partial>\<mu>)"
               using \<kappa>'.subprob_space by(auto intro!: nn_integral_mono simp: indicator_def disintegration_space_eq(2)[OF assms(5)])
             also have "... = \<mu> ((space \<mu> - A) \<inter> J n)"
               using J by simp
             also have "... \<le> \<mu> (J n)"
               using J by (auto intro!: emeasure_mono)
             also have "... < \<infinity>"
               using J(3)[of n] by (simp add: top.not_eq_extremum)
             finally show ?thesis .
           qed
           have "(\<integral>\<^sup>+x. (\<kappa> x) {y} * indicator ((space \<mu> - A) \<inter> J n) x - (\<kappa>' x) {y} * indicator ((space \<mu> - A) \<inter> J n) x \<partial>\<mu>) = (\<integral>\<^sup>+x\<in>(space \<mu> - A) \<inter> J n. (\<kappa> x) {y} \<partial>\<mu>) - (\<integral>\<^sup>+x\<in>(space \<mu> - A) \<inter> J n. (\<kappa>' x) {y}  \<partial>\<mu>)"
             using J ninf A by(auto intro!: nn_integral_diff simp: indicator_def)
           also have "... = 0"
           proof -
             have 0: "(\<integral>\<^sup>+x\<in>(space \<mu> - A) \<inter> J n. (\<kappa>' x) {y} \<partial>\<mu>) = \<nu> (((space \<mu> - A) \<inter> J n) \<times> {y})"
               using J y sets_eq by(auto intro!: \<kappa>'.disintegrationD[OF assms(6),of "(space \<mu> - A) \<inter> J n" "{y}",symmetric])
             have [simp]: "\<nu> (((space \<mu> - A) \<inter> J n) \<times> {y}) = (\<integral>\<^sup>+x\<in>(space \<mu> - A) \<inter> J n. (\<kappa> x) {y} \<partial>\<mu>)"
               using J y sets_eq by(auto intro!: disintegrationD[OF assms(5),of "(space \<mu> - A) \<inter> J n" "{y}"])
             show ?thesis
               using ninf by (simp add: 0 diff_eq_0_iff_ennreal)
           qed
           finally have assm:"AE x in \<mu>. (\<kappa> x) {y} * indicator ((space \<mu> - A) \<inter> J n) x - (\<kappa>' x) {y} * indicator ((space \<mu> - A) \<inter> J n) x = 0"
             using J by(simp add: nn_integral_0_iff_AE)
           show "AE x\<in>(space \<mu> - A) \<inter> J n in \<mu>. (\<kappa> x) {y} = (\<kappa>' x) {y}"
           proof(rule AE_mp[OF assm])
             show "AE x in \<mu>. emeasure (\<kappa> x) {y} * indicator ((space \<mu> - A) \<inter> J n) x - emeasure (\<kappa>' x) {y} * indicator ((space \<mu> - A) \<inter> J n) x = 0 \<longrightarrow> x \<in> (space \<mu> - A) \<inter> J n \<longrightarrow> emeasure (\<kappa> x) {y} = emeasure (\<kappa>' x) {y}"
             proof -
               {
                 fix x
                 assume h: "(\<kappa> x) {y} - (\<kappa>' x) {y} = 0" "x \<in> space \<mu>" "x \<notin> A"
                 have "(\<kappa> x) {y} = (\<kappa>' x) {y}"
                   using A[OF h(2,3)] by(auto intro!: antisym ennreal_minus_eq_0[OF h(1)] simp: A_def)
               }
               thus ?thesis
                 by(auto simp: indicator_def)
             qed
           qed
         qed
         hence "AE x\<in>(space \<mu> - A) \<inter> (\<Union> (range J))in \<mu>. \<kappa> x {y} = \<kappa>' x {y}"
           by auto
         thus ?thesis
           using J(2) by auto
       qed
       show "AE x in \<mu>. \<kappa> x {y} = \<kappa>' x {y}"
         using 1 2 by(auto simp: A_def)
     qed
   qed
   show ?thesis
   proof(rule AE_mp[OF 1])
     {
       fix x
       assume x: "x \<in> space X"
         and h: "\<forall>y\<in>space Y. \<kappa> x {y} = \<kappa>' x {y}"
       have "\<kappa> x = \<kappa>' x "
         by (simp add: \<kappa>'.kernel_sets assms h kernel_sets measure_eqI_countable x)
     }
     thus " AE x in \<mu>. (\<forall>y\<in>space Y. emeasure (\<kappa> x) {y} = emeasure (\<kappa>' x) {y}) \<longrightarrow> \<kappa> x = \<kappa>' x"
       by(auto simp: sets_eq_imp_space_eq[OF sets_eq(1)])
   qed
 qed
 
 end
 
 lemma(in subprob_kernel) nu_mu_spaceY_le:
   assumes "disintegration \<nu> \<mu>" "A \<in> sets X"
   shows "\<nu> (A \<times> space Y) \<le> \<mu> A"
 proof -
   have "\<nu> (A \<times> space Y) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x (space Y)) \<partial>\<mu>)"
     using assms by(simp add: disintegration_def)
   also have "... \<le> (\<integral>\<^sup>+x\<in>A. 1 \<partial>\<mu>)"
     using assms subprob_space by(auto intro!: nn_integral_mono simp:  disintegration_space_eq) (metis dual_order.refl indicator_simps(1) indicator_simps(2) mult.commute mult_1 mult_zero_right)
   also have "... = \<mu> A"
     using assms by (simp add: disintegration_def) 
   finally show ?thesis .
 qed
 
 context prob_kernel
 begin
 
 lemma countable_disintegration_AE_unique_prob:
   assumes "countable (space Y)" and [measurable_cong]:"sets Y = Pow (space Y)"
       and "prob_kernel X Y \<kappa>'" "sigma_finite_measure \<mu>"
       and "disintegration \<nu> \<mu>" "measure_kernel.disintegration X Y \<kappa>' \<nu> \<mu>"
     shows "AE x in \<mu>. \<kappa> x = \<kappa>' x"
   by(auto intro!: countable_disintegration_AE_unique[OF assms(1,2) _ assms(4-6)] prob_kernel.subprob_kernel assms(3))
 
 end
 
 subsection \<open> Lemma 14.D.3. \<close>
 lemma(in prob_kernel) nu_mu_spaceY:
   assumes "disintegration \<nu> \<mu>" "A \<in> sets X"
   shows "\<nu> (A \<times> space Y) = \<mu> A"
 proof -
   have "\<nu> (A \<times> space Y) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x (space Y)) \<partial>\<mu>)"
     using assms by(simp add: disintegration_def)
   also have "... = (\<integral>\<^sup>+x\<in>A. 1 \<partial>\<mu>)"
     using assms by(auto intro!: nn_integral_cong simp: prob_space disintegration_space_eq)
   also have "... = \<mu> A"
     using assms by (simp add: disintegration_def) 
   finally show ?thesis .
 qed
 
 corollary(in subprob_kernel) nu_finite:
   assumes "disintegration \<nu> \<mu>" "finite_measure \<mu>"
   shows "finite_measure \<nu>"
 proof
   have "\<nu> (space \<nu>) = \<nu> (space (X \<Otimes>\<^sub>M Y))"
     using assms by(simp add: disintegration_space_eq)
   also have "... \<le> \<mu> (space \<mu>)"
     using assms by(simp add: nu_mu_spaceY_le disintegration_space_eq space_pair_measure)
   finally show "\<nu> (space \<nu>) \<noteq> \<infinity>"
     using assms(2) by (metis finite_measure.emeasure_finite infinity_ennreal_def neq_top_trans)
 qed
 
 corollary(in subprob_kernel) nu_subprob_space:
   assumes "disintegration \<nu> \<mu>" "subprob_space \<mu>"
   shows "subprob_space \<nu>"
 proof
   have "\<nu> (space \<nu>) = \<nu> (space (X \<Otimes>\<^sub>M Y))"
     using assms by(simp add: disintegration_space_eq)
   also have "... \<le> \<mu> (space \<mu>)"
     using assms by(simp add: nu_mu_spaceY_le disintegration_space_eq space_pair_measure)
   finally show "\<nu> (space \<nu>) \<le> 1"
     using assms(2) order.trans subprob_space.emeasure_space_le_1 by auto
 next
   show "space \<nu> \<noteq> {}"
     using Y_not_empty assms by(auto simp: disintegration_space_eq subprob_space_def subprob_space_axioms_def space_pair_measure)
 qed
 
 corollary(in prob_kernel) nu_prob_space:
   assumes "disintegration \<nu> \<mu>" "prob_space \<mu>"
   shows "prob_space \<nu>"
 proof
   have "\<nu> (space \<nu>) = \<nu> (space (X \<Otimes>\<^sub>M Y))"
     using assms by(simp add: disintegration_space_eq)
   also have "... = \<mu> (space \<mu>)"
     using assms by(simp add: nu_mu_spaceY disintegration_space_eq space_pair_measure)
   finally show "\<nu> (space \<nu>) = 1"
     by (simp add: assms(2) prob_space.emeasure_space_1)
 qed
 
 lemma(in subprob_kernel) nu_sigma_finite:
   assumes "disintegration \<nu> \<mu>" "sigma_finite_measure \<mu>"
   shows "sigma_finite_measure \<nu>"
 proof
   obtain A where A:"countable A" "A \<subseteq> sets \<mu>" "\<Union> A = space \<mu>" "\<forall>a\<in>A. emeasure \<mu> a \<noteq> \<infinity>"
     using assms(2) by (meson sigma_finite_measure.sigma_finite_countable)
   have "countable {a \<times> space Y |a. a \<in> A}"
     using countable_image[OF A(1),of "\<lambda>a. a \<times> space Y"]
     by (simp add: Setcompr_eq_image)
   moreover have "{a \<times> space Y |a. a \<in> A} \<subseteq> sets \<nu>"
     using A(2) assms(1) disintegration_def by auto
   moreover have "\<Union> {a \<times> space Y |a. a \<in> A} = space \<nu>"
     using assms A(3) by(simp add: disintegration_space_eq space_pair_measure) blast
   moreover have "\<forall>b\<in>{a \<times> space Y |a. a \<in> A}. emeasure \<nu> b \<noteq> \<infinity>"
     using neq_top_trans[OF _ nu_mu_spaceY_le[OF assms(1)]] A(2,4) assms disintegration_sets_eq(2) by auto
   ultimately show "\<exists>B. countable B \<and> B \<subseteq> sets \<nu> \<and> \<Union> B = space \<nu> \<and> (\<forall>b\<in>B. emeasure \<nu> b \<noteq> \<infinity>)"
     by blast
 qed
 
 subsection \<open> Theorem 14.D.4. (Measure Mixture Theorem) \<close>
 lemma(in measure_kernel) exist_nu:
   assumes "sets \<mu> = sets X"
   shows "\<exists>\<nu>. disintegration \<nu> \<mu>"
 proof -
   define \<nu> where "\<nu> = extend_measure (space X \<times> space Y) {(a, b). a \<in> sets X \<and> b \<in> sets Y} (\<lambda>(a, b). a \<times> b) (\<lambda>(a, b). \<integral>\<^sup>+x\<in>a. emeasure (\<kappa> x) b\<partial>\<mu>) "
   have 1: "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)"
   proof -
     have "sets \<nu> = sigma_sets (space X \<times> space Y) ((\<lambda>(a, b). a \<times> b) ` {(a, b). a \<in> sets X \<and> b \<in> sets Y})"
       unfolding \<nu>_def
       by(rule sets_extend_measure) (use sets.space_closed[of X] sets.space_closed[of Y] in blast)
     also have "... = sigma_sets (space X \<times> space Y) {a \<times> b |a b. a \<in> sets X \<and> b \<in> sets Y}"
       by(auto intro!: sigma_sets_eqI)
     also have "... = sets (X \<Otimes>\<^sub>M Y)"
       by(simp add: sets_pair_measure)
     finally show ?thesis .
   qed
   have 2: "\<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x B) \<partial>\<mu>)" if "A \<in> sets X" "B \<in> sets Y" for A B
   proof(rule extend_measure_caratheodory_pair[OF \<nu>_def])
     fix i j k l
     assume "i \<in> sets X \<and> j \<in> sets Y" "k \<in> sets X \<and> l \<in> sets Y" "i \<times> j = k \<times> l"
     then consider "i = k" "j = l" | "i \<times> j = {}" "k \<times> l = {}" by blast
     thus "(\<integral>\<^sup>+x\<in>i. emeasure (\<kappa> x) j \<partial>\<mu>) = (\<integral>\<^sup>+x\<in>k. emeasure (\<kappa> x) l \<partial>\<mu>)" 
       by cases auto
   next
     fix A B j k
     assume h: "\<And>n::nat. A n \<in> sets X \<and> B n \<in> sets Y" "j \<in> sets X \<and> k \<in> sets Y" "disjoint_family (\<lambda>n. A n \<times> B n)" "(\<Union>i. A i \<times> B i) = j \<times> k"
     show "(\<Sum>n. \<integral>\<^sup>+x\<in>A n. emeasure (\<kappa> x) (B n)\<partial>\<mu>) = (\<integral>\<^sup>+x\<in>j. emeasure (\<kappa> x) k\<partial>\<mu>)"
          (is "?lhs = ?rhs")
     proof -
       have "?lhs = (\<integral>\<^sup>+x. (\<Sum>n. \<kappa> x (B n) * indicator (A n) x)\<partial>\<mu>)"
       proof(rule nn_integral_suminf[symmetric])
         fix n
         have [measurable]:"(\<lambda>x. emeasure (\<kappa> x) (B n)) \<in> borel_measurable \<mu>" "indicator (A n) \<in> borel_measurable \<mu>"
           using h(1)[of n] emeasure_measurable[of "B n"] assms(1) by auto
         thus "(\<lambda>x. emeasure (\<kappa> x) (B n) * indicator (A n) x) \<in> borel_measurable \<mu>"
           by simp
       qed
       also have "... = ?rhs"
       proof(safe intro!: nn_integral_cong)
         fix x
         assume "x \<in> space \<mu>"
         consider "j = {}" | "k = {}" | "j \<noteq> {}" "k \<noteq> {}" by auto
         then show "(\<Sum>n. emeasure (\<kappa> x) (B n) * indicator (A n) x) = emeasure (\<kappa> x) k * indicator j x"
         proof cases
           case 1
           then have "\<And>n. A n \<times> B n = {}"
             using h(4) by auto
           have "emeasure (\<kappa> x) (B n) * indicator (A n) x = 0" for n
             using \<open>A n \<times> B n = {}\<close> by(auto simp: Sigma_empty_iff)
           thus ?thesis
             by(simp only: 1,simp)
         next
           case 2
           then have "\<And>n. A n \<times> B n = {}"
             using h(4) by auto
           have "emeasure (\<kappa> x) (B n) * indicator (A n) x = 0" for n
             using \<open>A n \<times> B n = {}\<close> by(auto simp: Sigma_empty_iff)
           thus ?thesis
             by(simp only: 2,simp)
         next
           case 3
           then have xinjiff:"x \<in> j \<longleftrightarrow> (\<exists>i. \<exists>y\<in>B i. (x,y) \<in> A i \<times> B i)"
             using h(4) by blast
           have bunk:"\<Union> (B ` {i. x \<in> A i}) = k" if "x \<in> j"
             using that 3 h(4) by blast
           show ?thesis
           proof(cases "x \<in> j")
             case False
             then have "\<And>n. x \<notin> A n \<or> B n = {}"
               using h(4) 3 xinjiff by auto
             have "emeasure (\<kappa> x) (B n) * indicator (A n) x = 0" for n
               using \<open>x \<notin> A n \<or> B n = {}\<close> by auto
             thus ?thesis
               by(simp only:)(simp add: False)
           next
             case True
             then have [simp]: "emeasure (\<kappa> x) k * indicator j x = emeasure (\<kappa> x) k"
               by simp
             have "(\<Sum>n. emeasure (\<kappa> x) (B n) * indicator (A n) x) = (\<Sum>n. emeasure (\<kappa> x) (if x \<in> A n then B n else {}))"
               by(auto intro!: suminf_cong)
             also have "... = emeasure (\<kappa> x) (\<Union>n. if x \<in> A n then B n else {})"
             proof(rule suminf_emeasure)
               show "disjoint_family (\<lambda>i. if x \<in> A i then B i else {})"
                 using disjoint_family_onD[OF h(3)] by (auto simp: disjoint_family_on_def)
             next
               show "range (\<lambda>i. if x \<in> A i then B i else {}) \<subseteq> sets (\<kappa> x)"
                 using h(1) kernel_sets[of x] \<open>x \<in> space \<mu>\<close> sets_eq_imp_space_eq[OF assms(1)] by auto
             qed
             also have "... = emeasure (\<kappa> x) k"
               using True by(simp add: bunk)
             finally show ?thesis by simp
           qed
         qed
       qed
       finally show ?thesis .
     qed
   qed(use that in auto)
   show ?thesis
     using 1 2 assms
     by(auto simp: disintegration_def)
 qed
 
 lemma(in subprob_kernel) exist_unique_nu_sigma_finite':
   assumes "sets \<mu> = sets X" "sigma_finite_measure \<mu>"
   shows "\<exists>!\<nu>. disintegration \<nu> \<mu>"
 proof -
   obtain \<nu> where disi: "disintegration \<nu> \<mu>"
     using exist_nu[OF assms(1)] by auto
   with assms(2) interpret sf: sigma_finite_measure \<nu>
     by(simp add: nu_sigma_finite)
   interpret \<mu>: sigma_finite_measure \<mu> by fact
   show ?thesis
   proof(rule ex1I[where a=\<nu>])
     fix \<nu>'
     assume disi':"disintegration \<nu>' \<mu>"
     show "\<nu>' = \<nu>"
     proof(rule \<mu>.sigma_finite_disjoint)
       fix A :: "nat \<Rightarrow> _"
       assume A: "range A \<subseteq> sets \<mu>" "\<Union> (range A) = space \<mu>" "\<And>i. emeasure \<mu> (A i) \<noteq> \<infinity>" "disjoint_family A"
       define B where "B \<equiv> \<lambda>i. A i \<times> space Y"
       show "\<nu>' = \<nu>"
       proof(rule measure_eqI_generator_eq[where E=" {a \<times> b|a b. a \<in> sets X \<and> b \<in> sets Y}" and A=B and \<Omega>="space X \<times> space Y"])
         show "\<And>C. C \<in> {a \<times> b |a b. a \<in> sets X \<and> b \<in> sets Y} \<Longrightarrow> emeasure \<nu>' C = emeasure \<nu> C"
              "sets \<nu>' = sigma_sets (space X \<times> space Y) {a \<times> b |a b. a \<in> sets X \<and> b \<in> sets Y}"
              "sets \<nu> = sigma_sets (space X \<times> space Y) {a \<times> b |a b. a \<in> sets X \<and> b \<in> sets Y}"
           using disi disi' by(auto simp: disintegration_def sets_pair_measure)
       next
         show "range B \<subseteq> {a \<times> b |a b. a \<in> sets X \<and> b \<in> sets Y}"
              "\<Union> (range B) = space X \<times> space Y"
           using A(1,2) by(auto simp: B_def assms(1) sets_eq_imp_space_eq[OF assms(1)])
       next
         fix i
         show "emeasure \<nu>' (B i) \<noteq> \<infinity>"
           using A(1) nu_mu_spaceY_le[OF disi',of "A i"] A(3)[of i] by(auto simp: B_def assms top.extremum_uniqueI)
       qed(simp_all add: Int_stable_pair_measure_generator pair_measure_closed)
     qed
   qed fact
 qed
 
 lemma(in subprob_kernel) exist_unique_nu_sigma_finite:
   assumes "sets \<mu> = sets X" "sigma_finite_measure \<mu>"
   shows "\<exists>!\<nu>. disintegration \<nu> \<mu> \<and> sigma_finite_measure \<nu>"
   using assms exist_unique_nu_sigma_finite' nu_sigma_finite by blast
 
 lemma(in subprob_kernel) exist_unique_nu_finite:
   assumes "sets \<mu> = sets X" "finite_measure \<mu>"
   shows "\<exists>!\<nu>. disintegration \<nu> \<mu> \<and> finite_measure \<nu>"
   using assms nu_finite finite_measure.sigma_finite_measure[OF assms(2)] exist_unique_nu_sigma_finite' by blast
 
 lemma(in subprob_kernel) exist_unique_nu_sub_prob_space:
   assumes "sets \<mu> = sets X" "subprob_space \<mu>"
   shows "\<exists>!\<nu>. disintegration \<nu> \<mu> \<and> subprob_space \<nu>"
   using assms nu_subprob_space subprob_space_imp_sigma_finite[OF assms(2)] exist_unique_nu_sigma_finite' by blast
 
 lemma(in prob_kernel) exist_unique_nu_prob_space:
   assumes "sets \<mu> = sets X" "prob_space \<mu>"
   shows "\<exists>!\<nu>. disintegration \<nu> \<mu> \<and> prob_space \<nu>"
   using assms nu_prob_space prob_space_imp_sigma_finite[OF assms(2)] exist_unique_nu_sigma_finite' by blast
 
 
 lemma(in subprob_kernel) nn_integral_fst_finite':
   assumes "f \<in> borel_measurable (X \<Otimes>\<^sub>M Y)" "disintegration \<nu> \<mu>" "finite_measure \<mu>"
   shows "(\<integral>\<^sup>+z. f z \<partial>\<nu>) = (\<integral>\<^sup>+x. \<integral>\<^sup>+y. f (x,y) \<partial>(\<kappa> x) \<partial>\<mu>)"
   using assms(1)
 proof induction
   case (cong f g)
   have "integral\<^sup>N \<nu> f = integral\<^sup>N \<nu> g"
     using cong(3) by(auto intro!: nn_integral_cong simp: disintegration_space_eq(1)[OF assms(2)])
   with cong(3) show ?case
     by(auto simp: cong(4) kernel_space disintegration_space_eq(2)[OF assms(2)] space_pair_measure intro!: nn_integral_cong)
 next
   case (set A)
   show ?case
   proof(rule sigma_sets_induct_disjoint[of "{a \<times> b|a b. a \<in> sets X \<and> b \<in> sets Y}" "space X \<times> space Y"])
     show "A \<in> sigma_sets (space X \<times> space Y) {a \<times> b |a b. a \<in> sets X \<and> b \<in> sets Y}"
       using set by(simp add: sets_pair_measure)
   next
     fix A
     assume "A \<in> {a \<times> b |a b. a \<in> sets X \<and> b \<in> sets Y}"
     then obtain a b where ab: "A = a \<times> b" "a \<in> sets X" "b \<in> sets Y"
       by auto
     with assms(2) have "integral\<^sup>N \<nu> (indicator A) = (\<integral>\<^sup>+x\<in>a. (\<kappa> x b) \<partial>\<mu>)"
       by(simp add: disintegration_def)
     also have "... = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
       by(auto simp: ab(1) indicator_times disintegration_space_eq(2)[OF assms(2)] ab(3) kernel_sets mult.commute nn_integral_cmult_indicator intro!: nn_integral_cong)
     finally show "integral\<^sup>N \<nu> (indicator A) = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x \<partial>\<mu>)" .
   next
     fix A
     assume h: "A \<in> sigma_sets (space X \<times> space Y) {a \<times> b |a b. a \<in> sets X \<and> b \<in> sets Y}" "integral\<^sup>N \<nu> (indicator A) = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
     show "integral\<^sup>N \<nu> (indicator (space X \<times> space Y - A)) = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator (space X \<times> space Y - A) (x, y) \<partial>\<kappa> x \<partial>\<mu>)" (is "?lhs = ?rhs")
     proof -
       have "?lhs = (\<integral>\<^sup>+ z. 1 - indicator A z \<partial>\<nu>)"
         by(auto intro!: nn_integral_cong simp: disintegration_space_eq(1)[OF assms(2)] space_pair_measure indicator_def)
       also have "... = (\<integral>\<^sup>+ z. 1 \<partial>\<nu>) - (\<integral>\<^sup>+ z. indicator A z \<partial>\<nu>)"
       proof(rule nn_integral_diff)
         show "integral\<^sup>N \<nu> (indicator A) \<noteq> \<infinity>"
           using h(1)[simplified sets_pair_measure[symmetric]] disintegration_sets_eq(1)[OF assms(2)] finite_measure.emeasure_finite[OF nu_finite[OF assms(2,3)]]
           by auto
       next
         show "indicator A \<in> borel_measurable \<nu>"
           using h(1)[simplified sets_pair_measure[symmetric]] disintegration_sets_eq(1)[OF assms(2)] by simp
       qed(simp_all add: indicator_def)
       also have "... = (\<integral>\<^sup>+ z. 1 \<partial>\<nu>) - (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
         by(simp add: h(2))
       also have "... = \<nu> (space X \<times> space Y) - (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
         using nn_integral_indicator[OF sets.top[of \<nu>]] by(simp add: space_pair_measure disintegration_space_eq(1)[OF assms(2)])
       also have "... = (\<integral>\<^sup>+ x. \<kappa> x (space Y) \<partial>\<mu>) - (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
       proof -
         have "\<nu> (space X \<times> space Y) = (\<integral>\<^sup>+ x. \<kappa> x (space Y) \<partial>\<mu>)"
           using assms(2) by(auto simp: disintegration_def disintegration_space_eq(2)[OF assms(2)] intro!: nn_integral_cong)
         thus ?thesis by simp
       qed
       also have "... = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator (space X \<times> space Y) (x, y) \<partial>\<kappa> x \<partial>\<mu>) - (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
       proof -
         have "(\<integral>\<^sup>+ x. \<kappa> x (space Y) \<partial>\<mu>) = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator (space X \<times> space Y) (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
           using kernel_sets by(auto intro!: nn_integral_cong simp: indicator_times disintegration_space_eq(2)[OF assms(2)] )
         thus ?thesis by simp
       qed
       also have "... = (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. indicator (space X \<times> space Y) (x, y) \<partial>\<kappa> x) - (\<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x) \<partial>\<mu>)"
       proof(rule nn_integral_diff[symmetric])
         show "(\<lambda>x. \<integral>\<^sup>+ y. indicator (space X \<times> space Y) (x, y) \<partial>\<kappa> x) \<in> borel_measurable \<mu>"
              "(\<lambda>x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x) \<in> borel_measurable \<mu>"
            by(use disintegration_sets_eq[OF assms(2)] nn_integral_measurable_f h(1)[simplified sets_pair_measure[symmetric]] in auto)+
        next
          have "(\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x \<partial>\<mu>) \<le> (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. 1 \<partial>\<kappa> x \<partial>\<mu>)"
            by(rule nn_integral_mono)+ (simp add: indicator_def)
          also have "... \<le> (\<integral>\<^sup>+ x. 1 \<partial>\<mu>)"
            by(rule nn_integral_mono) (simp add: subprob_spaces disintegration_space_eq(2)[OF assms(2)] subprob_space.subprob_emeasure_le_1)
          also have "... < \<infinity>"
            using finite_measure.emeasure_finite[OF assms(3)]
            by (simp add: top.not_eq_extremum) 
          finally show "(\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x \<partial>\<mu>) \<noteq> \<infinity>"
            by auto
        next
          have "A \<subseteq> space X \<times> space Y"
            by (metis h(1) sets.sets_into_space sets_pair_measure space_pair_measure)
          hence "\<And>x. (\<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x) \<le> (\<integral>\<^sup>+ y. indicator (space X \<times> space Y) (x, y) \<partial>\<kappa> x)"
            by(auto intro!: nn_integral_mono)
          thus "AE x in \<mu>. (\<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x) \<le> (\<integral>\<^sup>+ y. indicator (space X \<times> space Y) (x, y) \<partial>\<kappa> x)"
            by simp
        qed
        also have "... = (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. indicator (space X \<times> space Y) (x, y) - indicator A (x, y) \<partial>\<kappa> x) \<partial>\<mu>)"
        proof(intro nn_integral_cong nn_integral_diff[symmetric])
          fix x
          assume "x \<in> space \<mu>"
          then have "x \<in> space X"
            by(auto simp: disintegration_space_eq(2)[OF assms(2)])
          with kernel_sets[OF this] h(1)[simplified sets_pair_measure[symmetric]]
          show "(\<lambda>y. indicator (space X \<times> space Y) (x, y)) \<in> borel_measurable (\<kappa> x)"
               "(\<lambda>y. indicator A (x, y)) \<in> borel_measurable (\<kappa> x)"
            by auto
        next
          fix x
          assume "x \<in> space \<mu>"
          then have "x \<in> space X"
            by(auto simp: disintegration_space_eq(2)[OF assms(2)])
          have "(\<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x) \<le> (\<integral>\<^sup>+ y. 1 \<partial>\<kappa> x)"
            by(rule nn_integral_mono) (simp add: indicator_def)
          also have "... \<le> 1"
            using subprob_spaces[OF \<open>x \<in> space X\<close>] by (simp add: subprob_space.subprob_emeasure_le_1)
          also have "... < \<infinity>"
            by auto           
          finally show "(\<integral>\<^sup>+ y. indicator A (x, y) \<partial>\<kappa> x) \<noteq> \<infinity>"
            by simp
          have "A \<subseteq> space X \<times> space Y"
            by (metis h(1) sets.sets_into_space sets_pair_measure space_pair_measure)
          thus "AE y in \<kappa> x. indicator A (x, y) \<le> (indicator (space X \<times> space Y) (x, y) :: ennreal)"
            by auto
        qed
        also have "... = ?rhs"
          by(auto simp: indicator_def intro!: nn_integral_cong)
        finally show ?thesis .
      qed
    next
     fix A
     assume h:"disjoint_family A" "range A \<subseteq> sigma_sets (space X \<times> space Y) {a \<times> b |a b. a \<in> sets X \<and> b \<in> sets Y}"
               "\<And>i::nat.  integral\<^sup>N \<nu> (indicator (A i)) = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator (A i) (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
     show "integral\<^sup>N \<nu> (indicator (\<Union> (range A))) = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator (\<Union> (range A)) (x, y) \<partial>\<kappa> x \<partial>\<mu>)" (is "?lhs = ?rhs")
     proof -
       have "?lhs = (\<integral>\<^sup>+ z. (\<Sum>i. indicator (A i) z) \<partial>\<nu>)"
         by(simp add: suminf_indicator[OF h(1)])
       also have "... = (\<Sum>i. (\<integral>\<^sup>+ z. indicator (A i) z \<partial>\<nu>))" 
         by(rule nn_integral_suminf) (use disintegration_sets_eq(1)[OF assms(2)] h(2)[simplified sets_pair_measure[symmetric]] in simp)
       also have "... = (\<Sum>i. (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. indicator (A i) (x, y) \<partial>\<kappa> x \<partial>\<mu>))"
         by(simp add: h)
       also have "... = (\<integral>\<^sup>+ x. (\<Sum>i. (\<integral>\<^sup>+ y. indicator (A i) (x, y) \<partial>\<kappa> x)) \<partial>\<mu>)"
         by(rule nn_integral_suminf[symmetric]) (use h(2)[simplified sets_pair_measure[symmetric]] disintegration_sets_eq(2)[OF assms(2)] nn_integral_measurable_f in simp)       
       also have "... = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. (\<Sum>i.  indicator (A i) (x, y)) \<partial>\<kappa> x \<partial>\<mu>)"
         using h(2)[simplified sets_pair_measure[symmetric]] kernel_sets
         by(auto intro!: nn_integral_cong nn_integral_suminf[symmetric] simp: disintegration_space_eq(2)[OF assms(2)])
       also have "... = ?rhs"
         by(simp add: suminf_indicator[OF h(1)])
       finally show ?thesis .
     qed
   qed(simp_all add: Int_stable_pair_measure_generator pair_measure_closed)   
 next
   case (mult u c)
   show ?case (is "?lhs = ?rhs")
   proof -
     have "?lhs = c * (\<integral>\<^sup>+ z. u z \<partial>\<nu>)"
       using disintegration_sets_eq(1)[OF assms(2)] mult
       by(simp add: nn_integral_cmult)
     also have "... = c * ( \<integral>\<^sup>+ x. \<integral>\<^sup>+ y. u (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
       by(simp add: mult)
     also have "... = ( \<integral>\<^sup>+ x. c * (\<integral>\<^sup>+ y. u (x, y) \<partial>\<kappa> x) \<partial>\<mu>)"
       using nn_integral_measurable_f'[OF mult(2)] disintegration_sets_eq(2)[OF assms(2)]
       by(simp add: nn_integral_cmult)
     also have "... = ?rhs"
       using mult by(auto intro!: nn_integral_cong nn_integral_cmult[symmetric] simp: disintegration_space_eq(2)[OF assms(2)])
     finally show ?thesis .
   qed
 next
   case (add u v)
   show ?case (is "?lhs = ?rhs")
   proof -
     have "?lhs = (\<integral>\<^sup>+ z. v z \<partial>\<nu>) + (\<integral>\<^sup>+ z. u z \<partial>\<nu>)"
       using add disintegration_sets_eq(1)[OF assms(2)] by (simp add: nn_integral_add)
     also have "... = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. v (x, y) \<partial>\<kappa> x \<partial>\<mu>) + (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. u (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
       by(simp add: add)
     also have "... = (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. v (x, y) \<partial>\<kappa> x) + (\<integral>\<^sup>+ y. u (x, y) \<partial>\<kappa> x) \<partial>\<mu>)"
       using nn_integral_measurable_f'[OF add(1)] nn_integral_measurable_f'[OF add(3)] disintegration_sets_eq[OF assms(2)]
       by(auto intro!: nn_integral_add[symmetric])
     also have "... = (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. v (x, y) + u (x, y) \<partial>\<kappa> x) \<partial>\<mu>)"
       using add by(auto intro!: nn_integral_add[symmetric] nn_integral_cong simp: disintegration_space_eq(2)[OF assms(2)])
     finally show ?thesis .
   qed
 next
   case (seq fi)
   have "(\<integral>\<^sup>+ y. (\<Squnion> range fi) (x, y) \<partial>\<kappa> x) = (\<Squnion>i. \<integral>\<^sup>+ y. fi i (x, y) \<partial>\<kappa> x)" (is "?lhs = ?rhs") if "x \<in> space X" for x
   proof -
     have "?lhs = (\<integral>\<^sup>+ y. (\<Squnion>i. fi i (x, y)) \<partial>\<kappa> x)"
       by(metis SUP_apply)
     also have "... = ?rhs"
     proof(rule nn_integral_monotone_convergence_SUP)
       show "incseq (\<lambda>i y. fi i (x, y))"
         using seq mono_compose by blast 
     next
       fix i
       show "(\<lambda>y. fi i (x, y)) \<in> borel_measurable (\<kappa> x)"
         using seq(1)[of i] that kernel_sets[OF that] by simp
     qed
     finally show ?thesis .
   qed
   have "integral\<^sup>N \<nu> (\<Squnion> range fi) = (\<integral>\<^sup>+ x. (\<Squnion>i. fi i x) \<partial>\<nu>)"
     by (metis SUP_apply)
   also have "... = (\<Squnion>i. integral\<^sup>N \<nu> (fi i))"
     using disintegration_sets_eq(1)[OF assms(2)] seq(1,3)
     by(auto intro!: nn_integral_monotone_convergence_SUP)
   also have "... = (\<Squnion>i. \<integral>\<^sup>+ x. \<integral>\<^sup>+ y. fi i (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
     by(simp add: seq)
   also have "... = (\<integral>\<^sup>+ x. (\<Squnion>i. \<integral>\<^sup>+ y. fi i (x, y) \<partial>\<kappa> x) \<partial>\<mu>)"
   proof(safe intro!: nn_integral_monotone_convergence_SUP[symmetric])
     show "incseq (\<lambda>i x. \<integral>\<^sup>+ y. fi i (x, y) \<partial>\<kappa> x)"
       using le_funD[OF incseq_SucD[OF seq(3)]]
       by(auto intro!: incseq_SucI le_funI nn_integral_mono)
   qed(use disintegration_sets_eq(2)[OF assms(2)] nn_integral_measurable_f'[OF seq(1)] in auto)
   also have "... = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. (\<Squnion>i. fi i (x, y)) \<partial>\<kappa> x \<partial>\<mu>)"
     using kernel_sets seq(1)
     by(auto intro!: nn_integral_cong nn_integral_monotone_convergence_SUP[symmetric] simp: disintegration_space_eq(2)[OF assms(2)] mono_compose seq(3))
   also have "... = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. (\<Squnion> range fi) (x, y) \<partial>\<kappa> x \<partial>\<mu>)"
     by(auto intro!: nn_integral_cong simp: image_image)
   finally show ?case .
 qed
 
 lemma(in prob_kernel) nn_integral_fst:
   assumes "f \<in> borel_measurable (X \<Otimes>\<^sub>M Y)" "disintegration \<nu> \<mu>" "sigma_finite_measure \<mu>"
   shows "(\<integral>\<^sup>+z. f z \<partial>\<nu>) = (\<integral>\<^sup>+x. \<integral>\<^sup>+y. f (x,y) \<partial>(\<kappa> x) \<partial>\<mu>)"
 proof(rule sigma_finite_measure.sigma_finite_disjoint[OF assms(3)])
   fix A
   assume A:"range A \<subseteq> sets \<mu>" "\<Union> (range A) = space \<mu>" "\<And>i::nat. emeasure \<mu> (A i) \<noteq> \<infinity>" "disjoint_family A"
   then have A': "range (\<lambda>i. A i \<times> space Y) \<subseteq> sets \<nu>" "\<Union> (range (\<lambda>i. A i \<times> space Y)) = space \<nu>" "disjoint_family (\<lambda>i. A i \<times> space Y)"
     by(auto simp: disintegration_sets_eq[OF assms(2)] disjoint_family_on_def disintegration_space_eq[OF assms(2)] space_pair_measure) blast
   show ?thesis (is "?lhs = ?rhs")
   proof -
     have "?lhs = (\<integral>\<^sup>+z\<in>\<Union> (range (\<lambda>i. A i \<times> space Y)). f z \<partial>\<nu>)"
       using A'(2) by auto
     also have "... = (\<Sum>i. \<integral>\<^sup>+z\<in> A i \<times> space Y. f z \<partial>\<nu>)"
       using A'(1,3) assms(1) disintegration_sets_eq[OF assms(2)]
       by(auto intro!: nn_integral_disjoint_family)
     also have "... = (\<Sum>i. \<integral>\<^sup>+z. f z \<partial>restrict_space \<nu> (A i \<times> space Y))"
       using A'(1) by(auto intro!: suminf_cong nn_integral_restrict_space[symmetric])
     also have "... = (\<Sum>i. \<integral>\<^sup>+x. \<integral>\<^sup>+y. f (x,y) \<partial>(\<kappa> x) \<partial>restrict_space \<mu> (A i))"
     proof(safe intro!: suminf_cong)
       fix n
       interpret pk: prob_kernel "restrict_space X (A n)" Y \<kappa>
         by(rule restrict_probability_kernel)
       have An:"A n \<inter> space X \<in> sets X" "A n \<inter> space X = A n"
         using A(1) by(auto simp: disintegration_sets_eq[OF assms(2)])
       have f:"f \<in> borel_measurable (restrict_space X (A n) \<Otimes>\<^sub>M Y)"
       proof -
         have 1:"sets (restrict_space X (A n) \<Otimes>\<^sub>M Y) = sets (restrict_space (X \<Otimes>\<^sub>M Y) (A n \<times> space Y))"
           using sets_pair_restrict_space[where Y=Y and B="space Y"] by simp
         show ?thesis
           using assms(1) by(simp add: measurable_cong_sets[OF 1 refl] measurable_restrict_space1)
       qed
       have fin: "finite_measure (restrict_space \<mu> (A n))"
         by (metis A(1) A(3) UNIV_I emeasure_restrict_space finite_measureI image_subset_iff space_restrict_space space_restrict_space2 subset_eq)
       show "(\<integral>\<^sup>+z. f z \<partial>restrict_space \<nu> (A n \<times> space Y)) = (\<integral>\<^sup>+x. \<integral>\<^sup>+y. f (x,y) \<partial>(\<kappa> x) \<partial>restrict_space \<mu> (A n))"
         by(rule pk.nn_integral_fst_finite'[OF f disintegration_restrict_space[OF assms(2) An(1)] fin])
     qed
     also have "... = (\<Sum>i. \<integral>\<^sup>+x\<in>A i. \<integral>\<^sup>+y. f (x,y) \<partial>(\<kappa> x) \<partial>\<mu>)"
       using A(1) by(auto intro!: suminf_cong nn_integral_restrict_space)
     also have "... = (\<integral>\<^sup>+x\<in>\<Union> (range A). \<integral>\<^sup>+y. f (x,y) \<partial>(\<kappa> x) \<partial>\<mu>)"
       using A(1,4) nn_integral_measurable_f'[OF assms(1)] disintegration_sets_eq[OF assms(2)]
       by(auto intro!: nn_integral_disjoint_family[symmetric])
     also have "... = ?rhs"
       using A(2) by simp
     finally show ?thesis .
   qed
 qed
 
 lemma(in prob_kernel) integrable_eq1:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes [measurable]:"f \<in> borel_measurable (X \<Otimes>\<^sub>M Y)"
       and "disintegration \<nu> \<mu>" "sigma_finite_measure \<mu>"
     shows "(\<integral>\<^sup>+ z. ennreal (norm (f z)) \<partial>\<nu>) < \<infinity> \<longleftrightarrow> (\<integral>\<^sup>+x. \<integral>\<^sup>+y. ennreal (norm (f (x,y))) \<partial>(\<kappa> x) \<partial>\<mu>) < \<infinity>"
   by(simp add: nn_integral_fst[OF _ assms(2,3)])
 
 lemma(in prob_kernel) integrable_kernel_integrable:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes "integrable \<nu> f" "disintegration \<nu> \<mu>" "sigma_finite_measure \<mu>"
   shows "AE x in \<mu>. integrable (\<kappa> x) (\<lambda>y. f (x,y))"
 proof -
   have [measurable]:"f \<in> borel_measurable (X \<Otimes>\<^sub>M Y)"
     using integrable_iff_bounded assms(1) disintegration_sets_eq[OF assms(2)] by simp
   show ?thesis
     unfolding integrable_iff_bounded
   proof -
     have 1:"(\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. ennreal (norm (f (x,y))) \<partial>\<kappa> x \<partial>\<mu>) < \<infinity>"
       using assms(1) integrable_eq1[OF _ assms(2,3),of f] by(simp add: integrable_iff_bounded)
     have "AE x in \<mu>. (\<integral>\<^sup>+ y. ennreal (norm (f (x,y))) \<partial>\<kappa> x) \<noteq> \<infinity>"
       by(rule nn_integral_PInf_AE) (use 1 disintegration_sets_eq[OF assms(2)] nn_integral_measurable_f in auto)
     thus "AE x in \<mu>. (\<lambda>y. f (x, y)) \<in> borel_measurable (\<kappa> x) \<and> (\<integral>\<^sup>+ y. ennreal (norm (f (x,y))) \<partial>\<kappa> x) < \<infinity>"
       using top.not_eq_extremum by(fastforce simp: disintegration_space_eq[OF assms(2)])
   qed
 qed
 
 lemma(in prob_kernel) integrable_lebesgue_integral_integrable':
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes "integrable \<nu> f" "disintegration \<nu> \<mu>" "sigma_finite_measure \<mu>"
   shows "integrable \<mu> (\<lambda>x. \<integral>y. f (x,y) \<partial>(\<kappa> x))"
   unfolding integrable_iff_bounded
 proof
   show "(\<lambda>x. \<integral>y. f (x,y) \<partial>(\<kappa> x)) \<in> borel_measurable \<mu>"
     using disintegration_sets_eq[OF assms(2)] assms(1) integral_measurable_f'[of f]
     by(auto simp: integrable_iff_bounded)
 next
   have "(\<integral>\<^sup>+ x. ennreal (norm (\<integral>y. f (x,y) \<partial>(\<kappa> x))) \<partial>\<mu>) \<le> (\<integral>\<^sup>+ x. \<integral>\<^sup>+y. ennreal (norm (f (x,y))) \<partial>(\<kappa> x) \<partial>\<mu>)"
     using integral_norm_bound_ennreal integrable_kernel_integrable[OF assms]
     by(auto intro!: nn_integral_mono_AE)
   also have "... < \<infinity>"
     using integrable_eq1[OF _ assms(2,3),of f] assms(1) disintegration_sets_eq[OF assms(2)]
     by(simp add: integrable_iff_bounded)
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (\<integral>y. f (x,y) \<partial>(\<kappa> x))) \<partial>\<mu>) < \<infinity>" .
 qed
 
 lemma(in prob_kernel) integrable_lebesgue_integral_integrable:
   fixes f :: "_ \<Rightarrow>_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes "integrable \<nu> (\<lambda>(x,y). f x y)" "disintegration \<nu> \<mu>" "sigma_finite_measure \<mu>"
   shows "integrable \<mu> (\<lambda>x. \<integral>y. f x y \<partial>(\<kappa> x))"
   using integrable_lebesgue_integral_integrable'[OF assms] by simp
 
 lemma(in prob_kernel) integral_fst:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes "integrable \<nu> f" "disintegration \<nu> \<mu>" "sigma_finite_measure \<mu>"
   shows "(\<integral>z. f z \<partial>\<nu>) = (\<integral>x. \<integral>y. f (x,y) \<partial>(\<kappa> x) \<partial>\<mu>)"
   using assms(1)
 proof induct
   case b:(base A c)
   then have 0:"integrable \<nu> (indicat_real A)"
     by blast
   then have 1[measurable]: "indicat_real A \<in> borel_measurable  (X \<Otimes>\<^sub>M Y)"
     using disintegration_sets_eq[OF assms(2)] by auto
   have eq:"(\<integral>z. indicat_real A z \<partial>\<nu>) = (\<integral>x. \<integral>y. indicat_real A (x,y) \<partial>\<kappa> x \<partial>\<mu>)" (is "?lhs = ?rhs")
   proof -
     have "?lhs = enn2real (\<integral>\<^sup>+ z. ennreal (indicat_real A z) \<partial>\<nu>)"
       by(rule integral_eq_nn_integral) (use b in auto)
     also have "... = enn2real (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. ennreal (indicat_real A (x,y)) \<partial>\<kappa> x \<partial>\<mu>)"
       using nn_integral_fst[OF _ assms(2,3)] b disintegration_sets_eq[OF assms(2)] by auto
     also have "... = enn2real (\<integral>\<^sup>+ x. ennreal (\<integral> y. indicat_real A (x,y) \<partial>\<kappa> x) \<partial>\<mu>)"
     proof -
       have "(\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. ennreal (indicat_real A (x,y)) \<partial>\<kappa> x \<partial>\<mu>) = (\<integral>\<^sup>+ x. ennreal (\<integral> y. indicat_real A (x,y) \<partial>\<kappa> x) \<partial>\<mu>)"
      proof(safe intro!: nn_integral_cong nn_integral_eq_integral)
         fix x
         assume "x \<in> space \<mu>"
         then have "x \<in> space X"
           by(simp add:  disintegration_space_eq[OF assms(2)])
         hence [simp]:"prob_space (\<kappa> x)" "sets (\<kappa> x) = sets Y" "space (\<kappa> x) = space Y"
           by(auto intro!: prob_spaces sets_eq_imp_space_eq kernel_sets)
         have [simp]:"{y. (x, y) \<in> A} \<in> sets Y"
         proof -
           have "{y. (x, y) \<in> A} = (\<lambda>y. (x,y)) -` A \<inter> space Y"
             using b(1)[simplified disintegration_sets_eq[OF assms(2)]]
             by auto
           also have "... \<in> sets Y"
             using b(1)[simplified disintegration_sets_eq[OF assms(2)]] \<open>x \<in> space X\<close>
             by auto
           finally show ?thesis .
         qed
         have [simp]: "(\<lambda>y. indicat_real A (x, y)) = indicat_real {y. (x,y) \<in> A}"
           by (auto simp: indicator_def)
         show "integrable (\<kappa> x) (\<lambda>y. indicat_real A (x, y))"
           using prob_space.emeasure_le_1[of "\<kappa> x" "{y. (x, y) \<in> A}"]
           by(auto simp add: integrable_indicator_iff order_le_less_trans)
       qed simp
       thus ?thesis by simp
     qed
     also have "... = ?rhs"
       using disintegration_sets_eq[OF assms(2)] integral_measurable_f'[OF 1]
       by(auto intro!: integral_eq_nn_integral[symmetric])
     finally show ?thesis .
   qed
   show ?case (is "?lhs = ?rhs")
   proof -
     have "?lhs = (\<integral>z. indicat_real A z \<partial>\<nu>) *\<^sub>R c"
       using 0 by auto
     also have "... = (\<integral>x. \<integral>y. indicat_real A (x,y) \<partial>\<kappa> x \<partial>\<mu>) *\<^sub>R c"
       by(simp only: eq)
     also have "... = (\<integral>x. (\<integral>y. indicat_real A (x,y) \<partial>\<kappa> x) *\<^sub>R c \<partial>\<mu>)"
       using integrable_lebesgue_integral_integrable'[OF 0 assms(2,3)]
       by(auto intro!: integral_scaleR_left[symmetric])
     also have "... = ?rhs"
       using integrable_kernel_integrable[OF 0 assms(2,3)] integral_measurable_f'[of " indicat_real A"] integral_measurable_f'[of "\<lambda>z. indicat_real A z *\<^sub>R c"] disintegration_sets_eq[OF assms(2)]
       by(auto intro!: integral_cong_AE)
     finally show ?thesis .
   qed
 next
   case fg:(add f g)
   note [measurable] = integrable_lebesgue_integral_integrable'[OF fg(1) assms(2,3)] integrable_lebesgue_integral_integrable'[OF fg(3) assms(2,3)] integrable_lebesgue_integral_integrable'[OF Bochner_Integration.integrable_add[OF fg(1,3)] assms(2,3)]
   show ?case (is "?lhs = ?rhs")
   proof -
     have "?lhs = (\<integral>x. (\<integral>y. f (x,y) \<partial>(\<kappa> x)) + (\<integral>y. g (x,y) \<partial>(\<kappa> x)) \<partial>\<mu>)"
       by(simp add: Bochner_Integration.integral_add[OF fg(1,3)] fg Bochner_Integration.integral_add[OF integrable_lebesgue_integral_integrable'[OF fg(1) assms(2,3)] integrable_lebesgue_integral_integrable'[OF fg(3) assms(2,3)]])
     also have "... = ?rhs"
       using integrable_kernel_integrable[OF fg(1) assms(2,3)] integrable_kernel_integrable[OF fg(3) assms(2,3)]
       by(auto intro!: integral_cong_AE)
     finally show ?thesis .
   qed
 next
   case (lim f s)
   then have [measurable]: "f \<in> borel_measurable \<nu>" "\<And>i. s i \<in> borel_measurable \<nu>"
     by auto
   show ?case
   proof (rule LIMSEQ_unique)
     show "(\<lambda>i. integral\<^sup>L \<nu> (s i)) \<longlonglongrightarrow> integral\<^sup>L \<nu> f"
     proof (rule integral_dominated_convergence)
       show "integrable \<nu> (\<lambda>x. 2 * norm (f x))"
         using lim(5) by auto
     qed(use lim in auto)
   next
     have "(\<lambda>i. \<integral> x. \<integral> y. s i (x, y) \<partial>(\<kappa> x) \<partial>\<mu>) \<longlonglongrightarrow> \<integral> x. \<integral> y. f (x, y) \<partial>(\<kappa> x) \<partial>\<mu>"
     proof (rule integral_dominated_convergence)
      have "AE x in \<mu>. \<forall>i. integrable (\<kappa> x) (\<lambda>y. s i (x, y))"
         unfolding AE_all_countable using integrable_kernel_integrable[OF lim(1) assms(2,3)] ..
       with AE_space integrable_kernel_integrable[OF lim(5) assms(2,3)]
       show "AE x in \<mu>. (\<lambda>i. \<integral> y. s i (x, y) \<partial>(\<kappa> x)) \<longlonglongrightarrow> \<integral> y. f (x, y) \<partial>(\<kappa> x)"
       proof eventually_elim
         fix x assume x: "x \<in> space \<mu>" and
           s: "\<forall>i. integrable (\<kappa> x) (\<lambda>y. s i (x, y))" and f: "integrable (\<kappa> x) (\<lambda>y. f (x, y))"
         show "(\<lambda>i. \<integral> y. s i (x, y) \<partial>(\<kappa> x)) \<longlonglongrightarrow> \<integral> y. f (x, y) \<partial>(\<kappa> x)"
         proof (rule integral_dominated_convergence)
           show "integrable (\<kappa> x) (\<lambda>y. 2 * norm (f (x, y)))"
              using f by auto
           show "AE xa in (\<kappa> x). (\<lambda>i. s i (x, xa)) \<longlonglongrightarrow> f (x, xa)"
             using x lim(3) kernel_space by (auto simp: space_pair_measure disintegration_space_eq[OF assms(2)])
           show "\<And>i. AE xa in (\<kappa> x). norm (s i (x, xa)) \<le> 2 * norm (f (x, xa))"
             using x lim(4) kernel_space by (auto simp: space_pair_measure disintegration_space_eq[OF assms(2)])
         qed (use x disintegration_sets_eq[OF assms(2)] disintegration_space_eq[OF assms(2)] in auto)
       qed
     next
       show "integrable \<mu> (\<lambda>x. (\<integral> y. 2 * norm (f (x, y)) \<partial>(\<kappa> x)))"
         using integrable_lebesgue_integral_integrable'[OF _ assms(2,3),of "\<lambda>z. 2 * norm (f (fst z, snd z))"] lim(5)
         by auto
     next
       fix i show "AE x in \<mu>. norm (\<integral> y. s i (x, y) \<partial>(\<kappa> x)) \<le> (\<integral> y. 2 * norm (f (x, y)) \<partial>(\<kappa> x))"
         using AE_space integrable_kernel_integrable[OF lim(1) assms(2,3),of i] integrable_kernel_integrable[OF lim(5) assms(2,3)]
       proof eventually_elim
         case sf:(elim x)
        from sf(2) have "norm (\<integral> y. s i (x, y) \<partial>(\<kappa> x)) \<le> (\<integral>\<^sup>+y. norm (s i (x, y)) \<partial>(\<kappa> x))"
           by (rule integral_norm_bound_ennreal)
         also have "\<dots> \<le> (\<integral>\<^sup>+y. 2 * norm (f (x, y)) \<partial>(\<kappa> x))"
           using sf lim kernel_space by (auto intro!: nn_integral_mono simp: space_pair_measure disintegration_space_eq[OF assms(2)])
         also have "\<dots> = (\<integral>y. 2 * norm (f (x, y)) \<partial>(\<kappa> x))"
           using sf by (intro nn_integral_eq_integral) auto
         finally show "norm (\<integral> y. s i (x, y) \<partial>(\<kappa> x)) \<le> (\<integral> y. 2 * norm (f (x, y)) \<partial>(\<kappa> x))"
           by simp
       qed
     qed(use integrable_lebesgue_integral_integrable'[OF lim(1) assms(2,3)] integrable_lebesgue_integral_integrable'[OF lim(5) assms(2,3)] disintegration_sets_eq[OF assms(2)] in auto)
     then show "(\<lambda>i. integral\<^sup>L \<nu> (s i)) \<longlonglongrightarrow> \<integral> x. \<integral> y. f (x, y) \<partial>(\<kappa> x) \<partial>\<mu>"
       using lim by simp
   qed
 qed
 
 subsection \<open> Marginal Measure \<close>
 definition marginal_measure_on :: "['a measure, 'b measure, ('a \<times> 'b) measure, 'b set] \<Rightarrow> 'a measure" where
 "marginal_measure_on X Y \<nu> B = measure_of (space X) (sets X) (\<lambda>A. \<nu> (A \<times> B))"
 
 abbreviation marginal_measure :: "['a measure, 'b measure, ('a \<times> 'b) measure] \<Rightarrow> 'a measure" where
 "marginal_measure X Y \<nu> \<equiv> marginal_measure_on X Y \<nu> (space Y)"
 
 lemma space_marginal_measure: "space (marginal_measure_on X Y \<nu> B) = space X"
   and sets_marginal_measure: "sets (marginal_measure_on X Y \<nu> B) = sets X"
   by(simp_all add: marginal_measure_on_def)
 
 lemma emeasure_marginal_measure_on:
   assumes "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "B \<in> sets Y" "A \<in> sets X"
   shows "marginal_measure_on X Y \<nu> B A = \<nu> (A \<times> B)"
   unfolding marginal_measure_on_def
 proof(rule emeasure_measure_of_sigma)
   show "countably_additive (sets X) (\<lambda>A. emeasure \<nu> (A \<times> B))"
   proof(rule countably_additiveI)
     fix A :: "nat \<Rightarrow> _"
     assume h:"range A \<subseteq> sets X" "disjoint_family A" "\<Union> (range A) \<in> sets X"
     have [simp]: "(\<Union>i. A i \<times> B) = (\<Union> (range A) \<times> B)"
       by blast
     have "range (\<lambda>i. A i \<times> B) \<subseteq> sets \<nu>" "disjoint_family (\<lambda>i. A i \<times> B)"
       using h assms(1,2) by(auto simp: disjoint_family_on_def)
     from suminf_emeasure[OF this]
     show " (\<Sum>i. \<nu> (A i \<times> B)) = \<nu> (\<Union> (range A) \<times> B)"
       by simp
   qed
 qed(insert assms, auto simp: positive_def sets.sigma_algebra_axioms)
 
 lemma emeasure_marginal_measure:
   assumes "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "A \<in> sets X"
   shows "marginal_measure X Y \<nu> A = \<nu> (A \<times> space Y)"
   using emeasure_marginal_measure_on[OF assms(1) _ assms(2)] by simp
 
 lemma finite_measure_marginal_measure_on_finite:
   assumes "finite_measure \<nu>" "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "B \<in> sets Y"
   shows "finite_measure (marginal_measure_on X Y \<nu> B)"
   by (simp add: assms emeasure_marginal_measure_on finite_measure.emeasure_finite finite_measureI space_marginal_measure)
 
 lemma finite_measure_marginal_measure_finite:
   assumes "finite_measure \<nu>" "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)"
   shows "finite_measure (marginal_measure X Y \<nu>)"
   by(rule finite_measure_marginal_measure_on_finite[OF assms sets.top])
 
 lemma marginal_measure_restrict_space:
   assumes "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "B \<in> sets Y"
   shows "marginal_measure X (restrict_space Y B) (restrict_space \<nu> (space X \<times> B)) = marginal_measure_on X Y \<nu> B"
 proof(rule measure_eqI)
   fix A
   assume "A \<in> sets (marginal_measure X (restrict_space Y B) (restrict_space \<nu> (space X \<times> B)))"
   then have "A \<in> sets X"
     by(simp add: sets_marginal_measure)
   have 1:"sets (restrict_space \<nu> (space X \<times> B)) = sets (X \<Otimes>\<^sub>M restrict_space Y B)"
     by (metis assms(1) restrict_space_space sets_pair_restrict_space sets_restrict_space_cong)
   show "emeasure (marginal_measure X (restrict_space Y B) (restrict_space \<nu> (space X \<times> B))) A = emeasure (marginal_measure_on X Y \<nu> B) A"
     apply(simp add: emeasure_marginal_measure_on[OF assms(1) assms(2) \<open>A \<in> sets X\<close>] emeasure_marginal_measure[OF 1  \<open>A \<in> sets X\<close>])
     apply(simp add: space_restrict_space)
     by (metis Sigma_cong Sigma_mono \<open>A \<in> sets X\<close> assms(1) assms(2) emeasure_restrict_space inf_le1 pair_measureI sets.Int_space_eq2 sets.sets_into_space sets.top)
 qed(simp add: sets_marginal_measure)
 
 lemma restrict_space_marginal_measure_on:
   assumes "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "B \<in> sets Y" "A \<in> sets X"
   shows "restrict_space (marginal_measure_on X Y \<nu> B) A = marginal_measure_on (restrict_space X A) Y (restrict_space \<nu> (A \<times> space Y)) B"
 proof(rule measure_eqI)
   fix A'
   assume "A' \<in> sets (restrict_space (marginal_measure_on X Y \<nu> B) A)"
   then have h:"A' \<in> sets.restricted_space X A"
     by(simp add: sets_marginal_measure sets_restrict_space)
   show "emeasure (restrict_space (marginal_measure_on X Y \<nu> B) A) A' = emeasure (marginal_measure_on (restrict_space X A) Y (restrict_space \<nu> (A \<times> space Y)) B) A'" (is "?lhs = ?rhs")
   proof -
     have 1:"sets (restrict_space \<nu> (A \<times> space Y)) = sets (restrict_space X A \<Otimes>\<^sub>M Y)"
       by (metis assms(1) restrict_space_space sets_pair_restrict_space sets_restrict_space_cong)
     have "?lhs = emeasure (marginal_measure_on X Y \<nu> B) A'"
       using h by(auto intro!: emeasure_restrict_space simp: space_marginal_measure sets_marginal_measure assms)
     also have "... = \<nu> (A' \<times> B)"
       using emeasure_marginal_measure_on[OF assms(1,2),of A'] h assms(3) by auto
     also have "... = restrict_space \<nu> (A \<times> space Y) (A' \<times> B)"
       using h assms sets.sets_into_space
       by(auto intro!: emeasure_restrict_space[symmetric])
     also have "... = ?rhs"
       using emeasure_marginal_measure_on[OF 1 assms(2),simplified sets_restrict_space,OF h] ..
     finally show ?thesis .
   qed
 qed(simp add: sets_marginal_measure sets_restrict_space)
 
 lemma restrict_space_marginal_measure:
   assumes "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "A \<in> sets X"
   shows "restrict_space (marginal_measure X Y \<nu>) A = marginal_measure (restrict_space X A) Y (restrict_space \<nu> (A \<times> space Y))"
   using restrict_space_marginal_measure_on[OF assms(1) _ assms(2)] by simp
 
 lemma marginal_measure_mono:
   assumes "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "A \<in> sets Y" "B \<in> sets Y" "A \<subseteq> B"
   shows "emeasure (marginal_measure_on X Y \<nu> A) \<le> emeasure (marginal_measure_on X Y \<nu> B)"
 proof(rule le_funI)
   fix U
   show "emeasure (marginal_measure_on X Y \<nu> A) U \<le> emeasure (marginal_measure_on X Y \<nu> B) U"
   proof -
     have 1:"U \<times> A \<subseteq> U \<times> B" using assms(4) by auto
     show ?thesis
     proof(cases "U \<in> sets X")
       case True
       then show ?thesis
         by (simp add: "1" assms emeasure_marginal_measure_on emeasure_mono) 
     next
       case False
       then show ?thesis
         by (simp add: emeasure_notin_sets sets_marginal_measure)
     qed
   qed
 qed
 
 lemma marginal_measure_absolutely_countinuous:
   assumes "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "A \<in> sets Y" "B \<in> sets Y" "A \<subseteq> B"
   shows "absolutely_continuous (marginal_measure_on X Y \<nu> B) (marginal_measure_on X Y \<nu> A)"
   using emeasure_marginal_measure[OF assms(1)] assms(2,3) le_funD[OF marginal_measure_mono[OF assms]]
   by(auto intro!: mono_absolutely_continuous simp: sets_marginal_measure)
 
 lemma marginal_measure_absolutely_continuous':
   assumes "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)" "A \<in> sets Y"
   shows "absolutely_continuous (marginal_measure X Y \<nu>) (marginal_measure_on X Y \<nu> A)"
   by(rule marginal_measure_absolutely_countinuous[OF assms sets.top sets.sets_into_space[OF assms(2)]])
 
 subsection \<open> Lemma 14.D.6. \<close>
 locale sigma_finite_measure_on_pair =
   fixes X :: "'a measure" and Y :: "'b measure" and \<nu> :: "('a \<times> 'b) measure"
   assumes nu_sets[measurable_cong]: "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)"
       and sigma_finite: "sigma_finite_measure \<nu>"
 begin
 
 abbreviation "\<nu>x \<equiv> marginal_measure X Y \<nu>"
 
 end
 
 locale projection_sigma_finite =
   fixes X :: "'a measure" and Y :: "'b measure" and \<nu> :: "('a \<times> 'b) measure"
   assumes nu_sets[measurable_cong]: "sets \<nu> = sets (X \<Otimes>\<^sub>M Y)"
       and marginal_sigma_finite: "sigma_finite_measure (marginal_measure X Y \<nu>)"
 begin
 
 sublocale \<nu>x : sigma_finite_measure "marginal_measure X Y \<nu>"
   by(rule marginal_sigma_finite)
 
 lemma \<nu>_sigma_finite: "sigma_finite_measure \<nu>"
 proof(rule \<nu>x.sigma_finite[simplified sets_marginal_measure space_marginal_measure])
   fix A :: "nat \<Rightarrow> _"
   assume A: "range A \<subseteq> sets X" "\<Union> (range A) = space X" "\<And>i. marginal_measure X Y \<nu> (A i) \<noteq> \<infinity>"
   define C where "C \<equiv> range (\<lambda>n. A n \<times> space Y)"
   have 1:"C \<subseteq> sets \<nu>" "countable C" "\<Union> C = space \<nu>"
     using nu_sets A(1,2) by(auto simp: C_def sets_eq_imp_space_eq[OF nu_sets] space_pair_measure)
   show "sigma_finite_measure \<nu>"
     unfolding sigma_finite_measure_def
   proof(safe intro!: exI[where x=C,simplified C_def])
     fix n
     assume "\<nu> (A n \<times> space Y) = \<infinity>"
     moreover have "\<nu> (A n \<times> space Y) \<noteq> \<infinity>"
       using A(3)[of n] emeasure_marginal_measure[OF nu_sets,of "A n"] A(1) by auto
     ultimately show False by auto
   qed (use 1 C_def in auto)
 qed
 
 sublocale sigma_finite_measure_on_pair
   using \<nu>_sigma_finite by(auto simp: sigma_finite_measure_on_pair_def nu_sets)
 
 definition \<kappa>' :: "'a \<Rightarrow> 'b set \<Rightarrow> ennreal" where
  "\<kappa>' x B \<equiv> RN_deriv \<nu>x (marginal_measure_on X Y \<nu> B) x"
 (* Notice that \<kappa>' has the type "'a \<Rightarrow> 'b set \<Rightarrow> ennreal" not "'a \<Rightarrow> 'b measure"
    because \<kappa>' x is not a measure in general. *)
 
 lemma kernel_measurable[measurable]:
  "(\<lambda>x. RN_deriv (marginal_measure X Y \<nu>) (marginal_measure_on X Y \<nu> B) x) \<in> borel_measurable \<nu>x"
   by simp
 
 corollary \<kappa>'_measurable[measurable]:
  "(\<lambda>x. \<kappa>' x B) \<in> borel_measurable X"
   using sets_marginal_measure[of X Y \<nu> "space Y"] by(auto simp: \<kappa>'_def)
 
 lemma kernel_RN_deriv:
   assumes "A \<in> sets X" "B \<in> sets Y"
   shows "\<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. \<kappa>' x B \<partial>\<nu>x)"
   unfolding \<kappa>'_def
 proof -
   have "emeasure \<nu> (A \<times> B) = emeasure (density \<nu>x (RN_deriv \<nu>x (marginal_measure_on X Y \<nu> B))) A"
     by (simp add: \<nu>x.density_RN_deriv assms emeasure_marginal_measure_on marginal_measure_absolutely_continuous' nu_sets sets_marginal_measure)
   then show "emeasure \<nu> (A \<times> B) = set_nn_integral \<nu>x A (RN_deriv \<nu>x (marginal_measure_on X Y \<nu> B))"
     by (simp add: assms(1) emeasure_density sets_marginal_measure)
 qed
 
 lemma empty_Y_bot:
   assumes "space Y = {}"
   shows "\<nu> = \<bottom>"
 proof -
   have "sets \<nu> = {{}}"
     using nu_sets space_empty_iff[of "X \<Otimes>\<^sub>M Y",simplified space_pair_measure] assms
     by simp
   thus ?thesis
     by(simp add: sets_eq_bot)
 qed
 
 lemma empty_Y_nux:
   assumes "space Y = {}"
   shows "\<nu>x A = 0"
 proof(cases "A \<in> sets X")
   case True
   from emeasure_marginal_measure[OF nu_sets this]
   show ?thesis
     by(simp add: assms)
 next
   case False
   with sets_marginal_measure[of X Y \<nu> "space Y"]
   show ?thesis 
     by(auto intro!: emeasure_notin_sets)
 qed
 
 lemma kernel_empty0_AE:
   "AE x in \<nu>x. \<kappa>' x {} = 0"
   unfolding \<kappa>'_def by(rule AE_symmetric[OF \<nu>x.RN_deriv_unique]) (auto intro!: measure_eqI simp: sets_marginal_measure emeasure_density emeasure_marginal_measure_on[OF nu_sets])
 
 lemma kernel_Y1_AE:
   "AE x in \<nu>x. \<kappa>' x (space Y) = 1"
   unfolding \<kappa>'_def by(rule AE_symmetric[OF \<nu>x.RN_deriv_unique]) (auto intro!: measure_eqI simp: emeasure_density)
 
 lemma kernel_suminf_AE:
   assumes "disjoint_family F"
       and "\<And>i. F i \<in> sets Y"
     shows "AE x in \<nu>x. (\<Sum>i.  \<kappa>' x (F i)) = \<kappa>' x (\<Union> (range F))"
   unfolding \<kappa>'_def
 proof(rule \<nu>x.RN_deriv_unique)
   show "density \<nu>x (\<lambda>x. \<Sum>i. RN_deriv local.\<nu>x (marginal_measure_on X Y \<nu> (F i)) x) = marginal_measure_on X Y \<nu> (\<Union> (range F))"
   proof(rule measure_eqI)
     fix A
     assume [measurable]:"A \<in> sets (density \<nu>x (\<lambda>x. \<Sum>i. RN_deriv \<nu>x (marginal_measure_on X Y \<nu> (F i)) x))"
     then have [measurable]:"A \<in> sets \<nu>x" "A \<in> sets X" by(auto simp: sets_marginal_measure)
     show "(density \<nu>x (\<lambda>x. \<Sum>i. RN_deriv \<nu>x (marginal_measure_on X Y \<nu> (F i)) x)) A = (marginal_measure_on X Y \<nu> (\<Union> (range F))) A"
          (is "?lhs = ?rhs")
     proof -
       have "?lhs = (\<integral>\<^sup>+x\<in>A. (\<Sum>i. RN_deriv \<nu>x (marginal_measure_on X Y \<nu> (F i)) x)\<partial>\<nu>x)"
         by(auto intro!: emeasure_density)
       also have "... = (\<integral>\<^sup>+x. (\<Sum>i. RN_deriv \<nu>x (marginal_measure_on X Y \<nu> (F i)) x * indicator A x)\<partial>\<nu>x)"
         by simp
       also have "... = (\<Sum>i. (\<integral>\<^sup>+x\<in>A. RN_deriv \<nu>x (marginal_measure_on X Y \<nu> (F i)) x \<partial>\<nu>x))"
         by(rule nn_integral_suminf) auto
       also have "... = (\<Sum>i. \<nu> (A \<times> F i))"
         using kernel_RN_deriv[of A "F _"] assms by(auto intro!: suminf_cong simp: \<kappa>'_def)
       also have "... = \<nu> (\<Union>i. A \<times> F i)"
         using assms nu_sets by(fastforce intro!: suminf_emeasure simp: disjoint_family_on_def)
       also have "... = \<nu> (A \<times> (\<Union>i. F i))"
       proof -
         have "(\<Union>i. A \<times> F i) = (A \<times> (\<Union>i. F i))" by blast
         thus ?thesis by simp
       qed
       also have "... = ?rhs"
         using nu_sets assms by(auto intro!: emeasure_marginal_measure_on[symmetric])
       finally show ?thesis .
     qed
   qed(simp add: sets_marginal_measure)
 qed auto
 
 lemma kernel_finite_sum_AE:
   assumes "disjoint_family_on F S" "finite S"
       and "\<And>i. i \<in> S \<Longrightarrow> F i \<in> sets Y"
     shows "AE x in \<nu>x. (\<Sum>i\<in>S. \<kappa>' x (F i)) = \<kappa>' x (\<Union>i\<in>S. F i)"
 proof -
   consider "S = {}" | "S \<noteq> {}" by auto
   then show ?thesis
   proof cases
     case 1
     then show ?thesis
       by(simp add: kernel_empty0_AE)
   next
     case S:2
     define F' where "F' \<equiv> (\<lambda>n. if n < card S then F (from_nat_into S n) else {})"
     have F'[simp]:"\<And>i. F' i \<in> sets Y"
       using assms(3)
       by (metis F'_def bot.extremum_strict bot_nat_def card.empty from_nat_into sets.empty_sets)
     have F'_disj: "disjoint_family F'"
       unfolding disjoint_family_on_def
     proof safe
       fix m n x
       assume h:"m \<noteq> n" "x \<in> F' m" "x \<in> F' n"
       consider "n < card S" "m < card S" | "n \<ge> card S" | "m \<ge> card S" by arith
       then show "x \<in> {}"
       proof cases
         case 1
         then have "S \<noteq> {}"
           by auto
         with 1 have "from_nat_into S n \<in> S" "from_nat_into S m \<in> S"
           using from_nat_into[of S ] by blast+
         moreover have "from_nat_into S n \<noteq> from_nat_into S m"
           by (metis "1"(1) "1"(2) assms(2) bij_betw_def h(1) lessThan_iff to_nat_on_finite to_nat_on_from_nat_into)
         ultimately show ?thesis
           using h assms(1) 1 by(auto simp: disjoint_family_on_def F'_def)
       qed(use h F'_def in simp_all)
     qed
     have 1:"(\<Sum>i\<in>S. \<kappa>' x (F i)) = (\<Sum>i<card S. \<kappa>' x (F' i))" for x
       unfolding F'_def by auto (metis (no_types, lifting) sum.card_from_nat_into sum.cong)
     have 2: "(\<Union> (range F')) = (\<Union>i\<in>S. F i)"
     proof safe
       fix x n
       assume h:"x \<in> F' n"
       then have "S \<noteq> {}" "n < card S"
         by(auto simp: F'_def) (meson empty_iff)
       with h show "x \<in> \<Union> (F ` S)"
         by(auto intro!: exI[where x="from_nat_into S n"] simp: F'_def from_nat_into \<open>S \<noteq> {}\<close>)
     next
       fix x s
       assume "s \<in> S" "x \<in> F s"
       with bij_betwE[OF to_nat_on_finite[OF assms(2)]]
       show "x \<in> \<Union> (range F')"
         by(auto intro!: exI[where x="to_nat_on S s"] simp: F'_def from_nat_into_to_nat_on[OF countable_finite[OF assms(2)]])
     qed
     have "AE x in \<nu>x. (\<Sum>i<card S. \<kappa>' x (F' i)) = (\<Sum>i. \<kappa>' x (F' i))"
     proof -
       have "AE x in \<nu>x. \<forall>i\<ge>card S. \<kappa>' x (F' i) = 0"
         using kernel_empty0_AE by(auto simp: F'_def)
       hence "AE x in \<nu>x. (\<Sum>i. \<kappa>' x (F' i)) = (\<Sum>i<card S. \<kappa>' x (F' i))"
       proof
         show "AE x in \<nu>x. (\<forall>i\<ge>card S. \<kappa>' x (F' i) = 0) \<longrightarrow> (\<Sum>i. \<kappa>' x (F' i)) = (\<Sum>i<card S. \<kappa>' x (F' i))"
         proof -
           {
             fix x
             assume "\<forall>i\<ge>card S. \<kappa>' x (F' i) = 0"
             then have "(\<Sum>i. \<kappa>' x (F' i)) = (\<Sum>i<card S. \<kappa>' x (F' i))"
               using suminf_offset[of "\<lambda>i. \<kappa>' x (F' i)" "card S"]
               by(auto simp: F'_def)
           }
           thus ?thesis
             by auto
         qed
       qed
       thus ?thesis
         by auto
     qed
     moreover have "AE x in \<nu>x. (\<Sum>i. \<kappa>' x (F' i)) = \<kappa>' x (\<Union> (range F'))"
       using kernel_suminf_AE[OF F'_disj] by simp
     ultimately show ?thesis
       by(auto simp: 1 2)
   qed
 qed
 
 lemma kernel_disjoint_sum_AE:
   assumes "B \<in> sets Y" "C \<in> sets Y"
       and "B \<inter> C = {}"
     shows "AE x in \<nu>x. \<kappa>' x (B \<union> C) = \<kappa>' x B + \<kappa>' x C"
 proof -
   define F where "F \<equiv> \<lambda>b. if b then B else C"
   have [simp]:"disjoint_family F" "\<And>i. F i \<in> sets Y" "\<And>x. (\<Sum>i\<in>UNIV. \<kappa>' x (F i)) = \<kappa>' x B + \<kappa>' x C" "\<Union> (range F) = B \<union> C"
     using assms by(auto simp: F_def disjoint_family_on_def comm_monoid_add_class.sum.Int_Diff[of UNIV _ "{True}"])
   show ?thesis
     using kernel_finite_sum_AE[of F UNIV] by auto
 qed
 
 lemma kernel_mono_AE:
   assumes "B \<in> sets Y" "C \<in> sets Y"
       and "B \<subseteq> C"
     shows "AE x in \<nu>x. \<kappa>' x B \<le> \<kappa>' x C"
 proof -
   have 1: "B \<union> (C - B) = C" using assms(3) by auto
   have "AE x in \<nu>x. \<kappa>' x C = \<kappa>' x B + \<kappa>' x (C - B)"
     using assms by(auto intro!: kernel_disjoint_sum_AE[of B "C - B",simplified 1])
   thus ?thesis
     by auto
 qed
 
 lemma kernel_incseq_AE:
   assumes "range B \<subseteq> sets Y" "incseq B"
   shows  "AE x in \<nu>x. incseq (\<lambda>n. \<kappa>' x (B n))"
   using assms(1) by(auto simp: incseq_Suc_iff AE_all_countable intro!: kernel_mono_AE[OF _ _ incseq_SucD[OF assms(2)]])
 
 lemma kernel_decseq_AE:
   assumes "range B \<subseteq> sets Y" "decseq B"
   shows  "AE x in \<nu>x. decseq (\<lambda>n. \<kappa>' x (B n))"
   using assms(1) by(auto simp: decseq_Suc_iff AE_all_countable intro!: kernel_mono_AE[OF _ _ decseq_SucD[OF assms(2)]])
 
 corollary kernel_01_AE:
   assumes "B \<in> sets Y"
   shows "AE x in \<nu>x. 0 \<le> \<kappa>' x B \<and> \<kappa>' x B \<le> 1"
 proof -
   have "{} \<subseteq> B" "B \<subseteq> space Y"
     using assms sets.sets_into_space by auto
   from kernel_empty0_AE kernel_Y1_AE kernel_mono_AE[OF _ _ this(1)] kernel_mono_AE[OF _ _ this(2)] assms
   show ?thesis
     by auto
 qed
 
 lemma kernel_get_0: "0 \<le> \<kappa>' x B"
   by simp
 
 lemma kernel_le1_AE:
   assumes "B \<in> sets Y"
   shows "AE x in \<nu>x. \<kappa>' x B \<le> 1"
   using kernel_01_AE[OF assms] by auto
 
 corollary kernel_n_infty:
   assumes "B \<in> sets Y"
   shows "AE x in \<nu>x. \<kappa>' x B \<noteq> \<top>"
   by(rule AE_mp[OF kernel_le1_AE[OF assms]],standard) (auto simp: neq_top_trans[OF ennreal_one_neq_top])
 
 corollary kernel_le_infty:
   assumes "B \<in> sets Y"
   shows "AE x in \<nu>x. \<kappa>' x B < \<top>"
   using kernel_n_infty[OF assms] by (simp add: top.not_eq_extremum)
 
 lemma kernel_SUP_incseq:
   assumes "range B \<subseteq> sets Y" "incseq B"
   shows "AE x in \<nu>x. \<kappa>' x (\<Union> (range B)) = (\<Squnion>n. \<kappa>' x (B n))"
 proof -
   define Bn where "Bn \<equiv> (\<lambda>n. if n = 0 then {} else B (n - 1))"
   have "incseq Bn"
     using assms(2) by(auto simp: Bn_def incseq_def)
   define Cn where "Cn \<equiv> (\<lambda>n. Bn (Suc n) - Bn n)"
   have Cn_simp: "Cn 0 = B 0" "Cn (Suc n) = B (Suc n) - B n" for n
     by(simp_all add: Cn_def Bn_def)
   have Cn_sets:"Cn n \<in> sets Y" for n
     using assms(1) by(induction n) (auto simp: Cn_simp)
   have Cn_disj: "disjoint_family Cn"
     by(auto intro!: disjoint_family_Suc[OF ] incseq_SucD[OF \<open>incseq Bn\<close>] simp: Cn_def)
   have Cn_un: "(\<Union>k<Suc n. Cn k) = B n" for n
     using incseq_SucD[OF assms(2)]
     by (induction n) (auto simp: Cn_simp lessThan_Suc sup_commute)
   have Cn_sum_Bn:"AE x in \<nu>x. \<forall>n. (\<Sum>i<Suc n. \<kappa>' x (Cn i)) = \<kappa>' x (B n)"
     unfolding AE_all_countable
     using kernel_finite_sum_AE[OF disjoint_family_on_mono[OF _ Cn_disj],of "{..<Suc _}"] Cn_sets
     by(auto simp: Cn_un)
   have Cn_bn_un: "(\<Union> (range B)) = (\<Union> (range Cn))" (is "?lhs = ?rhs")
   proof safe
     fix n x
     assume "x \<in> B n"
     with Cn_un[of n] show "x \<in> \<Union> (range Cn)"
       by blast
   next
     fix n x
     assume "x \<in> Cn n"
     then show "x \<in> \<Union> (range B)"
       by(cases n,auto simp: Cn_simp)
   qed
   hence "AE x in \<nu>x. \<kappa>' x (\<Union> (range B)) =  \<kappa>' x (\<Union> (range Cn))"
     by simp
   moreover have "AE x in \<nu>x. \<kappa>' x (\<Union> (range Cn)) = (\<Sum>n. \<kappa>' x (Cn n))"
     by(rule AE_symmetric[OF kernel_suminf_AE[OF Cn_disj]]) (use Cn_def Bn_def assms(1) in auto)
   moreover have "AE x in \<nu>x. (\<Sum>n. \<kappa>' x (Cn n)) = (\<Squnion>n. \<Sum>i<n. \<kappa>' x (Cn i))"
     by(auto simp: suminf_eq_SUP)
   moreover have "AE x in \<nu>x. (\<Squnion>n. \<Sum>i<n. \<kappa>' x (Cn i)) = (\<Squnion>n. \<Sum>i<Suc n. \<kappa>' x (Cn i))"
   proof(intro AE_I2 antisym)
     fix x
     show "(\<Squnion>n. \<Sum>i<n. \<kappa>' x (Cn i)) \<le> (\<Squnion>n. \<Sum>i<Suc n. \<kappa>' x (Cn i))"
       by(rule complete_lattice_class.Sup_mono, auto, use le_iff_add  in blast)
   next
     fix x
     show "(\<Squnion>n. \<Sum>i<n. \<kappa>' x (Cn i)) \<ge> (\<Squnion>n. \<Sum>i<Suc n. \<kappa>' x (Cn i))"
       by(rule complete_lattice_class.Sup_mono) blast
   qed
   moreover have "AE x in \<nu>x. (\<Squnion>n. \<Sum>i<Suc n. \<kappa>' x (Cn i)) = (\<Squnion>n. \<kappa>' x (B n))"
     by(rule AE_mp[OF Cn_sum_Bn]) (standard+, auto)
   ultimately show ?thesis by auto
 qed
 
 lemma kernel_lim_incseq:
   assumes "range B \<subseteq> sets Y" "incseq B"
   shows "AE x in \<nu>x. (\<lambda>n. \<kappa>' x (B n)) \<longlonglongrightarrow> \<kappa>' x (\<Union> (range B))"
   by(rule AE_mp[OF AE_conjI[OF kernel_SUP_incseq[OF assms] kernel_incseq_AE[OF assms]]],auto simp: LIMSEQ_SUP)
 
 lemma kernel_INF_decseq:
   assumes "range B \<subseteq> sets Y" "decseq B"
   shows "AE x in \<nu>x. \<kappa>' x (\<Inter> (range B)) = (\<Sqinter>n. \<kappa>' x (B n))"
 proof -
   define C where "C \<equiv> (\<lambda>k. space Y - B k)"
   have C:"range C \<subseteq> sets Y" "incseq C"
     using assms by(auto simp: C_def decseq_def incseq_def)
   have eq1: "AE x in \<nu>x. 1 - \<kappa>' x (\<Inter> (range B)) = \<kappa>' x (\<Union> (range C))"
   proof -
     have "AE x in \<nu>x. \<kappa>' x (\<Union> (range C)) + \<kappa>' x (\<Inter> (range B)) - \<kappa>' x (\<Inter> (range B)) = \<kappa>' x (\<Union> (range C))"
       using assms(1) kernel_n_infty[of "\<Inter> (range B)"] by auto
     moreover have "AE x in \<nu>x. \<kappa>' x (\<Union> (range C)) + \<kappa>' x (\<Inter> (range B)) = 1"
     proof -
       have [simp]:"(\<Union> (range C)) \<union> (\<Inter> (range B)) = space Y" "(\<Union> (range C)) \<inter> (\<Inter> (range B)) = {}"
         by(auto simp: C_def) (meson assms(1) range_subsetD sets.sets_into_space subsetD)
       from kernel_disjoint_sum_AE[OF _ _ this(2)] C(1) assms(1) kernel_Y1_AE
       show ?thesis by auto
     qed
     ultimately show ?thesis
       by auto
   qed
   have eq2: "AE x in \<nu>x. \<kappa>' x (\<Union> (range C)) = (\<Squnion>n. \<kappa>' x (C n))"
     using kernel_SUP_incseq[OF C] by auto
   have eq3: "AE x in \<nu>x. (\<Squnion>n. \<kappa>' x (C n)) = (\<Squnion>n. 1 -  \<kappa>' x (B n))"
   proof -
     have "AE x in \<nu>x. \<forall>n. \<kappa>' x (C n) = 1 -  \<kappa>' x (B n)"
       unfolding AE_all_countable
     proof safe
       fix n
       have "AE x in \<nu>x. \<kappa>' x (C n) + \<kappa>' x (B n) - \<kappa>' x (B n) = \<kappa>' x (C n)"
         using assms(1) kernel_n_infty[of "B n"] by auto
       moreover have "AE x in \<nu>x. \<kappa>' x (C n) + \<kappa>' x (B n) = 1"
       proof -
         have [simp]: "C n \<union> B n = space Y" "C n \<inter> B n = {}"
           by(auto simp: C_def) (meson assms(1) range_subsetD sets.sets_into_space subsetD)
         thus ?thesis
           using kernel_disjoint_sum_AE[of "C n" "B n"] C(1) assms(1) kernel_Y1_AE by fastforce
       qed
       ultimately show "AE x in \<nu>x. \<kappa>' x (C n) = 1 - \<kappa>' x (B n)" by auto
     qed
     thus ?thesis by auto
   qed
   have [simp]: "(\<Squnion>n. 1 -  \<kappa>' x (B n)) = 1 - (\<Sqinter>n. \<kappa>' x (B n))" for x
     by(auto simp: ennreal_INF_const_minus)
   have eq: "AE x in \<nu>x. 1 - \<kappa>' x (\<Inter> (range B)) = 1 - (\<Sqinter>n. \<kappa>' x (B n))"
     using eq1 eq2 eq3 by auto
   have le1: "AE x in \<nu>x. (\<Sqinter>n. \<kappa>' x (B n)) \<le> 1"
   proof -
     have "AE x in \<nu>x. \<forall>n. \<kappa>' x (B n) \<le> 1"
       using assms(1) by(auto intro!: kernel_le1_AE simp: AE_all_countable)
     thus ?thesis
       by (auto simp: INF_lower2)
   qed 
   show ?thesis
     by(rule AE_mp[OF AE_conjI[OF AE_conjI[OF eq le1] kernel_le1_AE[of "\<Inter> (range B)"]]])
       (insert assms(1),auto simp: ennreal_minus_cancel[OF ennreal_one_neq_top])
 qed
 
 lemma kernel_lim_decseq:
   assumes "range B \<subseteq> sets Y" "decseq B"
   shows "AE x in \<nu>x. (\<lambda>n. \<kappa>' x (B n)) \<longlonglongrightarrow> \<kappa>' x (\<Inter> (range B))"
   by(rule AE_mp[OF AE_conjI[OF kernel_INF_decseq[OF assms] kernel_decseq_AE[OF assms]]],standard,auto simp: LIMSEQ_INF)
 
 end
 
 lemma qlim_eq_lim_mono_at_bot:
   fixes g :: "rat \<Rightarrow> 'a :: linorder_topology"
   assumes "mono f" "(g \<longlongrightarrow> a) at_bot" "\<And>r::rat. f (real_of_rat r) = g r"
   shows "(f \<longlongrightarrow> a) at_bot"
 proof -
   have "mono g"
     by(metis assms(1,3) mono_def of_rat_less_eq)
   have ga:"\<And>r. g r \<ge> a"
   proof(rule ccontr)
     fix r
     assume "\<not> a \<le> g r"
     then have "g r < a" by simp
     from order_topology_class.order_tendstoD(1)[OF assms(2) this]
     obtain Q :: rat where q: "\<And>q. q \<le> Q \<Longrightarrow> g r < g q"
       by(auto simp: eventually_at_bot_linorder)
     define q where "q \<equiv> min r Q"
     show False
       using q[of q] \<open>mono g\<close>
       by(auto simp: q_def mono_def) (meson linorder_not_less min.cobounded1)
   qed
   show ?thesis
   proof(rule decreasing_tendsto)
     show "\<forall>\<^sub>F n in at_bot. a \<le> f n"
       unfolding eventually_at_bot_linorder
       by(rule exI[where x=undefined],auto) (metis Ratreal_def assms(1,3) dual_order.trans ga less_eq_real_def lt_ex monoD of_rat_dense) (*metis assms(1) assms(3) ga less_eq_real_def lfp.leq_trans lt_ex monoD of_rat_dense*)
   next
     fix x
     assume "a < x"
     with topological_space_class.topological_tendstoD[OF assms(2),of "{..<x}"]
     obtain Q :: rat where q: "\<And>q. q \<le> Q \<Longrightarrow> g q < x"
       by(auto simp: eventually_at_bot_linorder)
     show "\<forall>\<^sub>F n in at_bot. f n < x"
       using q assms(1,3) by(auto intro!: exI[where x="real_of_rat Q"] simp: eventually_at_bot_linorder) (metis dual_order.refl monoD order_le_less_trans)
   qed
 qed
 
 lemma qlim_eq_lim_mono_at_top:
   fixes g :: "rat \<Rightarrow> 'a :: linorder_topology"
   assumes "mono f" "(g \<longlongrightarrow> a) at_top" "\<And>r::rat. f (real_of_rat r) = g r"
   shows "(f \<longlongrightarrow> a) at_top"
 proof -
   have "mono g"
     by(metis assms(1,3) mono_def of_rat_less_eq)
   have ga:"\<And>r. g r \<le> a"
   proof(rule ccontr)
     fix r
     assume "\<not> g r \<le> a"
     then have "a < g r" by simp
     from order_topology_class.order_tendstoD(2)[OF assms(2) this]
     obtain Q :: rat where q: "\<And>q. Q \<le> q \<Longrightarrow> g q < g r"
       by(auto simp: eventually_at_top_linorder)
     define q where "q \<equiv> max r Q"
     show False
       using q[of q] \<open>mono g\<close> by(auto simp: q_def mono_def leD)
   qed
   show ?thesis
   proof(rule increasing_tendsto)
     show "\<forall>\<^sub>F n in at_top. f n \<le> a"
       unfolding eventually_at_top_linorder
       by(rule exI[where x=undefined],auto) (metis (no_types, opaque_lifting) assms(1) assms(3) dual_order.trans ga gt_ex monoD of_rat_dense order_le_less)
   next
     fix x
     assume "x < a"
     with topological_space_class.topological_tendstoD[OF assms(2),of "{x<..}"]
     obtain Q :: rat where q: "\<And>q. Q \<le> q \<Longrightarrow> x < g q"
       by(auto simp: eventually_at_top_linorder)
     show "\<forall>\<^sub>F n in at_top. x < f n"
       using q assms(1,3) by(auto simp: eventually_at_top_linorder intro!: exI[where x="real_of_rat Q"]) (metis dual_order.refl monoD order_less_le_trans)
   qed
 qed
 
 subsection \<open> Theorem 14.D.10. (Measure Disintegration Theorem) \<close>
 locale projection_sigma_finite_standard = projection_sigma_finite + standard_borel_ne Y
 begin
 
 theorem measure_disintegration:
     "\<exists>\<kappa>. prob_kernel X Y \<kappa> \<and> measure_kernel.disintegration X Y \<kappa> \<nu> \<nu>x \<and>
        (\<forall>\<kappa>''. prob_kernel X Y \<kappa>'' \<longrightarrow> measure_kernel.disintegration X Y \<kappa>'' \<nu> \<nu>x \<longrightarrow> (AE x in \<nu>x. \<kappa> x = \<kappa>'' x))"
 proof -
   have *:"\<exists>\<kappa>. prob_kernel X (borel :: real measure) \<kappa> \<and> measure_kernel.disintegration X borel \<kappa> \<nu> (marginal_measure X borel \<nu>) \<and>
              (\<forall>\<kappa>''. prob_kernel X borel \<kappa>'' \<longrightarrow> measure_kernel.disintegration X borel \<kappa>'' \<nu> (marginal_measure X borel \<nu>) \<longrightarrow> (AE x in (marginal_measure X borel \<nu>). \<kappa> x = \<kappa>'' x))"
         if nu_sets': "sets \<nu> = sets (X \<Otimes>\<^sub>M borel)" and marginal_sigma_finite': "sigma_finite_measure (marginal_measure X borel \<nu>)" for X :: "'a measure" and \<nu>
 
   proof -
     interpret r: projection_sigma_finite X borel \<nu>
       using that by(auto simp: projection_sigma_finite_def)
     define \<phi> :: "'a \<Rightarrow> rat \<Rightarrow> real"
       where "\<phi> \<equiv> (\<lambda>x r. enn2real (r.\<kappa>' x {..real_of_rat r}))"
     have as1: "AE x in r.\<nu>x. \<forall>r s. r \<le> s \<longrightarrow> \<phi> x r \<le> \<phi> x s"
       unfolding AE_all_countable
     proof(safe intro!: AE_impI)
       fix r s :: rat
       assume "r \<le> s"
       have "AE x in r.\<nu>x. r.\<kappa>' x {..real_of_rat k} < top" for k
         using atMost_borel r.kernel_le_infty by blast
       from this[of s] r.kernel_mono_AE[of "{..real_of_rat r}" "{..real_of_rat s}"] \<open>r \<le> s\<close>
       show "AE x in r.\<nu>x. \<phi> x r \<le> \<phi> x s"
         by(auto simp: \<phi>_def of_rat_less_eq enn2real_mono)
     qed
     have as2: "AE x in r.\<nu>x. \<forall>r. (\<lambda>n. \<phi> x (r + 1 / rat_of_nat (Suc n))) \<longlonglongrightarrow> \<phi> x r"
       unfolding AE_all_countable
     proof safe
       fix r
       have 1:"(\<Inter>n. {..real_of_rat (r + 1 / rat_of_nat (Suc n))}) = {..real_of_rat r}"
       proof safe
         fix x
         assume h:" x \<in> (\<Inter>n. {..real_of_rat (r + 1 / rat_of_nat (Suc n))})"
         show "x \<le> real_of_rat r"
         proof(rule ccontr)
           assume "\<not> x \<le> real_of_rat r"
           then have "0 < x - real_of_rat r" by simp
           then obtain n where "(1 / (real (Suc n))) < x - real_of_rat r"
             using nat_approx_posE by blast
           hence "real_of_rat (r + 1 / (1 + rat_of_nat n)) < x"
             by (simp add: of_rat_add of_rat_divide)
           with h show False
             using linorder_not_le by fastforce
         qed
       next
         fix x n
         assume "x \<le> real_of_rat r"
         then  show " x \<le> real_of_rat (r + 1 / rat_of_nat (Suc n))"
           by (metis le_add_same_cancel1 of_nat_0_le_iff of_rat_less_eq order_trans zero_le_divide_1_iff)
       qed
       have "AE x in r.\<nu>x. (\<lambda>n. r.\<kappa>' x {..real_of_rat (r + 1 / rat_of_nat (Suc n))}) \<longlonglongrightarrow> r.\<kappa>' x {..real_of_rat r}"
         unfolding 1[symmetric] by(rule r.kernel_lim_decseq) (auto simp: decseq_Suc_iff of_rat_less_eq frac_le)
       from AE_conjI[OF r.kernel_le_infty[of "{..real_of_rat r}",simplified] this] 
       show "AE x in r.\<nu>x. (\<lambda>n. \<phi> x (r + 1 / (rat_of_nat (Suc n)))) \<longlonglongrightarrow> \<phi> x r"
         unfolding \<phi>_def by eventually_elim (rule tendsto_enn2real, auto)
     qed
 
     have as3: "AE x in r.\<nu>x. (\<phi> x \<longlongrightarrow> 0) at_bot"
     proof -
       have 0: "range (\<lambda>n. {..- real n}) \<subseteq> sets borel" "decseq (\<lambda>n. {..- real n})"
         by(auto simp: decseq_def)
       show ?thesis
       proof(safe intro!: AE_I2[THEN AE_mp[OF AE_conjI[OF r.kernel_empty0_AE AE_conjI[OF r.kernel_lim_decseq[OF 0] as1]]]])
         fix x
         assume h: "r.\<kappa>' x {} = 0" " (\<lambda>n. r.\<kappa>' x {..- real n}) \<longlonglongrightarrow> r.\<kappa>' x (\<Inter>n. {..- real n})" "\<forall>r s. r \<le> s \<longrightarrow> \<phi> x r \<le> \<phi> x s"
         have [simp]: "(\<Inter>n. {..- real n}) = {}" by auto (meson le_minus_iff linorder_not_less reals_Archimedean2)
         show "(\<phi> x \<longlongrightarrow> 0) at_bot"
         proof(rule decreasing_tendsto)
           fix r :: real
           assume "0 < r"
           with h(2) eventually_sequentially
           obtain N where N:"\<And>n. n \<ge> N \<Longrightarrow> r.\<kappa>' x {..- real n} < r"
             by(fastforce simp: order_tendsto_iff h(1))
           show "\<forall>\<^sub>F q in at_bot. \<phi> x q < r"
             unfolding eventually_at_bot_linorder
           proof(safe intro!: exI[where x="- rat_of_nat N"])
             fix q
             assume "q \<le> - rat_of_nat N"
             with h(3) have "\<phi> x q \<le> \<phi> x (- rat_of_nat N)" by simp
             also have "... < r"
               by(auto simp: \<phi>_def) (metis N[OF order_refl] \<open>0 < r\<close> enn2real_less_iff enn2real_top of_rat_minus of_rat_of_nat_eq top.not_eq_extremum)
             finally show "\<phi> x q < r" .
           qed
         qed(simp add: \<phi>_def)
       qed
     qed
 
     have as4: "AE x in r.\<nu>x. (\<phi> x \<longlongrightarrow> 1) at_top"
     proof -
       have 0: "range (\<lambda>n. {..real n}) \<subseteq> sets borel" "incseq (\<lambda>n. {..real n})"
         by(auto simp: incseq_def)
       have [simp]: "(\<Union>n. {..real n}) = UNIV" by (auto simp: real_arch_simple)
       have 1: "AE x in r.\<nu>x. \<forall>n. r.\<kappa>' x {..real n} \<le> 1" "AE x in r.\<nu>x. \<forall>q. r.\<kappa>' x {..real_of_rat q} \<le> 1"
         by(auto simp: AE_all_countable intro!: r.kernel_le1_AE)
       show ?thesis
       proof(safe intro!: AE_I2[THEN AE_mp[OF AE_conjI[OF AE_conjI[OF 1] AE_conjI[OF r.kernel_Y1_AE AE_conjI[OF r.kernel_lim_incseq[OF 0] as1]]],simplified]])
         fix x
         assume h: "\<forall>q. r.\<kappa>' x {..real_of_rat q} \<le> 1" "\<forall>n. r.\<kappa>' x {..real n} \<le> 1"
                   "(\<lambda>n. r.\<kappa>' x {..real n}) \<longlonglongrightarrow> r.\<kappa>' x UNIV" "\<forall>r s. r \<le> s \<longrightarrow> \<phi> x r \<le> \<phi> x s" "r.\<kappa>' x UNIV = 1"
         then have h3: "(\<lambda>n. r.\<kappa>' x {..real n}) \<longlonglongrightarrow> 1"
           by auto
         show "(\<phi> x \<longlongrightarrow> 1) at_top"
         proof(rule increasing_tendsto)
           fix r :: real
           assume "r < 1"
           with h3 eventually_sequentially
           obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> r < r.\<kappa>' x {..real n}"
             by(fastforce simp: order_tendsto_iff)
           show "\<forall>\<^sub>F n in at_top. r < \<phi> x n"
             unfolding eventually_at_top_linorder
           proof(safe intro!: exI[where x="rat_of_nat N"])
             fix q
             assume "rat_of_nat N \<le> q"
             have "r < \<phi> x (rat_of_nat N)"
               by(auto simp: \<phi>_def) (metis N[OF order_refl] h(2) enn2real_1 enn2real_ennreal enn2real_positive_iff ennreal_cases ennreal_leI linorder_not_less zero_less_one)
             also have "... \<le> \<phi> x q"
               using h(4) \<open>rat_of_nat N \<le> q\<close> by simp
             finally show "r < \<phi> x q" .
           qed
         qed(use h(1) enn2real_leI \<phi>_def in auto)
       qed
     qed
     from AE_E3[OF AE_conjI[OF as1 AE_conjI[OF as2 AE_conjI[OF as3 as4]]],simplified space_marginal_measure]
     obtain N where N: "N \<in> null_sets r.\<nu>x" "\<And>x r s. x \<in> space X - N \<Longrightarrow> r \<le> s \<Longrightarrow> \<phi> x r \<le> \<phi> x s"
                       "\<And>x r. x \<in> space X - N \<Longrightarrow>  (\<lambda>n. \<phi> x (r + 1 / rat_of_nat (Suc n))) \<longlonglongrightarrow> \<phi> x r"
                       "\<And>x. x \<in> space X - N \<Longrightarrow> (\<phi> x \<longlongrightarrow> 0) at_bot" "\<And>x. x \<in> space X - N \<Longrightarrow> (\<phi> x \<longlongrightarrow> 1) at_top"
       by metis
     define F where "F \<equiv> (\<lambda>x y. indicat_real (space X - N) x * Inf {\<phi> x r |r. y \<le> real_of_rat r} + indicat_real N x * indicat_real {0..} y)"
     have [simp]: "{\<phi> x r |r. y \<le> real_of_rat r} \<noteq> {}" for x y
       by auto (meson gt_ex less_eq_real_def of_rat_dense)
     have [simp]: "bdd_below {\<phi> x r |r. y \<le> real_of_rat r}" if "x \<in> space X - N" for x y
     proof -
       obtain r' where "real_of_rat r' \<le> y"
         by (metis less_eq_real_def lt_ex of_rat_dense)
       from order_trans[OF this] of_rat_less_eq show ?thesis
         by(auto intro!: bdd_belowI[of _ "\<phi> x r'"] N(2)[OF that])
     qed
     have Feq: "F x (real_of_rat r) = \<phi> x r" if "x \<in> space X - N" for x r
       using that N(2)[OF that] by(auto intro!: cInf_eq_minimum simp: of_rat_less_eq F_def)
     have Fmono: "mono (F x)" if "x \<in> space X" for x
       by(auto simp: F_def mono_def indicator_def intro!: cInf_superset_mono) (meson gt_ex less_eq_real_def of_rat_dense)
 
     have F1: "(F x \<longlongrightarrow> 0) at_bot" if "x \<in> space X" for x
     proof(cases "x \<in> N")
       case True
       with that show ?thesis
         by(auto simp: F_def tendsto_iff eventually_at_bot_dense indicator_def intro!: exI[where x=0])
     next
       case False
       with qlim_eq_lim_mono_at_bot[OF Fmono[OF that] N(4)] Feq that
       show ?thesis by auto
     qed
     have F2: "(F x \<longlongrightarrow> 1) at_top" if "x \<in> space X" for x
     proof(cases "x \<in> N")
       case True
       with that show ?thesis
         by(auto simp: F_def tendsto_iff eventually_at_top_dense indicator_def intro!: exI[where x=0])
     next
       case False
       with qlim_eq_lim_mono_at_top[OF Fmono[OF that] N(5)] Feq that
       show ?thesis by auto
     qed
     have F3: "continuous (at_right a) (F x)" if "x \<in> space X" for x a
     proof(cases "x \<in> N")
       case x:True
       {
         fix e :: real
         assume e:"0 < e"
         consider "a \<ge> 0" | "a < 0" by fastforce
         then have "\<exists>d>0. indicat_real {0..} (a + d) - indicat_real {0..} a < e"
         proof cases
           case 1
           with e show ?thesis
             by(auto intro!: exI[where x=1])
         next
           case 2
           then obtain b where "b > 0" "a + b < 0"
             by (metis add_less_same_cancel2 of_rat_dense real_add_less_0_iff)
           with e 2 show ?thesis
             by(auto intro!: exI[where x=b])
         qed
       }
       with x show ?thesis
         unfolding continuous_at_right_real_increasing[of "F x",OF monoD[OF Fmono[OF that]],simplified]
         by(auto simp: F_def)
     next
       case x:False
       {
         fix e :: real
         assume e: "e > 0"
         have "\<exists>k. a \<le> real_of_rat k \<and> \<Sqinter> {\<phi> x r |r. a \<le> real_of_rat r} +  e / 2 \<ge> \<phi> x k"
         proof(rule ccontr)
           assume "\<nexists>k. a \<le> real_of_rat k \<and> \<phi> x k \<le> \<Sqinter> {\<phi> x r |r. a \<le> real_of_rat r} + e / 2"
           then have cont: "\<And>k. a \<le> real_of_rat k \<Longrightarrow> \<phi> x k - e / 2 > \<Sqinter> {\<phi> x r |r. a \<le> real_of_rat r}"
             by auto
           hence "a \<le> real_of_rat k \<Longrightarrow> \<exists>r. a \<le> real_of_rat r \<and> \<phi> x r  < \<phi> x k - e / 2" for k
             using cont \<open>x \<in> space X\<close> x cInf_less_iff [of "{\<phi> x r |r. a \<le> real_of_rat r}" "\<phi> x k - e / 2"]
             by auto
           then obtain r where r:"\<And>k. a \<le> real_of_rat k \<Longrightarrow> a \<le> real_of_rat (r k)" "\<And>k. a \<le> real_of_rat k \<Longrightarrow> \<phi> x (r k) < \<phi> x k - e / 2"
             by metis
           obtain k where k:"a \<le> real_of_rat k"
             by (meson gt_ex less_eq_real_def of_rat_dense)
           define f where "f \<equiv> rec_nat k (\<lambda>n fn. r fn)"
           have f_simp: "f 0 = k" "f (Suc n) = r (f n)" for n
             by(auto simp: f_def)
           have f1: "a \<le> real_of_rat (f n)" for n
             using r(1) k by(induction n) (auto simp: f_simp)
           have f2: "n \<ge> 1 \<Longrightarrow> \<phi> x (f n) < \<phi> x k - real n * e / 2" for n
           proof(induction n)
             case ih:(Suc n)
             consider "n = 0" | "n \<ge> 1" by fastforce
             then show ?case
             proof cases
               case 1
               with r k show ?thesis
                 by(simp add: f_simp)
             next
               case 2
               show ?thesis
                 using less_trans[OF r(2)[OF f1[of n]] diff_strict_right_mono[OF ih(1)[OF 2],of "e / 2"]]
                 by(auto simp: f_simp ring_distribs(2) add_divide_distrib)
             qed
           qed simp
           have "\<not> bdd_below {\<phi> x r |r. a \<le> real_of_rat r}"
             unfolding bdd_below_def
           proof safe
             fix M
             obtain n where "\<phi> x k - M < real n * e / 2"
               using f2 e reals_Archimedean3 by fastforce
             then have "\<phi> x k - M < real (Suc n) * e / 2"
               using divide_strict_right_mono pos_divide_less_eq e by fastforce
             thus "Ball {\<phi> x r |r. a \<le> real_of_rat r} ((\<le>) M) \<Longrightarrow> False"
               using f2[of "Suc n"] f1[of "Suc n"] by(auto intro!: exI[where x="\<phi> x (f (Suc n))"])
           qed
           with that x show False
             by simp
         qed
         then obtain k where k: "a \<le> real_of_rat k" "\<Sqinter> {\<phi> x r |r. a \<le> real_of_rat r} +  e / 2 \<ge> \<phi> x k"
           by auto
         obtain no where no:"\<And>n. n\<ge>no \<Longrightarrow> (\<phi> x (k + 1 / rat_of_nat (Suc n))) - (\<phi> x k) < e / 2"
           using \<open>x \<in> space X\<close> x metric_LIMSEQ_D[OF N(3)[of x k],of "e/2"] e N(2)[of x k "k + 1 / rat_of_nat (Suc _)"]
           by(auto simp: dist_real_def)
         have "\<exists>d>0. \<Sqinter> {\<phi> x r |r. a + d \<le> real_of_rat r} - \<Sqinter> {\<phi> x r |r. a \<le> real_of_rat r} < e"
         proof(safe intro!: exI[where x="real_of_rat (1 / rat_of_nat (Suc no))"])
           have "\<phi> x (k + 1 / rat_of_nat (Suc no)) - e < \<phi> x k - e / 2"
             using no[OF order_refl] by simp
           also have "... \<le> \<Sqinter> {\<phi> x r |r. a \<le> real_of_rat r}"
             using k by simp
           finally have "\<phi> x (k + 1 / rat_of_nat (Suc no)) - \<Sqinter> {\<phi> x r |r. a \<le> real_of_rat r} < e" by simp
           moreover have "\<Sqinter> {\<phi> x r |r. a + real_of_rat (1 / (1 + rat_of_nat no)) \<le> real_of_rat r} \<le> \<phi> x (k + 1 / rat_of_nat (Suc no))"
             using k that x by(auto intro!: cInf_lower simp: of_rat_add)
           ultimately show "\<Sqinter> {\<phi> x r |r. a + real_of_rat (1 / (rat_of_nat (Suc no))) \<le> real_of_rat r} - \<Sqinter> {\<phi> x r |r. a \<le> real_of_rat r} < e"
             by simp
         qed simp
       }
       with that x show ?thesis
         unfolding continuous_at_right_real_increasing[of "F x",OF monoD[OF Fmono[OF that]],simplified]
         by(auto simp: F_def)
     qed
 
     define \<kappa> where "\<kappa> \<equiv> (\<lambda>x. interval_measure (F x))"
 
     have \<kappa>: "\<And>x. x \<in> space X \<Longrightarrow> \<kappa> x UNIV = 1"
             "\<And>x r. x \<in> space X \<Longrightarrow> \<kappa> x {..r} = ennreal (F x r)"
  and[simp]: "\<And>x. sets (\<kappa> x) = sets borel" "\<And>x. space (\<kappa> x) = UNIV"
       using emeasure_interval_measure_Iic[OF _ F3 F1] interval_measure_UNIV[OF _ F3 F1 F2] Fmono
       by(auto simp: mono_def \<kappa>_def)
     
     interpret \<kappa>: prob_kernel X borel \<kappa>
       unfolding prob_kernel_def'
     proof(rule measurable_prob_algebra_generated[OF _ atMostq_Int_stable,of _ UNIV])
       show "\<And>a. a \<in> space X \<Longrightarrow> prob_space (\<kappa> a)"
         by(auto intro!: prob_spaceI \<kappa>(1))
     next
       fix A
       assume "A \<in> {{..r} |r::real. r \<in> \<rat>}"
       then obtain r where r: "A = {..real_of_rat r}"
         using Rats_cases by blast
       have "(\<lambda>x. ennreal (indicat_real (space X - N) x * \<phi> x r + indicat_real N x * indicat_real {0..} (real_of_rat r))) \<in> borel_measurable X" 
       proof -
         have "N \<in> sets X"
           using null_setsD2[OF N(1)] by(auto simp: sets_marginal_measure)
         thus ?thesis by(auto simp: \<phi>_def)
       qed
       moreover have "indicat_real (space X - N) x * \<phi> x r + indicat_real N x * indicat_real {0..} (real_of_rat r) = emeasure (\<kappa> x) A" if "x \<in> space X" for x
         using Feq[of x r] \<kappa>(2)[OF that,of "real_of_rat r"]
         by(cases "x \<in> N") (auto simp: r indicator_def F_def)
       ultimately show " (\<lambda>x. emeasure (\<kappa> x) A) \<in> borel_measurable X"
         using measurable_cong[of _ "\<lambda>x. emeasure (\<kappa> x) A" "\<lambda>x. ennreal (indicat_real (space X - N) x * \<phi> x r + indicat_real N x * indicat_real {0..} (real_of_rat r))"]
         by simp
     qed(auto simp: rborel_eq_atMostq)
     have \<kappa>_AE:"AE x in r.\<nu>x. \<kappa> x {..real_of_rat r} = r.\<kappa>' x {..real_of_rat r}" for r
     proof -
       have "AE x in r.\<nu>x. \<kappa> x {..real_of_rat r} = ennreal (F x (real_of_rat r))"
         by(auto simp: space_marginal_measure \<kappa>(2))
       moreover have "AE x in r.\<nu>x. ennreal (F x (real_of_rat r))= ennreal (\<phi> x r)"
         using Feq[of _ r] by(auto simp add: space_marginal_measure intro!: AE_I''[OF N(1)])
       moreover have "AE x in r.\<nu>x. ennreal (\<phi> x r) = ennreal (enn2real (r.\<kappa>' x  {..real_of_rat r}))"
         by(simp add: \<phi>_def)
       moreover have "AE x in r.\<nu>x. ennreal (enn2real (r.\<kappa>' x  {..real_of_rat r})) = r.\<kappa>' x {..real_of_rat r}"
         using r.kernel_le_infty[of "{..real_of_rat r}",simplified]
         by(auto simp: ennreal_enn2real_if)
       ultimately show ?thesis by auto
     qed
     have \<kappa>_dis: "\<kappa>.disintegration \<nu> r.\<nu>x"
     proof -
       interpret D: Dynkin_system UNIV "{B \<in> sets borel. \<forall>A\<in> sets X. \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) B\<partial>r.\<nu>x)}"
       proof
         {
           fix A
           assume h:"A\<in> sets X"
           then have "\<nu> (A \<times> UNIV) = (\<integral>\<^sup>+x\<in>A. 1 \<partial>r.\<nu>x)"
             using emeasure_marginal_measure[OF nu_sets' h] sets_marginal_measure[of X borel \<nu> "space borel"] by auto
           also have "... = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) UNIV\<partial>r.\<nu>x)"
             by(auto intro!: nn_integral_cong simp: \<kappa> space_marginal_measure)
           finally have "\<nu> (A \<times> UNIV) = (\<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) UNIV\<partial>r.\<nu>x)" .
         }
-        thus "UNIV \<in> {B \<in> sets borel. \<forall>A\<in>sets X. emeasure \<nu> (A \<times> B) = \<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) B\<partial>r.\<nu>x}"
+        thus "UNIV \<in> {B \<in> sets borel. \<forall>A\<in>sets X. emeasure \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) B\<partial>r.\<nu>x)}"
           by auto
         hence univ:"\<And>A. A \<in> sets X \<Longrightarrow> \<nu> (A \<times> UNIV) = (\<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) UNIV\<partial>r.\<nu>x)" by auto
-        show "\<And>B. B \<in> {B \<in> sets borel. \<forall>A\<in>sets X. emeasure \<nu> (A \<times> B) = \<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) B\<partial>r.\<nu>x} \<Longrightarrow> UNIV - B \<in> {B \<in> sets borel. \<forall>A\<in>sets X. emeasure \<nu> (A \<times> B) = \<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) B\<partial>r.\<nu>x}"
+        show "\<And>B. B \<in> {B \<in> sets borel. \<forall>A\<in>sets X. emeasure \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) B\<partial>r.\<nu>x)}
+            \<Longrightarrow> UNIV - B \<in> {B \<in> sets borel. \<forall>A\<in>sets X. emeasure \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) B\<partial>r.\<nu>x)}"
         proof(rule r.\<nu>x.sigma_finite_disjoint)
           fix B and J :: "nat \<Rightarrow> _"
           assume "B \<in> {B \<in> sets borel. \<forall>A\<in>sets X. emeasure \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) B \<partial>r.\<nu>x)}" "range J \<subseteq> sets r.\<nu>x" "\<Union> (range J) = space r.\<nu>x"
                  "(\<And>i. emeasure r.\<nu>x (J i) \<noteq> \<infinity>)" "disjoint_family J"
           then have B: "B \<in> sets borel" " \<forall>A\<in>sets X. \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) B\<partial>r.\<nu>x)"
              and J: "range J \<subseteq> sets X" "\<Union> (range J) = space X" "\<And>i. emeasure r.\<nu>x (J i) \<noteq> \<infinity>" "disjoint_family J"
             by (auto simp: sets_marginal_measure space_marginal_measure)
           {
             fix A
             assume A: "A \<in> sets X"
             have "\<nu> (A \<times> (UNIV - B)) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) (UNIV - B)\<partial>r.\<nu>x)" (is "?lhs = ?rhs")
             proof -
               have AJi1: "disjoint_family (\<lambda>i. (A \<inter> J i) \<times> (UNIV - B))"
                 using B(1) J(4) by(fastforce simp: disjoint_family_on_def)
               have AJi2[simp]: "(\<Union>i. ((A \<inter> J i) \<times> (UNIV - B))) = A \<times> (UNIV - B)"
                 using J(2) sets.sets_into_space[OF A] by blast
               have AJi3: "(range (\<lambda>i. (A \<inter> J i) \<times> (UNIV - B))) \<subseteq> sets \<nu>"
                 using B(1) J(1) A by(auto simp: nu_sets')
 
               have "?lhs = (\<Sum>i. \<nu> ((A \<inter> J i) \<times> (UNIV - B)))"
                 by(simp add: suminf_emeasure[OF AJi3 AJi1])
               also have "... = (\<Sum>i. (\<integral>\<^sup>+x\<in> A \<inter> J i. (\<kappa> x) (UNIV - B) \<partial>r.\<nu>x))"
               proof(safe intro!: suminf_cong)
                 fix n
                 have Jn: "J n \<in> sets X"
                   using J by auto
                 have fin: "\<nu> ((A \<inter> J n) \<times> C) \<noteq> \<infinity>" for C
                 proof(cases "(A \<inter> J n) \<times> C \<in> sets \<nu>")
                   case True
                   then have "\<nu> ((A \<inter> J n) \<times> C) \<le> \<nu> ((A \<inter> J n) \<times> UNIV)"
                     using Jn nu_sets' A by(intro emeasure_mono) auto
                   also have "\<nu> ((A \<inter> J n) \<times> UNIV) \<le> \<nu> (J n \<times> UNIV)"
                     using Jn nu_sets' by(intro emeasure_mono) auto
                   also have "... = r.\<nu>x (J n)"
                     using emeasure_marginal_measure[OF nu_sets' Jn] by simp
                   finally show ?thesis
                     by (metis J(3)[of n] infinity_ennreal_def neq_top_trans)
                 qed(simp add: emeasure_notin_sets)
                 show "\<nu> ((A \<inter> J n) \<times> (UNIV - B)) = (\<integral>\<^sup>+x\<in> A \<inter> J n. (\<kappa> x) (UNIV - B) \<partial>r.\<nu>x)" (is "?lhs = ?rhs")
                 proof -
                   have "?lhs = \<nu> ((A \<inter> J n) \<times> UNIV) - \<nu> ((A \<inter> J n) \<times> B)"
                   proof -
                     have [simp]: "?lhs + \<nu> ((A \<inter> J n) \<times> B) = \<nu> ((A \<inter> J n) \<times> UNIV)"
                     proof -
                       have [simp]:"((A \<inter> J n) \<times> (UNIV - B)) \<union> ((A \<inter> J n) \<times> B) = ((A \<inter> J n) \<times> UNIV)" by blast
                       show ?thesis
                         using B(1) A Jn nu_sets' by(intro plus_emeasure[of "(A \<inter> J n) \<times> (UNIV - B)" _ "(A \<inter> J n) \<times> B",simplified]) auto
                     qed
                     have "?lhs = ?lhs + \<nu> ((A \<inter> J n) \<times> B) - \<nu> ((A \<inter> J n) \<times> B)"
                       by(simp only: ennreal_add_diff_cancel[OF fin[of B]])
                     also have "... = \<nu> ((A \<inter> J n) \<times> UNIV) - \<nu> ((A \<inter> J n) \<times> B)"
                       by simp
                     finally show ?thesis .
                   qed
                   also have "... = (\<integral>\<^sup>+x\<in> A \<inter> J n. (\<kappa> x) UNIV \<partial>r.\<nu>x) - (\<integral>\<^sup>+x\<in> A \<inter> J n. (\<kappa> x) B \<partial>r.\<nu>x)"
                     using B(2) A Jn univ by auto
                   also have "... = (\<integral>\<^sup>+x. ((\<kappa> x) UNIV * indicator (A \<inter> J n) x - (\<kappa> x) B * indicator (A \<inter> J n) x) \<partial>r.\<nu>x)"
                   proof(rule nn_integral_diff[symmetric])
                     show "(\<lambda>x. (\<kappa> x) UNIV * indicator (A \<inter> J n) x) \<in> borel_measurable r.\<nu>x" "(\<lambda>x. (\<kappa> x) B * indicator (A \<inter> J n) x) \<in> borel_measurable r.\<nu>x"
                       using sets_marginal_measure[of X borel \<nu> "space borel"] \<kappa>.emeasure_measurable[OF B(1)] \<kappa>.emeasure_measurable[of UNIV] A Jn
                       by(auto simp del: space_borel)
                   next
-                    show "\<integral>\<^sup>+x\<in>A \<inter> J n. (\<kappa> x) B\<partial>r.\<nu>x \<noteq> \<infinity>"
+                    show "(\<integral>\<^sup>+x\<in>A \<inter> J n. (\<kappa> x) B\<partial>r.\<nu>x) \<noteq> \<infinity>"
                       using B(2) A Jn univ fin[of B] by auto
                   next
                     show "AE x in r.\<nu>x. (\<kappa> x) B * indicator (A \<inter> J n) x \<le> (\<kappa> x) UNIV * indicator (A \<inter> J n) x"
                       by(standard, auto simp: space_marginal_measure indicator_def intro!: emeasure_mono)
                   qed
                   also have "... = (\<integral>\<^sup>+x\<in> A \<inter> J n. ((\<kappa> x) UNIV - (\<kappa> x) B) \<partial>r.\<nu>x)"
                     by(auto intro!: nn_integral_cong simp: indicator_def)
                   also have "... = ?rhs"
                   proof(safe intro!: nn_integral_cong)
                     fix x
                     assume "x \<in> space r.\<nu>x"
                     then have "x \<in> space X"
                       by(simp add: space_marginal_measure)
                     show "((\<kappa> x) UNIV - (\<kappa> x) B) * indicator (A \<inter> J n) x = (\<kappa> x) (UNIV - B) * indicator (A \<inter> J n) x"
                       by(auto intro!: emeasure_compl[of B "\<kappa> x",simplified,symmetric] simp: B \<kappa>.prob_spaces \<open>x \<in> space X\<close> prob_space_imp_subprob_space subprob_space.emeasure_subprob_space_less_top indicator_def)
                   qed
                   finally show ?thesis .
                 qed
               qed
               also have "... = (\<integral>\<^sup>+x. (\<Sum>i. (\<kappa> x) (UNIV - B) * indicator (A \<inter> J i) x)\<partial>r.\<nu>x)"
                 using \<kappa>.emeasure_measurable[of "UNIV - B"] B(1) sets_marginal_measure[of X borel \<nu> "space borel"] A J
                 by(intro nn_integral_suminf[symmetric]) (auto simp del: space_borel)
               also have "... = (\<integral>\<^sup>+x. (\<kappa> x) (UNIV - B) * indicator A x *  (\<Sum>i. indicator (A \<inter> J i) x) \<partial>r.\<nu>x)"
                 by(auto simp: indicator_def intro!: nn_integral_cong)
               also have "... = (\<integral>\<^sup>+x. (\<kappa> x) (UNIV - B) * indicator A x * (indicator (\<Union>i. A \<inter> J i) x) \<partial>r.\<nu>x)"
               proof -
                 have "(\<Sum>i. indicator (A \<inter> J i) x) = (indicator (\<Union>i. A \<inter> J i) x :: ennreal)" for x
                   using J(4) by(intro suminf_indicator) (auto simp: disjoint_family_on_def)
                 thus ?thesis
                   by(auto intro!: nn_integral_cong)
               qed
               also have "... = ?rhs"
                 using J(2) by(auto simp: indicator_def space_marginal_measure intro!: nn_integral_cong)
               finally show ?thesis .
             qed
           }
           thus "UNIV - B \<in> {B \<in> sets borel. \<forall>A\<in>sets X. emeasure \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. emeasure (\<kappa> x) B \<partial>r.\<nu>x)}"
             using B by auto
         qed
       next
         fix J :: "nat \<Rightarrow> _"
-        assume J1: "disjoint_family J" "range J \<subseteq> {B \<in> sets borel. \<forall>A\<in>sets X. \<nu> (A \<times> B) = \<integral>\<^sup>+x\<in>A. (\<kappa> x) B\<partial>r.\<nu>x}"
+        assume J1: "disjoint_family J" "range J \<subseteq> {B \<in> sets borel. \<forall>A\<in>sets X. \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) B\<partial>r.\<nu>x)}"
         then have J2: "range J \<subseteq> sets borel" "\<Union> (range J) \<in> sets borel" "\<And>n A. A \<in> sets X \<Longrightarrow> \<nu> (A \<times> (J n)) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) (J n) \<partial>r.\<nu>x)"
           by auto
-        show "\<Union> (range J) \<in> {B \<in> sets borel. \<forall>A\<in>sets X. \<nu> (A \<times> B) = \<integral>\<^sup>+x\<in>A. (\<kappa> x) B\<partial>r.\<nu>x}"
+        show "\<Union> (range J) \<in> {B \<in> sets borel. \<forall>A\<in>sets X. \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) B\<partial>r.\<nu>x)}"
         proof -
           {
             fix A
             assume A:"A \<in> sets X"
             have "\<nu> (A \<times> \<Union> (range J)) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) (\<Union> (range J)) \<partial>r.\<nu>x)" (is "?lhs = ?rhs")
             proof -
               have "?lhs = \<nu> (\<Union>n. A \<times> J n)"
               proof -
                 have "(A \<times> \<Union> (range J)) = (\<Union>n. A \<times> J n)" by blast
                 thus ?thesis by simp
               qed
               also have "... = (\<Sum>n. \<nu> (A \<times> J n))"
                 using J1(1) J2(1) A nu_sets' by(fastforce intro!: suminf_emeasure[symmetric] simp: disjoint_family_on_def)
               also have "... = (\<Sum>n. (\<integral>\<^sup>+x\<in>A. (\<kappa> x) (J n) \<partial>r.\<nu>x))"
                 by(simp add: J2(3)[OF A])
               also have "... = (\<integral>\<^sup>+x. (\<Sum>n. (\<kappa> x) (J n) * indicator A x) \<partial>r.\<nu>x)"
                 using \<kappa>.emeasure_measurable J2(1) A sets_marginal_measure[of X borel \<nu> "space borel"]
                 by(intro nn_integral_suminf[symmetric]) auto
               also have "... = (\<integral>\<^sup>+x\<in>A. (\<Sum>n. (\<kappa> x) (J n)) \<partial>r.\<nu>x)"
                 by auto
               also have "... = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) (\<Union> (range J)) \<partial>r.\<nu>x)"
                 using J1 J2 by(auto intro!: nn_integral_cong suminf_emeasure simp: space_marginal_measure indicator_def)
               finally show ?thesis .
             qed
           }
           thus ?thesis
             using J2(2) by auto
         qed
       qed auto
       have "{ {..r} | r::real. r \<in> \<rat>} \<subseteq> {B \<in> sets borel. \<forall>A\<in> sets X. \<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) B\<partial>r.\<nu>x)}"
       proof -
         {
           fix r ::real and A
           assume h: "r \<in> \<rat>" "A \<in> sets X"
           then obtain r' where r':"r = real_of_rat r'"
             using Rats_cases by blast
           have "\<nu> (A \<times> {..r}) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) {..r} \<partial>r.\<nu>x)" (is "?lhs = ?rhs")
           proof -
             have "?lhs = (\<integral>\<^sup>+x\<in>A. r.\<kappa>' x {..r}\<partial>r.\<nu>x)"
               using h by(simp add: r.kernel_RN_deriv)
             also have "... = ?rhs"
               using \<kappa>_AE[of r'] by(auto intro!: nn_integral_cong_AE simp: r' simp del: space_borel)
             finally show ?thesis .
           qed
         }
         thus ?thesis
           by auto
       qed
       from D.Dynkin_subset[OF this] rborel_eq_atMostq[symmetric]
       show ?thesis
         by(auto simp: \<kappa>.disintegration_def sets_marginal_measure nu_sets' sigma_eq_Dynkin[OF _ atMostq_Int_stable,of UNIV,simplified,symmetric] rborel_eq_atMostq_sets simp del: space_borel)
     qed
     show ?thesis
     proof(intro exI conjI strip)
       fix \<kappa>''
       assume "prob_kernel X (borel :: real measure) \<kappa>''"
       interpret \<kappa>'':  prob_kernel X borel \<kappa>'' by fact
       assume disi: "\<kappa>''.disintegration \<nu> r.\<nu>x"
       have eq_atMostr_AE:"AE x in r.\<nu>x. \<forall>r. \<kappa> x {..real_of_rat r} = \<kappa>'' x {..real_of_rat r}"
         unfolding AE_all_countable
       proof safe
         fix r
         have "AE x in r.\<nu>x. (\<kappa>'' x) {..real_of_rat r} = r.\<kappa>' x {..real_of_rat r}"
         proof(safe intro!: r.\<nu>x.RN_deriv_unique[of "\<lambda>x. \<kappa>'' x {..real_of_rat r}" "marginal_measure_on X borel \<nu> {..real_of_rat r}",simplified r.\<kappa>'_def[of _ "{..real_of_rat r}",symmetric]])
           show 1:"(\<lambda>x. emeasure (\<kappa>'' x) {..real_of_rat r}) \<in> borel_measurable r.\<nu>x"
             using \<kappa>''.emeasure_measurable[of "{..real_of_rat r}"] sets_marginal_measure[of X borel \<nu> "space borel"] by simp
           show "density r.\<nu>x (\<lambda>x. emeasure (\<kappa>'' x) {..real_of_rat r}) = marginal_measure_on X borel \<nu> {..real_of_rat r}"
           proof(rule measure_eqI)
             fix A
             assume "A \<in> sets (density r.\<nu>x (\<lambda>x. (\<kappa>'' x) {..real_of_rat r}))"
             then have A [measurable]:"A \<in> sets X"
               by(simp add: sets_marginal_measure)
             show "emeasure (density r.\<nu>x (\<lambda>x. emeasure (\<kappa>'' x) {..real_of_rat r})) A = emeasure (marginal_measure_on X borel \<nu> {..real_of_rat r}) A" (is "?lhs = ?rhs")
             proof -
               have "?lhs = (\<integral>\<^sup>+x\<in>A. (\<kappa>'' x) {..real_of_rat r} \<partial>r.\<nu>x)"
                 using emeasure_density[OF 1,of A] A 
                 by(simp add: sets_marginal_measure)
               also have "... = \<nu> (A \<times> {..real_of_rat r})"
                 using disi A by(auto simp: \<kappa>''.disintegration_def)
               also have "... = ?rhs"
                 by(simp add: emeasure_marginal_measure_on[OF nu_sets' _ A])
               finally show ?thesis .
             qed
           qed(simp add: sets_marginal_measure)
         qed
         with \<kappa>_AE[of r]
         show "AE x in r.\<nu>x. \<kappa> x {..real_of_rat r} = \<kappa>'' x {..real_of_rat r}"
           by auto
       qed
       { fix x
         assume h:"x \<in> space r.\<nu>x" " \<forall>r. (\<kappa> x) {..real_of_rat r} = (\<kappa>'' x) {..real_of_rat r}"
         then have x: "x \<in> space X"
           by(simp add: space_marginal_measure)
         have "\<kappa> x = \<kappa>'' x"
         proof(rule measure_eqI_generator_eq[OF atMostq_Int_stable,of UNIV _ _ "\<lambda>n. {..real n}"])
           show "\<And>A. A \<in> {{..r} |r. r \<in> \<rat>} \<Longrightarrow> (\<kappa> x) A = (\<kappa>'' x) A"
             using h(2) Rats_cases by auto
         next
           show "(\<Union>n. {..real n}) = UNIV"
             by (simp add: real_arch_simple subsetI subset_antisym)
         next
           fix n
           have "(\<kappa> x) {..real n} \<le> \<kappa> x UNIV"
             by(auto intro!: emeasure_mono)
           also have "... = 1"
             by(rule \<kappa>(1)[OF x])
           finally show "(\<kappa> x) {..real n} \<noteq> \<infinity>"
             using linorder_not_le by fastforce
         next
           show "range (\<lambda>n. {..real n}) \<subseteq> {{..r} |r. r \<in> \<rat>}"
             using Rats_of_nat by blast
         qed(auto simp: \<kappa>.kernel_sets[OF x] \<kappa>''.kernel_sets[OF x] rborel_eq_atMostq_sets)
       }
       then show "AE x in r.\<nu>x. \<kappa> x = \<kappa>'' x"
         using eq_atMostr_AE by fastforce
     qed(auto simp del: space_borel simp add: \<kappa>_dis \<kappa>.prob_kernel_axioms)
   qed
 
   show ?thesis
   proof -
     define \<nu>' where "\<nu>' = distr \<nu> (X \<Otimes>\<^sub>M borel) (\<lambda>(x,y). (x, to_real y))"
     have \<nu>_distr:"\<nu> = distr \<nu>' (X \<Otimes>\<^sub>M Y) (\<lambda>(x,y). (x, from_real y))"
       using nu_sets sets_eq_imp_space_eq[OF nu_sets] from_real_to_real
       by(auto simp: \<nu>'_def distr_distr space_pair_measure intro!: distr_id'[symmetric])
     have \<nu>x_eq:"(marginal_measure X borel \<nu>') = \<nu>x"
       using emeasure_marginal_measure[of \<nu>' X borel] emeasure_marginal_measure[OF nu_sets] sets_eq_imp_space_eq[OF nu_sets]
       by(auto intro!: measure_eqI simp: sets_marginal_measure \<nu>'_def emeasure_distr map_prod_vimage[of id to_real,simplified map_prod_def id_def] space_pair_measure Times_Int_Times)
     interpret \<nu>' : projection_sigma_finite X borel \<nu>'
       by(auto simp: projection_sigma_finite_def \<nu>x_eq \<nu>x.sigma_finite_measure_axioms simp del: space_borel,auto simp add: \<nu>'_def)
     obtain \<kappa>' where \<kappa>': "prob_kernel X borel \<kappa>'" "measure_kernel.disintegration X borel \<kappa>' \<nu>' \<nu>'.\<nu>x"
          "\<And>\<kappa>''. prob_kernel X borel \<kappa>'' \<Longrightarrow> measure_kernel.disintegration X borel \<kappa>'' \<nu>' \<nu>'.\<nu>x \<Longrightarrow> (AE x in \<nu>'.\<nu>x. \<kappa>' x = \<kappa>'' x)"
       using *[of \<nu>' X] \<nu>'.nu_sets \<nu>'.\<nu>x.sigma_finite_measure_axioms by blast
     interpret \<kappa>': prob_kernel X borel \<kappa>' by fact
     define \<kappa> where "\<kappa> \<equiv> (\<lambda>x. distr (\<kappa>' x) Y from_real)"
     interpret \<kappa>: prob_kernel X Y \<kappa>
       by(auto simp: prob_kernel_def' \<kappa>_def)
     have disi: "\<kappa>.disintegration \<nu> \<nu>x"
     proof(rule \<kappa>.disintegrationI)
       fix A B
       assume A[measurable]:"A \<in> sets X" and B[measurable]: "B \<in> sets Y"
       have [measurable]: "from_real -` B \<in> sets borel"
         by(simp add: measurable_sets_borel[OF _ B])
       show "\<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. \<kappa> x B\<partial>\<nu>x)" (is "?lhs = ?rhs")
       proof -
         have "?lhs = \<nu>' (A \<times> (from_real -` B))"
           by(auto simp: \<nu>_distr emeasure_distr map_prod_vimage[of id from_real,simplified map_prod_def id_def])
         also have "... = (\<integral>\<^sup>+x\<in>A. \<kappa>' x (from_real -` B) \<partial>\<nu>x)"
           using \<kappa>'.disintegrationD[OF \<kappa>'(2),of A "from_real -` B"]
           by(auto simp add: \<nu>x_eq simp del: space_borel)
         also have "... = ?rhs"
           by(auto intro!: nn_integral_cong simp: space_marginal_measure \<kappa>_def emeasure_distr)
         finally show ?thesis .
       qed
     qed(simp_all add: sets_marginal_measure nu_sets)
 
     show ?thesis
     proof(safe intro!: exI[where x=\<kappa>])
       fix \<kappa>''
       assume h:"prob_kernel X Y \<kappa>''"
                "measure_kernel.disintegration X Y \<kappa>'' \<nu> \<nu>x"
       interpret \<kappa>'': prob_kernel X Y \<kappa>'' by fact
       show "AE x in \<nu>x. \<kappa> x = \<kappa>'' x"
       proof -
        define \<kappa>''' where "\<kappa>''' \<equiv> (\<lambda>x. distr (\<kappa>'' x) borel to_real)"
         interpret \<kappa>''': prob_kernel X borel \<kappa>'''
           by(auto simp: prob_kernel_def' \<kappa>'''_def)
         have \<kappa>''_def: "\<kappa>'' x = distr (\<kappa>''' x) Y from_real" if "x \<in> space X" for x
           using distr_distr[of from_real borel Y to_real "\<kappa>'' x",simplified measurable_cong_sets[OF \<kappa>''.kernel_sets[OF that] refl,of borel]] 
           by(auto simp: \<kappa>'''_def comp_def \<kappa>''.kernel_sets[OF that] measurable_cong_sets[OF \<kappa>''.kernel_sets[OF that] \<kappa>''.kernel_sets[OF that]] sets_eq_imp_space_eq[OF \<kappa>''.kernel_sets[OF that]] intro!: distr_id'[symmetric])
         have \<kappa>'''_disi: "\<kappa>'''.disintegration \<nu>' \<nu>'.\<nu>x"
         proof(rule \<kappa>'''.disintegrationI)
           fix A and B :: "real set"
           assume A[measurable]:"A \<in> sets X" and B[measurable]:"B \<in> sets borel"
           show "\<nu>' (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa>''' x) B \<partial>\<nu>'.\<nu>x)" (is "?lhs = ?rhs")
           proof -
             have "?lhs = \<nu> (A \<times> (to_real -` B \<inter> space Y))"
               by(auto simp: \<nu>'_def emeasure_distr map_prod_vimage[of id to_real,simplified map_prod_def id_def] sets_eq_imp_space_eq[OF nu_sets] space_pair_measure Times_Int_Times)
             also have "... = (\<integral>\<^sup>+x\<in>A. (\<kappa>'' x) (to_real -` B \<inter> space Y) \<partial>\<nu>x)"
               using \<kappa>''.disintegrationD[OF h(2) A,of "to_real -` B \<inter> space Y"] by auto
             also have "... = ?rhs"
               by(auto simp: \<nu>x_eq[symmetric] space_marginal_measure \<kappa>'''_def emeasure_distr sets_eq_imp_space_eq[OF \<kappa>''.kernel_sets] intro!: nn_integral_cong)
             finally show ?thesis .
           qed
         qed(auto simp: \<nu>'_def sets_marginal_measure) 
         show ?thesis
           by(rule AE_mp[OF \<kappa>'(3)[OF \<kappa>'''.prob_kernel_axioms \<kappa>'''_disi,simplified \<nu>x_eq]],standard) (auto simp: space_marginal_measure \<kappa>''_def \<kappa>_def)
       qed
     qed(simp_all add: disi \<kappa>.prob_kernel_axioms)
   qed
 qed
 
 end
 
 subsection \<open> Lemma 14.D.12. \<close>
 lemma ex_finite_density_measure:
   fixes A :: "nat \<Rightarrow> _"
   assumes A: "range A \<subseteq> sets M" "\<Union> (range A) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>" "disjoint_family A"
   defines "h \<equiv> (\<lambda>x. (\<Sum>n. (1/2)^(Suc n) * (1 / (1 + M (A n))) * indicator (A n) x))"
   shows "h \<in> borel_measurable M"
         "\<And>x. x \<in> space M \<Longrightarrow> 0 < h x"
         "\<And>x. x \<in> space M \<Longrightarrow> h x < 1"
         "finite_measure (density M h)"
 proof -
   have less1:"0 < 1 / (1 + M (A n))" "1 / (1 + M (A n)) \<le> 1" for n
     using A(3)[of n] ennreal_zero_less_divide[of 1 "1 + M (A n)"]
     by (auto intro!: divide_le_posI_ennreal simp: add_pos_nonneg)
   show [measurable]:"h \<in> borel_measurable M"
     using A by(simp add: h_def)
   {
     fix x
     assume x:"x \<in> space M"
     then obtain i where i: "x \<in> A i"
       using A(2) by auto
     show "0 < h x"
       using A(3)[of i] less1[of i]
       by(auto simp: h_def suminf_pos_iff i ennreal_divide_times ennreal_zero_less_divide power_divide_distrib_ennreal power_less_top_ennreal intro!: exI[where x=i])
     have "h x = (\<Sum>n. (1/2)^(Suc n + 2) * (1 / (1 + M (A (n + 2)))) * indicator (A (n + 2)) x) + (1/2) * (1 / (1 + M (A 0))) * indicator (A 0) x + (1/2)^2 * (1 / (1 + M (A 1))) * indicator (A 1) x"
       by(auto simp: h_def suminf_split_head suminf_offset[of "\<lambda>n. (1/2)^(Suc n) * (1 / (1 + M (A n))) * indicator (A n) x" 2] simp del: power_Suc sum_mult_indicator) (auto simp: numeral_2_eq_2)
     also have "... \<le> 1/4 +  (1/2) * (1 / (1 + M (A 0))) * indicator (A 0) x + (1/2)^2 * (1 / (1 + M (A 1))) * indicator (A 1) x"
     proof -
       have "(\<Sum>n. (1/2)^(Suc n + 2) * (1 / (1 + M (A (n + 2)))) * indicator (A (n + 2)) x) \<le> (\<Sum>n. (1/2)^(Suc n + 2))"
         using less1(2)[of "Suc (Suc _)"] by(intro suminf_le,auto simp: indicator_def) (metis mult.right_neutral mult_left_mono zero_le)
       also have "... = (\<Sum>n. ennreal ((1 / 2) ^ (Suc n + 2)))"
         by(simp only: ennreal_power[of "1/2",symmetric]) (metis divide_ennreal ennreal_1 ennreal_numeral linorder_not_le not_one_less_zero zero_less_numeral)
       also have "... = ennreal (\<Sum>n. (1 / 2) ^ (Suc n + 2))"
         by(rule suminf_ennreal2) auto
       also have "... = ennreal (1/4)"
         using nsum_of_r'[of "1/2" "Suc (Suc (Suc 0))" 1] by auto
       also have "... = 1 / 4"
         by (metis ennreal_divide_numeral ennreal_numeral numeral_One zero_less_one_class.zero_le_one)
       finally show ?thesis by simp
     qed
     also have "... < 1" (is "?lhs < _")
     proof(cases "x \<in> A 0")
       case True
       then have "x \<notin> A 1"
         using A(4) by (auto simp: disjoint_family_on_def)
       hence "?lhs =  1 / 4 + 1 / 2 * (1 / (1 + emeasure M (A 0)))"
         by(simp add: True)
       also have "... \<le> 1 / 4 + 1 / 2"
         using less1(2)[of 0] by (simp add: divide_right_mono_ennreal ennreal_divide_times)
       also have "... = 1 / 4 + 2 / 4"
         using divide_mult_eq[of 2 1 2] by simp
       also have "... = 3 / 4"
         by(simp add: add_divide_distrib_ennreal[symmetric])
       also have "... < 1"
         by(simp add: divide_less_ennreal)
       finally show ?thesis .
     next
       case False
       then have "?lhs = 1 / 4 + (1 / 2)\<^sup>2 * (1 / (1 + emeasure M (A 1))) * indicator (A 1) x"
         by simp
       also have "... \<le>  1 / 4 + (1 / 2)\<^sup>2"
         by (metis less1(2)[of 1] add_left_mono indicator_eq_0_iff indicator_eq_1_iff mult.right_neutral mult_eq_0_iff mult_left_mono zero_le)
       also have "... = 2 / 4"
         by(simp add: power_divide_distrib_ennreal add_divide_distrib_ennreal[symmetric])
       also have "... < 1"
         by(simp add: divide_less_ennreal)
       finally show ?thesis .
     qed
     finally show "h x < 1" .
   }
   show "finite_measure (density M h)"
   proof
     show "emeasure (density M h) (space (density M h)) \<noteq> \<infinity>"
     proof -
       have "integral\<^sup>N M h \<noteq> \<top>" (is "?lhs \<noteq> _")
       proof -
         have "?lhs = (\<Sum>n. (\<integral>\<^sup>+ x\<in>A n. ((1/2)^(Suc n) * (1 / (1 + M (A n)))) \<partial>M))"
           using A by(simp add: h_def nn_integral_suminf)
         also have "... = (\<Sum>n. (1/2)^(Suc n) * (1 / (1 + M (A n))) * M (A n))"
           by(rule suminf_cong,rule nn_integral_cmult_indicator) (use A in auto)
         also have "... = (\<Sum>n. (1/2)^(Suc n) * ((1 / (1 + M (A n))) * M (A n)))"
           by (simp add: mult.assoc)
         also have "... \<le> (\<Sum>n. (1/2)^(Suc n))"
         proof -
           have "(1 / (1 + M (A n))) * M (A n) \<le> 1" for n
             using A(3)[of n] by (simp add: add_pos_nonneg divide_le_posI_ennreal ennreal_divide_times)
           thus ?thesis
             by(intro suminf_le) (metis mult.right_neutral mult_left_mono zero_le,auto)
         qed
         also have "... = (\<Sum>n. ennreal ((1/2)^(Suc n)))"
           by(simp only: ennreal_power[of "1/2",symmetric]) (metis divide_ennreal ennreal_1 ennreal_numeral linorder_not_le not_one_less_zero zero_less_numeral)
         also have "... = ennreal (\<Sum>n. (1/2)^(Suc n))"
           by(rule suminf_ennreal2) auto
         also have "... = 1"
           using nsum_of_r'[of "1/2" 1 1] by auto
         finally show ?thesis
           using nle_le by fastforce
       qed
       thus ?thesis
         by(simp add: emeasure_density)
     qed
   qed
 qed
 
 lemma(in sigma_finite_measure) finite_density_measure:
   obtains h where "h \<in> borel_measurable M"
                   "\<And>x. x \<in> space M \<Longrightarrow> 0 < h x"
                   "\<And>x. x \<in> space M \<Longrightarrow> h x < 1"
                   "finite_measure (density M h)"
   by (metis (no_types, lifting) sigma_finite_disjoint ex_finite_density_measure)
 
 subsection \<open> Lemma 14.D.13. \<close>
 lemma (in measure_kernel)
   assumes "disintegration \<nu> \<mu>"
   defines "\<nu>x \<equiv> marginal_measure X Y \<nu>"
   shows disintegration_absolutely_continuous: "absolutely_continuous \<mu> \<nu>x"
     and disintegration_density: "\<nu>x = density \<mu> (\<lambda>x. \<kappa> x (space Y))"
     and disintegration_absolutely_continuous_iff:
         "absolutely_continuous \<nu>x \<mu> \<longleftrightarrow> (AE x in \<mu>. \<kappa> x (space Y) > 0)"
 proof -
   note sets_eq[measurable_cong] = disintegration_sets_eq[OF assms(1)]
   note [measurable] = emeasure_measurable[OF sets.top]
   have \<nu>x_eq: "\<nu>x A = (\<integral>\<^sup>+x\<in>A. (\<kappa> x (space Y)) \<partial>\<mu>)" if A:"A \<in> sets X" for A
     by(simp add: disintegrationD[OF assms(1) A sets.top] emeasure_marginal_measure[OF sets_eq(1) A] \<nu>x_def)
   thus 1:"\<nu>x = density \<mu> (\<lambda>x. \<kappa> x (space Y))"
     by(auto intro!: measure_eqI simp: sets_marginal_measure \<nu>x_def sets_eq emeasure_density)
   hence sets_\<nu>x:"sets \<nu>x = sets X"
     using sets_eq by simp
   show "absolutely_continuous \<mu> \<nu>x"
     unfolding absolutely_continuous_def
   proof safe
     fix A
     assume A: "A \<in> null_sets \<mu>"
     have "0 = (\<integral>\<^sup>+x\<in>A. (\<kappa> x (space Y)) \<partial>\<mu>)"
       by(simp add: A nn_integral_null_set)
     also have "... = \<nu>x A"
       using A \<nu>x_eq[of A,simplified sets_eq(2)[symmetric]]
       by auto
     finally show "A \<in> null_sets \<nu>x"
       using A by(auto simp: null_sets_def \<nu>x_def sets_marginal_measure sets_eq)
   qed
   show "absolutely_continuous \<nu>x \<mu> \<longleftrightarrow> (AE x in \<mu>. \<kappa> x (space Y) > 0)"
   proof
     assume h:"absolutely_continuous \<nu>x \<mu>"
     define N where "N = {x \<in> space \<mu>. (\<kappa> x) (space Y) = 0}"
     have "N \<in> null_sets \<mu>"
     proof -
       have "\<nu>x N = (\<integral>\<^sup>+x\<in>N. (\<kappa> x (space Y)) \<partial>\<mu>)"
         using \<nu>x_eq[of N] by(simp add: N_def sets_eq_imp_space_eq[OF sets_eq(2)])
       also have "... = (\<integral>\<^sup>+x\<in>N. 0 \<partial>\<mu>)"
         by(rule nn_integral_cong) (auto simp: N_def indicator_def)
       also have "... = 0" by simp
       finally have "N \<in> null_sets \<nu>x"
         by(auto simp: null_sets_def 1 N_def)
       thus ?thesis
         using h by(auto simp: absolutely_continuous_def)
     qed
     then show "AE x in \<mu>. 0 < (\<kappa> x) (space Y)"
       by(auto intro!: AE_I'[OF _ subset_refl] simp: N_def)
   next
     assume "AE x in \<mu>. 0 < (\<kappa> x) (space Y)"
     then show "absolutely_continuous \<nu>x \<mu>"
       using \<nu>x_eq by(auto simp: absolutely_continuous_def intro!: null_if_pos_func_has_zero_nn_int[where f="\<lambda>x. emeasure (\<kappa> x) (space Y)"]) (auto simp: null_sets_def sets_\<nu>x)
   qed
 qed
 
 subsection \<open> Theorem 14.D.14. \<close>
 locale sigma_finite_measure_on_pair_standard = sigma_finite_measure_on_pair + standard_borel_ne Y
 
 sublocale projection_sigma_finite_standard \<subseteq> sigma_finite_measure_on_pair_standard
   by (simp add: sigma_finite_measure_on_pair_axioms sigma_finite_measure_on_pair_standard_def standard_borel_ne_axioms)
 
 context sigma_finite_measure_on_pair_standard
 begin
 
 lemma measure_disintegration_extension:
    "\<exists>\<mu> \<kappa>. finite_measure \<mu> \<and> measure_kernel X Y \<kappa> \<and> measure_kernel.disintegration X Y \<kappa> \<nu> \<mu> \<and>
                (\<forall>x\<in>space X. sigma_finite_measure (\<kappa> x)) \<and>
                (\<forall>x\<in>space X. \<kappa> x (space Y) > 0) \<and>
                 \<mu> ~\<^sub>M \<nu>x" (is "?goal")
 proof(rule sigma_finite_measure.sigma_finite_disjoint[OF sigma_finite])
   fix A :: "nat \<Rightarrow> _"
   assume A:"range A \<subseteq> sets \<nu>" "\<Union> (range A) = space \<nu>" "\<And>i. emeasure \<nu> (A i) \<noteq> \<infinity>" "disjoint_family A"
   define h where "h \<equiv> (\<lambda>x. \<Sum>n. (1 / 2) ^ Suc n * (1 / (1 + emeasure \<nu> (A n))) * indicator (A n) x)"
   have h: "h \<in> borel_measurable \<nu>" "\<And>x y. x \<in> space X \<Longrightarrow> y \<in> space Y \<Longrightarrow> 0 < h (x,y)" "\<And>x y. x \<in> space X \<Longrightarrow> y \<in> space Y \<Longrightarrow> h (x,y) < 1" "finite_measure (density \<nu> h)"
     using ex_finite_density_measure[OF A] by(auto simp: sets_eq_imp_space_eq[OF nu_sets] h_def space_pair_measure)
 
   interpret psfs_\<nu>x: finite_measure "marginal_measure X Y (density \<nu> h)"
     by(rule finite_measure_marginal_measure_finite[OF h(4),simplified,OF nu_sets])
 
   interpret psfs: projection_sigma_finite_standard X Y "density \<nu> h"
     by(auto simp: projection_sigma_finite_standard_def projection_sigma_finite_def standard_borel_ne_axioms nu_sets finite_measure.sigma_finite_measure[OF finite_measure_marginal_measure_finite[OF h(4),simplified,OF nu_sets]])
   from psfs.measure_disintegration
   obtain \<kappa>' where \<kappa>': "prob_kernel X Y \<kappa>'" "measure_kernel.disintegration X Y \<kappa>' (density \<nu> h) psfs.\<nu>x" by auto
   interpret pk: prob_kernel X Y \<kappa>' by fact
   define \<kappa> where "\<kappa> \<equiv> (\<lambda>x. density (\<kappa>' x) (\<lambda>y. 1 / h (x,y)))"
   have \<kappa>B: "\<kappa> x B = (\<integral>\<^sup>+y\<in>B. (1 / h (x, y))\<partial>\<kappa>' x)" if "x \<in> space X" and [measurable]:"B \<in> sets Y" for x B
     using nu_sets pk.kernel_sets[OF that(1)] that h(1) by(auto simp: \<kappa>_def emeasure_density)
   interpret mk: measure_kernel X Y \<kappa>
   proof
     fix B
     assume [measurable]:"B \<in> sets Y"
     have 1:"(\<lambda>x. \<integral>\<^sup>+y\<in>B. (1 / h (x, y))\<partial>\<kappa>' x) \<in> borel_measurable X"
       using h(1) nu_sets by(auto intro!: pk.nn_integral_measurable_f'[of "\<lambda>z. (1 / h z) * indicator B (snd z)",simplified])
     show "(\<lambda>x. (\<kappa> x) B) \<in> borel_measurable X"
       by(rule measurable_cong[THEN iffD1,OF _ 1],simp add: \<kappa>B)
   qed(simp_all add: \<kappa>_def pk.kernel_sets space_ne)
 
   have disi: "mk.disintegration \<nu> psfs.\<nu>x"
   proof(rule mk.disintegrationI)
     fix A B
     assume A[measurable]:"A \<in> sets X" and B[measurable]:"B \<in> sets Y"
     show "\<nu> (A \<times> B) = (\<integral>\<^sup>+x\<in>A. (\<kappa> x) B\<partial>psfs.\<nu>x)" (is "?lhs = ?rhs")
     proof -
       have "?lhs = (\<integral>\<^sup>+z\<in>A \<times> B. 1 \<partial>\<nu>)"
         by auto
       also have "... = (\<integral>\<^sup>+z\<in>A \<times> B. (1 / h z * h z) \<partial>\<nu>)"
       proof -
         have 1: "a * (1 / a) = 1" if "0 < a" "a < 1" for a :: ennreal
         proof -
           have "a * (1 / a) = ennreal (enn2real a * 1 / (enn2real a))"
             by (simp add: divide_eq_1_ennreal enn2real_eq_0_iff ennreal_times_divide)
           also have "... = ennreal 1"
             using enn2real_eq_0_iff that by fastforce
           finally show ?thesis
             using ennreal_1 by simp
         qed
         show ?thesis
           by(rule nn_integral_cong,auto simp add: sets_eq_imp_space_eq[OF nu_sets] space_pair_measure ennreal_divide_times indicator_def 1[OF h(2,3)])
       qed
       also have "... = (\<integral>\<^sup>+z. h z * ((1 / h z) * indicator (A \<times> B) z) \<partial>\<nu>)"
         by(auto intro!: nn_integral_cong simp: indicator_def mult.commute)
       also have "... = (\<integral>\<^sup>+z\<in>A \<times> B. (1 / h z) \<partial>(density \<nu> h))"
         using h(1) by(simp add: nn_integral_density)
       also have "... = (\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. (1 / h (x,y) * indicator (A \<times> B) (x,y)) \<partial>\<kappa>' x \<partial>psfs.\<nu>x)"
         using h(1) by(simp add: pk.nn_integral_fst_finite'[OF _ \<kappa>'(2) psfs_\<nu>x.finite_measure_axioms])
       also have "... = (\<integral>\<^sup>+ x\<in>A. (\<integral>\<^sup>+ y\<in>B. (1 / h (x,y)) \<partial>\<kappa>' x) \<partial>psfs.\<nu>x)"
         by(auto intro!: nn_integral_cong simp: indicator_def)
       also have "... = ?rhs"
         by(auto intro!: nn_integral_cong simp: \<kappa>B[OF _ B] space_marginal_measure)
       finally show ?thesis .
     qed
   qed(simp_all add: nu_sets sets_marginal_measure)
   have geq0: "0 < (\<kappa> x) (space Y)" if "x \<in> space X" for x
   proof -
     have "0 = (\<integral>\<^sup>+ y. 0 \<partial>\<kappa>' x)" by simp
     also have "... < (\<integral>\<^sup>+ y. (1 / h (x,y)) \<partial>\<kappa>' x)"
     proof(rule nn_integral_less)
       show "\<not> (AE y in \<kappa>' x. 1 / h (x, y) \<le> 0)"
       proof
         assume "AE y in \<kappa>' x. 1 / h (x, y) \<le> 0"
         moreover have "h (x,y) \<noteq> \<top>" if "y \<in> space (\<kappa>' x)" for y
           using h(3)[OF \<open>x \<in> space X\<close> that[simplified sets_eq_imp_space_eq[OF pk.kernel_sets[OF \<open>x \<in> space X\<close>]]]] top.not_eq_extremum
           by fastforce
         ultimately show False
           using prob_space.AE_False[OF pk.prob_spaces[OF that]] by simp
       qed
     qed(use h(1) pk.kernel_sets[OF that] that in auto)
     also have "... = (\<kappa> x) (space Y)"
       by(simp add: \<kappa>B[OF that sets.top]) (simp add: sets_eq_imp_space_eq[OF pk.kernel_sets[OF that],symmetric])
     finally show ?thesis .
   qed
 
   show ?goal
   proof(safe intro!: exI[where x=psfs.\<nu>x] exI[where x=\<kappa>] disi)
     show "absolutely_continuous \<nu>x psfs.\<nu>x"
       unfolding mk.disintegration_absolutely_continuous_iff[OF disi]
       by standard (simp add: space_marginal_measure geq0)
   next
     fix x
     assume x:"x \<in> space X"
     define C where "C \<equiv> range (\<lambda>n. Pair x -` (A n) \<inter> space Y)"
     have 1:"countable C" "C \<subseteq> sets Y"
       using A(1,2) x by (auto simp: nu_sets sets_eq_imp_space_eq[OF nu_sets] space_pair_measure C_def)
     have 2: "\<Union> C = space Y"
       using A(1,2)  by(auto simp: sets_eq_imp_space_eq[OF nu_sets] space_pair_measure C_def) (use x in auto)
 
     show "sigma_finite_measure (\<kappa> x)"
       unfolding sigma_finite_measure_def
     proof(safe intro!: exI[where x=C])
       fix c
       assume "c \<in> C" "(\<kappa> x) c = \<infinity>"
       then obtain n where c:"c = Pair x -` (A n) \<inter> space Y" by(auto simp: C_def)
       have "(\<kappa> x) c = (\<integral>\<^sup>+y\<in>c. (1 / h (x, y))\<partial>\<kappa>' x)"
         using \<kappa>B[OF x,of c] 1 \<open>c \<in> C\<close> by auto
       also have "... = (\<integral>\<^sup>+y\<in>Pair x -` (A n). (1 / h (x, y))\<partial>\<kappa>' x)"
         by(auto intro!: nn_integral_cong simp: c indicator_def sets_eq_imp_space_eq[OF pk.kernel_sets[OF x]])
       also have "... = (\<integral>\<^sup>+y\<in>Pair x -` (A n). (1 / ((1 / 2) ^ Suc n * (1 / (1 + emeasure \<nu> (A n))))) \<partial>\<kappa>' x)"
       proof -
         {
           fix y
           assume xy:"(x, y) \<in> A n"
           have "1 / h (x, y) = 1 / ((1 / 2) ^ Suc n * (1 / (1 + emeasure \<nu> (A n))))"
           proof -
             have "h (x, y) = (1 / 2) ^ Suc n * (1 / (1 + emeasure \<nu> (A n)))" (is "?lhs = ?rhs")
             proof -
               have "?lhs = (\<Sum>m. (1 / 2) ^ Suc m * (1 / (1 + emeasure \<nu> (A m))) * indicator (A m) (x,y))"
                 by(simp add: h_def)
               also have "... = (\<Sum>m. if m = n then (1 / 2) ^ Suc n * (1 / (1 + emeasure \<nu> (A n))) else 0)"
                 using xy A(4) by(fastforce intro!: suminf_cong simp: disjoint_family_on_def indicator_def)
               also have "... = (\<Sum>j. if j + Suc n = n then (1 / 2) ^ Suc n * (1 / (1 + emeasure \<nu> (A n))) else 0) + (\<Sum>j<Suc n. if j = n then (1 / 2) ^ Suc n * (1 / (1 + emeasure \<nu> (A n))) else 0)"
                 by(auto simp: suminf_offset[of "\<lambda>m. if m = n then (1 / 2) ^ Suc n * (1 / (1 + emeasure \<nu> (A n))) else 0" "Suc n"] simp del: power_Suc)
               also have "... = ?rhs"
                 by simp
               finally show ?thesis .
             qed
             thus ?thesis by simp
           qed
         }
         thus ?thesis
           by(intro nn_integral_cong) (auto simp: sets_eq_imp_space_eq[OF pk.kernel_sets[OF x]] indicator_def simp del: power_Suc)
       qed
       also have "... \<le> (\<integral>\<^sup>+y. (1 / ((1 / 2) ^ Suc n * (1 / (1 + emeasure \<nu> (A n))))) \<partial>\<kappa>' x)"
         by(rule nn_integral_mono) (auto simp: indicator_def)
       also have "... = (1 / ((1 / 2) ^ Suc n * (1 / (1 + emeasure \<nu> (A n)))))"
         by(simp add: prob_space.emeasure_space_1[OF pk.prob_spaces[OF x]])
       also have "... < \<infinity>"
         by (metis A(3) ennreal_add_eq_top ennreal_divide_eq_0_iff ennreal_divide_eq_top_iff ennreal_top_neq_one infinity_ennreal_def mult_eq_0_iff power_eq_0_iff top.not_eq_extremum top_neq_numeral)
       finally show False
         using \<open>(\<kappa> x) c = \<infinity>\<close> by simp
     qed(insert 1 2, auto simp: mk.kernel_sets[OF x] sets_eq_imp_space_eq[OF mk.kernel_sets[OF x]])
   qed(auto simp: psfs_\<nu>x.finite_measure_axioms geq0 mk.measure_kernel_axioms mk.disintegration_absolutely_continuous[OF disi])
 qed
 
 end
 
 (* TODO: \<open>AE x in \<mu>. \<forall>B \<in> sets Y. ... = ...\<close> for a standard Borel Y. *)
 lemma(in sigma_finite_measure_on_pair) measure_disintegration_extension_AE_unique:
   assumes "sigma_finite_measure \<mu>" "sigma_finite_measure \<mu>'"
           "measure_kernel X Y \<kappa>" "measure_kernel X Y \<kappa>'"
           "measure_kernel.disintegration X Y \<kappa> \<nu> \<mu>" "measure_kernel.disintegration X Y \<kappa>' \<nu> \<mu>'"
       and "absolutely_continuous \<mu> \<mu>'" "B \<in> sets Y"
     shows "AE x in \<mu>. \<kappa>' x B * RN_deriv \<mu> \<mu>' x = \<kappa> x B"
 proof -
   interpret s1: sigma_finite_measure \<mu> by fact
   interpret s2: sigma_finite_measure \<mu>' by fact
   interpret mk1: measure_kernel X Y \<kappa> by fact
   interpret mk2: measure_kernel X Y \<kappa>' by fact
   have sets[measurable_cong]:"sets \<mu> = sets X" "sets \<mu>' = sets X"
     using assms(5,6) by(auto dest: mk1.disintegration_sets_eq mk2.disintegration_sets_eq)
   have 1:"AE x in \<mu>. \<kappa> x B = RN_deriv \<mu> (marginal_measure_on X Y \<nu> B) x"
     using sets mk1.emeasure_measurable[OF assms(8)] mk1.disintegrationD[OF assms(5) _ assms(8)]
     by(auto intro!: measure_eqI s1.RN_deriv_unique  simp: emeasure_density emeasure_marginal_measure_on[OF nu_sets assms(8)] sets sets_marginal_measure)
   have 2:"AE x in \<mu>. \<kappa>' x B * RN_deriv \<mu> \<mu>' x = RN_deriv \<mu> (marginal_measure_on X Y \<nu> B) x"
   proof -
     {
       fix A
       assume A: "A \<in> sets X"
       have "(\<integral>\<^sup>+x\<in>A.  ((\<kappa>' x) B * RN_deriv \<mu> \<mu>' x) \<partial>\<mu>) = (\<integral>\<^sup>+x. RN_deriv \<mu> \<mu>' x * (\<kappa>' x B * indicator A x)\<partial>\<mu>)"
         by(auto intro!: nn_integral_cong simp: indicator_def mult.commute)
       also have "... = (\<integral>\<^sup>+x\<in>A. \<kappa>' x B \<partial>\<mu>')"
         using mk2.emeasure_measurable[OF assms(8)] sets A
         by(auto intro!: s1.RN_deriv_nn_integral[OF assms(7),symmetric])
       also have "... = \<nu> (A \<times> B)"
         by(simp add: mk2.disintegrationD[OF assms(6) A assms(8)])
       finally have "(\<integral>\<^sup>+x\<in>A.  ((\<kappa>' x) B * RN_deriv \<mu> \<mu>' x) \<partial>\<mu>) = \<nu> (A \<times> B)" .
     }
     thus ?thesis
       using sets mk2.emeasure_measurable[OF assms(8)] 
       by(auto intro!: measure_eqI s1.RN_deriv_unique  simp: emeasure_density emeasure_marginal_measure_on[OF nu_sets assms(8)]sets sets_marginal_measure)
   qed
   show ?thesis
     using 1 2 by auto
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Hidden_Markov_Models/Hidden_Markov_Model.thy b/thys/Hidden_Markov_Models/Hidden_Markov_Model.thy
--- a/thys/Hidden_Markov_Models/Hidden_Markov_Model.thy
+++ b/thys/Hidden_Markov_Models/Hidden_Markov_Model.thy
@@ -1,626 +1,625 @@
 section \<open>Hidden Markov Models\<close>
 
 theory Hidden_Markov_Model
   imports
     Markov_Models.Discrete_Time_Markov_Chain Auxiliary
     "HOL-Library.IArray"
 begin
 
 subsection \<open>Definitions\<close>
 
 text \<open>Definition of Markov Kernels that are closed w.r.t. to a set of states.\<close>
 locale Closed_Kernel =
   fixes K :: "'s \<Rightarrow> 't pmf" and S :: "'t set"
   assumes finite: "finite S"
       and wellformed: "S \<noteq> {}"
       and closed: "\<forall> s. K s \<subseteq> S"
 
 text \<open>
   An HMM is parameterized by a Markov kernel for the transition probabilites between internal states,
   a Markov kernel for the output probabilities of observations,
   and a fixed set of observations.
 \<close>
 locale HMM_defs =
   fixes \<K> :: "'s \<Rightarrow> 's pmf" and \<O> :: "'s \<Rightarrow> 't pmf" and \<O>\<^sub>s :: "'t set"
 
 locale HMM =
   HMM_defs + O: Closed_Kernel \<O> \<O>\<^sub>s
 begin
 
 lemma observations_finite: "finite \<O>\<^sub>s"
   and observations_wellformed: "\<O>\<^sub>s \<noteq> {}"
   and observations_closed: "\<forall> s. \<O> s \<subseteq> \<O>\<^sub>s"
   using O.finite O.wellformed O.closed by -
 
 end
 
 text \<open>Fixed set of internal states.\<close>
 locale HMM2_defs = HMM_defs \<K> \<O> for \<K> :: "'s \<Rightarrow> 's pmf" and \<O> :: "'s \<Rightarrow> 't pmf" +
   fixes \<S> :: "'s set"
 
 locale HMM2 = HMM2_defs + HMM + K: Closed_Kernel \<K> \<S>
 begin
 
 lemma states_finite: "finite \<S>"
   and states_wellformed: "\<S> \<noteq> {}"
   and states_closed: "\<forall> s. \<K> s \<subseteq> \<S>"
   using K.finite K.wellformed K.closed by -
 
 end
 
 text \<open>
   The set of internal states is now given as a list to iterate over.
   This is needed for the computations on HMMs.
 \<close>
 locale HMM3_defs = HMM2_defs \<O>\<^sub>s \<K> for \<O>\<^sub>s :: "'t set" and \<K> :: "'s \<Rightarrow> 's pmf" +
   fixes state_list :: "'s list"
 
 locale HMM3 = HMM3_defs _ _ \<O>\<^sub>s \<K> + HMM2 \<O>\<^sub>s \<K> for \<O>\<^sub>s :: "'t set" and \<K> :: "'s \<Rightarrow> 's pmf" +
   assumes state_list_\<S>: "set state_list = \<S>"
 
 context HMM_defs
 begin
 
 no_notation (ASCII) comp  (infixl "o" 55)
 
 text \<open>The ``default'' observation.\<close>
 definition
   "obs \<equiv> SOME x. x \<in> \<O>\<^sub>s"
 
 lemma (in HMM) obs:
   "obs \<in> \<O>\<^sub>s"
   unfolding obs_def using observations_wellformed by (auto intro: someI_ex)
 
 text \<open>
   The HMM is encoded as a Markov chain over pairs of states and observations.
   This is the Markov chain's defining Markov kernel.
 \<close>
 definition
   "K \<equiv> \<lambda> (s\<^sub>1, o\<^sub>1 :: 't). bind_pmf (\<K> s\<^sub>1) (\<lambda> s\<^sub>2. map_pmf (\<lambda> o\<^sub>2. (s\<^sub>2, o\<^sub>2)) (\<O> s\<^sub>2))"
 
 sublocale MC_syntax K .
 
 text \<open>
   Uniform distribution of the pairs \<open>(s, o)\<close> for a fixed state \<open>s\<close>.
 \<close>
 definition "I (s :: 's) = map_pmf (\<lambda> x. (s, x)) (pmf_of_set \<O>\<^sub>s)"
 
 text \<open>
   The likelihood of an observation sequence given a starting state \<open>s\<close> is defined in terms of
   the trace space of the Markov kernel given the uniform distribution of pairs for \<open>s\<close>.
 \<close>
 definition
   "likelihood s os = T' (I s) {\<omega> \<in> space S. \<exists> o\<^sub>0 xs \<omega>'. \<omega> = (s, o\<^sub>0) ## xs @- \<omega>' \<and> map snd xs = os}"
 
 abbreviation (input) "L os \<omega> \<equiv> \<exists> xs \<omega>'. \<omega> = xs @- \<omega>' \<and> map snd xs = os"
 
 lemma likelihood_alt_def: "likelihood s os = T' (I s) {(s, o) ## xs @- \<omega>' |o xs \<omega>'. map snd xs = os}"
   unfolding likelihood_def by (simp add: in_S)
 
 
 subsection \<open>Iteration Rule For Likelihood\<close>
 
 lemma L_Nil:
   "L [] \<omega> = True"
   by simp
 
 lemma emeasure_T_observation_Nil:
   "T (s, o\<^sub>0) {\<omega> \<in> space S. L [] \<omega>} = 1"
   by simp
 
 lemma L_Cons:
   "L (o # os) \<omega> \<longleftrightarrow> snd (shd \<omega>) = o \<and> L os (stl \<omega>)"
   apply (cases \<omega>; cases "shd \<omega>"; safe; clarsimp)
    apply force
   subgoal for x xs \<omega>'
     by (force intro: exI[where x = "(x, o) # xs"])
   done
 
 lemma L_measurable[measurable]:
   "Measurable.pred S (L os)"
   apply (induction os)
    apply (simp; fail)
   subgoal premises that for o os
     by(subst L_Cons)
       (intro Measurable.pred_intros_logic
         measurable_compose[OF measurable_shd] measurable_compose[OF measurable_stl that];
         measurable)
   done
 
 lemma init_measurable[measurable]:
   "Measurable.pred S (\<lambda>x. \<exists>o\<^sub>0 xs \<omega>'. x = (s, o\<^sub>0) ## xs @- \<omega>' \<and> map snd xs = os)"
   (is "Measurable.pred S ?f")
 proof -
   have *: "?f \<omega> \<longleftrightarrow> fst (shd \<omega>) = s \<and> L os (stl \<omega>)" for \<omega>
     by (cases \<omega>) auto
   show ?thesis
     by (subst *)
        (intro Measurable.pred_intros_logic measurable_compose[OF measurable_shd]; measurable)
 qed
 
 lemma T_init_observation_eq:
   "T (s, o) {\<omega> \<in> space S. L os \<omega>} = T (s, o') {\<omega> \<in> space S. L os \<omega>}"
   apply (subst emeasure_Collect_T[unfolded space_T], (measurable; fail))
   apply (subst (2) emeasure_Collect_T[unfolded space_T], (measurable; fail))
   apply (simp add: K_def)
   done
 
 text \<open>
   Shows that it is equivalent to define likelihood in terms of the trace space starting at a single
   pair of an internal state \<open>s\<close> and the default observation @{term obs}.
 \<close>
 lemma (in HMM) likelihood_init:
   "likelihood s os = T (s, obs) {\<omega> \<in> space S. L os \<omega>}"
 proof -
   have *: "(\<Sum>o\<in>\<O>\<^sub>s. emeasure (T (s, o)) {\<omega> \<in> space S. L os \<omega>}) =
     of_nat (card \<O>\<^sub>s) * emeasure (T (s, obs)) {\<omega> \<in> space S. L os \<omega>}"
     by (subst sum_constant[symmetric]) (fastforce intro: sum.cong T_init_observation_eq[simplified])
   show ?thesis
     unfolding likelihood_def
     apply (subst emeasure_T')
     subgoal
       by measurable
     using *
     apply (simp add: I_def in_S observations_finite observations_wellformed nn_integral_pmf_of_set)
     apply (subst mult.commute)
     apply (simp add: observations_finite observations_wellformed mult_divide_eq_ennreal)
     done
 qed
 
 lemma emeasure_T_observation_Cons:
   "T (s, o\<^sub>0) {\<omega> \<in> space S. L (o\<^sub>1 # os) \<omega>} =
    (\<integral>\<^sup>+ t. ennreal (pmf (\<O> t) o\<^sub>1) * T (t, o\<^sub>1) {\<omega> \<in> space S. L os \<omega>} \<partial>(\<K> s))" (is "?l = ?r")
 proof -
   have *:
     "\<integral>\<^sup>+ y. T (s', y) {x \<in> space S. \<exists>xs. (\<exists>\<omega>'. (s', y) ## x = xs @- \<omega>') \<and> map snd xs = o\<^sub>1 # os}
        \<partial>measure_pmf (\<O> s') =
     ennreal (pmf (\<O> s') o\<^sub>1) * T (s', o\<^sub>1) {\<omega> \<in> space S. \<exists>xs. (\<exists>\<omega>'. \<omega> = xs @- \<omega>') \<and> map snd xs = os}"
     (is "?L = ?R") for s'
   proof -
     have "?L = \<integral>\<^sup>+ x. ennreal (pmf (\<O> s') x) *
             T (s', x) {\<omega> \<in> space S. \<exists>xs. (\<exists>\<omega>'. (s', x) ## \<omega> = xs @- \<omega>') \<and> map snd xs = o\<^sub>1 # os}
           \<partial>count_space UNIV"
       by (rule nn_integral_measure_pmf)
     also have "\<dots> =
       \<integral>\<^sup>+ o\<^sub>2. (if o\<^sub>2 = o\<^sub>1
               then ennreal (pmf (\<O> s') o\<^sub>1) * T (s', o\<^sub>1) {\<omega> \<in> space S. L os \<omega>}
               else 0)
        \<partial>count_space UNIV"
       apply (rule nn_integral_cong_AE
           [where v = "\<lambda> o\<^sub>2. if o\<^sub>2 = o\<^sub>1
             then ennreal (pmf (\<O> s') o\<^sub>1) * T (s', o\<^sub>1) {\<omega> \<in> space S. L os \<omega>} else 0"]
           )
        apply (rule AE_I2)
        apply (split if_split, safe)
       subgoal
         by (auto intro!: arg_cong2[where f = times, OF HOL.refl] arg_cong2[where f = emeasure];
             metis list.simps(9) shift.simps(2) snd_conv
            )
       subgoal
         by (subst arg_cong2[where f = emeasure and d = "{}", OF HOL.refl]) auto
       done
-    also have "\<dots> = \<integral>\<^sup>+o\<^sub>2\<in>{o\<^sub>1}.
-       (ennreal (pmf (\<O> s') o\<^sub>1) * T (s', o\<^sub>1) {\<omega> \<in> space S. L os \<omega>})
-      \<partial>count_space UNIV"
+    also have "\<dots> = (\<integral>\<^sup>+o\<^sub>2\<in>{o\<^sub>1}. (ennreal (pmf (\<O> s') o\<^sub>1) * T (s', o\<^sub>1) {\<omega> \<in> space S. L os \<omega>})
+      \<partial>count_space UNIV)"
       by (rule nn_integral_cong_AE) auto
     also have "\<dots> = ?R"
       by simp
     finally show ?thesis .
   qed
   have "?l = \<integral>\<^sup>+ t. T t {x \<in> space S. \<exists>xs \<omega>'. t ## x = xs @- \<omega>' \<and> map snd xs = o\<^sub>1 # os} \<partial> (K (s, o\<^sub>0))"
     by (subst emeasure_Collect_T[unfolded space_T], measurable)
   also have "\<dots> = ?r"
     using * by (simp add: K_def)
   finally show ?thesis .
 qed
 
 
 subsection \<open>Computation of Likelihood\<close>
 
 fun backward where
   "backward s [] = 1" |
   "backward s (o # os) = (\<integral>\<^sup>+ t. ennreal (pmf (\<O> t) o) * backward t os \<partial>measure_pmf (\<K> s))"
 
 lemma emeasure_T_observation_backward:
   "emeasure (T (s, o)) {\<omega> \<in> space S. L os \<omega>} = backward s os"
   using emeasure_T_observation_Cons by (induction os arbitrary: s o; simp)
 
 lemma (in HMM) likelihood_backward:
   "likelihood s os = backward s os"
   unfolding likelihood_init emeasure_T_observation_backward ..
 
 end (* HMM Defs *)
 
 context HMM2
 begin
 
 fun (in HMM2_defs) forward where
   "forward s t_end [] = indicator {t_end} s" |
   "forward s t_end (o # os) =
     (\<Sum>t \<in> \<S>. ennreal (pmf (\<O> t) o) * ennreal (pmf (\<K> s) t) * forward t t_end os)"
 
 lemma forward_split:
   "forward s t (os1 @ os2) = (\<Sum>t' \<in> \<S>. forward s t' os1 * forward t' t os2)"
   if "s \<in> \<S>"
   using that
   apply (induction os1 arbitrary: s)
   subgoal for s
     apply (simp add: sum_indicator_mult[OF states_finite])
     apply (subst sum.cong[where B = "{s}"])
     by auto
   subgoal for a os1 s
     apply simp
     apply (subst sum_distrib_right)
     apply (subst sum.swap)
     apply (simp add: sum_distrib_left algebra_simps)
     done
   done
 
 lemma (in -)
   "(\<Sum>t \<in> S. f t) = f t" if "finite S" "t \<in> S" "\<forall> s \<in> S - {t}. f s = 0"
   thm sum.empty sum.insert sum.mono_neutral_right[of S "{t}"]
   apply (subst sum.mono_neutral_right[of S "{t}"])
   using that
      apply auto
   done
 (*
   oops
   by (metis add.right_neutral empty_iff finite.intros(1) insert_iff subsetI sum.empty sum.insert sum.mono_neutral_right that)
 
   using that
   apply auto
 *)
 
 lemma forward_backward:
   "(\<Sum>t \<in> \<S>. forward s t os) = backward s os" if "s \<in> \<S>"
   using \<open>s \<in> \<S>\<close>
   apply (induction os arbitrary: s)
   subgoal for s
     by (subst sum.mono_neutral_right[of \<S> "{s}", OF states_finite])
        (auto split: if_split_asm simp: indicator_def)
   subgoal for a os s
     apply (simp add: sum.swap sum_distrib_left[symmetric])
     apply (subst nn_integral_measure_pmf_support[where A = \<S>])
     using states_finite states_closed by (auto simp: algebra_simps)
   done
 
 theorem likelihood_forward:
   "likelihood s os = (\<Sum>t \<in> \<S>. forward s t os)" if \<open>s \<in> \<S>\<close>
   unfolding likelihood_backward forward_backward[symmetric, OF \<open>s \<in> \<S>\<close>] ..
 
 
 subsection \<open>Definition of Maximum Probabilities\<close>
 
 abbreviation (input) "V os as \<omega> \<equiv> (\<exists> \<omega>'. \<omega> = zip as os @- \<omega>')"
 
 definition
   "max_prob s os =
   Max {T' (I s) {\<omega> \<in> space S. \<exists>o \<omega>'. \<omega> = (s, o) ## zip as os @- \<omega>'}
        | as. length as = length os \<and> set as \<subseteq> \<S>}"
 
 fun viterbi_prob where
   "viterbi_prob s t_end [] = indicator {t_end} s" |
   "viterbi_prob s t_end (o # os) =
     (MAX t \<in> \<S>. ennreal (pmf (\<O> t) o * pmf (\<K> s) t) * viterbi_prob t t_end os)"
 
 definition
   "is_decoding s os as \<equiv>
     T' (I s) {\<omega> \<in> space S. \<exists>o \<omega>'. \<omega> = (s, o) ## zip as os @- \<omega>'} = max_prob s os \<and>
     length as = length os \<and> set as \<subseteq> \<S>"
 
 
 subsection \<open>Iteration Rule For Maximum Probabilities\<close>
 
 lemma emeasure_T_state_Nil:
   "T (s, o\<^sub>0) {\<omega> \<in> space S. V [] as \<omega>} = 1"
   by simp
 
 lemma max_prob_T_state_Nil:
   "Max {T (s, o) {\<omega> \<in> space S. V [] as \<omega>} | as. length as = length [] \<and> set as \<subseteq> \<S>} = 1"
   by (simp add: emeasure_T_state_Nil)
 
 lemma V_Cons: "V (o # os) (a # as) \<omega> \<longleftrightarrow> fst (shd \<omega>) = a \<and> snd (shd \<omega>) = o \<and> V os as (stl \<omega>)"
   by (cases \<omega>) auto
 
 lemma measurable_V[measurable]:
   "Measurable.pred S (\<lambda>\<omega>. V os as \<omega>)"
 proof (induction os as rule: list_induct2')
   case (4 x xs y ys)
   then show ?case
     by (subst V_Cons)
        (intro Measurable.pred_intros_logic
           measurable_compose[OF measurable_shd] measurable_compose[OF measurable_stl];
         measurable)
 qed simp+
 
 lemma init_V_measurable[measurable]:
   "Measurable.pred S (\<lambda>x. \<exists>o \<omega>'. x = (s, o) ## zip as os @- \<omega>')" (is "Measurable.pred S ?f")
 proof -
   have *: "?f \<omega> \<longleftrightarrow> fst (shd \<omega>) = s \<and> V os as (stl \<omega>)" for \<omega>
     by (cases \<omega>) auto
   show ?thesis
     by (subst *)
        (intro Measurable.pred_intros_logic measurable_compose[OF measurable_shd]; measurable)
 qed
 
 lemma max_prob_Cons':
   "Max {T (s, o\<^sub>1) {\<omega> \<in> space S. V (o # os) as \<omega>} | as. length as = length (o # os) \<and> set as \<subseteq> \<S>} =
   (
     MAX t \<in> \<S>. ennreal (pmf (\<O> t) o * pmf (\<K> s) t) *
       (MAX as \<in> {as. length as = length os \<and> set as \<subseteq> \<S>}. T (t, o) {\<omega> \<in> space S. V os as \<omega>})
   )" (is "?l = ?r")
   and T_V_Cons:
   "T (s, o\<^sub>1) {\<omega> \<in> space S. V (o # os) (t # as) \<omega>}
   = ennreal (pmf (\<O> t) o * pmf (\<K> s) t) * T (t, o) {\<omega> \<in> space S. V os as \<omega>}"
   (is "?l' = ?r'")
   if "length as = length os"
 proof -
   let ?S = "\<lambda> os. {as. length as = length os \<and> set as \<subseteq> \<S>}"
   have S_finite: "finite (?S os)" for os :: "'t list"
     using finite_lists_length_eq[OF states_finite] by (rule finite_subset[rotated]) auto
   have S_nonempty: "?S os \<noteq> {}" for os :: "'t list"
   proof -
     let ?a = "SOME a. a \<in> \<S>" let ?as = "replicate (length os) ?a"
     from states_wellformed have "?a \<in> \<S>"
       by (auto intro: someI_ex)
     then have "?as \<in> ?S os"
       by auto
     then show ?thesis
       by force
   qed
   let ?f = "\<lambda>t as os. T t {\<omega> \<in> space S. V os as (t ## \<omega>)}"
   let ?g = "\<lambda>t as os. T t {\<omega> \<in> space S. V os as \<omega>}"
   have *: "?f t as (o # os) = ?g t (tl as) os * indicator {(hd as, o)} t"
     if "length as = Suc n" for t as n
     unfolding indicator_def using that by (cases as) auto
   have **: "K (s, o\<^sub>1) {(t, o)} = pmf (\<O> t) o * pmf (\<K> s) t" for t
     unfolding K_def
     apply (simp add: vimage_def)
     apply (subst arg_cong2[where
           f = nn_integral and d = "\<lambda> x. \<O> x {xa. xa = o \<and> x = t} * indicator {t} x",
           OF HOL.refl])
     subgoal
       by (auto simp: indicator_def)
     by (simp add: emeasure_pmf_single ennreal_mult')
   have "?l = (MAX as \<in> ?S (o # os). \<integral>\<^sup>+ t. ?f t as (o # os) \<partial>K (s, o\<^sub>1))"
     by (subst Max_to_image2; subst emeasure_Collect_T[unfolded space_T]; rule measurable_V HOL.refl)
   also have "\<dots> = (MAX as \<in> ?S (o # os). \<integral>\<^sup>+ t. ?g t (tl as) os * indicator {(hd as,o)} t \<partial>K (s,o\<^sub>1))"
     by (simp cong: Max_image_cong_simp add: *)
   also have "\<dots> = (MAX(t, as)\<in> \<S> \<times> ?S os. ennreal (pmf (\<O> t) o * pmf (\<K> s) t) * ?g (t, o) as os)"
   proof ((rule Max_eq_image_if; clarsimp?), goal_cases)
     case 1
     from S_finite[of "o # os"] show ?case
       by simp
   next
     case 2
     from states_finite show ?case
       by (blast intro: S_finite)
   next
     case (3 as)
     then show ?case
       by - (rule bexI[where x = "hd as"]; cases as; auto simp: algebra_simps **)
   next
     case (4 x as)
     then show ?case
       by - (rule exI[where x = "x # as"], simp add: algebra_simps **)
   qed
   also have "\<dots> = ?r"
     by (subst Max_image_left_mult[symmetric], fact+)
        (rule sym, rule Max_image_pair, rule states_finite, fact+)
   finally show "?l = ?r" .
   have "?l' = \<integral>\<^sup>+ t'. ?f t' (t # as) (o # os) \<partial>K (s, o\<^sub>1)"
     by (rule emeasure_Collect_T[unfolded space_T]; rule measurable_V)
   also from that have "\<dots> = \<integral>\<^sup>+ t'. ?g t' as os * indicator {(t,o)} t' \<partial>K (s,o\<^sub>1)"
     by (subst *[of _ "length as"]; simp)
   also have "\<dots> = ?r'"
     by (simp add: **, simp only: algebra_simps)
   finally show "?l' = ?r'" .
 qed
 
 lemmas max_prob_Cons = max_prob_Cons'[OF length_replicate]
 
 
 
 subsection \<open>Computation of Maximum Probabilities\<close>
 
 lemma T_init_V_eq:
   "T (s, o) {\<omega> \<in> space S. V os as \<omega>} = T (s, o') {\<omega> \<in> space S. V os as \<omega>}"
   apply (subst emeasure_Collect_T[unfolded space_T], (measurable; fail))
   apply (subst (2) emeasure_Collect_T[unfolded space_T], (measurable; fail))
   apply (simp add: K_def)
   done
 
 lemma T'_I_T:
   "T' (I s) {\<omega> \<in> space S. \<exists>o \<omega>'. \<omega> = (s, o) ## zip as os @- \<omega>'} = T (s,o) {\<omega> \<in> space S. V os as \<omega>}"
 proof -
   have "(\<Sum>o\<in>\<O>\<^sub>s. T (s, o) {\<omega> \<in> space S. V os as \<omega>}) =
     of_nat (card \<O>\<^sub>s) * T (s, o) {\<omega> \<in> space S. V os as \<omega>}" for as
     by (subst sum_constant[symmetric]) (fastforce intro: sum.cong T_init_V_eq[simplified])
   then show ?thesis
     unfolding max_prob_def
     apply (subst emeasure_T')
     subgoal
       by measurable
     apply (simp add: I_def in_S observations_finite observations_wellformed nn_integral_pmf_of_set)
     apply (subst mult.commute)
     apply (simp add: observations_finite observations_wellformed mult_divide_eq_ennreal)
     done
 qed
 
 lemma max_prob_init:
   "max_prob s os = Max {T (s,o) {\<omega> \<in> space S. V os as \<omega>} | as. length as = length os \<and> set as \<subseteq> \<S>}"
   unfolding max_prob_def by (simp add: T'_I_T[symmetric])
 
 lemma max_prob_Nil[simp]:
   "max_prob s [] = 1"
   unfolding max_prob_init[where o = obs] by auto
 
 lemma Max_start:
   "(MAX t\<in>\<S>. (indicator {t} s :: ennreal)) = 1" if "s \<in> \<S>"
   using states_finite that by (auto simp: indicator_def intro: Max_eqI)
 
 lemma Max_V_viterbi:
   "(MAX t \<in> \<S>. viterbi_prob s t os) =
    Max {T (s, o) {\<omega> \<in> space S. V os as \<omega>} | as. length as = length os \<and> set as \<subseteq> \<S>}" if "s \<in> \<S>"
   using that states_finite states_wellformed
   by (induction os arbitrary: s o; simp
         add: Max_start max_prob_Cons[simplified] Max_image_commute Max_image_left_mult Max_to_image2
         cong: Max_image_cong
       )
 
 lemma max_prob_viterbi:
   "(MAX t \<in> \<S>. viterbi_prob s t os) = max_prob s os" if "s \<in> \<S>"
   using max_prob_init[of s os] Max_V_viterbi[OF \<open>s \<in> \<S>\<close>, symmetric] by simp
 
 end
 
 subsection \<open>Decoding the Most Probable Hidden State Sequence\<close>
 
 context HMM3
 begin
 
 fun viterbi where
   "viterbi s t_end [] = ([], indicator {t_end} s)" |
   "viterbi s t_end (o # os) = fst (
     argmax snd (map
       (\<lambda>t. let (xs, v) = viterbi t t_end os in (t # xs, ennreal (pmf (\<O> t) o * pmf (\<K> s) t) * v))
     state_list))"
 
 lemma state_list_nonempty:
   "state_list \<noteq> []"
   using state_list_\<S> states_wellformed by auto
 
 lemma viterbi_viterbi_prob:
   "snd (viterbi s t_end os) = viterbi_prob s t_end os"
 proof (induction os arbitrary: s)
   case Nil
   then show ?case
     by simp
 next
   case (Cons o os)
   let ?f =
     "\<lambda>t. let (xs, v) = viterbi t t_end os in (t # xs, ennreal (pmf (\<O> t) o * pmf (\<K> s) t) * v)"
   let ?xs = "map ?f state_list"
   from state_list_nonempty have "map ?f state_list \<noteq> []"
     by simp
   from argmax(2,3)[OF this, of snd] have *:
     "snd (fst (argmax snd ?xs)) = snd (argmax snd ?xs)"
     "snd (argmax snd ?xs) = (MAX x \<in> set ?xs. snd x)" .
   then show ?case
     apply (simp add: state_list_\<S>)
     apply (rule Max_eq_image_if)
        apply (intro finite_imageI states_finite; fail)
       apply (intro finite_imageI states_finite; fail)
     subgoal
       apply clarsimp
       subgoal for x
         using Cons.IH[of x] by (auto split: prod.splits)
       done
     apply clarsimp
     subgoal for x
       using Cons.IH[of x] by (force split: prod.splits)
     done
 qed
 
 context
 begin
 
 private fun val_of where
   "val_of s [] [] = 1" |
   "val_of s (t # xs) (o # os) = ennreal (pmf (\<O> t) o * pmf (\<K> s) t) * val_of t xs os"
 
 lemma val_of_T:
   "val_of s as os = T (s, o\<^sub>1) {\<omega> \<in> space S. V os as \<omega>}" if "length as = length os"
   using that by (induction arbitrary: o\<^sub>1 rule: val_of.induct; (subst T_V_Cons)?; simp)
 
 lemma viterbi_sequence:
   "snd (viterbi s t_end os) = val_of s (fst (viterbi s t_end os)) os"
   if "snd (viterbi s t_end os) > 0"
   using that
 proof (induction os arbitrary: s)
   case Nil
   then show ?case
     by (simp add: indicator_def split: if_split_asm split_of_bool_asm)
 next
   case (Cons o os s)
   let ?xs = "map
     (\<lambda>t. let (xs, v) = viterbi t t_end os in (t # xs, ennreal (pmf (\<O> t) o * pmf (\<K> s) t) * v))
     state_list"
   from state_list_nonempty have "?xs \<noteq> []"
     by simp
   from argmax(1)[OF this, of snd] obtain t where
     "t \<in> set state_list"
     "fst (argmax snd ?xs) =
     (t # fst (viterbi t t_end os), ennreal (pmf (\<O> t) o * pmf (\<K> s) t) * snd (viterbi t t_end os))"
     by (auto split: prod.splits)
   with Cons show ?case
     by (auto simp: ennreal_zero_less_mult_iff)
 qed
 
 lemma viterbi_valid_path:
   "length as = length os \<and> set as \<subseteq> \<S>" if "viterbi s t_end os = (as, v)"
 using that proof (induction os arbitrary: s as v)
   case Nil
   then show ?case
     by simp
 next
   case (Cons o os s as v)
   let ?xs = "map
     (\<lambda>t. let (xs, v) = viterbi t t_end os in (t # xs, ennreal (pmf (\<O> t) o * pmf (\<K> s) t) * v))
     state_list"
   from state_list_nonempty have "?xs \<noteq> []"
     by simp
   from argmax(1)[OF this, of snd] obtain t where "t \<in> \<S>"
     "fst (argmax snd ?xs) =
     (t # fst (viterbi t t_end os), ennreal (pmf (\<O> t) o * pmf (\<K> s) t) * snd (viterbi t t_end os))"
     by (auto simp: state_list_\<S> split: prod.splits)
   with Cons.prems show ?case
     by (cases "viterbi t t_end os"; simp add: Cons.IH)
 qed
 
 definition
   "viterbi_final s os = fst (argmax snd (map (\<lambda> t. viterbi s t os) state_list))"
 
 lemma viterbi_finalE:
   obtains t where
     "t \<in> \<S>" "viterbi_final s os = viterbi s t os"
     "snd (viterbi s t os) = Max ((\<lambda>t. snd (viterbi s t os)) ` \<S>)"
 proof -
   from state_list_nonempty have "map (\<lambda> t. viterbi s t os) state_list \<noteq> []"
     by simp
   from argmax[OF this, of snd] show ?thesis
     by (auto simp: state_list_\<S> image_comp comp_def viterbi_final_def intro: that)
 qed
 
 theorem viterbi_final_max_prob:
   assumes "viterbi_final s os = (as, v)" "s \<in> \<S>"
   shows "v = max_prob s os"
 proof -
   obtain t where "t \<in> \<S>" "viterbi_final s os = viterbi s t os"
     "snd (viterbi s t os) = Max ((\<lambda>t. snd (viterbi s t os)) ` \<S>)"
     by (rule viterbi_finalE)
   with assms show ?thesis
     by (simp add: viterbi_viterbi_prob max_prob_viterbi)
 qed
 
 theorem viterbi_final_is_decoding:
   assumes "viterbi_final s os = (as, v)" "v > 0" "s \<in> \<S>"
   shows "is_decoding s os as"
 proof -
   from viterbi_valid_path[of s _ os as v] assms have as: "length as = length os" "set as \<subseteq> \<S>"
     by - (rule viterbi_finalE[of s os]; simp)+
   obtain t where "t \<in> \<S>" "viterbi_final s os = viterbi s t os"
     by (rule viterbi_finalE)
   with assms viterbi_sequence[of s t os] have "val_of s as os = v"
     by (cases "viterbi s t os") (auto simp: snd_def split!: prod.splits)
   with val_of_T as have "max_prob s os = T (s, obs) {\<omega> \<in> space S. V os as \<omega>}"
     by (simp add: viterbi_final_max_prob[OF assms(1,3)])
   with as show ?thesis
     unfolding is_decoding_def by (simp only: T'_I_T)
 qed
 
 end (* Anonymous context *)
 
 end (* HMM 3 *)
 
 end (* Theory *)
\ No newline at end of file