diff --git a/thys/Actuarial_Mathematics/Preliminaries.thy b/thys/Actuarial_Mathematics/Preliminaries.thy
--- a/thys/Actuarial_Mathematics/Preliminaries.thy
+++ b/thys/Actuarial_Mathematics/Preliminaries.thy
@@ -1,2572 +1,2571 @@
 theory Preliminaries
   imports "HOL-Library.Rewrite" "HOL-Library.Extended_Nonnegative_Real" "HOL-Library.Extended_Real"
     "HOL-Probability.Probability"
 begin
 
 notation powr (infixr ".^" 80)
 
 section \<open>Preliminary Lemmas\<close>
 
 lemma Collect_conj_eq2: "{x \<in> A. P x \<and> Q x} = {x \<in> A. P x} \<inter> {x \<in> A. Q x}"
   by blast
 
 lemma vimage_compl_atMost:
   fixes f :: "'a \<Rightarrow> 'b::linorder"
   shows "-(f -` {..y}) = f -` {y<..}"
   by fastforce
 
 lemma Ico_nat_disjoint: "disjoint_family (\<lambda>n::nat. {real n ..< real n + 1})"
 proof -
   { fix m n :: nat
     assume "{real m ..< real m + 1} \<inter> {real n ..< real n + 1} \<noteq> {}"
     then obtain x::real where "x \<in> {real m ..< real m + 1} \<inter> {real n ..< real n + 1}" by force
     hence "m = n" by simp }
   thus ?thesis
     unfolding disjoint_family_on_def by blast
 qed
 
 lemma Ico_nat_union: "(\<Union>n::nat. {real n ..< real n + 1}) = {0..}"
 proof
   show "(\<Union>n::nat. {real n ..< real n + 1}) \<subseteq> {0..}" by auto
 next
   show "{0..} \<subseteq> (\<Union>n::nat. {real n ..< real n + 1})"
   proof
     fix x::real
     assume "x \<in> {0..}"
     hence "nat \<lfloor>x\<rfloor> \<le> x \<and> x < nat \<lfloor>x\<rfloor> + 1"
       by (metis add_le_same_cancel1 atLeast_iff le_nat_floor less_one linorder_not_le of_nat_floor)
     thus "x \<in> (\<Union>n::nat. {real n ..< real n + 1})" unfolding atLeastLessThan_def by force
   qed
 qed
 
 lemma Ico_nat_union_finite: "(\<Union>(n::nat)<m. {real n ..< real n + 1}) = {0..<m}"
 proof
   show "(\<Union>(n::nat)<m. {real n ..< real n + 1}) \<subseteq> {0..<m}" by auto
 next
   show "{0..<m} \<subseteq> (\<Union>(n::nat)<m. {real n ..< real n + 1})"
   proof
     fix x::real
     assume \<star>: "x \<in> {0..<m}"
     hence "nat \<lfloor>x\<rfloor> < m" using of_nat_floor by fastforce
     moreover with \<star> have "nat \<lfloor>x\<rfloor> \<le> x \<and> x < nat \<lfloor>x\<rfloor> + 1"
       by (metis Nat.add_0_right atLeastLessThan_iff le_nat_floor
           less_one linorder_not_le nat_add_left_cancel_le of_nat_floor)
     ultimately show "x \<in> (\<Union>(n::nat)<m. {real n ..< real n + 1})"
       unfolding atLeastLessThan_def by force
   qed
 qed
 
 lemma seq_part_multiple: fixes m n :: nat assumes "m \<noteq> 0" defines "A \<equiv> \<lambda>i::nat. {i*m ..< (i+1)*m}"
   shows "\<forall>i j. i \<noteq> j \<longrightarrow> A i \<inter> A j = {}" and "(\<Union>i<n. A i) = {..< n*m}"
 proof -
   { fix i j :: nat
     have "i \<noteq> j \<Longrightarrow> A i \<inter> A j = {}"
     proof (erule contrapos_np)
       assume "A i \<inter> A j \<noteq> {}"
       then obtain k where "k \<in> A i \<inter> A j" by blast
       hence "i*m < (j+1)*m \<and> j*m < (i+1)*m" unfolding A_def by force
       hence "i < j+1 \<and> j < i+1" using mult_less_cancel2 by blast
       thus "i = j" by force
     qed }
   thus "\<forall>i j. i \<noteq> j \<longrightarrow> A i \<inter> A j = {}" by blast
 next
   show "(\<Union>i<n. A i) = {..< n*m}"
   proof
     show "(\<Union>i<n. A i) \<subseteq> {..< n*m}"
     proof
       fix x::nat
       assume "x \<in> (\<Union>i<n. A i)"
       then obtain i where i_n: "i < n" and i_x: "x < (i+1)*m" unfolding A_def by force
       hence "i+1 \<le> n" by linarith
       hence "x < n*m" by (meson less_le_trans mult_le_cancel2 i_x)
       thus "x \<in> {..< n*m}"
         using diff_mult_distrib mult_1 i_n by auto
     qed
   next
     show "{..< n*m} \<subseteq> (\<Union>i<n. A i)"
     proof
       fix x::nat
       let ?i = "x div m"
       assume "x \<in> {..< n*m}"
       hence "?i < n" by (simp add: less_mult_imp_div_less)
       moreover have "?i*m \<le> x \<and> x < (?i+1)*m"
         using assms div_times_less_eq_dividend dividend_less_div_times by auto
       ultimately show "x \<in> (\<Union>i<n. A i)" unfolding A_def by force
     qed
   qed
 qed
 
 lemma frontier_Icc_real: "frontier {a..b} = {a, b}" if "a \<le> b" for a b :: real
   unfolding frontier_def using that by force
 
 lemma(in field) divide_mult_cancel[simp]: fixes a b assumes "b \<noteq> 0"
   shows "a / b * b = a"
   by (simp add: assms)
 
 lemma inverse_powr: "(1/a).^b = a.^-b" if "a > 0" for a b :: real
   by (smt that powr_divide powr_minus_divide powr_one_eq_one)
 
 lemma powr_eq_one_iff_gen[simp]: "a.^x = 1 \<longleftrightarrow> x = 0" if "a > 0" "a \<noteq> 1" for a x :: real
   by (metis powr_eq_0_iff powr_inj powr_zero_eq_one that)
 
 lemma powr_less_cancel2: "0 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> x.^a < y.^a \<Longrightarrow> x < y"
   for a x y ::real
 proof -
   assume a_pos: "0 < a" and x_pos: "0 < x" and y_pos: "0 < y"
   show "x.^a < y.^a \<Longrightarrow> x < y"
   proof (erule contrapos_pp)
     assume "\<not> x < y"
     hence "x \<ge> y" by fastforce
     hence "x.^a \<ge> y.^a"
     proof (cases "x = y")
       case True
       thus ?thesis by simp
     next
       case False
       hence "x.^a > y.^a"
         using \<open>x \<ge> y\<close> powr_less_mono2 a_pos y_pos by auto
       thus ?thesis by auto
     qed
     thus "\<not> x.^a < y.^a" by fastforce
   qed
 qed
 
 lemma geometric_increasing_sum_aux: "(1-r)^2 * (\<Sum>k<n. (k+1)*r^k) = 1 - (n+1)*r^n + n*r^(n+1)"
   for n::nat and r::real
 proof (induct n)
   case 0
   thus ?case by simp
 next
   case (Suc n)
   thus ?case
     apply (simp only: sum.lessThan_Suc)
     apply (subst distrib_left)
     apply (subst Suc.hyps)
     by (subst power2_diff, simp add: field_simps power2_eq_square)
 qed
 
 lemma geometric_increasing_sum: "(\<Sum>k<n. (k+1)*r^k) = (1 - (n+1)*r^n + n*r^(n+1)) / (1-r)^2"
   if "r \<noteq> 1" for n::nat and r::real
   by (subst geometric_increasing_sum_aux[THEN sym], simp add: that)
 
 lemma Reals_UNIV[simp]: "\<real> = {x::real. True}"
   unfolding Reals_def by auto
 
 lemma Lim_cong:
   assumes "\<forall>\<^sub>F x in F. f x = g x"
   shows "Lim F f = Lim F g"
   unfolding t2_space_class.Lim_def using tendsto_cong assms by fastforce
 
 lemma antimono_onI:
   "(\<And>r s. r \<in> A \<Longrightarrow> s \<in> A \<Longrightarrow> r \<le> s \<Longrightarrow> f r \<ge> f s) \<Longrightarrow> antimono_on A f"
   by (rule monotone_onI)
 
 lemma antimono_onD:
   "\<lbrakk>antimono_on A f; r \<in> A; s \<in> A; r \<le> s\<rbrakk> \<Longrightarrow> f r \<ge> f s"
   by (rule monotone_onD)
 
 lemma antimono_imp_mono_on: "antimono f \<Longrightarrow> antimono_on A f"
   by (simp add: antimonoD antimono_onI)
 
 lemma antimono_on_subset: "antimono_on A f \<Longrightarrow> B \<subseteq> A \<Longrightarrow> antimono_on B f"
   by (rule monotone_on_subset)
 
 lemma mono_on_antimono_on:
   fixes f :: "'a::order \<Rightarrow> 'b::ordered_ab_group_add"
   shows "mono_on A f \<longleftrightarrow> antimono_on A (\<lambda>r. - f r)"
   by (simp add: monotone_on_def)
 
 corollary mono_antimono:
   fixes f :: "'a::order \<Rightarrow> 'b::ordered_ab_group_add"
   shows "mono f \<longleftrightarrow> antimono (\<lambda>r. - f r)"
   by (rule mono_on_antimono_on)
 
 lemma mono_on_at_top_le:
   fixes a :: "'a::linorder" and b :: "'b::{order_topology, linordered_ab_group_add}"
     and f :: "'a \<Rightarrow> 'b"
   assumes f_mono: "mono_on {a..} f" and f_to_l: "(f \<longlongrightarrow> l) at_top"
   shows "\<And>x. x \<in> {a..} \<Longrightarrow> f x \<le> l"
 proof (unfold atomize_ball)
   { fix b assume b_a: "b \<ge> a" and fb_l: "\<not> f b \<le> l"
     let ?eps = "f b - l"
     have lim_top: "\<And>S. open S \<Longrightarrow> l \<in> S \<Longrightarrow> eventually (\<lambda>x. f x \<in> S) at_top"
       using assms tendsto_def by auto
     have "eventually (\<lambda>x. f x \<in> {l - ?eps <..< l + ?eps}) at_top"
       using fb_l by (intro lim_top; force)
     then obtain N where fn_in: "\<And>n. n \<ge> N \<Longrightarrow> f n \<in> {l - ?eps <..< l + ?eps}"
       using eventually_at_top_linorder by metis
     let ?n = "max b N"
     have "f ?n < f b" using fn_in by force
     moreover have "f ?n \<ge> f b" using f_mono b_a by (simp add: le_max_iff_disj mono_on_def)
     ultimately have False by simp }
   thus "\<forall>x\<in>{a..}. f x \<le> l"
     apply -
     by (rule notnotD, rewrite Set.ball_simps) auto
 qed
 
 corollary mono_at_top_le:
   fixes b :: "'b::{order_topology, linordered_ab_group_add}" and f :: "'a::linorder \<Rightarrow> 'b"
   assumes "mono f" and "(f \<longlongrightarrow> b) at_top"
   shows "\<And>x. f x \<le> b"
   using mono_on_at_top_le assms by (metis atLeast_iff mono_imp_mono_on nle_le)
 
 lemma mono_on_at_bot_ge:
   fixes a :: "'a::linorder" and b :: "'b::{order_topology, linordered_ab_group_add}"
     and f :: "'a \<Rightarrow> 'b"
   assumes f_mono: "mono_on {..a} f" and f_to_l: "(f \<longlongrightarrow> l) at_bot"
   shows "\<And>x. x \<in> {..a} \<Longrightarrow> f x \<ge> l"
 proof (unfold atomize_ball)
   { fix b assume b_a: "b \<le> a" and fb_l: "\<not> f b \<ge> l"
     let ?eps = "l - f b"
     have lim_bot: "\<And>S. open S \<Longrightarrow> l \<in> S \<Longrightarrow> eventually (\<lambda>x. f x \<in> S) at_bot"
       using assms tendsto_def by auto
     have "eventually (\<lambda>x. f x \<in> {l - ?eps <..< l + ?eps}) at_bot"
       using fb_l by (intro lim_bot; force)
     then obtain N where fn_in: "\<And>n. n \<le> N \<Longrightarrow> f n \<in> {l - ?eps <..< l + ?eps}"
       using eventually_at_bot_linorder by metis
     let ?n = "min b N"
     have "f ?n > f b" using fn_in by force
     moreover have "f ?n \<le> f b" using f_mono b_a by (simp add: min.coboundedI1 mono_onD)
     ultimately have False by simp }
   thus "\<forall>x\<in>{..a}. f x \<ge> l"
     apply -
     by (rule notnotD, rewrite Set.ball_simps) auto
 qed
 
 corollary mono_at_bot_ge:
   fixes b :: "'b::{order_topology, linordered_ab_group_add}" and f :: "'a::linorder \<Rightarrow> 'b"
   assumes "mono f" and "(f \<longlongrightarrow> b) at_bot"
   shows "\<And>x. f x \<ge> b"
   using mono_on_at_bot_ge assms by (metis atMost_iff mono_imp_mono_on nle_le)
 
 lemma antimono_on_at_top_ge:
   fixes a :: "'a::linorder" and b :: "'b::{order_topology, linordered_ab_group_add}"
     and f :: "'a \<Rightarrow> 'b"
   assumes f_antimono: "antimono_on {a..} f" and f_to_l: "(f \<longlongrightarrow> l) at_top"
   shows "\<And>x. x \<in> {a..} \<Longrightarrow> f x \<ge> l"
 proof (unfold atomize_ball)
   { fix b assume b_a: "b \<ge> a" and fb_l: "\<not> f b \<ge> l"
     let ?eps = "l - f b"
     have lim_top: "\<And>S. open S \<Longrightarrow> l \<in> S \<Longrightarrow> eventually (\<lambda>x. f x \<in> S) at_top"
       using assms tendsto_def by auto
     have "eventually (\<lambda>x. f x \<in> {l - ?eps <..< l + ?eps}) at_top"
       using fb_l by (intro lim_top; force)
     then obtain N where fn_in: "\<And>n. n \<ge> N \<Longrightarrow> f n \<in> {l - ?eps <..< l + ?eps}"
       using eventually_at_top_linorder by metis
     let ?n = "max b N"
     have "f ?n > f b" using fn_in by force
     moreover have "f ?n \<le> f b" using f_antimono b_a
       by (simp add: antimono_onD le_max_iff_disj)
     ultimately have False by simp }
   thus "\<forall>x\<in>{a..}. f x \<ge> l"
     apply -
     by (rule notnotD, rewrite Set.ball_simps) auto
 qed
 
 corollary antimono_at_top_le:
   fixes b :: "'b::{order_topology, linordered_ab_group_add}" and f :: "'a::linorder \<Rightarrow> 'b"
   assumes "antimono f" and "(f \<longlongrightarrow> b) at_top"
   shows "\<And>x. f x \<ge> b"
   using antimono_on_at_top_ge assms antimono_imp_mono_on by blast
 
 lemma antimono_on_at_bot_ge:
   fixes a :: "'a::linorder" and b :: "'b::{order_topology, linordered_ab_group_add}"
     and f :: "'a \<Rightarrow> 'b"
   assumes f_antimono: "antimono_on {..a} f" and f_to_l: "(f \<longlongrightarrow> l) at_bot"
   shows "\<And>x. x \<in> {..a} \<Longrightarrow> f x \<le> l"
 proof (unfold atomize_ball)
   { fix b assume b_a: "b \<le> a" and fb_l: "\<not> f b \<le> l"
     let ?eps = "f b - l"
     have lim_bot: "\<And>S. open S \<Longrightarrow> l \<in> S \<Longrightarrow> eventually (\<lambda>x. f x \<in> S) at_bot"
       using assms tendsto_def by auto
     have "eventually (\<lambda>x. f x \<in> {l - ?eps <..< l + ?eps}) at_bot"
       using fb_l by (intro lim_bot; force)
     then obtain N where fn_in: "\<And>n. n \<le> N \<Longrightarrow> f n \<in> {l - ?eps <..< l + ?eps}"
       using eventually_at_bot_linorder by metis
     let ?n = "min b N"
     have "f ?n < f b" using fn_in by force
     moreover have "f ?n \<ge> f b" using f_antimono b_a by (simp add: min.coboundedI1 antimono_onD)
     ultimately have False by simp }
   thus  "\<forall>x\<in>{..a}. f x \<le> l"
     apply -
     by (rule notnotD, rewrite Set.ball_simps) auto
 qed
 
 corollary antimono_at_bot_ge:
   fixes b :: "'b::{order_topology, linordered_ab_group_add}" and f :: "'a::linorder \<Rightarrow> 'b"
   assumes "antimono f" and "(f \<longlongrightarrow> b) at_bot"
   shows "\<And>x. f x \<le> b"
   using antimono_on_at_bot_ge assms antimono_imp_mono_on by blast
 
 lemma continuous_cdivide:
   fixes c::"'a::real_normed_field"
   assumes "c \<noteq> 0" "continuous F f"
   shows "continuous F (\<lambda>x. f x / c)"
   using assms continuous_mult_right by (rewrite field_class.field_divide_inverse) auto
 
 lemma continuous_mult_left_iff:
   fixes c::"'a::real_normed_field"
   assumes "c \<noteq> 0"
   shows "continuous F f \<longleftrightarrow> continuous F (\<lambda>x. c * f x)"
   using continuous_mult_left continuous_cdivide assms by force
 
 lemma continuous_mult_right_iff:
   fixes c::"'a::real_normed_field"
   assumes "c \<noteq> 0"
   shows "continuous F f \<longleftrightarrow> continuous F (\<lambda>x. f x * c)"
   using continuous_mult_right continuous_cdivide assms by force
 
 lemma continuous_cdivide_iff:
   fixes c::"'a::real_normed_field"
   assumes "c \<noteq> 0"
   shows "continuous F f \<longleftrightarrow> continuous F (\<lambda>x. f x / c)"
 proof
   assume "continuous F f"
   thus "continuous F (\<lambda>x. f x / c)"
     by (intro continuous_cdivide) (simp add: assms)
 next
   assume "continuous F (\<lambda>x. f x / c)"
   hence "continuous F (\<lambda>x. f x / c * c)" using continuous_mult_right by fastforce
   thus "continuous F f" using assms by force
 qed
 
 lemma continuous_cong:
   assumes "eventually (\<lambda>x. f x = g x) F" "f (Lim F (\<lambda>x. x)) = g (Lim F (\<lambda>x. x))"
   shows "continuous F f \<longleftrightarrow> continuous F g"
   unfolding continuous_def using assms filterlim_cong by force
 
 lemma continuous_at_within_cong:
   assumes "f x = g x" "eventually (\<lambda>x. f x = g x) (at x within s)"
   shows "continuous (at x within s) f \<longleftrightarrow> continuous (at x within s) g"
 proof (cases \<open>x \<in> closure (s - {x})\<close>)
   case True
   thus ?thesis
     using assms apply (intro continuous_cong, simp)
     by (rewrite Lim_ident_at, simp add: at_within_eq_bot_iff)+ simp
 next
   case False
   hence "at x within s = bot" using not_trivial_limit_within by blast
   thus ?thesis by simp
 qed
 
 lemma DERIV_cmult_iff:
   assumes "c \<noteq> 0"
   shows "(f has_field_derivative D) (at x within s) \<longleftrightarrow>
     ((\<lambda>x. c * f x) has_field_derivative c * D) (at x within s)"
 proof
   assume "(f has_field_derivative D) (at x within s)"
   thus  "((\<lambda>x. c * f x) has_field_derivative c * D) (at x within s)" using DERIV_cmult by force
 next
   assume "((\<lambda>x. c * f x) has_field_derivative c * D) (at x within s)"
   hence "((\<lambda>x. c * f x / c) has_field_derivative c * D / c) (at x within s)"
     using DERIV_cdivide assms by blast
   thus "(f has_field_derivative D) (at x within s)" by (simp add: assms field_simps)
 qed
 
 lemma DERIV_cmult_right_iff:
   assumes "c \<noteq> 0"
   shows "(f has_field_derivative D) (at x within s) \<longleftrightarrow>
     ((\<lambda>x. f x * c) has_field_derivative D * c) (at x within s)"
   by (rewrite DERIV_cmult_iff[of c], simp_all add: assms mult_ac)
 
 lemma DERIV_cdivide_iff:
   assumes "c \<noteq> 0"
   shows "(f has_field_derivative D) (at x within s) \<longleftrightarrow>
     ((\<lambda>x. f x / c) has_field_derivative D / c) (at x within s)"
   apply (rewrite field_class.field_divide_inverse)+
   using DERIV_cmult_right_iff assms inverse_nonzero_iff_nonzero by blast
 
 lemma DERIV_ln_divide_chain:
   fixes f :: "real \<Rightarrow> real"
   assumes "f x > 0" and "(f has_real_derivative D) (at x within s)"
   shows "((\<lambda>x. ln (f x)) has_real_derivative (D / f x)) (at x within s)"
 proof -
   have "DERIV ln (f x) :> 1 / f x" using assms by (intro DERIV_ln_divide) blast
   thus ?thesis using DERIV_chain2 assms by fastforce
 qed
 
 lemma inverse_fun_has_integral_ln:
   fixes f :: "real \<Rightarrow> real" and f' :: "real \<Rightarrow> real"
   assumes "a \<le> b" and
     "\<And>x. x\<in>{a..b} \<Longrightarrow> f x > 0" and
     "continuous_on {a..b} f" and 
     "\<And>x. x\<in>{a<..<b} \<Longrightarrow> (f has_real_derivative f' x) (at x)"
   shows "((\<lambda>x. f' x / f x) has_integral (ln (f b) - ln (f a))) {a..b}"
 proof -
   have "continuous_on {a..b} (\<lambda>x. ln (f x))" using assms by (intro continuous_intros; force)
   moreover have "\<And>x. x\<in>{a<..<b} \<Longrightarrow> ((\<lambda>x. ln (f x)) has_vector_derivative f' x / f x) (at x)"
     apply (rewrite has_real_derivative_iff_has_vector_derivative[THEN sym])
     using assms by (intro DERIV_ln_divide_chain; simp)
   ultimately show ?thesis using assms by (intro fundamental_theorem_of_calculus_interior; simp)
 qed
 
 lemma DERIV_fun_powr2:
   fixes a::real
   assumes a_pos: "a > 0"
     and f: "DERIV f x :> r"
   shows "DERIV (\<lambda>x. a.^(f x)) x :> a.^(f x) * r * ln a"
 proof -
   let ?g = "(\<lambda>x. a)"
   have g: "DERIV ?g x :> 0" by simp
   have pos: "?g x > 0" by (simp add: a_pos)
   show ?thesis
     using DERIV_powr[OF g pos f] a_pos by (auto simp add: field_simps)
 qed
 
 lemma has_real_derivative_powr2:
   assumes a_pos: "a > 0"
   shows "((\<lambda>x. a.^x) has_real_derivative a.^x * ln a) (at x)"
 proof -
   let ?f = "(\<lambda>x. x::real)"
   have f: "DERIV ?f x :> 1" by simp
   thus ?thesis using DERIV_fun_powr2[OF a_pos f] by simp
 qed
 
 lemma has_integral_powr2_from_0:
   fixes a c :: real
   assumes a_pos: "a > 0" and a_neq_1: "a \<noteq> 1" and c_nneg: "c \<ge> 0"
   shows "((\<lambda>x. a.^x) has_integral ((a.^c - 1) / (ln a))) {0..c}"
 proof -
   have "((\<lambda>x. a.^x) has_integral ((a.^c)/(ln a) - (a.^0)/(ln a))) {0..c}"
   proof (rule fundamental_theorem_of_calculus[OF c_nneg])
     fix x::real
     assume "x \<in> {0..c}"
     show "((\<lambda>y. a.^y / ln a) has_vector_derivative a.^x) (at x within {0..c})"
       apply (insert has_real_derivative_powr2[OF a_pos, of x])
       apply (drule DERIV_cdivide[where c = "ln a"], simp add: assms)
       apply (rule has_vector_derivative_within_subset[where S=UNIV and T="{0..c}"], auto)
       by (rule iffD1[OF has_real_derivative_iff_has_vector_derivative])
   qed
   thus ?thesis
     using assms powr_zero_eq_one by (simp add: field_simps)
 qed
 
 lemma integrable_on_powr2_from_0:
   fixes a c :: real
   assumes a_pos: "a > 0" and a_neq_1: "a \<noteq> 1" and c_nneg: "c \<ge> 0"
   shows "(\<lambda>x. a.^x) integrable_on {0..c}"
   using has_integral_powr2_from_0[OF assms] unfolding integrable_on_def by blast
 
 lemma integrable_on_powr2_from_0_general:
   fixes a c :: real
   assumes a_pos: "a > 0" and c_nneg: "c \<ge> 0"
   shows "(\<lambda>x. a.^x) integrable_on {0..c}"
 proof (cases "a = 1")
   case True
   thus ?thesis
     using has_integral_const_real by auto
 next
   case False
   thus ?thesis
     using has_integral_powr2_from_0 False assms by auto
 qed
 
 lemma has_integral_null_interval: fixes a b :: real and f::"real \<Rightarrow> real" assumes "a \<ge> b"
   shows "(f has_integral 0) {a..b}"
   using assms content_real_eq_0 by blast
 
 lemma has_integral_interval_reverse: fixes f :: "real \<Rightarrow> real" and a b :: real
   assumes "a \<le> b"
     and "continuous_on {a..b} f"
   shows "((\<lambda>x. f (a+b-x)) has_integral (integral {a..b} f)) {a..b}"
 proof -
   let ?g = "\<lambda>x. a + b - x"
   let ?g' = "\<lambda>x. -1"
   have g_C0: "continuous_on {a..b} ?g" using continuous_on_op_minus by simp
   have Dg_g': "\<And>x. x\<in>{a..b} \<Longrightarrow> (?g has_field_derivative ?g' x) (at x within {a..b})"
     by (auto intro!: derivative_eq_intros)
   show ?thesis
     using has_integral_substitution_general
       [of "{}" a b ?g a b f, simplified, OF assms g_C0 Dg_g', simplified]
     apply (simp add: has_integral_null_interval[OF assms(1), THEN integral_unique])
     by (simp add: has_integral_neg_iff)
 qed
 
 section \<open>Additional Lemmas for the "Analysis" Library\<close>
 
 lemma continuous_within_shift:
   fixes a x :: "'a :: {topological_ab_group_add, t2_space}"
     and s :: "'a set"
     and f :: "'a \<Rightarrow> 'b::topological_space"
   shows "continuous (at x within s) (\<lambda>x. f (x+a)) \<longleftrightarrow> continuous (at (x+a) within plus a ` s) f"
 proof
   assume "continuous (at x within s) (\<lambda>x. f (x+a))"
   moreover have "continuous (at (x+a) within plus a ` s) (plus (-a))"
     by (simp add: continuous_at_imp_continuous_at_within)
   moreover have "plus (-a) ` plus a ` s = s" by force
   ultimately show "continuous (at (x+a) within plus a ` s) f"
     using continuous_within_compose unfolding comp_def by force
 next
   assume "continuous (at (x+a) within plus a ` s) f"
   moreover have "continuous (at x within s) (plus a)"
     by (simp add: continuous_at_imp_continuous_at_within)
   ultimately show "continuous (at x within s) (\<lambda>x. f (x+a))"
     using continuous_within_compose unfolding comp_def by (force simp add: add.commute)
 qed
 
 lemma isCont_shift:
   fixes a x :: "'a :: {topological_ab_group_add, t2_space}"
     and f :: "'a \<Rightarrow> 'b::topological_space"
   shows "isCont (\<lambda>x. f (x+a)) x \<longleftrightarrow> isCont f (x+a)"
   using continuous_within_shift by force
 
 lemma differentiable_eq_field_differentiable_real:
   fixes f :: "real \<Rightarrow> real"
   shows "f differentiable F \<longleftrightarrow> f field_differentiable F"
   unfolding field_differentiable_def differentiable_def has_real_derivative
   using has_real_derivative_iff by presburger
 
 lemma differentiable_on_eq_field_differentiable_real:
   fixes f :: "real \<Rightarrow> real"
   shows "f differentiable_on s \<longleftrightarrow> (\<forall>x\<in>s. f field_differentiable (at x within s))"
   unfolding differentiable_on_def using differentiable_eq_field_differentiable_real by simp
 
 lemma differentiable_on_cong :
   assumes "\<And>x. x\<in>s \<Longrightarrow> f x = g x" and "f differentiable_on s"
   shows "g differentiable_on s"
 proof -
   { fix x assume "x\<in>s"
     hence "f differentiable at x within s" using assms unfolding differentiable_on_def by simp
     from this obtain D where "(f has_derivative D) (at x within s)"
       unfolding differentiable_def by blast
     hence "(g has_derivative D) (at x within s)"
       using has_derivative_transform assms \<open>x\<in>s\<close> by metis
     hence "g differentiable at x within s" unfolding differentiable_def by blast }
   hence "\<forall>x\<in>s. g differentiable at x within s" by simp
   thus ?thesis unfolding differentiable_on_def by simp
 qed
 
 lemma C1_differentiable_imp_deriv_continuous_on:
   "f C1_differentiable_on S \<Longrightarrow> continuous_on S (deriv f)"
   using C1_differentiable_on_eq field_derivative_eq_vector_derivative by auto
 
 lemma deriv_shift:
   assumes "f field_differentiable at (x+a)"
   shows "deriv f (x+a) = deriv (\<lambda>s. f (x+s)) a"
 proof -
   have "(f has_field_derivative deriv f (x+a)) (at (x+a))"
     using DERIV_deriv_iff_field_differentiable assms
     by force
   hence "((\<lambda>s. f (x+s)) has_field_derivative deriv f (x+a)) (at a)"
     using DERIV_at_within_shift has_field_derivative_at_within by blast
   moreover have "((\<lambda>s. f (x+s)) has_field_derivative deriv (\<lambda>s. f (x+s)) a) (at a)"
     using DERIV_imp_deriv calculation by fastforce
   ultimately show ?thesis using DERIV_unique by force
 qed
 
 lemma piecewise_differentiable_on_cong:
   assumes "f piecewise_differentiable_on i"
     and "\<And>x. x \<in> i \<Longrightarrow> f x = g x"
   shows "g piecewise_differentiable_on i"
 proof -
   have "continuous_on i g"
     using continuous_on_cong_simp assms piecewise_differentiable_on_imp_continuous_on by force
   moreover have "\<exists>S. finite S \<and> (\<forall>x \<in> i - S. g differentiable (at x within i))"
   proof -
     from assms piecewise_differentiable_on_def
     obtain S where fin: "finite S" and "\<forall>x \<in> i - S. f differentiable (at x within i)" by metis
     hence "\<And>x. x \<in> i - S \<Longrightarrow> f differentiable (at x within i)" by simp
     hence "\<And>x. x \<in> i - S \<Longrightarrow> g differentiable (at x within i)"
       using has_derivative_transform assms by (metis DiffD1 differentiable_def)
     with fin show ?thesis by blast
   qed
   ultimately show ?thesis unfolding piecewise_differentiable_on_def by simp
 qed
 
 lemma differentiable_piecewise:
   assumes "continuous_on i f"
     and "f differentiable_on i"
   shows "f piecewise_differentiable_on i"
   unfolding piecewise_differentiable_on_def using assms differentiable_onD by auto
 
 lemma piecewise_differentiable_scaleR:
   assumes "f piecewise_differentiable_on S"
   shows "(\<lambda>x. a *\<^sub>R f x) piecewise_differentiable_on S"
 proof -
   from assms obtain T where fin: "finite T" "\<And>x. x \<in> S - T \<Longrightarrow> f differentiable at x within S"
     unfolding piecewise_differentiable_on_def by blast
   hence "\<And>x. x \<in> S - T \<Longrightarrow> (\<lambda>x. a *\<^sub>R f x) differentiable at x within S"
     using differentiable_scaleR by simp
   moreover have "continuous_on S (\<lambda>x. a *\<^sub>R f x)"
     using assms continuous_on_scaleR continuous_on_const piecewise_differentiable_on_def by blast
   ultimately show "(\<lambda>x. a *\<^sub>R f x) piecewise_differentiable_on S"
     using fin piecewise_differentiable_on_def by blast
 qed
 
 lemma differentiable_on_piecewise_compose:
   assumes "f piecewise_differentiable_on S"
     and "g differentiable_on f ` S"
   shows "g \<circ> f piecewise_differentiable_on S"
 proof -
   from assms obtain T where fin: "finite T" "\<And>x. x \<in> S - T \<Longrightarrow> f differentiable at x within S"
     unfolding piecewise_differentiable_on_def by blast
   hence "\<And>x. x \<in> S - T \<Longrightarrow> g \<circ> f differentiable at x within S"
     by (meson DiffD1 assms differentiable_chain_within differentiable_onD image_eqI)
   hence "\<exists>T. finite T \<and> (\<forall>x\<in>S-T. g \<circ> f differentiable at x within S)" using fin by blast
   moreover have "continuous_on S (g \<circ> f)"
     using assms continuous_on_compose differentiable_imp_continuous_on
     unfolding piecewise_differentiable_on_def by blast
   ultimately show ?thesis
     unfolding piecewise_differentiable_on_def by force
 qed
 
 lemma MVT_order_free:
   fixes r h :: real
   defines "I \<equiv> {r..r+h} \<union> {r+h..r}"
   assumes "continuous_on I f" and "f differentiable_on interior I"
   obtains t where "t \<in> {0<..<1}" and "f (r+h) - f r = h * deriv f (r + t*h)"
 proof -
   consider (h_pos) "h > 0" | (h_0) "h = 0" | (h_neg) "h < 0" by force
   thus ?thesis
   proof cases
     case h_pos
     hence "r < r+h" "I = {r..r+h}" unfolding I_def by simp_all
     moreover hence "interior I = {r<..<r+h}" by simp
     moreover hence "\<And>x. \<lbrakk>r < x; x < r+h\<rbrakk> \<Longrightarrow> f differentiable (at x)"
       using assms by (simp add: differentiable_on_eq_differentiable_at)
     ultimately obtain z where "r < z \<and> z < r+h \<and> f (r+h) - f r = h * deriv f z"
       using MVT assms by (smt (verit) DERIV_imp_deriv)
     moreover hence "(z-r) / h \<in> {0<..<1}" by simp
     moreover have "z = r + (z-r)/h * h" using h_pos by simp
     ultimately show ?thesis using that by presburger
   next
     case h_0
     have "1/2 \<in> {0::real<..<1}" by simp
     moreover have "f (r+h) - f r = 0" using h_0 by simp
     moreover have "h * deriv f (r + (1/2)*h) = 0" using h_0 by simp
     ultimately show ?thesis using that by presburger
   next case h_neg
     hence "r+h < r" "I = {r+h..r}" unfolding I_def by simp_all
     moreover hence "interior I = {r+h<..<r}" by simp
     moreover hence "\<And>x. \<lbrakk>r+h < x; x < r\<rbrakk> \<Longrightarrow> f differentiable (at x)"
       using assms by (simp add: differentiable_on_eq_differentiable_at)
     ultimately obtain z where "r+h < z \<and> z < r \<and> f r - f (r+h) = -h * deriv f z"
       using MVT assms by (smt (verit) DERIV_imp_deriv)
     moreover hence "(z-r) / h \<in> {0<..<1}" by (simp add: neg_less_divide_eq)
     moreover have "z = r + (z-r)/h * h" using h_neg by simp
     ultimately show ?thesis using that mult_minus_left by fastforce
   qed
 qed
 
 lemma integral_combine2:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "a \<le> c" "c \<le> b"
     and "f integrable_on {a..c}" "f integrable_on {c..b}"
   shows "integral {a..c} f + integral {c..b} f = integral {a..b} f"
   apply (rule integral_unique[THEN sym])
   apply (rule has_integral_combine[of a c b], simp_all add: assms)
   using has_integral_integral assms by auto
 
 lemma FTC_real_deriv_has_integral:
   fixes F :: "real \<Rightarrow> real"
   assumes "a \<le> b"
     and "F piecewise_differentiable_on {a<..<b}"
     and "continuous_on {a..b} F"
   shows "(deriv F has_integral F b - F a) {a..b}"
 proof -
   obtain S where fin: "finite S" and
     diff: "\<And>x. x \<in> {a<..<b} - S \<Longrightarrow> F differentiable at x within {a<..<b} - S"
     using assms unfolding piecewise_differentiable_on_def
     by (meson Diff_subset differentiable_within_subset)
   hence "\<And>x. x \<in> {a<..<b} - S \<Longrightarrow> (F has_real_derivative deriv F x) (at x)"
   proof -
     fix x assume x_in: "x \<in> {a<..<b} - S"
     have "open ({a<..<b} - S)"
       using fin finite_imp_closed by (metis open_Diff open_greaterThanLessThan)
     hence "at x within {a<..<b} - S = at x" by (meson x_in at_within_open)
     hence "F differentiable at x" using diff x_in by smt
     thus "(F has_real_derivative deriv F x) (at x)"
       using DERIV_deriv_iff_real_differentiable by simp
   qed
   thus ?thesis
     by (intro fundamental_theorem_of_calculus_interior_strong[where S=S];
         simp add: assms fin has_real_derivative_iff_has_vector_derivative)
 qed
 
 lemma integrable_spike_cong:
   assumes "negligible S" "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
   shows "f integrable_on T \<longleftrightarrow> g integrable_on T"
   using integrable_spike assms by force
 
 lemma set_borel_measurable_lborel:
   "set_borel_measurable lborel A f \<longleftrightarrow> set_borel_measurable borel A f"
   unfolding set_borel_measurable_def by simp
 
 lemma restrict_space_whole[simp]: "restrict_space M (space M) = M"
   unfolding restrict_space_def by (simp add: measure_of_of_measure)
 
 lemma deriv_measurable_real:
   fixes f :: "real \<Rightarrow> real"
   assumes "f differentiable_on S" "open S" "f \<in> borel_measurable borel"
   shows "set_borel_measurable borel S (deriv f)"
 proof -
   have "\<And>x. x \<in> S \<Longrightarrow> deriv f x = lim (\<lambda>i. (f (x + 1 / Suc i) - f x) / (1 / Suc i))"
   proof -
     fix x assume x_S: "x \<in> S"
     hence "f field_differentiable (at x within S)"
       using differentiable_on_eq_field_differentiable_real assms by simp
     hence "(f has_field_derivative deriv f x) (at x)"
       using assms DERIV_deriv_iff_field_differentiable x_S at_within_open by force
     hence "(\<lambda>h. (f (x+h) - f x) / h) \<midarrow>0\<rightarrow> deriv f x" using DERIV_def by auto
     hence "\<forall>d. (\<forall>i. d i \<in> UNIV-{0::real}) \<longrightarrow> d \<longlonglongrightarrow> 0 \<longrightarrow>
       ((\<lambda>h. (f (x+h) - f x) / h) \<circ> d) \<longlonglongrightarrow> deriv f x"
       using tendsto_at_iff_sequentially by blast
     moreover have "\<forall>i. 1 / Suc i \<in> UNIV - {0::real}" by simp
     moreover have "(\<lambda>i. 1 / Suc i) \<longlonglongrightarrow> 0" using LIMSEQ_Suc lim_const_over_n by blast
     ultimately have "((\<lambda>h. (f (x + h) - f x) / h) \<circ> (\<lambda>i. 1 / Suc i)) \<longlonglongrightarrow> deriv f x" by auto
     thus "deriv f x = lim (\<lambda>i. (f (x + 1 / Suc i) - f x) / (1 / Suc i))"
       unfolding comp_def by (simp add: limI)
   qed
   moreover have "(\<lambda>x. indicator S x * lim (\<lambda>i. (f (x + 1 / Suc i) - f x) / (1 / Suc i)))
     \<in> borel_measurable borel"
     using assms by (measurable, simp, measurable)
   ultimately show ?thesis
     unfolding set_borel_measurable_def measurable_cong
     by simp (smt (verit) indicator_simps(2) measurable_cong mult_eq_0_iff)
 qed
 
 lemma piecewise_differentiable_on_deriv_measurable_real:
   fixes f :: "real \<Rightarrow> real"
   assumes "f piecewise_differentiable_on S" "open S" "f \<in> borel_measurable borel"
   shows "set_borel_measurable borel S (deriv f)"
 proof -
   from assms obtain T where fin: "finite T" and
     diff: "\<And>x. x \<in> S - T \<Longrightarrow> f differentiable at x within S"
     unfolding piecewise_differentiable_on_def by blast
   with assms have "open (S - T)" using finite_imp_closed by blast
   moreover hence "f differentiable_on (S - T)"
     unfolding differentiable_on_def using assms by (metis Diff_iff at_within_open diff)
   ultimately have "set_borel_measurable borel (S - T) (deriv f)"
     by (intro deriv_measurable_real; simp add: assms)
   thus ?thesis
     unfolding set_borel_measurable_def apply simp
     apply (rule measurable_discrete_difference
         [where X=T and f="\<lambda>x. indicat_real (S - T) x * deriv f x"], simp_all)
     using fin uncountable_infinite apply blast
     by (simp add: indicator_diff)
 qed
 
 lemma borel_measurable_antimono:
   fixes f :: "real \<Rightarrow> real"
   shows "antimono f \<Longrightarrow> f \<in> borel_measurable borel"
   using borel_measurable_mono by (smt (verit, del_insts) borel_measurable_uminus_eq monotone_on_def)
 
 lemma set_borel_measurable_restrict_space_iff: 
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   assumes \<Omega>[measurable, simp]: "\<Omega> \<inter> space M \<in> sets M"
   shows "f \<in> borel_measurable (restrict_space M \<Omega>) \<longleftrightarrow> set_borel_measurable M \<Omega> f"
   using assms borel_measurable_restrict_space_iff set_borel_measurable_def by blast
 
 lemma set_integrable_restrict_space_iff:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes "A \<in> sets M"
   shows "set_integrable M A f \<longleftrightarrow> integrable (restrict_space M A) f"
   unfolding set_integrable_def using assms
   by (rewrite integrable_restrict_space; simp)
 
 lemma set_lebesgue_integral_restrict_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes "A \<in> sets M"
   shows "set_lebesgue_integral M A f = integral\<^sup>L (restrict_space M A) f"
   unfolding set_lebesgue_integral_def using assms integral_restrict_space
   by (metis (mono_tags) sets.Int_space_eq2)
 
 lemma distr_borel_lborel: "distr M borel f = distr M lborel f"
   by (metis distr_cong sets_lborel)
 
 lemma AE_translation:
   assumes "AE x in lborel. P x" shows "AE x in lborel. P (a+x)"
 proof -
   from assms obtain N where P: "\<And>x. x \<in> space lborel - N \<Longrightarrow> P x" and null: "N \<in> null_sets lborel"
     using AE_E3 by blast
   hence "{y. a+y \<in> N} \<in> null_sets lborel"
     using null_sets_translation[of N "-a", simplified] by (simp add: add.commute)
   moreover have "\<And>y. y \<in> space lborel - {y. a+y \<in> N} \<Longrightarrow> P (a+y)" using P by force
   ultimately show "AE y in lborel. P (a+y)"
     by (smt (verit, del_insts) Diff_iff eventually_ae_filter mem_Collect_eq subsetI)
 qed
 
 lemma set_AE_translation:
   assumes "AE x\<in>S in lborel. P x" shows "AE x \<in> plus (-a) ` S in lborel. P (a+x)"
 proof -
   have "AE x in lborel. a+x \<in> S \<longrightarrow> P (a+x)" using assms by (rule AE_translation)
   moreover have "\<And>x. a+x \<in> S \<longleftrightarrow> x \<in> plus (-a) ` S" by force
   ultimately show ?thesis by simp
 qed
 
 lemma AE_scale_measure_iff:
   assumes "r > 0"
   shows "(AE x in (scale_measure r M). P x) \<longleftrightarrow> (AE x in M. P x)"
   unfolding ae_filter_def null_sets_def
   apply (rewrite space_scale_measure, simp)
   using assms by (smt Collect_cong not_gr_zero)
 
 lemma nn_set_integral_cong2:
   assumes "AE x\<in>A in M. f x = g x"
   shows "(\<integral>\<^sup>+x\<in>A. f x \<partial>M) = (\<integral>\<^sup>+x\<in>A. g x \<partial>M)"
 proof -
   { fix x
     assume "x \<in> space M"
     have "(x \<in> A \<longrightarrow> f x = g x) \<longrightarrow> f x * indicator A x = g x * indicator A x" by force }
   hence "AE x in M. (x \<in> A \<longrightarrow> f x = g x) \<longrightarrow> f x * indicator A x = g x * indicator A x"
     by (rule AE_I2)
   hence "AE x in M. f x * indicator A x = g x * indicator A x" using assms AE_mp by auto
   thus ?thesis by (rule nn_integral_cong_AE)
 qed
 
 lemma set_lebesgue_integral_cong_AE2:
   assumes [measurable]: "A \<in> sets M" "set_borel_measurable M A f" "set_borel_measurable M A g"
   assumes "AE x \<in> A in M. f x = g x"
   shows "LINT x:A|M. f x = LINT x:A|M. g x"
 proof -
   let ?fA = "\<lambda>x. indicator A x *\<^sub>R f x" and ?gA = "\<lambda>x. indicator A x *\<^sub>R g x"
   have "?fA \<in> borel_measurable M" "?gA \<in> borel_measurable M"
     using assms unfolding set_borel_measurable_def by simp_all
   moreover have "AE x \<in> A in M. ?fA x = ?gA x" using assms by simp
   ultimately have "LINT x:A|M. ?fA x = LINT x:A|M. ?gA x"
     by (intro set_lebesgue_integral_cong_AE; simp)
   moreover have "LINT x:A|M. f x = LINT x:A|M. ?fA x" "LINT x:A|M. g x = LINT x:A|M. ?gA x"
     unfolding set_lebesgue_integral_def
     by (metis indicator_scaleR_eq_if)+
   ultimately show ?thesis by simp
 qed
 
 proposition nn_integral_disjoint_family_on_finite:
   assumes [measurable]: "f \<in> borel_measurable M" "\<And>(n::nat). n \<in> S \<Longrightarrow> B n \<in> sets M"
     and "disjoint_family_on B S" "finite S"
   shows "(\<integral>\<^sup>+x \<in> (\<Union>n\<in>S. B n). f x \<partial>M) = (\<Sum>n\<in>S. (\<integral>\<^sup>+x \<in> B n. f x \<partial>M))"
 proof -
   let ?A = "\<lambda>n::nat. if n \<in> S then B n else {}"
   have "\<And>n::nat. ?A n \<in> sets M" by simp
   moreover have "disjoint_family ?A"
     unfolding disjoint_family_on_def
   proof -
     { fix m n :: nat
       assume "m \<noteq> n"
       hence "(if m \<in> S then B m else {}) \<inter> (if n \<in> S then B n else {}) = {}"
         apply simp
         using assms unfolding disjoint_family_on_def by blast }
     thus "\<forall>m::nat\<in>UNIV. \<forall>n::nat\<in>UNIV. m \<noteq> n \<longrightarrow>
       (if m \<in> S then B m else {}) \<inter> (if n \<in> S then B n else {}) = {}"
       by blast
   qed
   ultimately have "set_nn_integral M (\<Union> (range ?A)) f = (\<Sum>n. set_nn_integral M (?A n) f)"
     by (rewrite nn_integral_disjoint_family; simp)
   moreover have "set_nn_integral M (\<Union> (range ?A)) f = (\<integral>\<^sup>+x \<in> (\<Union>n\<in>S. B n). f x \<partial>M)"
   proof -
     have "\<Union> (range ?A) = (\<Union>n\<in>S. B n)" by simp
     thus ?thesis by simp
   qed
   moreover have "(\<Sum>n. set_nn_integral M (?A n) f) = (\<Sum>n\<in>S. set_nn_integral M (B n) f)"
     by (rewrite suminf_finite[of S]; simp add: assms)
   ultimately show ?thesis by simp
 qed
 
 lemma nn_integral_distr_set:
   assumes "T \<in> measurable M M'" and "f \<in> borel_measurable (distr M M' T)"
     and "A \<in> sets M'" and "\<And>x. x \<in> space M \<Longrightarrow> T x \<in> A"
   shows "integral\<^sup>N (distr M M' T) f = set_nn_integral (distr M M' T) A f"
 proof -
   have "integral\<^sup>N (distr M M' T) f = (\<integral>\<^sup>+x\<in>(space M'). f x \<partial>(distr M M' T))"
     by (rewrite nn_set_integral_space[THEN sym], simp)
   also have "\<dots> = (\<integral>\<^sup>+x\<in>A. f x \<partial>(distr M M' T))"
   proof -
     have [simp]: "sym_diff (space M') A = space M' - A"
       using assms by (metis Diff_mono sets.sets_into_space sup.orderE)
     show ?thesis
       apply (rule nn_integral_null_delta; simp add: assms)
       unfolding null_sets_def using assms
       apply (simp, rewrite emeasure_distr; simp)
       unfolding vimage_def using emeasure_empty
       by (smt (z3) Collect_empty_eq Diff_iff Int_def mem_Collect_eq)
   qed
   finally show ?thesis .
 qed
 
 (* Analogue for "measure_eqI_lessThan" in the "Lebesgue_Measure" Theory *)
 lemma measure_eqI_Ioc:
   fixes M N :: "real measure"
   assumes sets: "sets M = sets borel" "sets N = borel"
   assumes fin: "\<And>a b. a \<le> b \<Longrightarrow> emeasure M {a<..b} < \<infinity>"
   assumes eq: "\<And>a b. a \<le> b \<Longrightarrow> emeasure M {a<..b} = emeasure N {a<..b}"
   shows "M = N"
 proof (rule measure_eqI_generator_eq_countable)
   let ?Ioc = "\<lambda>(a::real,b::real). {a<..b}" let ?E = "range ?Ioc"
   show "Int_stable ?E" using Int_stable_def Int_greaterThanAtMost by force
   show "?E \<subseteq> Pow UNIV" "sets M = sigma_sets UNIV ?E" "sets N = sigma_sets UNIV ?E"
     unfolding sets by (auto simp add: borel_sigma_sets_Ioc)
   show "\<And>I. I \<in> ?E \<Longrightarrow> emeasure M I = emeasure N I"
   proof -
     fix I assume "I \<in> ?E"
     then obtain a b where "I = {a<..b}" by auto
     thus "emeasure M I = emeasure N I" by (smt (verit, best) eq greaterThanAtMost_empty)
   qed
   show "?Ioc ` (Rats \<times> Rats) \<subseteq> ?E" "(\<Union>i\<in>(Rats\<times>Rats). ?Ioc i) = UNIV"
     using Rats_no_bot_less Rats_no_top_le by auto
   show "countable (?Ioc ` (Rats \<times> Rats))" using countable_rat by blast
   show "\<And>I. I \<in> ?Ioc ` (Rats \<times> Rats) \<Longrightarrow> emeasure M I \<noteq> \<infinity>"
   proof -
     fix I assume "I \<in> ?Ioc ` (Rats \<times> Rats)"
     then obtain a b where "(a,b) \<in> (Rats \<times> Rats)" "I = {a<..b}" by blast
     thus "emeasure M I \<noteq> \<infinity>" by (smt (verit, best) Ioc_inj fin order.strict_implies_not_eq)
   qed
 qed
 
 lemma (in finite_measure) distributed_measure:
   assumes "distributed M N X f"
     and "\<And>x. x \<in> space N \<Longrightarrow>  f x \<ge> 0"
     and "A \<in> sets N"
   shows "measure M (X -` A \<inter> space M) = (\<integral>x. indicator A x * f x \<partial>N)"
 proof -
   have [simp]: "(\<lambda>x. indicat_real A x * f x) \<in> borel_measurable N"
     using assms apply (measurable; simp?)
     using distributed_real_measurable assms by force
   have "emeasure M (X -` A \<inter> space M) = (\<integral>\<^sup>+x\<in>A. ennreal (f x) \<partial>N)"
     by (rule distributed_emeasure; simp add: assms)
   moreover have "enn2real (\<integral>\<^sup>+x\<in>A. ennreal (f x) \<partial>N) = \<integral>x. indicator A x * f x \<partial>N"
     apply (rewrite enn2real_nn_integral_eq_integral
         [where f="\<lambda>x. ennreal (indicator A x * f x)", THEN sym]; (simp add: assms)?)
     using distributed_emeasure assms
-     apply (smt (verit) emeasure_finite indicator_mult_ennreal mult.commute
+    by (smt (verit) emeasure_finite indicator_mult_ennreal mult.commute
         nn_integral_cong top.not_eq_extremum)
-    by (rewrite nn_integral_set_ennreal, rewrite mult.commute) simp
   ultimately show ?thesis using measure_def by metis
 qed
 
 (* Set Integral Version of the Lebesgue's Dominated Convergence Theorem *)
 lemma
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and w :: "'a \<Rightarrow> real"
   assumes "A \<in> sets M" "set_borel_measurable M A f"
     "\<And>i. set_borel_measurable M A (s i)" "set_integrable M A w"
   assumes lim: "AE x\<in>A in M. (\<lambda>i. s i x) \<longlonglongrightarrow> f x"
   assumes bound: "\<And>i::nat. AE x\<in>A in M. norm (s i x) \<le> w x"
   shows set_integrable_dominated_convergence: "set_integrable M A f"
     and set_integrable_dominated_convergence2: "\<And>i. set_integrable M A (s i)"
     and set_integral_dominated_convergence:
     "(\<lambda>i. set_lebesgue_integral M A (s i)) \<longlonglongrightarrow>  set_lebesgue_integral M A f"
 proof -
   have "(\<lambda>x. indicator A x *\<^sub>R f x) \<in> borel_measurable M" and
     "\<And>i. (\<lambda>x. indicator A x *\<^sub>R s i x) \<in> borel_measurable M" and
     "integrable M (\<lambda>x. indicator A x *\<^sub>R w x)"
     using assms unfolding set_borel_measurable_def set_integrable_def by simp_all
   moreover have "AE x in M. (\<lambda>i. indicator A x *\<^sub>R s i x) \<longlonglongrightarrow> indicator A x *\<^sub>R f x"
   proof -
     obtain N where N_null: "N \<in> null_sets M" and
       si_f: "\<And>x. x \<in> space M - N \<Longrightarrow> x \<in> A \<longrightarrow> (\<lambda>i. s i x) \<longlonglongrightarrow> f x"
       using lim AE_E3 by (smt (verit))
     hence "\<And>x. x \<in> space M - N \<Longrightarrow> (\<lambda>i. indicator A x *\<^sub>R s i x) \<longlonglongrightarrow> indicator A x *\<^sub>R f x"
     proof -
       fix x assume asm: "x \<in> space M - N"
       thus "(\<lambda>i. indicator A x *\<^sub>R s i x) \<longlonglongrightarrow> indicator A x *\<^sub>R f x"
       proof (cases \<open>x \<in> A\<close>)
         case True
         with si_f asm show ?thesis by simp
       next 
         case False
         thus ?thesis by simp
       qed
     qed
     thus ?thesis by (smt (verit) AE_I' DiffI N_null mem_Collect_eq subsetI)
   qed
   moreover have "\<And>i. AE x in M. norm (indicator A x *\<^sub>R s i x) \<le> indicator A x *\<^sub>R w x"
   proof -
     fix i
     from bound obtain N where N_null: "N \<in> null_sets M" and
       "\<And>x. x \<in> space M - N \<Longrightarrow> x \<in> A \<longrightarrow> norm (s i x) \<le> w x"
       using AE_E3 by (smt (verit))
     hence "\<And>x. x \<in> space M - N \<Longrightarrow> norm (indicator A x *\<^sub>R s i x) \<le> indicator A x *\<^sub>R w x"
       by (simp add: indicator_scaleR_eq_if)
     with N_null show "AE x in M. norm (indicator A x *\<^sub>R s i x) \<le> indicator A x *\<^sub>R w x"
       by (smt (verit) DiffI eventually_ae_filter mem_Collect_eq subsetI)
   qed
   ultimately show "set_integrable M A f" "\<And>i. set_integrable M A (s i)"
     "(\<lambda>i. set_lebesgue_integral M A (s i)) \<longlonglongrightarrow>  set_lebesgue_integral M A f"
     unfolding set_integrable_def set_lebesgue_integral_def
     by (rule integrable_dominated_convergence, rule integrable_dominated_convergence2,
         rule integral_dominated_convergence)
 qed
 
 lemma absolutely_integrable_on_iff_set_integrable:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "f \<in> borel_measurable lborel"
     and  "S \<in> sets lborel"
   shows "set_integrable lborel S f \<longleftrightarrow> f absolutely_integrable_on S"
   unfolding set_integrable_def apply (simp, rewrite integrable_completion[THEN sym])
    apply measurable using assms by simp_all
 
 corollary integrable_on_iff_set_integrable_nonneg:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "\<And>x. x \<in> S \<Longrightarrow> f x \<ge> 0" "f \<in> borel_measurable lborel"
     and  "S \<in> sets lborel"
   shows "set_integrable lborel S f \<longleftrightarrow> f integrable_on S"
   using absolutely_integrable_on_iff_set_integrable assms
   by (metis absolutely_integrable_on_iff_nonneg)
 
 lemma integrable_on_iff_set_integrable_nonneg_AE:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "AE x\<in>S in lborel. f x \<ge> 0" "f \<in> borel_measurable lborel"
     and  "S \<in> sets lborel"
   shows "set_integrable lborel S f \<longleftrightarrow> f integrable_on S"
 proof -
   from assms obtain N where nonneg: "\<And>x. x \<in> S - N \<Longrightarrow> f x \<ge> 0" and null: "N \<in> null_sets lborel"
     by (smt (verit, ccfv_threshold) AE_E3 Diff_iff UNIV_I space_borel space_lborel)
   let ?g = "\<lambda>x. if x \<in> N then 0 else f x"
   have [simp]: "negligible N" using null negligible_iff_null_sets null_sets_completionI by blast
   have "N \<in> sets lborel" using null by auto
   hence [simp]: "?g \<in> borel_measurable borel" using assms by force
   have "set_integrable lborel S f \<longleftrightarrow> set_integrable lborel S ?g"
   proof -
     have "AE x\<in>S in lborel. f x = ?g x" by (rule AE_I'[of N], simp_all add: null, blast)
     thus ?thesis using assms by (intro set_integrable_cong_AE[of f _ ?g S]; simp)
   qed
   also have "\<dots> \<longleftrightarrow> ?g integrable_on S"
     using assms by (intro integrable_on_iff_set_integrable_nonneg; simp add: nonneg)
   also have "\<dots> \<longleftrightarrow> f integrable_on S" by (rule integrable_spike_cong[of N]; simp)
   finally show ?thesis .
 qed
 
 lemma set_borel_integral_eq_integral_nonneg:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "\<And>x. x \<in> S \<Longrightarrow> f x \<ge> 0" "f \<in> borel_measurable borel" "S \<in> sets borel"
   shows "LINT x : S | lborel. f x = integral S f"
   \<comment> \<open>Note that 0 = 0 holds when the integral diverges.\<close>
 proof (cases \<open>set_integrable lborel S f\<close>)
   case True
   thus ?thesis using set_borel_integral_eq_integral by force
 next
   case False
   hence "LINT x : S | lborel. f x = 0"
     unfolding set_lebesgue_integral_def set_integrable_def
     by (rewrite not_integrable_integral_eq; simp)
   moreover have "integral S f = 0"
     apply (rule not_integrable_integral)
     using False assms by (rewrite in asm integrable_on_iff_set_integrable_nonneg; simp)
   ultimately show ?thesis ..
 qed
 
 lemma set_borel_integral_eq_integral_nonneg_AE:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "AE x\<in>S in lborel. f x \<ge> 0" "f \<in> borel_measurable borel" "S \<in> sets borel"
   shows "LINT x : S | lborel. f x = integral S f"
   \<comment> \<open>Note that 0 = 0 holds when the integral diverges.\<close>
 proof (cases \<open>set_integrable lborel S f\<close>)
   case True
   thus ?thesis using set_borel_integral_eq_integral by force
 next
   case False
   hence "LINT x : S | lborel. f x = 0"
     unfolding set_lebesgue_integral_def set_integrable_def
     by (rewrite not_integrable_integral_eq; simp)
   moreover have "integral S f = 0"
     apply (rule not_integrable_integral)
     using False assms by (rewrite in asm integrable_on_iff_set_integrable_nonneg_AE; simp)
   ultimately show ?thesis ..
 qed
 
 subsection \<open>Interchange of Differentiation and Lebesgue Integration\<close>
 
 definition measurize :: "'a measure \<Rightarrow> 'b measure \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b" where
   "measurize M N f = (SOME g. g \<in> M \<rightarrow>\<^sub>M N \<and> (\<exists>S\<in>(null_sets M). {x \<in> space M. f x \<noteq> g x} \<subseteq> S))"
   \<comment> \<open>The term "measurize" is what I coined in this formalization.\<close>
 
 lemma
   fixes f g
   assumes "g \<in> M \<rightarrow>\<^sub>M N" "S \<in> null_sets M" "{x \<in> space M. f x \<noteq> g x} \<subseteq> S"
   shows measurizeI: "AE x in M. f x = measurize M N f x" and
     measurizeI2: "AE x in M. g x = measurize M N f x" and
     measurize_measurable: "measurize M N f \<in> measurable M N"
 proof -
   let ?G = "\<lambda>g. g \<in> M \<rightarrow>\<^sub>M N" and ?S = "\<lambda>g. \<exists>S\<in>null_sets M. {x \<in> space M. f x \<noteq> g x} \<subseteq> S"
   show "AE x in M. f x = measurize M N f x"
     unfolding measurize_def
     apply (rule someI2[of "\<lambda>g. ?G g \<and> ?S g" g])
     using assms apply blast
     using AE_I' by auto
   moreover have "AE x in M. g x = f x"
     using assms by (smt (verit, best) AE_I' Collect_cong)
   ultimately show "AE x in M. g x = measurize M N f x" by force
   show "measurize M N f \<in> measurable M N"
     unfolding measurize_def
     apply (rule conjE[of "?G g" "?S g"])
     using assms apply auto[1]
     using someI_ex[of "\<lambda>g. ?G g \<and> ?S g"] by auto
 qed
 
 corollary measurable_measurize_AE:
   fixes f
   assumes "f \<in> M \<rightarrow>\<^sub>M N"
   shows "AE x in M. f x = measurize M N f x"
   by (rule measurizeI[where g=f and S="{}"]; simp add: assms)
 
 definition borel_measurize :: "'a measure \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) \<Rightarrow> 'a \<Rightarrow> 'b" where
   "borel_measurize M f = measurize M borel f"
 
 lemma
   fixes f g
   assumes "g \<in> borel_measurable M" "S \<in> null_sets M" "{x \<in> space M. f x \<noteq> g x} \<subseteq> S"
   shows borel_measurizeI: "AE x in M. f x = borel_measurize M f x" and
     borel_measurizeI2: "AE x in M. g x = borel_measurize M f x" and
     borel_measurize_measurable: "borel_measurize M f \<in> borel_measurable M"
   unfolding borel_measurize_def using assms
   apply -
   using measurizeI apply blast
   using measurizeI2 apply blast
   using measurize_measurable by blast
 
 corollary borel_measurable_measurize_AE:
   fixes f
   assumes "f \<in> borel_measurable M"
   shows "AE x in M. f x = borel_measurize M f x"
   using assms measurable_measurize_AE unfolding borel_measurize_def by auto
 
 definition set_borel_measurize :: "'a measure \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) \<Rightarrow> 'a \<Rightarrow> 'b"
   where "set_borel_measurize M A f = borel_measurize (restrict_space M A) f"
 
 lemma
   fixes f g :: "'a \<Rightarrow> 'b::real_normed_vector" and A
   assumes "A \<in> sets M" "set_borel_measurable M A g" "S \<in> null_sets M" "{x \<in> A. f x \<noteq> g x} \<subseteq> S"
   shows set_borel_measurizeI: "AE x\<in>A in M. f x = set_borel_measurize M A f x" and
     set_borel_measurizeI2: "AE x\<in>A in M. g x = set_borel_measurize M A f x" and
     set_borel_measurize_measurable: "set_borel_measurable M A (set_borel_measurize M A f)"
 proof -
   have "g \<in> borel_measurable (restrict_space M A)"
     using assms by (rewrite set_borel_measurable_restrict_space_iff; simp)
   moreover have "S \<inter> A \<in> null_sets (restrict_space M A)"
     using assms null_sets_restrict_space by (metis Int_lower2 null_set_Int2)
   moreover have "{x \<in> space (restrict_space M A). f x \<noteq> g x} \<subseteq> S \<inter> A"
     using assms by (rewrite space_restrict_space2; simp)
   ultimately show "AE x\<in>A in M. f x = set_borel_measurize M A f x" and
     "AE x\<in>A in M. g x = set_borel_measurize M A f x" and
     "set_borel_measurable M A (set_borel_measurize M A f)"
     unfolding set_borel_measurize_def using assms
       apply -
       apply (rewrite AE_restrict_space_iff[THEN sym], simp)
       apply (rule borel_measurizeI[of g _ "S \<inter> A"]; simp)
      apply (rewrite AE_restrict_space_iff[THEN sym], simp)
      apply (rule borel_measurizeI2[of g _ "S \<inter> A"]; simp)
     apply (rewrite set_borel_measurable_restrict_space_iff[THEN sym], simp)
     by (rule borel_measurize_measurable[of g _ "S \<inter> A"]; simp)
 qed
 
 corollary set_borel_measurable_measurize_AE:
   fixes f::"'a \<Rightarrow> 'b::real_normed_vector" and A
   assumes "set_borel_measurable M A f" "A \<in> sets M"
   shows "AE x\<in>A in M. f x = set_borel_measurize M A f x"
   using set_borel_measurable_restrict_space_iff borel_measurable_measurize_AE AE_restrict_space_iff
   unfolding set_borel_measurize_def
   by (smt (verit) AE_cong sets.Int_space_eq2 assms)
 
 proposition interchange_deriv_LINT_general:
   fixes a b :: real and f :: "real \<Rightarrow> 'a \<Rightarrow> real" and g :: "'a \<Rightarrow> real"
   assumes f_integ: "\<And>r. r\<in>{a<..<b} \<Longrightarrow> integrable M (f r)" and
     f_diff: "AE x in M. (\<lambda>r. f r x) differentiable_on {a<..<b}" and
     Df_bound: "AE x in M. \<forall>r\<in>{a<..<b}. \<bar>deriv (\<lambda>r. f r x) r\<bar> \<le> g x" "integrable M g"
   shows "\<And>r. r\<in>{a<..<b} \<Longrightarrow> ((\<lambda>r. \<integral>x. f r x \<partial>M) has_real_derivative
     \<integral>x. borel_measurize M (\<lambda>x. deriv (\<lambda>r. f r x) r) x \<partial>M) (at r)"
 proof -
   text \<open>Preparation\<close>
   have f_msr: "\<And>r. r\<in>{a<..<b} \<Longrightarrow> f r \<in> borel_measurable M" using f_integ by auto
   from f_diff obtain N1 where N1_null: "N1 \<in> null_sets M" and
     "\<And>x. x \<in> space M - N1 \<Longrightarrow> (\<lambda>s. f s x) differentiable_on {a<..<b}"
     by (smt (verit) AE_E3)
   hence f_diffN1: "\<And>x. x \<in> space M - N1 \<Longrightarrow> (\<lambda>s. f s x) differentiable_on {a<..<b}"
     by (meson Diff_iff sets.sets_into_space subset_eq)
   from Df_bound obtain N2 where N2_null: "N2 \<in> null_sets M" and
     "\<And>x. x \<in> space M - N2 \<Longrightarrow> \<forall>r\<in>{a<..<b}. \<bar>deriv (\<lambda>s. f s x) r\<bar> \<le> g x"
     by (smt (verit) AE_E3)
   hence Df_boundN2:"\<And>x. x \<in> space M - N2 \<Longrightarrow> \<forall>r\<in>{a<..<b}. \<bar>deriv (\<lambda>s. f s x) r\<bar> \<le> g x"
     by (meson Diff_iff sets.sets_into_space subset_eq)
   define N where "N \<equiv> N1 \<union> N2"
   let ?CN = "space M - N"
   have N_null: "N \<in> null_sets M" and N_msr: "N \<in> sets M"
     unfolding N_def using N1_null N2_null by auto
   have f_diffCN: "\<And>x. x\<in>?CN \<Longrightarrow> (\<lambda>s. f s x) differentiable_on {a<..<b}"
     unfolding N_def using f_diffN1 by simp
   define Df :: "real \<Rightarrow> 'a \<Rightarrow> real" where
     "Df r x \<equiv> indicator ({a<..<b}\<times>?CN) (r,x) * deriv (\<lambda>s. f s x) r" for r x
   have Df_boundCN: "\<And>x. x\<in>?CN \<Longrightarrow> \<forall>r\<in>{a<..<b}. \<bar>Df r x\<bar> \<le> g x"
     unfolding Df_def N_def using Df_boundN2 by simp
   text \<open>Main Part of the Proof\<close>
   fix r assume r_ab: "r\<in>{a<..<b}"
   then obtain e where e_pos: "e > 0" and ball_ab: "ball r e \<subseteq> {a<..<b}"
     by (meson openE open_greaterThanLessThan)
   have "\<And>d::nat\<Rightarrow>real. \<lbrakk>\<forall>i. d i \<in> UNIV-{0}; d \<longlonglongrightarrow> 0\<rbrakk> \<Longrightarrow>
     ((\<lambda>h. ((\<integral>x. f (r+h) x \<partial>M) - \<integral>x. f r x \<partial>M) / h) \<circ> d) \<longlonglongrightarrow>
     \<integral>x. borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) x \<partial>M"
   proof -
     fix d::"nat\<Rightarrow>real" assume d_neq0: "\<forall>i. d i \<in> UNIV-{0}" and d_to0: "d \<longlonglongrightarrow> 0"
     then obtain m where "\<forall>i\<ge>m. \<bar>d i - 0\<bar> < e" using LIMSEQ_def e_pos dist_real_def by metis
     hence rd_ab: "\<And>n. r + d (n+m) \<in> {a<..<b}" using dist_real_def ball_ab by (simp add: subset_eq)
     hence fd_msr: "\<And>n. (\<lambda>x. (f (r + d (n+m)) x - f r x) / d (n+m)) \<in> borel_measurable M"
       using r_ab by (measurable; (intro f_msr)?; simp)
     hence limf_msr: "(\<lambda>x. lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m))) \<in> borel_measurable M"
       by measurable
     moreover have limf_Df: "\<And>x. x\<in>?CN \<Longrightarrow> (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) \<longlonglongrightarrow> Df r x"
     proof -
       fix x assume x_CN: "x\<in>?CN"
       hence "(\<lambda>s. f s x) field_differentiable (at r)"
         using f_diffCN r_ab
         by (metis at_within_open differentiable_on_eq_field_differentiable_real
             open_greaterThanLessThan)
       hence "((\<lambda>h. (f (r+h) x - f r x) / h) \<longlongrightarrow> Df r x) (at 0)"
         apply (rewrite in asm DERIV_deriv_iff_field_differentiable[THEN sym])
         unfolding Df_def using r_ab x_CN by (simp add: DERIV_def)
       hence "(\<lambda>i. (f (r + d i) x - f r x) / d i) \<longlonglongrightarrow> Df r x"
         apply (rewrite in asm tendsto_at_iff_sequentially)
         apply (rule allE'[where x=d], simp)
         unfolding comp_def using d_neq0 d_to0 by simp
       thus "(\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) \<longlonglongrightarrow> Df r x"
         by (rule LIMSEQ_ignore_initial_segment[where k=m])
     qed
     ultimately have Df_eq:
       "\<And>x. Df r x = indicator ?CN x * lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m))"
     proof -
       fix x
       show "Df r x = indicator ?CN x * lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m))"
       proof (cases \<open>x\<in>?CN\<close>)
         case True
         hence "lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) = Df r x"
           by (intro limI, rule limf_Df)
         thus ?thesis using True by simp
       next
         case False
         thus ?thesis unfolding Df_def by simp
       qed
     qed
     hence Df_msr: "Df r \<in> borel_measurable M"
       apply (rewrite in "\<lambda>x. \<hole>" Df_eq)
       apply (measurable; (rule limf_msr)?)
       using N_null unfolding null_sets_def by force
     have "((\<lambda>h. ((\<integral>x. f (r+h) x \<partial>M) - \<integral>x. f r x \<partial>M) / h) \<circ> d) \<longlonglongrightarrow>
       \<integral>x. lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) \<partial>M"
     proof -
       have "(\<lambda>n. \<integral>x. (f (r + d (n+m)) x - f r x) / d (n+m) \<partial>M) \<longlonglongrightarrow>
         \<integral>x. lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) \<partial>M"
       proof - \<comment> \<open>by Lebesgue's Dominated Convergence Theorem\<close>
         have "AE x in M. (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) \<longlonglongrightarrow>
           lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m))"
           using limf_Df Df_eq N_null by (smt (verit) DiffI AE_I' limI mem_Collect_eq subset_eq)
         moreover have "\<And>n. AE x in M. norm ((f (r + d (n+m)) x - f r x) / d (n+m)) \<le> g x"
         proof -
           fix n
           { fix x assume x_CN: "x\<in>?CN"
             let ?I = "{r..(r + d (n+m))} \<union> {(r + d (n+m))..r}"
             have f_diffI: "(\<lambda>s. f s x) differentiable_on ?I"
               apply (rule differentiable_on_subset[where t="{a<..<b}"], rule f_diffCN, rule x_CN)
               using r_ab rd_ab[of n] by (rewrite Un_subset_iff, auto)
             hence "continuous_on ?I (\<lambda>s. f s x)" "(\<lambda>s. f s x) differentiable_on interior ?I"
                apply -
               using differentiable_imp_continuous_on apply blast
               by (metis differentiable_on_subset interior_subset)
             then obtain t where t_01: "t\<in>{0<..<1}" and
               f_MVT: "f (r + d (n+m)) x - f r x = d (n+m) * deriv (\<lambda>s. f s x) (r + t * (d (n+m)))"
               by (rule MVT_order_free)
             hence "0 < t" "t < 1" by simp_all
             hence rtd_ab: "r + t * (d (n+m)) \<in> {a<..<b}"
               using r_ab rd_ab[of n]
               by simp (smt (verit, ccfv_threshold) mult_less_cancel_left mult_less_cancel_right2)
             have "d (n+m) * deriv (\<lambda>s. f s x) (r + t * (d (n+m))) =
               d (n+m) * Df (r + t * (d (n+m))) x"
             proof -
               have "r + t * (d (n+m)) \<in> {a<..<b}"
                 using r_ab rd_ab[of n] t_01
                 by (smt (verit) ball_eq_greaterThanLessThan dist_real_def
                     greaterThanLessThan_eq_iff greaterThanLessThan_eq_ball mem_ball
                     mult_le_cancel_right1 mult_minus_right mult_pos_neg)
               thus ?thesis unfolding Df_def using x_CN by simp
             qed
             with f_MVT have "(f (r + d (n+m)) x - f r x) / d (n+m) = Df (r + t * (d (n+m))) x"
               using d_neq0 by simp
             moreover have "\<bar>Df (r + t * (d (n+m))) x\<bar> \<le> g x" using Df_boundCN x_CN rtd_ab by simp
             ultimately have "\<bar>(f (r + d (n+m)) x - f r x) / d (n+m)\<bar> \<le> g x" by simp }
           thus "AE x in M. norm ((f (r + d (n+m)) x - f r x) / d (n+m)) \<le> g x"
             unfolding real_norm_def using AE_I' N_null
             by (smt (verit, ccfv_threshold) Diff_iff mem_Collect_eq subsetI)
         qed
         ultimately show "((\<lambda>n. \<integral>x. (f (r + d (n+m)) x - f r x) / d (n+m) \<partial>M) \<longlonglongrightarrow>
           \<integral>x. lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) \<partial>M)" 
           using limf_msr fd_msr Df_bound
           by (intro integral_dominated_convergence[where w=g], simp_all)
       qed
       moreover have "\<And>n. ((\<integral>x. f (r + d (n+m)) x \<partial>M) - \<integral>x. f r x \<partial>M) / d (n+m) =
         \<integral>x. (f (r + d (n+m)) x - f r x) / d (n+m) \<partial>M"
         using d_neq0 apply simp
         by (rewrite Bochner_Integration.integral_diff;
             (rule f_integ | simp); (rule rd_ab | rule r_ab))
       ultimately show ?thesis
         unfolding comp_def using d_neq0
         apply -
         by (rule LIMSEQ_offset[where k=m]) simp
     qed
     moreover have "(\<integral>x. lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) \<partial>M) =
       \<integral>x. borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) x \<partial>M"
     proof -
       have "(\<integral>x. lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) \<partial>M) = \<integral>x. Df r x \<partial>M"
       proof -
         have "AE x in M. lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) = Df r x"
         proof -
           { fix x assume x_CN: "x\<in>?CN"
             hence "lim (\<lambda>n. (f (r + d (n+m)) x - f r x) / d (n+m)) = Df r x" by (simp add: Df_eq) }
           thus ?thesis using AE_I' N_null by (smt (verit, del_insts) DiffI mem_Collect_eq subsetI)
         qed
         thus ?thesis using limf_msr Df_msr by (intro integral_cong_AE; simp)
       qed
       also have "\<dots> = \<integral>x. borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) x \<partial>M"
       proof -
         have "AE x in M. Df r x = borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) x" and
           "borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) \<in> borel_measurable M"
         proof -
           have "{x \<in> space M. deriv (\<lambda>s. f s x) r \<noteq> Df r x} \<subseteq> N"
           proof -
             { fix x assume "x\<in>?CN"
               hence "deriv (\<lambda>s. f s x) r = Df r x" unfolding Df_def using r_ab by simp }
             thus ?thesis by blast
           qed
           thus "AE x in M. Df r x = borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) x" and
             "borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) \<in> borel_measurable M"
             using Df_msr N_null
              apply -
              apply (rule borel_measurizeI2[where S=N]; simp)
             by (rule borel_measurize_measurable[where g="Df r"]; simp)
         qed
         thus ?thesis using Df_msr by (intro integral_cong_AE; simp)
       qed
       finally show ?thesis .
     qed
     ultimately show "((\<lambda>h. ((\<integral>x. f (r+h) x \<partial>M) - \<integral>x. f r x \<partial>M) / h) \<circ> d) \<longlonglongrightarrow>
       \<integral>x. borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) x \<partial>M"
       using tendsto_cong_limit by simp
   qed
   thus "((\<lambda>s. \<integral>x. f s x \<partial>M) has_real_derivative
     \<integral>x. borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) x \<partial>M) (at r)"
     by (rewrite DERIV_def, rewrite tendsto_at_iff_sequentially) simp
 qed
 
 proposition interchange_deriv_LINT:
   fixes a b :: real and f :: "real \<Rightarrow> 'a \<Rightarrow> real" and g :: "'a \<Rightarrow> real"
   assumes "\<And>r. r\<in>{a<..<b} \<Longrightarrow> integrable M (f r)" and
     "AE x in M. (\<lambda>r. f r x) differentiable_on {a<..<b}" and
     "\<And>r. r\<in>{a<..<b} \<Longrightarrow> (\<lambda>x. (deriv (\<lambda>r. f r x) r)) \<in> borel_measurable M" and
     "AE x in M. \<forall>r\<in>{a<..<b}. \<bar>deriv (\<lambda>r. f r x) r\<bar> \<le> g x" "integrable M g"
   shows "\<And>r. r\<in>{a<..<b} \<Longrightarrow> ((\<lambda>r. \<integral>x. f r x \<partial>M) has_real_derivative
     \<integral>x. deriv (\<lambda>r. f r x) r \<partial>M) (at r)"
 proof -
   fix r assume r_ab: "r\<in>{a<..<b}"
   hence Df_msr: "(\<lambda>x. deriv (\<lambda>s. f s x) r) \<in> borel_measurable M" using assms by simp
   have "((\<lambda>s. \<integral>x. f s x \<partial>M) has_real_derivative
     \<integral>x. borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) x \<partial>M) (at r)"
     using assms r_ab by (intro interchange_deriv_LINT_general; simp)
   moreover have "(\<integral>x. borel_measurize M (\<lambda>y. deriv (\<lambda>s. f s y) r) x \<partial>M) =
     \<integral>x. deriv (\<lambda>s. f s x) r \<partial>M"
     apply (rule integral_cong_AE)
       apply (rule borel_measurize_measurable[where g="\<lambda>y. deriv (\<lambda>s. f s y) r" and S="{}"],
         simp_all add: Df_msr)
     using borel_measurable_measurize_AE Df_msr by (smt (verit) AE_cong)
   ultimately show "((\<lambda>r. \<integral>x. f r x \<partial>M) has_real_derivative \<integral>x. deriv (\<lambda>r. f r x) r \<partial>M) (at r)"
     by simp
 qed
 
 proposition interchange_deriv_LINT_set_general:
   fixes a b :: real and f :: "real \<Rightarrow> 'a \<Rightarrow> real" and g :: "'a \<Rightarrow> real" and A :: "'a set"
   assumes A_msr: "A \<in> sets M" and
     f_integ: "\<And>r. r\<in>{a<..<b} \<Longrightarrow> set_integrable M A (f r)" and
     f_diff: "AE x\<in>A in M. (\<lambda>r. f r x) differentiable_on {a<..<b}" and
     Df_bound: "AE x\<in>A in M. \<forall>r\<in>{a<..<b}. \<bar>deriv (\<lambda>r. f r x) r\<bar> \<le> g x" "set_integrable M A g"
   shows "\<And>r. r\<in>{a<..<b} \<Longrightarrow> ((\<lambda>r. \<integral>x\<in>A. f r x \<partial>M) has_real_derivative
     \<integral>x\<in>A. set_borel_measurize M A (\<lambda>x. deriv (\<lambda>r. f r x) r) x \<partial>M) (at r)"
 proof -
   let ?M_A = "restrict_space M A"
   have "\<And>r. r\<in>{a<..<b} \<Longrightarrow> integrable ?M_A (f r)"
     using A_msr f_integ set_integrable_restrict_space_iff by auto
   moreover have "AE x in ?M_A. (\<lambda>r. f r x) differentiable_on {a<..<b}"
     using AE_restrict_space_iff A_msr f_diff by (metis sets.Int_space_eq2)
   moreover have "AE x in ?M_A. \<forall>r\<in>{a<..<b}. \<bar>deriv (\<lambda>r. f r x) r\<bar> \<le> g x" and
     "integrable ?M_A g"
     using A_msr Df_bound set_integrable_restrict_space_iff
      apply -
     by (simp add: AE_restrict_space_iff, auto)
   ultimately have "\<And>r. r\<in>{a<..<b} \<Longrightarrow> ((\<lambda>r. integral\<^sup>L ?M_A (f r)) has_real_derivative
     integral\<^sup>L ?M_A (borel_measurize ?M_A (\<lambda>x. deriv (\<lambda>r. f r x) r))) (at r)"
     by (rule interchange_deriv_LINT_general[where M="restrict_space M A"]) auto
   thus "\<And>r. r\<in>{a<..<b} \<Longrightarrow> ((\<lambda>r. \<integral>x\<in>A. f r x \<partial>M) has_real_derivative
     \<integral>x\<in>A. set_borel_measurize M A (\<lambda>x. deriv (\<lambda>r. f r x) r) x \<partial>M) (at r)"
     unfolding set_borel_measurize_def using assms 
     by (rewrite set_lebesgue_integral_restrict_space, simp)+
 qed
 
 proposition interchange_deriv_LINT_set:
   fixes a b :: real and f :: "real \<Rightarrow> 'a \<Rightarrow> real" and g :: "'a \<Rightarrow> real" and A :: "'a set"
   assumes "A \<in> sets M" and
     "\<And>r. r\<in>{a<..<b} \<Longrightarrow> set_integrable M A (f r)" and
     "AE x\<in>A in M. (\<lambda>r. f r x) differentiable_on {a<..<b}" and
     "\<And>r. r\<in>{a<..<b} \<Longrightarrow> set_borel_measurable M A (\<lambda>x. (deriv (\<lambda>r. f r x) r))" and
     "AE x\<in>A in M. \<forall>r\<in>{a<..<b}. \<bar>deriv (\<lambda>r. f r x) r\<bar> \<le> g x" "set_integrable M A g"
   shows "\<And>r. r\<in>{a<..<b} \<Longrightarrow> ((\<lambda>r. \<integral>x\<in>A. f r x \<partial>M) has_real_derivative
     \<integral>x\<in>A. deriv (\<lambda>r. f r x) r \<partial>M) (at r)"
 proof -
   fix r assume r_ab: "r\<in>{a<..<b}"
   hence Df_msr: "set_borel_measurable M A (\<lambda>x. deriv (\<lambda>s. f s x) r)" using assms by simp
   have "((\<lambda>s. \<integral>x\<in>A. f s x \<partial>M) has_real_derivative
     \<integral>x\<in>A. set_borel_measurize M A (\<lambda>y. deriv (\<lambda>s. f s y) r) x \<partial>M) (at r)"
     using assms r_ab by (intro interchange_deriv_LINT_set_general; simp)
   moreover have "(\<integral>x\<in>A. set_borel_measurize M A (\<lambda>y. deriv (\<lambda>s. f s y) r) x \<partial>M) =
     \<integral>x\<in>A. deriv (\<lambda>s. f s x) r \<partial>M"
     apply (rule set_lebesgue_integral_cong_AE2, simp add: assms)
       apply (rule set_borel_measurize_measurable[where g="\<lambda>y. deriv (\<lambda>s. f s y) r" and S="{}"],
         simp_all add: Df_msr assms)
     using set_borel_measurable_measurize_AE Df_msr assms by (smt (verit) AE_cong)
   ultimately show "((\<lambda>r. \<integral>x\<in>A. f r x \<partial>M) has_real_derivative \<integral>x\<in>A. deriv (\<lambda>r. f r x) r \<partial>M) (at r)"
     by simp
 qed
 
 section \<open>Additional Lemmas for the "Probability" Library\<close>
 
 lemma (in finite_borel_measure)
   fixes F :: "real \<Rightarrow> real"
   assumes nondecF : "\<And> x y. x \<le> y \<Longrightarrow> F x \<le> F y" and
     right_cont_F : "\<And>a. continuous (at_right a) F" and
     lim_F_at_bot : "(F \<longlongrightarrow> 0) at_bot" and
     lim_F_at_top : "(F \<longlongrightarrow> m) at_top" and
     m : "0 \<le> m"
   shows emeasure_interval_measure_Ioi: "emeasure (interval_measure F) {x<..} = m - F x"
     and measure_interval_measure_Ioi: "measure (interval_measure F) {x<..} = m - F x"
 proof -
   interpret F_FM: finite_measure "interval_measure F"
     using finite_borel_measure.axioms(1) finite_borel_measure_interval_measure lim_F_at_bot
       lim_F_at_top m nondecF right_cont_F by blast
   have "UNIV = {..x} \<union> {x<..}" by auto
   moreover have "{..x} \<inter> {x<..} = {}" by auto
   ultimately have "emeasure (interval_measure F) UNIV =
     emeasure (interval_measure F) {..x} + emeasure (interval_measure F) {x<..}"
     by (simp add: plus_emeasure)
   moreover have "emeasure (interval_measure F) UNIV = m"
     using assms interval_measure_UNIV by presburger
   ultimately show \<star>: "emeasure (interval_measure F) {x<..} = m - F x"
     using assms emeasure_interval_measure_Iic
     by (metis ennreal_add_diff_cancel_left ennreal_minus measure_interval_measure_Iic
         measure_nonneg top_neq_ennreal)
   hence "ennreal (measure (interval_measure F) {x<..}) = m - F x"
     using emeasure_eq_measure by (metis emeasure_eq_ennreal_measure top_neq_ennreal)
   moreover have "\<And>x. F x \<le> m"
     using lim_F_at_top nondecF by (intro mono_at_top_le[where f=F]; simp add: mono_def)
   ultimately show "measure (interval_measure F) {x<..} = m - F x"
     using ennreal_inj F_FM.emeasure_eq_measure by force
 qed
 
 lemma (in prob_space) cond_prob_nonneg[simp]: "cond_prob M P Q \<ge> 0"
   by (auto simp: cond_prob_def)
 
 lemma (in prob_space) cond_prob_whole_1: "cond_prob M P P = 1" if "prob {\<omega> \<in> space M. P \<omega>} \<noteq> 0"
   unfolding cond_prob_def using that by simp
 
 lemma (in prob_space) cond_prob_0_null: "cond_prob M P Q = 0" if "prob {\<omega> \<in> space M. Q \<omega>} = 0"
   unfolding cond_prob_def using that by simp
 
 lemma (in prob_space) cond_prob_AE_prob:
   assumes "{\<omega> \<in> space M. P \<omega>} \<in> events" "{\<omega> \<in> space M. Q \<omega>} \<in> events"
     and "AE \<omega> in M. Q \<omega>"
   shows "cond_prob M P Q = prob {\<omega> \<in> space M. P \<omega>}"
 proof -
   let ?setP = "{\<omega> \<in> space M. P \<omega>}"
   let ?setQ = "{\<omega> \<in> space M. Q \<omega>}"
   have [simp]: "prob ?setQ = 1" using assms prob_Collect_eq_1 by simp
   hence "cond_prob M P Q = prob (?setP \<inter> ?setQ)"
     unfolding cond_prob_def by (simp add: Collect_conj_eq2)
   also have "\<dots> = prob ?setP"
   proof (rule antisym)
     show "prob (?setP \<inter> ?setQ) \<le> prob ?setP"
       using assms finite_measure_mono inf_sup_ord(1) by blast
   next
     show "prob ?setP \<le> prob (?setP \<inter> ?setQ)"
     proof -
       have "prob (?setP \<inter> ?setQ) = prob ?setP + prob ?setQ - prob (?setP \<union> ?setQ)"
         using assms by (smt (verit) finite_measure_Diff' finite_measure_Union' sup_commute)
       also have "\<dots> = prob ?setP + (1 - prob (?setP \<union> ?setQ))" by simp
       also have "\<dots> \<ge> prob ?setP" by simp
       finally show ?thesis .
     qed
   qed
   finally show ?thesis .
 qed
 
 subsection \<open>More Properties of cdf's\<close>
 
 context finite_borel_measure
 begin
 
 lemma cdf_diff_eq2:
   assumes "x \<le> y"
   shows "cdf M y - cdf M x = measure M {x<..y}"
 proof (cases \<open>x = y\<close>)
   case True
   thus ?thesis by force
 next 
   case False
   hence "x < y" using assms by simp
   thus ?thesis by (rule cdf_diff_eq)
 qed
 
 end
 
 context prob_space
 begin
 
 lemma cdf_distr_measurable [measurable]:
   assumes [measurable]: "random_variable borel X"
   shows "cdf (distr M borel X) \<in> borel_measurable borel"
 proof (rule borel_measurable_mono)
   show "mono (cdf (distr M borel X))"
     unfolding mono_def
     using finite_borel_measure.cdf_nondecreasing
     by (simp add: real_distribution.finite_borel_measure_M)
 qed
 
 lemma cdf_distr_P:
   assumes "random_variable borel X"
   shows "cdf (distr M borel X) x = \<P>(\<omega> in M. X \<omega> \<le> x)"
   unfolding cdf_def apply (rewrite measure_distr; (simp add: assms)?)
   unfolding vimage_def by (rule arg_cong[where f=prob], force)
 
 lemma cdf_continuous_distr_P_lt:
   assumes "random_variable borel X" "isCont (cdf (distr M borel X)) x"
   shows "cdf (distr M borel X) x = \<P>(\<omega> in M. X \<omega> < x)"
 proof -
   have "\<P>(\<omega> in M. X \<omega> < x) = measure (distr M borel X) {..<x}"
     apply (rewrite measure_distr, simp_all add: assms)
     unfolding vimage_def by simp (smt (verit) Collect_cong Int_def mem_Collect_eq)
   also have "\<dots> = measure (distr M borel X) ({..<x} \<union> {x})"
     apply (rewrite finite_measure.measure_zero_union, simp_all add: assms finite_measure_distr)
     using finite_borel_measure.isCont_cdf real_distribution.finite_borel_measure_M assms by blast
   also have "\<dots> = measure (distr M borel X) {..x}" by (metis ivl_disj_un_singleton(2))
   also have "\<dots> = cdf (distr M borel X) x" unfolding cdf_def by simp
   finally show ?thesis by simp
 qed
 
 lemma cdf_distr_diff_P:
   assumes "x \<le> y"
     and "random_variable borel X"
   shows "cdf (distr M borel X) y - cdf (distr M borel X) x = \<P>(\<omega> in M. x < X \<omega> \<and> X \<omega> \<le> y)"
 proof -
   interpret distrX_FBM: finite_borel_measure "distr M borel X"
     using real_distribution.finite_borel_measure_M real_distribution_distr assms by simp
   have "cdf (distr M borel X) y - cdf (distr M borel X) x = measure (distr M borel X) {x<..y}"
     by (rewrite distrX_FBM.cdf_diff_eq2; simp add: assms)
   also have "\<dots> = \<P>(\<omega> in M. x < X \<omega> \<and> X \<omega> \<le> y)"
     apply (rewrite measure_distr; (simp add: assms)?)
     unfolding vimage_def by (rule arg_cong[where f=prob], force)
   finally show ?thesis .
 qed
 
 lemma cdf_distr_max:
   fixes c::real
   assumes [measurable]: "random_variable borel X"
   shows "cdf (distr M borel (\<lambda>x. max (X x) c)) u = cdf (distr M borel X) u * indicator {c..} u"
 proof (cases \<open>c \<le> u\<close>)
   case True
   thus ?thesis
     unfolding cdf_def
     apply (rewrite measure_distr; simp?)+
     by (smt (verit) Collect_cong atMost_iff vimage_def)
 next
   case False
   thus ?thesis
     unfolding cdf_def
     apply (rewrite measure_distr; simp?)+
     by (smt (verit, best) Int_emptyI atMost_iff measure_empty vimage_eq)
 qed
 
 lemma cdf_distr_min:
   fixes c::real
   assumes [measurable]: "random_variable borel X"
   shows "cdf (distr M borel (\<lambda>x. min (X x) c)) u =
     1 - (1 - cdf (distr M borel X) u) * indicator {..<c} u"
 proof (cases \<open>c \<le> u\<close>)
   case True
   thus ?thesis
     unfolding cdf_def
     using real_distribution.finite_borel_measure_M real_distribution_distr
     apply (rewrite measure_distr; simp?)
     by (smt (verit, del_insts) Int_absorb1 atMost_iff prob_space subset_vimage_iff)
 next
   case False
   thus ?thesis
     unfolding cdf_def
     using real_distribution.finite_borel_measure_M real_distribution_distr
     apply (rewrite measure_distr; simp?)+
     using prob_space_axioms assms
     by (smt (verit) Collect_cong Int_def atMost_iff prob_space prob_space.cdf_distr_P vimage_eq)
 qed
 
 lemma cdf_distr_floor_P:
   fixes X :: "'a \<Rightarrow> real"
   assumes [measurable]: "random_variable borel X"
   shows "cdf (distr M borel (\<lambda>x. \<lfloor>X x\<rfloor>)) u = \<P>(x in M. X x < \<lfloor>u\<rfloor> + 1)"
   unfolding cdf_def
   apply (rewrite measure_distr; simp?)
   apply (rule arg_cong[where f=prob])
   unfolding vimage_def using floor_le_iff le_floor_iff by blast
 
 lemma expectation_nonneg_tail:
   assumes [measurable]: "random_variable borel X"
     and X_nonneg: "\<And>x. x \<in> space M \<Longrightarrow> X x \<ge> 0"
   defines "F u \<equiv> cdf (distr M borel X) u"
   shows "(\<integral>\<^sup>+x. ennreal (X x) \<partial>M) = \<integral>\<^sup>+u\<in>{0..}. ennreal (1 - F u) \<partial>lborel"
 proof -
   let ?distrX = "distr M borel X"
   have "(\<integral>\<^sup>+x. ennreal (X x) \<partial>M) = (\<integral>\<^sup>+u. ennreal u \<partial>?distrX)"
     by (rewrite nn_integral_distr; simp)
   also have "\<dots> = (\<integral>\<^sup>+u\<in>{0..}. ennreal u \<partial>?distrX)"
     by (rule nn_integral_distr_set; simp add: X_nonneg)
   also have "\<dots> = \<integral>\<^sup>+u\<in>{0..}. (\<integral>\<^sup>+v\<in>{0..}. indicator {..<u} v \<partial>lborel) \<partial>?distrX"
   proof -
     have "\<And>u::real. u\<in>{0..} \<Longrightarrow> ennreal u = \<integral>\<^sup>+v\<in>{0..}. indicator {..<u} v \<partial>lborel"
       apply (rewrite indicator_inter_arith[THEN sym])
       apply (rewrite nn_integral_indicator, measurable, simp)
       by (metis atLeastLessThan_def diff_zero emeasure_lborel_Ico inf.commute)
     thus ?thesis by (metis (no_types, lifting) indicator_eq_0_iff mult_eq_0_iff)
   qed
   also have "\<dots> = \<integral>\<^sup>+v\<in>{0..}. (\<integral>\<^sup>+u\<in>{0..}. indicator {..<u} v \<partial>?distrX) \<partial>lborel"
   proof -
     have "\<integral>\<^sup>+u\<in>{0..}. (\<integral>\<^sup>+v\<in>{0..}. indicator {..<u} v \<partial>lborel) \<partial>?distrX =
       \<integral>\<^sup>+u. (\<integral>\<^sup>+v. indicator {..<u} v * indicator {0..} v * indicator {0..} u \<partial>lborel) \<partial>?distrX"
       by (rewrite nn_integral_multc; simp)
     also have "\<dots> =
       \<integral>\<^sup>+v. (\<integral>\<^sup>+u. indicator {..<u} v * indicator {0..} v * indicator {0..} u \<partial>?distrX) \<partial>lborel"
       apply (rewrite pair_sigma_finite.Fubini'; simp?)
       using pair_sigma_finite.intro assms
         prob_space_distr prob_space_imp_sigma_finite sigma_finite_lborel
        apply blast
       by measurable auto
     also have "\<dots> = \<integral>\<^sup>+v\<in>{0..}. (\<integral>\<^sup>+u\<in>{0..}. indicator {..<u} v \<partial>?distrX) \<partial>lborel"
       apply (rewrite nn_integral_multc[THEN sym]; measurable; simp?)
       apply (rule nn_integral_cong)+ 
       using mult.assoc mult.commute by metis
     finally show ?thesis by simp
   qed
   also have "\<dots> = \<integral>\<^sup>+v\<in>{0..}. (\<integral>\<^sup>+u. indicator {v<..} u \<partial>?distrX) \<partial>lborel"
     apply (rule nn_integral_cong)
     apply (rewrite nn_integral_multc[THEN sym], measurable; (simp del: nn_integral_indicator)?)+
     apply (rule nn_integral_cong)
     using lessThan_iff greaterThan_iff atLeast_iff indicator_simps
     by (smt (verit, del_insts) mult_1 mult_eq_0_iff)
   also have "\<dots> = (\<integral>\<^sup>+v\<in>{0..}. ennreal (1 - F v) \<partial>lborel)"
     apply (rule nn_integral_cong, simp)
     apply (rewrite emeasure_distr; simp?)
     apply (rewrite vimage_compl_atMost[THEN sym])
     unfolding F_def cdf_def
     apply (rewrite measure_distr; simp?)
     apply (rewrite prob_compl[THEN sym], simp)
     by (metis (no_types, lifting) Diff_Compl Diff_Diff_Int Int_commute emeasure_eq_measure)
   finally show ?thesis .
 qed
 
 lemma expectation_nonpos_tail:
   assumes [measurable]: "random_variable borel X"
     and X_nonpos: "\<And>x. x \<in> space M \<Longrightarrow> X x \<le> 0"
   defines "F u \<equiv> cdf (distr M borel X) u"
   shows "(\<integral>\<^sup>+x. ennreal (- X x) \<partial>M) = \<integral>\<^sup>+u\<in>{..0}. ennreal (F u) \<partial>lborel"
 proof -
   let ?distrX = "distr M borel X"
   have "(\<integral>\<^sup>+x. ennreal (- X x) \<partial>M) = (\<integral>\<^sup>+u. ennreal (-u) \<partial>?distrX)"
     by (rewrite nn_integral_distr; simp)
   also have "\<dots> = \<integral>\<^sup>+u\<in>{..0}. ennreal (-u) \<partial>?distrX"
   proof -
     have [simp]: "{..0::real} \<union> {0<..} = UNIV" by force
     have "(\<integral>\<^sup>+u. ennreal (-u) \<partial>?distrX) =
       (\<integral>\<^sup>+u\<in>{..0}. ennreal (-u) \<partial>?distrX) + (\<integral>\<^sup>+u\<in>{0<..}. ennreal (-u) \<partial>?distrX)"
       by (rewrite nn_integral_disjoint_pair[THEN sym], simp_all, force)
     also have "\<dots> = (\<integral>\<^sup>+u\<in>{..0}. ennreal (-u) \<partial>?distrX)"
       apply (rewrite nn_integral_zero'[of "\<lambda>u. ennreal (-u) * indicator {0<..} u"]; simp?)
       unfolding indicator_def using always_eventually ennreal_lt_0 by force
     finally show ?thesis .
   qed
   also have "\<dots> = \<integral>\<^sup>+u\<in>{..0}. (\<integral>\<^sup>+v\<in>{..0}. indicator {u..} v \<partial>lborel) \<partial>?distrX"
   proof -
     have "\<And>u::real. u\<in>{..0} \<Longrightarrow> ennreal (-u) = \<integral>\<^sup>+v\<in>{..0}. indicator {u..} v \<partial>lborel"
       apply (rewrite indicator_inter_arith[THEN sym])
       apply (rewrite nn_integral_indicator, measurable, simp)
       by (metis emeasure_lborel_Icc atLeastAtMost_def diff_0)
     thus ?thesis by (metis (no_types, lifting) indicator_eq_0_iff mult_eq_0_iff)
   qed
   also have "\<dots> = \<integral>\<^sup>+v\<in>{..0}. (\<integral>\<^sup>+u\<in>{..0}. indicator {u..} v \<partial>?distrX) \<partial>lborel"
   proof -
     have "\<integral>\<^sup>+u\<in>{..0}. (\<integral>\<^sup>+v\<in>{..0}. indicator {u..} v \<partial>lborel) \<partial>?distrX =
       \<integral>\<^sup>+u. (\<integral>\<^sup>+v. indicator {u..} v * indicator {..0} v * indicator {..0} u \<partial>lborel) \<partial>?distrX"
       by (rewrite nn_integral_multc; simp)
     also have "\<dots> =
       \<integral>\<^sup>+v. (\<integral>\<^sup>+u. indicator {u..} v * indicator {..0} v * indicator {..0} u \<partial>?distrX) \<partial>lborel"
       apply (rewrite pair_sigma_finite.Fubini'; simp?)
       using pair_sigma_finite.intro assms
         prob_space_distr prob_space_imp_sigma_finite sigma_finite_lborel
        apply blast
       by measurable auto
     also have "\<dots> = \<integral>\<^sup>+v\<in>{..0}. (\<integral>\<^sup>+u\<in>{..0}. indicator {u..} v \<partial>?distrX) \<partial>lborel"
       apply (rewrite nn_integral_multc[THEN sym]; measurable; simp?)
       apply (rule nn_integral_cong)+ 
       using mult.assoc mult.commute by metis
     finally show ?thesis by simp
   qed
   also have "\<dots> = \<integral>\<^sup>+v\<in>{..0}. (\<integral>\<^sup>+u. indicator {..v} u \<partial>?distrX) \<partial>lborel"
     apply (rule nn_integral_cong)
     apply (rewrite nn_integral_multc[THEN sym], measurable; (simp del: nn_integral_indicator)?)+
     apply (rule nn_integral_cong)
     using atMost_iff atLeast_iff indicator_simps by (smt (verit, del_insts) mult_1 mult_eq_0_iff)
   also have "\<dots> = \<integral>\<^sup>+v\<in>{..0}. ennreal (F v) \<partial>lborel"
     apply (rule nn_integral_cong, simp)
     apply (rewrite emeasure_distr; simp?)
     unfolding F_def cdf_def
     by (rewrite measure_distr; simp add: emeasure_eq_measure)
   finally show ?thesis .
 qed
 
 proposition expectation_tail:
   assumes [measurable]: "integrable M X"
   defines "F u \<equiv> cdf (distr M borel X) u"
   shows "expectation X = (LBINT u:{0..}. 1 - F u) - (LBINT u:{..0}. F u)"
 proof -
   have "expectation X = expectation (\<lambda>x. max (X x) 0) + expectation (\<lambda>x. min (X x) 0)"
     using integrable_max integrable_min
     apply (rewrite Bochner_Integration.integral_add[THEN sym], measurable)
     by (rule Bochner_Integration.integral_cong; simp)
   also have "\<dots> = expectation (\<lambda>x. max (X x) 0) - expectation (\<lambda>x. - min (X x) 0)" by force
   also have "\<dots> = (LBINT u:{0..}. 1 - F u) - (LBINT u:{..0}. F u)"
   proof -
     have "expectation (\<lambda>x. max (X x) 0) = LBINT u:{0..}. 1 - F u"
     proof -
       have "expectation (\<lambda>x. max (X x) 0) = enn2real (\<integral>\<^sup>+x. ennreal (max (X x) 0) \<partial>M)"
         by (rule integral_eq_nn_integral; simp)
       also have "\<dots> = enn2real (\<integral>\<^sup>+u\<in>{0..}. ennreal (1 - F u) \<partial>lborel)"
         apply (rewrite expectation_nonneg_tail; simp?)
         apply (rewrite cdf_distr_max, simp)
         unfolding F_def
         by (metis (opaque_lifting) indicator_simps mult.commute mult_1 mult_eq_0_iff)
       also have "\<dots> = enn2real (\<integral>\<^sup>+u. ennreal ((1 - F u) * indicator {0..} u) \<partial>lborel)"
         by (simp add: indicator_mult_ennreal mult.commute)
       also have "\<dots> = LBINT u:{0..}. 1 - F u"
         apply (rewrite integral_eq_nn_integral[THEN sym], simp add: F_def)
         unfolding F_def using real_distribution.cdf_bounded_prob apply force
         unfolding set_lebesgue_integral_def by (rule Bochner_Integration.integral_cong; simp)
       finally show ?thesis .
     qed
     moreover have "expectation (\<lambda>x. - min (X x) 0) = LBINT u:{..0}. F u"
     proof -
       have "expectation (\<lambda>x. - min (X x) 0) = enn2real (\<integral>\<^sup>+x. ennreal (- min (X x) 0) \<partial>M)"
         by (rule integral_eq_nn_integral; simp)
       also have "\<dots> = enn2real (\<integral>\<^sup>+u\<in>{..0}. ennreal (F u) \<partial>lborel)"
       proof -
         let ?distrminX = "distr M borel (\<lambda>x. min (X x) 0)"
         have [simp]: "sym_diff {..0} {..<0} = {0::real}" by force
         have "enn2real (\<integral>\<^sup>+x. ennreal (- min (X x) 0) \<partial>M) =
       enn2real (\<integral>\<^sup>+u\<in>{..0}. ennreal (cdf ?distrminX u) \<partial>lborel)"
           by (rewrite expectation_nonpos_tail; simp)
         also have "\<dots> = enn2real (\<integral>\<^sup>+u\<in>{..<0}. ennreal (cdf ?distrminX u) \<partial>lborel)"
           by (rewrite nn_integral_null_delta, auto)
         also have "\<dots> = enn2real (\<integral>\<^sup>+u\<in>{..<0}. ennreal (F u) \<partial>lborel)"
           apply (rewrite cdf_distr_min, simp)
           apply (rule arg_cong[where f=enn2real], rule nn_integral_cong)
           unfolding F_def by (smt (verit) indicator_simps mult_cancel_left1 mult_eq_0_iff)
         also have "\<dots> = enn2real (\<integral>\<^sup>+u\<in>{..0}. ennreal (F u) \<partial>lborel)"
           by (rewrite nn_integral_null_delta, auto simp add: sup_commute)
         finally show ?thesis .
       qed
       also have "\<dots> = enn2real (\<integral>\<^sup>+u. ennreal (F u * indicator {..0} u) \<partial>lborel)"
         using mult.commute indicator_mult_ennreal by metis
       also have "\<dots> = LBINT u:{..0}. F u"
         apply (rewrite integral_eq_nn_integral[THEN sym], simp add: F_def)
         unfolding F_def
         using finite_borel_measure.cdf_nonneg real_distribution.finite_borel_measure_M apply simp
         unfolding set_lebesgue_integral_def by (rule Bochner_Integration.integral_cong; simp)
       finally show ?thesis .
     qed
     ultimately show ?thesis by simp
   qed
   finally show ?thesis .
 qed
 
 proposition distributed_deriv_cdf:
   assumes [measurable]: "random_variable borel X"
   defines "F u \<equiv> cdf (distr M borel X) u"
   assumes "finite S" "\<And>x. x \<notin> S \<Longrightarrow> (F has_real_derivative f x) (at x)"
     and "continuous_on UNIV F" "f \<in> borel_measurable lborel"
   shows "distributed M lborel X f"
 proof -
   have FBM: "finite_borel_measure (distr M borel X)"
     using real_distribution.finite_borel_measure_M real_distribution_distr assms by simp
   then interpret distrX_FBM: finite_borel_measure "distr M borel X" .
   have FBMl: "finite_borel_measure (distr M lborel X)" using FBM distr_borel_lborel by smt
   then interpret distrlX_FBM: finite_borel_measure "distr M lborel X" .
   have [simp]: "(\<lambda>x. ennreal (f x)) \<in> borel_measurable borel" using assms by simp
   moreover have "distr M lborel X = density lborel f"
   proof -
     have "\<And>a b. a \<le> b \<Longrightarrow> emeasure (distr M lborel X) {a<..b} < \<top>"
       using distrlX_FBM.emeasure_real less_top_ennreal by blast
     moreover have "\<And>a b. a \<le> b \<Longrightarrow>
       emeasure (distr M lborel X) {a<..b} = emeasure (density lborel f) {a<..b}"
     proof -
       fix a b :: real assume "a \<le> b"
       hence [simp]: "sym_diff {a<..b} {a..b} = {a}" by force
       have "emeasure (density lborel f) {a<..b} = \<integral>\<^sup>+x\<in>{a<..b}. ennreal (f x) \<partial>lborel"
         by (rewrite emeasure_density; simp)
       also have "\<dots> = \<integral>\<^sup>+x\<in>{a..b}. ennreal (f x) \<partial>lborel" by (rewrite nn_integral_null_delta, auto)
       also have "\<dots> = \<integral>\<^sup>+x. ennreal (indicat_real {a..b} x * f x) \<partial>lborel"
         by (metis indicator_mult_ennreal mult.commute)
       also have "\<dots> = ennreal (F b - F a)"
       proof -
         define g where "g x = (if x \<in> S then 0 else f x)" for x :: real
         have [simp]: "\<And>x. g x \<ge> 0"
           unfolding g_def
           apply (split if_split, auto)
           apply (rule mono_on_imp_deriv_nonneg[of UNIV F], auto)
           unfolding F_def mono_on_def using distrX_FBM.cdf_nondecreasing apply blast
           using assms unfolding F_def by force
         have "(\<integral>\<^sup>+x. ennreal (indicat_real {a..b} x * f x) \<partial>lborel)
           = \<integral>\<^sup>+x. ennreal (indicat_real {a..b} x * g x) \<partial>lborel"
           apply (rule nn_integral_cong_AE)
           apply (rule AE_mp[where P= "\<lambda>x. x \<notin> S"])
           using assms finite_imp_null_set_lborel AE_not_in apply blast
           unfolding g_def by simp
         also have "\<dots> = ennreal (F b - F a)"
           apply (rewrite nn_integral_has_integral_lebesgue, simp)
            apply (rule fundamental_theorem_of_calculus_strong[of S], auto simp: \<open>a \<le> b\<close> g_def assms)
           using has_real_derivative_iff_has_vector_derivative assms apply presburger
           using assms continuous_on_subset subsetI by fastforce
         finally show ?thesis .
       qed
       also have "\<dots> = emeasure (distr M lborel X) {a <.. b}"
         apply (rewrite distrlX_FBM.emeasure_Ioc, simp add: \<open>a \<le> b\<close>)
         unfolding F_def cdf_def
         apply (rewrite ennreal_minus[THEN sym], simp)+
         by (metis distr_borel_lborel)
       finally show "emeasure (distr M lborel X) {a<..b} = emeasure (density lborel f) {a<..b}"
         by simp
     qed
     ultimately show ?thesis by (intro measure_eqI_Ioc; simp)
   qed
   ultimately show ?thesis unfolding distributed_def by auto
 qed
 
 end
 
 text \<open>
   Define the conditional probability space.
   This is obtained by rescaling the restricted space of a probability space.
 \<close>
 
 subsection \<open>Conditional Probability Space\<close>
 
 lemma restrict_prob_space:
   assumes "measure_space \<Omega> A \<mu>" "a \<in> A"
     and "0 < \<mu> a" "\<mu> a < \<infinity>"
   shows "prob_space (scale_measure (1 / \<mu> a) (restrict_space (measure_of \<Omega> A \<mu>) a))"
 proof
   let ?M = "measure_of \<Omega> A \<mu>"
   let ?Ma = "restrict_space ?M a"
   let ?rMa = "scale_measure (1 / \<mu> a) ?Ma"
   have "emeasure ?rMa (space ?rMa) = 1 / \<mu> a * emeasure ?Ma (space ?rMa)" by simp
   also have "\<dots> = 1 / \<mu> a * emeasure ?M (space ?rMa)"
     using assms
     apply (rewrite emeasure_restrict_space)
     apply (simp add: measure_space_def sigma_algebra.sets_measure_of_eq)
     by (simp add: space_restrict_space space_scale_measure) simp
   also have "\<dots> = 1 / \<mu> a * emeasure ?M (space ?Ma)" by (rewrite space_scale_measure) simp
   also have "\<dots> = 1 / \<mu> a * emeasure ?M a"
     using assms
     apply (rewrite space_restrict_space2)
     by (simp add: measure_space_closed)+
   also have "\<dots> = 1"
     using assms measure_space_def
     apply (rewrite emeasure_measure_of_sigma, blast+)
     by (simp add: ennreal_divide_times)
   finally show "emeasure ?rMa (space ?rMa) = 1" .
 qed
 
 definition cond_prob_space :: "'a measure \<Rightarrow> 'a set \<Rightarrow> 'a measure" (infix "\<downharpoonright>" 200)
   where "M\<downharpoonright>A \<equiv> scale_measure (1 / emeasure M A) (restrict_space M A)"
 
 context prob_space
 begin
 
 lemma cond_prob_space_whole[simp]: "M \<downharpoonright> space M = M"
   unfolding cond_prob_space_def using emeasure_space_1 by simp
 
 lemma cond_prob_space_correct:
   assumes "A \<in> events" "prob A > 0"
   shows "prob_space (M\<downharpoonright>A)"
   unfolding cond_prob_space_def
   apply (subst(2) measure_of_of_measure[of M, THEN sym])
   using assms
   by (intro restrict_prob_space; (simp add: measure_space)?; simp_all add: emeasure_eq_measure)
 
 lemma space_cond_prob_space:
   assumes "A \<in> events"
   shows "space (M\<downharpoonright>A) = A"
   unfolding cond_prob_space_def using assms by (simp add: space_scale_measure)
 
 lemma sets_cond_prob_space: "sets (M\<downharpoonright>A) = (\<inter>) A ` events"
   unfolding cond_prob_space_def by (metis sets_restrict_space sets_scale_measure)
 
 lemma measure_cond_prob_space:
   assumes "A \<in> events" "B \<in> events"
     and "prob A > 0"
   shows "measure (M\<downharpoonright>A) (B \<inter> A) = prob (B \<inter> A) / prob A"
 proof -
   have "1 / emeasure M A = ennreal (1 / prob A)"
     using assms by (smt (verit) divide_ennreal emeasure_eq_measure ennreal_1)
   hence "measure (M\<downharpoonright>A) (B \<inter> A) = (1 / prob A) * measure (restrict_space M A) (B \<inter> A)"
     unfolding cond_prob_space_def using measure_scale_measure by force
   also have "\<dots> = (1 / prob A) * prob (B \<inter> A)"
     using measure_restrict_space assms by (metis inf.cobounded2 sets.Int_space_eq2)
   also have "\<dots> = prob (B \<inter> A) / prob A" by simp
   finally show ?thesis .
 qed
 
 corollary measure_cond_prob_space_subset:
   assumes "A \<in> events" "B \<in> events" "B \<subseteq> A"
     and "prob A > 0"
   shows "measure (M\<downharpoonright>A) B = prob B / prob A"
 proof -
   have "B = B \<inter> A" using assms by auto
   moreover have "measure (M\<downharpoonright>A) (B \<inter> A) = prob (B \<inter> A) / prob A"
     using assms measure_cond_prob_space by simp
   ultimately show ?thesis by auto
 qed
 
 lemma cond_cond_prob_space:
   assumes "A \<in> events" "B \<in> events" "B \<subseteq> A" "prob B > 0"
   shows "(M\<downharpoonright>A)\<downharpoonright>B = M\<downharpoonright>B"
 proof (rule measure_eqI)
   have pA_pos[simp]: "prob A > 0" using assms by (smt (verit, ccfv_SIG) finite_measure_mono)
   interpret MA_PS: prob_space "M\<downharpoonright>A" using cond_prob_space_correct assms by simp
   interpret MB_PS: prob_space "M\<downharpoonright>B" using cond_prob_space_correct assms by simp
   have "1 / emeasure M A = ennreal (1 / prob A)"
     using pA_pos by (smt (verit, ccfv_SIG) divide_ennreal emeasure_eq_measure ennreal_1)
   hence [simp]: "0 < MA_PS.prob B"
     using assms pA_pos
     by (metis divide_eq_0_iff measure_cond_prob_space_subset zero_less_measure_iff)
   have [simp]: "B \<in> MA_PS.events"
     using assms by (rewrite sets_cond_prob_space, unfold image_def) blast
   have [simp]: "finite_measure ((M\<downharpoonright>A)\<downharpoonright>B)"
     by (rule prob_space.finite_measure, rule prob_space.cond_prob_space_correct,
         simp_all add: MA_PS.prob_space_axioms)
   show sets_MAB: "sets ((M\<downharpoonright>A)\<downharpoonright>B) = sets (M\<downharpoonright>B)"
     apply (rewrite prob_space.sets_cond_prob_space)
     using MA_PS.prob_space_axioms apply presburger
     apply (rewrite sets_cond_prob_space, unfold image_def)+
     using assms by blast
   show "\<And>C. C \<in> sets ((M\<downharpoonright>A)\<downharpoonright>B) \<Longrightarrow> emeasure ((M\<downharpoonright>A)\<downharpoonright>B) C = emeasure (M\<downharpoonright>B) C"
   proof -
     fix C assume "C \<in> sets ((M\<downharpoonright>A)\<downharpoonright>B)"
     hence "C \<in> sets (M\<downharpoonright>B)" using sets_MAB by simp
     from this obtain D where "D \<in> events" "C = B \<inter> D"
       by (rewrite in asm sets_cond_prob_space, auto)
     hence [simp]: "C \<in> events" and [simp]: "C \<subseteq> B" and [simp]: "C \<subseteq> A" using assms by auto
     hence [simp]: "C \<in> MA_PS.events"
       using assms by (rewrite sets_cond_prob_space, unfold image_def) blast
     show "emeasure ((M\<downharpoonright>A)\<downharpoonright>B) C = emeasure (M\<downharpoonright>B) C"
       apply (rewrite finite_measure.emeasure_eq_measure, simp)+
       apply (rewrite ennreal_inj, simp_all)
       apply (rewrite prob_space.measure_cond_prob_space_subset,
           simp_all add: assms prob_space_axioms MA_PS.prob_space_axioms)+
       using pA_pos by fastforce
   qed
 qed
 
 lemma cond_prob_space_prob:
   assumes[measurable]: "Measurable.pred M P" "Measurable.pred M Q"
     and "\<P>(x in M. Q x) > 0"
   shows "measure (M \<downharpoonright> {x \<in> space M. Q x}) {x \<in> space M. P x \<and> Q x} = \<P>(x in M. P x \<bar> Q x)"
 proof -
   let ?SetP = "{x \<in> space M. P x}"
   let ?SetQ = "{x \<in> space M. Q x}"
   have "measure (M\<downharpoonright>?SetQ) {x \<in> space M. P x \<and> Q x} = measure (M\<downharpoonright>?SetQ) (?SetP \<inter> ?SetQ)"
     by (smt (verit, ccfv_SIG) Collect_cong Int_def mem_Collect_eq)
   also have "\<dots> = prob (?SetP \<inter> ?SetQ) / prob ?SetQ"
     using assms by (rewrite measure_cond_prob_space; simp?)
   also have "\<dots> = \<P>(x in M. P x \<bar> Q x)"
     unfolding cond_prob_def assms by (smt (verit) Collect_cong Int_def mem_Collect_eq)
   finally show ?thesis .
 qed
 
 lemma cond_prob_space_cond_prob:
   assumes [measurable]: "Measurable.pred M P" "Measurable.pred M Q"
     and "\<P>(x in M. Q x) > 0"
   shows "\<P>(x in M. P x \<bar> Q x) = \<P>(x in (M \<downharpoonright> {x \<in> space M. Q x}). P x)"
 proof -
   let ?setQ = "{x \<in> space M. Q x}"
   have "\<P>(x in M. P x \<bar> Q x) = measure (M\<downharpoonright>?setQ) {x \<in> space M. P x \<and> Q x}"
     using cond_prob_space_prob assms by simp
   also have "\<dots> = \<P>(x in (M\<downharpoonright>?setQ). P x)"
   proof -
     have "{x \<in> space M. P x \<and> Q x} = {x \<in> space (M\<downharpoonright>?setQ). P x}"
       using space_cond_prob_space assms by force
     thus ?thesis by simp
   qed
   finally show ?thesis .
 qed
 
 lemma cond_prob_neg:
   assumes[measurable]: "Measurable.pred M P" "Measurable.pred M Q"
     and "\<P>(x in M. Q x) > 0"
   shows "\<P>(x in M. \<not> P x \<bar> Q x) = 1 - \<P>(x in M. P x \<bar> Q x)"
 proof -
   let ?setP = "{x \<in> space M. P x}"
   let ?setQ = "{x \<in> space M. Q x}"
   interpret setQ_PS: prob_space "M\<downharpoonright>?setQ" using cond_prob_space_correct assms by simp
   have [simp]: "{x \<in> space (M\<downharpoonright>?setQ). P x} \<in> setQ_PS.events"
   proof -
     have "{x \<in> space (M\<downharpoonright>?setQ). P x} = ?setQ \<inter> ?setP" using space_cond_prob_space by force
     thus ?thesis using sets_cond_prob_space by simp
   qed
   have "\<P>(x in M. \<not> P x \<bar> Q x) = \<P>(x in M\<downharpoonright>?setQ. \<not> P x)"
     by (rewrite cond_prob_space_cond_prob; simp add: assms)
   also have "\<dots> = 1 - \<P>(x in M\<downharpoonright>?setQ. P x)" by (rewrite setQ_PS.prob_neg, simp_all add: assms)
   also have "\<dots> = 1 - \<P>(x in M. P x \<bar> Q x)"
     by (rewrite cond_prob_space_cond_prob; simp add: assms)
   finally show ?thesis .
 qed
 
 lemma random_variable_cond_prob_space:
   assumes "A \<in> events" "prob A > 0"
     and [measurable]: "random_variable borel X"
   shows "X \<in> borel_measurable (M\<downharpoonright>A)"
 proof (rule borel_measurableI)
   fix S :: "'b set"
   assume [measurable]: "open S"
   show "X -` S \<inter> space (M \<downharpoonright> A) \<in> sets (M \<downharpoonright> A)"
     apply (rewrite space_cond_prob_space, simp add: assms)
     apply (rewrite sets_cond_prob_space, simp add: image_def)
     apply (rule bexI[of _ "X -` S \<inter> space M"]; measurable)
     using sets.Int_space_eq2 Int_commute assms by auto
 qed
 
 lemma AE_cond_prob_space_iff:
   assumes "A \<in> events" "prob A > 0"
   shows "(AE x in M\<downharpoonright>A. P x) \<longleftrightarrow> (AE x in M. x \<in> A \<longrightarrow> P x)"
 proof -
   have [simp]: "1 / emeasure M A > 0"
     using assms divide_ennreal emeasure_eq_measure ennreal_1
     by (smt (verit) divide_pos_pos ennreal_eq_0_iff not_gr_zero)
   show ?thesis
     unfolding cond_prob_space_def
     apply (rewrite AE_scale_measure_iff, simp)
     by (rewrite AE_restrict_space_iff; simp add: assms)
 qed
 
 lemma integral_cond_prob_space_nn:
   assumes "A \<in> events" "prob A > 0"
     and [measurable]: "random_variable borel X"
     and nonneg: "AE x in M. x \<in> A \<longrightarrow> 0 \<le> X x"
   shows "integral\<^sup>L (M\<downharpoonright>A) X = expectation (\<lambda>x. indicator A x * X x) / prob A"
 proof -
   have [simp]: "X \<in> borel_measurable (M\<downharpoonright>A)"
     by (rule random_variable_cond_prob_space; (simp add: assms))
   have [simp]: "AE x in (M\<downharpoonright>A). 0 \<le> X x"
     by (rewrite AE_cond_prob_space_iff; simp add: assms)
   have [simp]: "random_variable borel (\<lambda>x. indicat_real A x * X x)" 
     using borel_measurable_indicator assms by force
   have [simp]: "AE x in M. 0 \<le> indicat_real A x * X x" using nonneg by fastforce
   have "integral\<^sup>L (M\<downharpoonright>A) X = enn2real (\<integral>\<^sup>+ x. ennreal (X x) \<partial>(M\<downharpoonright>A))"
     by (rewrite integral_eq_nn_integral; simp)
   also have "\<dots> = enn2real (1 / prob A * \<integral>\<^sup>+ x. ennreal (X x) \<partial>(restrict_space M A))"
     unfolding cond_prob_space_def
     apply (rewrite nn_integral_scale_measure, simp add: measurable_restrict_space1)
     using divide_ennreal emeasure_eq_measure ennreal_1 assms by smt
   also have "\<dots> = enn2real (1 / prob A * (\<integral>\<^sup>+ x. ennreal (indicator A x * X x) \<partial>M))"
     apply (rewrite nn_integral_restrict_space, simp add: assms)
     by (metis indicator_mult_ennreal mult.commute)
   also have "\<dots> = integral\<^sup>L M (\<lambda>x. indicator A x * X x) / prob A"
     apply (rewrite integral_eq_nn_integral; simp?)
     by (simp add: divide_nonneg_pos enn2real_mult)
   finally show ?thesis by simp
 qed
 
 end
 
 text \<open>
   Define the complementary cumulative distribution function, also known as tail distribution.
   The theory presented below is a slight modification of the subsection "Properties of cdf's"
   in the theory "@{text Distribution_Functions}".
 \<close>
 
 subsection \<open>Complementary Cumulative Distribution Function\<close>
 
 definition ccdf :: "real measure \<Rightarrow> real \<Rightarrow> real"
   where "ccdf M \<equiv> \<lambda>x. measure M {x<..}"
     \<comment> \<open>complementary cumulative distribution function (tail distribution)\<close>
 
 lemma ccdf_def2: "ccdf M x = measure M {x<..}"
   by (simp add: ccdf_def)
 
 context finite_borel_measure
 begin
 
 lemma add_cdf_ccdf: "cdf M x + ccdf M x = measure M (space M)"
 proof -
   have "{..x} \<union> {x<..} = UNIV" by auto
   moreover have "{..x} \<inter> {x<..} = {}" by auto
   ultimately have "emeasure M {..x} + emeasure M {x<..} = emeasure M UNIV"
     using plus_emeasure M_is_borel atMost_borel greaterThan_borel by metis
   hence "measure M {..x} + measure M {x<..} = measure M UNIV"
     using finite_emeasure_space emeasure_eq_measure ennreal_inj
     by (smt (verit, ccfv_SIG) ennreal_plus measure_nonneg)
   thus ?thesis unfolding cdf_def ccdf_def using borel_UNIV by simp
 qed
 
 lemma ccdf_cdf: "ccdf M = (\<lambda>x. measure M (space M) - cdf M x)"
   by (rule ext) (smt add_cdf_ccdf)
 
 lemma cdf_ccdf: "cdf M = (\<lambda>x. measure M (space M) - ccdf M x)"
   by (rule ext) (smt add_cdf_ccdf)
 
 lemma isCont_cdf_ccdf: "isCont (cdf M) x \<longleftrightarrow> isCont (ccdf M) x"
 proof
   show "isCont (cdf M) x \<Longrightarrow> isCont (ccdf M) x" by (rewrite ccdf_cdf) auto
 next
   show "isCont (ccdf M) x \<Longrightarrow> isCont (cdf M) x" by (rewrite cdf_ccdf) auto
 qed
 
 lemma isCont_ccdf: "isCont (ccdf M) x \<longleftrightarrow> measure M {x} = 0"
   using isCont_cdf_ccdf isCont_cdf by simp
 
 lemma continuous_cdf_ccdf:
   shows "continuous F (cdf M) \<longleftrightarrow> continuous F (ccdf M)"
     (is "?LHS \<longleftrightarrow> ?RHS")
 proof
   assume ?LHS
   thus ?RHS using continuous_diff continuous_const by (rewrite ccdf_cdf) blast
 next
   assume ?RHS
   thus ?LHS using continuous_diff continuous_const by (rewrite cdf_ccdf) blast
 qed
 
 lemma has_real_derivative_cdf_ccdf:
   "(cdf M has_real_derivative D) F \<longleftrightarrow> (ccdf M has_real_derivative -D) F"
 proof
   assume "(cdf M has_real_derivative D) F"
   thus "(ccdf M has_real_derivative -D) F"
     using ccdf_cdf DERIV_const Deriv.field_differentiable_diff by fastforce
 next
   assume "(ccdf M has_real_derivative -D) F"
   thus "(cdf M has_real_derivative D) F"
     using cdf_ccdf DERIV_const Deriv.field_differentiable_diff by fastforce
 qed
 
 lemma differentiable_cdf_ccdf: "(cdf M differentiable F) \<longleftrightarrow> (ccdf M differentiable F)"
   unfolding differentiable_def
   apply (rewrite has_real_derivative_iff[THEN sym])+
   apply (rewrite has_real_derivative_cdf_ccdf)
   by (metis verit_minus_simplify(4))
 
 lemma deriv_cdf_ccdf:
   assumes "cdf M differentiable at x"
   shows "deriv (cdf M) x = - deriv (ccdf M) x"
   using has_real_derivative_cdf_ccdf differentiable_cdf_ccdf assms
   by (simp add: DERIV_deriv_iff_real_differentiable DERIV_imp_deriv)
 
 lemma ccdf_diff_eq2:
   assumes "x \<le> y"
   shows "ccdf M x - ccdf M y = measure M {x<..y}"
 proof -
   have "ccdf M x - ccdf M y = cdf M y - cdf M x" using add_cdf_ccdf by (smt (verit))
   also have "\<dots> = measure M {x<..y}" using cdf_diff_eq2 assms by simp
   finally show ?thesis .
 qed
 
 lemma ccdf_nonincreasing: "x \<le> y \<Longrightarrow> ccdf M x \<ge> ccdf M y"
   using add_cdf_ccdf cdf_nondecreasing by smt
 
 lemma ccdf_nonneg: "ccdf M x \<ge> 0"
   using add_cdf_ccdf cdf_bounded by smt
 
 lemma ccdf_bounded: "ccdf M x \<le> measure M (space M)"
   using add_cdf_ccdf cdf_nonneg by smt
 
 lemma ccdf_lim_at_top: "(ccdf M \<longlongrightarrow> 0) at_top"
 proof -
   have "((\<lambda>x. measure M (space M) - cdf M x) \<longlongrightarrow> measure M (space M) - measure M (space M)) at_top"
     apply (intro tendsto_intros)
     by (rule cdf_lim_at_top)
   thus ?thesis
     by (rewrite ccdf_cdf) simp
 qed
 
 lemma ccdf_lim_at_bot: "(ccdf M \<longlongrightarrow> measure M (space M)) at_bot"
 proof -
   have "((\<lambda>x. measure M (space M) - cdf M x) \<longlongrightarrow> measure M (space M) - 0) at_bot"
     apply (intro tendsto_intros)
     by (rule cdf_lim_at_bot)
   thus ?thesis
     by (rewrite ccdf_cdf) simp
 qed
 
 lemma ccdf_is_right_cont: "continuous (at_right a) (ccdf M)"
 proof -
   have "continuous (at_right a) (\<lambda>x. measure M (space M) - cdf M x)"
     apply (intro continuous_intros)
     by (rule cdf_is_right_cont)
   thus ?thesis by (rewrite ccdf_cdf) simp
 qed
 
 end
 
 context prob_space
 begin
 
 lemma ccdf_distr_measurable [measurable]:
   assumes [measurable]: "random_variable borel X"
   shows "ccdf (distr M borel X) \<in> borel_measurable borel"
   using real_distribution.finite_borel_measure_M by (rewrite finite_borel_measure.ccdf_cdf; simp)
 
 lemma ccdf_distr_P:
   assumes "random_variable borel X"
   shows "ccdf (distr M borel X) x = \<P>(\<omega> in M. X \<omega> > x)"
   unfolding ccdf_def apply (rewrite measure_distr; (simp add: assms)?)
   unfolding vimage_def by (rule arg_cong[where f=prob]) force
 
 lemma ccdf_continuous_distr_P_ge:
   assumes "random_variable borel X" "isCont (ccdf (distr M borel X)) x"
   shows "ccdf (distr M borel X) x = \<P>(\<omega> in M. X \<omega> \<ge> x)"
 proof -
   have "ccdf (distr M borel X) x = measure (distr M borel X) {x<..}" unfolding ccdf_def by simp
   also have "\<dots> = measure (distr M borel X) ({x<..} \<union> {x})"
     apply (rewrite finite_measure.measure_zero_union, simp_all add: assms finite_measure_distr)
     using finite_borel_measure.isCont_ccdf real_distribution.finite_borel_measure_M assms by blast
   also have "\<dots> = measure (distr M borel X) {x..}" by (metis Un_commute ivl_disj_un_singleton(1))
   also have "\<dots> = \<P>(\<omega> in M. X \<omega> \<ge> x)" 
     apply (rewrite measure_distr, simp_all add: assms)
     unfolding vimage_def by simp (smt (verit) Collect_cong Int_def mem_Collect_eq)
   finally show ?thesis .
 qed
 
 lemma ccdf_distr_diff_P:
   assumes "x \<le> y"
     and "random_variable borel X"
   shows "ccdf (distr M borel X) x - ccdf (distr M borel X) y = \<P>(\<omega> in M. x < X \<omega> \<and> X \<omega> \<le> y)"
 proof -
   interpret distrX_FBM: finite_borel_measure "distr M borel X"
     using real_distribution.finite_borel_measure_M real_distribution_distr assms by simp
   have "ccdf (distr M borel X) x - ccdf (distr M borel X) y = measure (distr M borel X) {x<..y}"
     by (rewrite distrX_FBM.ccdf_diff_eq2; simp add: assms)
   also have "\<dots> = \<P>(\<omega> in M. x < X \<omega> \<and> X \<omega> \<le> y)"
     apply (rewrite measure_distr; (simp add: assms)?)
     unfolding vimage_def by (rule arg_cong[where f=prob], force)
   finally show ?thesis .
 qed
 
 end
 
 context real_distribution
 begin
 
 lemma ccdf_bounded_prob: "\<And>x. ccdf M x \<le> 1"
   by (subst prob_space[THEN sym], rule ccdf_bounded)
 
 lemma ccdf_lim_at_bot_prob: "(ccdf M \<longlongrightarrow> 1) at_bot"
   by (subst prob_space[THEN sym], rule ccdf_lim_at_bot)
 
 end
 
 text \<open>Introduce the hazard rate. This notion will be used to define the force of mortality.\<close>
 
 subsection \<open>Hazard Rate\<close>
 
 context prob_space
 begin
 
 definition hazard_rate :: "('a \<Rightarrow> real) \<Rightarrow> real \<Rightarrow> real"
   where "hazard_rate X t \<equiv>
     Lim (at_right 0) (\<lambda>dt. \<P>(x in M. t < X x \<and> X x \<le> t + dt \<bar> X x > t) / dt)"
     \<comment> \<open>Here, X is supposed to be a random variable.\<close>
 
 lemma hazard_rate_0_ccdf_0:
   assumes [measurable]: "random_variable borel X"
     and "ccdf (distr M borel X) t = 0"
   shows "hazard_rate X t = 0"
   \<comment> \<open>Note that division by 0 is calculated as 0 in Isabelle/HOL.\<close>
 proof -
   have "\<And>dt. \<P>(x in M. t < X x \<and> X x \<le> t + dt \<bar> X x > t) = 0"
     unfolding cond_prob_def using ccdf_distr_P assms by simp
   hence "hazard_rate X t = Lim (at_right 0) (\<lambda>dt::real. 0)"
     unfolding hazard_rate_def by (rewrite Lim_cong; simp)
   also have "\<dots> = 0" by (rule tendsto_Lim; simp)
   finally show ?thesis .
 qed
 
 lemma hazard_rate_deriv_cdf:
   assumes [measurable]: "random_variable borel X"
     and "(cdf (distr M borel X)) differentiable at t"
   shows "hazard_rate X t = deriv (cdf (distr M borel X)) t / ccdf (distr M borel X) t"
 proof (cases \<open>ccdf (distr M borel X) t = 0\<close>)
   case True
   with hazard_rate_0_ccdf_0 show ?thesis by simp
 next
   case False
   let ?F = "cdf (distr M borel X)"
   have "\<forall>\<^sub>F dt in at_right 0. \<P>(x in M. t < X x \<and> X x \<le> t + dt \<bar> X x > t) / dt =
     (?F (t + dt) - ?F t) / dt / ccdf (distr M borel X) t"
     apply (rule eventually_at_rightI[where b=1]; simp)
     unfolding cond_prob_def
     apply (rewrite cdf_distr_diff_P; simp)
     apply (rewrite ccdf_distr_P[THEN sym], simp)
     by (smt (verit) Collect_cong mult.commute)
   moreover have "((\<lambda>dt. (?F (t + dt) - ?F t) / dt / ccdf (distr M borel X) t) \<longlongrightarrow>
     deriv ?F t / ccdf (distr M borel X) t) (at_right 0)"
     apply (rule tendsto_intros, simp_all add: False)
     apply (rule Lim_at_imp_Lim_at_within)
     using DERIV_deriv_iff_real_differentiable assms DERIV_def by blast
   ultimately show ?thesis
     unfolding hazard_rate_def using tendsto_cong by (intro tendsto_Lim; force)
 qed
 
 lemma deriv_cdf_hazard_rate:
   assumes [measurable]: "random_variable borel X"
     and "(cdf (distr M borel X)) differentiable at t"
   shows "deriv (cdf (distr M borel X)) t = ccdf (distr M borel X) t * hazard_rate X t"
 proof -
   interpret distrX_FBM: finite_borel_measure "distr M borel X"
     using real_distribution.finite_borel_measure_M real_distribution_distr assms by simp
   show ?thesis
   proof (cases \<open>ccdf (distr M borel X) t = 0\<close>)
     case True
     hence "cdf (distr M borel X) t = 1"
       using distrX_FBM.cdf_ccdf
       by simp (metis assms(1) distrX_FBM.borel_UNIV prob_space.prob_space prob_space_distr)
     moreover obtain D where "(cdf (distr M borel X) has_real_derivative D) (at t)"
       using assms real_differentiable_def by atomize_elim blast
     ultimately have "(cdf (distr M borel X) has_real_derivative 0) (at t)"
       using assms
       by (smt (verit) DERIV_local_max real_distribution.cdf_bounded_prob real_distribution_distr)
     thus ?thesis using True by (simp add: DERIV_imp_deriv)
   next
     case False
     thus ?thesis using hazard_rate_deriv_cdf assms by simp
   qed
 qed
 
 lemma hazard_rate_deriv_ccdf:
   assumes [measurable]: "random_variable borel X"
     and "(ccdf (distr M borel X)) differentiable at t"
   shows "hazard_rate X t = - deriv (ccdf (distr M borel X)) t / ccdf (distr M borel X) t"
 proof -
   interpret distrX_FBM: finite_borel_measure "distr M borel X"
     using real_distribution.finite_borel_measure_M real_distribution_distr assms by simp
   show ?thesis
     using hazard_rate_deriv_cdf distrX_FBM.deriv_cdf_ccdf assms distrX_FBM.differentiable_cdf_ccdf
     by presburger
 qed
 
 lemma deriv_ccdf_hazard_rate: 
   assumes [measurable]: "random_variable borel X"
     and "(ccdf (distr M borel X)) differentiable at t"
   shows "deriv (ccdf (distr M borel X)) t = - ccdf (distr M borel X) t * hazard_rate X t"
 proof -
   interpret distrX_FBM: finite_borel_measure "distr M borel X"
     using real_distribution.finite_borel_measure_M real_distribution_distr assms by simp
   show ?thesis
     using deriv_cdf_hazard_rate distrX_FBM.deriv_cdf_ccdf assms distrX_FBM.differentiable_cdf_ccdf
     by simp
 qed
 
 lemma hazard_rate_deriv_ln_ccdf:
   assumes [measurable]: "random_variable borel X"
     and "(ccdf (distr M borel X)) differentiable at t"
     and "ccdf (distr M borel X) t \<noteq> 0"
   shows "hazard_rate X t = - deriv (\<lambda>t. ln (ccdf (distr M borel X) t)) t"
 proof -
   interpret distrX_FBM: finite_borel_measure "distr M borel X"
     using real_distribution.finite_borel_measure_M real_distribution_distr assms by simp
   let ?srvl = "ccdf (distr M borel X)"
   have "?srvl t > 0" using distrX_FBM.ccdf_nonneg assms by (smt (verit))
   moreover have "(?srvl has_real_derivative (deriv ?srvl t)) (at t)"
     using DERIV_deriv_iff_real_differentiable assms by blast
   ultimately have "((\<lambda>t. ln (?srvl t)) has_real_derivative  1 / ?srvl t * deriv ?srvl t) (at t)"
     by (rule derivative_intros)
   hence "deriv (\<lambda>t. ln (?srvl t)) t = deriv ?srvl t / ?srvl t" by (simp add: DERIV_imp_deriv)
   also have "\<dots> = - hazard_rate X t" using hazard_rate_deriv_ccdf assms by simp
   finally show ?thesis by simp
 qed
 
 lemma hazard_rate_has_integral:
   assumes [measurable]: "random_variable borel X"
     and "t \<le> u"
     and "(ccdf (distr M borel X)) piecewise_differentiable_on {t<..<u}"
     and "continuous_on {t..u} (ccdf (distr M borel X))"
     and "\<And>s. s \<in> {t..u} \<Longrightarrow> ccdf (distr M borel X) s \<noteq> 0"
   shows
     "(hazard_rate X has_integral ln (ccdf (distr M borel X) t / ccdf (distr M borel X) u)) {t..u}"
 proof -
   interpret distrX_FBM: finite_borel_measure "distr M borel X"
     using real_distribution.finite_borel_measure_M real_distribution_distr assms by simp
   let ?srvl = "ccdf (distr M borel X)"
   have [simp]: "\<And>s. t \<le> s \<and> s \<le> u \<Longrightarrow> ?srvl s > 0"
     using distrX_FBM.ccdf_nonneg assms by (smt (verit) atLeastAtMost_iff)
   have "(deriv (\<lambda>s. - ln (?srvl s)) has_integral - ln (?srvl u) - - ln (?srvl t)) {t..u}"
   proof -
     have "continuous_on {t..u} (\<lambda>s. - ln (?srvl s))"
       by (rule continuous_intros, rule continuous_on_ln, auto simp add: assms)
     moreover hence "(\<lambda>s. - ln (?srvl s)) piecewise_differentiable_on {t<..<u}"
     proof -
       have "?srvl ` {t<..<u} \<subseteq> {0<..}"
       proof -
         { fix s assume "s \<in> {t<..<u}"
           hence "?srvl s \<noteq> 0" using assms by simp
           moreover have "?srvl s \<ge> 0" using distrX_FBM.ccdf_nonneg by simp
           ultimately have "?srvl s > 0" by simp }
         thus ?thesis by auto
       qed
       hence "(\<lambda>r. - ln r) \<circ> ?srvl piecewise_differentiable_on {t<..<u}"
         apply (intro differentiable_on_piecewise_compose, simp add: assms)
         apply (rule derivative_intros)
         apply (rule differentiable_on_subset[of ln "{0<..}"], simp_all)
         apply (rewrite differentiable_on_eq_field_differentiable_real, auto)
         unfolding field_differentiable_def using DERIV_ln by (metis has_field_derivative_at_within)
       thus ?thesis unfolding comp_def by simp
     qed
     ultimately show ?thesis by (intro FTC_real_deriv_has_integral; simp add: assms)
   qed
   hence ln: "(deriv (\<lambda>s. - ln (?srvl s)) has_integral ln (?srvl t / ?srvl u)) {t..u}"
     by simp (rewrite ln_div; force simp: assms)
   thus "((hazard_rate X) has_integral ln (?srvl t / ?srvl u)) {t..u}"
   proof -
     from assms obtain S0 where finS0: "finite S0" and
       diffS0: "\<And>s. s \<in> {t<..<u} - S0 \<Longrightarrow> ?srvl differentiable at s within {t<..<u}"
       unfolding piecewise_differentiable_on_def by blast
     from this obtain S where "finite S" and "\<And>s. s \<in> {t..u} - S \<Longrightarrow> ?srvl differentiable at s"
     proof (atomize_elim)
       let ?S = "S0 \<union> {t, u}"
       have "finite ?S" using finS0 by simp
       moreover have "\<forall>s. s \<in> {t..u} - ?S \<longrightarrow> ccdf (distr M borel X) differentiable at s"
       proof -
         { fix s assume s_in: "s \<in> {t..u} - ?S"
           hence "?srvl differentiable at s within {t<..<u}" using diffS0 by simp
           hence "?srvl differentiable at s"
             using s_in by (rewrite at_within_open[THEN sym], simp_all) }
         thus ?thesis by blast
       qed
       ultimately show
         "\<exists>S. finite S \<and> (\<forall>s. s \<in> {t..u} - S \<longrightarrow> ccdf (distr M borel X) differentiable at s)"
         by blast
     qed
     thus ?thesis
       apply (rewrite has_integral_spike_finite_eq [of S _ "deriv (\<lambda>s. - ln (?srvl s))"], simp)
        apply (rewrite hazard_rate_deriv_ln_ccdf, simp_all add: assms)
        apply (rewrite deriv_minus, simp_all)
        apply (rewrite in asm differentiable_eq_field_differentiable_real)
        apply (rewrite comp_def[THEN sym], rule field_differentiable_compose[of "?srvl"], simp_all)
       unfolding field_differentiable_def apply (rule exI, rule DERIV_ln, simp)
       using ln by simp
   qed
 qed
 
 corollary hazard_rate_integrable:
   assumes [measurable]: "random_variable borel X"
     and "t \<le> u"
     and "(ccdf (distr M borel X)) piecewise_differentiable_on {t<..<u}"
     and "continuous_on {t..u} (ccdf (distr M borel X))"
     and "\<And>s. s \<in> {t..u} \<Longrightarrow> ccdf (distr M borel X) s \<noteq> 0"
   shows "hazard_rate X integrable_on {t..u}"
   using has_integral_integrable hazard_rate_has_integral assms by blast
 
 lemma ccdf_exp_cumulative_hazard:
   assumes [measurable]: "random_variable borel X"
     and "t \<le> u"
     and "(ccdf (distr M borel X)) piecewise_differentiable_on {t<..<u}"
     and "continuous_on {t..u} (ccdf (distr M borel X))"
     and "\<And>s. s \<in> {t..u} \<Longrightarrow> ccdf (distr M borel X) s \<noteq> 0"
   shows "ccdf (distr M borel X) u / ccdf (distr M borel X) t =
     exp (- integral {t..u} (hazard_rate X))"
 proof -
   interpret distrX_FBM: finite_borel_measure "distr M borel X"
     using real_distribution.finite_borel_measure_M real_distribution_distr assms by simp
   let ?srvl = "ccdf (distr M borel X)"
   have [simp]: "\<And>s. t \<le> s \<and> s \<le> u \<Longrightarrow> ?srvl s > 0"
     using distrX_FBM.ccdf_nonneg assms by (smt (verit) atLeastAtMost_iff)
   have "integral {t..u} (hazard_rate X) = ln (?srvl t / ?srvl u)"
     using hazard_rate_has_integral has_integral_integrable_integral assms by auto
   also have "\<dots> = - ln (?srvl u / ?srvl t)" using ln_div assms by simp
   finally have "- integral {t..u} (hazard_rate X) = ln (?srvl u / ?srvl t)" by simp
   thus ?thesis using assms by simp
 qed
 
 lemma hazard_rate_density_ccdf:
   assumes "distributed M lborel X f"
     and "\<And>s. f s \<ge> 0" "t < u" "continuous_on {t..u} f"
   shows "hazard_rate X t = f t / ccdf (distr M borel X) t"
 proof (cases \<open>ccdf (distr M borel X) t = 0\<close>)
   case True
   thus ?thesis
     apply (rewrite hazard_rate_0_ccdf_0, simp_all)
     using assms(1) distributed_measurable by force
 next
   case False
   have [simp]: "t \<le> u" using assms by simp
   have [measurable]: "random_variable borel X"
     using assms distributed_measurable measurable_lborel1 by blast
   have [measurable]: "f \<in> borel_measurable lborel"
     using assms distributed_real_measurable by metis
   have [simp]: "integrable lborel f"
   proof -
     have "prob (X -` UNIV \<inter> space M) = LINT x|lborel. indicat_real UNIV x * f x"
       by (rule distributed_measure; simp add: assms)
     thus ?thesis
       using prob_space not_integrable_integral_eq by fastforce
   qed
   have "((\<lambda>dt. (LBINT s:{t..t+dt}. f s) / dt) \<longlongrightarrow> f t) (at_right 0)"
   proof -
     have "\<And>dt. (\<integral>\<^sup>+ x. ennreal (indicat_real {t..t+dt} x * f x) \<partial>lborel) < \<infinity>"
     proof -
       fix dt :: real
       have "(\<integral>\<^sup>+ x. ennreal (indicat_real {t..t+dt} x * f x) \<partial>lborel) =
         set_nn_integral lborel {t..t+dt} f"
         by (metis indicator_mult_ennreal mult.commute)
       moreover have "emeasure M (X -` {t..t+dt} \<inter> space M) = set_nn_integral lborel {t..t+dt} f"
         by (rule distributed_emeasure; simp add: assms)
       moreover have "emeasure M (X -` {t..t+dt} \<inter> space M) < \<infinity>"
         using emeasure_eq_measure ennreal_less_top infinity_ennreal_def by presburger
       ultimately show "(\<integral>\<^sup>+ x. ennreal (indicat_real {t..t+dt} x * f x) \<partial>lborel) < \<infinity>" by simp
     qed
     hence "\<And>dt. LBINT s:{t..t+dt}. f s = integral {t..t+dt} f"
       apply (intro set_borel_integral_eq_integral)
       unfolding set_integrable_def
-      apply (rule integrableI_real_bounded; simp)
+      apply (rule integrableI_nonneg; simp)
       by (rule AE_I2, simp add: assms)
     moreover have "((\<lambda>dt. (integral {t..t+dt} f) / dt) \<longlongrightarrow> f t) (at_right 0)"
     proof -
       have "((\<lambda>x. integral {t..x} f) has_real_derivative f t) (at t within {t..u})"
         by (rule integral_has_real_derivative; simp add: assms)
       moreover have "(at t within {t..u}) = (at (t+0) within (+)t ` {0..u-t})" by simp
       ultimately have
         "((\<lambda>x. integral {t..x} f) \<circ> (+)t has_real_derivative f t) (at 0 within {0..u-t})"
         by (metis DERIV_at_within_shift_lemma)
       hence "((\<lambda>dt. (integral {t..t+dt} f) / dt) \<longlongrightarrow> f t) (at 0 within {0..u-t})"
         using has_field_derivative_iff by force
       thus ?thesis using at_within_Icc_at_right assms by smt
     qed
     ultimately show ?thesis by simp
   qed
   moreover have "\<And>dt. dt > 0 \<Longrightarrow> \<P>(x in M. X x \<in> {t <.. t+dt}) = LBINT s:{t..t+dt}. f s"
   proof -
     fix dt :: real assume "dt > 0"
     hence [simp]: "sym_diff {t<..t + dt} {t..t + dt} = {t}" by force
     have "prob (X -` {t<..t+dt} \<inter> space M) = \<integral>s. indicator {t<..t+dt} s * f s \<partial>lborel"
       by (rule distributed_measure; simp add: assms)
     hence "\<P>(x in M. X x \<in> {t <.. t+dt}) = LBINT s:{t<..t+dt}. f s"
       unfolding set_lebesgue_integral_def vimage_def Int_def by simp (smt (verit) Collect_cong)
     moreover have "LBINT s:{t<..t+dt}. f s = LBINT s:{t..t+dt}. f s"
       by (rule set_integral_null_delta; force)
     ultimately show "\<P>(x in M. X x \<in> {t <.. t+dt}) = LBINT s:{t..t+dt}. f s" by simp
   qed
   ultimately have "((\<lambda>dt. \<P>(x in M. t < X x \<and> X x \<le> t + dt) / dt) \<longlongrightarrow> f t) (at_right 0)"
     by simp (smt (verit) Lim_cong_within greaterThan_iff)
   hence "((\<lambda>dt. \<P>(x in M. t < X x \<and> X x \<le> t + dt \<bar> X x > t) / dt) \<longlongrightarrow>
     f t / ccdf (distr M borel X) t) (at_right 0)"
     unfolding cond_prob_def
     apply (rewrite ccdf_distr_P[THEN sym]; simp)
     apply (rewrite mult.commute, rewrite divide_divide_eq_left[THEN sym])
     by (rule tendsto_intros; (simp add: False)?) (smt (verit) Collect_cong Lim_cong_within)
   thus ?thesis unfolding hazard_rate_def by (intro tendsto_Lim; simp)
 qed
 
 end
 
 end
diff --git a/thys/Actuarial_Mathematics/Survival_Model.thy b/thys/Actuarial_Mathematics/Survival_Model.thy
--- a/thys/Actuarial_Mathematics/Survival_Model.thy
+++ b/thys/Actuarial_Mathematics/Survival_Model.thy
@@ -1,2732 +1,2732 @@
 theory Survival_Model
   imports "HOL-Library.Rewrite" "HOL-Library.Extended_Nonnegative_Real" "HOL-Library.Extended_Real"
     "HOL-Probability.Probability" Preliminaries
 begin
 
 section \<open>Survival Model\<close>
 
 text \<open>
   The survival model is built on the probability space @{text "\<MM>"}.
   Additionally, the random variable @{text "X : space \<MM> \<rightarrow> \<real>"} is introduced,
   which represents the age at death.
 \<close>
 
 locale prob_space_actuary = MM_PS: prob_space \<MM> for \<MM> 
   \<comment> \<open>Since the letter M may be used as a commutation function,
       adopt the letter @{text "\<MM>"} instead as a notation for the measure space.\<close>
 
 locale survival_model = prob_space_actuary +
   fixes X :: "'a \<Rightarrow> real"
   assumes X_RV[simp]: "MM_PS.random_variable (borel :: real measure) X"
     and X_pos_AE[simp]: "AE \<xi> in \<MM>. X \<xi> > 0"
 begin
 
 subsection \<open>General Theory of Survival Model\<close>
 
 interpretation distrX_RD: real_distribution "distr \<MM> borel X"
   using MM_PS.real_distribution_distr by simp
 
 lemma X_le_event[simp]: "{\<xi> \<in> space \<MM>. X \<xi> \<le> x} \<in> MM_PS.events"
   by measurable simp
 
 lemma X_gt_event[simp]: "{\<xi> \<in> space \<MM>. X \<xi> > x} \<in> MM_PS.events"
   by measurable simp
 
 lemma X_compl_le_gt: "space \<MM> - {\<xi> \<in> space \<MM>. X \<xi> \<le> x} = {\<xi> \<in> space \<MM>. X \<xi> > x}" for x::real
 proof -
   have "space \<MM> - {\<xi> \<in> space \<MM>. X \<xi> \<le> x} = space \<MM> - (X -` {..x})" by blast
   also have "\<dots> = (X -` {x<..}) \<inter> space \<MM>" using vimage_compl_atMost by fastforce
   also have "\<dots> = {\<xi> \<in> space \<MM>. X \<xi> > x}" by blast
   finally show ?thesis .
 qed
 
 lemma X_compl_gt_le: "space \<MM> - {\<xi> \<in> space \<MM>. X \<xi> > x} = {\<xi> \<in> space \<MM>. X \<xi> \<le> x}" for x::real
   using X_compl_le_gt by blast
 
 subsubsection \<open>Introduction of Survival Function for X\<close>
 
 text \<open>Note that @{text "ccdf (distr \<MM> borel X)"} is the survival (distributive) function for X.\<close>
 
 lemma ccdfX_0_1: "ccdf (distr \<MM> borel X) 0 = 1"
   apply (rewrite MM_PS.ccdf_distr_P, simp)
   using X_pos_AE MM_PS.prob_space
   using MM_PS.prob_Collect_eq_1 X_gt_event by presburger
 
 lemma ccdfX_unborn_1: "ccdf (distr \<MM> borel X) x = 1" if "x \<le> 0"
 proof (rule antisym)
   show "ccdf (distr \<MM> borel X) x \<le> 1" using MM_PS.ccdf_distr_P by simp
   show "ccdf (distr \<MM> borel X) x \<ge> 1"
   proof -
     have "ccdf (distr \<MM> borel X) x \<ge> ccdf (distr \<MM> borel X) 0"
       using finite_borel_measure.ccdf_nonincreasing distrX_RD.finite_borel_measure_M that by simp
     also have "ccdf (distr \<MM> borel X) 0 = 1" using ccdfX_0_1 that by simp
     finally show ?thesis .
   qed
 qed
 
 definition death_pt :: ereal ("$\<psi>")
   where "$\<psi> \<equiv> Inf (ereal ` {x \<in> \<real>. ccdf (distr \<MM> borel X) x = 0})"
     \<comment> \<open>This is my original notation,
         which is used to develop life insurance mathematics rigorously.\<close>
 
 lemma psi_nonneg: "$\<psi> \<ge> 0"
   unfolding death_pt_def
 proof (rule Inf_greatest)
   fix x'::ereal
   assume "x' \<in> ereal ` {x \<in> \<real>. ccdf (distr \<MM> borel X) x = 0}"
   then obtain x::real where "x' = ereal x" and "ccdf (distr \<MM> borel X) x = 0" by blast
   hence "ccdf (distr \<MM> borel X) 0 > ccdf (distr \<MM> borel X) x" using ccdfX_0_1 X_pos_AE by simp
   hence "x \<ge> 0"
     using mono_invE finite_borel_measure.ccdf_nonincreasing distrX_RD.finite_borel_measure_M X_RV
     by (smt(verit))
   thus "x' \<ge> 0" using \<open>x' = ereal x\<close> by simp
 qed
 
 lemma ccdfX_beyond_0: "ccdf (distr \<MM> borel X) x = 0" if "x > $\<psi>" for x::real
 proof -
   have "ereal ` {y \<in> \<real>. ccdf (distr \<MM> borel X) y = 0} \<noteq> {}" using death_pt_def that by force
   hence "\<exists>y'\<in>(ereal ` {y \<in> \<real>. ccdf (distr \<MM> borel X) y = 0}). y' < ereal x"
     using that unfolding death_pt_def by (rule cInf_lessD)
   then obtain "y'"
     where "y' \<in> (ereal ` {y \<in> \<real>. ccdf (distr \<MM> borel X) y = 0})" and "y' < ereal x" by blast
   then obtain y::real
     where "y' = ereal y" and "ccdf (distr \<MM> borel X) y = 0" and "ereal y < ereal x" by blast
   hence "ccdf (distr \<MM> borel X) y = 0" and "y < x" by simp_all
   hence "ccdf (distr \<MM> borel X) x \<le> 0"
     using finite_borel_measure.ccdf_nonincreasing distrX_RD.finite_borel_measure_M X_RV
     by (metis order_less_le)
   thus ?thesis using finite_borel_measure.ccdf_nonneg distrX_RD.finite_borel_measure_M X_RV by smt
 qed
 
 lemma ccdfX_psi_0: "ccdf (distr \<MM> borel X) (real_of_ereal $\<psi>) = 0" if "$\<psi> < \<infinity>"
 proof -
   have "\<bar>$\<psi>\<bar> \<noteq> \<infinity>" using that psi_nonneg by simp
   then obtain u::real where "$\<psi> = ereal u" using ereal_real' by blast
   hence "real_of_ereal $\<psi> = u" by simp
   moreover have "ccdf (distr \<MM> borel X) u = 0"
   proof -
     have "\<And>x::real. x \<noteq> u \<Longrightarrow> x \<in> {u<..} \<Longrightarrow> ccdf (distr \<MM> borel X) x = 0"
       by (rule ccdfX_beyond_0, simp add: \<open>$\<psi> = ereal u\<close>)
     hence "(ccdf (distr \<MM> borel X) \<longlongrightarrow> 0) (at_right u)"
       apply -
       by (rule iffD2[OF Lim_cong_within[where ?g="(\<lambda>x.0)"]], simp_all+)
     moreover have "(ccdf (distr \<MM> borel X) \<longlongrightarrow> ccdf (distr \<MM> borel X) u) (at_right u)"
       using finite_borel_measure.ccdf_is_right_cont distrX_RD.finite_borel_measure_M
         continuous_within X_RV by blast
     ultimately show ?thesis using tendsto_unique trivial_limit_at_right_real by blast
   qed
   ultimately show ?thesis by simp
 qed
 
 lemma ccdfX_0_equiv: "ccdf (distr \<MM> borel X) x = 0 \<longleftrightarrow> x \<ge> $\<psi>" for x::real
 proof
   assume "ccdf (distr \<MM> borel X) x = 0"
   thus "ereal x \<ge> $\<psi>" unfolding death_pt_def by (simp add: INF_lower)
 next
   assume "$\<psi> \<le> ereal x"
   hence "$\<psi> = ereal x \<or> $\<psi> < ereal x" unfolding less_eq_ereal_def by auto
   thus "ccdf (distr \<MM> borel X) x = 0"
   proof
     assume \<star>: "$\<psi> = ereal x"
     hence "$\<psi> < \<infinity>" by simp
     moreover have "real_of_ereal $\<psi> = x" using \<star> by simp
     ultimately show "ccdf (distr \<MM> borel X) x = 0" using ccdfX_psi_0 by simp
   next
     assume "$\<psi> < ereal x"
     thus "ccdf (distr \<MM> borel X) x = 0" by (rule ccdfX_beyond_0)
   qed
 qed
 
 lemma psi_pos[simp]: "$\<psi> > 0"
 proof (rule not_le_imp_less, rule notI)
   show "$\<psi> \<le> (0::ereal) \<Longrightarrow> False"
   proof -
     assume "$\<psi> \<le> (0::ereal)"
     hence "ccdf (distr \<MM> borel X) 0 = 0" using ccdfX_0_equiv by (simp add: zero_ereal_def)
     moreover have "ccdf (distr \<MM> borel X) 0 = 1" using ccdfX_0_1 by simp
     ultimately show "False" by simp
   qed
 qed
 
 corollary psi_pos'[simp]: "$\<psi> > ereal 0"
   using psi_pos zero_ereal_def by presburger
 
 subsubsection \<open>Introdution of Future-Lifetime Random Variable T(x)\<close>
 
 definition alive :: "real \<Rightarrow> 'a set"
   where "alive x \<equiv> {\<xi> \<in> space \<MM>. X \<xi> > x}"
 
 lemma alive_event[simp]: "alive x \<in> MM_PS.events" for x::real
   unfolding alive_def by simp
 
 lemma X_alivex_measurable[measurable, simp]: "X \<in> borel_measurable (\<MM> \<downharpoonright> alive x)" for x::real
   unfolding cond_prob_space_def by (measurable; simp add: measurable_restrict_space1)
 
 definition futr_life :: "real \<Rightarrow> ('a \<Rightarrow> real)" ("T")
   where "T x \<equiv> (\<lambda>\<xi>. X \<xi> - x)"
     \<comment> \<open>Note that @{text "T(x) : space \<MM> \<rightarrow> \<real>"} represents the time until death of a person aged x.\<close>
 
 lemma T0_eq_X[simp]: "T 0 = X"
   unfolding futr_life_def by simp
 
 lemma Tx_measurable[measurable, simp]: "T x \<in> borel_measurable \<MM>" for x::real
   unfolding futr_life_def by (simp add: borel_measurable_diff)
 
 lemma Tx_alivex_measurable[measurable, simp]: "T x \<in> borel_measurable (\<MM> \<downharpoonright> alive x)" for x::real
   unfolding futr_life_def by (simp add: borel_measurable_diff)
 
 lemma alive_T: "alive x = {\<xi> \<in> space \<MM>. T x \<xi> > 0}" for x::real
   unfolding alive_def futr_life_def by force
 
 lemma alivex_Tx_pos[simp]: "0 < T x \<xi>" if "\<xi> \<in> space (\<MM> \<downharpoonright> alive x)" for x::real
   using MM_PS.space_cond_prob_space alive_T that by simp
 
 lemma PT0_eq_PX_lborel: "\<P>(\<xi> in \<MM>. T 0 \<xi> \<in> A \<bar> T 0 \<xi> > 0) = \<P>(\<xi> in \<MM>. X \<xi> \<in> A)"
   if "A \<in> sets lborel" for A :: "real set"
   apply (rewrite MM_PS.cond_prob_AE_prob, simp_all)
   using that X_RV measurable_lborel1 predE pred_sets2 by blast
 
 subsubsection \<open>Actuarial Notations on the Survival Model\<close>
 
 definition survive :: "real \<Rightarrow> real \<Rightarrow> real" ("$p'_{_&_}" [0,0] 200)
   where "$p_{t&x} \<equiv> ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t"
     \<comment> \<open>the probability that a person aged x will survive for t years\<close>
     \<comment> \<open>Note that the function @{text "$p_{\<cdot>&x}"} is the survival function
         on @{text "(\<MM> \<downharpoonright> alive x)"} for the random variable T(x).\<close>
     \<comment> \<open>The parameter t is usually nonnegative, but theoretically it can be negative.\<close>
 abbreviation survive_1 :: "real \<Rightarrow> real" ("$p'__" [101] 200)
   where "$p_x \<equiv> $p_{1&x}"
 definition die :: "real \<Rightarrow> real \<Rightarrow> real" ("$q'_{_&_}" [0,0] 200)
   where "$q_{t&x} \<equiv> cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t"
     \<comment> \<open>the probability that a person aged x will die within t years\<close>
     \<comment> \<open>Note that the function @{text "$q_{\<cdot>&x}"} is the cumulative distributive function
         on @{text "(\<MM> \<downharpoonright> alive x)"} for the random variable T(x).\<close>
     \<comment> \<open>The parameter t is usually nonnegative, but theoretically it can be negative.\<close>
 abbreviation die_1 :: "real \<Rightarrow> real" ("$q'__" [101] 200)
   where "$q_x \<equiv> $q_{1&x}"
 definition die_defer :: "real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real" ("$q'_{_\<bar>_&_}" [0,0,0] 200)
   where "$q_{f\<bar>t&x} = \<bar>$q_{f+t&x} - $q_{f&x}\<bar>"
     \<comment> \<open>the probability that a person aged x will die within t years, deferred f years\<close>
     \<comment> \<open>The parameters f and t are usually nonnegative, but theoretically they can be negative.\<close>
 abbreviation die_defer_1 :: "real \<Rightarrow> real \<Rightarrow> real" ("$q'_{_\<bar>&_}" [0,0] 200)
   where "$q_{f\<bar>&x} \<equiv> $q_{f\<bar>1&x}"
 definition life_expect :: "real \<Rightarrow> real" ("$e`\<circ>'__" [101] 200)
   where "$e`\<circ>_x \<equiv> integral\<^sup>L (\<MM> \<downharpoonright> alive x) (T x)"
     \<comment> \<open>complete life expectation\<close>
     \<comment> \<open>Note that @{text "$e`\<circ>_x"} is calculated as 0
         when @{text "nn_integral (\<MM> \<downharpoonright> alve x) (T x) = \<infinity>"}.\<close>
 definition temp_life_expect :: "real \<Rightarrow> real \<Rightarrow>real" ("$e`\<circ>'_{_:_}" [0,0] 200)
   where "$e`\<circ>_{x:n} \<equiv> integral\<^sup>L (\<MM> \<downharpoonright> alive x) (\<lambda>\<xi>. min (T x \<xi>) n)"
     \<comment> \<open>temporary complete life expectation\<close>
 definition curt_life_expect :: "real \<Rightarrow> real" ("$e'__" [101] 200)
   where "$e_x \<equiv> integral\<^sup>L (\<MM> \<downharpoonright> alive x) (\<lambda>\<xi>. \<lfloor>T x \<xi>\<rfloor>)"
     \<comment> \<open>curtate life expectation\<close>
     \<comment> \<open>Note that @{text "$e_x"} is calculated as 0 when
         @{text "nn_integral (\<MM> \<downharpoonright> alive x) \<lfloor>T x\<rfloor> = \<infinity>"}.\<close>
 definition temp_curt_life_expect :: "real \<Rightarrow> real \<Rightarrow> real" ("$e'_{_:_}" [0,0] 200)
   where "$e_{x:n} \<equiv> integral\<^sup>L (\<MM> \<downharpoonright> alive x) (\<lambda>\<xi>. \<lfloor>min (T x \<xi>) n\<rfloor>)"
     \<comment> \<open>temporary curtate life expectation\<close>
     \<comment> \<open>In the definition n can be a real number, but in practice n is usually a natural number.\<close>
 
 subsubsection \<open>Properties of Survival Function for T(x)\<close>
 
 context
   fixes x::real
   assumes x_lt_psi[simp]: "x < $\<psi>"
 begin
 
 lemma PXx_pos[simp]: "\<P>(\<xi> in \<MM>. X \<xi> > x) > 0"
 proof -
   have "\<P>(\<xi> in \<MM>. X \<xi> > x) = ccdf (distr \<MM> borel X) x"
     unfolding alive_def using MM_PS.ccdf_distr_P by simp
   also have "\<dots> > 0"
     using ccdfX_0_equiv distrX_RD.ccdf_nonneg x_lt_psi by (smt (verit) linorder_not_le)
   finally show ?thesis .
 qed
 
 lemma PTx_pos[simp]: "\<P>(\<xi> in \<MM>. T x \<xi> > 0) > 0"
   apply (rewrite alive_T[THEN sym])
   unfolding alive_def by simp
 
 interpretation alivex_PS: prob_space "\<MM> \<downharpoonright> alive x"
   by (rule MM_PS.cond_prob_space_correct, simp_all add: alive_def)
 
 interpretation distrTx_RD: real_distribution "distr (\<MM> \<downharpoonright> alive x) borel (T x)" by simp
 
 lemma ccdfTx_cond_prob:
   "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t = \<P>(\<xi> in \<MM>. T x \<xi> > t \<bar> T x \<xi> > 0)" for t::real
   apply (rewrite alivex_PS.ccdf_distr_P, simp)
   unfolding alive_def
   apply (rewrite MM_PS.cond_prob_space_cond_prob[THEN sym], simp_all add: pred_def)
   unfolding futr_life_def by simp
 
 lemma ccdfTx_0_1: "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) 0 = 1"
   apply (rewrite ccdfTx_cond_prob)
   unfolding futr_life_def cond_prob_def
   by (smt (verit, best) Collect_cong PXx_pos divide_eq_1_iff)
 
 lemma ccdfTx_nonpos_1: "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t = 1" if "t \<le> 0" for t :: real
   using antisym ccdfTx_0_1 that
   by (metis distrTx_RD.ccdf_bounded_prob distrTx_RD.ccdf_nonincreasing)
 
 lemma ccdfTx_0_equiv: "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t = 0 \<longleftrightarrow> x+t \<ge> $\<psi>" for t::real
 proof -
   have "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t =
     \<P>(\<xi> in \<MM>. X \<xi> > x+t \<and> X \<xi> > x) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
     apply (rewrite ccdfTx_cond_prob)
     unfolding cond_prob_def futr_life_def by (smt (verit) Collect_cong)
   hence "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t = 0 \<longleftrightarrow>
     \<P>(\<xi> in \<MM>. X \<xi> > x+t \<and> X \<xi> > x) / \<P>(\<xi> in \<MM>. X \<xi> > x) = 0"
     by simp
   also have "\<dots> \<longleftrightarrow> \<P>(\<xi> in \<MM>. X \<xi> > x+t \<and> X \<xi> > x) = 0"
     using x_lt_psi PXx_pos by (smt (verit) divide_eq_0_iff)
   also have "\<dots> \<longleftrightarrow> x+t \<ge> $\<psi>"
     using ccdfX_0_equiv MM_PS.ccdf_distr_P
     by (smt (verit) Collect_cong X_RV le_ereal_le linorder_not_le x_lt_psi)
   finally show ?thesis .
 qed
 
 lemma ccdfTx_continuous_on_nonpos[simp]:
   "continuous_on {..0} (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
   by (metis atMost_iff ccdfTx_nonpos_1 continuous_on_cong continuous_on_const)
 
 lemma ccdfTx_differentiable_on_nonpos[simp]:
   "(ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) differentiable_on {..0}"
   by (rewrite differentiable_on_cong[where f="\<lambda>_. 1"]; simp add: ccdfTx_nonpos_1)
 
 lemma ccdfTx_has_real_derivative_0_at_neg:
   "(ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) has_real_derivative 0) (at t)" if "t < 0" for t::real
   apply (rewrite has_real_derivative_iff_has_vector_derivative)
   apply (rule has_vector_derivative_transform_within_open[of "\<lambda>_. 1" _ _ "{..<0}"])
   using ccdfTx_nonpos_1 that by simp_all
 
 lemma ccdfTx_integrable_Icc:
   "set_integrable lborel {a..b} (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))" for a b :: real
 proof -
   have "(\<integral>\<^sup>+t. ennreal (indicat_real {a..b} t * ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t) \<partial>lborel)
     < \<top>"
   proof -
     have "(\<integral>\<^sup>+t. ennreal (indicat_real {a..b} t * ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t) \<partial>lborel)
       \<le> (\<integral>\<^sup>+t. ennreal (indicat_real {a..b} t) \<partial>lborel)"
       apply (rule nn_integral_mono)
       using distrTx_RD.ccdf_bounded
       by (simp add: distrTx_RD.ccdf_bounded_prob indicator_times_eq_if(1))
     also have "\<dots> = nn_integral lborel (indicator {a..b})" by (meson ennreal_indicator)
     also have "\<dots> = emeasure lborel {a..b}" by (rewrite nn_integral_indicator; simp)
     also have "\<dots> < \<top>"
       using emeasure_lborel_Icc_eq ennreal_less_top infinity_ennreal_def by presburger
     finally show ?thesis .
   qed
   thus ?thesis
     unfolding set_integrable_def
     apply (intro integrableI_nonneg, simp_all)
     using distrTx_RD.ccdf_nonneg by (intro always_eventually) auto
 qed
 
 corollary ccdfTx_integrable_on_Icc:
   "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) integrable_on {a..b}" for a b :: real
   using set_borel_integral_eq_integral ccdfTx_integrable_Icc by force
 
 lemma ccdfTx_PX:
   "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t = \<P>(\<xi> in \<MM>. X \<xi> > x+t) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
   if "t \<ge> 0" for t::real
   apply (rewrite ccdfTx_cond_prob)
   unfolding cond_prob_def futr_life_def PXx_pos by (smt (verit) Collect_cong that)
 
 lemma ccdfTx_ccdfX: "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t =
   ccdf (distr \<MM> borel X) (x + t) / ccdf (distr \<MM> borel X) x"
   if "t \<ge> 0" for t::real
   using ccdfTx_PX that MM_PS.ccdf_distr_P X_RV by presburger
 
 lemma ccdfT0_eq_ccdfX: "ccdf (distr (\<MM> \<downharpoonright> alive 0) borel (T 0)) = ccdf (distr \<MM> borel X)"
 proof
   fix x
   show "ccdf (distr (\<MM> \<downharpoonright> alive 0) borel (T 0)) x = ccdf (distr \<MM> borel X) x"
   proof (cases \<open>x \<ge> 0\<close>)
     case True
     thus ?thesis
       using survival_model.ccdfTx_ccdfX[where x=0] ccdfX_0_1 survival_model_axioms by fastforce
   next
     case False
     hence "x \<le> 0" by simp
     thus ?thesis
       apply (rewrite ccdfX_unborn_1, simp)
       by (rewrite survival_model.ccdfTx_nonpos_1; simp add: survival_model_axioms)
   qed
 qed
 
 lemma continuous_ccdfX_ccdfTx:
   "continuous (at (x+t) within {x..}) (ccdf (distr \<MM> borel X)) \<longleftrightarrow> 
     continuous (at t within {0..}) (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
   if "t \<ge> 0" for t::real
 proof -
   let ?srvl = "ccdf (distr \<MM> borel X)"
   have [simp]: "\<P>(\<xi> in \<MM>. X \<xi> > x) \<noteq> 0" using PXx_pos by force
   have \<star>: "\<And>u. u \<ge> 0 \<Longrightarrow> ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) u =
     ?srvl (x + u) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
     using survive_def MM_PS.ccdf_distr_P ccdfTx_PX that by simp
   have "continuous (at t within {0..}) (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) \<longleftrightarrow>
     continuous (at t within {0..}) (\<lambda>u. ?srvl (x+u) / \<P>(\<xi> in \<MM>. x < X \<xi>))"
   proof -
     have "\<forall>\<^sub>F u in at t within {0..}. ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) u =
     ?srvl (x+u) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
       using \<star> by (rewrite eventually_at_topological, simp_all) blast
     thus ?thesis
       by (intro continuous_at_within_cong, simp_all add: \<star> that)
   qed
   also have "\<dots> \<longleftrightarrow> continuous (at t within {0..}) (\<lambda>u. ?srvl (x+u))"
     by (rewrite at "_ = \<hole>" continuous_cdivide_iff[of "\<P>(\<xi> in \<MM>. X \<xi> > x)"], simp_all)
   also have "\<dots> \<longleftrightarrow> continuous (at (x+t) within {x..}) ?srvl"
   proof
     let ?subx = "\<lambda>v. v-x"
     assume LHS: "continuous (at t within {0..}) (\<lambda>u. ?srvl (x+u))"
     hence "continuous (at (?subx (x+t)) within ?subx ` {x..}) (\<lambda>u. ?srvl (x+u))"
     proof -
       have "?subx ` {x..} = {0..}"
         by (metis (no_types, lifting) add.commute add_uminus_conv_diff diff_self
             image_add_atLeast image_cong)
       thus ?thesis using LHS by simp
     qed
     moreover have "continuous (at (x+t) within {x..}) ?subx" by (simp add: continuous_diff)
     ultimately have "continuous (at (x+t) within {x..}) (\<lambda>u. ?srvl (x + (?subx u)))"
       using continuous_within_compose2 by force
     thus "continuous (at (x+t) within {x..}) ?srvl" by simp
   next
     assume RHS: "continuous (at (x+t) within {x..}) ?srvl"
     hence "continuous (at ((plus x) t) within (plus x) ` {0..}) ?srvl" by simp
     moreover have "continuous (at t within {0..}) (plus x)" by (simp add: continuous_add)
     ultimately show "continuous (at t within {0..}) (\<lambda>u. ?srvl (x+u))"
       using continuous_within_compose2 by force
   qed
   finally show ?thesis by simp
 qed
 
 lemma isCont_ccdfX_ccdfTx:
   "isCont (ccdf (distr \<MM> borel X)) (x+t) \<longleftrightarrow>
     isCont (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) t"
   if "t > 0" for t::real
 proof -
   have "isCont (ccdf (distr \<MM> borel X)) (x+t) \<longleftrightarrow>
     continuous (at (x+t) within {x<..}) (ccdf (distr \<MM> borel X))"
     by (smt (verit) at_within_open greaterThan_iff open_greaterThan that)
   also have "\<dots> \<longleftrightarrow> continuous (at (x+t) within {x..}) (ccdf (distr \<MM> borel X))"
     by (meson Ioi_le_Ico calculation continuous_within_subset top_greatest)
   also have "\<dots> \<longleftrightarrow> continuous (at t within {0..}) (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
     using that continuous_ccdfX_ccdfTx by force
   also have "\<dots> \<longleftrightarrow> continuous (at t within {0<..}) (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
     by (metis Ioi_le_Ico at_within_open continuous_at_imp_continuous_at_within
         continuous_within_subset greaterThan_iff open_greaterThan that)
   also have "\<dots> \<longleftrightarrow> isCont (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) t"
     by (metis at_within_open greaterThan_iff open_greaterThan that)
   finally show ?thesis .
 qed
 
 lemma has_real_derivative_ccdfX_ccdfTx:
   "((ccdf (distr \<MM> borel X)) has_real_derivative D) (at (x+t)) \<longleftrightarrow>
   ((ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) has_real_derivative (D / \<P>(\<xi> in \<MM>. X \<xi> > x))) (at t)"
   if "t > 0" for t D :: real
 proof -
   have "((ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) has_real_derivative
     (D / \<P>(\<xi> in \<MM>. X \<xi> > x))) (at t) \<longleftrightarrow>
     ((\<lambda>t. (ccdf (distr \<MM> borel X)) (x+t) / \<P>(\<xi> in \<MM>. X \<xi> > x)) has_real_derivative
     (D / \<P>(\<xi> in \<MM>. X \<xi> > x))) (at t)"
   proof -
     let ?d = "t/2"
     { fix u::real assume "dist u t < ?d"
       hence "u > 0" by (smt (verit) dist_real_def dist_triangle_half_r)
       hence "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) u =
         ccdf (distr \<MM> borel X) (x + u) / MM_PS.prob {\<xi>::'a \<in> space \<MM>. x < X \<xi>}"
         using survive_def MM_PS.ccdf_distr_P ccdfTx_PX that by simp }
     moreover have "?d > 0" using that by simp
     ultimately show ?thesis
       apply -
       apply (rule DERIV_cong_ev, simp)
        apply (rewrite eventually_nhds_metric, blast)
       by simp
   qed
   also have "\<dots> \<longleftrightarrow> ((\<lambda>t. (ccdf (distr \<MM> borel X)) (x+t)) has_real_derivative D) (at t)"
     using PXx_pos by (rewrite DERIV_cdivide_iff[of "\<P>(\<xi> in \<MM>. X \<xi> > x)", THEN sym]; force)
   also have "\<dots> \<longleftrightarrow> (ccdf (distr \<MM> borel X) has_real_derivative D) (at (x+t))"
     by (simp add: DERIV_shift add.commute)
   finally show ?thesis by simp
 qed
 
 lemma differentiable_ccdfX_ccdfTx:
   "(ccdf (distr \<MM> borel X)) differentiable at (x+t) \<longleftrightarrow>
   (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) differentiable at t"
   if "t > 0" for t::real
   apply (rewrite differentiable_eq_field_differentiable_real)+
   unfolding field_differentiable_def using has_real_derivative_ccdfX_ccdfTx that
   by (smt (verit, del_insts) PXx_pos nonzero_mult_div_cancel_left)
 
 subsubsection \<open>Properties of @{text "$p_{t&x}"}\<close>
 
 lemma p_0_1: "$p_{0&x} = 1"
   unfolding survive_def using ccdfTx_0_1 by simp
 
 lemma p_nonneg[simp]: "$p_{t&x} \<ge> 0" for t::real
   unfolding survive_def using distrTx_RD.ccdf_nonneg by simp
 
 lemma p_0_equiv: "$p_{t&x} = 0 \<longleftrightarrow> x+t \<ge> $\<psi>" for t::real
   unfolding survive_def by (rule ccdfTx_0_equiv)
 
 lemma p_PTx: "$p_{t&x} = \<P>(\<xi> in \<MM>. T x \<xi> > t \<bar> T x \<xi> > 0)" for t::real
   unfolding survive_def using ccdfTx_cond_prob by simp
 
 lemma p_PX: "$p_{t&x} = \<P>(\<xi> in \<MM>. X \<xi> > x + t) / \<P>(\<xi> in \<MM>. X \<xi> > x)" if "t \<ge> 0" for t::real
   unfolding survive_def using ccdfTx_PX that by simp
 
 lemma p_mult: "$p_{t+t' & x} = $p_{t&x} * $p_{t' & x+t}"
   if "t \<ge> 0" "t' \<ge> 0" "x+t < $\<psi>" for t t' :: real
 proof -
   have "$p_{t+t' & x} = \<P>(\<xi> in \<MM>. X \<xi> > x+t+t') / \<P>(\<xi> in \<MM>. X \<xi> > x)"
     apply (rewrite p_PX; (simp add: that)?)
     by (rule disjI2, smt (verit, best) Collect_cong)
   also have "\<dots> = (\<P>(\<xi> in \<MM>. X \<xi> > x+t+t') / \<P>(\<xi> in \<MM>. X \<xi> > x+t)) *
     (\<P>(\<xi> in \<MM>. X \<xi> > x+t) / \<P>(\<xi> in \<MM>. X \<xi> > x))"
     using that survival_model.PXx_pos survival_model_axioms by fastforce
   also have "\<dots> = $p_{t&x} * $p_{t' & x+t}"
     apply (rewrite p_PX, simp add: that)
     by (rewrite survival_model.p_PX, simp_all add: that survival_model_axioms)
   finally show ?thesis .
 qed
 
 lemma p_PTx_ge_ccdf_isCont: "$p_{t&x} = \<P>(\<xi> in \<MM>. T x \<xi> \<ge> t \<bar> T x \<xi> > 0)"
   if "isCont (ccdf (distr \<MM> borel X)) (x+t)" "t > 0" for t::real
   unfolding survive_def using that isCont_ccdfX_ccdfTx
   apply (rewrite alivex_PS.ccdf_continuous_distr_P_ge, simp_all)
   by (rewrite MM_PS.cond_prob_space_cond_prob, simp_all add: alive_T)
 
 end
 
 subsubsection \<open>Properties of Survival Function for X\<close>
 
 lemma ccdfX_continuous_unborn[simp]: "continuous_on {..0} (ccdf (distr \<MM> borel X))"
   using ccdfTx_continuous_on_nonpos by (metis ccdfT0_eq_ccdfX psi_pos')
 
 lemma ccdfX_differentiable_unborn[simp]: "(ccdf (distr \<MM> borel X)) differentiable_on {..0}"
   using ccdfTx_differentiable_on_nonpos by (metis ccdfT0_eq_ccdfX psi_pos')
 
 lemma ccdfX_has_real_derivative_0_unborn:
   "(ccdf (distr \<MM> borel X) has_real_derivative 0) (at x)" if "x < 0" for x::real
   using ccdfTx_has_real_derivative_0_at_neg by (metis ccdfT0_eq_ccdfX psi_pos' that)
 
 lemma ccdfX_integrable_Icc:
   "set_integrable lborel {a..b} (ccdf (distr \<MM> borel X))" for a b :: real
   using ccdfTx_integrable_Icc by (metis ccdfT0_eq_ccdfX psi_pos')
 
 corollary ccdfX_integrable_on_Icc:
   "ccdf (distr \<MM> borel X) integrable_on {a..b}" for a b :: real
   using set_borel_integral_eq_integral ccdfX_integrable_Icc by force
 
 lemma ccdfX_p: "ccdf (distr \<MM> borel X) x = $p_{x&0}" for x::real
   by (metis ccdfT0_eq_ccdfX survive_def psi_pos')
 
 subsubsection \<open>Introduction of Cumulative Distributive Function for X\<close>
 
 lemma cdfX_0_0: "cdf (distr \<MM> borel X) 0 = 0"
   using ccdfX_0_1 distrX_RD.ccdf_cdf distrX_RD.prob_space by fastforce
 
 lemma cdfX_unborn_0: "cdf (distr \<MM> borel X) x = 0" if "x \<le> 0"
   using ccdfX_unborn_1 cdfX_0_0 distrX_RD.cdf_ccdf that by fastforce
 
 lemma cdfX_beyond_1: "cdf (distr \<MM> borel X) x = 1" if "x > $\<psi>" for x::real
   using ccdfX_beyond_0 distrX_RD.cdf_ccdf that distrX_RD.prob_space by force
 
 lemma cdfX_psi_1: "cdf (distr \<MM> borel X) (real_of_ereal $\<psi>) = 1" if "$\<psi> < \<infinity>"
   using ccdfX_psi_0 distrX_RD.cdf_ccdf distrX_RD.prob_space that by fastforce
 
 lemma cdfX_1_equiv: "cdf (distr \<MM> borel X) x = 1 \<longleftrightarrow> x \<ge> $\<psi>" for x::real
   using ccdfX_0_equiv distrX_RD.cdf_ccdf distrX_RD.prob_space by force
 
 subsubsection \<open>Properties of Cumulative Distributive Function for T(x)\<close>
 
 context
   fixes x::real
   assumes x_lt_psi[simp]: "x < $\<psi>"
 begin
 
 interpretation alivex_PS: prob_space "\<MM> \<downharpoonright> alive x"
   by (rule MM_PS.cond_prob_space_correct, simp_all add: alive_def)
 
 interpretation distrTx_RD: real_distribution "distr (\<MM> \<downharpoonright> alive x) borel (T x)" by simp
 
 lemma cdfTx_cond_prob:
   "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t = \<P>(\<xi> in \<MM>. T x \<xi> \<le> t \<bar> T x \<xi> > 0)" for t::real
   apply (rewrite distrTx_RD.cdf_ccdf, rewrite distrTx_RD.prob_space)
   apply (rewrite ccdfTx_cond_prob, simp)
   by (rewrite not_less[THEN sym], rewrite MM_PS.cond_prob_neg; simp)
 
 lemma cdfTx_0_0: "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) 0 = 0"
   using ccdfTx_0_1 distrTx_RD.cdf_ccdf distrTx_RD.prob_space by force
 
 lemma cdfTx_nonpos_0: "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t = 0" if "t \<le> 0" for t :: real
   using ccdfTx_nonpos_1 distrTx_RD.cdf_ccdf distrTx_RD.prob_space that by force
 
 lemma cdfTx_1_equiv: "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t = 1 \<longleftrightarrow> x+t \<ge> $\<psi>" for t::real
   using ccdfTx_0_equiv distrTx_RD.cdf_ccdf distrTx_RD.prob_space by force
 
 lemma cdfTx_continuous_on_nonpos[simp]:
   "continuous_on {..0} (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
   by (rewrite continuous_on_cong[where g="\<lambda>t. 0"]) (simp_all add: cdfTx_nonpos_0)+
 
 lemma cdfTx_differentiable_on_nonpos[simp]:
   "(cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) differentiable_on {..0}"
   by (rewrite differentiable_on_cong[where f="\<lambda>t. 0"]; simp add: cdfTx_nonpos_0)
 
 lemma cdfTx_has_real_derivative_0_at_neg:
   "(cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) has_real_derivative 0) (at t)" if "t < 0" for t::real
   apply (rewrite has_real_derivative_iff_has_vector_derivative)
   apply (rule has_vector_derivative_transform_within_open[of "\<lambda>_. 0" _ _ "{..<0}"])
   using cdfTx_nonpos_0 that by simp_all
 
 lemma cdfTx_integrable_Icc:
   "set_integrable lborel {a..b} (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))" for a b :: real
 proof -
   have "set_integrable lborel {a..b} (\<lambda>_. 1::real)"
     unfolding set_integrable_def
     using emeasure_compact_finite by (simp, intro integrable_real_indicator; force)
   thus ?thesis
     apply (rewrite distrTx_RD.cdf_ccdf, rewrite distrTx_RD.prob_space)
     using ccdfTx_integrable_Icc by (rewrite set_integral_diff; simp)
 qed
 
 corollary cdfTx_integrable_on_Icc:
   "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) integrable_on {a..b}" for a b :: real
   using cdfTx_integrable_Icc set_borel_integral_eq_integral by force
 
 lemma cdfTx_PX:
   "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t = \<P>(\<xi> in \<MM>. x < X \<xi> \<and> X \<xi> \<le> x+t) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
   for t::real
   apply (rewrite cdfTx_cond_prob)
   unfolding cond_prob_def futr_life_def PXx_pos by (smt (verit) Collect_cong)
 
 lemma cdfT0_eq_cdfX: "cdf (distr (\<MM> \<downharpoonright> alive 0) borel (T 0)) = cdf (distr \<MM> borel X)"
 proof
   interpret alive0_PS: prob_space "\<MM> \<downharpoonright> alive 0"
     apply (rule MM_PS.cond_prob_space_correct, simp)
     using PXx_pos alive_def psi_pos' by presburger
   interpret distrT0_RD: real_distribution "distr (\<MM> \<downharpoonright> alive 0) borel (T 0)" by simp
   show "\<And>x. cdf (distr (\<MM> \<downharpoonright> alive 0) borel (T 0)) x = cdf (distr \<MM> borel X) x"
     using ccdfT0_eq_ccdfX distrX_RD.ccdf_cdf distrT0_RD.ccdf_cdf
     by (smt (verit, best) distrT0_RD.prob_space distrX_RD.prob_space psi_pos')
 qed
 
 lemma continuous_cdfX_cdfTx:
   "continuous (at (x+t) within {x..}) (cdf (distr \<MM> borel X)) \<longleftrightarrow>
     continuous (at t within {0..}) (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
   if "t \<ge> 0" for t::real
 proof -
   have "continuous (at (x+t) within {x..}) (cdf (distr \<MM> borel X)) \<longleftrightarrow>
     continuous (at (x+t) within {x..}) (ccdf (distr \<MM> borel X))"
     by (rule distrX_RD.continuous_cdf_ccdf)
   also have "\<dots> \<longleftrightarrow> continuous (at t within {0..}) (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
     using continuous_ccdfX_ccdfTx that by simp
   also have "\<dots> \<longleftrightarrow> continuous (at t within {0..}) (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
     using distrTx_RD.continuous_cdf_ccdf by simp
   finally show ?thesis .
 qed
 
 lemma isCont_cdfX_cdfTx:
   "isCont (cdf (distr \<MM> borel X)) (x+t) \<longleftrightarrow>
   isCont (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) t"
   if "t > 0" for t::real
   apply (rewrite distrX_RD.isCont_cdf_ccdf)
   apply (rewrite isCont_ccdfX_ccdfTx, simp_all add: that)
   by (rule distrTx_RD.isCont_cdf_ccdf[THEN sym])
 
 lemma has_real_derivative_cdfX_cdfTx:
   "((cdf (distr \<MM> borel X)) has_real_derivative D) (at (x+t)) \<longleftrightarrow>
   ((cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) has_real_derivative (D / \<P>(\<xi> in \<MM>. X \<xi> > x))) (at t)"
   if "t > 0" for t D :: real
 proof -
   have "((cdf (distr \<MM> borel X)) has_real_derivative D) (at (x+t)) \<longleftrightarrow>
     (ccdf (distr \<MM> borel X) has_real_derivative -D) (at (x+t))"
     using distrX_RD.has_real_derivative_cdf_ccdf by force
   also have "\<dots> \<longleftrightarrow>
     ((ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) has_real_derivative (-D / \<P>(\<xi> in \<MM>. X \<xi> > x))) (at t)"
     using has_real_derivative_ccdfX_ccdfTx that by simp
   also have "\<dots> \<longleftrightarrow>
     ((cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) has_real_derivative (D / \<P>(\<xi> in \<MM>. X \<xi> > x))) (at t)"
     by (simp add: distrTx_RD.has_real_derivative_cdf_ccdf)
   finally show ?thesis .
 qed
 
 lemma differentiable_cdfX_cdfTx:
   "(cdf (distr \<MM> borel X)) differentiable at (x+t) \<longleftrightarrow>
   (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) differentiable at t"
   if "t > 0" for t::real
   apply (rewrite differentiable_eq_field_differentiable_real)+
   unfolding field_differentiable_def using has_real_derivative_cdfX_cdfTx that
   by (meson differentiable_ccdfX_ccdfTx distrTx_RD.finite_borel_measure_axioms
       distrX_RD.finite_borel_measure_axioms finite_borel_measure.differentiable_cdf_ccdf
       real_differentiable_def x_lt_psi)
 
 subsubsection \<open>Properties of @{text "$q_{t&x}"}\<close>
 
 lemma q_0_0: "$q_{0&x} = 0"
   unfolding die_def using cdfTx_0_0 by simp
 
 lemma q_nonneg[simp]: "$q_{t&x} \<ge> 0" for t::real
   unfolding die_def using distrTx_RD.cdf_nonneg by simp
 
 lemma q_1_equiv: "$q_{t&x} = 1 \<longleftrightarrow> x+t \<ge> $\<psi>" for t::real
   unfolding die_def using cdfTx_1_equiv by simp
 
 lemma q_PTx: "$q_{t&x} = \<P>(\<xi> in \<MM>. T x \<xi> \<le> t \<bar> T x \<xi> > 0)" for t::real
   unfolding die_def using cdfTx_cond_prob by simp
 
 lemma q_PX: "$q_{t&x} = \<P>(\<xi> in \<MM>. x < X \<xi> \<and> X \<xi> \<le> x + t) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
   unfolding die_def using cdfTx_PX by simp
 
 lemma q_defer_0_q[simp]: "$q_{0\<bar>t&x} = $q_{t&x}" for t::real
   unfolding die_defer_def using q_0_0 by simp
 
 lemma q_defer_0_0: "$q_{f\<bar>0&x} = 0" for f::real
   unfolding die_defer_def by simp
 
 lemma q_defer_nonneg[simp]: "$q_{f\<bar>t&x} \<ge> 0" for f t :: real
   unfolding die_defer_def by simp
 
 lemma q_defer_q: "$q_{f\<bar>t&x} = $q_{f+t & x} - $q_{f&x}" if "t \<ge> 0" for f t :: real
   unfolding die_defer_def die_def using distrTx_RD.cdf_nondecreasing that by simp
 
 lemma q_defer_PTx: "$q_{f\<bar>t&x} = \<P>(\<xi> in \<MM>. f < T x \<xi> \<and> T x \<xi> \<le> f + t \<bar> T x \<xi> > 0)"
   if "t \<ge> 0" for f t :: real
 proof -
   have "$q_{f\<bar>t&x} = $q_{f+t & x} - $q_{f&x}" using q_defer_q that by simp
   also have "\<dots> = \<P>(\<xi> in \<MM>. T x \<xi> \<le> f + t \<bar> T x \<xi> > 0) - \<P>(\<xi> in \<MM>. T x \<xi> \<le> f \<bar> T x \<xi> > 0)"
     using q_PTx by simp
   also have "\<dots> = \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> \<le> f + t) - \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> \<le> f)"
     using MM_PS.cond_prob_space_cond_prob alive_T by simp
   also have "\<dots> = \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). f < T x \<xi> \<and> T x \<xi> \<le> f + t)"
   proof -
     have "{\<xi> \<in> space (\<MM> \<downharpoonright> alive x). T x \<xi> \<le> f + t} - {\<xi> \<in> space (\<MM> \<downharpoonright> alive x). T x \<xi> \<le> f} =
       {\<xi> \<in> space (\<MM> \<downharpoonright> alive x). f < T x \<xi> \<and> T x \<xi> \<le> f + t}"
       using that by force
     hence "alivex_PS.prob
       ({\<xi> \<in> space (\<MM> \<downharpoonright> alive x). T x \<xi> \<le> f + t} - {\<xi> \<in> space (\<MM> \<downharpoonright> alive x). T x \<xi> \<le> f}) =
       \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). f < T x \<xi> \<and> T x \<xi> \<le> f + t)"
       by simp
     moreover have "{\<xi> \<in> space (\<MM> \<downharpoonright> alive x). T x \<xi> \<le> f} \<subseteq> {\<xi> \<in> space (\<MM> \<downharpoonright> alive x). T x \<xi> \<le> f + t}"
       using that by force
     ultimately show ?thesis by (rewrite alivex_PS.finite_measure_Diff[THEN sym]; simp)
   qed
   also have "\<dots> = \<P>(\<xi> in \<MM>. f < T x \<xi> \<and> T x \<xi> \<le> f + t \<bar> T x \<xi> > 0)"
     using MM_PS.cond_prob_space_cond_prob alive_T by simp
   finally show ?thesis .
 qed
 
 lemma q_defer_PX: "$q_{f\<bar>t&x} = \<P>(\<xi> in \<MM>. x + f < X \<xi> \<and> X \<xi> \<le> x + f + t) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
   if "f \<ge> 0" "t \<ge> 0" for f t :: real
 proof -
   have "$q_{f\<bar>t&x} = \<P>(\<xi> in \<MM>. f < T x \<xi> \<and> T x \<xi> \<le> f + t \<and> T x \<xi> > 0) / \<P>(\<xi> in \<MM>. T x \<xi> > 0)"
     apply (rewrite q_defer_PTx; (simp add: that)?)
     unfolding cond_prob_def by simp
   also have "\<dots> = \<P>(\<xi> in \<MM>. f < T x \<xi> \<and> T x \<xi> \<le> f + t) / \<P>(\<xi> in \<MM>. T x \<xi> > 0)"
   proof -
     have "\<And>\<xi>. \<xi> \<in> space \<MM> \<Longrightarrow> f < T x \<xi> \<and> T x \<xi> \<le> f + t \<and> T x \<xi> > 0 \<longleftrightarrow> f < T x \<xi> \<and> T x \<xi> \<le> f + t"
       using that by auto
     hence "{\<xi> \<in> space \<MM>. f < T x \<xi> \<and> T x \<xi> \<le> f + t \<and> T x \<xi> > 0} =
       {\<xi> \<in> space \<MM>. f < T x \<xi> \<and> T x \<xi> \<le> f + t}" by blast
     thus ?thesis by simp
   qed
   also have "\<dots> = \<P>(\<xi> in \<MM>. x + f < X \<xi> \<and> X \<xi> \<le> x + f + t) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
     unfolding futr_life_def by (smt (verit) Collect_cong)
   finally show ?thesis .
 qed
 
 lemma q_defer_old_0: "$q_{f\<bar>t&x} = 0" if "x+f \<ge> $\<psi>" "t \<ge> 0" for f t :: real
 proof -
   have "$q_{f\<bar>t&x} = $q_{f+t & x} - $q_{f&x}" using q_defer_q that by simp
   moreover have "$q_{f+t & x} = 1" using q_1_equiv that le_ereal_le by auto
   moreover have "$q_{f&x} = 1" using q_1_equiv that by simp
   ultimately show ?thesis by simp
 qed
 
 end
 
 subsubsection \<open>Properties of Cumulative Distributive Function for X\<close>
 
 lemma cdfX_continuous_unborn[simp]: "continuous_on {..0} (cdf (distr \<MM> borel X))"
   using cdfTx_continuous_on_nonpos by (metis cdfT0_eq_cdfX psi_pos')
 
 lemma cdfX_differentiable_unborn[simp]: "(cdf (distr \<MM> borel X)) differentiable_on {..0}"
   using cdfTx_differentiable_on_nonpos by (metis cdfT0_eq_cdfX psi_pos')
 
 lemma cdfX_has_real_derivative_0_unborn:
   "(cdf (distr \<MM> borel X) has_real_derivative 0) (at x)" if "x < 0" for x::real
   using cdfTx_has_real_derivative_0_at_neg by (metis cdfT0_eq_cdfX psi_pos' that)
 
 lemma cdfX_integrable_Icc:
   "set_integrable lborel {a..b} (cdf (distr \<MM> borel X))" for a b :: real
   using cdfTx_integrable_Icc by (metis cdfT0_eq_cdfX psi_pos')
 
 corollary cdfX_integrable_on_Icc:
   "cdf (distr \<MM> borel X) integrable_on {a..b}" for a b :: real
   using cdfX_integrable_Icc set_borel_integral_eq_integral by force
 
 lemma cdfX_q: "cdf (distr \<MM> borel X) x = $q_{x&0}" if "x \<ge> 0" for x::real
   by (metis cdfT0_eq_cdfX die_def psi_pos')
 
 subsubsection \<open>Relations between @{text "$p_{t&x}"} and @{text "$q_{t&x}"}\<close>
 
 context
   fixes x::real
   assumes x_lt_psi[simp]: "x < $\<psi>"
 begin
 
 interpretation alivex_PS: prob_space "\<MM> \<downharpoonright> alive x"
   by (rule MM_PS.cond_prob_space_correct, simp_all add: alive_def)
 
 interpretation distrTx_RD: real_distribution "distr (\<MM> \<downharpoonright> alive x) borel (T x)" by simp
 
 lemma p_q_1: "$p_{t&x} + $q_{t&x} = 1" for t::real
   unfolding survive_def die_def using distrTx_RD.add_cdf_ccdf
   by (smt (verit) distrTx_RD.prob_space x_lt_psi)
 
 lemma q_defer_p: "$q_{f\<bar>t&x} = $p_{f&x} - $p_{f+t & x}" if "t \<ge> 0" for f t :: real
   using q_defer_q p_q_1 that x_lt_psi by smt
 
 lemma q_defer_p_q_defer: "$p_{f&x} * $q_{f'\<bar>t & x+f} = $q_{f+f'\<bar>t & x}"
   if "x+f < $\<psi>" "f \<ge> 0" "f' \<ge> 0" "t \<ge> 0" for f f' t :: real
 proof -
   have "$p_{f&x} * $q_{f'\<bar>t & x+f} =
     \<P>(\<xi> in \<MM>. X \<xi> > x+f) / \<P>(\<xi> in \<MM>. X \<xi> > x) *
     \<P>(\<xi> in \<MM>. x+f+f' < X \<xi> \<and> X \<xi> \<le> x+f+f'+t) / \<P>(\<xi> in \<MM>. X \<xi> > x+f)"
     apply (rewrite p_PX, (simp_all add: that)[2])
     by (rewrite survival_model.q_defer_PX, simp_all add: that survival_model_axioms)
   also have "\<dots> = \<P>(\<xi> in \<MM>. x+f+f' < X \<xi> \<and> X \<xi> \<le> x+f+f'+t) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
     using survival_model.PXx_pos[of \<MM> X "x+f"] nonzero_mult_div_cancel_left that
     by (smt (verit, ccfv_SIG) survival_model_axioms times_divide_eq_left times_divide_eq_right)
   also have "\<dots> = $q_{f+f'\<bar>t & x}"
     by (rewrite q_defer_PX; simp add: that group_cancel.add1)
   finally show ?thesis .
 qed
 
 lemma q_defer_pq: "$q_{f\<bar>t&x} = $p_{f&x} * $q_{t & x+f}"
   if "x+f < $\<psi>" "t \<ge> 0" "f \<ge> 0" for f t :: real
   using q_defer_p_q_defer[where f'=0] that
   by (simp add: survival_model.q_defer_0_q survival_model_axioms)
 
 subsubsection \<open>Properties of Life Expectation\<close>
 
 lemma e_nonneg: "$e`\<circ>_x \<ge> 0"
   unfolding life_expect_def
   by (rule Bochner_Integration.integral_nonneg, simp add: less_eq_real_def)
 
 lemma e_P: "$e`\<circ>_x =
   MM_PS.expectation (\<lambda>\<xi>. indicator (alive x) \<xi> * T x \<xi>) / \<P>(\<xi> in \<MM>. T x \<xi> > 0)"
   unfolding life_expect_def
   by (rewrite MM_PS.integral_cond_prob_space_nn, auto simp add: alive_T)
 
 proposition nn_integral_T_p:
   "(\<integral>\<^sup>+\<xi>. ennreal (T x \<xi>) \<partial>(\<MM> \<downharpoonright> alive x)) = \<integral>\<^sup>+t\<in>{0..}. ennreal ($p_{t&x}) \<partial>lborel"
   apply (rewrite alivex_PS.expectation_nonneg_tail, simp_all add: less_imp_le)
   apply (rule nn_integral_cong)
   unfolding survive_def using distrTx_RD.prob_space distrTx_RD.ccdf_cdf by presburger
 
 lemma nn_integral_T_pos: "(\<integral>\<^sup>+\<xi>. ennreal (T x \<xi>) \<partial>(\<MM> \<downharpoonright> alive x)) > 0"
 proof -
   let ?f = "\<lambda>t. - ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t"
   have "\<And>t u. t \<le> u \<Longrightarrow> ?f t \<le> ?f u" using distrTx_RD.ccdf_nonincreasing by simp
   moreover have "continuous (at_right 0) ?f"
     using distrTx_RD.ccdf_is_right_cont by (intro continuous_intros)
   ultimately have "\<forall>e>0. \<exists>d>0. ?f (0 + d) - ?f 0 < e"
     using continuous_at_right_real_increasing by simp
   hence "\<exists>d>0. ?f (0 + d) - ?f 0 < 1/2" by (smt (verit, del_insts) field_sum_of_halves)
   from this obtain d where d_pos: "d > 0" and "$p_{d&x} \<ge> 1/2"
     using p_0_1 unfolding survive_def by auto
   hence "\<And>t. t\<in>{0..d} \<Longrightarrow> $p_{t&x} \<ge> 1/2"
     unfolding survive_def using distrTx_RD.ccdf_nonincreasing by force
   hence "\<integral>\<^sup>+t\<in>{0..d}. ennreal ($p_{t&x}) \<partial>lborel \<ge> \<integral>\<^sup>+t\<in>{0..d}. ennreal (1/2) \<partial>lborel"
     apply (intro nn_set_integral_mono, simp_all)
     unfolding survive_def using Tx_alivex_measurable apply force
     by (rule AE_I2) (smt (verit) ennreal_half ennreal_leI half_bounded_equal)
   moreover have "\<integral>\<^sup>+t\<in>{0..}. ennreal ($p_{t&x}) \<partial>lborel \<ge> \<integral>\<^sup>+t\<in>{0..d}. ennreal ($p_{t&x}) \<partial>lborel"
     by (rule nn_set_integral_set_mono) simp
   moreover have "\<integral>\<^sup>+t\<in>{0..d}. ennreal (1/2) \<partial>lborel > 0"
     apply (rewrite nn_integral_cmult_indicator, simp_all)
     using d_pos emeasure_lborel_Icc ennreal_zero_less_mult_iff by fastforce
   ultimately show ?thesis using nn_integral_T_p by simp
 qed
 
 proposition e_LBINT_p: "$e`\<circ>_x = LBINT t:{0..}. $p_{t&x}"
   \<comment> \<open>Note that 0 = 0 holds when the integral diverges.\<close>
   unfolding life_expect_def apply (rewrite integral_eq_nn_integral, simp_all add: less_imp_le)
   unfolding set_lebesgue_integral_def apply (rewrite integral_eq_nn_integral, simp_all)
    apply (measurable, simp add: survive_def)
   by (rewrite nn_integral_T_p) (simp add: indicator_mult_ennreal mult.commute)
 
 corollary e_integral_p: "$e`\<circ>_x = integral {0..} (\<lambda>t. $p_{t&x})"
   \<comment> \<open>Note that 0 = 0 holds when the integral diverges.\<close>
 proof -
   have "$e`\<circ>_x = LBINT t:{0..}. $p_{t&x}" using e_LBINT_p by simp
   also have "\<dots> = integral {0..} (\<lambda>t. $p_{t&x})"
     apply (rule set_borel_integral_eq_integral_nonneg, simp_all)
     unfolding survive_def by simp
   finally show ?thesis .
 qed
 
 lemma e_LBINT_p_Icc: "$e`\<circ>_x = LBINT t:{0..n}. $p_{t&x}" if "x+n \<ge> $\<psi>" for n::real
 proof -
   have [simp]: "{0..n} \<inter> {n<..} = {}" using ivl_disj_int_one(7) by blast
   have [simp]: "{0..n} \<union> {n<..} = {0..}"
     by (smt (verit) ereal_less_le ivl_disj_un_one(7) leD that x_lt_psi)
   have [simp]: "\<And>t. n < t \<Longrightarrow> 0 \<le> t" using that x_lt_psi by (smt (verit) ereal_less_le leD)
   have [simp]: "\<And>t. n < t \<Longrightarrow> $\<psi> \<le> ereal (x+t)" using that by (simp add: le_ereal_le)
   have gt_n_0: "has_bochner_integral lborel (\<lambda>t. indicat_real {n<..} t * $p_{t&x}) 0"
     apply (rewrite has_bochner_integral_cong[where N=lborel and g="\<lambda>t.0" and y=0], simp_all)
     using p_0_equiv that x_lt_psi
      apply (smt (verit, ccfv_SIG) greaterThan_iff indicator_simps le_ereal_le linorder_not_le)
     by (rule has_bochner_integral_zero)
   hence gt_n: "set_integrable lborel {n<..} (\<lambda>t. $p_{t&x})"
     unfolding set_integrable_def using integrable.simps by auto
   moreover have le_n: "set_integrable lborel {0..n} (\<lambda>t. $p_{t&x})"
     unfolding survive_def by (intro ccdfTx_integrable_Icc) simp
   ultimately have "set_integrable lborel ({0..n} \<union> {n<..}) (\<lambda>t. $p_{t&x})"
     using set_integrable_Un by force
   hence "set_integrable lborel {0..} (\<lambda>t. $p_{t&x})" by force
   thus ?thesis
     apply (rewrite e_LBINT_p, simp)
     apply (rewrite set_integral_Un[of "{0..n}" "{n<..}", simplified], simp_all add: gt_n le_n)
     unfolding set_lebesgue_integral_def using gt_n_0 has_bochner_integral_integral_eq by fastforce
 qed
 
 lemma e_integral_p_Icc: "$e`\<circ>_x = integral {0..n} (\<lambda>t. $p_{t&x})" if "x+n \<ge> $\<psi>" for n::real
   using that apply (rewrite e_LBINT_p_Icc, simp_all)
   using ccdfTx_integrable_Icc unfolding survive_def
   by (rewrite set_borel_integral_eq_integral; simp)
 
 lemma temp_e_P: "$e`\<circ>_{x:n} =
   MM_PS.expectation (\<lambda>\<xi>. indicator (alive x) \<xi> * min (T x \<xi>) n) / \<P>(\<xi> in \<MM>. T x \<xi> > 0)"
   if "n \<ge> 0" for n::real
   unfolding temp_life_expect_def
   by (rewrite MM_PS.integral_cond_prob_space_nn; simp add: alive_T that)
 
 lemma temp_e_LBINT_p: "$e`\<circ>_{x:n} = LBINT t:{0..n}. $p_{t&x}" if "n \<ge> 0" for n::real
 proof -
   let ?minTxn = "\<lambda>\<xi>. min (T x \<xi>) n"
   let ?F = "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))"
   let ?Fn = "cdf (distr (\<MM> \<downharpoonright> alive x) borel ?minTxn)"
   interpret distrTxn_RD: real_distribution "distr (\<MM> \<downharpoonright> alive x) borel ?minTxn" by (simp add: that)
   have [simp]: "\<And>\<xi>. \<xi> \<in> space (\<MM> \<downharpoonright> alive x) \<Longrightarrow> 0 \<le> T x \<xi>" by (smt (verit) alivex_Tx_pos)
   have "(\<integral>\<^sup>+\<xi>. ennreal (min (T x \<xi>) n) \<partial>(\<MM> \<downharpoonright> alive x)) = \<integral>\<^sup>+t\<in>{0..}. ennreal (1 - ?Fn t) \<partial>lborel"
     by (rewrite alivex_PS.expectation_nonneg_tail; simp add: that)
   also have "\<dots> = \<integral>\<^sup>+t\<in>{0..}. (ennreal (1 - ?F t) * indicator {..<n} t) \<partial>lborel"
     apply (rule nn_integral_cong)
     by (rewrite alivex_PS.cdf_distr_min; simp add: indicator_mult_ennreal mult.commute)
   also have "\<dots> = \<integral>\<^sup>+t\<in>{0..<n}. ennreal (1 - ?F t) \<partial>lborel"
     apply (rule nn_integral_cong) using nn_integral_set_ennreal
     by (smt (verit, best) Int_def atLeastLessThan_def ennreal_mult_right_cong
         indicator_simps mem_Collect_eq mult.commute mult_1)
   also have "\<dots> = \<integral>\<^sup>+t\<in>{0..n}. ennreal (1 - ?F t) \<partial>lborel"
   proof -
     have "sym_diff {0..<n} {0..n} = {n}" using that by force
     thus ?thesis by (intro nn_integral_null_delta; force)
   qed
   also have "\<dots> = ennreal (LBINT t:{0..n}. $p_{t&x})"
   proof -
     have "set_integrable lborel {0..n} (\<lambda>t. $p_{t&x})"
       unfolding survive_def by (intro ccdfTx_integrable_Icc) simp
     thus ?thesis
       unfolding set_lebesgue_integral_def unfolding set_integrable_def
       apply (rewrite nn_integral_eq_integral[THEN sym]; simp)
       apply (rule nn_integral_cong, simp)
       unfolding survive_def using distrTx_RD.ccdf_cdf distrTx_RD.prob_space nn_integral_set_ennreal
       by (simp add: indicator_mult_ennreal mult.commute)
   qed
   finally have "(\<integral>\<^sup>+\<xi>. ennreal (min (T x \<xi>) n) \<partial>(\<MM> \<downharpoonright> alive x)) =
     ennreal (LBINT t:{0..n}. $p_{t&x})" .
   thus ?thesis
     unfolding temp_life_expect_def
     apply (rewrite integral_eq_nn_integral; simp add: that)
     apply (rewrite enn2real_ennreal; simp?)
     unfolding set_lebesgue_integral_def by (simp add: that)
 qed
 
 lemma temp_e_integral_p: "$e`\<circ>_{x:n} = integral {0..n} (\<lambda>t. $p_{t&x})" if "n \<ge> 0" for n::real
   using that apply (rewrite temp_e_LBINT_p, simp_all)
   using ccdfTx_integrable_Icc unfolding survive_def
   by (rewrite set_borel_integral_eq_integral; simp)
 
 lemma e_eq_temp: "$e`\<circ>_x = $e`\<circ>_{x:n}" if "n \<ge> 0" "x+n \<ge> $\<psi>" for n::real
   using that e_LBINT_p_Icc temp_e_LBINT_p by simp
 
 lemma curt_e_P: "$e_x =
   MM_PS.expectation (\<lambda>\<xi>. indicator (alive x) \<xi> * \<lfloor>T x \<xi>\<rfloor>) / \<P>(\<xi> in \<MM>. T x \<xi> > 0)"
   unfolding curt_life_expect_def
   apply (rewrite MM_PS.integral_cond_prob_space_nn; simp add: alive_T)
   by (metis (no_types, lifting) Bochner_Integration.integral_cong indicator_simps of_int_0 of_int_1)
 
 lemma curt_e_sum_P: "$e_x = (\<Sum>k. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))"
   if "summable (\<lambda>k. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))"
 proof -
   let ?F_flrTx = "cdf (distr (\<MM> \<downharpoonright> alive x) borel (\<lambda>\<xi>. \<lfloor>T x \<xi>\<rfloor>))"
   have [simp]: "\<And>\<xi>. \<xi> \<in> space (\<MM> \<downharpoonright> alive x) \<Longrightarrow> 0 \<le> T x \<xi>" by (smt (verit) alivex_Tx_pos)
   have "integral\<^sup>N (\<MM> \<downharpoonright> alive x) (\<lambda>\<xi>. ennreal \<lfloor>T x \<xi>\<rfloor>) = \<integral>\<^sup>+t\<in>{0..}. ennreal (1 - ?F_flrTx t) \<partial>lborel"
     by (rewrite alivex_PS.expectation_nonneg_tail; simp)
   also have "\<dots> = \<integral>\<^sup>+t\<in>{0::real..}. ennreal \<P>(\<xi> in \<MM>. T x \<xi> \<ge> \<lfloor>t\<rfloor> + 1 \<bar> T x \<xi> > 0) \<partial>lborel"
   proof -
     { fix t::real assume "t \<ge> 0"
       hence "1 - ?F_flrTx t = \<P>(\<xi> in \<MM>. T x \<xi> \<ge> real_of_int \<lfloor>t\<rfloor> + 1 \<bar> T x \<xi> > 0)"
       proof -
         have "1 - ?F_flrTx t = 1 - \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> < real_of_int \<lfloor>t\<rfloor> + 1)"
           by (rewrite alivex_PS.cdf_distr_floor_P; simp)
         also have "\<dots> = 1 - \<P>(\<xi> in \<MM>. T x \<xi> < real_of_int \<lfloor>t\<rfloor> + 1 \<bar> T x \<xi> > 0)"
           using alive_T by (rewrite MM_PS.cond_prob_space_cond_prob; simp)
         also have "\<dots> = \<P>(\<xi> in \<MM>. T x \<xi> \<ge> real_of_int \<lfloor>t\<rfloor> + 1 \<bar> T x \<xi> > 0)"
           by (rewrite not_le[THEN sym], rewrite MM_PS.cond_prob_neg; simp)
         finally show ?thesis .
       qed }
     thus ?thesis
       apply -
       by (rule nn_set_integral_cong2, rule AE_I2) simp
   qed
   also have "\<dots> = (\<Sum>k. \<integral>\<^sup>+t\<in>{k..<k+1}. ennreal \<P>(\<xi> in \<MM>. T x \<xi> \<ge> \<lfloor>t\<rfloor> + 1 \<bar> T x \<xi> > 0) \<partial>lborel)"
     apply (rewrite nn_integral_disjoint_family[THEN sym]; simp)
      apply (rewrite add.commute, rule Ico_nat_disjoint)
     by (rewrite Ico_nat_union[THEN sym], simp add: add.commute)
   also have "\<dots> = (\<Sum>k. \<integral>\<^sup>+t\<in>{k..<k+1::nat}. ennreal \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0) \<partial>lborel)"
   proof -
     { fix k::nat and t::real
       assume "real k \<le> t" and "t < 1 + real k"
       hence "real_of_int \<lfloor>t\<rfloor> = real k"
         by (metis add.commute floor_eq2 of_int_of_nat_eq)
       hence "\<P>(\<xi> in \<MM>. T x \<xi> \<ge> real_of_int \<lfloor>t\<rfloor> + 1 \<bar> T x \<xi> > 0) =
       \<P>(\<xi> in \<MM>. T x \<xi> \<ge> 1 + real k \<bar> T x \<xi> > 0)"
         by (simp add: add.commute) }
     thus ?thesis
       apply -
       apply (rule suminf_cong, rule nn_set_integral_cong2, rule AE_I2)
       by (rule impI) simp
   qed
   also have "\<dots> = (\<Sum>k. ennreal \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))"
     by (rewrite nn_integral_cmult_indicator; simp add: add.commute)
   also have "\<dots> = ennreal (\<Sum>k. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))"
     by (rewrite suminf_ennreal2; simp add: that)
   finally have "integral\<^sup>N (\<MM> \<downharpoonright> alive x) (\<lambda>\<xi>. ennreal \<lfloor>T x \<xi>\<rfloor>) =
     ennreal (\<Sum>k. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))" .
   hence "integral\<^sup>L (\<MM> \<downharpoonright> alive x) (\<lambda>\<xi>. \<lfloor>T x \<xi>\<rfloor>) = (\<Sum>k. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))"
     apply (rewrite integral_eq_nn_integral; simp)
     apply (rewrite enn2real_ennreal; simp add: add.commute)
     apply (rule suminf_nonneg; simp?)
     by (rewrite add.commute, simp add: that)
   thus ?thesis unfolding curt_life_expect_def by (simp add: add.commute)
 qed
 
 lemma curt_e_sum_P_finite: "$e_x = (\<Sum>k<n. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))"
   if "x+n+1 > $\<psi>" for n::nat
 proof -
   from that have psi_fin: "$\<psi> < \<infinity>" by force
   let ?P = "\<lambda>k::nat. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0)"
   let ?P_fin = "\<lambda>k::nat. if k\<in>{..<n} then ?P k else 0"
   have "\<And>k. ?P k = ?P_fin k"
   proof -
     fix k
     show "?P k = ?P_fin k"
     proof (cases \<open>k \<in> {..<n}\<close>)
       case True
       thus ?thesis by simp
     next
       case False
       hence "\<not> k < n" by simp
       hence "x + k + 1 > real_of_ereal $\<psi>"
         using that psi_nonneg real_of_ereal_ord_simps(4) by fastforce
       hence "{\<xi> \<in> space \<MM>. T x \<xi> \<ge> k + 1 \<and> T x \<xi> > 0} \<subseteq> {\<xi> \<in> space \<MM>. X \<xi> > real_of_ereal $\<psi>}"
         unfolding futr_life_def using that less_ereal_le of_nat_1 of_nat_add by force
       hence "\<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<and> T x \<xi> > 0) \<le> \<P>(\<xi> in \<MM>. X \<xi> > real_of_ereal $\<psi>)"
         by (intro MM_PS.finite_measure_mono, simp_all)
       also have "\<dots> = 0" using MM_PS.ccdf_distr_P X_RV ccdfX_psi_0 psi_fin by presburger
       finally have "\<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<and> T x \<xi> > 0) = 0" using measure_le_0_iff by blast
       hence "?P k = 0" unfolding cond_prob_def by (simp add: add.commute)
       thus ?thesis by simp
     qed
   qed
   moreover have "?P_fin sums (\<Sum>k<n. ?P k)" using sums_If_finite_set by force
   ultimately have \<star>: "?P sums (\<Sum>k<n. ?P k)" using sums_cong by simp
   moreover hence "summable ?P" using sums_summable by blast
   ultimately have "?P sums $e_x" using curt_e_sum_P by force
   hence "$e_x = (\<Sum>k<n. ?P k)" by (rewrite sums_unique2[of "?P"]; simp add: \<star>)
   thus ?thesis by (simp add: add.commute)
 qed
 
 lemma curt_e_sum_p: "$e_x = (\<Sum>k. $p_{k+1&x})"
   if "summable (\<lambda>k. $p_{k+1&x})" "\<And>k::nat. isCont (\<lambda>t. $p_{t&x}) (k+1)"
 proof -
   have "\<And>k::nat. $p_{k+1&x} = \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0)"
     apply (rewrite p_PTx_ge_ccdf_isCont, simp_all)
     using that(2) isCont_ccdfX_ccdfTx unfolding survive_def by simp
   thus ?thesis using that p_PTx_ge_ccdf_isCont curt_e_sum_P by presburger
 qed
 
 lemma curt_e_rec: "$e_x = $p_x * (1 + $e_(x+1))"
   if "summable (\<lambda>k. $p_{k+1&x})" "\<And>k::nat. isCont (\<lambda>t. $p_{t&x}) (real k + 1)" "x+1 < $\<psi>"
 proof -
   have px_neq_0[simp]: "$p_x \<noteq> 0" using p_0_equiv that by auto
   have "(\<lambda>k. $p_{k+1&x}) sums $e_x"
     using that apply (rewrite curt_e_sum_p, simp_all add: add.commute)
     by (rule summable_sums, simp add: that)
   hence "(\<lambda>k. $p_x * $p_{k&x+1}) sums $e_x"
     apply (rewrite sums_cong[where g="\<lambda>k. $p_{k+1&x}"]; simp?)
     using p_mult by (smt (verit) of_nat_0_le_iff that(3) x_lt_psi)
   hence "(\<lambda>k. $p_{k&x+1}) sums ($e_x / $p_x)"
     using sums_mult_D that by (smt (verit, best) linorder_not_le p_0_equiv sums_cong x_lt_psi)
   hence p_e_p: "(\<lambda>k. $p_{Suc k & x+1}) sums ($e_x / $p_x - $p_{0&x+1})"
     using sums_split_initial_segment[where n=1] by force
   moreover have "(\<lambda>k. $p_{Suc k & x+1}) sums $e_(x+1)"
   proof -
     have [simp]: "summable (\<lambda>k::nat. $p_{real k + 1 & x + 1})"
       apply (intro sums_summable[where l="$e_x / $p_x - $p_{0&x+1}"])
       using p_e_p by (simp add: add.commute)
     have [simp]: "\<And>k::nat. isCont (\<lambda>t. $p_{t&x+1}) (real k + 1)"
     proof -
       fix k::nat
       have "isCont (\<lambda>t. $p_x * $p_{t-1&x+1}) (real k + 2)"
       proof -
         let ?S="{real k + 1 <..< real k + 3}"
         have "open ?S" by simp
         moreover have "real k + 2 \<in> ?S" by simp
         moreover have "\<And>t. t \<in> ?S \<Longrightarrow> $p_x * $p_{t-1&x+1} = $p_{t&x}"
           using p_mult
           by (smt (verit, del_insts) greaterThanLessThan_iff of_nat_0_le_iff that(3) x_lt_psi)
         ultimately show ?thesis
           apply (rewrite isCont_cong[where g="\<lambda>t. $p_{t&x}"])
            apply (rewrite eventually_nhds, blast)
           using that by (smt (verit) of_nat_1 of_nat_add)
       qed
       hence "isCont (\<lambda>t. $p_x * $p_{t-1&x+1} / $p_x) (real k + 2)"
         by (intro isCont_divide[where g="\<lambda>t. $p_x"], auto)
       hence "isCont ((\<lambda>t. $p_{t-1&x+1}) \<circ> (\<lambda>t. t+1)) (real k + 1)"
         by simp (rule continuous_at_compose, simp_all add: add.commute)
       thus "isCont (\<lambda>t. $p_{t&x+1}) (real k + 1)" unfolding comp_def by simp
     qed
     show ?thesis
       apply (rewrite survival_model.curt_e_sum_p; simp add: survival_model_axioms that)
       using summable_sums by (rewrite add.commute) force
   qed
   ultimately have "$e_x / $p_x - $p_{0&x+1} = $e_(x+1)" by (rule sums_unique2)
   thus ?thesis
     using p_0_1 that
     by (smt (verit) px_neq_0 divide_mult_cancel mult.commute mult_cancel_left2 p_mult that(3))
 qed
 
 lemma curt_e_sum_p_finite: "$e_x = (\<Sum>k<n. $p_{k+1&x})"
   if "\<And>k::nat. k < n \<Longrightarrow> isCont (\<lambda>t. $p_{t&x}) (real k + 1)" "x+n+1 > $\<psi>" for n::nat
 proof -
   have "\<And>k::nat. k < n \<Longrightarrow> $p_{k+1&x} = \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0)"
     apply (rewrite p_PTx_ge_ccdf_isCont, simp_all)
     using that isCont_ccdfX_ccdfTx unfolding survive_def by (smt (verit) of_nat_0_le_iff x_lt_psi)
   thus ?thesis using that p_PTx_ge_ccdf_isCont curt_e_sum_P_finite by simp
 qed
 
 lemma temp_curt_e_P: "$e_{x:n} =
   MM_PS.expectation (\<lambda>\<xi>. indicator (alive x) \<xi> * \<lfloor>min (T x \<xi>) n\<rfloor>) / \<P>(\<xi> in \<MM>. T x \<xi> > 0)"
   if "n \<ge> 0" for n::real
   unfolding temp_curt_life_expect_def
   apply (rewrite MM_PS.integral_cond_prob_space_nn; simp add: alive_T that)
   apply (rule disjI2, rule Bochner_Integration.integral_cong; simp)
   using indicator_simps of_int_0 of_int_1 by smt
 
 lemma temp_curt_e_sum_P: "$e_{x:n} = (\<Sum>k<n. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))" for n::nat
 proof -
   let ?F_flrminTx = "cdf (distr (\<MM> \<downharpoonright> alive x) borel (\<lambda>\<xi>. \<lfloor>min (T x \<xi>) n\<rfloor>))"
   have [simp]: "\<And>\<xi>. \<xi> \<in> space (\<MM> \<downharpoonright> alive x) \<Longrightarrow> 0 \<le> T x \<xi>" by (smt (verit) alivex_Tx_pos)
   have "integral\<^sup>N (\<MM> \<downharpoonright> alive x) (\<lambda>\<xi>. ennreal \<lfloor>min (T x \<xi>) n\<rfloor>) =
     (\<integral>\<^sup>+t\<in>{0..}. ennreal (1 - ?F_flrminTx t) \<partial>lborel)"
     by (rewrite alivex_PS.expectation_nonneg_tail; simp)
   also have "\<dots> = \<integral>\<^sup>+t\<in>{0::real..}. ennreal
     ((1 - \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> < \<lfloor>t\<rfloor> + 1)) * of_bool (\<lfloor>t\<rfloor> + 1 \<le> n)) \<partial>lborel"
   proof -
     have "\<And>t. t \<ge> 0 \<Longrightarrow> ennreal (1 - ?F_flrminTx t) =
       ennreal ((1 - \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> < \<lfloor>t\<rfloor> + 1)) * of_bool (\<lfloor>t\<rfloor> + 1 \<le> n))"
     proof -
       fix t::real assume "t \<ge> 0"
       thus "ennreal (1 - ?F_flrminTx t) =
         ennreal ((1 - \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> < \<lfloor>t\<rfloor> + 1)) * of_bool (\<lfloor>t\<rfloor> + 1 \<le> n))"
       proof (cases \<open>\<lfloor>t\<rfloor> + 1 \<le> n\<close>)
         case True
         thus ?thesis
           apply (rewrite alivex_PS.cdf_distr_floor_P; simp)
           using min_less_iff_disj
           by (smt (verit, ccfv_SIG) Collect_cong
               floor_eq floor_less_cancel floor_of_nat of_int_floor_le)
       next
         case False
         thus ?thesis
           apply (rewrite alivex_PS.cdf_distr_floor_P; simp)
           using min_less_iff_disj
           by (smt (verit, ccfv_SIG) Collect_cong MM_PS.space_cond_prob_space alive_T alive_event
               alivex_PS.prob_space mem_Collect_eq of_int_of_nat_eq of_nat_less_of_int_iff)
       qed
     qed
     thus ?thesis
       by (intro nn_set_integral_cong2, intro AE_I2) auto
   qed
   also have "\<dots> = \<integral>\<^sup>+t\<in>{0..<n}. ennreal (1 - \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> < \<lfloor>t\<rfloor> + 1)) \<partial>lborel"
   proof -
     { fix t::real
       have "(\<lfloor>t\<rfloor> + 1 \<le> n) = (t < n)" by linarith
       hence "\<And>r::real.
         ennreal (r * of_bool (\<lfloor>t\<rfloor> + 1 \<le> n)) * indicator {0..} t = ennreal r * indicator {0..<n} t"
         unfolding atLeastLessThan_def by (simp add: indicator_inter_arith) }
     thus ?thesis by simp
   qed
   also have "\<dots> = \<integral>\<^sup>+t\<in>{0..<n}. ennreal \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> \<ge> \<lfloor>t\<rfloor> + 1) \<partial>lborel"
     by (rewrite alivex_PS.prob_neg[THEN sym]; simp add: not_less)
   also have "\<dots> = (\<Sum>k<n. \<integral>\<^sup>+t\<in>{k..<k+1}. ennreal \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> \<ge> \<lfloor>t\<rfloor> + 1) \<partial>lborel)"
     apply (rewrite  Ico_nat_union_finite[of n, THEN sym])
     apply (rewrite nn_integral_disjoint_family_on_finite; simp add: add.commute)
     apply (rule disjoint_family_on_mono[of _ "{0..}"]; simp)
     by (rewrite add.commute, rule Ico_nat_disjoint)
   also have "\<dots> = (\<Sum>k<n. ennreal \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))"
   proof -
     { fix k::nat
       assume "k < n"
       hence "\<integral>\<^sup>+t\<in>{k..<(1 + real k)}.
         ennreal \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> \<ge> real_of_int \<lfloor>t\<rfloor> + 1) \<partial>lborel =
         \<P>(\<xi> in \<MM>. T x \<xi> \<ge> 1 + real k \<bar> T x \<xi> > 0)" (is "?LHS = ?RHS")
       proof -
         have "?LHS = \<integral>\<^sup>+t\<in>{k..<(1 + real k)}. ennreal \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> \<ge> k + 1) \<partial>lborel"
         proof -
           { fix t::real
             assume "k \<le> t" "t < 1 + real k"
             hence "real_of_int \<lfloor>t\<rfloor> = real k" by (smt (verit) floor_eq2 of_int_of_nat_eq)
             hence "\<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> \<ge> real_of_int \<lfloor>t\<rfloor> + 1) =
               \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> \<ge> 1 + real k)"
               by (simp add: add.commute) }
           thus ?thesis by (intro nn_set_integral_cong2, intro AE_I2) auto
         qed
         also have "\<dots> = ennreal \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> \<ge> k + 1)"
           by (rewrite nn_integral_cmult_indicator; simp)
         also have "\<dots> = ?RHS"
           by (rewrite MM_PS.cond_prob_space_cond_prob, simp_all add: alive_T)
         finally show ?thesis .
       qed }
     thus ?thesis by (intro sum.cong) auto
   qed
   also have "\<dots> = ennreal (\<Sum>k<n. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))" by simp
   finally have "integral\<^sup>N (\<MM> \<downharpoonright> alive x) (\<lambda>\<xi>. ennreal \<lfloor>min (T x \<xi>) n\<rfloor>) =
     ennreal (\<Sum>k<n. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))" .
   hence "integral\<^sup>L (\<MM> \<downharpoonright> alive x) (\<lambda>\<xi>. \<lfloor>min (T x \<xi>) n\<rfloor>) =
     (\<Sum>k<n. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))"
     apply (intro nn_integral_eq_integrable[THEN iffD1, THEN conjunct2]; simp)
     using MM_PS.cond_prob_nonneg by (meson sum_nonneg)
   thus ?thesis unfolding temp_curt_life_expect_def by simp
 qed
 
 corollary curt_e_eq_temp: "$e_x = $e_{x:n}" if "x+n+1 > $\<psi>" for n::nat
   using curt_e_sum_P_finite temp_curt_e_sum_P that by simp
 
 lemma temp_curt_e_sum_p: "$e_{x:n} = (\<Sum>k<n. $p_{k+1&x})"
   if "\<And>k::nat. k < n \<Longrightarrow> isCont (\<lambda>t. $p_{t&x}) (real k + 1)" for n::nat
 proof -
   have "\<And>k::nat. k < n \<Longrightarrow> $p_{k+1&x} = \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0)"
     apply (rewrite p_PTx_ge_ccdf_isCont, simp_all)
     using that isCont_ccdfX_ccdfTx unfolding survive_def by (smt (verit) of_nat_0_le_iff x_lt_psi)
   thus ?thesis
     apply (rewrite temp_curt_e_sum_P)
     by (rule sum.cong) simp_all
 qed
 
 lemma temp_curt_e_rec: "$e_{x:n} = $p_x * (1 + $e_{x+1:n-1})"
   if "\<And>k::nat. k < n \<Longrightarrow> isCont (\<lambda>t. $p_{t&x}) (real k + 1)" "x+1 < $\<psi>" "n \<noteq> 0" for n::nat
 proof -
   have [simp]: "$p_x \<noteq> 0" using p_0_equiv that by auto
   have [simp]: "\<And>k. k < n-1 \<Longrightarrow> isCont (\<lambda>t. $p_{t&x+1}) (real k + 1)"
   proof -
     fix k::nat assume k_n: "k < n-1"
     have "isCont (\<lambda>t. $p_x * $p_{t-1&x+1}) (real k + 2)"
     proof -
       let ?S="{real k + 1 <..< real k + 3}"
       have "open ?S" by simp
       moreover have "real k + 2 \<in> ?S" by simp
       moreover have "\<And>t. t \<in> ?S \<Longrightarrow> $p_x * $p_{t-1&x+1} = $p_{t&x}"
         using p_mult
         by (smt (verit, del_insts) greaterThanLessThan_iff of_nat_0_le_iff that(2) x_lt_psi)
       ultimately show ?thesis
         apply (rewrite isCont_cong[where g="\<lambda>t. $p_{t&x}"])
          apply (rewrite eventually_nhds, blast)
         using that k_n by (smt (verit) less_diff_conv of_nat_1 of_nat_add)
     qed
     hence "isCont (\<lambda>t. $p_x * $p_{t-1&x+1} / $p_x) (real k + 2)"
       by (intro isCont_divide[where g="\<lambda>t. $p_x"], auto)
     hence "isCont ((\<lambda>t. $p_{t-1&x+1}) \<circ> (\<lambda>t. t+1)) (real k + 1)"
       by simp (rule continuous_at_compose, simp_all add: add.commute)
     thus "isCont (\<lambda>t. $p_{t&x+1}) (real k + 1)" unfolding comp_def by simp
   qed
   have "$p_x * (1 + $e_{x+1:n-1}) = $p_x * (1 + (\<Sum>k<(n-1). $p_{k+1&x+1}))"
     by (rewrite survival_model.temp_curt_e_sum_p; simp add: survival_model_axioms that)
   also have "\<dots> = $p_x + (\<Sum>k<(n-1). $p_x * $p_{k+1&x+1})"
     apply (rewrite distrib_left, simp)
     by (rewrite vector_space_over_itself.scale_sum_right, simp)
   also have "\<dots> = $p_x + (\<Sum>k<(n-1). $p_{k+2&x})"
     apply (rewrite sum.cong, simp_all add: add.commute)
     using p_mult by (smt (verit) of_nat_0_le_iff that(2) x_lt_psi)
   also have "\<dots> = (\<Sum>k<Suc(n-1). $p_{k+1&x})"
     apply (rewrite lessThan_atLeast0)+
     by (rewrite sum.atLeast0_lessThan_Suc_shift) simp
   also have "\<dots> = $e_{x:n}" using that by (rewrite temp_curt_e_sum_p; simp)
   finally show ?thesis by simp
 qed
 
 end
 
 end
 
 subsection \<open>Piecewise Differentiable Survival Function\<close>
 
 locale smooth_survival_function = survival_model +
   assumes ccdfX_piecewise_differentiable[simp]:
     "(ccdf (distr \<MM> borel X)) piecewise_differentiable_on UNIV"
 
 begin
 
 interpretation distrX_RD: real_distribution "distr \<MM> borel X"
   using MM_PS.real_distribution_distr by simp
 
 subsubsection \<open>Properties of Survival Function for X\<close>
 
 lemma ccdfX_continuous[simp]: "continuous_on UNIV (ccdf (distr \<MM> borel X))"
   using ccdfX_piecewise_differentiable piecewise_differentiable_on_imp_continuous_on by fastforce
 
 corollary ccdfX_borel_measurable[measurable]: "ccdf (distr \<MM> borel X) \<in> borel_measurable borel"
   by (rule borel_measurable_continuous_onI) simp
 
 lemma ccdfX_nondifferentiable_finite_set[simp]:
   "finite {x. \<not> ccdf (distr \<MM> borel X) differentiable at x}"
 proof -
   obtain S where
     fin: "finite S" and "\<And>x. x \<notin> S \<Longrightarrow> (ccdf (distr \<MM> borel X)) differentiable at x"
     using ccdfX_piecewise_differentiable unfolding piecewise_differentiable_on_def by blast
   hence "{x. \<not> ccdf (distr \<MM> borel X) differentiable at x} \<subseteq> S" by blast
   thus ?thesis using finite_subset fin by blast
 qed
 
 lemma ccdfX_differentiable_open_set: "open {x. ccdf (distr \<MM> borel X) differentiable at x}"
   using ccdfX_nondifferentiable_finite_set finite_imp_closed
   by (metis (mono_tags, lifting) Collect_cong open_Collect_neg)
 
 lemma ccdfX_differentiable_borel_set[measurable, simp]:
   "{x. ccdf (distr \<MM> borel X) differentiable at x} \<in> sets borel"
   using ccdfX_differentiable_open_set by simp
 
 lemma ccdfX_differentiable_AE:
   "AE x in lborel. (ccdf (distr \<MM> borel X)) differentiable at x"
   apply (rule AE_I'[of "{x. \<not> ccdf (distr \<MM> borel X) differentiable at x}"], simp_all)
   using ccdfX_nondifferentiable_finite_set by (simp add: finite_imp_null_set_lborel)
 
 lemma deriv_ccdfX_measurable[measurable]: "deriv (ccdf (distr \<MM> borel X)) \<in> borel_measurable borel"
 proof -
   have "set_borel_measurable borel UNIV (deriv (ccdf (distr \<MM> borel X)))"
     by (rule piecewise_differentiable_on_deriv_measurable_real; simp)
   thus ?thesis unfolding set_borel_measurable_def by simp
 qed
 
 subsubsection \<open>Properties of Cumulative Distributive Function for X\<close>
 
 lemma cdfX_piecewise_differentiable[simp]:
   "(cdf (distr \<MM> borel X)) piecewise_differentiable_on UNIV"
   by (rewrite distrX_RD.cdf_ccdf) (rule piecewise_differentiable_diff; simp)
 
 lemma cdfX_continuous[simp]: "continuous_on UNIV (cdf (distr \<MM> borel X))"
   using cdfX_piecewise_differentiable piecewise_differentiable_on_imp_continuous_on by fastforce
 
 corollary cdfX_borel_measurable[measurable]: "cdf (distr \<MM> borel X) \<in> borel_measurable borel"
   by (rule borel_measurable_continuous_onI) simp
 
 lemma cdfX_nondifferentiable_finite_set[simp]:
   "finite {x. \<not> cdf (distr \<MM> borel X) differentiable at x}"
   using distrX_RD.differentiable_cdf_ccdf ccdfX_nondifferentiable_finite_set by simp
 
 lemma cdfX_differentiable_open_set: "open {x. cdf (distr \<MM> borel X) differentiable at x}"
   using distrX_RD.differentiable_cdf_ccdf ccdfX_differentiable_open_set by simp
 
 lemma cdfX_differentiable_borel_set[measurable, simp]:
   "{x. cdf (distr \<MM> borel X) differentiable at x} \<in> sets borel"
   using cdfX_differentiable_open_set by simp
 
 lemma cdfX_differentiable_AE:
   "AE x in lborel. (cdf (distr \<MM> borel X)) differentiable at x"
   using ccdfX_differentiable_AE distrX_RD.differentiable_cdf_ccdf AE_iffI by simp
 
 lemma deriv_cdfX_measurable[measurable]: "deriv (cdf (distr \<MM> borel X)) \<in> borel_measurable borel"
 proof -
   have "set_borel_measurable borel UNIV (deriv (cdf (distr \<MM> borel X)))"
     by (rule piecewise_differentiable_on_deriv_measurable_real; simp)
   thus ?thesis unfolding set_borel_measurable_def by simp
 qed
 
 subsubsection \<open>Introduction of Probability Density Functions of X and T(x)\<close>
 
 definition pdfX :: "real \<Rightarrow> real"
   where "pdfX x \<equiv> if cdf (distr \<MM> borel X) differentiable at x
     then deriv (cdf (distr \<MM> borel X)) x else 0"
     \<comment> \<open>This function is defined to be always nonnegative for future application.\<close>
 
 definition pdfT :: "real \<Rightarrow> real \<Rightarrow> real"
   where "pdfT x t \<equiv> if cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t
     then deriv (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) t else 0"
     \<comment> \<open>This function is defined to be always nonnegative for future application.\<close>
 
 lemma pdfX_measurable[measurable]: "pdfX \<in> borel_measurable borel"
 proof -
   let ?cdfX = "cdf (distr \<MM> borel X)"
   have "countable {x. \<not> ?cdfX differentiable at x}"
     using cdfX_nondifferentiable_finite_set uncountable_infinite by force
   thus ?thesis
     unfolding pdfX_def
     apply -
     by (rule measurable_discrete_difference
         [where X="{x. \<not> ?cdfX differentiable at x}" and f="deriv ?cdfX"]; simp)
 qed
 
 lemma distributed_pdfX: "distributed \<MM> lborel X pdfX"
 proof -
   let ?cdfX = "cdf (distr \<MM> borel X)"
   obtain S where fin: "finite S" and diff: "\<And>t. t \<notin> S \<Longrightarrow> ?cdfX differentiable at t"
     using cdfX_piecewise_differentiable unfolding piecewise_differentiable_on_def by blast
   { fix t::real assume t_notin: "t \<notin> S"
     have "?cdfX differentiable at t" using diff t_notin by simp
     hence "(?cdfX has_real_derivative pdfX t) (at t)"
       unfolding pdfX_def using DERIV_deriv_iff_real_differentiable by auto }
   thus ?thesis
     by (intro MM_PS.distributed_deriv_cdf[where S=S]; simp add: fin)
 qed
 
 lemma pdfT0_X: "pdfT 0 = pdfX"
   unfolding pdfT_def pdfX_def using cdfT0_eq_cdfX psi_pos' by fastforce
 
 subsubsection \<open>Properties of Survival Function for T(x)\<close>
 
 context
   fixes x::real
   assumes x_lt_psi[simp]: "x < $\<psi>"
 begin
 
 interpretation alivex_PS: prob_space "\<MM> \<downharpoonright> alive x"
   by (rule MM_PS.cond_prob_space_correct; simp add: alive_def)
 
 interpretation distrTx_RD: real_distribution "distr (\<MM> \<downharpoonright> alive x) borel (T x)" by simp
 
 lemma ccdfTx_continuous_on_nonneg[simp]:
   "continuous_on {0..} (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
   apply (rewrite continuous_on_eq_continuous_within, auto)
   apply (rewrite continuous_ccdfX_ccdfTx[THEN sym], auto)
   by (metis UNIV_I ccdfX_continuous continuous_at_imp_continuous_at_within
       continuous_on_eq_continuous_within)
 
 lemma ccdfTx_continuous[simp]: "continuous_on UNIV (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
 proof -
   have [simp]: "{..0::real} \<union> {0..} = UNIV" by auto
   have "continuous_on {..0} (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
     by (rule ccdfTx_continuous_on_nonpos) simp
   moreover have "continuous_on {0..} (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))" by simp
   ultimately have "continuous_on ({..0} \<union> {0..}) (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
     by (intro continuous_on_closed_Un) simp_all
   thus ?thesis by simp
 qed
 
 corollary ccdfTx_borel_measurable[measurable]:
   "ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) \<in> borel_measurable borel"
   by (rule borel_measurable_continuous_onI) simp
 
 lemma ccdfTx_nondifferentiable_finite_set[simp]:
   "finite {t. \<not> ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t}"
 proof -
   let ?P = "\<lambda>t. ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t"
   have "{t. t < 0 \<and> \<not> ?P t} = {}"
   proof (rule equals0I)
     fix t assume asm: "t \<in> {t. t < 0 \<and> \<not> ?P t}"
     hence "?P t" using ccdfTx_has_real_derivative_0_at_neg real_differentiable_def x_lt_psi by blast
     with asm show False by simp
   qed
   hence "{t. \<not> ?P t} \<subseteq> insert 0 {t. t > 0 \<and> \<not> ?P t}" by force
   moreover have "finite {t. t > 0 \<and> \<not> ?P t}"
   proof -
     have "{t. \<not> ccdf (distr \<MM> borel X) differentiable at (x+t)} =
       plus (-x) ` {s. \<not> ccdf (distr \<MM> borel X) differentiable at s}"
       by force
     hence "finite {t. \<not> ccdf (distr \<MM> borel X) differentiable at (x+t)}"
       using ccdfX_nondifferentiable_finite_set by simp
     thus ?thesis
       using finite_subset differentiable_ccdfX_ccdfTx
       by (metis (no_types, lifting) mem_Collect_eq subsetI x_lt_psi)
   qed
   ultimately show ?thesis using finite_subset by auto
 qed
 
 lemma ccdfTx_differentiable_open_set:
   "open {t. ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t}"
   using ccdfTx_nondifferentiable_finite_set finite_imp_closed
   by (metis (mono_tags, lifting) Collect_cong open_Collect_neg)
 
 lemma ccdfTx_differentiable_borel_set[measurable, simp]:
   "{t. ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t} \<in> sets borel"
   using ccdfTx_differentiable_open_set by simp
 
 lemma ccdfTx_differentiable_AE:
   "AE t in lborel. (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) differentiable at t"
   apply (rule AE_I'[of "{t. \<not> ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t}"]; simp?)
   using ccdfTx_nondifferentiable_finite_set by (simp add: finite_imp_null_set_lborel)
 
 lemma ccdfTx_piecewise_differentiable[simp]:
   "(ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) piecewise_differentiable_on UNIV"
 proof -
   have "\<forall>t\<in>UNIV-{t. \<not> ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t}.
     ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t"
     by auto
   thus ?thesis
     unfolding piecewise_differentiable_on_def
     using ccdfTx_continuous ccdfTx_nondifferentiable_finite_set by blast
 qed
 
 lemma deriv_ccdfTx_measurable[measurable]:
   "deriv (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) \<in> borel_measurable borel"
 proof -
   have "set_borel_measurable borel UNIV (deriv (ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))))"
     by (rule piecewise_differentiable_on_deriv_measurable_real; simp)
   thus ?thesis unfolding set_borel_measurable_def by simp
 qed
 
 subsubsection \<open>Properties of Cumulative Distributive Function for T(x)\<close>
 
 lemma cdfTx_continuous[simp]:
   "continuous_on UNIV (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
   using distrTx_RD.cdf_ccdf ccdfTx_continuous by (simp add: continuous_on_eq_continuous_within)
 
 corollary cdfTx_borel_measurable[measurable]:
   "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) \<in> borel_measurable borel"
   by (rule borel_measurable_continuous_onI) simp
 
 lemma cdfTx_nondifferentiable_finite_set[simp]:
   "finite {t. \<not> cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t}"
   using distrTx_RD.differentiable_cdf_ccdf by simp
 
 lemma cdfTx_differentiable_open_set:
   "open {t. cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t}"
   using distrTx_RD.differentiable_cdf_ccdf ccdfTx_differentiable_open_set by simp
 
 lemma cdfTx_differentiable_borel_set[measurable, simp]:
   "{t. cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t} \<in> sets borel"
   using cdfTx_differentiable_open_set by simp
 
 lemma cdfTx_differentiable_AE:
   "AE t in lborel. (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) differentiable at t"
   by (rewrite distrTx_RD.differentiable_cdf_ccdf, simp add: ccdfTx_differentiable_AE)
 
 lemma cdfTx_piecewise_differentiable[simp]:
   "(cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) piecewise_differentiable_on UNIV"
   using piecewise_differentiable_diff piecewise_differentiable_const ccdfTx_piecewise_differentiable
   by (rewrite distrTx_RD.cdf_ccdf) blast
 
 lemma deriv_cdfTx_measurable[measurable]:
   "deriv (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) \<in> borel_measurable borel"
 proof -
   have "set_borel_measurable borel UNIV (deriv (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))))"
     by (rule piecewise_differentiable_on_deriv_measurable_real; simp)
   thus ?thesis unfolding set_borel_measurable_def by simp
 qed
 
 subsubsection \<open>Properties of Probability Density Function of T(x)\<close>
 
 lemma pdfTx_nonneg: "pdfT x t \<ge> 0" for t::real
 proof -
   fix t
   show "pdfT x t \<ge> 0"
   proof (cases \<open>cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t\<close>)
     case True
     have "mono_on UNIV (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)))"
       unfolding mono_on_def using distrTx_RD.cdf_nondecreasing by blast
     moreover have "(cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) has_real_derivative pdfT x t) (at t)"
       unfolding pdfT_def using True DERIV_deriv_iff_real_differentiable by presburger
     ultimately show ?thesis by (rule mono_on_imp_deriv_nonneg) simp
   next
     case False
     thus ?thesis unfolding pdfT_def by simp
   qed
 qed
 
 lemma pdfTx_neg_0: "pdfT x t = 0" if "t < 0" for t::real
 proof -
   let ?e = "-t/2"
   have "(cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) has_real_derivative 0) (at t)"
     apply (rewrite DERIV_cong_ev[of t t _ "\<lambda>_. 0" 0 0], simp_all add: that)
     apply (rewrite eventually_nhds)
     apply (rule exI[of _ "ball t ?e"], auto simp add: that)
     by (rule cdfTx_nonpos_0; simp add: dist_real_def)
   thus ?thesis unfolding pdfT_def by (meson DERIV_imp_deriv)
 qed
 
 lemma pdfTx_0_0: "pdfT x 0 = 0"
 proof (cases \<open>cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at 0\<close>)
   case True
   let ?cdfx = "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))"
   have "(?cdfx has_real_derivative 0) (at 0)"
   proof -
     from True obtain c where cdfx_deriv: "(?cdfx has_real_derivative c) (at 0)"
       unfolding differentiable_def using has_real_derivative by blast
     hence "(?cdfx has_real_derivative c) (at 0 within {..0})"
       by (rule has_field_derivative_at_within)
     moreover have "(?cdfx has_real_derivative 0) (at 0 within {..0})"
     proof -
       have "\<forall>\<^sub>F t in at 0 within {..0}. ?cdfx t = 0"
       proof -
         { fix t assume "t \<in> {..0::real}" "t \<noteq> 0" "dist t 0 < 1"
           hence "?cdfx t = 0" using cdfTx_nonpos_0 x_lt_psi by blast }
         hence "\<exists>d>0::real. \<forall>t\<in>{..0}. t\<noteq>0 \<and> dist t 0 < d \<longrightarrow> ?cdfx t = 0" by (smt (verit))
         thus ?thesis by (rewrite eventually_at) simp
       qed
       moreover have "?cdfx 0 = 0"
       proof -
         have "continuous (at 0 within {..0}) ?cdfx"
           using True differentiable_imp_continuous_within differentiable_subset by blast
         thus ?thesis by (simp add: cdfTx_nonpos_0)
       qed
       ultimately show ?thesis
         by (rewrite has_field_derivative_cong_eventually[of _ "\<lambda>_. 0::real" 0 "{..0}" 0]; simp)
     qed
     ultimately have "c = 0"
       using has_real_derivative_iff_has_vector_derivative
       apply (intro vector_derivative_unique_within[of 0 "{..0}" ?cdfx c 0]; blast?)
       by (rewrite at_within_eq_bot_iff)
         (metis closure_lessThan islimpt_in_closure limpt_of_closure
           trivial_limit_at_left_real trivial_limit_within)
     thus "(?cdfx has_real_derivative 0) (at 0)" using cdfx_deriv by simp
   qed
   thus ?thesis unfolding pdfT_def by (meson DERIV_imp_deriv)
 next
   case False
   thus ?thesis unfolding pdfT_def by simp
 qed
 
 lemma pdfTx_nonpos_0: "pdfT x t = 0" if "t \<le> 0" for t::real
   using pdfTx_neg_0 pdfTx_0_0 that by force
 
 lemma pdfTx_beyond_0: "pdfT x t = 0" if "x+t \<ge> $\<psi>" for t::real
 proof (cases \<open>t \<le> 0\<close>)
   case True
   thus ?thesis using pdfTx_nonpos_0 by simp
 next
   let ?cdfTx = "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))"
   case False
   hence t_pos: "t > 0" by simp
   thus ?thesis
   proof -
     have "(?cdfTx has_real_derivative 0) (at_right t)"
       apply (rewrite has_field_derivative_cong_eventually[where g="\<lambda>_. 1"], simp_all)
        apply (rewrite eventually_at_right_field)
       using that cdfTx_1_equiv
       by (intro exI[of _"t+1"], auto simp add: le_ereal_less less_eq_ereal_def)
     thus ?thesis unfolding pdfT_def
       by (meson has_real_derivative_iff_has_vector_derivative has_vector_derivative_at_within
           DERIV_deriv_iff_real_differentiable trivial_limit_at_right_real
           vector_derivative_unique_within)
   qed
 qed
 
 lemma pdfTx_pdfX: "pdfT x t = pdfX (x+t) / \<P>(\<xi> in \<MM>. X \<xi> > x)" if "t > 0" for t::real
 proof (cases \<open>cdf (distr \<MM> borel X) differentiable at (x+t)\<close>)
   case True
   let ?cdfX = "cdf (distr \<MM> borel X)"
   let ?cdfTx = "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))"
   have [simp]: "?cdfTx differentiable at t" using differentiable_cdfX_cdfTx that True by simp
   have "pdfT x t = deriv ?cdfTx t" unfolding pdfT_def using that differentiable_cdfX_cdfTx by simp
   hence "(?cdfTx has_field_derivative (pdfT x t)) (at t)"
     using True DERIV_deriv_iff_real_differentiable by simp
   moreover have "\<And>u. dist u t < t \<Longrightarrow>
     ?cdfX (x+u) / \<P>(\<xi> in \<MM>. X \<xi> > x) - (1 / \<P>(\<xi> in \<MM>. X \<xi> > x) - 1) = ?cdfTx u"
   proof -
     fix u::real
     assume "dist u t < t"
     hence [simp]: "u > 0" using dist_real_def by fastforce
     have "?cdfX (x+u) / \<P>(\<xi> in \<MM>. X \<xi> > x) - (1 / \<P>(\<xi> in \<MM>. X \<xi> > x) - 1) = 
       (1 - \<P>(\<xi> in \<MM>. X \<xi> > x+u)) / \<P>(\<xi> in \<MM>. X \<xi> > x) - (1 / \<P>(\<xi> in \<MM>. X \<xi> > x) - 1)"
       using MM_PS.ccdf_distr_P X_RV distrX_RD.cdf_ccdf distrX_RD.prob_space by presburger
     also have "\<dots> = 1 - \<P>(\<xi> in \<MM>. X \<xi> > x+u) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
       by (simp add: diff_divide_distrib)
     also have "\<dots> = ?cdfTx u"
       apply (rewrite ccdfTx_PX[THEN sym], simp_all add: less_eq_real_def)
       using distrTx_RD.cdf_ccdf distrTx_RD.prob_space by presburger
     finally show "?cdfX (x+u) / \<P>(\<xi> in \<MM>. X \<xi> > x) - (1 / \<P>(\<xi> in \<MM>. X \<xi> > x) - 1) = ?cdfTx u" .
   qed
   ultimately have "((\<lambda>u. ?cdfX (x+u) / \<P>(\<xi> in \<MM>. X \<xi> > x) - (1 / \<P>(\<xi> in \<MM>. X \<xi> > x) - 1))
     has_field_derivative (pdfT x t)) (at t)"
     apply -
     by (rule has_field_derivative_transform_within[where d=t]; simp add: that)
   hence "((\<lambda>u. ?cdfX (x+u) / \<P>(\<xi> in \<MM>. X \<xi> > x)) has_field_derivative (pdfT x t)) (at t)"
     unfolding has_field_derivative_def
     using has_derivative_add_const[where c="1 / \<P>(\<xi> in \<MM>. X \<xi> > x) - 1"] by force
   hence "((\<lambda>u. ?cdfX (x+u) / \<P>(\<xi> in \<MM>. X \<xi> > x) * \<P>(\<xi> in \<MM>. X \<xi> > x)) has_field_derivative
     pdfT x t * \<P>(\<xi> in \<MM>. X \<xi> > x)) (at t)"
     using DERIV_cmult_right[where c="\<P>(\<xi> in \<MM>. X \<xi> > x)"] by force
   hence "((\<lambda>u. ?cdfX (x+u)) has_field_derivative pdfT x t * \<P>(\<xi> in \<MM>. X \<xi> > x)) (at t)"
     unfolding has_field_derivative_def using has_derivative_transform PXx_pos x_lt_psi
     by (smt (verit) Collect_cong UNIV_I nonzero_mult_div_cancel_right times_divide_eq_left)
   hence "(?cdfX has_field_derivative pdfT x t * \<P>(\<xi> in \<MM>. X \<xi> > x)) (at (x+t))"
     using DERIV_at_within_shift by force
   moreover have "(?cdfX has_field_derivative deriv ?cdfX (x+t)) (at (x+t))"
     using True DERIV_deriv_iff_real_differentiable by blast
   ultimately have "pdfT x t * \<P>(\<xi> in \<MM>. X \<xi> > x) = deriv ?cdfX (x+t)"
     by (simp add: DERIV_imp_deriv)
   thus "pdfT x t = pdfX (x+t) / \<P>(\<xi> in \<MM>. X \<xi> > x)"
     unfolding pdfX_def using True
     by simp (metis PXx_pos nonzero_mult_div_cancel_right x_lt_psi zero_less_measure_iff)
 next
   case False
   hence [simp]: "\<not> cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) differentiable at t"
     using differentiable_cdfX_cdfTx that by simp
   thus "pdfT x t = pdfX (x+t) / \<P>(\<xi> in \<MM>. X \<xi> > x)" unfolding pdfT_def pdfX_def using False by simp
 qed
 
 lemma pdfTx_measurable[measurable]: "pdfT x \<in> borel_measurable borel"
 proof -
   let ?cdfTx = "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))"
   have "countable {x. \<not> ?cdfTx differentiable at x}"
     using cdfX_nondifferentiable_finite_set uncountable_infinite by force
   thus ?thesis
     unfolding pdfT_def
     apply -
     by (rule measurable_discrete_difference
         [where X="{x. \<not> ?cdfTx differentiable at x}" and f="deriv ?cdfTx"]; simp)
 qed
 
 lemma distributed_pdfTx: "distributed (\<MM> \<downharpoonright> alive x) lborel (T x) (pdfT x)"
 proof -
   let ?cdfTx = "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))"
   obtain S where fin: "finite S" and diff: "\<And>t. t \<notin> S \<Longrightarrow> ?cdfTx differentiable at t"
     using cdfTx_piecewise_differentiable unfolding piecewise_differentiable_on_def by blast
   { fix t::real assume t_notin: "t \<notin> S"
     have "?cdfTx differentiable at t" using diff t_notin by simp
     hence "(?cdfTx has_real_derivative pdfT x t) (at t)"
       unfolding pdfT_def using DERIV_deriv_iff_real_differentiable by force }
   thus ?thesis
     by (intro alivex_PS.distributed_deriv_cdf[where S=S]; simp add: fin)
 qed
 
 lemma nn_integral_pdfTx_1: "(\<integral>\<^sup>+s. pdfT x s \<partial>lborel) = 1"
 proof -
   have "(\<integral>\<^sup>+s. pdfT x s \<partial>lborel) = emeasure (density lborel (pdfT x)) UNIV"
     by (rewrite emeasure_density) simp_all
   also have "\<dots> = emeasure (distr (\<MM> \<downharpoonright> alive x) lborel (T x)) UNIV"
     using distributed_pdfTx unfolding distributed_def by simp
   also have "\<dots> = 1"
     by (metis distrTx_RD.emeasure_space_1 distrTx_RD.space_eq_univ distr_cong sets_lborel)
   finally show ?thesis .
 qed
 
 corollary has_bochner_integral_pdfTx_1: "has_bochner_integral lborel (pdfT x) 1"
   by (rule has_bochner_integral_nn_integral; simp add: pdfTx_nonneg nn_integral_pdfTx_1)
 
 corollary LBINT_pdfTx_1: "LBINT s. pdfT x s = 1"
   using has_bochner_integral_pdfTx_1 by (simp add: has_bochner_integral_integral_eq)
 
 corollary pdfTx_has_integral_1: "(pdfT x has_integral 1) UNIV"
   by (rule nn_integral_has_integral; simp add: pdfTx_nonneg nn_integral_pdfTx_1)
 
 lemma set_nn_integral_pdfTx_1: "\<integral>\<^sup>+s\<in>{0..}. pdfT x s \<partial>lborel = 1"
   apply (rewrite nn_integral_pdfTx_1[THEN sym])
   apply (rule nn_integral_cong)
   using pdfTx_nonpos_0
   by (metis atLeast_iff ennreal_0 indicator_simps(1) linorder_le_cases
       mult.commute mult_1 mult_zero_left)
 
 corollary has_bochner_integral_pdfTx_1_nonpos:
   "has_bochner_integral lborel (\<lambda>s. pdfT x s * indicator {0..} s) 1"
   apply (rule has_bochner_integral_nn_integral, simp_all)
   using pdfTx_nonneg apply simp
   using set_nn_integral_pdfTx_1 by (simp add: nn_integral_set_ennreal)
 
 corollary set_LBINT_pdfTx_1: "(LBINT s:{0..}. pdfT x s) = 1"
   unfolding set_lebesgue_integral_def
   using has_bochner_integral_pdfTx_1_nonpos has_bochner_integral_integral_eq
   apply (simp, rewrite mult.commute)
   by (smt (verit) Bochner_Integration.integral_cong has_bochner_integral_integral_eq)
 
 corollary pdfTx_has_integral_1_nonpos: "(pdfT x has_integral 1) {0..}"
 proof -
   have "set_integrable lebesgue {0..} (pdfT x)"
     unfolding set_integrable_def
     apply (rewrite integrable_completion, simp_all)
     using has_bochner_integral_pdfTx_1_nonpos by (rewrite mult.commute, rule integrable.intros)
   moreover have "LINT s:{0..}|lebesgue. pdfT x s = 1"
     using set_LBINT_pdfTx_1 unfolding set_lebesgue_integral_def
     by (rewrite integral_completion; simp)
   ultimately show ?thesis using has_integral_set_lebesgue by force
 qed
 
 lemma set_nn_integral_pdfTx_PTx: "\<integral>\<^sup>+s\<in>A. pdfT x s \<partial>lborel = \<P>(\<xi> in \<MM>. T x \<xi> \<in> A \<bar> T x \<xi> > 0)"
   if "A \<in> sets lborel" for A :: "real set"
 proof -
   have [simp]: "A \<in> sets borel" using that by simp
   have "\<integral>\<^sup>+s\<in>A. pdfT x s \<partial>lborel = emeasure (density lborel (pdfT x)) A"
     using that by (rewrite emeasure_density; force)
   also have "\<dots> = emeasure (distr (\<MM> \<downharpoonright> alive x) lborel (T x)) A"
     using distributed_pdfTx unfolding distributed_def by simp
   also have "\<dots> = ennreal \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). T x \<xi> \<in> A)"
     apply (rewrite emeasure_distr, simp_all)
     apply (rewrite finite_measure.emeasure_eq_measure, simp)
     by (smt (verit) Collect_cong vimage_eq Int_def)
   also have "\<dots> = ennreal \<P>(\<xi> in \<MM>. T x \<xi> \<in> A \<bar> T x \<xi> > 0)"
     unfolding alive_def
     apply (rewrite MM_PS.cond_prob_space_cond_prob[THEN sym], simp_all add: pred_def futr_life_def)
     using borel_measurable_diff X_RV that by measurable
   finally show ?thesis .
 qed
 
 lemma pdfTx_set_integrable: "set_integrable lborel A (pdfT x)" if "A \<in> sets lborel"
   unfolding set_integrable_def
-  using that pdfTx_nonneg apply (intro integrableI_real_bounded, simp_all)
+  using that pdfTx_nonneg apply (intro integrableI_nonneg, simp_all)
   apply (rewrite mult.commute)
   using set_nn_integral_pdfTx_PTx that
   by (metis (no_types, lifting) ennreal_indicator ennreal_less_top ennreal_mult' nn_integral_cong)
 
 lemma set_integral_pdfTx_PTx: "LBINT s:A. pdfT x s = \<P>(\<xi> in \<MM>. T x \<xi> \<in> A \<bar> T x \<xi> > 0)"
   if "A \<in> sets lborel" for A :: "real set"
   unfolding set_lebesgue_integral_def
   apply (rewrite integral_eq_nn_integral)
   using that apply (simp_all add: pdfTx_nonneg)
   apply (rewrite indicator_mult_ennreal[THEN sym], rewrite mult.commute)
   by (rewrite set_nn_integral_pdfTx_PTx; simp)
 
 lemma pdfTx_has_integral_PTx: "(pdfT x has_integral \<P>(\<xi> in \<MM>. T x \<xi> \<in> A \<bar> T x \<xi> > 0)) A"
   if "A \<in> sets lborel" for A :: "real set"
 proof -
   have "((\<lambda>s. pdfT x s * indicat_real A s) has_integral \<P>(\<xi> in \<MM>. T x \<xi> \<in> A \<bar> T x \<xi> > 0)) UNIV"
     using that pdfTx_nonneg apply (intro nn_integral_has_integral, simp_all)
     using set_nn_integral_pdfTx_PTx that by (simp add: nn_integral_set_ennreal)
   thus ?thesis
     by (smt (verit) has_integral_cong has_integral_restrict_UNIV
         indicator_eq_0_iff indicator_simps(1) mult_cancel_left2 mult_eq_0_iff)
 qed
 
 corollary pdfTx_has_integral_PTx_Icc:
   "(pdfT x has_integral \<P>(\<xi> in \<MM>. a \<le> T x \<xi> \<and> T x \<xi> \<le> b \<bar> T x \<xi> > 0)) {a..b}" for a b :: real
   using pdfTx_has_integral_PTx[of "{a..b}"] by simp
 
 corollary pdfTx_integrable_on_Icc: "pdfT x integrable_on {a..b}" for a b :: real
   using pdfTx_has_integral_PTx_Icc by auto
 
 end
 
 subsubsection \<open>Properties of Probability Density Function of X\<close>
 
 lemma pdfX_nonneg: "pdfX x \<ge> 0" for x::real
   using pdfTx_nonneg pdfT0_X psi_pos' by smt
 
 lemma pdfX_nonpos_0: "pdfX x = 0" if "x \<le> 0" for x::real
   using pdfTx_nonpos_0 pdfT0_X psi_pos' that by smt 
 
 lemma pdfX_beyond_0: "pdfX x = 0" if "x \<ge> $\<psi>" for x::real
   using pdfTx_beyond_0 pdfT0_X psi_pos' that by smt
 
 lemma nn_integral_pdfX_1: "integral\<^sup>N lborel pdfX = 1"
   using nn_integral_pdfTx_1 pdfT0_X psi_pos' by metis
 
 corollary has_bochner_integral_pdfX_1: "has_bochner_integral lborel pdfX 1"
   by (rule has_bochner_integral_nn_integral; simp add: pdfX_nonneg nn_integral_pdfX_1)
 
 corollary LBINT_pdfX_1: "LBINT s. pdfX s = 1"
   using has_bochner_integral_pdfX_1 by (simp add: has_bochner_integral_integral_eq)
 
 corollary pdfX_has_integral_1: "(pdfX has_integral 1) UNIV"
   by (rule nn_integral_has_integral; simp add: pdfX_nonneg nn_integral_pdfX_1)
 
 lemma set_nn_integral_pdfX_PX: "set_nn_integral lborel A pdfX = \<P>(\<xi> in \<MM>. X \<xi> \<in> A)"
   if "A \<in> sets lborel" for A :: "real set"
   using PT0_eq_PX_lborel that
   by (rewrite pdfT0_X[THEN sym], rewrite set_nn_integral_pdfTx_PTx; simp)
 
 lemma pdfX_set_integrable: "set_integrable lborel A pdfX" if "A \<in> sets lborel" for A :: "real set"
   using pdfTx_set_integrable pdfT0_X psi_pos' that by smt
 
 lemma set_integral_pdfX_PX: "LBINT s:A. pdfX s = \<P>(\<xi> in \<MM>. X \<xi> \<in> A)"
   if "A \<in> sets lborel" for A :: "real set"
   using PT0_eq_PX_lborel that by (rewrite pdfT0_X[THEN sym], rewrite set_integral_pdfTx_PTx; simp)
 
 lemma pdfX_has_integral_PX: "(pdfX has_integral \<P>(\<xi> in \<MM>. X \<xi> \<in> A)) A"
   if "A \<in> sets lborel" for A :: "real set"
   using that apply (rewrite pdfT0_X[THEN sym], rewrite PT0_eq_PX_lborel[THEN sym], simp)
   by (rule pdfTx_has_integral_PTx; simp)
 
 corollary pdfX_has_integral_PX_Icc: "(pdfX has_integral \<P>(\<xi> in \<MM>. a \<le> X \<xi> \<and> X \<xi> \<le> b)) {a..b}"
   for a b :: real
   using pdfX_has_integral_PX[of "{a..b}"] by simp
 
 corollary pdfX_integrable_on_Icc: "pdfX integrable_on {a..b}" for a b :: real
   using pdfX_has_integral_PX_Icc by auto
 
 subsubsection \<open>Relations between Life Expectation and Probability Density Function\<close>
 
 context
   fixes x::real
   assumes x_lt_psi[simp]: "x < $\<psi>"
 begin
 
 interpretation alivex_PS: prob_space "\<MM> \<downharpoonright> alive x"
   by (rule MM_PS.cond_prob_space_correct; simp add: alive_def)
 
 interpretation distrTx_RD: real_distribution "distr (\<MM> \<downharpoonright> alive x) borel (T x)" by simp
 
 proposition nn_integral_T_pdfT:
   "(\<integral>\<^sup>+\<xi>. ennreal (g (T x \<xi>)) \<partial>(\<MM> \<downharpoonright> alive x)) = \<integral>\<^sup>+s\<in>{0..}. ennreal (pdfT x s * g s) \<partial>lborel"
   if "g \<in> borel_measurable lborel" for g :: "real \<Rightarrow> real"
 proof -
   have "(\<integral>\<^sup>+\<xi>. ennreal (g (T x \<xi>)) \<partial>(\<MM> \<downharpoonright> alive x)) = \<integral>\<^sup>+s. ennreal (pdfT x s) * ennreal (g s) \<partial>lborel"
   proof -
     have "distributed (\<MM> \<downharpoonright> alive x) lborel (T x) (\<lambda>s. ennreal (pdfT x s))"
       by (intro distributed_pdfTx) simp
     moreover have "(\<lambda>s. ennreal (g s)) \<in> borel_measurable borel" using that by measurable
     ultimately show ?thesis by (rewrite distributed_nn_integral; simp)
   qed
   also have "\<dots> = \<integral>\<^sup>+s. ennreal (pdfT x s * g s) \<partial>lborel" using ennreal_mult' pdfTx_nonneg by force
   also have "\<dots> = \<integral>\<^sup>+s\<in>{0..}. ennreal (pdfT x s * g s) \<partial>lborel"
     apply (rule nn_integral_cong, simp)
     by (metis atLeast_iff ennreal_0 indicator_simps linorder_not_le mult_1 mult_commute_abs
         mult_zero_left pdfTx_neg_0 x_lt_psi)
   finally show ?thesis .
 qed
 
 lemma expectation_LBINT_pdfT_nonneg:
   "alivex_PS.expectation (\<lambda>\<xi>. g (T x \<xi>)) = LBINT s:{0..}. pdfT x s * g s"
   if "\<And>s. s \<ge> 0 \<Longrightarrow> g s \<ge> 0" "g \<in> borel_measurable lborel" for g :: "real \<Rightarrow> real"
   \<comment> \<open>Note that 0 = 0 holds when the integral diverges.\<close>
   using that apply (rewrite integral_eq_nn_integral, simp)
    apply (rule AE_I2, metis alivex_Tx_pos less_imp_le)
   unfolding set_lebesgue_integral_def apply (rewrite integral_eq_nn_integral, simp_all)
    apply (rule AE_I2,
       metis indicator_pos_le pdfTx_nonpos_0 x_lt_psi zero_le_mult_iff zero_le_square pdfTx_nonneg)
   by (rewrite nn_integral_T_pdfT) (simp_all add: indicator_mult_ennreal mult.commute)
 
 corollary expectation_integral_pdfT_nonneg:
   "alivex_PS.expectation (\<lambda>\<xi>. g (T x \<xi>)) = integral {0..} (\<lambda>s. pdfT x s * g s)"
   if "\<And>s. s \<ge> 0 \<Longrightarrow> g s \<ge> 0" "g \<in> borel_measurable lborel" for g :: "real \<Rightarrow> real"
   \<comment> \<open>Note that 0 = 0 holds when the integral diverges.\<close>
 proof -
   have "alivex_PS.expectation (\<lambda>\<xi>. g (T x \<xi>)) = LBINT s:{0..}. pdfT x s * g s"
     using expectation_LBINT_pdfT_nonneg that by simp
   also have "\<dots> = integral {0..} (\<lambda>s. pdfT x s * g s)"
     using that pdfTx_nonneg by (intro set_borel_integral_eq_integral_nonneg; simp)
   finally show ?thesis .
 qed
 
 proposition expectation_LBINT_pdfT:
   "alivex_PS.expectation (\<lambda>\<xi>. g (T x \<xi>)) = LBINT s:{0..}. pdfT x s * g s"
   if "set_integrable lborel {0..} (\<lambda>s. pdfT x s * g s)" "g \<in> borel_measurable lborel"
   for g :: "real \<Rightarrow> real"
 proof -
   have pg_fin: "(\<integral>\<^sup>+\<xi>. ennreal (g (T x \<xi>)) \<partial>(\<MM> \<downharpoonright> alive x)) \<noteq> \<infinity>"
     using that apply (rewrite nn_integral_T_pdfT, simp)
     using that unfolding set_integrable_def apply (rewrite in asm real_integrable_def, simp)
     by (simp add: indicator_mult_ennreal mult.commute)
   moreover have mg_fin: "(\<integral>\<^sup>+\<xi>. ennreal (- g (T x \<xi>)) \<partial>(\<MM> \<downharpoonright> alive x)) \<noteq> \<infinity>"
     using that apply (rewrite nn_integral_T_pdfT[of "\<lambda>s. - g s"], simp)
     using that unfolding set_integrable_def apply (rewrite in asm real_integrable_def, simp)
     by (simp add: indicator_mult_ennreal mult.commute)
   ultimately have [simp]: "integrable (\<MM> \<downharpoonright> alive x) (\<lambda>\<xi>. g (T x \<xi>))"
     using that by (rewrite real_integrable_def; simp)
   have "(\<integral>\<^sup>+s\<in>{0..}. ennreal (pdfT x s * max 0 (g s)) \<partial>lborel) = 
     (\<integral>\<^sup>+s\<in>{0..}. ennreal (pdfT x s * g s) \<partial>lborel)"
     using SPMF.ennreal_max_0 ennreal_mult' pdfTx_nonneg x_lt_psi by presburger
   also have "\<dots> < \<infinity>"
     using pg_fin nn_integral_T_pdfT that top.not_eq_extremum by auto
   finally have "(\<integral>\<^sup>+s\<in>{0..}. ennreal (pdfT x s * max 0 (g s)) \<partial>lborel) < \<infinity>" .
   hence [simp]: "set_integrable lborel {0..} (\<lambda>s. pdfT x s * max 0 (g s))"
     unfolding set_integrable_def using that apply (intro integrableI_nonneg, simp_all)
     using pdfTx_nonneg apply (intro AE_I2, force)
     by (metis (no_types, lifting) indicator_mult_ennreal mult.commute nn_integral_cong)
   have "(\<integral>\<^sup>+s\<in>{0..}. ennreal (pdfT x s * max 0 (- g s)) \<partial>lborel) =
     (\<integral>\<^sup>+s\<in>{0..}. ennreal (pdfT x s * - g s) \<partial>lborel)"
     using SPMF.ennreal_max_0 ennreal_mult' pdfTx_nonneg x_lt_psi by presburger
   also have "\<dots> < \<infinity>"
     using mg_fin nn_integral_T_pdfT[of "\<lambda>s. - g s"] that top.not_eq_extremum by force
   finally have "(\<integral>\<^sup>+s\<in>{0..}. ennreal (pdfT x s * max 0 (- g s)) \<partial>lborel) < \<infinity>" .
   hence [simp]: "set_integrable lborel {0..} (\<lambda>s. pdfT x s * max 0 (- g s))"
     unfolding set_integrable_def using that apply (intro integrableI_nonneg, simp_all)
     using pdfTx_nonneg apply (intro AE_I2, force)
     by (metis (no_types, lifting) indicator_mult_ennreal mult.commute nn_integral_cong)
   have "alivex_PS.expectation (\<lambda>\<xi>. g (T x \<xi>)) =
     alivex_PS.expectation (\<lambda>\<xi>. max 0 (g (T x \<xi>))) - alivex_PS.expectation (\<lambda>\<xi>. max 0 (- g (T x \<xi>)))"
     by (rewrite Bochner_Integration.integral_cong
         [where N="\<MM> \<downharpoonright> alive x" and g="\<lambda>\<xi>. max 0 (g (T x \<xi>)) - max 0 (- g (T x \<xi>))"]; simp)
   moreover have "alivex_PS.expectation (\<lambda>\<xi>. max 0 (g (T x \<xi>))) =
     (LBINT s:{0..}. pdfT x s * max 0 (g s))"
     using that by (rewrite expectation_LBINT_pdfT_nonneg[where g="\<lambda>s. max 0 (g s)"]) simp_all
   moreover have "alivex_PS.expectation (\<lambda>\<xi>. max 0 (- g (T x \<xi>))) =
     (LBINT s:{0..}. pdfT x s * max 0 (- g s))"
     using that by (rewrite expectation_LBINT_pdfT_nonneg[where g="\<lambda>s. max 0 (- g s)"]) simp_all
   ultimately have "alivex_PS.expectation (\<lambda>\<xi>. g (T x \<xi>)) =
     (LBINT s:{0..}. pdfT x s * max 0 (g s)) - (LBINT s:{0..}. pdfT x s *  max 0 (- g s))" by simp
   also have "\<dots> = LBINT s:{0..}. (pdfT x s * max 0 (g s) - pdfT x s * max 0 (- g s))"
     by (rewrite set_integral_diff; simp)
   also have "\<dots> = LBINT s:{0..}. pdfT x s * (max 0 (g s) - max 0 (- g s))"
     by (simp add: right_diff_distrib)
   also have "\<dots> = LBINT s:{0..}. pdfT x s * g s"
     using minus_max_eq_min
     by (metis (no_types, opaque_lifting) diff_zero max_def min_def minus_diff_eq)
   finally show ?thesis .
 qed
 
 corollary expectation_integral_pdfT:
   "alivex_PS.expectation (\<lambda>\<xi>. g (T x \<xi>)) = integral {0..} (\<lambda>s. pdfT x s * g s)"
   if "(\<lambda>s. pdfT x s * g s) absolutely_integrable_on {0..}" "g \<in> borel_measurable lborel"
   for g :: "real \<Rightarrow> real"
 proof -
   have [simp]: "set_integrable lborel {0..} (\<lambda>s. pdfT x s * g s)"
     using that by (rewrite absolutely_integrable_on_iff_set_integrable; simp)
   show ?thesis
     apply (rewrite set_borel_integral_eq_integral(2)[THEN sym], simp)
     using that by (rewrite expectation_LBINT_pdfT; simp)
 qed
 
 corollary e_LBINT_pdfT: "$e`\<circ>_x = LBINT s:{0..}. pdfT x s * s"
   \<comment> \<open>Note that 0 = 0 holds when the life expectation diverges.\<close>
   unfolding life_expect_def using expectation_LBINT_pdfT_nonneg by force
 
 corollary e_integral_pdfT: "$e`\<circ>_x = integral {0..} (\<lambda>s. pdfT x s * s)"
   \<comment> \<open>Note that 0 = 0 holds when the life expectation diverges.\<close>
   unfolding life_expect_def using expectation_integral_pdfT_nonneg by force
 
 end
 
 corollary e_LBINT_pdfX: "$e`\<circ>_0 = (LBINT x:{0..}. pdfX x * x)"
   \<comment> \<open>Note that 0 = 0 holds when the life expectation diverges.\<close>
   using e_LBINT_pdfT pdfT0_X psi_pos' by presburger
 
 corollary e_integral_pdfX: "$e`\<circ>_0 = integral {0..} (\<lambda>x. pdfX x * x)"
   \<comment> \<open>Note that 0 = 0 holds when the life expectation diverges.\<close>
   using e_integral_pdfT pdfT0_X psi_pos' by presburger
 
 subsubsection \<open>Introduction of Force of Mortality\<close>
 
 definition force_mortal :: "real \<Rightarrow> real" ("$\<mu>'__" [101] 200)
   where "$\<mu>_x \<equiv> MM_PS.hazard_rate X x"
 
 lemma mu_pdfX: "$\<mu>_x = pdfX x / ccdf (distr \<MM> borel X) x"
   if "(cdf (distr \<MM> borel X)) differentiable at x" for x::real
   unfolding force_mortal_def pdfX_def
   by (rewrite MM_PS.hazard_rate_deriv_cdf, simp_all add: that)
 
 lemma mu_unborn_0: "$\<mu>_x = 0" if "x < 0" for x::real
   apply (rewrite mu_pdfX)
   using cdfX_has_real_derivative_0_unborn real_differentiable_def that apply blast
   using pdfX_nonpos_0 that by auto
 
 lemma mu_beyond_0: "$\<mu>_x = 0" if "x \<ge> $\<psi>" for x::real
   \<comment> \<open>Note that division by 0 is defined as 0 in Isabelle/HOL.\<close>
   unfolding force_mortal_def using MM_PS.hazard_rate_0_ccdf_0 ccdfX_0_equiv that by simp
 
 lemma mu_nonneg_differentiable: "$\<mu>_x \<ge> 0"
   if "(cdf (distr \<MM> borel X)) differentiable at x" for x::real
   apply (rewrite mu_pdfX, simp add: that)
   using pdfX_nonneg distrX_RD.ccdf_nonneg by simp
 
 lemma mu_nonneg_AE: "AE x in lborel. $\<mu>_x \<ge> 0"
   using cdfX_differentiable_AE mu_nonneg_differentiable by auto
 
 lemma mu_measurable[measurable]: "(\<lambda>x. $\<mu>_x) \<in> borel_measurable borel"
 proof -
   obtain S where
     "finite S" and "\<And>x. x \<notin> S \<Longrightarrow> (cdf (distr \<MM> borel X)) differentiable at x"
     using cdfX_piecewise_differentiable unfolding piecewise_differentiable_on_def by blast
   thus ?thesis
     apply (rewrite measurable_discrete_difference
         [where f="\<lambda>x. pdfX x / ccdf (distr \<MM> borel X) x" and X=S], simp_all)
     by (simp_all add: MM_PS.ccdf_distr_measurable borel_measurable_divide countable_finite mu_pdfX)
 qed
 
 lemma mu_deriv_ccdf: "$\<mu>_x = - deriv (ccdf (distr \<MM> borel X)) x / ccdf (distr \<MM> borel X) x"
   if "(ccdf (distr \<MM> borel X)) differentiable at x" "x < $\<psi>" for x::real
   unfolding force_mortal_def
   by (rewrite MM_PS.hazard_rate_deriv_ccdf; simp add: that)
 
 lemma mu_deriv_ln: "$\<mu>_x = - deriv (\<lambda>x. ln (ccdf (distr \<MM> borel X) x)) x"
   if "(ccdf (distr \<MM> borel X)) differentiable at x" "x < $\<psi>" for x::real
   unfolding force_mortal_def
   apply (rewrite MM_PS.hazard_rate_deriv_ln_ccdf, simp_all add: that)
   using ccdfX_0_equiv that by force
 
 lemma p_exp_integral_mu: "$p_{t&x} = exp (- integral {x..x+t} (\<lambda>y. $\<mu>_y))"
   if "x \<ge> 0" "t \<ge> 0" "x+t < $\<psi>"
 proof -
   have [simp]: "x < $\<psi>" using that by (meson add_increasing2 ereal_less linorder_not_le)
   have "$p_{t&x} = (ccdf (distr \<MM> borel X) (x+t)) / (ccdf (distr \<MM> borel X) x)"
     apply (rewrite p_PX, simp_all add: that)
     by (rewrite MM_PS.ccdf_distr_P, simp)+ simp
   also have "\<dots> = exp (- integral {x..x+t} (MM_PS.hazard_rate X))"
     apply (rule MM_PS.ccdf_exp_cumulative_hazard, simp_all add: that)
     using ccdfX_piecewise_differentiable piecewise_differentiable_on_subset apply blast
     using ccdfX_continuous continuous_on_subset apply blast
     using ccdfX_0_equiv that ereal_less_le linorder_not_le by force
   also have "\<dots> = exp (- integral {x..x+t} (\<lambda>y. $\<mu>_y))" unfolding force_mortal_def by simp
   finally show ?thesis .
 qed
 
 corollary ccdfX_exp_integral_mu: "ccdf (distr \<MM> borel X) x = exp (- integral {0..x} (\<lambda>y. $\<mu>_y))"
   if "0 \<le> x \<and> x < $\<psi>" for x::real
   by (rewrite p_exp_integral_mu[where t=x and x=0, simplified, THEN sym]; simp add: that ccdfX_p)
 
 subsubsection \<open>Properties of Force of Mortality\<close>
 
 context
   fixes x::real
   assumes x_lt_psi[simp]: "x < $\<psi>"
 begin
 
 interpretation alivex_PS: prob_space "\<MM> \<downharpoonright> alive x"
   by (rule MM_PS.cond_prob_space_correct; simp add: alive_def)
 
 interpretation distrTx_RD: real_distribution "distr (\<MM> \<downharpoonright> alive x) borel (T x)" by simp
 
 lemma hazard_rate_Tx_mu: "alivex_PS.hazard_rate (T x) t = $\<mu>_(x+t)"
   if "t \<ge> 0" "x+t < $\<psi>" for t::real
 proof -
   have [simp]: "\<P>(\<xi> in \<MM>. X \<xi> > x) > 0" by force
   moreover have [simp]: "\<P>(\<xi> in \<MM>. X \<xi> > x + t) > 0" using that by force
   moreover have [simp]: "{\<xi> \<in> space (\<MM> \<downharpoonright> alive x). X \<xi> > x + t} = {\<xi> \<in> space \<MM>. X \<xi> > x + t}"
     unfolding alive_def using that by (rewrite MM_PS.space_cond_prob_space, simp_all, force)
   hence [simp]: "{\<xi> \<in> space (\<MM> \<downharpoonright> alive x). X \<xi> > x + t} \<in> MM_PS.events" by simp
   ultimately have \<star>[simp]: "\<P>(\<xi> in (\<MM> \<downharpoonright> alive x). X \<xi> > x + t) > 0"
     unfolding alive_def
     apply (rewrite MM_PS.cond_prob_space_cond_prob[THEN sym], (simp_all add: pred_def)[3])
     unfolding cond_prob_def by (smt (verit) Collect_cong divide_pos_pos)
   have "alivex_PS.hazard_rate (T x) t =
     Lim (at_right 0) (\<lambda>dt. \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). t < T x \<xi> \<and> T x \<xi> \<le> t + dt \<bar> T x \<xi> > t) / dt)"
     unfolding alivex_PS.hazard_rate_def by simp
   also have "\<dots> = Lim (at_right 0)
     (\<lambda>dt. \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). x + t < X \<xi> \<and> X \<xi> \<le> x + t + dt \<bar> X \<xi> > x + t) / dt)"
     apply (rule Lim_cong, rule eventually_at_rightI[of 0 1], simp_all)
     unfolding futr_life_def cond_prob_def using Collect_cong by smt
   also have "\<dots> =
     Lim (at_right 0) (\<lambda>dt. \<P>(\<xi> in \<MM>. x + t < X \<xi> \<and> X \<xi> \<le> x + t + dt \<bar> X \<xi> > x + t) / dt)"
   proof -
     have "\<And>dt. \<P>(\<xi> in (\<MM> \<downharpoonright> alive x). x + t < X \<xi> \<and> X \<xi> \<le> x + t + dt \<bar> X \<xi> > x + t) =
       \<P>(\<xi> in \<MM>. x + t < X \<xi> \<and> X \<xi> \<le> x + t + dt \<bar> X \<xi> > x + t)"
     proof -
       fix dt
       let ?rngX = "\<lambda>\<xi>. x + t < X \<xi> \<and> X \<xi> \<le> x + t + dt"
       have "\<P>(\<xi> in (\<MM> \<downharpoonright> alive x). ?rngX \<xi> \<bar> X \<xi> > x + t) =
         \<P>(\<xi> in ((\<MM> \<downharpoonright> alive x) \<downharpoonright> {\<eta> \<in> space (\<MM> \<downharpoonright> alive x). X \<eta> > x + t}). ?rngX \<xi>)"
         using \<star> by (rewrite alivex_PS.cond_prob_space_cond_prob) simp_all
       also have "\<dots> = \<P>(\<xi> in (\<MM> \<downharpoonright> {\<eta> \<in> space \<MM>. X \<eta> > x + t}). ?rngX \<xi>)"
       proof -
         have "(\<MM> \<downharpoonright> alive x) \<downharpoonright> {\<eta> \<in> space (\<MM> \<downharpoonright> alive x). X \<eta> > x + t} =
           \<MM> \<downharpoonright> {\<eta> \<in> space (\<MM> \<downharpoonright> alive x). X \<eta> > x + t}"
           apply (rewrite MM_PS.cond_cond_prob_space, simp_all)
           unfolding alive_def using that by force
         also have "\<dots> = \<MM> \<downharpoonright> {\<eta> \<in> space \<MM>. X \<eta> > x + t}" by simp
         finally have "(\<MM> \<downharpoonright> alive x) \<downharpoonright> {\<eta> \<in> space (\<MM> \<downharpoonright> alive x). X \<eta> > x + t} =
           \<MM> \<downharpoonright> {\<eta> \<in> space \<MM>. X \<eta> > x + t}" .
         thus ?thesis by simp
       qed
       also have "\<dots> = \<P>(\<xi> in \<MM>. x + t < X \<xi> \<and> X \<xi> \<le> x + t + dt \<bar> X \<xi> > x + t)"
         by (rewrite MM_PS.cond_prob_space_cond_prob, simp_all add: pred_def sets.sets_Collect_conj)
       finally show "\<P>(\<xi> in (\<MM> \<downharpoonright> alive x). ?rngX \<xi> \<bar> X \<xi> > x + t) =
         \<P>(\<xi> in \<MM>. x + t < X \<xi> \<and> X \<xi> \<le> x + t + dt \<bar> X \<xi> > x + t)" .
     qed
     thus ?thesis
       apply -
       by (rule Lim_cong, rule eventually_at_rightI[of 0 1]; simp)
   qed
   also have "\<dots> = $\<mu>_(x+t)" unfolding force_mortal_def MM_PS.hazard_rate_def by simp
   finally show ?thesis .
 qed
 
 lemma pdfTx_p_mu: "pdfT x t = $p_{t&x} * $\<mu>_(x+t)"
   if "(cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) differentiable at t" "t > 0" for t::real
 proof (cases \<open>x+t < $\<psi>\<close>)
   case True
   hence [simp]: "t \<ge> 0" and "(ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) t \<noteq> 0" 
     using that p_0_equiv unfolding survive_def by auto
   have "deriv (cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))) t =
     ccdf (distr (\<MM> \<downharpoonright> alive x) borel (T x)) t * alivex_PS.hazard_rate (T x) t"
     by (rule alivex_PS.deriv_cdf_hazard_rate; simp add: that)
   thus ?thesis unfolding survive_def pdfT_def using hazard_rate_Tx_mu True that by simp
 next
   case False
   hence "x+t \<ge> $\<psi>" by simp
   thus ?thesis using pdfTx_beyond_0 mu_beyond_0 by simp
 qed
 
 lemma deriv_t_p_mu: "deriv (\<lambda>s. $p_{s&x}) t = - $p_{t&x} * $\<mu>_(x+t)"
   if "(\<lambda>s. $p_{s&x}) differentiable at t" "t > 0" for t::real
 proof -
   let ?cdfTx = "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))"
   have diff: "?cdfTx differentiable at t"
     using that distrTx_RD.differentiable_cdf_ccdf unfolding survive_def by blast
   hence "deriv ?cdfTx t = $p_{t&x} * $\<mu>_(x+t)" using that pdfTx_p_mu pdfT_def by simp
   moreover have "deriv ?cdfTx t = - deriv (\<lambda>s. $p_{s&x}) t"
     using that diff distrTx_RD.deriv_cdf_ccdf unfolding survive_def by presburger
   ultimately show ?thesis by simp
 qed
 
 lemma pdfTx_p_mu_AE: "AE s in lborel. s > 0 \<longrightarrow> pdfT x s = $p_{s&x} * $\<mu>_(x+s)"
 proof -
   let ?cdfX = "cdf (distr \<MM> borel X)"
   let ?cdfTx = "cdf (distr (\<MM> \<downharpoonright> alive x) borel (T x))"
   from cdfX_differentiable_AE obtain N
     where diff: "\<And>r. r \<in> space lborel - N \<Longrightarrow> ?cdfX differentiable at r"
       and null: "N \<in> null_sets lborel"
     using AE_E3 by blast
   let ?N' = "{s. x+s \<in> N}"
   have "?N' \<in> null_sets lborel"
     using null_sets_translation[of N "-x", simplified] null by (simp add: add.commute)
   moreover have "{s \<in> space lborel. \<not> (s > 0 \<longrightarrow> pdfT x s = $p_{s&x} * $\<mu>_(x+s))} \<subseteq> ?N'"
   proof (rewrite Compl_subset_Compl_iff[THEN sym], safe)
     fix s::real
     assume "s \<in> space lborel" and "x+s \<notin> N" and "s > 0"
     thus "pdfT x s = $p_{s&x} * $\<mu>_(x+s)"
       apply (intro pdfTx_p_mu, simp_all)
       by (rewrite differentiable_cdfX_cdfTx[THEN sym]; simp add: diff)
   qed
   ultimately show ?thesis using AE_I'[of ?N'] by simp
 qed
 
 lemma LBINT_p_mu_q: "LBINT s:{f<..f+t}. $p_{s&x} * $\<mu>_(x+s) = $q_{f\<bar>t&x}"
   if "t \<ge> 0" "f \<ge> 0" for t f :: real
 proof -
   have "LBINT s:{f<..f+t}. $p_{s&x} * $\<mu>_(x+s) = LBINT s:{f<..f+t}. pdfT x s"
     apply (rule set_lebesgue_integral_cong_AE; simp)
      apply (simp add: survive_def)
     using pdfTx_p_mu_AE apply (rule AE_mp)
     using that by (intro always_eventually; simp add: ereal_less_le)
   also have "\<dots> = enn2real (\<integral>\<^sup>+s\<in>{f<..f+t}. ennreal (pdfT x s) \<partial>lborel)"
   proof -
     have "\<integral>\<^sup>+s\<in>{f<..f+t}. ennreal (pdfT x s) \<partial>lborel < \<top>"
     proof -
       have "\<integral>\<^sup>+s\<in>{f<..f+t}. ennreal (pdfT x s) \<partial>lborel \<le> \<integral>\<^sup>+s. ennreal (pdfT x s) \<partial>lborel"
         by (smt (verit) indicator_simps le_zero_eq linorder_le_cases
             mult.right_neutral mult_zero_right nn_integral_mono)
       also have "\<dots> < \<top>" using nn_integral_pdfTx_1 by simp
       finally show ?thesis .
     qed
     thus ?thesis
       unfolding set_lebesgue_integral_def
       by (rewrite enn2real_nn_integral_eq_integral[where g="\<lambda>s. pdfT x s * indicator {f<..f+t} s"])
         (simp_all add: pdfTx_nonneg mult.commute ennreal_indicator ennreal_mult')
   qed
   also have "\<dots> = measure (density lborel (pdfT x)) {f<..f+t}"
     unfolding measure_def by (rewrite emeasure_density; simp)
   also have "\<dots> = measure (distr (\<MM> \<downharpoonright> alive x) lborel (T x)) {f<..f+t}"
     using distributed_pdfTx unfolding distributed_def by simp
   also have "\<dots> =
     cdf (distr (\<MM> \<downharpoonright> alive x) lborel (T x)) (f+t) - cdf (distr (\<MM> \<downharpoonright> alive x) lborel (T x)) f"
     using that finite_borel_measure.cdf_diff_eq2
     by (smt (verit) distrTx_RD.finite_borel_measure_axioms distr_cong sets_lborel)
   also have "\<dots> = $q_{f\<bar>t&x}"
     using q_defer_q die_def that by (metis distr_cong sets_lborel x_lt_psi)
   finally show ?thesis .
 qed
 
 lemma set_integrable_p_mu: "set_integrable lborel {f<..f+t} (\<lambda>s. $p_{s&x} * $\<mu>_(x+s))"
   if "t \<ge> 0" "f \<ge> 0" for t f :: real
 proof -
   have "(\<lambda>s. $p_{s&x}) \<in> borel_measurable borel" unfolding survive_def by simp
   moreover have "AE s in lborel. f < s \<and> s \<le> f + t \<longrightarrow> $p_{s&x} * $\<mu>_(x+s) = pdfT x s"
     using pdfTx_p_mu_AE apply (rule AE_mp)
     using that by (intro always_eventually; simp add: ereal_less_le)
   moreover have "set_integrable lborel {f<..f+t} (pdfT x)" using pdfTx_set_integrable by simp
   ultimately show ?thesis by (rewrite set_integrable_cong_AE[where g="pdfT x"]; simp)
 qed
 
 lemma p_mu_has_integral_q_defer_Ioc:
   "((\<lambda>s. $p_{s&x} * $\<mu>_(x+s)) has_integral $q_{f\<bar>t&x}) {f<..f+t}"
   if "t \<ge> 0" "f \<ge> 0" for t f :: real
   apply (rewrite LBINT_p_mu_q[THEN sym], simp_all add: that)
   apply (rewrite set_borel_integral_eq_integral, simp add: set_integrable_p_mu that)
   by (rewrite has_integral_integral[THEN sym];
       simp add: set_borel_integral_eq_integral set_integrable_p_mu that)
 
 lemma p_mu_has_integral_q_defer_Icc:
   "((\<lambda>s. $p_{s&x} * $\<mu>_(x+s)) has_integral $q_{f\<bar>t&x}) {f..f+t}" if "t \<ge> 0" "f \<ge> 0" for t f :: real
 proof -
   have "negligible {f}" by simp
   hence [simp]: "negligible ({f..f+t} - {f<..f+t})"
     by (smt (verit) Diff_iff atLeastAtMost_iff greaterThanAtMost_iff insertI1
         negligible_sing negligible_subset subsetI)
   have [simp]: "negligible ({f<..f+t} - {f..f+t})" by (simp add: subset_eq)
   show ?thesis
     apply (rewrite has_integral_spike_set_eq[where T="{f<..f+t}"])
       apply (rule negligible_subset[of "{f..f+t} - {f<..f+t}"], simp, blast)
      apply (rule negligible_subset[of "{f<..f+t} - {f..f+t}"], simp, blast)
     using p_mu_has_integral_q_defer_Ioc that by simp
 qed
 
 corollary p_mu_has_integral_q_Icc:
   "((\<lambda>s. $p_{s&x} * $\<mu>_(x+s)) has_integral $q_{t&x}) {0..t}" if "t \<ge> 0" for t::real
   using p_mu_has_integral_q_defer_Icc[where f=0] that by simp
 
 corollary p_mu_integrable_on_Icc:
   "(\<lambda>s. $p_{s&x} * $\<mu>_(x+s)) integrable_on {0..t}" if "t \<ge> 0" for t::real
   using p_mu_has_integral_q_Icc that by auto
 
 lemma e_ennreal_p_mu: "(\<integral>\<^sup>+\<xi>. ennreal (T x \<xi>) \<partial>(\<MM> \<downharpoonright> alive x)) =
   \<integral>\<^sup>+s\<in>{0..}. ennreal ($p_{s&x} * $\<mu>_(x+s) * s) \<partial>lborel"
 proof -
   have [simp]: "sym_diff {0..} {0<..} = {0::real}" by force
   have "(\<integral>\<^sup>+\<xi>. ennreal (T x \<xi>) \<partial>(\<MM> \<downharpoonright> alive x)) = \<integral>\<^sup>+s\<in>{0..}. ennreal (pdfT x s * s) \<partial>lborel"
     by (rewrite nn_integral_T_pdfT[where g="\<lambda>s. s"]; simp)
   also have "\<dots> = \<integral>\<^sup>+s\<in>{0<..}. ennreal (pdfT x s * s) \<partial>lborel"
     by (rewrite nn_integral_null_delta; force)
   also have "\<dots> = \<integral>\<^sup>+s\<in>{0<..}. ennreal ($p_{s&x} * $\<mu>_(x+s) * s) \<partial>lborel"
     apply (rule nn_integral_cong_AE)
     using pdfTx_p_mu_AE apply (rule AE_mp, intro AE_I2) by force
   also have "\<dots> = \<integral>\<^sup>+s\<in>{0..}. ennreal ($p_{s&x} * $\<mu>_(x+s) * s) \<partial>lborel"
     by (rewrite nn_integral_null_delta[THEN sym]; force)
   finally show ?thesis .
 qed
 
 lemma e_LBINT_p_mu: "$e`\<circ>_x = LBINT s:{0..}. $p_{s&x} * $\<mu>_(x+s) * s"
   \<comment> \<open>Note that 0 = 0 holds when the life expectation diverges.\<close>
 proof -
   let ?f = "\<lambda>s. $p_{s&x} * $\<mu>_(x+s) * s"
   have [simp]: "(\<lambda>s. ?f s * indicat_real {0..} s) \<in> borel_measurable borel"
     by measurable (simp_all add: survive_def)
   hence [simp]: "(\<lambda>s. indicat_real {0..} s * ?f s) \<in> borel_measurable borel"
     by (meson measurable_cong mult.commute)
   have [simp]: "AE s in lborel. ?f s * indicat_real {0..} s \<ge> 0"
   proof -
     have "AE s in lborel. pdfT x s * s * indicat_real {0..} s \<ge> 0"
       using pdfTx_nonneg pdfTx_nonpos_0 x_lt_psi
       by (intro AE_I2) (smt (verit, del_insts) indicator_pos_le mult_eq_0_iff mult_nonneg_nonneg)
     thus ?thesis
       apply (rule AE_mp)
       using pdfTx_p_mu_AE apply (rule AE_mp)
       by (rule AE_I2) (metis atLeast_iff indicator_simps(2) mult_eq_0_iff order_le_less)
   qed
   hence [simp]: "AE s in lborel. indicat_real {0..} s * ?f s \<ge> 0"
     by (metis (no_types, lifting) AE_cong mult.commute)
   show ?thesis
   proof (cases \<open>integrable (\<MM> \<downharpoonright> alive x) (T x)\<close>)
     case True
     hence "ennreal ($e`\<circ>_x) = \<integral>\<^sup>+\<xi>. ennreal (T x \<xi>) \<partial>(\<MM> \<downharpoonright> alive x)"
       unfolding life_expect_def apply (rewrite nn_integral_eq_integral, simp_all)
       by (smt (verit) AE_I2 alivex_Tx_pos)
     also have "\<dots> = \<integral>\<^sup>+s. ennreal (?f s * indicat_real {0..} s) \<partial>lborel"
       by (simp add: nn_integral_set_ennreal e_ennreal_p_mu)
     also have "\<dots> = ennreal (LBINT s:{0..}. ?f s)"
     proof -
       have "integrable lborel (\<lambda>s. ?f s * indicat_real {0..} s)"
       proof -
         have "(\<integral>\<^sup>+s. ennreal (?f s * indicat_real {0..} s) \<partial>lborel) < \<infinity>"
           by (metis calculation ennreal_less_top infinity_ennreal_def)
         thus ?thesis by (intro integrableI_nonneg; simp)
       qed
       thus ?thesis
         unfolding set_lebesgue_integral_def
         by (rewrite nn_integral_eq_integral, simp_all) (meson mult.commute)
     qed
     finally have "ennreal ($e`\<circ>_x) = ennreal (LBINT s:{0..}. ?f s)" .
     moreover have "LBINT s:{0..}. ?f s \<ge> 0"
       unfolding set_lebesgue_integral_def by (rule integral_nonneg_AE) simp
     ultimately show ?thesis using e_nonneg by simp
   next
     case False
     hence "$e`\<circ>_x = 0" unfolding life_expect_def using not_integrable_integral_eq by force
     also have "\<dots> = LBINT s:{0..}. ?f s"
     proof -
       have "\<infinity> = \<integral>\<^sup>+\<xi>. ennreal (T x \<xi>) \<partial>(\<MM> \<downharpoonright> alive x)"
         using nn_integral_nonneg_infinite False
         by (smt (verit) AE_cong Tx_alivex_measurable alivex_PS.AE_prob_1 alivex_PS.prob_space
             alivex_Tx_pos nn_integral_cong)
       hence "0 = enn2real (\<integral>\<^sup>+s\<in>{0..}. ennreal (?f s) \<partial>lborel)" using e_ennreal_p_mu by simp
       also have "\<dots> = LBINT s:{0..}. ?f s"
         unfolding set_lebesgue_integral_def apply (rewrite integral_eq_nn_integral, simp_all)
         by (simp add: indicator_mult_ennreal mult.commute)
       finally show ?thesis by simp
     qed
     finally show ?thesis .
   qed
 qed
 
 lemma e_integral_p_mu: "$e`\<circ>_x = integral {0..} (\<lambda>s. $p_{s&x} * $\<mu>_(x+s) * s)"
   \<comment> \<open>Note that 0 = 0 holds when the life expectation diverges.\<close>
 proof -
   have "LBINT s:{0..}. $p_{s&x} * $\<mu>_(x+s) * s = integral {0..} (\<lambda>s. $p_{s&x} * $\<mu>_(x+s) * s)"
   proof -
     have "AE s in lborel. s \<ge> 0 \<longrightarrow> $p_{s&x} * $\<mu>_(x+s) * s \<ge> 0"
     proof -
       have "AE s in lborel. $\<mu>_(x+s) \<ge> 0" by (rule AE_translation, rule mu_nonneg_AE)
       with p_nonneg show ?thesis by force
     qed
     moreover have "(\<lambda>s. $p_{s&x} * $\<mu>_(x+s) * s) \<in> borel_measurable borel"
       unfolding survive_def by simp
     ultimately show ?thesis by (intro set_borel_integral_eq_integral_nonneg_AE; simp)
   qed
   thus ?thesis using e_LBINT_p_mu by simp
 qed
 
 end
 
 lemma p_has_real_derivative_x_ccdfX:
   "((\<lambda>y. $p_{t&y}) has_real_derivative
     ((deriv svl (x+t) * svl x - svl (x+t) * deriv svl x) / (svl x)\<^sup>2)) (at x)"
   if "svl \<equiv> ccdf (distr \<MM> borel X)" "svl differentiable at x" "svl differentiable at (x+t)"
     "t \<ge> 0" "x < $\<psi>" for x t :: real
 proof -
   have "open {y. svl differentiable at y}" using ccdfX_differentiable_open_set that by simp
   with that obtain e0 where e0_pos: "e0 > 0" and ball_e0: "ball x e0 \<subseteq> {y. svl differentiable at y}"
     using open_contains_ball by blast
   define e where "e \<equiv> if $\<psi> < \<infinity> then min e0 (real_of_ereal $\<psi> - x) else e0"
   have "e > 0 \<and> ball x e \<subseteq> {y. svl y \<noteq> 0 \<and> svl differentiable at y}"
   proof (cases \<open>$\<psi> < \<infinity>\<close>)
     case True
     hence "e > 0"
     proof -
       have "real_of_ereal $\<psi> - x > 0" using not_inftyI True that by force
       with e0_pos show ?thesis unfolding e_def using True by simp
     qed
     moreover have "ball x e \<subseteq> {y. svl y \<noteq> 0}"
     proof -
       have "e \<le> real_of_ereal $\<psi> - x" unfolding e_def using True by simp
       hence "ball x e \<subseteq> {..< real_of_ereal $\<psi>}" unfolding ball_def dist_real_def by force
       thus ?thesis using that ccdfX_0_equiv
         using True ereal_less_real_iff psi_nonneg by auto
     qed
     moreover have "ball x e \<subseteq> {y. svl differentiable at y}"
     proof -
       have "e \<le> e0" unfolding e_def using True by simp
       hence "ball x e \<subseteq> ball x e0" by force
       with ball_e0 show ?thesis by simp
     qed
     ultimately show ?thesis by blast
   next
     case False
     hence "ball x e \<subseteq> {y. svl y \<noteq> 0}" using ccdfX_0_equiv that by simp
     with False show ?thesis unfolding e_def using e0_pos ball_e0 by force
   qed
   hence e_pos: "e > 0" and ball_e: "ball x e \<subseteq> {y. svl y \<noteq> 0 \<and> svl differentiable at y}" by auto
   hence ball_svl: "\<And>y. y \<in> ball x e \<Longrightarrow> svl y \<noteq> 0 \<and> svl field_differentiable at y"
     using differentiable_eq_field_differentiable_real by blast
   hence "\<And>y. y \<in> ball x e \<Longrightarrow> $p_{t&y} = svl (y+t) / svl y"
     unfolding survive_def using that ccdfX_0_equiv by (rewrite ccdfTx_ccdfX, simp_all) force
   moreover from ball_svl have "((\<lambda>y. svl (y+t) / svl y) has_real_derivative
     ((deriv svl (x+t) * svl x - svl (x+t) * deriv svl x) / (svl x)\<^sup>2)) (at x)"
     apply (rewrite power2_eq_square)
     apply (rule DERIV_divide)
     using DERIV_deriv_iff_real_differentiable DERIV_shift that apply blast
     using that DERIV_deriv_iff_real_differentiable apply simp
     by (simp add: e_pos)
   ultimately show ?thesis
     using e_pos
     apply (rewrite has_field_derivative_cong_eventually[where g="\<lambda>y. svl (y+t) / svl y"], simp_all)
     by (smt (verit) dist_commute eventually_at)
 qed
 
 lemma p_has_real_derivative_x_p_mu:
   "((\<lambda>y. $p_{t&y}) has_real_derivative $p_{t&x} * ($\<mu>_x - $\<mu>_(x+t))) (at x)"
   if "ccdf (distr \<MM> borel X) differentiable at x" "ccdf (distr \<MM> borel X) differentiable at (x+t)"
     "t \<ge> 0" "x < $\<psi>" for x t :: real
 proof (cases \<open>x+t < $\<psi>\<close>)
   case True
   let ?svl = "ccdf (distr \<MM> borel X)"
   have [simp]: "?svl x \<noteq> 0" using that ccdfX_0_equiv by (smt (verit) le_ereal_le linorder_not_le)
   have [simp]: "?svl field_differentiable at (x+t)"
     using that differentiable_eq_field_differentiable_real by simp
   have "((\<lambda>y. $p_{t&y}) has_real_derivative
     ((deriv ?svl (x+t) * ?svl x - ?svl (x+t) * deriv ?svl x) / (?svl x)\<^sup>2)) (at x)"
     using p_has_real_derivative_x_ccdfX that by simp
   moreover have "(deriv ?svl (x+t) * ?svl x - ?svl (x+t) * deriv ?svl x) / (?svl x)\<^sup>2 =
     $p_{t&x} * ($\<mu>_x - $\<mu>_(x+t))" (is "?LHS = ?RHS")
   proof -
     have "deriv ?svl (x+t) = deriv (\<lambda>y. ?svl (y+t)) x"
       using that by (metis DERIV_deriv_iff_real_differentiable DERIV_imp_deriv DERIV_shift)
     hence "?LHS = (deriv (\<lambda>y. ?svl (y+t)) x * ?svl x - ?svl (x+t) * deriv ?svl x) / (?svl x)\<^sup>2"
       by simp
     also have "\<dots> = (deriv (\<lambda>y. ?svl (y+t)) x - ?svl (x+t) * deriv ?svl x / ?svl x) / ?svl x"
       by (simp add: add_divide_eq_if_simps(4) power2_eq_square)
     also have "\<dots> = (- ?svl (x+t) * $\<mu>_(x+t) + ?svl (x+t) * $\<mu>_x) / ?svl x"
     proof -
       have "deriv (\<lambda>y. ?svl (y+t)) x = - ?svl (x+t) * $\<mu>_(x+t)"
         apply (rewrite add.commute, rewrite deriv_shift[THEN sym], rewrite add.commute, simp)
         using add.commute that by (metis MM_PS.deriv_ccdf_hazard_rate X_RV force_mortal_def)
       moreover have "- ?svl (x+t) * deriv ?svl x / ?svl x = ?svl (x+t) * $\<mu>_x"
         using that by (simp add: MM_PS.deriv_ccdf_hazard_rate force_mortal_def)
       ultimately show ?thesis by simp
     qed
     also have "\<dots> = ?svl (x+t) * ($\<mu>_x - $\<mu>_(x+t)) / ?svl x" by (simp add: mult_diff_mult)
     also have "\<dots> = ?RHS" unfolding survive_def using ccdfTx_ccdfX that by simp
     ultimately show ?thesis by simp
   qed
   ultimately show ?thesis by simp
 next
   case False
   hence ptx_0: "$p_{t&x} = 0" using p_0_equiv that by simp
   moreover have "((\<lambda>y. $p_{t&y}) has_real_derivative 0) (at x)"
   proof -
     have "\<And>y. x < y \<Longrightarrow> y < $\<psi> \<Longrightarrow> $p_{t&y} = 0"
       using False p_0_equiv that by (smt (verit, ccfv_SIG) ereal_less_le linorder_not_le)
     hence "\<forall>\<^sub>F x in at_right x. $p_{t&x} = 0"
       apply (rewrite eventually_at_right_field)
       using that by (meson ereal_dense2 ereal_le_less less_eq_ereal_def less_ereal.simps)
     hence "((\<lambda>y. $p_{t&y}) has_real_derivative 0) (at_right x)"
       using ptx_0 by (rewrite has_field_derivative_cong_eventually[where g="\<lambda>_. 0"]; simp)
     thus ?thesis
       using vector_derivative_unique_within p_has_real_derivative_x_ccdfX that
       by (metis has_field_derivative_at_within has_real_derivative_iff_has_vector_derivative
           trivial_limit_at_right_real)
   qed
   ultimately show ?thesis by simp
 qed
 
 corollary deriv_x_p_mu: "deriv (\<lambda>y. $p_{t&y}) x = $p_{t&x} * ($\<mu>_x - $\<mu>_(x+t))"
   if "ccdf (distr \<MM> borel X) differentiable at x" "ccdf (distr \<MM> borel X) differentiable at (x+t)"
     "t \<ge> 0" "x < $\<psi>" for x t :: real
   using that p_has_real_derivative_x_p_mu DERIV_imp_deriv by blast
 
 lemma e_has_derivative_mu_e: "((\<lambda>x. $e`\<circ>_x) has_real_derivative ($\<mu>_x * $e`\<circ>_x - 1)) (at x)"
   if "\<And>x. x\<in>{a<..<b} \<Longrightarrow> set_integrable lborel {x..} (ccdf (distr \<MM> borel X))"
     "ccdf (distr \<MM> borel X) differentiable at x" "x\<in>{a<..<b}" "b \<le> $\<psi>"
   for a b x :: real
 proof -
   let ?svl = "ccdf (distr \<MM> borel X)"
   have x_lt_psi[simp]: "x < $\<psi>" using that ereal_le_less by simp
   hence svlx_neq0[simp]: "?svl x \<noteq> 0" by (simp add: ccdfX_0_equiv linorder_not_le)
   define d ::real where "d \<equiv> min (b-x) (x-a)"
   have d_pos: "d > 0" unfolding d_def using that ereal_less_real_iff by force
   have e_svl: "\<And>y. y < $\<psi> \<Longrightarrow> $e`\<circ>_y = (LBINT t:{0..}. ?svl (y+t)) / ?svl y"
     apply (rewrite e_LBINT_p, simp)
     apply (rewrite set_integral_divide_zero[THEN sym])
     apply (rule set_lebesgue_integral_cong, simp_all)
     unfolding survive_def using ccdfTx_ccdfX by force
   have "((\<lambda>y. LBINT t:{0..}. ?svl (y+t)) has_real_derivative (- ?svl x)) (at x)"
   proof -
     { fix y assume "dist y x < d"
       hence y_ab: "y \<in> {a<..<b}" unfolding d_def dist_real_def by force
       hence "set_integrable lborel {y..} ?svl" using that by simp
       hence "set_integrable lborel (einterval y \<infinity>) ?svl"
         by (rewrite set_integrable_discrete_difference[where X="{y}"]; simp) force
       moreover have "\<And>u. ((\<lambda>u. u-y) has_real_derivative (1-0)) (at u)"
         by (rule derivative_intros) auto
       moreover have "\<And>u. y < u \<Longrightarrow> isCont (\<lambda>t. ?svl (y+t)) (u-y)"
         apply (rewrite add.commute, rewrite isCont_shift, simp)
         using ccdfX_continuous continuous_on_eq_continuous_within by blast
       moreover have "((ereal \<circ> (\<lambda>u. u-y) \<circ> real_of_ereal) \<longlongrightarrow> 0) (at_right (ereal y))"
         by (smt (verit, ccfv_SIG) LIM_zero Lim_cong_within ereal_tendsto_simps1(2)
             ereal_tendsto_simps2(1) tendsto_ident_at zero_ereal_def)
       moreover have "((ereal \<circ> (\<lambda>u. u-y) \<circ> real_of_ereal) \<longlongrightarrow> \<infinity>) (at_left \<infinity>)"
       proof -
         have "\<And>r u. r+y+1 \<le> u \<Longrightarrow> r < u-y" by auto
         hence "\<And>r. \<forall>\<^sub>F u in at_top. r < u - y" by (rule eventually_at_top_linorderI)
         thus ?thesis by (rewrite ereal_tendsto_simps, rewrite tendsto_PInfty) simp
       qed
       ultimately have "(LBINT t=0..\<infinity>. ?svl (y+t)) = (LBINT u=y..\<infinity>. ?svl (y+(u-y)) * 1)"
         using distrX_RD.ccdf_nonneg by (intro interval_integral_substitution_nonneg(2); simp)
       moreover have "(LBINT t:{0..}. ?svl (y+t)) = (LBINT t=0..\<infinity>. ?svl (y+t))"
         unfolding interval_lebesgue_integral_def einterval_def apply simp
         by (rule set_integral_discrete_difference[where X="{0}"]; force)
       moreover have "(LBINT u=y..\<infinity>. ?svl (y+(u-y))*1) = (LBINT u:{y..}. ?svl u)"
         unfolding interval_lebesgue_integral_def einterval_def apply simp
         by (rule set_integral_discrete_difference[where X="{y}"]; force)
       ultimately have "(LBINT t:{0..}. ?svl (y+t)) = (LBINT u:{y..}. ?svl u)" by simp }
     hence "\<forall>\<^sub>F y in nhds x. LBINT t:{0..}. ?svl (y+t) = LBINT u:{y..}. ?svl u"
       using d_pos by (rewrite eventually_nhds_metric) auto
     moreover have "((\<lambda>y. LBINT u:{y..}. ?svl u) has_real_derivative (- ?svl x)) (at x)"
     proof -
       have "((\<lambda>y. integral {y..b} ?svl) has_real_derivative (- ?svl x)) (at x within {a..b})"
         using that apply (intro integral_has_real_derivative'; simp)
         using ccdfX_continuous continuous_on_subset by blast
       hence "((\<lambda>y. integral {y..b} ?svl) has_real_derivative (- ?svl x)) (at x)"
         using that apply (rewrite at_within_open[where S="{a<..<b}", THEN sym], simp_all)
         by (rule DERIV_subset[where s="{a..b}"]) auto
       moreover have "\<forall>\<^sub>F y in nhds x. LBINT u:{y..b}. ?svl u = integral {y..b} ?svl"
         apply (rewrite eventually_nhds_metric)
         using d_pos by (metis ccdfX_integrable_Icc set_borel_integral_eq_integral(2))
       ultimately have "((\<lambda>y. LBINT u:{y..b}. ?svl u) has_real_derivative (- ?svl x)) (at x)"
         by (rewrite DERIV_cong_ev; simp)
       hence "((\<lambda>y. (LBINT u:{y..b}. ?svl u) + (LBINT u:{b<..}. ?svl u)) has_real_derivative
         (- ?svl x)) (at x)"
         by (rewrite to "- ?svl x + 0" add_0_right[THEN sym], rule DERIV_add; simp)
       moreover have "\<forall>\<^sub>F y in nhds x.
         LBINT u:{y..}. ?svl u = (LBINT u:{y..b}. ?svl u) + (LBINT u:{b<..}. ?svl u)"
       proof -
         { fix y assume "dist y x < d"
           hence y_ab: "y \<in> {a<..<b}" unfolding d_def dist_real_def by force
           hence "set_integrable lborel {y..} ?svl" using that by simp
           hence "set_integrable lborel {y..b} ?svl" "set_integrable lborel {b<..} ?svl"
             apply (rule set_integrable_subset, simp_all)+
             using y_ab by force
           moreover have "{y..b} \<inter> {b<..} = {}" "{y..} = {y..b} \<union> {b<..}" using y_ab by force+
           ultimately have "LBINT u:{y..}. ?svl u = (LBINT u:{y..b}. ?svl u) + (LBINT u:{b<..}. ?svl u)"
             using set_integral_Un by simp }
         thus ?thesis using d_pos by (rewrite eventually_nhds_metric) blast
       qed
       ultimately show ?thesis by (rewrite has_field_derivative_cong_ev; simp)
     qed
     ultimately show ?thesis by (rewrite DERIV_cong_ev; simp)
   qed
   moreover have "(?svl has_real_derivative (deriv ?svl x)) (at x)"
     using that DERIV_deriv_iff_real_differentiable by blast
   ultimately have "((\<lambda>y. (LBINT t:{0..}. ?svl (y+t)) / ?svl y) has_real_derivative
     ((- ?svl x) * ?svl x - (LBINT t:{0..}. ?svl (x+t)) * deriv ?svl x) / (?svl x * ?svl x)) (at x)"
     by (rule DERIV_divide) simp
   moreover have "eventually (\<lambda>y. (LBINT t:{0..}. ?svl (y+t)) / ?svl y = $e`\<circ>_y) (at x)"
   proof -
     { fix y assume "dist y x < d" "y \<noteq> x"
       hence "y < $\<psi>"
         unfolding dist_real_def d_def using that ereal_le_less by fastforce
       hence "$e`\<circ>_y = (LBINT t:{0..}. ?svl (y+t)) / ?svl y" by (rule e_svl) }
     thus ?thesis
       apply (rewrite eventually_at_filter, rewrite eventually_nhds_metric)
       using d_pos that by metis
   qed
   ultimately have "((\<lambda>y. $e`\<circ>_y) has_real_derivative
     ((- ?svl x) * ?svl x - (LBINT t:{0..}. ?svl (x+t)) * deriv ?svl x) / (?svl x * ?svl x)) (at x)"
     using e_svl by (rewrite has_field_derivative_cong_eventually[THEN sym]; simp)
   moreover have
     "((- ?svl x) * ?svl x - (LBINT t:{0..}. ?svl (x+t)) * deriv ?svl x) / (?svl x * ?svl x) =
       $\<mu>_x * $e`\<circ>_x - 1" (is "?LHS = ?RHS")
   proof -
     have "?LHS = -1 + (LBINT t:{0..}. ?svl (x+t)) / ?svl x * (- deriv ?svl x / ?svl x)"
       by simp (smt (verit) svlx_neq0 add_divide_distrib divide_eq_minus_1_iff
           mult_minus_left real_divide_square_eq)
     also have "\<dots> = -1 + $e`\<circ>_x * $\<mu>_x" using e_svl mu_deriv_ccdf that by force
     also have "\<dots> = ?RHS" by simp
     finally show ?thesis .
   qed
   ultimately show ?thesis by simp
 qed
 
 corollary e_has_derivative_mu_e': "((\<lambda>x. $e`\<circ>_x) has_real_derivative ($\<mu>_x * $e`\<circ>_x - 1)) (at x)"
   if "\<And>x. x\<in>{a<..<b} \<Longrightarrow> ccdf (distr \<MM> borel X) integrable_on {x..}"
     "ccdf (distr \<MM> borel X) differentiable at x" "x\<in>{a<..<b}" "b \<le> $\<psi>"
   for a b x :: real
   using that apply (intro e_has_derivative_mu_e[where a=a], simp_all)
   using distrX_RD.ccdf_nonneg by (rewrite integrable_on_iff_set_integrable_nonneg; simp)
 
 subsubsection \<open>Properties of Curtate Life Expectation\<close>
 
 context
   fixes x::real
   assumes x_lt_psi[simp]: "x < $\<psi>"
 begin
 
 lemma isCont_p_nat: "isCont (\<lambda>t. $p_{t&x}) (k + (1::real))" for k::nat
 proof -
   fix k::nat
   have "continuous_on {0<..} (\<lambda>t. $p_{t&x})"
     unfolding survive_def
     using ccdfTx_continuous_on_nonneg continuous_on_subset Ioi_le_Ico x_lt_psi by blast
   hence "\<forall>t\<in>{0<..}. isCont (\<lambda>t. $p_{t&x}) t"
     using continuous_on_eq_continuous_at open_greaterThan by blast
   thus "isCont (\<lambda>t. $p_{t&x}) (real k+1)" by force
 qed
 
 lemma curt_e_sum_p_smooth: "$e_x = (\<Sum>k. $p_{k+1&x})" if "summable (\<lambda>k. $p_{k+1&x})"
   using curt_e_sum_p isCont_p_nat that by simp
 
 lemma curt_e_rec_smooth: "$e_x = $p_x * (1 + $e_(x+1))" if "summable (\<lambda>k. $p_{k+1&x})" "x+1 < $\<psi>"
   using curt_e_rec isCont_p_nat that by simp
 
 lemma curt_e_sum_p_finite_smooth: "$e_x = (\<Sum>k<n. $p_{k+1&x})" if "x+n+1 > $\<psi>" for n::nat
   using curt_e_sum_p_finite isCont_p_nat that by simp
 
 lemma temp_curt_e_sum_p_smooth: "$e_{x:n} = (\<Sum>k<n. $p_{k+1&x})" for n::nat
   using temp_curt_e_sum_p isCont_p_nat by simp
 
 lemma temp_curt_e_rec_smooth: "$e_{x:n} = $p_x * (1 + $e_{x+1:n-1})"
   if "x+1 < $\<psi>" "n \<noteq> 0" for n::nat
   using temp_curt_e_rec isCont_p_nat that by simp
 
 end
 
 end
 
 subsection \<open>Finite Survival Function\<close>
 
 locale finite_survival_function = survival_model +
   assumes psi_finite[simp]: "$\<psi> < \<infinity>"
 begin
 
 definition ult_age :: nat ("$\<omega>")
   where "$\<omega> \<equiv> LEAST x::nat. ccdf (distr \<MM> borel X) x = 0"
     \<comment> \<open>the conventional notation for ultimate age\<close>
 
 lemma ccdfX_ceil_psi_0: "ccdf (distr \<MM> borel X) \<lceil>real_of_ereal $\<psi>\<rceil> = 0"
 proof -
   have "real_of_ereal $\<psi> \<le> \<lceil>real_of_ereal $\<psi>\<rceil>" by simp
   thus ?thesis using ccdfX_0_equiv psi_finite ccdfX_psi_0 le_ereal_le by presburger
 qed
 
 lemma ccdfX_omega_0: "ccdf (distr \<MM> borel X) $\<omega> = 0"
   unfolding ult_age_def
 proof (rule LeastI_ex)
   have "\<lceil>real_of_ereal $\<psi>\<rceil> \<ge> 0" using psi_nonneg real_of_ereal_pos by fastforce
   thus "\<exists>x::nat. ccdf (distr \<MM> borel X) (real x) = 0"
     using ccdfX_ceil_psi_0 by (metis of_int_of_nat_eq zero_le_imp_eq_int)
 qed
 
 corollary psi_le_omega: "$\<psi> \<le> $\<omega>"
   using ccdfX_0_equiv ccdfX_omega_0 by blast
 
 corollary omega_pos: "$\<omega> > 0"
   using psi_le_omega order.strict_iff_not by fastforce
 
 lemma omega_ceil_psi: "$\<omega> = \<lceil>real_of_ereal $\<psi>\<rceil>"
 proof (rule antisym)
   let ?cpsi = "\<lceil>real_of_ereal $\<psi>\<rceil>"
   have \<star>: "?cpsi \<ge> 0" using psi_nonneg real_of_ereal_pos by fastforce
   moreover have "ccdf (distr \<MM> borel X) ?cpsi = 0" by (rule ccdfX_ceil_psi_0)
   ultimately have "$\<omega> \<le> nat ?cpsi"
     unfolding ult_age_def using wellorder_Least_lemma of_nat_nat by smt
   thus "int $\<omega> \<le> ?cpsi" using le_nat_iff \<star> by blast
 next
   show "\<lceil>real_of_ereal $\<psi>\<rceil> \<le> int $\<omega>"
     using psi_le_omega by (simp add: ceiling_le_iff real_of_ereal_ord_simps(2))
 qed
 
 lemma ccdfX_0_equiv_nat: "ccdf (distr \<MM> borel X) x = 0 \<longleftrightarrow> x \<ge> $\<omega>" for x::nat
 proof
   assume "ccdf (distr \<MM> borel X) (real x) = 0"
   thus "x \<ge> $\<omega>" unfolding ult_age_def using wellorder_Least_lemma by fastforce
 next
   assume "x \<ge> $\<omega>"
   hence "ereal (real x) \<ge> $\<psi>" using psi_le_omega le_ereal_le of_nat_mono by blast
   thus "ccdf (distr \<MM> borel X) (real x) = 0" using ccdfX_0_equiv by simp
 qed
 
 lemma psi_le_iff_omega_le: "$\<psi> \<le> x \<longleftrightarrow> $\<omega> \<le> x" for x::nat
   using ccdfX_0_equiv ccdfX_0_equiv_nat by presburger
 
 context 
   fixes x::nat
   assumes x_lt_omega[simp]: "x < $\<omega>"
 begin
 
 lemma x_lt_psi[simp]: "x < $\<psi>"
   using x_lt_omega psi_le_iff_omega_le by (meson linorder_not_less)
 
 lemma p_0_1_nat: "$p_{0&x} = 1"
   using p_0_1 by simp
 
 lemma p_0_equiv_nat: "$p_{t&x} = 0 \<longleftrightarrow> x+t \<ge> $\<omega>" for t::nat
   using psi_le_iff_omega_le p_0_equiv by (metis of_nat_add x_lt_psi)
 
 lemma q_0_0_nat: "$q_{0&x} = 0"
   using p_q_1 p_0_1_nat by (smt (verit) x_lt_psi)
 
 lemma q_1_equiv_nat: "$q_{t&x} = 1 \<longleftrightarrow> x+t \<ge> $\<omega>" for t::nat
   using p_q_1 p_0_equiv_nat by (smt (verit) x_lt_psi)
 
 lemma q_defer_old_0_nat: "$q_{f\<bar>t&x} = 0" if "$\<omega> \<le> x+f" for f t :: nat
   using q_defer_old_0 psi_le_iff_omega_le that by (metis of_nat_0_le_iff of_nat_add x_lt_psi)
 
 lemma curt_e_sum_P_finite_nat: "$e_x = (\<Sum>k<n. \<P>(\<xi> in \<MM>. T x \<xi> \<ge> k + 1 \<bar> T x \<xi> > 0))"
   if "x+n \<ge> $\<omega>" for n::nat
   apply (rule curt_e_sum_P_finite, simp)
   using that psi_le_iff_omega_le by (smt (verit) le_ereal_less of_nat_add)
 
 lemma curt_e_sum_p_finite_nat: "$e_x = (\<Sum>k<n. $p_{k+1&x})"
   if "\<And>k::nat. k < n \<Longrightarrow> isCont (\<lambda>t. $p_{t&x}) (real k + 1)" "x+n \<ge> $\<omega>" for n::nat
   apply (rule curt_e_sum_p_finite, simp_all add: that)
   using that psi_le_iff_omega_le by (smt (verit) le_ereal_less of_nat_add)
 
 end
 
 lemma q_omega_1: "$q_($\<omega>-1) = 1"
   using q_1_equiv_nat
   by (metis diff_less dual_order.refl le_diff_conv of_nat_1 omega_pos zero_less_one)
 
 end
 
 end
diff --git a/thys/Affine_Arithmetic/Intersection.thy b/thys/Affine_Arithmetic/Intersection.thy
--- a/thys/Affine_Arithmetic/Intersection.thy
+++ b/thys/Affine_Arithmetic/Intersection.thy
@@ -1,2814 +1,2814 @@
 section \<open>Intersection\<close>
 theory Intersection
 imports
   "HOL-Library.Monad_Syntax"
   Polygon
   Counterclockwise_2D_Arbitrary
   Affine_Form
 begin
 text \<open>\label{sec:intersection}\<close>
 
 subsection \<open>Polygons and @{term ccw}, @{term lex}, @{term psi}, @{term coll}\<close>
 
 lemma polychain_of_ccw_conjunction:
   assumes sorted: "ccw'.sortedP 0 Ps"
   assumes z: "z \<in> set (polychain_of Pc Ps)"
   shows "list_all (\<lambda>(xi, xj). ccw xi xj (fst z) \<and> ccw xi xj (snd z)) (polychain_of Pc Ps)"
   using assms
 proof (induction Ps arbitrary: Pc z rule: list.induct)
   case (Cons P Ps)
   {
     assume "set Ps = {}"
     hence ?case using Cons by simp
   } moreover {
     assume "set Ps \<noteq> {}"
     hence "Ps \<noteq> []" by simp
     {
       fix a assume "a \<in> set Ps"
       hence "ccw' 0 P a"
         using Cons.prems
         by (auto elim!: linorder_list0.sortedP_Cons)
     } note ccw' = this
     have sorted': "linorder_list0.sortedP (ccw' 0) Ps"
       using Cons.prems
       by (auto elim!: linorder_list0.sortedP_Cons)
     from in_set_polychain_of_imp_sum_list[OF Cons(3)]
     obtain d
     where d: "z = (Pc + sum_list (take d (P # Ps)), Pc + sum_list (take (Suc d) (P # Ps)))" .
 
     from Cons(3)
     have disj: "z = (Pc, Pc + P) \<or> z \<in> set (polychain_of (Pc + P) Ps)"
       by auto
 
     let ?th = "\<lambda>(xi, xj). ccw xi xj Pc \<and> ccw xi xj (Pc + P)"
     have la: "list_all ?th (polychain_of (Pc + P) Ps)"
     proof (rule list_allI)
       fix x assume x: "x \<in> set (polychain_of (Pc + P) Ps)"
       from in_set_polychain_of_imp_sum_list[OF this]
       obtain e where e: "x = (Pc + P + sum_list (take e Ps), Pc + P + sum_list (take (Suc e) Ps))"
         by auto
       {
         assume "e \<ge> length Ps"
         hence "?th x" by (auto simp: e)
       } moreover {
         assume "e < length Ps"
         have 0: "\<And>e. e < length Ps \<Longrightarrow> ccw' 0 P (Ps ! e)"
           by (rule ccw') simp
         have 2: "0 < e \<Longrightarrow> ccw' 0 (P + sum_list (take e Ps)) (Ps ! e)"
           using \<open>e < length Ps\<close>
           by (auto intro!: ccw'.add1 0 ccw'.sum2 sorted' ccw'.sorted_nth_less
             simp: sum_list_sum_nth)
         have "ccw Pc (Pc + P + sum_list (take e Ps)) (Pc + P + sum_list (take (Suc e) Ps))"
           by (cases "e = 0")
             (auto simp add: ccw_translate_origin take_Suc_eq add.assoc[symmetric] 0 2
               intro!: ccw'_imp_ccw intro: cyclic)
         hence "ccw (Pc + P + sum_list (take e Ps)) (Pc + P + sum_list (take (Suc e) Ps)) Pc"
           by (rule cyclic)
         moreover
         have "0 < e \<Longrightarrow> ccw 0 (Ps ! e) (- sum_list (take e Ps))"
           using \<open>e < length Ps\<close>
           by (auto simp add: take_Suc_eq add.assoc[symmetric]
               sum_list_sum_nth
             intro!: ccw'_imp_ccw ccw'.sum2 sorted' ccw'.sorted_nth_less)
         hence "ccw (Pc + P + sum_list (take e Ps)) (Pc + P + sum_list (take (Suc e) Ps)) (Pc + P)"
           by (cases "e = 0") (simp_all add: ccw_translate_origin take_Suc_eq)
         ultimately have "?th x"
           by (auto simp add: e)
       } ultimately show "?th x" by arith
     qed
     from disj have ?case
     proof
       assume z: "z \<in> set (polychain_of (Pc + P) Ps)"
       have "ccw 0 P (sum_list (take d (P # Ps)))"
       proof (cases d)
         case (Suc e) note e = this
         show ?thesis
         proof (cases e)
           case (Suc f)
           have "ccw 0 P (P + sum_list (take (Suc f) Ps))"
             using z
             by (force simp add: sum_list_sum_nth intro!: ccw'.sum intro: ccw' ccw'_imp_ccw)
           thus ?thesis
             by (simp add: e Suc)
         qed (simp add: e)
       qed simp
       hence "ccw Pc (Pc + P) (fst z)"
         by (simp add: d ccw_translate_origin)
       moreover
       from z have "ccw 0 P (P + sum_list (take d Ps))"
         by (cases d, force)
           (force simp add: sum_list_sum_nth intro!: ccw'_imp_ccw ccw'.sum intro: ccw')+
       hence "ccw Pc (Pc + P) (snd z)"
         by (simp add: d ccw_translate_origin)
       moreover
       from z Cons.prems have "list_all (\<lambda>(xi, xj). ccw xi xj (fst z) \<and> ccw xi xj (snd z))
         (polychain_of (Pc + P) Ps)"
         by (intro Cons.IH) (auto elim!: linorder_list0.sortedP_Cons)
       ultimately show ?thesis by simp
     qed (simp add: la)
   } ultimately show ?case by blast
 qed simp
 
 lemma lex_polychain_of_center:
   "d \<in> set (polychain_of x0 xs) \<Longrightarrow> list_all (\<lambda>x. lex x 0) xs \<Longrightarrow> lex (snd d) x0"
 proof (induction xs arbitrary: x0)
   case (Cons x xs) thus ?case
     by (auto simp add: lex_def lex_translate_origin dest!: Cons.IH)
 qed (auto simp: lex_translate_origin)
 
 lemma lex_polychain_of_last:
   "(c, d) \<in> set (polychain_of x0 xs) \<Longrightarrow> list_all (\<lambda>x. lex x 0) xs \<Longrightarrow>
     lex (snd (last (polychain_of x0 xs))) d"
 proof (induction xs arbitrary: x0 c d)
   case (Cons x xs)
   let ?c1 = "c = x0 \<and> d = x0 + x"
   let ?c2 = "(c, d) \<in> set (polychain_of (x0 + x) xs)"
   from Cons(2) have "?c1 \<or> ?c2" by auto
   thus ?case
   proof
     assume ?c1
     with Cons.prems show ?thesis
       by (auto intro!: lex_polychain_of_center)
   next
     assume ?c2
     from Cons.IH[OF this] Cons.prems
     show ?thesis
       by auto
   qed
 qed (auto simp: lex_translate_origin)
 
 lemma distinct_fst_polychain_of:
   assumes "list_all (\<lambda>x. x \<noteq> 0) xs"
   assumes "list_all (\<lambda>x. lex x 0) xs"
   shows "distinct (map fst (polychain_of x0 xs))"
   using assms
 proof (induction xs arbitrary: x0)
   case Nil
   thus ?case by simp
 next
   case (Cons x xs)
   hence "\<And>d. list_all (\<lambda>x. lex x 0) (x # take d xs)"
     by (auto simp: list_all_iff dest!: in_set_takeD)
   from sum_list_nlex_eq_zero_iff[OF this] Cons.prems
   show ?case
     by (cases "xs = []") (auto intro!: Cons.IH elim!: in_set_polychain_of_imp_sum_list)
 qed
 
 lemma distinct_snd_polychain_of:
   assumes "list_all (\<lambda>x. x \<noteq> 0) xs"
   assumes "list_all (\<lambda>x. lex x 0) xs"
   shows "distinct (map snd (polychain_of x0 xs))"
   using assms
 proof (induction xs arbitrary: x0)
   case Nil
   thus ?case by simp
 next
   case (Cons x xs)
   have contra:
     "\<And>d. xs \<noteq> [] \<Longrightarrow> list_all (\<lambda>x. x \<noteq> 0) xs \<Longrightarrow> list_all ((=) 0) (take (Suc d) xs) \<Longrightarrow> False"
     by (auto simp: neq_Nil_conv)
   from Cons have "\<And>d. list_all (\<lambda>x. lex x 0) (take (Suc d) xs)"
     by (auto simp: list_all_iff dest!: in_set_takeD)
   from sum_list_nlex_eq_zero_iff[OF this] Cons.prems contra
   show ?case
     by (cases "xs = []") (auto intro!: Cons.IH elim!: in_set_polychain_of_imp_sum_list dest!: contra)
 qed
 
 
 subsection \<open>Orient all entries\<close>
 
 lift_definition nlex_pdevs::"point pdevs \<Rightarrow> point pdevs"
   is "\<lambda>x n. if lex 0 (x n) then - x n else x n" by simp
 
 lemma pdevs_apply_nlex_pdevs[simp]: "pdevs_apply (nlex_pdevs x) n =
   (if lex 0 (pdevs_apply x n) then - pdevs_apply x n else pdevs_apply x n)"
   by transfer simp
 
 lemma nlex_pdevs_zero_pdevs[simp]: "nlex_pdevs zero_pdevs = zero_pdevs"
   by (auto intro!: pdevs_eqI)
 
 lemma pdevs_domain_nlex_pdevs[simp]: "pdevs_domain (nlex_pdevs x) = pdevs_domain x"
   by (auto simp: pdevs_domain_def)
 
 lemma degree_nlex_pdevs[simp]: "degree (nlex_pdevs x) = degree x"
   by (rule degree_cong) auto
 
 lemma
   pdevs_val_nlex_pdevs:
   assumes "e \<in> UNIV \<rightarrow> I" "uminus ` I = I"
   obtains e' where "e' \<in> UNIV \<rightarrow> I" "pdevs_val e x = pdevs_val e' (nlex_pdevs x)"
   using assms
   by (atomize_elim, intro exI[where x="\<lambda>n. if lex 0 (pdevs_apply x n) then - e n else e n"])
     (force simp: pdevs_val_pdevs_domain intro!: sum.cong)
 
 lemma
   pdevs_val_nlex_pdevs2:
   assumes "e \<in> UNIV \<rightarrow> I" "uminus ` I = I"
   obtains e' where "e' \<in> UNIV \<rightarrow> I" "pdevs_val e (nlex_pdevs x) = pdevs_val e' x"
   using assms
   by (atomize_elim, intro exI[where x="\<lambda>n. (if lex 0 (pdevs_apply x n) then - e n else e n)"])
     (force simp: pdevs_val_pdevs_domain intro!: sum.cong)
 
 lemma
   pdevs_val_selsort_ccw:
   assumes "distinct xs"
   assumes "e \<in> UNIV \<rightarrow> I"
   obtains e' where "e' \<in> UNIV \<rightarrow> I"
     "pdevs_val e (pdevs_of_list xs) = pdevs_val e' (pdevs_of_list (ccw.selsort 0 xs))"
 proof -
   have "set xs = set (ccw.selsort 0 xs)" "distinct xs" "distinct (ccw.selsort 0 xs)"
     by (simp_all add: assms)
   from this assms(2) obtain e'
   where "e' \<in> UNIV \<rightarrow> I"
     "pdevs_val e (pdevs_of_list xs) = pdevs_val e' (pdevs_of_list (ccw.selsort 0 xs))"
     by (rule pdevs_val_permute)
   thus thesis ..
 qed
 
 lemma
   pdevs_val_selsort_ccw2:
   assumes "distinct xs"
   assumes "e \<in> UNIV \<rightarrow> I"
   obtains e' where "e' \<in> UNIV \<rightarrow> I"
     "pdevs_val e (pdevs_of_list (ccw.selsort 0 xs)) = pdevs_val e' (pdevs_of_list xs)"
 proof -
   have "set (ccw.selsort 0 xs) = set xs" "distinct (ccw.selsort 0 xs)" "distinct xs"
     by (simp_all add: assms)
   from this assms(2) obtain e'
   where "e' \<in> UNIV \<rightarrow> I"
     "pdevs_val e (pdevs_of_list (ccw.selsort 0 xs)) = pdevs_val e' (pdevs_of_list xs)"
     by (rule pdevs_val_permute)
   thus thesis ..
 qed
 
 lemma lex_nlex_pdevs: "lex (pdevs_apply (nlex_pdevs x) i) 0"
   by (auto simp: lex_def algebra_simps prod_eq_iff)
 
 
 subsection \<open>Lowest Vertex\<close>
 
 definition lowest_vertex::"'a::ordered_euclidean_space aform \<Rightarrow> 'a" where
   "lowest_vertex X = fst X - sum_list (map snd (list_of_pdevs (snd X)))"
 
 lemma snd_abs: "snd (abs x) = abs (snd x)"
   by (metis abs_prod_def snd_conv)
 
 lemma lowest_vertex:
   fixes X Y::"(real*real) aform"
   assumes "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes "\<And>i. snd (pdevs_apply (snd X) i) \<ge> 0"
   assumes "\<And>i. abs (snd (pdevs_apply (snd Y) i)) = abs (snd (pdevs_apply (snd X) i))"
   assumes "degree_aform Y = degree_aform X"
   assumes "fst Y = fst X"
   shows "snd (lowest_vertex X) \<le> snd (aform_val e Y)"
 proof -
   from abs_pdevs_val_le_tdev[OF assms(1), of "snd Y"]
   have "snd \<bar>pdevs_val e (snd Y)\<bar> \<le> (\<Sum>i<degree_aform Y. \<bar>snd (pdevs_apply (snd X) i)\<bar>)"
     unfolding lowest_vertex_def
     by (auto simp: aform_val_def tdev_def less_eq_prod_def snd_sum snd_abs assms)
   also have "\<dots> = (\<Sum>i<degree_aform X. snd (pdevs_apply (snd X) i))"
     by (simp add: assms)
   also have "\<dots> \<le> snd (sum_list (map snd (list_of_pdevs (snd X))))"
     by (simp add: sum_list_list_of_pdevs dense_list_of_pdevs_def sum_list_distinct_conv_sum_set
       snd_sum atLeast0LessThan)
   finally show ?thesis
     by (auto simp: aform_val_def lowest_vertex_def minus_le_iff snd_abs abs_real_def assms
       split: if_split_asm)
 qed
 
 lemma sum_list_nonposI:
   fixes xs::"'a::ordered_comm_monoid_add list"
   shows "list_all (\<lambda>x. x \<le> 0) xs \<Longrightarrow> sum_list xs \<le> 0"
   by (induct xs) (auto simp: intro!: add_nonpos_nonpos)
 
 lemma center_le_lowest:
   "fst (fst X) \<le> fst (lowest_vertex (fst X, nlex_pdevs (snd X)))"
   by (auto simp: lowest_vertex_def fst_sum_list intro!: sum_list_nonposI)
     (auto simp: lex_def list_all_iff list_of_pdevs_def dest!: in_set_butlastD split: if_split_asm)
 
 lemma lowest_vertex_eq_center_iff:
   "lowest_vertex (x0, nlex_pdevs (snd X)) = x0 \<longleftrightarrow> snd X = zero_pdevs"
 proof
   assume "lowest_vertex (x0, nlex_pdevs (snd X)) = x0"
   then have "sum_list (map snd (list_of_pdevs (nlex_pdevs (snd X)))) = 0"
     by (simp add: lowest_vertex_def)
   moreover have "list_all (\<lambda>x. Counterclockwise_2D_Arbitrary.lex x 0)
     (map snd (list_of_pdevs (nlex_pdevs (snd X))))"
     by (auto simp add: list_all_iff list_of_pdevs_def)
   ultimately have "\<forall>x\<in>set (list_of_pdevs (nlex_pdevs (snd X))). snd x = 0"
     by (simp add: sum_list_nlex_eq_zero_iff list_all_iff)
   then have "pdevs_apply (snd X) i = pdevs_apply zero_pdevs i" for i
     by (simp add: list_of_pdevs_def split: if_splits)
   then show "snd X = zero_pdevs"
     by (rule pdevs_eqI)
 qed (simp add: lowest_vertex_def)
 
 
 subsection \<open>Collinear Generators\<close>
 
 lemma scaleR_le_self_cancel:
   fixes c::"'a::ordered_real_vector"
   shows "a *\<^sub>R c \<le> c \<longleftrightarrow> (1 < a \<and> c \<le> 0 \<or> a < 1 \<and> 0 \<le> c \<or> a = 1)"
   using scaleR_le_0_iff[of "a - 1" c]
   by (simp add: algebra_simps)
 
 lemma pdevs_val_coll:
   assumes coll: "list_all (coll 0 x) xs"
   assumes nlex: "list_all (\<lambda>x. lex x 0) xs"
   assumes "x \<noteq> 0"
   assumes "f \<in> UNIV \<rightarrow> {-1 .. 1}"
   obtains e where "e \<in> {-1 .. 1}" "pdevs_val f (pdevs_of_list xs) = e *\<^sub>R (sum_list xs)"
 proof cases
   assume "sum_list xs = 0"
   have "pdevs_of_list xs = zero_pdevs"
     by (auto intro!: pdevs_eqI sum_list_nlex_eq_zeroI[OF nlex \<open>sum_list xs = 0\<close>]
       simp: pdevs_apply_pdevs_of_list list_all_iff dest!: nth_mem)
   hence "0 \<in> {-1 .. 1::real}" "pdevs_val f (pdevs_of_list xs) = 0 *\<^sub>R sum_list xs"
     by simp_all
   thus ?thesis ..
 next
   assume "sum_list xs \<noteq> 0"
   have "sum_list (map abs xs) \<ge> 0"
     by (auto intro!: sum_list_nonneg)
   hence [simp]: "\<not>sum_list (map abs xs) \<le> 0"
     by (metis \<open>sum_list xs \<noteq> 0\<close> abs_le_zero_iff antisym_conv sum_list_abs)
 
   have collist: "list_all (coll 0 (sum_list xs)) xs"
   proof (rule list_allI)
     fix y assume "y \<in> set xs"
     hence "coll 0 x y"
       using coll by (auto simp: list_all_iff)
     also have "coll 0 x (sum_list xs)"
       using coll by (auto simp: list_all_iff intro!: coll_sum_list)
     finally (coll_trans)
     show "coll 0 (sum_list xs) y"
       by (simp add: coll_commute \<open>x \<noteq> 0\<close>)
   qed
 
   {
     fix i assume "i < length xs"
     hence "\<exists>r. xs ! i = r *\<^sub>R (sum_list xs)"
       by (metis (mono_tags) coll_scale nth_mem \<open>sum_list xs \<noteq> 0\<close> list_all_iff collist)
   } then obtain r where r: "\<And>i. i < length xs \<Longrightarrow> (xs ! i) = r i *\<^sub>R (sum_list xs)"
     by metis
   let ?coll = "pdevs_of_list xs"
   have "pdevs_val f (pdevs_of_list xs) =
       (\<Sum>i<degree (pdevs_of_list xs). f i *\<^sub>R xs ! i)"
     unfolding pdevs_val_sum
     by (simp add: pdevs_apply_pdevs_of_list less_degree_pdevs_of_list_imp_less_length)
   also have "\<dots> = (\<Sum>i<degree ?coll. (f i * r i) *\<^sub>R (sum_list xs))"
     by (simp add: r less_degree_pdevs_of_list_imp_less_length)
   also have "\<dots> = (\<Sum>i<degree ?coll. f i * r i) *\<^sub>R (sum_list xs)"
     by (simp add: algebra_simps scaleR_sum_left)
   finally have eq: "pdevs_val f ?coll = (\<Sum>i<degree ?coll. f i * r i) *\<^sub>R (sum_list xs)"
     (is "_ = ?e *\<^sub>R _")
     .
 
   have "abs (pdevs_val f ?coll) \<le> tdev ?coll"
     using assms(4)
     by (intro abs_pdevs_val_le_tdev) (auto simp: Pi_iff less_imp_le)
   also have "\<dots> = sum_list (map abs xs)" using assms by simp
   also note eq
   finally have less: "\<bar>?e\<bar> *\<^sub>R abs (sum_list xs) \<le> sum_list (map abs xs)" by (simp add: abs_scaleR)
   also have "\<bar>sum_list xs\<bar> = sum_list (map abs xs)"
     using coll \<open>x \<noteq> 0\<close> nlex
     by (rule abs_sum_list_coll)
   finally have "?e \<in> {-1 .. 1}"
     by (auto simp add: less_le scaleR_le_self_cancel)
   thus ?thesis using eq ..
 qed
 
 lemma scaleR_eq_self_cancel:
   fixes x::"'a::real_vector"
   shows "a *\<^sub>R x = x \<longleftrightarrow> a = 1 \<or> x = 0"
   using scaleR_cancel_right[of a x 1]
   by simp
 
 lemma abs_pdevs_val_less_tdev:
   assumes "e \<in> UNIV \<rightarrow> {-1 <..< 1}" "degree x > 0"
   shows "\<bar>pdevs_val e x\<bar> < tdev x"
 proof -
   have bnds: "\<And>i. \<bar>e i\<bar> < 1" "\<And>i. \<bar>e i\<bar> \<le> 1"
     using assms
     by (auto simp: Pi_iff abs_less_iff order.strict_implies_order)
   moreover
   let ?w = "degree x - 1"
   have witness: "\<bar>e ?w\<bar> *\<^sub>R \<bar>pdevs_apply x ?w\<bar> < \<bar>pdevs_apply x ?w\<bar>"
     using degree_least_nonzero[of x] assms bnds
     by (intro neq_le_trans) (auto simp: scaleR_eq_self_cancel Pi_iff
       intro!: scaleR_left_le_one_le neq_le_trans
       intro: abs_leI less_imp_le dest!: order.strict_implies_not_eq)
   ultimately
   show ?thesis
     using assms witness bnds
     by (auto simp: pdevs_val_sum tdev_def abs_scaleR
       intro!: le_less_trans[OF sum_abs] sum_strict_mono_ex1 scaleR_left_le_one_le)
 qed
 
 lemma pdevs_val_coll_strict:
   assumes coll: "list_all (coll 0 x) xs"
   assumes nlex: "list_all (\<lambda>x. lex x 0) xs"
   assumes "x \<noteq> 0"
   assumes "f \<in> UNIV \<rightarrow> {-1 <..< 1}"
   obtains e where "e \<in> {-1 <..< 1}" "pdevs_val f (pdevs_of_list xs) = e *\<^sub>R (sum_list xs)"
 proof cases
   assume "sum_list xs = 0"
   have "pdevs_of_list xs = zero_pdevs"
     by (auto intro!: pdevs_eqI sum_list_nlex_eq_zeroI[OF nlex \<open>sum_list xs = 0\<close>]
       simp: pdevs_apply_pdevs_of_list list_all_iff dest!: nth_mem)
   hence "0 \<in> {-1 <..< 1::real}" "pdevs_val f (pdevs_of_list xs) = 0 *\<^sub>R sum_list xs"
     by simp_all
   thus ?thesis ..
 next
   assume "sum_list xs \<noteq> 0"
   have "sum_list (map abs xs) \<ge> 0"
     by (auto intro!: sum_list_nonneg)
   hence [simp]: "\<not>sum_list (map abs xs) \<le> 0"
     by (metis \<open>sum_list xs \<noteq> 0\<close> abs_le_zero_iff antisym_conv sum_list_abs)
 
   have "\<exists>x \<in> set xs. x \<noteq> 0"
   proof (rule ccontr)
     assume "\<not> (\<exists>x\<in>set xs. x \<noteq> 0)"
     hence "\<And>x. x \<in> set xs \<Longrightarrow> x = 0" by auto
     hence "sum_list xs = 0"
       by (auto simp: sum_list_eq_0_iff_nonpos list_all_iff less_eq_prod_def prod_eq_iff fst_sum_list
         snd_sum_list)
     thus False using \<open>sum_list xs \<noteq> 0\<close> by simp
   qed
   then obtain i where i: "i < length xs" "xs ! i \<noteq> 0"
     by (metis in_set_conv_nth)
   hence "i < degree (pdevs_of_list xs)"
     by (auto intro!: degree_gt simp: pdevs_apply_pdevs_of_list)
   hence deg_pos: "0 < degree (pdevs_of_list xs)" by simp
 
   have collist: "list_all (coll 0 (sum_list xs)) xs"
   proof (rule list_allI)
     fix y assume "y \<in> set xs"
     hence "coll 0 x y"
       using coll by (auto simp: list_all_iff)
     also have "coll 0 x (sum_list xs)"
       using coll by (auto simp: list_all_iff intro!: coll_sum_list)
     finally (coll_trans)
     show "coll 0 (sum_list xs) y"
       by (simp add: coll_commute \<open>x \<noteq> 0\<close>)
   qed
 
   {
     fix i assume "i < length xs"
     hence "\<exists>r. xs ! i = r *\<^sub>R (sum_list xs)"
       by (metis (mono_tags, lifting) \<open>sum_list xs \<noteq> 0\<close> coll_scale collist list_all_iff nth_mem)
   } then obtain r where r: "\<And>i. i < length xs \<Longrightarrow> (xs ! i) = r i *\<^sub>R (sum_list xs)"
     by metis
   let ?coll = "pdevs_of_list xs"
   have "pdevs_val f (pdevs_of_list xs) =
       (\<Sum>i<degree (pdevs_of_list xs). f i *\<^sub>R xs ! i)"
     unfolding pdevs_val_sum
     by (simp add: less_degree_pdevs_of_list_imp_less_length pdevs_apply_pdevs_of_list)
   also have "\<dots> = (\<Sum>i<degree ?coll. (f i * r i) *\<^sub>R (sum_list xs))"
     by (simp add: r less_degree_pdevs_of_list_imp_less_length)
   also have "\<dots> = (\<Sum>i<degree ?coll. f i * r i) *\<^sub>R (sum_list xs)"
     by (simp add: algebra_simps scaleR_sum_left)
   finally have eq: "pdevs_val f ?coll = (\<Sum>i<degree ?coll. f i * r i) *\<^sub>R (sum_list xs)"
     (is "_ = ?e *\<^sub>R _")
     .
 
   have "abs (pdevs_val f ?coll) < tdev ?coll"
     using assms(4)
     by (intro abs_pdevs_val_less_tdev) (auto simp: Pi_iff less_imp_le deg_pos)
   also have "\<dots> = sum_list (map abs xs)" using assms by simp
   also note eq
   finally have less: "\<bar>?e\<bar> *\<^sub>R abs (sum_list xs) < sum_list (map abs xs)" by (simp add: abs_scaleR)
   also have "\<bar>sum_list xs\<bar> = sum_list (map abs xs)"
     using coll \<open>x \<noteq> 0\<close> nlex
     by (rule abs_sum_list_coll)
   finally have "?e \<in> {-1 <..< 1}"
     by (auto simp add: less_le scaleR_le_self_cancel)
   thus ?thesis using eq ..
 qed
 
 
 subsection \<open>Independent Generators\<close>
 
 fun independent_pdevs::"point list \<Rightarrow> point list"
   where
   "independent_pdevs [] = []"
 | "independent_pdevs (x#xs) =
     (let
       (cs, is) = List.partition (coll 0 x) xs;
       s = x + sum_list cs
     in (if s = 0 then [] else [s]) @ independent_pdevs is)"
 
 lemma in_set_independent_pdevsE:
   assumes "y \<in> set (independent_pdevs xs)"
   obtains x where "x\<in>set xs" "coll 0 x y"
 proof atomize_elim
   show "\<exists>x. x \<in> set xs \<and> coll 0 x y"
     using assms
   proof (induct xs rule: independent_pdevs.induct)
     case 1 thus ?case by simp
   next
     case (2 z zs)
     let ?c1 = "y = z + sum_list (filter (coll 0 z) zs)"
     let ?c2 = "y \<in> set (independent_pdevs (filter (Not \<circ> coll 0 z) zs))"
     from 2
     have "?c1 \<or> ?c2"
       by (auto simp: Let_def split: if_split_asm)
     thus ?case
     proof
       assume ?c2
       hence "y \<in> set (independent_pdevs (snd (partition (coll 0 z) zs)))"
         by simp
       from 2(1)[OF refl prod.collapse refl this]
       show ?case
         by auto
     next
       assume y: ?c1
       show ?case
         unfolding y
         by (rule exI[where x="z"]) (auto intro!: coll_add coll_sum_list )
     qed
   qed
 qed
 
 lemma in_set_independent_pdevs_nonzero: "x \<in> set (independent_pdevs xs) \<Longrightarrow> x \<noteq> 0"
 proof (induct xs rule: independent_pdevs.induct)
   case (2 y ys)
   from 2(1)[OF refl prod.collapse refl] 2(2)
   show ?case
     by (auto simp: Let_def split: if_split_asm)
 qed simp
 
 lemma independent_pdevs_pairwise_non_coll:
   assumes "x \<in> set (independent_pdevs xs)"
   assumes "y \<in> set (independent_pdevs xs)"
   assumes "\<And>x. x \<in> set xs \<Longrightarrow> x \<noteq> 0"
   assumes "x \<noteq> y"
   shows "\<not> coll 0 x y"
 using assms
 proof (induct xs rule: independent_pdevs.induct)
   case 1 thus ?case by simp
 next
   case (2 z zs)
   from 2 have "z \<noteq> 0" by simp
   from 2(2) have "x \<noteq> 0" by (rule in_set_independent_pdevs_nonzero)
   from 2(3) have "y \<noteq> 0" by (rule in_set_independent_pdevs_nonzero)
   let ?c = "filter (coll 0 z) zs"
   let ?nc = "filter (Not \<circ> coll 0 z) zs"
   {
     assume "x \<in> set (independent_pdevs ?nc)" "y \<in> set (independent_pdevs ?nc)"
     hence "\<not>coll 0 x y"
       by (intro 2(1)[OF refl prod.collapse refl _ _ 2(4) 2(5)]) auto
   } note IH = this
   {
     fix x assume "x \<noteq> 0" "z + sum_list ?c \<noteq> 0"
       "coll 0 x (z + sum_list ?c)"
     hence "x \<notin> set (independent_pdevs ?nc)"
       using sum_list_filter_coll_ex_scale[OF \<open>z \<noteq> 0\<close>, of "z#zs"]
       by (auto elim!: in_set_independent_pdevsE  simp: coll_commute)
         (metis (no_types) \<open>x \<noteq> 0\<close> coll_scale coll_scaleR)
   } note nc = this
   from 2(2,3,4,5) nc[OF \<open>x \<noteq> 0\<close>] nc[OF \<open>y \<noteq> 0\<close>]
   show ?case
     by (auto simp: Let_def IH coll_commute split: if_split_asm)
 qed
 
 lemma distinct_independent_pdevs[simp]:
   shows "distinct (independent_pdevs xs)"
 proof (induct xs rule: independent_pdevs.induct)
   case 1 thus ?case by simp
 next
   case (2 x xs)
   let ?is = "independent_pdevs (filter (Not \<circ> coll 0 x) xs)"
   have "distinct ?is"
     by (rule 2) (auto intro!: 2)
   thus ?case
   proof (clarsimp simp add: Let_def)
     let ?s = "x + sum_list (filter (coll 0 x) xs)"
     assume s: "?s \<noteq> 0" "?s \<in> set ?is"
     from in_set_independent_pdevsE[OF s(2)]
     obtain y where y:
       "y \<in> set (filter (Not \<circ> coll 0 x) xs)"
       "coll 0 y (x + sum_list (filter (coll 0 x) xs))"
       by auto
     {
       assume "y = 0 \<or> x = 0 \<or> sum_list (filter (coll 0 x) xs) = 0"
       hence False using s y by (auto simp: coll_commute)
     } moreover {
       assume "y \<noteq> 0" "x \<noteq> 0" "sum_list (filter (coll 0 x) xs) \<noteq> 0"
         "sum_list (filter (coll 0 x) xs) + x \<noteq> 0"
       have *: "coll 0 (sum_list (filter (coll 0 x) xs)) x"
         by (auto intro!: coll_sum_list simp: coll_commute)
       have "coll 0 y (sum_list (filter (coll 0 x) xs) + x)"
         using s y by (simp add: add.commute)
       hence "coll 0 y x" using *
         by (rule coll_add_trans) fact+
       hence False using s y by (simp add: coll_commute)
     } ultimately show False using s y by (auto simp: add.commute)
   qed
 qed
 
 lemma in_set_independent_pdevs_invariant_nlex:
   "x \<in> set (independent_pdevs xs) \<Longrightarrow> (\<And>x. x \<in> set xs \<Longrightarrow> lex x 0) \<Longrightarrow>
   (\<And>x. x \<in> set xs \<Longrightarrow> x \<noteq> 0) \<Longrightarrow> Counterclockwise_2D_Arbitrary.lex x 0"
 proof (induction xs arbitrary: x rule: independent_pdevs.induct )
   case 1 thus ?case by simp
 next
   case (2 y ys)
   from 2 have "y \<noteq> 0" by auto
   from 2(2)
   have "x \<in> set (independent_pdevs (filter (Not \<circ> coll 0 y) ys)) \<or>
     x = y + sum_list (filter (coll 0 y) ys)"
     by (auto simp: Let_def split: if_split_asm)
   thus ?case
   proof
     assume "x \<in> set (independent_pdevs (filter (Not \<circ> coll 0 y) ys))"
     from 2(1)[OF refl prod.collapse refl, simplified, OF this 2(3,4)]
     show ?case by simp
   next
     assume "x = y + sum_list (filter (coll 0 y) ys)"
     also have "lex \<dots> 0"
       by (force intro: nlex_add nlex_sum simp: sum_list_sum_nth
         dest: nth_mem intro: 2(3))
     finally show ?case .
   qed
 qed
 
 lemma
   pdevs_val_independent_pdevs2:
   assumes "e \<in> UNIV \<rightarrow> I"
   shows "\<exists>e'. e' \<in> UNIV \<rightarrow> I \<and>
     pdevs_val e (pdevs_of_list (independent_pdevs xs)) = pdevs_val e' (pdevs_of_list xs)"
   using assms
 proof (induct xs arbitrary: e rule: independent_pdevs.induct)
   case 1 thus ?case by force
 next
   case (2 x xs)
   let ?coll = "(filter (coll 0 x) (x#xs))"
   let ?ncoll = "(filter (Not o coll 0 x) (x#xs))"
   let ?e0 = "if sum_list ?coll = 0 then e else e \<circ> (+) (Suc 0)"
   have "pdevs_val e (pdevs_of_list (independent_pdevs (x#xs))) =
     e 0 *\<^sub>R (sum_list ?coll) + pdevs_val ?e0 (pdevs_of_list (independent_pdevs ?ncoll))"
     (is "_ = ?vc + ?vnc")
     by (simp add: Let_def)
   also
   have e_split: "(\<lambda>_. e 0) \<in> UNIV \<rightarrow> I" "?e0 \<in> UNIV \<rightarrow> I"
     using 2(2) by auto
   from 2(1)[OF refl prod.collapse refl e_split(2)]
   obtain e' where e': "e' \<in> UNIV \<rightarrow> I" and "?vnc = pdevs_val e' (pdevs_of_list ?ncoll)"
     by (auto simp add: o_def)
   note this(2)
   also
   have "?vc = pdevs_val (\<lambda>_. e 0) (pdevs_of_list ?coll)"
     by (simp add: pdevs_val_const_pdevs_of_list)
   also
   from pdevs_val_pdevs_of_list_append[OF e_split(1) e'] obtain e'' where
     e'': "e'' \<in> UNIV \<rightarrow> I"
     and "pdevs_val (\<lambda>_. e 0) (pdevs_of_list ?coll) + pdevs_val e' (pdevs_of_list ?ncoll) =
       pdevs_val e'' (pdevs_of_list (?coll @ ?ncoll))"
     by metis
   note this(2)
   also
   from pdevs_val_perm[OF partition_permI e'', of "coll 0 x" "x#xs"]
   obtain e''' where e''': "e''' \<in> UNIV \<rightarrow> I"
     and "\<dots> = pdevs_val e''' (pdevs_of_list (x # xs))"
     by metis
   note this(2)
   finally show ?case using e''' by auto
 qed
 
 lemma list_all_filter: "list_all p (filter p xs)"
   by (induct xs) auto
 
 lemma pdevs_val_independent_pdevs:
   assumes "list_all (\<lambda>x. lex x 0) xs"
   assumes "list_all (\<lambda>x. x \<noteq> 0) xs"
   assumes "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "\<exists>e'. e' \<in> UNIV \<rightarrow> {-1 .. 1} \<and> pdevs_val e (pdevs_of_list xs) =
     pdevs_val e' (pdevs_of_list (independent_pdevs xs))"
   using assms(1,2,3)
 proof (induct xs arbitrary: e rule: independent_pdevs.induct)
   case 1 thus ?case by force
 next
   case (2 x xs)
 
   let ?coll = "(filter (coll 0 x) (x#xs))"
   let ?ncoll = "(filter (Not o coll 0 x) xs)"
 
   from 2 have "x \<noteq> 0" by simp
 
   from pdevs_val_partition[OF 2(4), of "x#xs" "coll 0 x"]
   obtain f g where part: "pdevs_val e (pdevs_of_list (x # xs)) =
       pdevs_val f (pdevs_of_list ?coll) +
       pdevs_val g (pdevs_of_list (filter (Not o coll 0 x) (x#xs)))"
     and f: "f \<in> UNIV \<rightarrow> {-1 .. 1}" and g: "g \<in> UNIV \<rightarrow> {-1 .. 1}"
     by blast
   note part
   also
 
   have "list_all (\<lambda>x. lex x 0) (filter (coll 0 x) (x#xs))"
     using 2(2) by (auto simp: inner_prod_def list_all_iff)
   from pdevs_val_coll[OF list_all_filter this \<open>x \<noteq> 0\<close> f]
   obtain f' where "pdevs_val f (pdevs_of_list ?coll) = f' *\<^sub>R sum_list (filter (coll 0 x) (x#xs))"
     and f': "f' \<in> {-1 .. 1}"
     by blast
   note this(1)
   also
 
   have "filter (Not o coll 0 x) (x#xs) = ?ncoll"
     by simp
   also
 
   from 2(2) have "list_all (\<lambda>x. lex x 0) ?ncoll" "list_all (\<lambda>x. x \<noteq> 0) ?ncoll"
     by (auto simp: list_all_iff)
   from 2(1)[OF refl partition_filter_conv[symmetric] refl this g]
   obtain g'
   where "pdevs_val g (pdevs_of_list ?ncoll) =
       pdevs_val g' (pdevs_of_list (independent_pdevs ?ncoll))"
     and g': "g' \<in> UNIV \<rightarrow> {-1 .. 1}"
     by metis
   note this(1)
   also
 
   define h where "h = (if sum_list ?coll \<noteq> 0 then rec_nat f' (\<lambda>i _. g' i) else g')"
   have "f' *\<^sub>R sum_list ?coll + pdevs_val g' (pdevs_of_list (independent_pdevs ?ncoll))
       = pdevs_val h (pdevs_of_list (independent_pdevs (x#xs)))"
     by (simp add: h_def o_def Let_def)
 
   finally
   have "pdevs_val e (pdevs_of_list (x # xs)) =
       pdevs_val h (pdevs_of_list (independent_pdevs (x # xs)))" .
 
   moreover have "h \<in> UNIV \<rightarrow> {-1 .. 1}"
   proof
     fix i show "h i \<in> {-1 .. 1}"
       using f' g'
       by (cases i) (auto simp: h_def)
   qed
 
   ultimately show ?case by blast
 qed
 
 lemma
   pdevs_val_independent_pdevs_strict:
   assumes "list_all (\<lambda>x. lex x 0) xs"
   assumes "list_all (\<lambda>x. x \<noteq> 0) xs"
   assumes "e \<in> UNIV \<rightarrow> {-1 <..< 1}"
   shows "\<exists>e'. e' \<in> UNIV \<rightarrow> {-1 <..< 1} \<and> pdevs_val e (pdevs_of_list xs) =
     pdevs_val e' (pdevs_of_list (independent_pdevs xs))"
   using assms(1,2,3)
 proof (induct xs arbitrary: e rule: independent_pdevs.induct)
   case 1 thus ?case by force
 next
   case (2 x xs)
 
   let ?coll = "(filter (coll 0 x) (x#xs))"
   let ?ncoll = "(filter (Not o coll 0 x) xs)"
 
   from 2 have "x \<noteq> 0" by simp
 
   from pdevs_val_partition[OF 2(4), of "x#xs" "coll 0 x"]
   obtain f g
   where part: "pdevs_val e (pdevs_of_list (x # xs)) =
       pdevs_val f (pdevs_of_list ?coll) +
       pdevs_val g (pdevs_of_list (filter (Not o coll 0 x) (x#xs)))"
     and f: "f \<in> UNIV \<rightarrow> {-1 <..< 1}" and g: "g \<in> UNIV \<rightarrow> {-1 <..< 1}"
     by blast
   note part
   also
 
   have "list_all (\<lambda>x. lex x 0) (filter (coll 0 x) (x#xs))"
     using 2(2) by (auto simp: inner_prod_def list_all_iff)
   from pdevs_val_coll_strict[OF list_all_filter this \<open>x \<noteq> 0\<close> f]
   obtain f' where "pdevs_val f (pdevs_of_list ?coll) = f' *\<^sub>R sum_list (filter (coll 0 x) (x#xs))"
     and f': "f' \<in> {-1 <..< 1}"
     by blast
   note this(1)
   also
 
   have "filter (Not o coll 0 x) (x#xs) = ?ncoll"
     by simp
   also
 
   from 2(2) have "list_all (\<lambda>x. lex x 0) ?ncoll" "list_all (\<lambda>x. x \<noteq> 0) ?ncoll"
     by (auto simp: list_all_iff)
   from 2(1)[OF refl partition_filter_conv[symmetric] refl this g]
   obtain g'
   where "pdevs_val g (pdevs_of_list ?ncoll) =
       pdevs_val g' (pdevs_of_list (independent_pdevs ?ncoll))"
     and g': "g' \<in> UNIV \<rightarrow> {-1 <..< 1}"
     by metis
   note this(1)
   also
 
   define h where "h = (if sum_list ?coll \<noteq> 0 then rec_nat f' (\<lambda>i _. g' i) else g')"
   have "f' *\<^sub>R sum_list ?coll + pdevs_val g' (pdevs_of_list (independent_pdevs ?ncoll))
       = pdevs_val h (pdevs_of_list (independent_pdevs (x#xs)))"
     by (simp add: h_def o_def Let_def)
 
   finally
   have "pdevs_val e (pdevs_of_list (x # xs)) =
       pdevs_val h (pdevs_of_list (independent_pdevs (x # xs)))" .
 
   moreover have "h \<in> UNIV \<rightarrow> {-1 <..< 1}"
   proof
     fix i show "h i \<in> {-1 <..< 1}"
       using f' g'
       by (cases i) (auto simp: h_def)
   qed
 
   ultimately show ?case by blast
 qed
 
 lemma sum_list_independent_pdevs: "sum_list (independent_pdevs xs) = sum_list xs"
 proof (induct xs rule: independent_pdevs.induct)
   case (2 y ys)
   from 2[OF refl prod.collapse refl]
   show ?case
     using sum_list_partition[of "coll 0 y" ys, symmetric]
     by (auto simp: Let_def)
 qed simp
 
 lemma independent_pdevs_eq_Nil_iff:
   "list_all (\<lambda>x. lex x 0) xs \<Longrightarrow> list_all (\<lambda>x. x \<noteq> 0) xs \<Longrightarrow> independent_pdevs xs = [] \<longleftrightarrow> xs = []"
 proof (induct xs)
   case Nil thus ?case by simp
 next
   case (Cons x xs)
   from Cons(2) have "list_all (\<lambda>x. lex x 0) (x # filter (coll 0 x) xs)"
     by (auto simp: list_all_iff)
   from sum_list_nlex_eq_zero_iff[OF this] Cons(3)
   show ?case
     by (auto simp: list_all_iff)
 qed
 
 
 subsection \<open>Independent Oriented Generators\<close>
 
 definition "inl p = independent_pdevs (map snd (list_of_pdevs (nlex_pdevs p)))"
 
 lemma distinct_inl[simp]: "distinct (inl (snd X))"
   by (auto simp: inl_def)
 
 lemma in_set_inl_nonzero: "x \<in> set (inl xs) \<Longrightarrow> x \<noteq> 0"
   by (auto simp: inl_def in_set_independent_pdevs_nonzero)
 
 lemma
   inl_ncoll: "y \<in> set (inl (snd X)) \<Longrightarrow> z \<in> set (inl (snd X)) \<Longrightarrow> y \<noteq> z \<Longrightarrow> \<not>coll 0 y z"
   unfolding inl_def
   by (rule independent_pdevs_pairwise_non_coll, assumption+)
     (auto simp: inl_def list_of_pdevs_nonzero)
 
 lemma in_set_inl_lex: "x \<in> set (inl xs) \<Longrightarrow> lex x 0"
   by (auto simp: inl_def list_of_pdevs_def dest!: in_set_independent_pdevs_invariant_nlex
     split: if_split_asm)
 
 interpretation ccw0: linorder_list "ccw 0" "set (inl (snd X))"
 proof unfold_locales
   fix a b c
   show "a \<noteq> b \<Longrightarrow> ccw 0 a b \<or> ccw 0 b a"
     by (metis UNIV_I ccw_self(1) nondegenerate)
   assume a: "a \<in> set (inl (snd X))"
   show "ccw 0 a a"
     by simp
   assume b: "b \<in> set (inl (snd X))"
   show "ccw 0 a b \<Longrightarrow> ccw 0 b a \<Longrightarrow> a = b"
     by (metis ccw_self(1) in_set_inl_nonzero mem_Collect_eq not_ccw_eq a b)
   assume c: "c \<in> set (inl (snd X))"
   assume distinct: "a \<noteq> b" "b \<noteq> c" "a \<noteq> c"
   assume ab: "ccw 0 a b" and bc: "ccw 0 b c"
   show "ccw 0 a c"
     using a b c ab bc
   proof (cases "a = (0, 1)" "b = (0, 1)" "c = (0, 1)"
       rule: case_split[case_product case_split[case_product case_split]])
     assume nu: "a \<noteq> (0, 1)" "b \<noteq> (0, 1)" "c \<noteq> (0, 1)"
     have "distinct5 a b c (0, 1) 0" "in5 UNIV a b c (0, 1) 0"
       using a b c distinct nu by (simp_all add: in_set_inl_nonzero)
     moreover have "ccw 0 (0, 1) a" "ccw 0 (0, 1) b" "ccw 0 (0, 1) c"
       by (auto intro!: nlex_ccw_left in_set_inl_lex a b c)
     ultimately show ?thesis using ab bc
       by (rule ccw.transitive[where S=UNIV and s="(0, 1)"])
   next
     assume "a \<noteq> (0, 1)" "b = (0, 1)" "c \<noteq> (0, 1)"
     thus ?thesis
       using ccw_switch23 in_set_inl_lex inl_ncoll nlex_ccw_left a b ab
       by blast
   next
     assume "a \<noteq> (0, 1)" "b \<noteq> (0, 1)" "c = (0, 1)"
     thus ?thesis
       using ccw_switch23 in_set_inl_lex inl_ncoll nlex_ccw_left b c bc
       by blast
   qed (auto simp add: nlex_ccw_left in_set_inl_lex)
 qed
 
 lemma sorted_inl: "ccw.sortedP 0 (ccw.selsort 0 (inl (snd X)))"
   by (rule ccw0.sortedP_selsort) auto
 
 lemma sorted_scaled_inl: "ccw.sortedP 0 (map ((*\<^sub>R) 2) (ccw.selsort 0 (inl (snd X))))"
   using sorted_inl
   by (rule ccw_sorted_scaleR) simp
 
 lemma distinct_selsort_inl: "distinct (ccw.selsort 0 (inl (snd X)))"
   by simp
 
 lemma distinct_map_scaleRI:
   fixes xs::"'a::real_vector list"
   shows "distinct xs \<Longrightarrow> c \<noteq> 0 \<Longrightarrow> distinct (map ((*\<^sub>R) c) xs)"
   by (induct xs) auto
 
 lemma distinct_scaled_inl: "distinct (map ((*\<^sub>R) 2) (ccw.selsort 0 (inl (snd X))))"
   using distinct_selsort_inl
   by (rule distinct_map_scaleRI) simp
 
 lemma ccw'_sortedP_scaled_inl:
   "ccw'.sortedP 0 (map ((*\<^sub>R) 2) (ccw.selsort 0 (inl (snd X))))"
   using ccw_sorted_implies_ccw'_sortedP
   by (rule ccw'_sorted_scaleR) (auto simp: sorted_inl inl_ncoll)
 
 lemma pdevs_val_pdevs_of_list_inl2E:
   assumes "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   obtains e' where "pdevs_val e X = pdevs_val e' (pdevs_of_list (inl X))" "e' \<in> UNIV \<rightarrow> {-1 .. 1}"
 proof -
   let ?l = "map snd (list_of_pdevs (nlex_pdevs X))"
   have l: "list_all (\<lambda>x. Counterclockwise_2D_Arbitrary.lex x 0) ?l"
     "list_all (\<lambda>x. x \<noteq> 0) (map snd (list_of_pdevs (nlex_pdevs X)))"
     by (auto simp: list_all_iff list_of_pdevs_def)
 
   from pdevs_val_nlex_pdevs[OF assms(1)]
   obtain e' where "e' \<in> UNIV \<rightarrow> {-1 .. 1}" "pdevs_val e X = pdevs_val e' (nlex_pdevs X)"
     by auto
   note this(2)
   also from pdevs_val_of_list_of_pdevs2[OF \<open>e' \<in> _\<close>]
   obtain e'' where "e'' \<in> UNIV \<rightarrow> {-1 .. 1}" "\<dots> = pdevs_val e'' (pdevs_of_list ?l)"
     by metis
   note this(2)
   also from pdevs_val_independent_pdevs[OF l \<open>e'' \<in> _\<close>]
   obtain e'''
   where "e''' \<in> UNIV \<rightarrow> {-1 .. 1}"
     and "\<dots> = pdevs_val e''' (pdevs_of_list (independent_pdevs ?l))"
     by metis
   note this(2)
   also have "\<dots> = pdevs_val e''' (pdevs_of_list (inl X))"
     by (simp add: inl_def)
   finally have "pdevs_val e X = pdevs_val e''' (pdevs_of_list (inl X))" .
   thus thesis using \<open>e''' \<in> _\<close> ..
 qed
 
 lemma pdevs_val_pdevs_of_list_inlE:
   assumes "e \<in> UNIV \<rightarrow> I" "uminus ` I = I" "0 \<in> I"
   obtains e' where "pdevs_val e (pdevs_of_list (inl X)) = pdevs_val e' X" "e' \<in> UNIV \<rightarrow> I"
 proof -
   let ?l = "map snd (list_of_pdevs (nlex_pdevs X))"
   have "pdevs_val e (pdevs_of_list (inl X)) = pdevs_val e (pdevs_of_list (independent_pdevs ?l))"
     by (simp add: inl_def)
   also
   from pdevs_val_independent_pdevs2[OF \<open>e \<in> _\<close>]
   obtain e'
   where "pdevs_val e (pdevs_of_list (independent_pdevs ?l)) = pdevs_val e' (pdevs_of_list ?l)"
     and "e' \<in> UNIV \<rightarrow> I"
     by auto
   note this(1)
   also
   from pdevs_val_of_list_of_pdevs[OF \<open>e' \<in> _\<close> \<open>0 \<in> I\<close>, of "nlex_pdevs X"]
   obtain e'' where "pdevs_val e' (pdevs_of_list ?l) = pdevs_val e'' (nlex_pdevs X)"
     and "e'' \<in> UNIV \<rightarrow> I"
     by metis
   note this(1)
   also
   from pdevs_val_nlex_pdevs2[OF \<open>e'' \<in> _\<close> \<open>_ = I\<close>]
   obtain e''' where "pdevs_val e'' (nlex_pdevs X) = pdevs_val e''' X" "e''' \<in> UNIV \<rightarrow> I"
     by metis
   note this(1)
   finally have "pdevs_val e (pdevs_of_list (inl X)) = pdevs_val e''' X" .
   thus ?thesis using \<open>e''' \<in> UNIV \<rightarrow> I\<close> ..
 qed
 
 lemma sum_list_nlex_eq_sum_list_inl:
   "sum_list (map snd (list_of_pdevs (nlex_pdevs X))) = sum_list (inl X)"
   by (auto simp: inl_def sum_list_list_of_pdevs sum_list_independent_pdevs)
 
 lemma Affine_inl: "Affine (fst X, pdevs_of_list (inl (snd X))) = Affine X"
   by (auto simp: Affine_def valuate_def aform_val_def
     elim: pdevs_val_pdevs_of_list_inlE[of _ _ "snd X"] pdevs_val_pdevs_of_list_inl2E[of _ "snd X"])
 
 
 subsection \<open>Half Segments\<close>
 
 definition half_segments_of_aform::"point aform \<Rightarrow> (point*point) list"
   where "half_segments_of_aform X =
     (let
       x0 = lowest_vertex (fst X, nlex_pdevs (snd X))
     in
       polychain_of x0 (map ((*\<^sub>R) 2) (ccw.selsort 0 (inl (snd X)))))"
 
 lemma subsequent_half_segments:
   fixes X
   assumes "Suc i < length (half_segments_of_aform X)"
   shows "snd (half_segments_of_aform X ! i) = fst (half_segments_of_aform X ! Suc i)"
   using assms
   by (cases i) (auto simp: half_segments_of_aform_def Let_def polychain_of_subsequent_eq)
 
 lemma polychain_half_segments_of_aform: "polychain (half_segments_of_aform X)"
   by (auto simp: subsequent_half_segments intro!: polychainI)
 
 lemma fst_half_segments:
   "half_segments_of_aform X \<noteq> [] \<Longrightarrow>
     fst (half_segments_of_aform X ! 0) = lowest_vertex (fst X, nlex_pdevs (snd X))"
   by (auto simp: half_segments_of_aform_def Let_def o_def split_beta')
 
 lemma nlex_half_segments_of_aform: "(a, b) \<in> set (half_segments_of_aform X) \<Longrightarrow> lex b a"
   by (auto simp: half_segments_of_aform_def prod_eq_iff lex_def
     dest!: in_set_polychain_ofD in_set_inl_lex)
 
 lemma ccw_half_segments_of_aform_all:
   assumes cd: "(c, d) \<in> set (half_segments_of_aform X)"
   shows "list_all (\<lambda>(xi, xj). ccw xi xj c \<and> ccw xi xj d) (half_segments_of_aform X)"
 proof -
   have
     "list_all (\<lambda>(xi, xj). ccw xi xj (fst (c, d)) \<and> ccw xi xj (snd (c, d)))
       (polychain_of (lowest_vertex (fst X, nlex_pdevs (snd X)))
         ((map ((*\<^sub>R) 2) (linorder_list0.selsort (ccw 0) (inl (snd X))))))"
     using ccw'_sortedP_scaled_inl cd[unfolded half_segments_of_aform_def Let_def]
     by (rule polychain_of_ccw_conjunction)
   thus ?thesis
     unfolding half_segments_of_aform_def[unfolded Let_def, symmetric] fst_conv snd_conv .
 qed
 
 lemma ccw_half_segments_of_aform:
   assumes ij: "(xi, xj) \<in> set (half_segments_of_aform X)"
   assumes c: "(c, d) \<in> set (half_segments_of_aform X)"
   shows "ccw xi xj c" "ccw xi xj d"
   using ccw_half_segments_of_aform_all[OF c] ij
   by (auto simp add: list_all_iff)
 
 lemma half_segments_of_aform1:
   assumes ch: "x \<in> convex hull set (map fst (half_segments_of_aform X))"
   assumes ab: "(a, b) \<in> set (half_segments_of_aform X)"
   shows "ccw a b x"
   using finite_set _ ch
 proof (rule ccw.convex_hull)
   fix c assume "c \<in> set (map fst (half_segments_of_aform X))"
   then obtain d where "(c, d) \<in> set (half_segments_of_aform X)" by auto
   with ab show "ccw a b c"
     by (rule ccw_half_segments_of_aform(1))
 qed (insert ab, simp add: nlex_half_segments_of_aform)
 
 lemma half_segments_of_aform2:
   assumes ch: "x \<in> convex hull set (map snd (half_segments_of_aform X))"
   assumes ab: "(a, b) \<in> set (half_segments_of_aform X)"
   shows "ccw a b x"
   using finite_set _ ch
 proof (rule ccw.convex_hull)
   fix d assume "d \<in> set (map snd (half_segments_of_aform X))"
   then obtain c where "(c, d) \<in> set (half_segments_of_aform X)" by auto
   with ab show "ccw a b d"
     by (rule ccw_half_segments_of_aform(2))
 qed (insert ab, simp add: nlex_half_segments_of_aform)
 
 lemma
   in_set_half_segments_of_aform_aform_valE:
   assumes "(x2, y2) \<in> set (half_segments_of_aform X)"
   obtains e where "y2 = aform_val e X" "e \<in> UNIV \<rightarrow> {-1 .. 1}"
 proof -
   from assms obtain d where
     "y2 = lowest_vertex (fst X, nlex_pdevs (snd X)) +
       sum_list (take (Suc d) (map ((*\<^sub>R) 2) (ccw.selsort 0 (inl (snd X)))))"
     by (auto simp: half_segments_of_aform_def elim!: in_set_polychain_of_imp_sum_list)
   also have "lowest_vertex (fst X, nlex_pdevs (snd X)) =
       fst X - sum_list (map snd (list_of_pdevs (nlex_pdevs (snd X))))"
     by (simp add: lowest_vertex_def)
   also have "sum_list (map snd (list_of_pdevs (nlex_pdevs (snd X)))) =
       pdevs_val (\<lambda>_. 1) (nlex_pdevs (snd X))"
     by (auto simp: pdevs_val_sum_list)
   also
 
   have "sum_list (take (Suc d) (map ((*\<^sub>R) 2) (ccw.selsort 0 (inl (snd X))))) =
       pdevs_val (\<lambda>i. if i \<le> d then 2 else 0) (pdevs_of_list (ccw.selsort 0 (inl (snd X))))"
     (is "_ = pdevs_val ?e _")
     by (subst sum_list_take_pdevs_val_eq)
       (auto simp: pdevs_val_sum if_distrib pdevs_apply_pdevs_of_list
         degree_pdevs_of_list_scaleR intro!: sum.cong )
   also
   obtain e'' where "\<dots> = pdevs_val e'' (pdevs_of_list (inl (snd X)))" "e'' \<in> UNIV \<rightarrow> {0..2}"
     by (auto intro: pdevs_val_selsort_ccw2[of "inl (snd X)" ?e "{0 .. 2}"])
   note this(1)
   also note inl_def
   also
   let ?l = "map snd (list_of_pdevs (nlex_pdevs (snd X)))"
   from pdevs_val_independent_pdevs2[OF \<open>e'' \<in> _\<close>]
   obtain e'''
   where "pdevs_val e'' (pdevs_of_list (independent_pdevs ?l)) = pdevs_val e''' (pdevs_of_list ?l)"
     and "e''' \<in> UNIV \<rightarrow> {0..2}"
     by auto
   note this(1)
   also
   have "0 \<in> {0 .. 2::real}" by simp
   from pdevs_val_of_list_of_pdevs[OF \<open>e''' \<in> _\<close> this, of "nlex_pdevs (snd X)"]
   obtain e'''' where "pdevs_val e''' (pdevs_of_list ?l) = pdevs_val e'''' (nlex_pdevs (snd X))"
     and "e'''' \<in> UNIV \<rightarrow> {0 .. 2}"
     by metis
   note this(1)
   finally have
     "y2 = fst X + (pdevs_val e'''' (nlex_pdevs (snd X)) - pdevs_val (\<lambda>_. 1) (nlex_pdevs (snd X)))"
     by simp
   also have "pdevs_val e'''' (nlex_pdevs (snd X)) - pdevs_val (\<lambda>_. 1) (nlex_pdevs (snd X)) =
       pdevs_val (\<lambda>i. e'''' i - 1) (nlex_pdevs (snd X))"
     by (simp add: pdevs_val_minus)
   also
   have "(\<lambda>i. e'''' i - 1) \<in> UNIV \<rightarrow> {-1 .. 1}" using \<open>e'''' \<in> _\<close> by auto
   from pdevs_val_nlex_pdevs2[OF this]
   obtain f where "f \<in> UNIV \<rightarrow>  {-1 .. 1}"
     and "pdevs_val (\<lambda>i. e'''' i - 1) (nlex_pdevs (snd X)) = pdevs_val f (snd X)"
     by auto
   note this(2)
   finally have "y2 = aform_val f X" by (simp add: aform_val_def)
   thus ?thesis using \<open>f \<in> _\<close> ..
 qed
 
 lemma fst_hd_half_segments_of_aform:
   assumes "half_segments_of_aform X \<noteq> []"
   shows "fst (hd (half_segments_of_aform X)) = lowest_vertex (fst X, (nlex_pdevs (snd X)))"
   using assms
   by (auto simp: half_segments_of_aform_def Let_def fst_hd_polychain_of)
 
 lemma
   "linorder_list0.sortedP (ccw' (lowest_vertex (fst X, nlex_pdevs (snd X))))
     (map snd (half_segments_of_aform X))"
   (is "linorder_list0.sortedP (ccw' ?x0) ?ms")
   unfolding half_segments_of_aform_def Let_def
   by (rule ccw'_sortedP_polychain_of_snd) (rule ccw'_sortedP_scaled_inl)
 
 lemma rev_zip: "length xs = length ys \<Longrightarrow> rev (zip xs ys) = zip (rev xs) (rev ys)"
   by (induct xs ys rule: list_induct2) auto
 
 lemma zip_upt_self_aux: "zip [0..<length xs] xs = map (\<lambda>i. (i, xs ! i)) [0..<length xs]"
   by (auto intro!: nth_equalityI)
 
 lemma half_segments_of_aform_strict:
   assumes "e \<in> UNIV \<rightarrow> {-1 <..< 1}"
   assumes "seg \<in> set (half_segments_of_aform X)"
   assumes "length (half_segments_of_aform X) \<noteq> 1"
   shows "ccw' (fst seg) (snd seg) (aform_val e X)"
   using assms unfolding half_segments_of_aform_def Let_def
 proof -
   have len: "length (map ((*\<^sub>R) 2) (linorder_list0.selsort (ccw 0) (inl (snd X)))) \<noteq> 1"
     using assms by (auto simp: half_segments_of_aform_def)
 
   have "aform_val e X = fst X + pdevs_val e (snd X)"
     by (simp add: aform_val_def)
   also
   obtain e' where "e' \<in> UNIV \<rightarrow> {-1 <..< 1}"
     "pdevs_val e (snd X) = pdevs_val e' (nlex_pdevs (snd X))"
     using pdevs_val_nlex_pdevs[OF \<open>e \<in> _\<close>]
     by auto
   note this(2)
   also obtain e'' where "e'' \<in> UNIV \<rightarrow> {-1 <..< 1}"
     "\<dots> = pdevs_val e'' (pdevs_of_list (map snd (list_of_pdevs (nlex_pdevs (snd X)))))"
     by (metis pdevs_val_of_list_of_pdevs2[OF \<open>e' \<in> _\<close>])
   note this(2)
   also
   obtain e''' where "e''' \<in> UNIV \<rightarrow> {-1 <..< 1}" "\<dots> = pdevs_val e''' (pdevs_of_list (inl (snd X)))"
     unfolding inl_def
     using
       pdevs_val_independent_pdevs_strict[OF list_all_list_of_pdevsI,
         OF lex_nlex_pdevs list_of_pdevs_all_nonzero \<open>e'' \<in> _\<close>]
     by metis
   note this(2)
   also
   from pdevs_val_selsort_ccw[OF distinct_inl \<open>e''' \<in> _\<close>]
   obtain f where "f \<in> UNIV \<rightarrow> {-1 <..< 1}"
     "\<dots> = pdevs_val f (pdevs_of_list (linorder_list0.selsort (ccw 0) (inl (snd X))))"
     (is "_ = pdevs_val _ (pdevs_of_list ?sl)")
     by metis
   note this(2)
   also have "\<dots> = pdevs_val (\<lambda>i. f i + 1) (pdevs_of_list ?sl) +
       lowest_vertex (fst X, nlex_pdevs (snd X)) - fst X"
   proof -
     have "sum_list (dense_list_of_pdevs (nlex_pdevs (snd X))) =
         sum_list (dense_list_of_pdevs (pdevs_of_list (ccw.selsort 0 (inl (snd X)))))"
       by (subst dense_list_of_pdevs_pdevs_of_list)
         (auto simp: in_set_independent_pdevs_nonzero dense_list_of_pdevs_pdevs_of_list inl_def
           sum_list_distinct_selsort sum_list_independent_pdevs sum_list_list_of_pdevs)
     thus ?thesis
       by (auto simp add: pdevs_val_add lowest_vertex_def algebra_simps pdevs_val_sum_list
         sum_list_list_of_pdevs in_set_inl_nonzero dense_list_of_pdevs_pdevs_of_list)
   qed
   also have "pdevs_val (\<lambda>i. f i + 1) (pdevs_of_list ?sl) =
       pdevs_val (\<lambda>i. 1/2 * (f i + 1)) (pdevs_of_list (map ((*\<^sub>R) 2) ?sl))"
     (is "_ = pdevs_val ?f' (pdevs_of_list ?ssl)")
     by (subst pdevs_val_cmul) (simp add: pdevs_of_list_map_scaleR)
   also
   have "distinct ?ssl" "?f' \<in> UNIV \<rightarrow> {0<..<1}" using \<open>f \<in> _\<close>
     by (auto simp: distinct_map_scaleRI Pi_iff algebra_simps real_0_less_add_iff)
   from pdevs_of_list_sum[OF this]
   obtain g where "g \<in> UNIV \<rightarrow> {0<..<1}"
     "pdevs_val ?f' (pdevs_of_list ?ssl) = (\<Sum>P\<in>set ?ssl. g P *\<^sub>R P)"
     by blast
   note this(2)
   finally
   have "aform_val e X = lowest_vertex (fst X, nlex_pdevs (snd X)) + (\<Sum>P\<in>set ?ssl. g P *\<^sub>R P)"
     by simp
   also
   have "ccw' (fst seg) (snd seg) \<dots>"
     using \<open>g \<in> _\<close> _ len \<open>seg \<in> _\<close>[unfolded half_segments_of_aform_def Let_def]
     by (rule in_polychain_of_ccw) (simp add: ccw'_sortedP_scaled_inl)
   finally show ?thesis .
 qed
 
 lemma half_segments_of_aform_strict_all:
   assumes "e \<in> UNIV \<rightarrow> {-1 <..< 1}"
   assumes "length (half_segments_of_aform X) \<noteq> 1"
   shows "list_all (\<lambda>seg. ccw' (fst seg) (snd seg) (aform_val e X)) (half_segments_of_aform X)"
   using assms
   by (auto intro!: half_segments_of_aform_strict simp: list_all_iff)
 
 lemma list_allD: "list_all P xs \<Longrightarrow> x \<in> set xs \<Longrightarrow> P x"
   by (auto simp: list_all_iff)
 
 lemma minus_one_less_multI:
   fixes e x::real
   shows "- 1 \<le> e \<Longrightarrow> 0 < x \<Longrightarrow> x < 1 \<Longrightarrow> - 1 < e * x"
   by (metis abs_add_one_gt_zero abs_real_def le_less_trans less_not_sym mult_less_0_iff
     mult_less_cancel_left1 real_0_less_add_iff)
 
 lemma less_one_multI:
   fixes e x::real
   shows "e \<le> 1 \<Longrightarrow> 0 < x \<Longrightarrow> x < 1 \<Longrightarrow> e * x < 1"
   by (metis (erased, opaque_lifting) less_eq_real_def monoid_mult_class.mult.left_neutral
     mult_strict_mono zero_less_one)
 
 lemma ccw_half_segments_of_aform_strictI:
   assumes "e \<in> UNIV \<rightarrow> {-1 <..< 1}"
   assumes "(s1, s2) \<in> set (half_segments_of_aform X)"
   assumes "length (half_segments_of_aform X) \<noteq> 1"
   assumes "x = (aform_val e X)"
   shows "ccw' s1 s2 x"
   using half_segments_of_aform_strict[OF assms(1-3)] assms(4) by simp
 
 lemma
   ccw'_sortedP_subsequent:
   assumes "Suc i < length xs" "ccw'.sortedP 0 (map dirvec xs)" "fst (xs ! Suc i) = snd (xs ! i)"
   shows "ccw' (fst (xs ! i)) (snd (xs ! i)) (snd (xs ! Suc i))"
   using assms
 proof (induct xs arbitrary: i)
   case Nil thus ?case by simp
 next
   case (Cons x xs)
   thus ?case
     by (auto simp: nth_Cons dirvec_minus split: nat.split elim!: ccw'.sortedP_Cons)
       (metis (no_types, lifting) ccw'.renormalize length_greater_0_conv nth_mem prod.case_eq_if)
 qed
 
 lemma ccw'_sortedP_uminus: "ccw'.sortedP 0 xs \<Longrightarrow> ccw'.sortedP 0 (map uminus xs)"
   by (induct xs) (auto intro!: ccw'.sortedP.Cons elim!: ccw'.sortedP_Cons simp del: uminus_Pair)
 
 lemma subsequent_half_segments_ccw:
   fixes X
   assumes "Suc i < length (half_segments_of_aform X)"
   shows "ccw' (fst (half_segments_of_aform X ! i)) (snd (half_segments_of_aform X ! i))
     (snd (half_segments_of_aform X ! Suc i))"
   using assms
   by (intro ccw'_sortedP_subsequent )
     (auto simp: subsequent_half_segments half_segments_of_aform_def
       sorted_inl polychain_of_subsequent_eq intro!: ccw_sorted_implies_ccw'_sortedP[OF inl_ncoll]
       ccw'_sorted_scaleR)
 
 lemma convex_polychain_half_segments_of_aform: "convex_polychain (half_segments_of_aform X)"
 proof cases
   assume "length (half_segments_of_aform X) = 1"
   thus ?thesis
     by (auto simp: length_Suc_conv convex_polychain_def polychain_def)
 next
   assume len: "length (half_segments_of_aform X) \<noteq> 1"
   show ?thesis
     by (rule convex_polychainI)
       (simp_all add: polychain_half_segments_of_aform subsequent_half_segments_ccw
         ccw'_def[symmetric])
 qed
 
 lemma hd_distinct_neq_last: "distinct xs \<Longrightarrow> length xs > 1 \<Longrightarrow> hd xs \<noteq> last xs"
   by (metis One_nat_def add_Suc_right distinct.simps(2) last.simps last_in_set less_irrefl
     list.exhaust list.sel(1) list.size(3) list.size(4) add.right_neutral nat_neq_iff not_less0)
 
 lemma ccw_hd_last_half_segments_dirvec:
   assumes "length (half_segments_of_aform X) > 1"
   shows "ccw' 0 (dirvec (hd (half_segments_of_aform X))) (dirvec (last (half_segments_of_aform X)))"
 proof -
   let ?i = "ccw.selsort 0 (inl (snd X))"
   let ?s = "map ((*\<^sub>R) 2) (ccw.selsort 0 (inl (snd X)))"
   from assms have l: "1 < length (inl (snd X))" "inl (snd X) \<noteq> []"
     using assms by (auto simp add: half_segments_of_aform_def)
   hence "hd ?i \<in> set ?i" "last ?i \<in> set ?i"
     by (auto intro!: hd_in_set last_in_set simp del: ccw.set_selsort)
   hence "\<not>coll 0 (hd ?i) (last ?i)" using l
     by (intro inl_ncoll[of _ X]) (auto simp: hd_distinct_neq_last)
   hence "\<not>coll 0 (hd ?s) (last ?s)" using l
     by (auto simp: hd_map last_map)
   hence "ccw' 0 (hd (map ((*\<^sub>R) 2) (linorder_list0.selsort (ccw 0) (inl (snd X)))))
      (last (map ((*\<^sub>R) 2) (linorder_list0.selsort (ccw 0) (inl (snd X)))))"
     using assms
     by (auto simp add: half_segments_of_aform_def
       intro!: sorted_inl ccw_sorted_scaleR ccw.hd_last_sorted ccw_ncoll_imp_ccw)
   with assms show ?thesis
     by (auto simp add: half_segments_of_aform_def Let_def
         dirvec_hd_polychain_of dirvec_last_polychain_of length_greater_0_conv[symmetric]
       simp del: polychain_of.simps length_greater_0_conv
       split: if_split_asm)
 qed
 
 lemma map_fst_half_segments_aux_eq: "[] \<noteq> half_segments_of_aform X \<Longrightarrow>
     map fst (half_segments_of_aform X) =
       fst (hd (half_segments_of_aform X))#butlast (map snd (half_segments_of_aform X))"
   by (rule nth_equalityI)
     (auto simp: nth_Cons hd_conv_nth nth_butlast subsequent_half_segments split: nat.split)
 
 lemma le_less_Suc_eq: "x - Suc 0 \<le> (i::nat) \<Longrightarrow> i < x \<Longrightarrow> x - Suc 0 = i"
   by simp
 
 lemma map_snd_half_segments_aux_eq: "half_segments_of_aform X \<noteq> [] \<Longrightarrow>
     map snd (half_segments_of_aform X) =
       tl (map fst (half_segments_of_aform X)) @ [snd (last (half_segments_of_aform X))]"
   by (rule nth_equalityI)
     (auto simp: nth_Cons hd_conv_nth nth_append nth_tl subsequent_half_segments
       not_less last_conv_nth algebra_simps dest!: le_less_Suc_eq
     split: nat.split)
 
 lemma ccw'_sortedP_snd_half_segments_of_aform:
   "ccw'.sortedP (lowest_vertex (fst X, nlex_pdevs (snd X))) (map snd (half_segments_of_aform X))"
   by (auto simp: half_segments_of_aform_def Let_def
     intro!: ccw'.sortedP.Cons ccw'_sortedP_polychain_of_snd ccw'_sortedP_scaled_inl)
 
 lemma
   lex_half_segments_lowest_vertex:
   assumes "(c, d) \<in> set (half_segments_of_aform X)"
   shows "lex d (lowest_vertex (fst X, nlex_pdevs (snd X)))"
   unfolding half_segments_of_aform_def Let_def
   by (rule lex_polychain_of_center[OF assms[unfolded half_segments_of_aform_def Let_def],
       unfolded snd_conv])
     (auto simp: list_all_iff lex_def dest!: in_set_inl_lex)
 
 lemma
   lex_half_segments_lowest_vertex':
   assumes "d \<in> set (map snd (half_segments_of_aform X))"
   shows "lex d (lowest_vertex (fst X, nlex_pdevs (snd X)))"
   using assms
   by (auto intro: lex_half_segments_lowest_vertex)
 
 lemma
   lex_half_segments_last:
   assumes "(c, d) \<in> set (half_segments_of_aform X)"
   shows "lex (snd (last (half_segments_of_aform X))) d"
   using assms
   unfolding half_segments_of_aform_def Let_def
   by (rule lex_polychain_of_last) (auto simp: list_all_iff lex_def dest!: in_set_inl_lex)
 
 lemma
   lex_half_segments_last':
   assumes "d \<in> set (map snd (half_segments_of_aform X))"
   shows "lex (snd (last (half_segments_of_aform X))) d"
   using assms
   by (auto intro: lex_half_segments_last)
 
 lemma
   ccw'_half_segments_lowest_last:
   assumes set_butlast: "(c, d) \<in> set (butlast (half_segments_of_aform X))"
   assumes ne: "inl (snd X) \<noteq> []"
   shows "ccw' (lowest_vertex (fst X, nlex_pdevs (snd X))) d (snd (last (half_segments_of_aform X)))"
   using set_butlast
   unfolding half_segments_of_aform_def Let_def
   by (rule ccw'_polychain_of_sorted_center_last) (auto simp: ne ccw'_sortedP_scaled_inl)
 
 lemma distinct_fst_half_segments:
   "distinct (map fst (half_segments_of_aform X))"
   by (auto simp: half_segments_of_aform_def list_all_iff lex_scale1_zero
     simp del: scaleR_Pair
     intro!: distinct_fst_polychain_of
     dest: in_set_inl_nonzero in_set_inl_lex)
 
 lemma distinct_snd_half_segments:
   "distinct (map snd (half_segments_of_aform X))"
   by (auto simp: half_segments_of_aform_def list_all_iff lex_scale1_zero
     simp del: scaleR_Pair
     intro!: distinct_snd_polychain_of
     dest: in_set_inl_nonzero in_set_inl_lex)
 
 
 subsection \<open>Mirror\<close>
 
 definition "mirror_point x y = 2 *\<^sub>R x - y"
 
 lemma ccw'_mirror_point3[simp]:
   "ccw' (mirror_point x y) (mirror_point x z) (mirror_point x w) \<longleftrightarrow> ccw' y z w "
   by (auto simp: mirror_point_def det3_def' ccw'_def algebra_simps)
 
 lemma mirror_point_self_inverse[simp]:
   fixes x::"'a::real_vector"
   shows "mirror_point p (mirror_point p x) = x"
   by (auto simp: mirror_point_def scaleR_2)
 
 lemma mirror_half_segments_of_aform:
   assumes "e \<in> UNIV \<rightarrow> {-1 <..< 1}"
   assumes "length (half_segments_of_aform X) \<noteq> 1"
   shows "list_all (\<lambda>seg. ccw' (fst seg) (snd seg) (aform_val e X))
       (map (pairself (mirror_point (fst X))) (half_segments_of_aform X))"
   unfolding list_all_length
 proof safe
   let ?m = "map (pairself (mirror_point (fst X))) (half_segments_of_aform X)"
   fix n assume "n < length ?m"
   hence "ccw' (fst (half_segments_of_aform X ! n)) (snd (half_segments_of_aform X ! n))
       (aform_val (- e) X)"
     using assms
     by (auto dest!: nth_mem intro!: half_segments_of_aform_strict)
   also have "aform_val (-e) X = 2 *\<^sub>R fst X - aform_val e X"
     by (auto simp: aform_val_def pdevs_val_sum algebra_simps scaleR_2 sum_negf)
   finally have le:
     "ccw' (fst (half_segments_of_aform X ! n)) (snd (half_segments_of_aform X ! n))
       (2 *\<^sub>R fst X - aform_val e X)"
     .
 
   have eq: "(map (pairself (mirror_point (fst X))) (half_segments_of_aform X) ! n) =
     (2 *\<^sub>R fst X - fst ((half_segments_of_aform X) ! n),
      2 *\<^sub>R fst X - snd ((half_segments_of_aform X) ! n))"
     using \<open>n < length ?m\<close>
     by (cases "half_segments_of_aform X ! n") (auto simp add: mirror_point_def)
   show "ccw' (fst (?m ! n)) (snd (?m ! n)) (aform_val e X)"
     using le
     unfolding eq
     by (auto simp: algebra_simps ccw'_def det3_def')
 qed
 
 lemma last_half_segments:
   assumes "half_segments_of_aform X \<noteq> []"
   shows "snd (last (half_segments_of_aform X)) =
     mirror_point (fst X) (lowest_vertex (fst X, nlex_pdevs (snd X)))"
   using assms
   by (auto simp add: half_segments_of_aform_def Let_def lowest_vertex_def mirror_point_def scaleR_2
     scaleR_sum_list[symmetric] last_polychain_of sum_list_distinct_selsort inl_def
     sum_list_independent_pdevs sum_list_list_of_pdevs)
 
 lemma convex_polychain_map_mirror:
   assumes "convex_polychain hs"
   shows "convex_polychain (map (pairself (mirror_point x)) hs)"
 proof (rule convex_polychainI)
 qed (insert assms, auto simp: convex_polychain_def polychain_map_pairself pairself_apply
   mirror_point_def det3_def' algebra_simps)
 
 lemma ccw'_mirror_point0:
   "ccw' (mirror_point x y) z w \<longleftrightarrow> ccw' y (mirror_point x z) (mirror_point x w)"
   by (metis ccw'_mirror_point3 mirror_point_self_inverse)
 
 lemma ccw'_sortedP_mirror:
   "ccw'.sortedP x0 (map (mirror_point p0) xs) \<longleftrightarrow> ccw'.sortedP (mirror_point p0 x0) xs"
   by (induct xs)
     (simp_all add: linorder_list0.sortedP.Nil linorder_list0.sortedP_Cons_iff ccw'_mirror_point0)
 
 lemma ccw'_sortedP_mirror2:
   "ccw'.sortedP (mirror_point p0 x0) (map (mirror_point p0) xs) \<longleftrightarrow> ccw'.sortedP x0 xs"
   using ccw'_sortedP_mirror[of "mirror_point p0 x0" p0 xs]
   by simp
 
 lemma map_mirror_o_snd_polychain_of_eq: "map (mirror_point x0 \<circ> snd) (polychain_of y xs) =
   map snd (polychain_of (mirror_point x0 y) (map uminus xs))"
   by (induct xs arbitrary: x0 y) (auto simp: mirror_point_def o_def algebra_simps)
 
 lemma lowest_vertex_eq_mirror_last:
   "half_segments_of_aform X \<noteq> [] \<Longrightarrow>
     (lowest_vertex (fst X, nlex_pdevs (snd X))) =
     mirror_point (fst X) (snd (last (half_segments_of_aform X)))"
   using last_half_segments[of X] by simp
 
 lemma snd_last: "xs \<noteq> [] \<Longrightarrow> snd (last xs) = last (map snd xs)"
   by (induct xs) auto
 
 lemma mirror_point_snd_last_eq_lowest:
   "half_segments_of_aform X \<noteq> [] \<Longrightarrow>
     mirror_point (fst X) (last (map snd (half_segments_of_aform X))) =
       lowest_vertex (fst X, nlex_pdevs (snd X))"
   by (simp add: lowest_vertex_eq_mirror_last snd_last)
 
 lemma lex_mirror_point: "lex (mirror_point x0 a) (mirror_point x0 b) \<Longrightarrow> lex b a"
   by (auto simp: mirror_point_def lex_def)
 
 lemma ccw'_mirror_point:
   "ccw' (mirror_point x0 a) (mirror_point x0 b)  (mirror_point x0 c) \<Longrightarrow> ccw' a b c"
   by (auto simp: mirror_point_def)
 
 lemma inj_mirror_point: "inj (mirror_point (x::'a::real_vector))"
   by (auto simp: mirror_point_def inj_on_def algebra_simps)
 
 lemma
   distinct_map_mirror_point_eq:
   "distinct (map (mirror_point (x::'a::real_vector)) xs) = distinct xs"
   by (auto simp: distinct_map intro!: subset_inj_on[OF inj_mirror_point])
 
 lemma eq_self_mirror_iff: fixes x::"'a::real_vector" shows "x = mirror_point y x \<longleftrightarrow> x = y"
   by (auto simp: mirror_point_def algebra_simps scaleR_2[symmetric])
 
 
 subsection \<open>Full Segments\<close>
 
 definition segments_of_aform::"point aform \<Rightarrow> (point * point) list"
   where "segments_of_aform X =
     (let hs = half_segments_of_aform X in hs @ map (pairself (mirror_point (fst X))) hs)"
 
 lemma segments_of_aform_strict:
   assumes "e \<in> UNIV \<rightarrow> {-1 <..< 1}"
   assumes "length (half_segments_of_aform X) \<noteq> 1"
   shows "list_all (\<lambda>seg. ccw' (fst seg) (snd seg) (aform_val e X)) (segments_of_aform X)"
   using assms
   by (auto simp: segments_of_aform_def Let_def mirror_half_segments_of_aform
     half_segments_of_aform_strict_all)
   
 
 lemma mirror_point_aform_val[simp]: "mirror_point (fst X) (aform_val e X) = aform_val (- e) X"
   by (auto simp: mirror_point_def aform_val_def pdevs_val_sum algebra_simps scaleR_2 sum_negf)
 
 lemma
   in_set_segments_of_aform_aform_valE:
   assumes "(x2, y2) \<in> set (segments_of_aform X)"
   obtains e where "y2 = aform_val e X" "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   using assms
 proof (auto simp: segments_of_aform_def Let_def)
   assume "(x2, y2) \<in> set (half_segments_of_aform X)"
   from in_set_half_segments_of_aform_aform_valE[OF this]
   obtain e where "y2 = aform_val e X" "e \<in> UNIV \<rightarrow> {- 1..1}" by auto
   thus ?thesis ..
 next
   fix a b aa ba
   assume "((a, b), aa, ba) \<in> set (half_segments_of_aform X)"
   from in_set_half_segments_of_aform_aform_valE[OF this]
   obtain e where e: "(aa, ba) = aform_val e X" "e \<in> UNIV \<rightarrow> {- 1..1}" by auto
   assume "y2 = mirror_point (fst X) (aa, ba)"
   hence "y2 = aform_val (-e) X" "(-e) \<in> UNIV \<rightarrow> {-1 .. 1}" using e by auto
   thus ?thesis ..
 qed
 
 lemma
   last_half_segments_eq_mirror_hd:
   assumes "half_segments_of_aform X \<noteq> []"
   shows "snd (last (half_segments_of_aform X)) = mirror_point (fst X) (fst (hd (half_segments_of_aform X)))"
   by (simp add: last_half_segments assms fst_hd_half_segments_of_aform)
 
 lemma polychain_segments_of_aform: "polychain (segments_of_aform X)"
   by (auto simp: segments_of_aform_def Let_def polychain_half_segments_of_aform
     polychain_map_pairself last_half_segments_eq_mirror_hd hd_map pairself_apply
     intro!: polychain_appendI)
 
 lemma segments_of_aform_closed:
   assumes "segments_of_aform X \<noteq> []"
   shows "fst (hd (segments_of_aform X)) = snd (last (segments_of_aform X))"
   using assms
   by (auto simp: segments_of_aform_def Let_def fst_hd_half_segments_of_aform last_map
     pairself_apply last_half_segments mirror_point_def)
 
 lemma convex_polychain_segments_of_aform:
   assumes "1 < length (half_segments_of_aform X)"
   shows "convex_polychain (segments_of_aform X)"
   unfolding segments_of_aform_def Let_def
     using ccw_hd_last_half_segments_dirvec[OF assms]
   by (intro convex_polychain_appendI)
     (auto
       simp: convex_polychain_half_segments_of_aform convex_polychain_map_mirror dirvec_minus hd_map
         pairself_apply last_half_segments mirror_point_def fst_hd_half_segments_of_aform det3_def'
         algebra_simps ccw'_def
       intro!: polychain_appendI polychain_half_segments_of_aform polychain_map_pairself)
 
 lemma convex_polygon_segments_of_aform:
   assumes "1 < length (half_segments_of_aform X)"
   shows "convex_polygon (segments_of_aform X)"
 proof -
   from assms have hne: "half_segments_of_aform X \<noteq> []"
     by auto
   from convex_polychain_segments_of_aform[OF assms]
   have "convex_polychain (segments_of_aform X)" .
   thus ?thesis
     by (auto simp: convex_polygon_def segments_of_aform_closed)
 qed
 
 lemma
   previous_segments_of_aformE:
   assumes "(y, z) \<in> set (segments_of_aform X)"
   obtains x where "(x, y) \<in> set (segments_of_aform X)"
 proof -
   from assms have ne[simp]: "segments_of_aform X \<noteq> []"
     by auto
   from assms
   obtain i where i: "i<length (segments_of_aform X)" "(segments_of_aform X) ! i = (y, z)"
     by (auto simp: in_set_conv_nth)
   show ?thesis
   proof (cases i)
     case 0
     with segments_of_aform_closed[of X] assms
     have "(fst (last (segments_of_aform X)), y) \<in> set (segments_of_aform X)"
       by (metis fst_conv hd_conv_nth i(2) last_in_set ne snd_conv surj_pair)
     thus ?thesis ..
   next
     case (Suc j)
     have "(fst (segments_of_aform X ! j), snd (segments_of_aform X ! j)) \<in>
         set (segments_of_aform X)"
       using Suc i(1) by auto
     also
     from i have "y = fst (segments_of_aform X ! i)"
       by auto
     hence "snd (segments_of_aform X ! j) = y"
       using polychain_segments_of_aform[of X] i(1) Suc
       by (auto simp: polychain_def Suc)
     finally have "(fst (segments_of_aform X ! j), y) \<in> set (segments_of_aform X)" .
     thus ?thesis ..
   qed
 qed
 
 lemma fst_compose_pairself: "fst o pairself f = f o fst"
   and snd_compose_pairself: "snd o pairself f = f o snd"
   by (auto simp: pairself_apply)
 
 lemma in_set_butlastI: "xs \<noteq> [] \<Longrightarrow> x \<in> set xs \<Longrightarrow> x \<noteq> last xs \<Longrightarrow> x \<in> set (butlast xs)"
   by (induct xs) (auto split: if_splits)
 
 lemma distinct_in_set_butlastD:
   "x \<in> set (butlast xs) \<Longrightarrow> distinct xs \<Longrightarrow> x \<noteq> last xs"
   by (induct xs) auto
 
 lemma distinct_in_set_tlD:
   "x \<in> set (tl xs) \<Longrightarrow> distinct xs \<Longrightarrow> x \<noteq> hd xs"
   by (induct xs) auto
 
 lemma ccw'_sortedP_snd_segments_of_aform:
   assumes "length (inl (snd X)) > 1"
   shows
     "ccw'.sortedP (lowest_vertex (fst X, nlex_pdevs (snd X)))
       (butlast (map snd (segments_of_aform X)))"
 proof cases
   assume "[] = half_segments_of_aform X"
   from this show ?thesis
     by (simp add: segments_of_aform_def Let_def ccw'.sortedP.Nil)
 next
   assume H: "[] \<noteq> half_segments_of_aform X"
   let ?m = "mirror_point (fst X)"
   have ne: "inl (snd X) \<noteq> []" using assms by auto
   have "ccw'.sortedP (lowest_vertex (fst X, nlex_pdevs (snd X)))
      (map snd (half_segments_of_aform X) @ butlast (map (?m \<circ> snd)
     (half_segments_of_aform X)))"
   proof (rule ccw'.sortedP_appendI)
     show "ccw'.sortedP (lowest_vertex (fst X, nlex_pdevs (snd X))) (map snd (half_segments_of_aform X))"
       by (rule ccw'_sortedP_snd_half_segments_of_aform)
     have "butlast (map (?m \<circ> snd) (half_segments_of_aform X)) =
       butlast
        (map (?m \<circ> snd) (polychain_of (lowest_vertex (fst X, nlex_pdevs (snd X)))
          (map ((*\<^sub>R) 2) (ccw.selsort 0 (inl (snd X))))))"
       by (simp add: half_segments_of_aform_def)
     also have "\<dots> =
        map snd
         (butlast
           (polychain_of (?m (lowest_vertex (fst X, nlex_pdevs (snd X))))
             (map uminus (map ((*\<^sub>R) 2) (ccw.selsort 0 (inl (snd X)))))))"
       (is "_ = map snd (butlast (polychain_of ?x ?xs))")
       by (simp add: map_mirror_o_snd_polychain_of_eq map_butlast)
     also
     {
       have "ccw'.sortedP 0 ?xs"
         by (intro ccw'_sortedP_uminus ccw'_sortedP_scaled_inl)
       moreover
       have "ccw'.sortedP ?x (map snd (polychain_of ?x ?xs))"
         unfolding ccw'_sortedP_mirror[symmetric] map_map map_mirror_o_snd_polychain_of_eq
         by (auto simp add: o_def intro!: ccw'_sortedP_polychain_of_snd ccw'_sortedP_scaled_inl)
       ultimately
       have "ccw'.sortedP (snd (last (polychain_of ?x ?xs)))
           (map snd (butlast (polychain_of ?x ?xs)))"
         by (rule ccw'_sortedP_convex_rotate_aux)
     }
     also have "(snd (last (polychain_of ?x ?xs))) =
         ?m (last (map snd (half_segments_of_aform X)))"
       by (simp add: half_segments_of_aform_def ne map_mirror_o_snd_polychain_of_eq
          last_map[symmetric, where f="?m"]
          last_map[symmetric, where f="snd"])
     also have "\<dots> = lowest_vertex (fst X, nlex_pdevs (snd X))"
       using ne H
       by (auto simp: lowest_vertex_eq_mirror_last snd_last)
     finally show "ccw'.sortedP (lowest_vertex (fst X, nlex_pdevs (snd X)))
        (butlast (map (?m \<circ> snd) (half_segments_of_aform X)))" .
   next
     fix x y
     assume seg: "x \<in> set (map snd (half_segments_of_aform X))"
       and mseg: "y \<in> set (butlast (map (?m \<circ> snd) (half_segments_of_aform X)))"
     from seg assms have neq_Nil: "inl (snd X) \<noteq> []" "half_segments_of_aform X \<noteq> []"
       by auto
 
     from seg obtain a where a: "(a, x) \<in> set (half_segments_of_aform X)"
       by auto
     from mseg obtain b
     where mirror_y: "(b, ?m y) \<in> set (butlast (half_segments_of_aform X))"
       by (auto simp: map_butlast[symmetric])
 
     let ?l = "lowest_vertex (fst X, nlex_pdevs (snd X))"
     let ?ml = "?m ?l"
 
     have mirror_eq_last: "?ml = snd (last (half_segments_of_aform X))"
       using seg H
       by (intro last_half_segments[symmetric]) simp
 
     define r
       where "r = ?l + (0, abs (snd x - snd ?l) + abs (snd y - snd ?l) + abs (snd ?ml - snd ?l) + 1)"
 
     have d1: "x \<noteq> r" "y \<noteq> r" "?l \<noteq> r" "?ml \<noteq> r"
       by (auto simp: r_def plus_prod_def prod_eq_iff)
     have "distinct (map (?m \<circ> snd) (half_segments_of_aform X))"
       unfolding map_comp_map[symmetric]
       unfolding o_def distinct_map_mirror_point_eq
       by (rule distinct_snd_half_segments)
     from distinct_in_set_butlastD[OF \<open>y \<in> _\<close> this]
     have "?l \<noteq> y"
       by (simp add: neq_Nil lowest_vertex_eq_mirror_last last_map)
     moreover have "?l \<noteq> ?ml"
       using neq_Nil by (auto simp add: eq_self_mirror_iff lowest_vertex_eq_center_iff inl_def)
     ultimately
     have d2: "?l \<noteq> y" "?l \<noteq> ?ml"
       by auto
 
     have *: "ccw' ?l (?m y) ?ml"
       by (metis mirror_eq_last ccw'_half_segments_lowest_last mirror_y neq_Nil(1))
     have "ccw' ?ml y ?l"
       by (rule ccw'_mirror_point[of "fst X"]) (simp add: *)
     hence lmy: "ccw' ?l ?ml y"
       by (simp add: ccw'_def det3_def' algebra_simps)
     let ?ccw = "ccw' (lowest_vertex (fst X, nlex_pdevs (snd X))) x y"
     {
       assume "x \<noteq> ?ml"
       hence x_butlast: "(a, x) \<in> set (butlast (half_segments_of_aform X))"
         unfolding mirror_eq_last
         using a
         by (auto intro!: in_set_butlastI simp: prod_eq_iff)
       have "ccw' ?l x ?ml"
         by (metis mirror_eq_last ccw'_half_segments_lowest_last x_butlast neq_Nil(1))
     } note lxml = this
     {
       assume "x = ?ml"
       hence ?ccw
         by (simp add: lmy)
     } moreover {
       assume "x \<noteq> ?ml" "y = ?ml"
       hence ?ccw
         by (simp add: lxml)
     } moreover {
       assume d3: "x \<noteq> ?ml" "y \<noteq> ?ml"
 
       from \<open>x \<in> set _\<close>
       have "x \<in> set (map snd (half_segments_of_aform X))" by force
       hence "x \<in> set (tl (map fst (half_segments_of_aform X)))"
         using d3
         unfolding map_snd_half_segments_aux_eq[OF neq_Nil(2)]
         by (auto simp: mirror_eq_last)
       from distinct_in_set_tlD[OF this distinct_fst_half_segments]
       have "?l \<noteq> x"
         by (simp add: fst_hd_half_segments_of_aform neq_Nil hd_map)
 
       from lxml[OF \<open>x \<noteq> ?ml\<close>] \<open>ccw' ?l ?ml y\<close>
       have d4: "x \<noteq> y"
         by (rule neq_left_right_of lxml)
 
       have "distinct5 x ?ml y r ?l"
         using d1 d2 \<open>?l \<noteq> x\<close> d3 d4
         by simp_all
       moreover
       note _
       moreover
       have "lex x ?l"
         by (rule lex_half_segments_lowest_vertex) fact
       hence "ccw ?l r x"
         unfolding r_def by (rule lex_ccw_left) simp
       moreover
       have "lex ?ml ?l"
         using last_in_set[OF H[symmetric]]
         by (auto simp: mirror_eq_last intro: lex_half_segments_lowest_vertex')
       hence "ccw ?l r ?ml"
         unfolding r_def by (rule lex_ccw_left) simp
       moreover
       have "lex (?m (lowest_vertex (fst X, nlex_pdevs (snd X)))) (?m y)"
         using mirror_y
         by (force dest!: in_set_butlastD intro: lex_half_segments_last' simp: mirror_eq_last )
       hence "lex y ?l"
         by (rule lex_mirror_point)
       hence "ccw ?l r y"
         unfolding r_def by (rule lex_ccw_left) simp
       moreover
       from \<open>x \<noteq> ?ml\<close> have "ccw ?l x ?ml"
         by (simp add: ccw_def lxml)
       moreover
       from lmy have "ccw ?l ?ml y"
         by (simp add: ccw_def)
       ultimately
       have "ccw ?l x y"
         by (rule ccw.transitive[where S=UNIV]) simp
 
       moreover
       {
         have "x \<noteq> ?l" using \<open>?l \<noteq> x\<close> by simp
         moreover
         have "lex (?m y) (?m ?ml)"
           using mirror_y
           by (force intro: lex_half_segments_lowest_vertex in_set_butlastD)
         hence "lex ?ml y"
           by (rule lex_mirror_point)
         moreover
         from a have "lex ?ml x"
           unfolding mirror_eq_last
           by (rule lex_half_segments_last)
         moreover note \<open>lex y ?l\<close> \<open>lex x ?l\<close> \<open>ccw' ?l x ?ml\<close> \<open>ccw' ?l ?ml y\<close>
         ultimately
         have ncoll: "\<not> coll ?l x y"
           by (rule not_coll_ordered_lexI)
       }
       ultimately have ?ccw
         by (simp add: ccw_def)
     } ultimately show ?ccw
       by blast
   qed
   thus ?thesis using H
     by (simp add: segments_of_aform_def Let_def butlast_append snd_compose_pairself)
 qed
 
 lemma polychain_of_segments_of_aform1:
   assumes "length (segments_of_aform X) = 1"
   shows "False"
   using assms
   by (auto simp: segments_of_aform_def Let_def half_segments_of_aform_def add_is_1
     split: if_split_asm)
 
 lemma polychain_of_segments_of_aform2:
   assumes "segments_of_aform X = [x, y]"
   assumes "between (fst x, snd x) p"
   shows "p \<in> convex hull set (map fst (segments_of_aform X))"
 proof -
   from polychain_segments_of_aform[of X] segments_of_aform_closed[of X] assms
   have "fst y = snd x" "snd y = fst x" by (simp_all add: polychain_def)
   thus ?thesis
     using assms
     by (cases x) (auto simp: between_mem_convex_hull)
 qed
 
 lemma append_eq_2:
   assumes "length xs = length ys"
   shows "xs @ ys = [x, y] \<longleftrightarrow> xs = [x] \<and> ys = [y]"
   using assms
 proof (cases xs)
   case (Cons z zs)
   thus ?thesis using assms by (cases zs) auto
 qed simp
 
 lemma segments_of_aform_line_segment:
   assumes "segments_of_aform X = [x, y]"
   assumes "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "aform_val e X \<in> closed_segment (fst x) (snd x)"
 proof -
   from pdevs_val_pdevs_of_list_inl2E[OF \<open>e \<in> _\<close>, of "snd X"]
   obtain e' where e': "pdevs_val e (snd X) = pdevs_val e' (pdevs_of_list (inl (snd X)))"
     "e' \<in> UNIV \<rightarrow> {- 1..1}" .
   from e' have "0 \<le> 1 + e' 0" by (auto simp: Pi_iff dest!: spec[where x=0])
   with assms e' show ?thesis
     by (auto simp: segments_of_aform_def Let_def append_eq_2 half_segments_of_aform_def
         polychain_of_singleton_iff mirror_point_def ccw.selsort_singleton_iff lowest_vertex_def
         aform_val_def sum_list_nlex_eq_sum_list_inl closed_segment_def Pi_iff
       intro!: exI[where x="(1 + e' 0) / 2"])
       (auto simp: algebra_simps)
 qed
 
 
 subsection \<open>Continuous Generalization\<close>
 
 lemma LIMSEQ_minus_fract_mult:
   "(\<lambda>n. r * (1 - 1 / real (Suc (Suc n)))) \<longlonglongrightarrow> r"
   by (rule tendsto_eq_rhs[OF tendsto_mult[where a=r and b = 1]])
     (auto simp: inverse_eq_divide[symmetric] simp del: of_nat_Suc
       intro: filterlim_compose[OF LIMSEQ_inverse_real_of_nat filterlim_Suc] tendsto_eq_intros)
 
 lemma det3_nonneg_segments_of_aform:
   assumes "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes "length (half_segments_of_aform X) \<noteq> 1"
   shows "list_all (\<lambda>seg. det3 (fst seg) (snd seg) (aform_val e X) \<ge> 0) (segments_of_aform X)"
   unfolding list_all_iff
 proof safe
   fix a b c d
   assume seg: "((a, b), c, d) \<in> set (segments_of_aform X)" (is "?seg \<in> _")
   define normal_of_segment
     where "normal_of_segment = (\<lambda>((a0, a1), b0, b1). (b1 - a1, a0 - b0)::real*real)"
   define support_of_segment
     where "support_of_segment = (\<lambda>(a, b). normal_of_segment (a, b) \<bullet> a)"
   have "closed ((\<lambda>x. x \<bullet> normal_of_segment ?seg) -` {..support_of_segment ?seg})" (is "closed ?cl")
     by (auto intro!: continuous_intros closed_vimage)
   moreover
   define f where "f n i = e i * ( 1 - 1 / (Suc (Suc n)))" for n i
   have "\<forall>n. aform_val (f n) X \<in> ?cl"
   proof
     fix n
     have "f n \<in> UNIV \<rightarrow> {-1 <..< 1}"
       using assms
       by (auto simp: f_def Pi_iff intro!: less_one_multI minus_one_less_multI)
     from list_allD[OF segments_of_aform_strict[OF this assms(2)] seg]
     show "aform_val (f n) X \<in> (\<lambda>x. x \<bullet> normal_of_segment ((a, b), c, d)) -`
         {..support_of_segment ((a, b), c, d)}"
       by (auto simp: list_all_iff normal_of_segment_def support_of_segment_def
         det3_def' field_simps inner_prod_def ccw'_def)
   qed
   moreover
   have "\<And>i. (\<lambda>n. f n i) \<longlonglongrightarrow> e i"
     unfolding f_def
     by (rule LIMSEQ_minus_fract_mult)
   hence "(\<lambda>n. aform_val (f n) X) \<longlonglongrightarrow> aform_val e X"
     by (auto simp: aform_val_def pdevs_val_sum intro!: tendsto_intros)
   ultimately have "aform_val e X \<in> ?cl"
-    by (rule closed_sequentially)
+    by (meson closed_sequentially)
   thus "det3 (fst ?seg) (snd ?seg) (aform_val e X) \<ge> 0"
     by (auto simp: list_all_iff normal_of_segment_def support_of_segment_def det3_def' field_simps
       inner_prod_def)
 qed
 
 lemma det3_nonneg_segments_of_aformI:
   assumes "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes "length (half_segments_of_aform X) \<noteq> 1"
   assumes "seg \<in> set (segments_of_aform X)"
   shows "det3 (fst seg) (snd seg) (aform_val e X) \<ge> 0"
   using assms det3_nonneg_segments_of_aform by (auto simp: list_all_iff)
 
 
 subsection \<open>Intersection of Vertical Line with Segment\<close>
 
 fun intersect_segment_xline'::"nat \<Rightarrow> point * point \<Rightarrow> real \<Rightarrow> point option"
   where "intersect_segment_xline' p ((x0, y0), (x1, y1)) xl =
     (if x0 \<le> xl \<and> xl \<le> x1 then
       if x0 = x1 then Some ((min y0 y1), (max y0 y1))
       else
         let
           yl = truncate_down p (truncate_down p (real_divl p (y1 - y0) (x1 - x0) * (xl - x0)) + y0);
           yr = truncate_up p (truncate_up p (real_divr p (y1 - y0) (x1 - x0) * (xl - x0)) + y0)
         in Some (yl, yr)
     else None)"
 
 lemma norm_pair_fst0[simp]: "norm (0, x) = norm x"
   by (auto simp: norm_prod_def)
 
 lemmas add_right_mono_le = order_trans[OF add_right_mono]
 lemmas mult_right_mono_le = order_trans[OF mult_right_mono]
 
 lemmas add_right_mono_ge = order_trans[OF _ add_right_mono]
 lemmas mult_right_mono_ge = order_trans[OF _ mult_right_mono]
 
 lemma dest_segment:
   fixes x b::real
   assumes "(x, b) \<in> closed_segment (x0, y0) (x1, y1)"
   assumes "x0 \<noteq> x1"
   shows "b = (y1 - y0) * (x - x0) / (x1 - x0) + y0"
 proof -
   from assms obtain u where u: "x = x0 *\<^sub>R (1 - u) + u * x1" "b = y0 *\<^sub>R (1 - u) + u * y1" "0 \<le> u" "u \<le> 1"
     by (auto simp: closed_segment_def algebra_simps)
   show "b = (y1 - y0) * (x - x0) / (x1 - x0) + y0 "
     using assms by (auto simp: closed_segment_def field_simps u)
 qed
 
 lemma intersect_segment_xline':
   assumes "intersect_segment_xline' prec (p0, p1) x = Some (m, M)"
   shows "closed_segment p0 p1 \<inter> {p. fst p = x} \<subseteq> {(x, m) .. (x, M)}"
   using assms
 proof (cases p0)
   case (Pair x0 y0) note p0 = this
   show ?thesis
   proof (cases p1)
     case (Pair x1 y1) note p1 = this
     {
       assume "x0 = x1" "x = x1" "m = min y0 y1" "M = max y0 y1"
       hence ?thesis
         by (force simp: abs_le_iff p0 p1 min_def max_def algebra_simps dest: segment_bound
           split: if_split_asm)
     } thus ?thesis
       using assms
       by (auto simp: abs_le_iff p0 p1 split: if_split_asm
         intro!: truncate_up_le truncate_down_le
         add_right_mono_le[OF truncate_down]
         add_right_mono_le[OF real_divl]
         add_right_mono_le[OF mult_right_mono_le[OF real_divl]]
         add_right_mono_ge[OF _ truncate_up]
         add_right_mono_ge[OF _ mult_right_mono_ge[OF _ real_divr]]
         dest!: dest_segment)
   qed
 qed
 
 lemma
   in_segment_fst_le:
   fixes x0 x1 b::real
   assumes "x0 \<le> x1" "(x, b) \<in> closed_segment (x0, y0) (x1, y1)"
   shows "x \<le> x1"
   using assms using mult_left_mono[OF \<open>x0 \<le> x1\<close>, where c="1 - u" for u]
   by (force simp add: min_def max_def split: if_split_asm
     simp add: algebra_simps not_le closed_segment_def)
 
 lemma
   in_segment_fst_ge:
   fixes x0 x1 b::real
   assumes "x0 \<le> x1" "(x, b) \<in> closed_segment (x0, y0) (x1, y1)"
   shows "x0 \<le> x"
   using assms using mult_left_mono[OF \<open>x0 \<le> x1\<close>]
   by (force simp add: min_def max_def split: if_split_asm
     simp add: algebra_simps not_le closed_segment_def)
 
 lemma intersect_segment_xline'_eq_None:
   assumes "intersect_segment_xline' prec (p0, p1) x = None"
   assumes "fst p0 \<le> fst p1"
   shows "closed_segment p0 p1 \<inter> {p. fst p = x} = {}"
   using assms
   by (cases p0, cases p1)
     (auto simp: abs_le_iff split: if_split_asm dest: in_segment_fst_le in_segment_fst_ge)
 
 fun intersect_segment_xline
   where "intersect_segment_xline prec ((a, b), (c, d)) x =
   (if a \<le> c then intersect_segment_xline' prec ((a, b), (c, d)) x
   else intersect_segment_xline' prec ((c, d), (a, b)) x)"
 
 lemma closed_segment_commute: "closed_segment a b = closed_segment b a"
   by (meson convex_contains_segment convex_closed_segment dual_order.antisym ends_in_segment)
 
 lemma intersect_segment_xline:
   assumes "intersect_segment_xline prec (p0, p1) x = Some (m, M)"
   shows "closed_segment p0 p1 \<inter> {p. fst p = x} \<subseteq> {(x, m) .. (x, M)}"
   using assms
   by (cases p0, cases p1)
     (auto simp: closed_segment_commute split: if_split_asm simp del: intersect_segment_xline'.simps
       dest!: intersect_segment_xline')
 
 lemma intersect_segment_xline_fst_snd:
   assumes "intersect_segment_xline prec seg x = Some (m, M)"
   shows "closed_segment (fst seg) (snd seg) \<inter> {p. fst p = x} \<subseteq> {(x, m) .. (x, M)}"
   using intersect_segment_xline[of prec "fst seg" "snd seg" x m M] assms
   by simp
 
 lemma intersect_segment_xline_eq_None:
   assumes "intersect_segment_xline prec (p0, p1) x = None"
   shows "closed_segment p0 p1 \<inter> {p. fst p = x} = {}"
   using assms
   by (cases p0, cases p1)
      (auto simp: closed_segment_commute split: if_split_asm simp del: intersect_segment_xline'.simps
       dest!: intersect_segment_xline'_eq_None)
 
 lemma inter_image_empty_iff: "(X \<inter> {p. f p = x} = {}) \<longleftrightarrow> (x \<notin> f ` X)"
   by auto
 
 lemma fst_closed_segment[simp]: "fst ` closed_segment a b = closed_segment (fst a) (fst b)"
   by (force simp: closed_segment_def)
 
 lemma intersect_segment_xline_eq_empty:
   fixes p0 p1::"real * real"
   assumes "closed_segment p0 p1 \<inter> {p. fst p = x} = {}"
   shows "intersect_segment_xline prec (p0, p1) x = None"
   using assms
   by (cases p0, cases p1)
     (auto simp: inter_image_empty_iff closed_segment_eq_real_ivl split: if_split_asm)
 
 lemma intersect_segment_xline_le:
   assumes "intersect_segment_xline prec y xl = Some (m0, M0)"
   shows "m0 \<le> M0"
   using assms
   by (cases y) (auto simp: min_def split: if_split_asm intro!: truncate_up_le truncate_down_le
     order_trans[OF real_divl] order_trans[OF _ real_divr] mult_right_mono)
 
 lemma intersect_segment_xline_None_iff:
   fixes p0 p1::"real * real"
   shows "intersect_segment_xline prec (p0, p1) x = None \<longleftrightarrow> closed_segment p0 p1 \<inter> {p. fst p = x} = {}"
   by (auto intro!: intersect_segment_xline_eq_empty dest!: intersect_segment_xline_eq_None)
 
 
 subsection \<open>Bounds on Vertical Intersection with Oriented List of Segments\<close>
 
 primrec bound_intersect_2d where
   "bound_intersect_2d prec [] x = None"
 | "bound_intersect_2d prec (X # Xs) xl =
     (case bound_intersect_2d prec Xs xl of
       None \<Rightarrow> intersect_segment_xline prec X xl
     | Some (m, M) \<Rightarrow>
       (case intersect_segment_xline prec X xl of
         None \<Rightarrow> Some (m, M)
       | Some (m', M') \<Rightarrow> Some (min m' m, max M' M)))"
 
 lemma
   bound_intersect_2d_eq_None:
   assumes "bound_intersect_2d prec Xs x = None"
   assumes "X \<in> set Xs"
   shows "intersect_segment_xline prec X x = None"
   using assms by (induct Xs) (auto split: option.split_asm)
 
 lemma bound_intersect_2d_upper:
   assumes "bound_intersect_2d prec Xs x = Some (m, M)"
   obtains X m' where "X \<in> set Xs" "intersect_segment_xline prec X x = Some (m', M)"
     "\<And>X m' M' . X \<in> set Xs \<Longrightarrow> intersect_segment_xline prec X x = Some (m', M') \<Longrightarrow> M' \<le> M"
 proof atomize_elim
   show "\<exists>X m'. X \<in> set Xs \<and> intersect_segment_xline prec X x = Some (m', M) \<and>
     (\<forall>X m' M'. X \<in> set Xs \<longrightarrow> intersect_segment_xline prec X x = Some (m', M') \<longrightarrow> M' \<le> M)"
     using assms
   proof (induct Xs arbitrary: m M)
     case Nil thus ?case by (simp add: bound_intersect_2d_def)
   next
     case (Cons X Xs)
     show ?case
     proof (cases "bound_intersect_2d prec Xs x")
       case None
       thus ?thesis using Cons
         by (intro exI[where x=X] exI[where x=m])
           (simp del: intersect_segment_xline.simps add: bound_intersect_2d_eq_None)
     next
       case (Some mM)
       note Some1=this
       then obtain m' M' where mM: "mM = (m', M')" by (cases mM)
       from Cons(1)[OF Some[unfolded mM]]
       obtain X' m'' where X': "X' \<in> set Xs"
         and m'': "intersect_segment_xline prec X' x = Some (m'', M')"
         and max: "\<And>X m' M'a. X \<in> set Xs \<Longrightarrow> intersect_segment_xline prec X x = Some (m', M'a) \<Longrightarrow>
           M'a \<le> M'"
         by auto
       show ?thesis
       proof (cases "intersect_segment_xline prec X x")
         case None thus ?thesis using Some1 mM Cons(2) X' m'' max
           by (intro exI[where x= X'] exI[where x= m''])
             (auto simp del: intersect_segment_xline.simps split: option.split_asm)
       next
         case (Some mM''')
         thus ?thesis using Some1 mM Cons(2) X' m''
           by (cases mM''')
             (force simp: max_def min_def simp del: intersect_segment_xline.simps
               split: option.split_asm if_split_asm dest!: max
               intro!: exI[where x= "if M' \<ge> snd mM''' then X' else X"]
               exI[where x= "if M' \<ge> snd mM''' then m'' else fst mM'''"])
       qed
     qed
   qed
 qed
 
 lemma bound_intersect_2d_lower:
   assumes "bound_intersect_2d prec Xs x = Some (m, M)"
   obtains X M' where "X \<in> set Xs" "intersect_segment_xline prec X x = Some (m, M')"
     "\<And>X m' M' . X \<in> set Xs \<Longrightarrow> intersect_segment_xline prec X x = Some (m', M') \<Longrightarrow> m \<le> m'"
 proof atomize_elim
   show "\<exists>X M'. X \<in> set Xs \<and> intersect_segment_xline prec X x = Some (m, M') \<and>
     (\<forall>X m' M'. X \<in> set Xs \<longrightarrow> intersect_segment_xline prec X x = Some (m', M') \<longrightarrow> m \<le> m')"
     using assms
   proof (induct Xs arbitrary: m M)
     case Nil thus ?case by (simp add: bound_intersect_2d_def)
   next
     case (Cons X Xs)
     show ?case
     proof (cases "bound_intersect_2d prec Xs x")
       case None
       thus ?thesis using Cons
         by (intro exI[where x= X])
           (simp del: intersect_segment_xline.simps add: bound_intersect_2d_eq_None)
     next
       case (Some mM)
       note Some1=this
       then obtain m' M' where mM: "mM = (m', M')" by (cases mM)
       from Cons(1)[OF Some[unfolded mM]]
       obtain X' M'' where X': "X' \<in> set Xs"
         and M'': "intersect_segment_xline prec X' x = Some (m', M'')"
         and min: "\<And>X m'a M'. X \<in> set Xs \<Longrightarrow> intersect_segment_xline prec X x = Some (m'a, M') \<Longrightarrow>
           m' \<le> m'a"
         by auto
       show ?thesis
       proof (cases "intersect_segment_xline prec X x")
         case None thus ?thesis using Some1 mM Cons(2) X' M'' min
           by (intro exI[where x= X'] exI[where x= M''])
             (auto simp del: intersect_segment_xline.simps split: option.split_asm)
       next
         case (Some mM''')
         thus ?thesis using Some1 mM Cons(2) X' M'' min
           by (cases mM''')
             (force simp: max_def min_def
               simp del: intersect_segment_xline.simps
               split: option.split_asm if_split_asm
               dest!: min
               intro!: exI[where x= "if m' \<le> fst mM''' then X' else X"]
                 exI[where x= "if m' \<le> fst mM''' then M'' else snd mM'''"])
       qed
     qed
   qed
 qed
 
 lemma bound_intersect_2d:
   assumes "bound_intersect_2d prec Xs x = Some (m, M)"
   shows "(\<Union>(p1, p2) \<in> set Xs. closed_segment p1 p2) \<inter> {p. fst p = x} \<subseteq> {(x, m) .. (x, M)}"
 proof (clarsimp, safe)
   fix b x0 y0 x1 y1
   assume H: "((x0, y0), x1, y1) \<in> set Xs" "(x, b) \<in> closed_segment (x0, y0) (x1, y1)"
   hence "intersect_segment_xline prec ((x0, y0), x1, y1) x \<noteq> None"
     by (intro notI)
       (auto dest!: intersect_segment_xline_eq_None simp del: intersect_segment_xline.simps)
   then obtain e f where ef: "intersect_segment_xline prec ((x0, y0), x1, y1) x = Some (e, f)"
     by auto
   with H have "m \<le> e"
     by (auto intro: bound_intersect_2d_lower[OF assms])
   also have "\<dots> \<le> b"
     using intersect_segment_xline[OF ef] H
     by force
   finally show "m \<le> b" .
   have "b \<le> f"
     using intersect_segment_xline[OF ef] H
     by force
   also have "\<dots> \<le> M"
     using H ef by (auto intro: bound_intersect_2d_upper[OF assms])
   finally show "b \<le> M" .
 qed
 
 lemma bound_intersect_2d_eq_None_iff:
   "bound_intersect_2d prec Xs x = None \<longleftrightarrow> (\<forall>X\<in>set Xs. intersect_segment_xline prec X x = None)"
   by (induct Xs) (auto simp: split: option.split_asm)
 
 lemma bound_intersect_2d_nonempty:
   assumes "bound_intersect_2d prec Xs x = Some (m, M)"
   shows "(\<Union>(p1, p2) \<in> set Xs. closed_segment p1 p2) \<inter> {p. fst p = x} \<noteq> {}"
 proof -
   from assms have "bound_intersect_2d prec Xs x \<noteq> None" by simp
   then obtain p1 p2 where "(p1, p2) \<in> set Xs" "intersect_segment_xline prec (p1, p2) x \<noteq> None"
     unfolding bound_intersect_2d_eq_None_iff by auto
   hence "closed_segment p1 p2 \<inter> {p. fst p = x} \<noteq> {}"
     by (simp add: intersect_segment_xline_None_iff)
   thus ?thesis using \<open>(p1, p2) \<in> set Xs\<close> by auto
 qed
 
 lemma bound_intersect_2d_le:
   assumes "bound_intersect_2d prec Xs x = Some (m, M)" shows "m \<le> M"
 proof -
   from bound_intersect_2d_nonempty[OF assms] bound_intersect_2d[OF assms]
   show "m \<le> M" by auto
 qed
 
 
 subsection \<open>Bounds on Vertical Intersection with General List of Segments\<close>
 
 definition "bound_intersect_2d_ud prec X xl =
   (case segments_of_aform X of
     [] \<Rightarrow> if fst (fst X) = xl then let m = snd (fst X) in Some (m, m) else None
   | [x, y] \<Rightarrow> intersect_segment_xline prec x xl
   | xs \<Rightarrow>
     (case bound_intersect_2d prec (filter (\<lambda>((x1, y1), x2, y2). x1 < x2) xs) xl of
       Some (m, M') \<Rightarrow>
       (case bound_intersect_2d prec (filter (\<lambda>((x1, y1), x2, y2). x1 > x2) xs) xl of
         Some (m', M) \<Rightarrow> Some (min m m', max M M')
       | None \<Rightarrow> None)
     | None \<Rightarrow> None))"
 
 lemma list_cases4:
   "\<And>x P. (x = [] \<Longrightarrow> P) \<Longrightarrow> (\<And>y. x = [y] \<Longrightarrow> P) \<Longrightarrow>
     (\<And>y z. x = [y, z] \<Longrightarrow> P) \<Longrightarrow>
     (\<And>w y z zs. x = w # y # z # zs \<Longrightarrow> P) \<Longrightarrow> P"
   by (metis list.exhaust)
 
 lemma bound_intersect_2d_ud_segments_of_aform_le:
   "bound_intersect_2d_ud prec X xl = Some (m0, M0) \<Longrightarrow> m0 \<le> M0"
   by (cases "segments_of_aform X" rule: list_cases4)
     (auto simp: Let_def bound_intersect_2d_ud_def min_def max_def intersect_segment_xline_le
       if_split_eq1 split: option.split_asm prod.split_asm list.split_asm
       dest!: bound_intersect_2d_le)
 
 lemma pdevs_domain_eq_empty_iff[simp]: "pdevs_domain (snd X) = {} \<longleftrightarrow> snd X = zero_pdevs"
   by (auto simp: intro!: pdevs_eqI)
 
 lemma ccw_contr_on_line_left:
   assumes "det3 (a, b) (x, c) (x, d) \<ge> 0" "a > x"
   shows "d \<le> c"
 proof -
   from assms have "d * (a - x) \<le> c * (a - x)"
     by (auto simp: det3_def' algebra_simps)
   with assms show "c \<ge> d" by auto
 qed
 
 lemma ccw_contr_on_line_right:
   assumes "det3 (a, b) (x, c) (x, d) \<ge> 0" "a < x"
   shows "d \<ge> c"
 proof -
   from assms have "c * (x - a) \<le> d * (x - a)"
     by (auto simp: det3_def' algebra_simps)
   with assms show "d \<ge> c" by auto
 qed
 
 lemma singleton_contrE:
   assumes "\<And>x y. x \<noteq> y \<Longrightarrow> x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> False"
   assumes "X \<noteq> {}"
   obtains x where "X = {x}"
   using assms by blast
 
 lemma segment_intersection_singleton:
   fixes xl and a b::"real * real"
   defines "i \<equiv> closed_segment a b \<inter> {p. fst p = xl}"
   assumes ne1: "fst a \<noteq> fst b"
   assumes upper: "i \<noteq> {}"
   obtains p1 where "i = {p1}"
 proof (rule singleton_contrE[OF _ upper])
   fix x y assume H: "x \<noteq> y" "x \<in> i" "y \<in> i"
   then obtain u v where uv: "x = u *\<^sub>R b + (1 - u) *\<^sub>R a" "y = v *\<^sub>R b + (1 - v) *\<^sub>R a"
     "0 \<le> u" "u \<le> 1" "0 \<le> v" "v \<le> 1"
     by (auto simp add: closed_segment_def i_def field_simps)
   then have "x + u *\<^sub>R a = a + u *\<^sub>R b" "y + v *\<^sub>R a = a + v *\<^sub>R b"
     by simp_all
   then have "fst (x + u *\<^sub>R a) = fst (a + u *\<^sub>R b)" "fst (y + v *\<^sub>R a) = fst (a + v *\<^sub>R b)"
     by simp_all
   then have "u = v * (fst a - fst b) / (fst a - fst b)"
     using ne1 H(2,3) \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> \<open>0 \<le> v\<close> \<open>v \<le> 1\<close>
     by (simp add: closed_segment_def i_def field_simps)
   then have "u = v"
     by (simp add: ne1)
   then show False using H uv
     by simp
 qed
 
 lemma bound_intersect_2d_ud_segments_of_aform:
   assumes "bound_intersect_2d_ud prec X xl = Some (m0, M0)"
   assumes "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "{aform_val e X} \<inter> {x. fst x = xl} \<subseteq> {(xl, m0) .. (xl, M0)}"
 proof safe
   fix a b
   assume safeassms: "(a, b) = aform_val e X" "xl = fst (a, b)"
   hence fst_aform_val: "fst (aform_val e X) = xl"
     by simp
   {
     assume len: "length (segments_of_aform X) > 2"
     with assms obtain m M m' M'
     where lb: "bound_intersect_2d prec
         [((x1, y1), x2, y2)\<leftarrow>segments_of_aform X . x1 < x2] xl = Some (m, M')"
       and ub: "bound_intersect_2d prec
         [((x1, y1), x2, y2)\<leftarrow>segments_of_aform X . x2 < x1] xl = Some (m', M)"
       and minmax: "m0 = min m m'" "M0 = max M M'"
       by (auto simp: bound_intersect_2d_ud_def split: option.split_asm list.split_asm )
     from bound_intersect_2d_upper[OF ub] obtain X1 m1
     where upper:
       "X1 \<in> set [((x1, y1), x2, y2)\<leftarrow>segments_of_aform X . x2 < x1]"
       "intersect_segment_xline prec X1 xl = Some (m1, M)"
       by metis
     from bound_intersect_2d_lower[OF lb] obtain X2 M2
     where lower:
       "X2 \<in> set [((x1, y1), x2, y2)\<leftarrow>segments_of_aform X . x1 < x2]"
       "intersect_segment_xline prec X2 xl = Some (m, M2)"
       by metis
     from upper(1) lower(1)
     have X1: "X1 \<in> set (segments_of_aform X)" "fst (fst X1) > fst (snd X1)"
       and X2: "X2 \<in> set (segments_of_aform X)" "fst (fst X2) < fst (snd X2)"
       by auto
     note upper_seg = intersect_segment_xline_fst_snd[OF upper(2)]
     note lower_seg = intersect_segment_xline_fst_snd[OF lower(2)]
     from len have lh: "length (half_segments_of_aform X) \<noteq> 1"
       by (auto simp: segments_of_aform_def Let_def)
     from X1 have ne1: "fst (fst X1) \<noteq> fst (snd X1)"
       by simp
     moreover have "closed_segment (fst X1) (snd X1) \<inter> {p. fst p = xl} \<noteq> {}"
       using upper(2)
       by (simp add: intersect_segment_xline_None_iff[of prec, symmetric])
     ultimately obtain p1 where p1: "closed_segment (fst X1) (snd X1) \<inter> {p. fst p = xl} = {p1}"
       by (rule segment_intersection_singleton)
     then obtain u where u: "p1 = (1 - u) *\<^sub>R fst X1 + u *\<^sub>R (snd X1)" "0 \<le> u" "u \<le> 1"
       by (auto simp: closed_segment_def algebra_simps)
     have coll1: "det3 (fst X1) p1 (aform_val e X) \<ge> 0"
       and coll1': "det3 p1 (snd X1) (aform_val e X) \<ge> 0"
       unfolding atomize_conj
       using u
       by (cases "u = 0 \<or> u = 1")
         (auto simp: u(1) intro: det3_nonneg_scaleR_segment1 det3_nonneg_scaleR_segment2
           det3_nonneg_segments_of_aformI[OF \<open>e \<in> _\<close> lh X1(1)])
 
     from X2 have ne2: "fst (fst X2) \<noteq> fst (snd X2)" by simp
     moreover
     have "closed_segment (fst X2) (snd X2) \<inter> {p. fst p = xl} \<noteq> {}"
       using lower(2)
       by (simp add: intersect_segment_xline_None_iff[of prec, symmetric])
     ultimately
     obtain p2 where p2: "closed_segment (fst X2) (snd X2) \<inter> {p. fst p = xl} = {p2}"
       by (rule segment_intersection_singleton)
     then obtain v where v: "p2 = (1 - v) *\<^sub>R fst X2 + v *\<^sub>R (snd X2)" "0 \<le> v" "v \<le> 1"
       by (auto simp: closed_segment_def algebra_simps)
     have coll2: "det3 (fst X2) p2 (aform_val e X) \<ge> 0"
       and coll2': "det3 p2 (snd X2) (aform_val e X) \<ge> 0"
       unfolding atomize_conj
       using v
       by (cases "v = 0 \<or> v = 1")
         (auto simp: v(1) intro: det3_nonneg_scaleR_segment1 det3_nonneg_scaleR_segment2
           det3_nonneg_segments_of_aformI[OF \<open>e \<in> _\<close> lh X2(1)])
 
     from in_set_segments_of_aform_aform_valE
         [of "fst X1" "snd X1" X, unfolded prod.collapse, OF X1(1)]
     obtain e1s where e1s: "snd X1 = aform_val e1s X" "e1s \<in> UNIV \<rightarrow> {- 1..1}" .
     from previous_segments_of_aformE
         [of "fst X1" "snd X1" X, unfolded prod.collapse, OF X1(1)]
     obtain fX0 where "(fX0, fst X1) \<in> set (segments_of_aform X)" .
     from in_set_segments_of_aform_aform_valE[OF this]
     obtain e1f where e1f: "fst X1 = aform_val e1f X" "e1f \<in> UNIV \<rightarrow> {- 1..1}" .
     have "p1 \<in> closed_segment (aform_val e1f X) (aform_val e1s X)"
       using p1 by (auto simp: e1s e1f)
     with segment_in_aform_val[OF e1s(2) e1f(2), of X]
     obtain ep1 where ep1: "ep1 \<in> UNIV \<rightarrow> {-1 .. 1}" "p1 = aform_val ep1 X"
       by (auto simp: Affine_def valuate_def closed_segment_commute)
 
     from in_set_segments_of_aform_aform_valE
         [of "fst X2" "snd X2" X, unfolded prod.collapse, OF X2(1)]
     obtain e2s where e2s: "snd X2 = aform_val e2s X" "e2s \<in> UNIV \<rightarrow> {- 1..1}" .
     from previous_segments_of_aformE
         [of "fst X2" "snd X2" X, unfolded prod.collapse, OF X2(1)]
     obtain fX02 where "(fX02, fst X2) \<in> set (segments_of_aform X)" .
     from in_set_segments_of_aform_aform_valE[OF this]
     obtain e2f where e2f: "fst X2 = aform_val e2f X" "e2f \<in> UNIV \<rightarrow> {- 1..1}" .
     have "p2 \<in> closed_segment (aform_val e2f X) (aform_val e2s X)"
       using p2 by (auto simp: e2s e2f)
     with segment_in_aform_val[OF e2f(2) e2s(2), of X]
     obtain ep2 where ep2: "ep2 \<in> UNIV \<rightarrow> {-1 .. 1}" "p2 = aform_val ep2 X"
       by (auto simp: Affine_def valuate_def)
 
     from det3_nonneg_segments_of_aformI[OF ep2(1), of X "(fst X1, snd X1)", unfolded prod.collapse,
         OF lh X1(1), unfolded ep2(2)[symmetric]]
     have c2: "det3 (fst X1) (snd X1) p2 \<ge> 0" .
     hence c12: "det3 (fst X1) p1 p2 \<ge> 0"
       using u by (cases "u = 0") (auto simp: u(1) det3_nonneg_scaleR_segment2)
     from det3_nonneg_segments_of_aformI[OF ep1(1), of X "(fst X2, snd X2)", unfolded prod.collapse,
         OF lh X2(1), unfolded ep1(2)[symmetric]]
     have c1: "det3 (fst X2) (snd X2) p1 \<ge> 0" .
     hence c21: "det3 (fst X2) p2 p1 \<ge> 0"
       using v by (cases "v = 0") (auto simp: v(1) det3_nonneg_scaleR_segment2)
     from p1 p2 have p1p2xl: "fst p1 = xl" "fst p2 = xl"
       by (auto simp: det3_def')
     from upper_seg p1 have "snd p1 \<le> M" by (auto simp: less_eq_prod_def)
     from lower_seg p2 have "m \<le> snd p2" by (auto simp: less_eq_prod_def)
 
     {
       have *: "(fst p1, snd (aform_val e X)) = aform_val e X"
         by (simp add: prod_eq_iff p1p2xl fst_aform_val)
       hence coll:
         "det3 (fst (fst X1), snd (fst X1)) (fst p1, snd p1) (fst p1, snd (aform_val e X)) \<ge> 0"
         and coll':
         "det3 (fst (snd X1), snd (snd X1)) (fst p1, snd (aform_val e X)) (fst p1, snd p1) \<ge> 0"
         using coll1 coll1'
         by (auto simp: det3_rotate)
       have "snd (aform_val e X) \<le> M"
       proof (cases "fst (fst X1) = xl")
         case False
         have "fst (fst X1) \<ge> fst p1"
           unfolding u using X1
           by (auto simp: algebra_simps intro!: mult_left_mono u)
         moreover
         have "fst (fst X1) \<noteq> fst p1"
           using False
           by (simp add: p1p2xl)
         ultimately
         have "fst (fst X1) > fst p1" by simp
         from ccw_contr_on_line_left[OF coll this]
         show ?thesis using \<open>snd p1 \<le> M\<close> by simp
       next
         case True
         have "fst (snd X1) * (1 - u) \<le> fst (fst X1) * (1 - u)"
           using X1 u
           by (auto simp: intro!: mult_right_mono)
         hence "fst (snd X1) \<le> fst p1"
           unfolding u by (auto simp: algebra_simps)
         moreover
         have "fst (snd X1) \<noteq> fst p1"
           using True ne1
           by (simp add: p1p2xl)
         ultimately
         have "fst (snd X1) < fst p1" by simp
         from ccw_contr_on_line_right[OF coll' this]
         show ?thesis using \<open>snd p1 \<le> M\<close> by simp
       qed
     } moreover {
       have "(fst p2, snd (aform_val e X)) = aform_val e X"
         by (simp add: prod_eq_iff p1p2xl fst_aform_val)
       hence coll:
         "det3 (fst (fst X2), snd (fst X2)) (fst p2, snd p2) (fst p2, snd (aform_val e X)) \<ge> 0"
         and coll':
         "det3 (fst (snd X2), snd (snd X2)) (fst p2, snd (aform_val e X)) (fst p2, snd p2) \<ge> 0"
         using coll2 coll2'
         by (auto simp: det3_rotate)
       have "m \<le> snd (aform_val e X)"
       proof (cases "fst (fst X2) = xl")
         case False
         have "fst (fst X2) \<le> fst p2"
           unfolding v using X2
           by (auto simp: algebra_simps intro!: mult_left_mono v)
         moreover
         have "fst (fst X2) \<noteq> fst p2"
           using False
           by (simp add: p1p2xl)
         ultimately
         have "fst (fst X2) < fst p2" by simp
         from ccw_contr_on_line_right[OF coll this]
         show ?thesis using \<open>m \<le> snd p2\<close> by simp
       next
         case True
         have "(1 - v) * fst (snd X2) \<ge> (1 - v) * fst (fst X2)"
           using X2 v
           by (auto simp: intro!: mult_left_mono)
         hence "fst (snd X2) \<ge> fst p2"
           unfolding v by (auto simp: algebra_simps)
         moreover
         have "fst (snd X2) \<noteq> fst p2"
           using True ne2
           by (simp add: p1p2xl)
         ultimately
         have "fst (snd X2) > fst p2" by simp
         from ccw_contr_on_line_left[OF coll' this]
         show ?thesis using \<open>m \<le> snd p2\<close> by simp
       qed
     } ultimately have "aform_val e X \<in> {(xl, m) .. (xl, M)}"
       by (auto simp: less_eq_prod_def fst_aform_val)
     hence "aform_val e X \<in> {(xl, m0) .. (xl, M0)}"
       by (auto simp: minmax less_eq_prod_def)
   } moreover {
     assume "length (segments_of_aform X) = 2"
     then obtain a b where s: "segments_of_aform X = [a, b]"
       by (auto simp: numeral_2_eq_2 length_Suc_conv)
     from segments_of_aform_line_segment[OF this assms(2)]
     have "aform_val e X \<in> closed_segment (fst a) (snd a)" .
     moreover
     from assms
     have "intersect_segment_xline prec a xl = Some (m0, M0)"
       by (auto simp: bound_intersect_2d_ud_def s)
     note intersect_segment_xline_fst_snd[OF this]
     ultimately
     have "aform_val e X \<in> {(xl, m0) .. (xl, M0)}"
       by (auto simp: less_eq_prod_def fst_aform_val)
   } moreover {
     assume "length (segments_of_aform X) = 1"
     from polychain_of_segments_of_aform1[OF this]
     have "aform_val e X \<in> {(xl, m0) .. (xl, M0)}" by auto
   } moreover {
     assume len: "length (segments_of_aform X) = 0"
     hence "independent_pdevs (map snd (list_of_pdevs (nlex_pdevs (snd X)))) = []"
       by (simp add: segments_of_aform_def Let_def half_segments_of_aform_def inl_def)
     hence "snd X = zero_pdevs"
       by (subst (asm) independent_pdevs_eq_Nil_iff) (auto simp: list_all_iff list_of_pdevs_def)
     hence "aform_val e X = fst X"
       by (simp add: aform_val_def)
     with len assms have "aform_val e X \<in> {(xl, m0) .. (xl, M0)}"
       by (auto simp: bound_intersect_2d_ud_def Let_def split: if_split_asm)
   } ultimately have "aform_val e X \<in> {(xl, m0)..(xl, M0)}"
     by arith
   thus "(a, b) \<in> {(fst (a, b), m0)..(fst (a, b), M0)}"
     using safeassms
     by simp
 qed
 
 
 subsection \<open>Approximation from Orthogonal Directions\<close>
 
 definition inter_aform_plane_ortho::
   "nat \<Rightarrow> 'a::executable_euclidean_space aform \<Rightarrow> 'a \<Rightarrow> real \<Rightarrow> 'a aform option"
   where
   "inter_aform_plane_ortho p Z n g = do {
     mMs \<leftarrow> those (map (\<lambda>b. bound_intersect_2d_ud p (inner2_aform Z n b) g) Basis_list);
     let l = (\<Sum>(b, m)\<leftarrow>zip Basis_list (map fst mMs). m *\<^sub>R b);
     let u = (\<Sum>(b, M)\<leftarrow>zip Basis_list (map snd mMs). M *\<^sub>R b);
     Some (aform_of_ivl l u)
   }"
 
 lemma
   those_eq_SomeD:
   assumes "those (map f xs) = Some ys"
   shows "ys = map (the o f) xs \<and> (\<forall>i.\<exists>y. i < length xs \<longrightarrow> f (xs ! i) = Some y)"
   using assms
   by (induct xs arbitrary: ys) (auto split: option.split_asm simp: o_def nth_Cons split: nat.split)
 
 lemma
   sum_list_zip_map:
   assumes "distinct xs"
   shows "(\<Sum>(x, y)\<leftarrow>zip xs (map g xs). f x y) = (\<Sum>x\<in>set xs. f x (g x))"
   by (force simp add: sum_list_distinct_conv_sum_set assms distinct_zipI1 split_beta'
     in_set_zip in_set_conv_nth inj_on_convol_ident
     intro!: sum.reindex_cong[where l="\<lambda>x. (x, g x)"])
 
 lemma
   inter_aform_plane_ortho_overappr:
   assumes "inter_aform_plane_ortho p Z n g = Some X"
   shows "{x. \<forall>i \<in> Basis. x \<bullet> i \<in> {y. (g, y) \<in> (\<lambda>x. (x \<bullet> n, x \<bullet> i)) ` Affine Z}} \<subseteq> Affine X"
 proof -
   let ?inter = "(\<lambda>b. bound_intersect_2d_ud p (inner2_aform Z n b) g)"
   obtain xs
   where xs: "those (map ?inter Basis_list) = Some xs"
     using assms by (cases "those (map ?inter Basis_list)") (auto simp: inter_aform_plane_ortho_def)
 
   from those_eq_SomeD[OF this]
   obtain y' where xs_eq: "xs = map (the \<circ> ?inter) Basis_list"
     and y': "\<And>i. i < length (Basis_list::'a list) \<Longrightarrow> ?inter (Basis_list ! i) = Some (y' i)"
     by metis
   have "\<forall>(i::'a) \<in> Basis. \<exists>j<length (Basis_list::'a list). i = Basis_list ! j"
     by (metis Basis_list in_set_conv_nth)
   then obtain j where j:
     "\<And>i::'a. i\<in>Basis \<Longrightarrow> j i < length (Basis_list::'a list)"
     "\<And>i::'a. i\<in>Basis \<Longrightarrow> i = Basis_list ! j i"
     by metis
   define y where "y = y' o j"
   with y' j have y: "\<And>i. i \<in> Basis \<Longrightarrow> ?inter i = Some (y i)"
     by (metis comp_def)
   hence y_le: "\<And>i. i \<in> Basis \<Longrightarrow> fst (y i) \<le> snd (y i)"
     by (auto intro!: bound_intersect_2d_ud_segments_of_aform_le)
   hence "(\<Sum>b\<in>Basis. fst (y b) *\<^sub>R b) \<le> (\<Sum>b\<in>Basis. snd (y b) *\<^sub>R b)"
     by (auto simp: eucl_le[where 'a='a])
   with assms have X: "Affine X = {\<Sum>b\<in>Basis. fst (y b) *\<^sub>R b..\<Sum>b\<in>Basis. snd (y b) *\<^sub>R b}"
     by (auto simp: inter_aform_plane_ortho_def sum_list_zip_map xs xs_eq y Affine_aform_of_ivl)
 
   show ?thesis
   proof safe
     fix x assume x: "\<forall>i\<in>Basis. x \<bullet> i \<in> {y. (g, y) \<in> (\<lambda>x. (x \<bullet> n, x \<bullet> i)) ` Affine Z}"
     {
       fix i::'a assume i: "i \<in> Basis"
       from x i have x_in2: "(g, x \<bullet> i) \<in> (\<lambda>x. (x \<bullet> n, x \<bullet> i)) ` Affine Z"
         by auto
       from x_in2 obtain e
       where e: "e \<in> UNIV \<rightarrow> {- 1..1}"
         and g: "g = aform_val e Z \<bullet> n"
         and x: "x \<bullet> i = aform_val e Z \<bullet> i"
         by (auto simp: Affine_def valuate_def)
       have "{aform_val e (inner2_aform Z n i)} = {aform_val e (inner2_aform Z n i)} \<inter> {x. fst x = g}"
         by (auto simp: g inner2_def)
       also
       from y[OF \<open>i \<in> Basis\<close>]
       have "?inter i = Some (fst (y i), snd (y i))" by simp
       note bound_intersect_2d_ud_segments_of_aform[OF this e]
       finally have "x \<bullet> i \<in> {fst (y i) .. snd (y i)}"
         by (auto simp: x inner2_def)
     } thus "x \<in> Affine X"
       unfolding X
       by (auto simp: eucl_le[where 'a='a])
   qed
 qed
 
 lemma inter_proj_eq:
   fixes n g l
   defines "G \<equiv> {x. x \<bullet> n = g}"
   shows "(\<lambda>x. x \<bullet> l) ` (Z \<inter> G) =
     {y. (g, y) \<in> (\<lambda>x. (x \<bullet> n, x \<bullet> l)) ` Z}"
   by (auto simp: G_def)
 
 lemma
   inter_overappr:
   fixes n \<gamma> l
   shows "Z \<inter> {x. x \<bullet> n = g} \<subseteq> {x. \<forall>i \<in> Basis. x \<bullet> i \<in> {y. (g, y) \<in> (\<lambda>x. (x \<bullet> n, x \<bullet> i)) ` Z}}"
   by auto
 
 lemma inter_inter_aform_plane_ortho:
   assumes "inter_aform_plane_ortho p Z n g = Some X"
   shows "Affine Z \<inter> {x. x \<bullet> n = g} \<subseteq> Affine X"
 proof -
   note inter_overappr[of "Affine Z" n g]
   also note inter_aform_plane_ortho_overappr[OF assms]
   finally show ?thesis .
 qed
 
 subsection \<open>``Completeness'' of Intersection\<close>
 
 abbreviation "encompasses x seg \<equiv> det3 (fst seg) (snd seg) x \<ge> 0"
 
 lemma encompasses_cases:
   "encompasses x seg \<or> encompasses x (snd seg, fst seg)"
   by (auto simp: det3_def' algebra_simps)
 
 lemma list_all_encompasses_cases:
   assumes "list_all (encompasses p) (x # y # zs)"
   obtains "list_all (encompasses p) [x, y, (snd y, fst x)]"
     | "list_all (encompasses p) ((fst x, snd y)#zs)"
   using encompasses_cases
 proof
   assume "encompasses p (snd y, fst x)"
   hence "list_all (encompasses p) [x, y, (snd y, fst x)]"
     using assms by (auto simp: list_all_iff)
   thus ?thesis ..
 next
   assume "encompasses p (snd (snd y, fst x), fst (snd y, fst x))"
   hence "list_all (encompasses p) ((fst x, snd y)#zs)"
     using assms by (auto simp: list_all_iff)
   thus ?thesis ..
 qed
 
 lemma triangle_encompassing_polychain_of:
   assumes "det3 p a b \<ge> 0" "det3 p b c \<ge> 0" "det3 p c a \<ge> 0"
   assumes "ccw' a b c"
   shows "p \<in> convex hull {a, b, c}"
 proof -
   from assms have nn: "det3 b c p \<ge> 0" "det3 c a p \<ge> 0" "det3 a b p \<ge> 0" "det3 a b c \<ge> 0"
     by (auto simp: det3_def' algebra_simps)
   have "det3 a b c *\<^sub>R p = det3 b c p *\<^sub>R a + det3 c a p *\<^sub>R b + det3 a b p *\<^sub>R c"
     by (auto simp: det3_def' algebra_simps prod_eq_iff)
   hence "inverse (det3 a b c) *\<^sub>R (det3 a b c *\<^sub>R p) =
       inverse (det3 a b c) *\<^sub>R (det3 b c p *\<^sub>R a + det3 c a p *\<^sub>R b + det3 a b p *\<^sub>R c)"
     by simp
   with assms have p_eq: "p =
     (det3 b c p / det3 a b c) *\<^sub>R a + (det3 c a p / det3 a b c) *\<^sub>R b + (det3 a b p / det3 a b c) *\<^sub>R c"
     (is "_ = scaleR ?u _ + scaleR ?v _ + scaleR ?w _")
     by (simp add: inverse_eq_divide algebra_simps ccw'_def)
   have det_eq: "det3 b c p / det3 a b c + det3 c a p / det3 a b c + det3 a b p / det3 a b c = 1"
     using assms(4)
     by (simp add: add_divide_distrib[symmetric] det3_def' algebra_simps ccw'_def)
   show ?thesis
     unfolding convex_hull_3
     using assms(4)
     by (blast intro: exI[where x="?u"] exI[where x="?v"] exI[where x="?w"]
       intro!: p_eq divide_nonneg_nonneg nn det_eq)
 qed
 
 lemma encompasses_convex_polygon3:
   assumes "list_all (encompasses p) (x#y#z#zs)"
   assumes "convex_polygon (x#y#z#zs)"
   assumes "ccw'.sortedP (fst x) (map snd (butlast (x#y#z#zs)))"
   shows "p \<in> convex hull (set (map fst (x#y#z#zs)))"
   using assms
 proof (induct zs arbitrary: x y z p)
   case Nil
   thus ?case
     by (auto simp: det3_def' algebra_simps
       elim!: ccw'.sortedP_Cons ccw'.sortedP_Nil
       intro!: triangle_encompassing_polychain_of)
 next
   case (Cons w ws)
   from Cons.prems(2) have "snd y = fst z" by auto
   from Cons.prems(1)
   show ?case
   proof (rule list_all_encompasses_cases)
     assume "list_all (encompasses p) [x, y, (snd y, fst x)]"
     hence "p \<in> convex hull {fst x, fst y, snd y}"
       using Cons.prems
       by (auto simp: det3_def' algebra_simps
         elim!: ccw'.sortedP_Cons ccw'.sortedP_Nil
         intro!: triangle_encompassing_polychain_of)
     thus ?case
       by (rule rev_subsetD[OF _ hull_mono]) (auto simp: \<open>snd y = fst z\<close>)
   next
     assume *: "list_all (encompasses p) ((fst x, snd y) # z # w # ws)"
     from Cons.prems
     have enc: "ws \<noteq> [] \<Longrightarrow> encompasses p (last ws)"
       by (auto simp: list_all_iff)
     have "set (map fst ((fst x, snd y)#z#w#ws)) \<subseteq> set (map fst (x # y # z # w # ws))"
       by auto
     moreover
     {
       note *
       moreover
       have "convex_polygon ((fst x, snd y) # z # w # ws)"
         by (metis convex_polygon_skip Cons.prems(2,3))
       moreover
       have "ccw'.sortedP (fst (fst x, snd y)) (map snd (butlast ((fst x, snd y) # z # w # ws)))"
         using Cons.prems(3)
         by (auto elim!: ccw'.sortedP_Cons intro!: ccw'.sortedP.Cons ccw'.sortedP.Nil
           split: if_split_asm)
       ultimately have "p \<in> convex hull set (map fst ((fst x, snd y)#z#w#ws))"
         by (rule Cons.hyps)
     }
     ultimately
     show "p \<in> convex hull set (map fst (x # y # z # w # ws))"
       by (rule subsetD[OF hull_mono])
   qed
 qed
 
 lemma segments_of_aform_empty_Affine_eq:
   assumes "segments_of_aform X = []"
   shows "Affine X = {fst X}"
 proof -
   have "independent_pdevs (map snd (list_of_pdevs (nlex_pdevs (snd X)))) = [] \<longleftrightarrow>
     (list_of_pdevs (nlex_pdevs (snd X))) = []"
     by (subst independent_pdevs_eq_Nil_iff) (auto simp: list_all_iff list_of_pdevs_def )
   with assms show ?thesis
     by (force simp: aform_val_def list_of_pdevs_def Affine_def valuate_def segments_of_aform_def
       Let_def half_segments_of_aform_def inl_def)
 qed
 
 lemma not_segments_of_aform_singleton: "segments_of_aform X \<noteq> [x]"
   by (auto simp: segments_of_aform_def Let_def add_is_1 dest!: arg_cong[where f=length])
 
 lemma encompasses_segments_of_aform_in_AffineI:
   assumes "length (segments_of_aform X) > 2"
   assumes "list_all (encompasses p) (segments_of_aform X)"
   shows "p \<in> Affine X"
 proof -
   from assms(1) obtain x y z zs where eq: "segments_of_aform X = x#y#z#zs"
     by (cases "segments_of_aform X" rule: list_cases4) auto
   hence "fst x = fst (hd (half_segments_of_aform X))"
     by (metis segments_of_aform_def hd_append list.map_disc_iff list.sel(1))
   also have "\<dots> = lowest_vertex (fst X, nlex_pdevs (snd X))"
     using assms
     by (intro fst_hd_half_segments_of_aform) (auto simp: segments_of_aform_def)
   finally have fstx: "fst x = lowest_vertex (fst X, nlex_pdevs (snd X))" .
   have "p \<in> convex hull (set (map fst (segments_of_aform X)))"
     using assms(2)
     unfolding eq
   proof (rule encompasses_convex_polygon3)
     show "convex_polygon (x # y # z # zs)"
       using assms(1) unfolding eq[symmetric]
       by (intro convex_polygon_segments_of_aform) (simp add: segments_of_aform_def Let_def)
     show "ccw'.sortedP (fst x) (map snd (butlast (x # y # z # zs)))"
       using assms(1)
       unfolding fstx map_butlast eq[symmetric]
       by (intro ccw'_sortedP_snd_segments_of_aform)
         (simp add: segments_of_aform_def Let_def half_segments_of_aform_def)
   qed
   also have "\<dots> \<subseteq> convex hull (Affine X)"
   proof (rule hull_mono, safe)
     fix a b assume "(a, b) \<in> set (map fst (segments_of_aform X))"
     then obtain c d where "((a, b), c, d) \<in> set (segments_of_aform X)" by auto
     from previous_segments_of_aformE[OF this]
     obtain x where "(x, a, b) \<in> set (segments_of_aform X)" by auto
     from in_set_segments_of_aform_aform_valE[OF this]
     obtain e where "(a, b) = aform_val e X" "e \<in> UNIV \<rightarrow> {- 1..1}" by auto
     thus "(a, b) \<in> Affine X"
       by (auto simp: Affine_def valuate_def image_iff)
   qed
   also have "\<dots> = Affine X"
     by (simp add: convex_Affine convex_hull_eq)
   finally show ?thesis .
 qed
 
 end
diff --git a/thys/Green/Derivs.thy b/thys/Green/Derivs.thy
--- a/thys/Green/Derivs.thy
+++ b/thys/Green/Derivs.thy
@@ -1,651 +1,649 @@
 theory Derivs
   imports General_Utils
 begin
 
 lemma field_simp_has_vector_derivative [derivative_intros]:
   "(f has_field_derivative y) F \<Longrightarrow> (f has_vector_derivative y) F"
   by (simp add: has_real_derivative_iff_has_vector_derivative)
 
 lemma continuous_on_cases_empty [continuous_intros]:
   "\<lbrakk>closed S; continuous_on S f; \<And>x. \<lbrakk>x \<in> S; \<not> P x\<rbrakk> \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow>
     continuous_on S (\<lambda>x. if P x then f x else g x)"
   using continuous_on_cases [of _ "{}"] by force
 
 lemma inj_on_cases:
   assumes "inj_on f (Collect P \<inter> S)" "inj_on g (Collect (Not \<circ> P) \<inter> S)"
     "f ` (Collect P \<inter> S) \<inter> g ` (Collect (Not \<circ> P) \<inter> S) = {}"
   shows "inj_on (\<lambda>x. if P x then f x else g x) S"
   using assms by (force simp: inj_on_def)
 
 lemma inj_on_arccos: "S \<subseteq> {-1..1} \<Longrightarrow> inj_on arccos S"
   by (metis atLeastAtMost_iff cos_arccos inj_onI subsetCE)
 
 lemma has_vector_derivative_componentwise_within:
   "(f has_vector_derivative f') (at a within S) \<longleftrightarrow>
     (\<forall>i \<in> Basis. ((\<lambda>x. f x \<bullet> i) has_vector_derivative (f' \<bullet> i)) (at a within S))"
   apply (simp add: has_vector_derivative_def)
   apply (subst has_derivative_componentwise_within)
   apply simp
   done
 
 lemma has_vector_derivative_pair_within:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space" and g :: "real \<Rightarrow> 'b::euclidean_space"
   assumes "\<And>u. u \<in> Basis \<Longrightarrow> ((\<lambda>x. f x \<bullet> u) has_vector_derivative f' \<bullet> u) (at x within S)"
     "\<And>u. u \<in> Basis \<Longrightarrow> ((\<lambda>x. g x \<bullet> u) has_vector_derivative g' \<bullet> u) (at x within S)"
   shows "((\<lambda>x. (f x, g x)) has_vector_derivative (f',g')) (at x within S)"
   apply (subst has_vector_derivative_componentwise_within)
   apply (auto simp: assms Basis_prod_def)
   done
 
 lemma piecewise_C1_differentiable_const:
   shows "(\<lambda>x. c) piecewise_C1_differentiable_on s"
   using continuous_on_const
   by (auto simp add: piecewise_C1_differentiable_on_def)
 
 declare piecewise_C1_differentiable_const [simp, derivative_intros]
 declare piecewise_C1_differentiable_neg [simp, derivative_intros]
 declare piecewise_C1_differentiable_add [simp, derivative_intros]
 declare piecewise_C1_differentiable_diff [simp, derivative_intros]
 
 (*move to Derivative*)
 
 lemma piecewise_C1_differentiable_on_ident [simp, derivative_intros]:
   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
   shows "(\<lambda>x. x) piecewise_C1_differentiable_on S"
   unfolding piecewise_C1_differentiable_on_def using C1_differentiable_on_ident
   by (blast intro: continuous_on_id C1_differentiable_on_ident)
 
 lemma piecewise_C1_differentiable_on_mult [simp, derivative_intros]:
   fixes f :: "real \<Rightarrow> 'a::real_normed_algebra"
   assumes "f piecewise_C1_differentiable_on S" "g piecewise_C1_differentiable_on S"
   shows "(\<lambda>x. f x * g x) piecewise_C1_differentiable_on S"
   using assms
   unfolding piecewise_C1_differentiable_on_def
   apply safe
    apply (blast intro: continuous_intros)
   apply (rename_tac A B)
   apply (rule_tac x="A \<union> B" in exI)
   apply (auto intro: C1_differentiable_on_mult C1_differentiable_on_subset)
   done
 
 lemma C1_differentiable_on_cdiv [simp, derivative_intros]:
   fixes f :: "real \<Rightarrow> 'a :: real_normed_field"
   shows "f C1_differentiable_on S \<Longrightarrow> (\<lambda>x. f x / c) C1_differentiable_on S"
   by (simp add: divide_inverse)
 
 lemma piecewise_C1_differentiable_on_cdiv [simp, derivative_intros]:
   fixes f :: "real \<Rightarrow> 'a::real_normed_field"
   assumes "f piecewise_C1_differentiable_on S"
   shows "(\<lambda>x. f x / c) piecewise_C1_differentiable_on S"
   by (simp add: divide_inverse piecewise_C1_differentiable_const piecewise_C1_differentiable_on_mult assms)
 
 lemma sqrt_C1_differentiable [simp, derivative_intros]:
   assumes f: "f C1_differentiable_on S" and fim: "f ` S \<subseteq> {0<..}"
   shows "(\<lambda>x. sqrt (f x)) C1_differentiable_on S"
 proof -
   have contf: "continuous_on S f"
     by (simp add: C1_differentiable_imp_continuous_on f)
   show ?thesis
     using assms
     unfolding C1_differentiable_on_def has_real_derivative_iff_has_vector_derivative [symmetric]
     by (fastforce intro!: contf continuous_intros derivative_intros)
 qed
 
 lemma sqrt_piecewise_C1_differentiable [simp, derivative_intros]:
   assumes f: "f piecewise_C1_differentiable_on S" and fim: "f ` S \<subseteq> {0<..}"
   shows "(\<lambda>x. sqrt (f x)) piecewise_C1_differentiable_on S"
   using assms
   unfolding piecewise_C1_differentiable_on_def
   by (fastforce intro!: continuous_intros derivative_intros)
 
 lemma
   fixes f :: "real \<Rightarrow> 'a::{banach,real_normed_field}"
   assumes f: "f C1_differentiable_on S"
   shows sin_C1_differentiable [simp, derivative_intros]: "(\<lambda>x. sin (f x)) C1_differentiable_on S"
   and   cos_C1_differentiable [simp, derivative_intros]: "(\<lambda>x. cos (f x)) C1_differentiable_on S"
 proof -
   have contf: "continuous_on S f"
     by (simp add: C1_differentiable_imp_continuous_on f)
   note df_sin = field_vector_diff_chain_at [where g=sin, unfolded o_def]
   note df_cos = field_vector_diff_chain_at [where g=cos, unfolded o_def]
   show  "(\<lambda>x. sin (f x)) C1_differentiable_on S" "(\<lambda>x. cos (f x)) C1_differentiable_on S"
     using assms
     unfolding C1_differentiable_on_def has_real_derivative_iff_has_vector_derivative [symmetric]
     apply auto
     by (rule contf continuous_intros df_sin df_cos derivative_intros exI conjI ballI | force)+
 qed
 
 lemma has_derivative_abs:
   fixes a::real
   assumes "a \<noteq> 0"
   shows "(abs has_derivative ((*) (sgn a))) (at a)"
 proof -
   have [simp]: "norm = abs"
     using real_norm_def by force
   show ?thesis
     using has_derivative_norm [where 'a=real, simplified] assms
     by (simp add: mult_commute_abs)
 qed
 
 lemma abs_C1_differentiable [simp, derivative_intros]:
   fixes f :: "real \<Rightarrow> real"
   assumes f: "f C1_differentiable_on S" and "0 \<notin> f ` S"
   shows "(\<lambda>x. abs (f x)) C1_differentiable_on S"
 proof -
   have contf: "continuous_on S f"
     by (simp add: C1_differentiable_imp_continuous_on f)
   note df = DERIV_chain [where f=abs and g=f, unfolded o_def]
   show ?thesis
     using assms
     unfolding C1_differentiable_on_def has_real_derivative_iff_has_vector_derivative [symmetric]
     apply clarify
     apply (rule df exI conjI ballI)+
       apply (force simp: has_field_derivative_def intro: has_derivative_abs continuous_intros contf)+
     done
 qed
 
 lemma C1_differentiable_on_pair [simp, derivative_intros]:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space" and g :: "real \<Rightarrow> 'b::euclidean_space"
   assumes "f C1_differentiable_on S" "g C1_differentiable_on S"
   shows "(\<lambda>x. (f x, g x)) C1_differentiable_on S"
   using assms unfolding C1_differentiable_on_def
   apply safe
   apply (rename_tac A B)
   apply (intro exI ballI conjI)
    apply (rule_tac f'="A x" and g'="B x" in has_vector_derivative_pair_within)
   using  has_vector_derivative_componentwise_within
   by (blast intro: continuous_on_Pair)+
 
 lemma piecewise_C1_differentiable_on_pair [simp, derivative_intros]:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space" and g :: "real \<Rightarrow> 'b::euclidean_space"
   assumes "f piecewise_C1_differentiable_on S" "g piecewise_C1_differentiable_on S"
   shows "(\<lambda>x. (f x, g x)) piecewise_C1_differentiable_on S"
   using assms unfolding piecewise_C1_differentiable_on_def
   by (blast intro!: continuous_intros C1_differentiable_on_pair del: continuous_on_discrete
       intro: C1_differentiable_on_subset)
 
 lemma test2:
   assumes s: "\<And>x. x \<in> {0..1} - s \<Longrightarrow> g differentiable at x"
     and fs: "finite s" and uv: "u \<in> {0..1}" "v \<in> {0..1}" "u \<le> v"
     and "x \<in> {0..1}" "x \<notin> (\<lambda>t. (v-u) *\<^sub>R t + u) -` s"
   shows "vector_derivative (\<lambda>x. g ((v-u) * x + u)) (at x within {0..1}) = (v-u) *\<^sub>R vector_derivative g (at ((v-u) * x + u) within{0..1})"
 proof -
   have i:"(g has_vector_derivative vector_derivative g (at ((v - u) * x + u))) (at ((v-u) * x + u))"
     using assms s [of "(v - u) * x + u"] uv mult_left_le [of x "v-u"]
     by (auto simp:  vector_derivative_works)
   have ii:"((\<lambda>x. g ((v - u) * x + u)) has_vector_derivative (v - u) *\<^sub>R vector_derivative g (at ((v - u) * x + u))) (at x)"
     by (intro vector_diff_chain_at [simplified o_def] derivative_eq_intros | simp add: i)+
   have 0: "0 \<le> (v - u) * x + u"
     using assms uv by auto
   have 1: "(v - u) * x + u \<le> 1"
     using assms uv
     by simp (metis add.commute atLeastAtMost_iff atLeastatMost_empty_iff diff_ge_0_iff_ge empty_iff le_diff_eq mult_left_le)
   have iii: "vector_derivative g (at ((v - u) * x + u) within {0..1}) = vector_derivative g (at ((v - u) * x + u))"
     using Derivative.vector_derivative_at_within_ivl[OF i, of "0" "1", OF 0 1]
     by auto
   have iv: "vector_derivative (\<lambda>x. g ((v - u) * x + u)) (at x within {0..1}) = (v - u) *\<^sub>R vector_derivative g (at ((v - u) * x + u))"
     using Derivative.vector_derivative_at_within_ivl[OF ii, of "0" "1"] assms
     by auto
   show ?thesis
     using iii iv by auto
 qed
 
 lemma C1_differentiable_on_components:
   assumes "\<And>i. i \<in> Basis \<Longrightarrow> (\<lambda>x. f x \<bullet> i) C1_differentiable_on s"
   shows "f C1_differentiable_on s"
 proof (clarsimp simp add: C1_differentiable_on_def has_vector_derivative_def)
   have *:"\<forall>f i x. x *\<^sub>R (f \<bullet> i) = (x *\<^sub>R f) \<bullet> i" by auto
   have "\<exists>f'. \<forall>i\<in>Basis. \<forall>x\<in>s. ((\<lambda>x. f x \<bullet> i) has_derivative (\<lambda>z. z *\<^sub>R f' x \<bullet> i)) (at x) \<and> continuous_on s f'"
     using assms lambda_skolem_euclidean[of "\<lambda>i D. (\<forall>x\<in>s. ((\<lambda>x. f x \<bullet> i) has_derivative (\<lambda>z. z *\<^sub>R D x)) (at x)) \<and> continuous_on s D"]
     apply (simp only: C1_differentiable_on_def has_vector_derivative_def *)
     using continuous_on_componentwise[of "s"]
     by metis
   then obtain f' where f': "\<forall>i\<in>Basis. \<forall>x\<in>s. ((\<lambda>x. f x \<bullet> i) has_derivative (\<lambda>z. z *\<^sub>R f' x \<bullet> i)) (at x) \<and> continuous_on s f'"
     by auto
   then have 0: "(\<forall>x\<in>s. (f has_derivative (\<lambda>z. z *\<^sub>R f' x)) (at x)) \<and> continuous_on s f'"
     using f' has_derivative_componentwise_within[of "f", where S= UNIV]
     by auto
   then show "\<exists>D. (\<forall>x\<in>s. (f has_derivative (\<lambda>z. z *\<^sub>R D x)) (at x)) \<and> continuous_on s D" by metis
 qed
 
 lemma piecewise_C1_differentiable_on_components:
   assumes "finite t"
     "\<And>i. i \<in> Basis \<Longrightarrow> (\<lambda>x. f x \<bullet> i) C1_differentiable_on s - t"
     "\<And>i. i \<in> Basis \<Longrightarrow> continuous_on s (\<lambda>x. f x \<bullet> i)"
   shows "f piecewise_C1_differentiable_on s"
   using C1_differentiable_on_components assms continuous_on_componentwise piecewise_C1_differentiable_on_def by blast
 
 lemma all_components_smooth_one_pw_smooth_is_pw_smooth:
   assumes "\<And>i. i \<in> Basis - {j} \<Longrightarrow> (\<lambda>x. f x \<bullet> i) C1_differentiable_on s"
   assumes "(\<lambda>x. f x \<bullet> j) piecewise_C1_differentiable_on s"
   shows "f piecewise_C1_differentiable_on s"
 proof -
   have is_cont: "\<forall>i\<in>Basis. continuous_on s (\<lambda>x. f x \<bullet> i)"
     using assms C1_differentiable_imp_continuous_on piecewise_C1_differentiable_on_def
     by fastforce
   obtain t where t:"(finite t \<and> (\<lambda>x. f x \<bullet> j) C1_differentiable_on s - t)" using assms(2) piecewise_C1_differentiable_on_def by auto
   show ?thesis
     using piecewise_C1_differentiable_on_components[where ?f = "f"]
     using assms(2) piecewise_C1_differentiable_on_def
       C1_differentiable_on_subset[OF assms(1) Diff_subset, where ?B1 ="t"] t is_cont
     by fastforce
 qed
 
 lemma derivative_component_fun_component:
   fixes i::"'a::euclidean_space"
   assumes "f differentiable (at x)"
   shows "((vector_derivative f (at x)) \<bullet> i) = ((vector_derivative (\<lambda>x. (f x) \<bullet> i) (at x)) )"
 proof -
   have "((\<lambda>x. f x \<bullet> i) has_vector_derivative vector_derivative f (at x) \<bullet> i) (at x)"
     using assms and bounded_linear.has_vector_derivative[of "(\<lambda>x. x \<bullet> i)" "f" "(vector_derivative f (at x))" "(at x)"] and
       bounded_linear_inner_left[of "i"] and vector_derivative_works[of "f" "(at x)"]
     by blast
   then show "((vector_derivative f (at x)) \<bullet> i) = ((vector_derivative (\<lambda>x. (f x) \<bullet> i) (at x)) )"
     using vector_derivative_works[of "(\<lambda>x. (f x) \<bullet> i)" "(at x)"] and
       differentiableI_vector[of "(\<lambda>x. (f x) \<bullet> i)" "(vector_derivative f (at x) \<bullet> i)" "(at x)"] and
       Derivative.vector_derivative_at
     by force
 qed
 
 lemma gamma_deriv_at_within:
   assumes a_leq_b: "a < b"  and
     x_within_bounds: "x \<in> {a..b}" and
     gamma_differentiable: "\<forall>x \<in> {a .. b}. \<gamma> differentiable at x"
   shows  "vector_derivative \<gamma> (at x within {a..b}) =  vector_derivative \<gamma> (at x)"
   using Derivative.vector_derivative_at_within_ivl[of "\<gamma>" "vector_derivative \<gamma> (at x)" "x" "a" "b"]
     gamma_differentiable x_within_bounds a_leq_b
   by (auto simp add: vector_derivative_works)
 
 lemma islimpt_diff_finite:
   assumes "finite (t::'a::t1_space set)"
   shows "x islimpt s - t = x islimpt s"
 proof-
   have iii: "s - t = s - (t \<inter> s)" by auto
   have "(t \<inter> s) \<subseteq> s" by auto
   have ii:"finite (t \<inter> s)" using assms(1) by auto
   have i: "(t \<inter> s) \<union> (s - (t \<inter> s)) = ( s)"
     using assms by auto
   then have "x islimpt s - (t \<inter> s) = x islimpt s"
-    using islimpt_Un_finite[OF ii,where ?t = "s - (t \<inter> s)"] i assms(1)
-    by force
+    by (metis ii islimpt_Un_finite)
   then show ?thesis using iii by auto
 qed
 
 lemma ivl_limpt_diff:
   assumes "finite s" "a < b"  "(x::real) \<in> {a..b} - s"
   shows "x islimpt {a..b} - s"
 proof-
   have "x islimpt {a..b}"
   proof (cases "x \<in>{a,b}")
     have i: "finite {a,b}" and ii:  "{a, b} \<union> {a<..<b} = {a..b}" using assms by auto
     assume "x \<in>{a,b}"
     then show ?thesis
-      using islimpt_Un_finite[OF i, where ?t= "{a<..<b}"]
-      by (metis assms(2) empty_iff ii insert_iff islimpt_greaterThanLessThan1 islimpt_greaterThanLessThan2)
+      by (meson DiffE assms(2) assms(3) islimpt_Icc)
   next
     assume "x \<notin>{a,b}"
     then show "x islimpt {a..b}" using assms by auto
   qed
   then show "x islimpt {a..b} - s" using islimpt_diff_finite[OF assms(1)] assms
     by fastforce
 qed
 
 lemma ivl_closure_diff_del:
   assumes "finite s" "a < b"  "(x::real) \<in> {a..b} - s"
   shows "x \<in> closure (({a..b} - s) - {x})"
   using ivl_limpt_diff islimpt_in_closure assms by blast
 
 lemma ivl_not_trivial_limit_within:
   assumes "finite s"
     "a < b"
     "(x::real) \<in> {a..b} - s"
   shows "at x within {a..b} - s \<noteq> bot"
   using assms ivl_closure_diff_del not_trivial_limit_within
   by blast
 
 lemma vector_derivative_at_within_non_trivial_limit:
   "at x within s \<noteq> bot \<and> (f has_vector_derivative f') (at x) \<Longrightarrow>
      vector_derivative f (at x within s) = f'"
   using has_vector_derivative_at_within vector_derivative_within by fastforce
 
 lemma vector_derivative_at_within_ivl_diff:
   "finite s \<and> a < b \<and> (x::real) \<in> {a..b} - s \<and> (f has_vector_derivative f') (at x) \<Longrightarrow>
      vector_derivative f (at x within {a..b} - s) = f'"
   using vector_derivative_at_within_non_trivial_limit ivl_not_trivial_limit_within by fastforce
 
 lemma gamma_deriv_at_within_diff:
   assumes a_leq_b: "a < b"  and
     x_within_bounds: "x \<in> {a..b} - s" and
     gamma_differentiable: "\<forall>x \<in> {a .. b} - s. \<gamma> differentiable at x" and
     s_subset: "s \<subseteq> {a..b}" and
     finite_s: "finite s"
   shows "vector_derivative \<gamma> (at x within {a..b} - s)
                            =  vector_derivative \<gamma> (at x)"
   using vector_derivative_at_within_ivl_diff [of "s" "a" "b" "x" "\<gamma>" "vector_derivative \<gamma> (at x)"]
     gamma_differentiable
     x_within_bounds a_leq_b s_subset finite_s
   by (auto simp add: vector_derivative_works)
 
 lemma gamma_deriv_at_within_gen:
   assumes a_leq_b: "a < b"  and
     x_within_bounds: "x \<in> s" and
     s_subset: "s \<subseteq> {a..b}" and
     gamma_differentiable: "\<forall>x \<in> s. \<gamma> differentiable at x"
   shows "vector_derivative \<gamma> (at x within ({a..b})) =  vector_derivative \<gamma> (at x)"
   using Derivative.vector_derivative_at_within_ivl[of "\<gamma>" "vector_derivative \<gamma> (at x)" "x" "a" "b"]
     gamma_differentiable  x_within_bounds a_leq_b s_subset
   by (auto simp add: vector_derivative_works)
 
 lemma derivative_component_fun_component_at_within_gen:
   assumes gamma_differentiable: "\<forall>x \<in> s. \<gamma> differentiable at x" and s_subset: "s \<subseteq> {0..1}"
   shows "\<forall>x \<in> s. vector_derivative (\<lambda>x. \<gamma> x) (at x within {0..1}) \<bullet> (i::'a:: euclidean_space)
            =  vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x within {0..1})"
 proof -
   have gamma_i_component_smooth:
     "\<forall>x \<in> s. (\<lambda>x. \<gamma> x \<bullet> i) differentiable at x"
     using gamma_differentiable
     by auto
   show "\<forall>x \<in> s. vector_derivative (\<lambda>x. \<gamma> x) (at x within {0..1}) \<bullet> i
                                   =  vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x within {0..1})"
   proof
     fix x::real
     assume x_within_bounds: "x \<in> s"
     have gamma_deriv_at_within:
         "vector_derivative (\<lambda>x. \<gamma> x) (at x within {0..1}) = vector_derivative (\<lambda>x. \<gamma> x) (at x)"
       using gamma_deriv_at_within_gen[of "0" "1"] x_within_bounds
         gamma_differentiable s_subset
       by (auto simp add: vector_derivative_works)
     then have gamma_component_deriv_at_within:
       "vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x)
        = vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x within {0..1})"
       using gamma_deriv_at_within_gen[of "0" "1", where \<gamma> = "(\<lambda>x. \<gamma> x \<bullet> i)"] x_within_bounds
         gamma_i_component_smooth s_subset
       by (auto simp add: vector_derivative_works)
     have gamma_component_deriv_eq_gamma_deriv_component:
       "vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x) = vector_derivative (\<lambda>x. \<gamma> x) (at x) \<bullet> i"
       using derivative_component_fun_component[of "\<gamma>" "x" "i"] gamma_differentiable x_within_bounds
       by auto
     show "vector_derivative \<gamma> (at x within {0..1}) \<bullet> i = vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x within {0..1})"
       using gamma_component_deriv_eq_gamma_deriv_component gamma_component_deriv_at_within gamma_deriv_at_within
       by auto
   qed
 qed
 
 lemma derivative_component_fun_component_at_within:
   assumes gamma_differentiable: "\<forall>x \<in> {0 .. 1}. \<gamma> differentiable at x"
   shows "\<forall>x \<in> {0..1}. vector_derivative (\<lambda>x. \<gamma> x) (at x within {0..1}) \<bullet> (i::'a:: euclidean_space)
                                        =  vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x within {0..1})"
 proof -
   have gamma_i_component_smooth:
     "\<forall>x \<in> {0 .. 1}. (\<lambda>x. \<gamma> x \<bullet> i) differentiable at x"
     using gamma_differentiable by auto
   show "\<forall>x \<in> {0..1}. vector_derivative (\<lambda>x. \<gamma> x) (at x within {0..1}) \<bullet> i
                                   =  vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x within {0..1})"
   proof
     fix x::real
     assume x_within_bounds: "x \<in> {0..1}"
     have gamma_deriv_at_within:
       "vector_derivative (\<lambda>x. \<gamma> x) (at x within {0..1}) =  vector_derivative (\<lambda>x. \<gamma> x) (at x)"
       using gamma_deriv_at_within[of "0" "1"] x_within_bounds
         gamma_differentiable
       by (auto simp add: vector_derivative_works)
     have gamma_component_deriv_at_within:
       "vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x) = vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x within {0..1})"
       using Derivative.vector_derivative_at_within_ivl[of "(\<lambda>x. (\<gamma> x) \<bullet> i)" "vector_derivative (\<lambda>x. (\<gamma> x)  \<bullet> i) (at x)" "x" "0" "1"]
         has_vector_derivative_at_within[of "(\<lambda>x. \<gamma> x \<bullet> i)" "vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x)" "x" "{0..1}"]
         gamma_i_component_smooth x_within_bounds
       by (simp add: vector_derivative_works)
     have gamma_component_deriv_eq_gamma_deriv_component:
       "vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x) = vector_derivative (\<lambda>x. \<gamma> x) (at x) \<bullet> i"
       using derivative_component_fun_component[of "\<gamma>" "x" "i"] gamma_differentiable x_within_bounds
       by auto
     show "vector_derivative \<gamma> (at x within {0..1}) \<bullet> i = vector_derivative (\<lambda>x. \<gamma> x \<bullet> i) (at x within {0..1})"
       using gamma_component_deriv_eq_gamma_deriv_component gamma_component_deriv_at_within gamma_deriv_at_within
       by auto
   qed
 qed
 
 lemma straight_path_diffrentiable_x:
   fixes b :: "real" and y1 ::"real"
   assumes gamma_def: "\<gamma> = (\<lambda>x. (b, y2 + y1 * x))"
   shows "\<forall>x. \<gamma> differentiable at x"
   unfolding gamma_def differentiable_def
   by (fast intro!: derivative_intros)
 
 lemma straight_path_diffrentiable_y:
   fixes b :: "real" and
     y1 y2 ::"real"
   assumes gamma_def: "\<gamma> = (\<lambda>x. (y2 + y1 * x , b))"
   shows "\<forall>x. \<gamma> differentiable at x"
   unfolding gamma_def differentiable_def
   by (fast intro!: derivative_intros)
 
 lemma piecewise_C1_differentiable_on_imp_continuous_on:
   assumes "f piecewise_C1_differentiable_on s"
   shows "continuous_on s f"
   using assms
   by (auto simp add: piecewise_C1_differentiable_on_def)
 
 lemma boring_lemma1:
   fixes f :: "real\<Rightarrow>real"
   assumes "(f has_vector_derivative D) (at x)"
   shows "((\<lambda>x. (f x, 0)) has_vector_derivative ((D,0::real))) (at x)"
 proof-
   have *: "((\<lambda>x. (f x) *\<^sub>R (1,0)) has_vector_derivative (D *\<^sub>R (1,0))) (at x)"
     using bounded_linear.has_vector_derivative[OF Real_Vector_Spaces.bounded_linear_scaleR_left assms(1),
         of "(1,0)"] by auto
   have "((\<lambda>x. (f x) *\<^sub>R (1,0)) has_vector_derivative (D,0)) (at x)"
   proof -
     have "(D, 0::'a) = D *\<^sub>R (1, 0)"
       by simp
     then show ?thesis
       by (metis (no_types) *)
   qed
   then show ?thesis by auto
 qed
 
 lemma boring_lemma2:
   fixes f :: "real\<Rightarrow>real"
   assumes "(f has_vector_derivative D) (at x)"
   shows "((\<lambda>x. (0, f x)) has_vector_derivative (0, D)) (at x)"
 proof-
   have *: "((\<lambda>x. (f x) *\<^sub>R (0,1)) has_vector_derivative (D *\<^sub>R (0,1))) (at x)"
     using bounded_linear.has_vector_derivative[OF Real_Vector_Spaces.bounded_linear_scaleR_left assms(1),
         of "(0,1)"] by auto
   then have "((\<lambda>x. (f x) *\<^sub>R (0,1)) has_vector_derivative ((0,D))) (at x)"
     using scaleR_Pair Real_Vector_Spaces.real_scaleR_def
   proof -
     have "(0::'b, D) = D *\<^sub>R (0, 1)"
       by auto
     then show ?thesis
       by (metis (no_types) *)
   qed
   then show ?thesis by auto
 qed
 
 lemma pair_prod_smooth_pw_smooth:
   assumes "(f::real\<Rightarrow>real) C1_differentiable_on s" "(g::real\<Rightarrow>real) piecewise_C1_differentiable_on s"
   shows "(\<lambda>x. (f x, g x)) piecewise_C1_differentiable_on s"
 proof -
   have f_cont: "continuous_on s f"
     using assms(1) C1_differentiable_imp_continuous_on
     by fastforce
   have g_cont: "continuous_on s g"
     using assms(2)  by (auto simp add: piecewise_C1_differentiable_on_def)
   obtain t where t:"(finite t \<and> g C1_differentiable_on s - t)" using assms(2) piecewise_C1_differentiable_on_def by auto
   show ?thesis
     using piecewise_C1_differentiable_on_components[where ?f = "(\<lambda>x. (f x, g x))"]
     apply (simp add: real_pair_basis)
     using assms(2) piecewise_C1_differentiable_on_def
       C1_differentiable_on_subset[OF assms(1) Diff_subset, where ?B1 ="t"] t
       f_cont g_cont
     by fastforce
 qed
 
 lemma scale_shift_smooth:
   shows "(\<lambda>x. a + b * x) C1_differentiable_on s"
 proof -
   show "(\<lambda>x. a + b * x) C1_differentiable_on s"
     using C1_differentiable_on_mult C1_differentiable_on_add C1_differentiable_on_const
           C1_differentiable_on_ident by auto
 qed
 
 lemma open_diff:
   assumes "finite (t::'a::t1_space set)"
     "open (s::'a set)"
   shows "open (s -t)"
   using assms
 proof(induction "t")
   show "open s \<Longrightarrow> open (s - {})" by auto
 next
   fix x::"'a::t1_space"
   fix F::"'a::t1_space set"
   assume step: "finite F " " x \<notin> F" "open s"
   then have i: "(s - insert x F) = (s - F) - {x}" by auto
   assume ind_hyp: " (open s \<Longrightarrow> open (s - F))"
   show "open (s - insert x F)"
     apply (simp only: i)
     using open_delete[of "s -F"] ind_hyp[OF step(3)] by auto
 qed
 
 lemma has_derivative_transform_within:
   assumes "0 < d"
     and "x \<in> s"
     and "\<forall>x'\<in>s. dist x' x < d \<longrightarrow> f x' = g x'"
     and "(f has_derivative f') (at x within s)"
   shows "(g has_derivative f') (at x within s)"
   using assms
   unfolding has_derivative_within
   by (force simp add: intro: Lim_transform_within)
 
 lemma has_derivative_transform_within_ivl:
   assumes "(0::real) < b"
     and     "\<forall>x\<in>{a..b} -s. f x = g x"
     and "x \<in> {a..b} -s"
     and "(f has_derivative f') (at x within {a..b} - s)"
   shows "(g has_derivative f') (at x within {a..b} - s)"
   using has_derivative_transform_within[of "b" "x" "{a..b} - s"] assms
   by auto
 
 lemma has_vector_derivative_transform_within_ivl:
   assumes "(0::real) < b"
     and     "\<forall>x\<in>{a..b} -s . f x = g x"
     and "x \<in> {a..b} - s"
     and "(f has_vector_derivative f') (at x within {a..b} - s)"
   shows "(g has_vector_derivative f') (at x within {a..b} - s)"
   using assms has_derivative_transform_within_ivl
   apply (auto simp add: has_vector_derivative_def)
   by blast
 
 lemma has_derivative_transform_at:
   assumes "0 < d"
     and "\<forall>x'. dist x' x < d \<longrightarrow> f x' = g x'"
     and "(f has_derivative f') (at x)"
   shows "(g has_derivative f') (at x)"
   using has_derivative_transform_within [of d x UNIV f g f'] assms
   by simp
 
 lemma has_vector_derivative_transform_at:
   assumes "0 < d"
     and "\<forall>x'. dist x' x < d \<longrightarrow> f x' = g x'"
     and "(f has_vector_derivative f') (at x)"
   shows "(g has_vector_derivative f') (at x)"
   using assms
   unfolding has_vector_derivative_def
   by (rule has_derivative_transform_at)
 
 lemma C1_diff_components_2:
   assumes "b \<in> Basis"
   assumes "f C1_differentiable_on s"
   shows "(\<lambda>x. f x \<bullet> b) C1_differentiable_on s"
 proof -
   obtain D where D:"(\<forall>x\<in>s. (f has_derivative (\<lambda>z. z *\<^sub>R D x)) (at x))" "continuous_on s D"
     using assms(2) by (fastforce simp add: C1_differentiable_on_def has_vector_derivative_def)
   show ?thesis
   proof (simp add: C1_differentiable_on_def has_vector_derivative_def, intro exI conjI)
     show "continuous_on s (\<lambda>x. D x \<bullet> b)" using D continuous_on_componentwise assms(1) by fastforce
     show "(\<forall>x\<in>s. ((\<lambda>x. f x \<bullet> b) has_derivative (\<lambda>y. y * (\<lambda>x. D x \<bullet> b) x)) (at x))"
       using has_derivative_inner_left D(1) by fastforce
   qed
 qed
 
 lemma eq_smooth:
   assumes "0 < d"
     "\<forall>x\<in>s. \<forall>y. dist x y < d \<longrightarrow> f y = g y" (*This crappy condition cannot be loosened :( *)
     "f C1_differentiable_on s"
   shows "g C1_differentiable_on s"
 proof (simp add: C1_differentiable_on_def)
   obtain D where D: "(\<forall>x\<in>s. (f has_vector_derivative D x) (at x)) \<and> continuous_on s D"
     using assms by (auto simp add: C1_differentiable_on_def)
   then have f: "(\<forall>x\<in>s. (g has_vector_derivative D x) (at x))"
     using assms(1-2)
     by (metis dist_commute has_vector_derivative_transform_at)
   have "(\<forall>x\<in>s. (g has_vector_derivative D x) (at x)) \<and> continuous_on s D" using D f by auto
   then show "\<exists>D. (\<forall>x\<in>s. (g has_vector_derivative D x) (at x)) \<and> continuous_on s D" by metis
 qed
 
 lemma eq_pw_smooth:
   assumes "0 < d"
     "\<forall>x\<in>s. \<forall>y. dist x y < d \<longrightarrow> f y = g y" (*This crappy condition cannot be loosened :( *)
     "\<forall>x\<in>s. f x = g x"
     "f piecewise_C1_differentiable_on s"
   shows "g piecewise_C1_differentiable_on s"
 proof (simp add: piecewise_C1_differentiable_on_def)
   have g_cont: "continuous_on s g" using assms piecewise_C1_differentiable_const
     by (simp add: piecewise_C1_differentiable_on_def)
   obtain t where t: "finite t \<and> f C1_differentiable_on s - t"
     using assms by (auto simp add: piecewise_C1_differentiable_on_def)
   then have "g C1_differentiable_on s - t" using assms eq_smooth by blast
   then show "continuous_on s g \<and> (\<exists>t. finite t \<and> g C1_differentiable_on s - t)"
     using t g_cont by metis
 qed
 
 lemma scale_piecewise_C1_differentiable_on:
   assumes "f piecewise_C1_differentiable_on s"
   shows "(\<lambda>x. (c::real) * (f x)) piecewise_C1_differentiable_on s"
 proof (simp add: piecewise_C1_differentiable_on_def, intro conjI)
   show "continuous_on s (\<lambda>x. c * f x)"
     using assms continuous_on_mult_left
     by (auto simp add: piecewise_C1_differentiable_on_def)
   show "\<exists>t. finite t \<and> (\<lambda>x. c * f x) C1_differentiable_on s - t"
     using assms continuous_on_mult_left
     by (auto simp add: piecewise_C1_differentiable_on_def)
 qed
 
 lemma eq_smooth_gen:
   assumes "f C1_differentiable_on s"
     "\<forall>x. f x = g x"
   shows "g C1_differentiable_on s"
   using assms unfolding C1_differentiable_on_def
   by (metis (no_types, lifting) has_vector_derivative_weaken UNIV_I top_greatest)
 
 lemma subpath_compose:
   shows "(subpath a b \<gamma>) = \<gamma> o (\<lambda>x.  (b - a) * x + a)"
   by (auto simp add: subpath_def)
 
 lemma subpath_smooth:
   assumes "\<gamma> C1_differentiable_on {0..1}" "0 \<le> a" "a < b" "b \<le> 1"
   shows "(subpath a b \<gamma>) C1_differentiable_on {0..1}"
 proof-
   have "\<gamma> C1_differentiable_on {a..b}"
     apply (rule C1_differentiable_on_subset)
     using assms by auto
   then have "\<gamma> C1_differentiable_on (\<lambda>x. (b - a) * x + a) ` {0..1}"
     using \<open>a < b\<close> closed_segment_eq_real_ivl closed_segment_real_eq by auto
   moreover have "finite ({0..1} \<inter> (\<lambda>x. (b - a) * x + a) -` {x})" for x
   proof -
     have "((\<lambda>x. (b - a) * x + a) -` {x}) = {(x -a) /(b-a)}"
       using assms by (auto simp add: divide_simps)
     then show ?thesis
       by auto
   qed
   ultimately show ?thesis
     by (force simp add: subpath_compose intro: C1_differentiable_compose derivative_intros)
 qed
 
 lemma has_vector_derivative_divide[derivative_intros]:
   fixes a :: "'a::real_normed_field"
   shows "(f has_vector_derivative x) F \<Longrightarrow> ((\<lambda>x. f x / a) has_vector_derivative (x / a)) F"
   unfolding divide_inverse by (fact has_vector_derivative_mult_left)
 
 end
diff --git a/thys/Markov_Models/ex/Zeroconf_Analysis.thy b/thys/Markov_Models/ex/Zeroconf_Analysis.thy
--- a/thys/Markov_Models/ex/Zeroconf_Analysis.thy
+++ b/thys/Markov_Models/ex/Zeroconf_Analysis.thy
@@ -1,250 +1,248 @@
 (* Author: Johannes Hölzl <hoelzl@in.tum.de> *)
 
 section \<open>Formalizing the IPv4-address allocation in ZeroConf\<close>
 
 theory Zeroconf_Analysis
   imports "../Discrete_Time_Markov_Chain"
 begin
 
 declare UNIV_bool[simp]
 
 subsection \<open>Definition of a ZeroConf allocation run\<close>
 
 datatype zc_state = start
                   | probe nat
                   | ok
                   | error
 
 lemma inj_probe: "inj_on probe X"
   by (auto simp: inj_on_def)
 
 text \<open>Countability of @{typ zc_state} simplifies measurability of functions on @{typ zc_state}.\<close>
 
 instance zc_state :: countable
 proof
   have "countable ({start, ok, error} \<union> probe`UNIV)"
     by auto
   also have "{start, ok, error} \<union> probe`UNIV = UNIV"
     using zc_state.nchotomy by auto
   finally show "\<exists>f::zc_state \<Rightarrow> nat. inj f"
     using inj_on_to_nat_on[of "UNIV :: zc_state set"] by auto
 qed
 
 locale Zeroconf_Analysis =
   fixes N :: nat and p q r e :: real
   assumes p: "0 < p" "p < 1" and q: "0 < q" "q < 1"
   assumes r[simp]: "0 \<le> r" and e[simp]: "0 \<le> e"
 begin
 
 lemma p_bounds[simp]: "0 \<le> p" "p \<le> 1"
   using p by auto
 
 lemma q_bounds[simp]: "0 \<le> q" "q \<le> 1"
   using q by auto
 
 abbreviation states where
   "states \<equiv> probe ` {.. N} \<union> {start, ok, error}"
 
 primrec \<tau> :: "zc_state \<Rightarrow> zc_state pmf" where
   "\<tau> start     = map_pmf (\<lambda>True \<Rightarrow> probe 0 | False \<Rightarrow> ok) (bernoulli_pmf q)"
 | "\<tau> (probe n) = map_pmf (\<lambda>True \<Rightarrow> (if n < N then probe (Suc n) else error) | False \<Rightarrow> start) (bernoulli_pmf p)"
 | "\<tau> ok        = return_pmf ok"
 | "\<tau> error     = return_pmf error"
 
 primrec \<rho> :: "zc_state \<Rightarrow> zc_state \<Rightarrow> real" where
   "\<rho> start     = (\<lambda>_. 0) (probe 0 := r, ok := r * (N + 1))"
 | "\<rho> (probe n) = (if n < N then (\<lambda>_. 0) (probe (Suc n) := r) else (\<lambda>_. 0) (error := e))"
 | "\<rho> ok        = (\<lambda>_. 0) (ok := 0)"
 | "\<rho> error     = (\<lambda>_. 0) (error := 0)"
 
 lemma \<rho>_nonneg'[simp]: "0 \<le> \<rho> s t"
   using r e by (cases s) auto
 
 sublocale MC_with_rewards \<tau> \<rho> "\<lambda>s. 0"
   proof qed (simp_all add: pair_measure_countable)
 
 subsection \<open>The allocation run is a rewarded DTMC\<close>
 
 abbreviation "E s \<equiv> set_pmf (\<tau> s)"
 
 lemma enabled_ok: "enabled ok \<omega> \<longleftrightarrow> \<omega> = sconst ok"
   by (simp add: enabled_iff_sconst)
 
 lemma finite_E[intro, simp]: "finite (E s)"
   by (cases s) auto
 
 lemma E_closed: "s \<in> states \<Longrightarrow> E s \<subseteq> states"
   using p q by (cases s) (auto split: bool.splits)
 
 lemma enabled_error: "enabled error \<omega> \<longleftrightarrow> \<omega> = sconst error"
   by (simp add: enabled_iff_sconst)
 
 lemma pos_neg_q_pn: "0 < 1 - q * (1 - p^Suc N)"
 proof -
   have "p ^ Suc N \<le> 1 ^ Suc N"
     using p by (intro power_mono) auto
   with p q have "q * (1 - p^Suc N) < 1 * 1"
     by (intro mult_strict_mono) (auto simp: field_simps simp del: power_Suc)
   then show ?thesis by simp
 qed
 
 lemma to_error: assumes "n \<le> N" shows "(probe n, error) \<in> acc"
   using \<open>n \<le> N\<close>
 proof (induction rule: inc_induct)
   case (step n') with p show ?case
     by (intro rtrancl_trans[OF r_into_rtrancl step.IH]) auto
 qed (insert p, auto)
 
 subsection \<open>Probability of a erroneous allocation\<close>
 
 definition "P_err s = \<P>(\<omega> in T s. ev (HLD {error}) (s ## \<omega>))"
 
 lemma P_err:
   defines "p_start == (q * p ^ Suc N) / (1 - q * (1 - p ^ Suc N))"
   defines "p_probe == (\<lambda>n. p ^ Suc (N - n) + (1 - p^Suc (N - n)) * p_start)"
   assumes s: "s \<in> states - {ok, error}"
   shows "P_err s = (case s of ok \<Rightarrow> 0 | error \<Rightarrow> 1 | probe n \<Rightarrow> p_probe n | start \<Rightarrow> p_start)"
     (is "\<dots> = ?E s")
   using s
 proof (rule unique_les)
   have [arith]: "0 \<le> p * (q * p ^ N)"
     using p q by simp
   have p_eq: "p_start = p_probe 0 * q"
     "\<And>n. n < N \<Longrightarrow> p_probe n = p_probe (Suc n) * p + p_start * (1 - p)"
     "p_probe N = p + p_start * (1 - p)"
     using p q
     by (auto simp: p_probe_def p_start_def power_Suc[symmetric] Suc_diff_Suc divide_simps
              simp del: power_Suc)
        (auto simp: field_simps)
   fix s assume s: "s \<in> states - {ok, error}"
   then show "?E s = (\<integral>t. ?E t \<partial>\<tau> s) + 0"
     using p q by (auto intro: p_eq)
   show "\<exists>t\<in>{ok, error}. (s, t) \<in> acc"
     using s q to_error by auto
   from s show "P_err s = integral\<^sup>L (measure_pmf (\<tau> s)) P_err + 0"
     unfolding P_err_def[abs_def] by (subst prob_T) (auto simp: ev_Stream simp del: UNIV_bool)
 next
   fix s assume "s \<in> {ok, error}" then show "P_err s = ?E s"
     by (auto intro!: T.prob_eq_0_AE T.prob_Collect_eq_1[THEN iffD2]
              simp: P_err_def AE_sconst ev_sconst HLD_iff ev_Stream T.prob_space
              simp del: space_T sets_T )
 qed (insert p q, auto intro!: integrable_measure_pmf_finite split: if_split_asm)
 
 lemma P_err_start: "P_err start = (q * p ^ Suc N) / (1 - q * (1 - p ^ Suc N))"
   by (simp add: P_err)
 
 subsection \<open>An allocation run terminates almost surely\<close>
 
 lemma states_closed:
   assumes "s \<in> states"
   assumes "(s, t) \<in> acc_on (- {error, ok})"
   shows "t \<in> states"
   using assms(2,1) p q by induction (auto split: if_split_asm)
 
 lemma finite_reached:
   assumes s: "s \<in> states" shows "finite (acc_on (- {error, ok}) `` {s})"
   using states_closed[OF s]
   by (rule_tac finite_subset[of _ states]) auto
 
 lemma AE_reaches_error_or_ok:
   assumes s: "s \<in> states"
   shows "AE \<omega> in T s. ev (HLD {error, ok}) \<omega>"
 proof (rule AE_T_ev_HLD)
   { fix t assume t: "(s, t) \<in> acc_on (- {error, ok})"
     with states_closed[OF s t] to_error p q show "\<exists>t'\<in>{error, ok}. (t, t') \<in> acc"
       by auto }
 qed (rule finite_reached[OF s])
 
 subsection \<open>Expected runtime of an allocation run\<close>
 
 definition "R s = (\<integral>\<^sup>+ \<omega>. reward_until {error, ok} s \<omega> \<partial>T s)"
 
 definition "R' s = enn2real (R s)"
 
 lemma R_iter: "s \<noteq> error \<Longrightarrow> s \<noteq> ok \<Longrightarrow> R s = (\<integral>\<^sup>+t. ennreal (\<rho> s t) + R t \<partial>\<tau> s)"
   unfolding R_def using T.emeasure_space_1
   by (subst nn_integral_T)
      (auto simp del: \<tau>.simps \<rho>.simps simp add: AE_measure_pmf_iff nn_integral_add
            intro!: nn_integral_cong_AE)
 
 lemma R_finite:
   assumes s: "s \<in> states"
   shows "R s \<noteq> \<infinity>"
   unfolding R_def
 proof (rule nn_integral_reward_until_finite)
   { fix t assume "(s, t) \<in> acc" from this s p q have "t \<in> states"
       by induction (auto split: if_split_asm) }
   then have "acc `` {s} \<subseteq> states"
     by auto
   then show "finite (acc `` {s})"
     by (auto dest: finite_subset)
 qed (auto simp: AE_reaches_error_or_ok[OF s])
 
 lemma R_less_top: "s \<in> states \<Longrightarrow> R s < top"
   using R_finite[of s] by (subst less_top[symmetric]) simp
 
 lemma R'_iter: assumes s: "s \<in> states" "s \<noteq> error" "s \<noteq> ok" shows "R' s = (\<integral>t. \<rho> s t + R' t \<partial>\<tau> s)"
   unfolding R'_def R_iter[OF s(2,3)]
 proof (rule enn2real_nn_integral_eq_integral)
   have "t \<in> E s \<Longrightarrow> R t < top" for t
     using \<open>s\<in>states\<close> E_closed[of s] by (intro R_less_top) auto
   then show "AE t in \<tau> s. ennreal (\<rho> s t) + R t = ennreal (\<rho> s t + enn2real (R t))"
     by (auto simp: AE_measure_pmf_iff intro!: ennreal_enn2real[symmetric])
-  show "(\<integral>\<^sup>+ t. ennreal (\<rho> s t) + R t \<partial>\<tau> s) < \<top>"
-    unfolding R_iter[symmetric, OF s(2,3)] by (rule R_less_top) fact
 qed auto
 
 lemma cost_from_start:
   "R' start =
     (q * (r + p^Suc N * e + r * p * (1 - p^N) / (1 - p)) + (1 - q) * (r * Suc N)) /
     (1 - q + q * p^Suc N)"
 proof -
   have ok_error: "R' ok = 0 \<and> R' error = 0"
     unfolding R'_def R_def by (subst (1 2) reward_until_unfold[abs_def]) simp
 
   then have R_start: "R' start = q * (r + R' (probe 0)) + (1 - q) * (r * (N + 1))"
     using q r by (subst R'_iter) (simp_all add: field_simps)
 
   have R_probe: "\<And>n. n < N \<Longrightarrow> R' (probe n) = p * R' (probe (Suc n)) + p * r + (1 - p) * R' start"
     using p r by (subst R'_iter) (simp_all add: field_simps distrib_right)
 
   have R_N: "R' (probe N) = p * e + (1 - p) * R' start"
     using p e ok_error by (subst R'_iter) (auto simp: mult.commute )
 
   { fix n
     assume "n \<le> N"
     then have "R' (probe (N - n)) =
       p ^ Suc n * e + (1 - p^n) * r * p / (1 - p) + (1 - p^Suc n) * R' start"
     proof (induct n)
       case 0 with R_N show ?case by simp
     next
       case (Suc n)
       moreover then have "Suc (N - Suc n) = N - n" by simp
       ultimately show ?case
         using R_probe[of "N - Suc n"] p by (simp_all add: field_simps Suc)
     qed }
   from this[of N]
   have [simp]: "R' (probe 0) = p ^ Suc N * e + (1 - p^N) * r * p / (1 - p) + (1 - p^Suc N) * R' start"
     by simp
   have "R' start - q * (1 - p^Suc N) * R' start =
     q * (r + p^Suc N * e + (1 - p^N) * r * p / (1 - p)) + (1 - q) * (r * (N + 1))"
     by (subst R_start) (simp_all add: field_simps)
   then have "R' start = (q * (r + p^Suc N * e + (1 - p^N) * r * p / (1 - p)) + (1 - q) * (r * Suc N)) /
     (1 - q * (1 - p^Suc N))"
     using pos_neg_q_pn by (simp_all add: field_simps)
   then show ?thesis
     by (simp add: field_simps)
 qed
 
 end
 
 interpretation ZC: Zeroconf_Analysis 2 "16 / 65024 :: real" "0.01" "0.002" "3600"
   by standard auto
 
 lemma "ZC.P_err start \<le> 1 / 10^12"
   unfolding ZC.P_err_start by (simp add: power_divide power_one_over[symmetric])
 
 lemma "ZC.R' start \<le> 0.007"
   unfolding ZC.cost_from_start by (simp add: power_divide power_one_over[symmetric])
 
 end
diff --git a/thys/Ordinary_Differential_Equations/IVP/Flow.thy b/thys/Ordinary_Differential_Equations/IVP/Flow.thy
--- a/thys/Ordinary_Differential_Equations/IVP/Flow.thy
+++ b/thys/Ordinary_Differential_Equations/IVP/Flow.thy
@@ -1,3194 +1,3193 @@
 section \<open>Flow\<close>
 theory Flow
 imports
   Picard_Lindeloef_Qualitative
   "HOL-Library.Diagonal_Subsequence"
   "../Library/Bounded_Linear_Operator"
   "../Library/Multivariate_Taylor"
   "../Library/Interval_Integral_HK"
 begin
 
 text \<open>TODO: extend theorems for dependence on initial time\<close>
 
 subsection \<open>simp rules for integrability (TODO: move)\<close>
 
 lemma blinfun_ext: "x = y \<longleftrightarrow> (\<forall>i. blinfun_apply x i = blinfun_apply y i)"
   by transfer auto
 
 notation id_blinfun ("1\<^sub>L")
 
 lemma blinfun_inverse_left:
   fixes f::"'a::euclidean_space \<Rightarrow>\<^sub>L 'a" and f'
   shows "f o\<^sub>L f' = 1\<^sub>L \<longleftrightarrow> f' o\<^sub>L f = 1\<^sub>L"
   by transfer
     (auto dest!: bounded_linear.linear simp: id_def[symmetric]
       linear_inverse_left)
 
 lemma onorm_zero_blinfun[simp]: "onorm (blinfun_apply 0) = 0"
   by transfer (simp add: onorm_zero)
 
 lemma blinfun_compose_1_left[simp]: "x o\<^sub>L 1\<^sub>L = x"
   and blinfun_compose_1_right[simp]: "1\<^sub>L o\<^sub>L y = y"
   by (auto intro!: blinfun_eqI)
 
 
 named_theorems integrable_on_simps
 
 lemma integrable_on_refl_ivl[intro, simp]: "g integrable_on {b .. (b::'b::ordered_euclidean_space)}"
   and integrable_on_refl_closed_segment[intro, simp]: "h integrable_on closed_segment a a"
   using integrable_on_refl by auto
 
 lemma integrable_const_ivl_closed_segment[intro, simp]: "(\<lambda>x. c) integrable_on closed_segment a (b::real)"
   by (auto simp: closed_segment_eq_real_ivl)
 
 lemma integrable_ident_ivl[intro, simp]: "(\<lambda>x. x) integrable_on closed_segment a (b::real)"
   and integrable_ident_cbox[intro, simp]: "(\<lambda>x. x) integrable_on cbox a (b::real)"
   by (auto simp: closed_segment_eq_real_ivl ident_integrable_on)
 
 lemma content_closed_segment_real:
   fixes a b::real
   shows "content (closed_segment a b) = abs (b - a)"
   by (auto simp: closed_segment_eq_real_ivl)
 
 lemma integral_const_closed_segment:
   fixes a b::real
   shows "integral (closed_segment a b) (\<lambda>x. c) = abs (b - a) *\<^sub>R c"
   by (auto simp: closed_segment_eq_real_ivl content_closed_segment_real)
 
 lemmas [integrable_on_simps] =
   integrable_on_empty \<comment> \<open>empty\<close>
   integrable_on_refl integrable_on_refl_ivl integrable_on_refl_closed_segment \<comment> \<open>singleton\<close>
   integrable_const integrable_const_ivl integrable_const_ivl_closed_segment \<comment> \<open>constant\<close>
   ident_integrable_on integrable_ident_ivl integrable_ident_cbox \<comment> \<open>identity\<close>
 
 lemma integrable_cmul_real:
   fixes K::real
   shows "f integrable_on X \<Longrightarrow> (\<lambda>x. K * f x) integrable_on X "
   unfolding real_scaleR_def[symmetric]
   by (rule integrable_cmul)
 
 lemmas [integrable_on_simps] =
   integrable_0
   integrable_neg
   integrable_cmul
   integrable_cmul_real
   integrable_on_cmult_iff
   integrable_on_cmult_left
   integrable_on_cmult_right
-  integrable_on_cdivide
   integrable_on_cmult_iff
   integrable_on_cmult_left_iff
   integrable_on_cmult_right_iff
   integrable_on_cdivide_iff
   integrable_diff
   integrable_add
   integrable_sum
 
 lemma dist_cancel_add1: "dist (t0 + et) t0 = norm et"
   by (simp add: dist_norm)
 
 lemma double_nonneg_le:
   fixes a::real
   shows "a * 2 \<le> b \<Longrightarrow> a \<ge> 0 \<Longrightarrow> a \<le> b"
   by arith
 
 
 subsection \<open>Nonautonomous IVP on maximal existence interval\<close>
 
 context ll_on_open_it
 begin
 
 context
 fixes x0
 assumes iv_defined: "t0 \<in> T" "x0 \<in> X"
 begin
 
 lemmas closed_segment_iv_subset_domain = closed_segment_subset_domainI[OF iv_defined(1)]
 
 lemma
   local_unique_solutions:
   obtains t u L
   where
     "0 < t" "0 < u"
     "cball t0 t \<subseteq> existence_ivl t0 x0"
     "cball x0 (2 * u) \<subseteq> X"
     "\<And>t'. t' \<in> cball t0 t \<Longrightarrow> L-lipschitz_on (cball x0 (2 * u)) (f t')"
     "\<And>x. x \<in> cball x0 u \<Longrightarrow> (flow t0 x usolves_ode f from t0) (cball t0 t) (cball x u)"
     "\<And>x. x \<in> cball x0 u \<Longrightarrow> cball x u \<subseteq> X"
 proof -
   from local_unique_solution[OF iv_defined] obtain et ex B L
     where "0 < et" "0 < ex" "cball t0 et \<subseteq> T" "cball x0 ex \<subseteq> X"
       "unique_on_cylinder t0 (cball t0 et) x0 ex f B L"
     by metis
   then interpret cyl: unique_on_cylinder t0 "cball t0 et" x0 ex "cball x0 ex" f B L
     by auto
 
   from cyl.solution_solves_ode order_refl \<open>cball x0 ex \<subseteq> X\<close>
   have "(cyl.solution solves_ode f) (cball t0 et) X"
     by (rule solves_ode_on_subset)
   then have "cball t0 et \<subseteq> existence_ivl t0 x0"
     by (rule existence_ivl_maximal_interval) (insert \<open>cball t0 et \<subseteq> T\<close> \<open>0 < et\<close>, auto)
 
   have "cball t0 et = {t0 - et .. t0 + et}"
     using \<open>et > 0\<close> by (auto simp: dist_real_def)
   then have cylbounds[simp]: "cyl.tmin = t0 - et" "cyl.tmax = t0 + et"
     unfolding cyl.tmin_def cyl.tmax_def
     using \<open>0 < et\<close>
     by auto
 
   define et' where "et' \<equiv> et / 2"
   define ex' where "ex' \<equiv> ex / 2"
 
   have "et' > 0" "ex' > 0" using \<open>0 < et\<close> \<open>0 < ex\<close> by (auto simp: et'_def ex'_def)
   moreover
   from \<open>cball t0 et \<subseteq> existence_ivl t0 x0\<close> have "cball t0 et' \<subseteq> existence_ivl t0 x0"
     by (force simp: et'_def dest!: double_nonneg_le)
   moreover
   from this have "cball t0 et' \<subseteq> T" using existence_ivl_subset[of x0] by simp
   have  "cball x0 (2 * ex') \<subseteq> X" "\<And>t'. t' \<in> cball t0 et' \<Longrightarrow> L-lipschitz_on (cball x0 (2 * ex')) (f t')"
     using cyl.lipschitz \<open>0 < et\<close> \<open>cball x0 ex \<subseteq> X\<close>
     by (auto simp: ex'_def et'_def intro!:)
   moreover
   {
     fix x0'::'a
     assume x0': "x0' \<in> cball x0 ex'"
     {
       fix b
       assume d: "dist x0' b \<le> ex'"
       have "dist x0 b \<le> dist x0 x0' + dist x0' b"
         by (rule dist_triangle)
       also have "\<dots> \<le> ex' + ex'"
         using x0' d by simp
       also have "\<dots> \<le> ex" by (simp add: ex'_def)
       finally have "dist x0 b \<le> ex" .
     } note triangle = this
     have subs1: "cball t0 et' \<subseteq> cball t0 et"
       and subs2: "cball x0' ex' \<subseteq> cball x0 ex"
       and subs: "cball t0 et' \<times> cball x0' ex' \<subseteq> cball t0 et \<times> cball x0 ex"
       using \<open>0 < ex\<close> \<open>0 < et\<close> x0'
       by (auto simp: ex'_def et'_def triangle dest!: double_nonneg_le)
 
     have subset_X: "cball x0' ex' \<subseteq> X"
       using \<open>cball x0 ex \<subseteq> X\<close> subs2 \<open>0 < ex'\<close> by force
     then have "x0' \<in> X" using \<open>0 < ex'\<close> by force
     have x0': "t0 \<in> T" "x0' \<in> X" by fact+
     have half_intros: "a \<le> ex' \<Longrightarrow> a \<le> ex" "a \<le> et' \<Longrightarrow> a \<le> et"
       and halfdiv_intro: "a * 2 \<le> ex / B \<Longrightarrow> a \<le> ex' / B" for a
       using \<open>0 < ex\<close> \<open>0 < et\<close>
       by (auto simp: ex'_def et'_def)
 
     interpret cyl': solution_in_cylinder t0 "cball t0 et'" x0' ex' f "cball x0' ex'" B
       using \<open>0 < et'\<close> \<open>0 < ex'\<close> \<open>0 < et\<close> cyl.norm_f cyl.continuous subs1 \<open>cball t0 et \<subseteq> T\<close>
       apply unfold_locales
       apply (auto simp: split_beta' dist_cancel_add1 intro!: triangle
         continuous_intros cyl.norm_f order_trans[OF _ cyl.e_bounded] halfdiv_intro)
       by (simp add: ex'_def et'_def dist_commute)
 
     interpret cyl': unique_on_cylinder t0 "cball t0 et'" x0' ex' "cball x0' ex'" f B L
       using cyl.lipschitz[simplified] subs subs1
       by (unfold_locales)
          (auto simp: triangle intro!: half_intros lipschitz_on_subset[OF _ subs2])
     from cyl'.solution_usolves_ode
     have "(flow t0 x0' usolves_ode f from t0) (cball t0 et') (cball x0' ex')"
       apply (rule usolves_ode_solves_odeI)
       subgoal
         apply (rule cyl'.solves_ode_on_subset_domain[where Y=X])
         subgoal
           apply (rule solves_ode_on_subset[where S="existence_ivl t0 x0'" and Y=X])
           subgoal by (rule flow_solves_ode[OF x0'])
           subgoal
             using subs2 \<open>cball x0 ex \<subseteq> X\<close> \<open>0 < et'\<close> \<open>cball t0 et' \<subseteq> T\<close>
             by (intro existence_ivl_maximal_interval[OF solves_ode_on_subset[OF cyl'.solution_solves_ode]])
               auto
           subgoal by force
           done
         subgoal by (force simp: \<open>x0' \<in> X\<close> iv_defined)
         subgoal using \<open>0 < et'\<close> by force
         subgoal by force
         subgoal by force
         done
       subgoal by (force simp: \<open>x0' \<in> X\<close> iv_defined cyl'.solution_iv)
       done
     note this subset_X
   } ultimately show thesis ..
 qed
 
 lemma Picard_iterate_mem_existence_ivlI:
   assumes "t \<in> T"
   assumes "compact C" "x0 \<in> C" "C \<subseteq> X"
   assumes "\<And>y s. s \<in> {t0 -- t} \<Longrightarrow> y t0 = x0 \<Longrightarrow> y \<in> {t0--s} \<rightarrow> C \<Longrightarrow> continuous_on {t0--s} y \<Longrightarrow>
       x0 + ivl_integral t0 s (\<lambda>t. f t (y t)) \<in> C"
   shows "t \<in> existence_ivl t0 x0" "\<And>s. s \<in> {t0 -- t} \<Longrightarrow> flow t0 x0 s \<in> C"
 proof -
   have "{t0 -- t} \<subseteq> T"
     by (intro closed_segment_subset_domain iv_defined assms)
   from lipschitz_on_compact[OF compact_segment \<open>{t0 -- t} \<subseteq> T\<close> \<open>compact C\<close> \<open>C \<subseteq> X\<close>]
   obtain L where L: "\<And>s. s \<in> {t0 -- t} \<Longrightarrow> L-lipschitz_on C (f s)" by metis
   interpret uc: unique_on_closed t0 "{t0 -- t}" x0 f C L
     using assms closed_segment_iv_subset_domain
     by unfold_locales
       (auto intro!: L compact_imp_closed \<open>compact C\<close> continuous_on_f continuous_intros
         simp: split_beta)
   have "{t0 -- t} \<subseteq> existence_ivl t0 x0"
     using assms closed_segment_iv_subset_domain
     by (intro maximal_existence_flow[OF solves_ode_on_subset[OF uc.solution_solves_ode]])
       auto
   thus "t \<in> existence_ivl t0 x0"
     using assms by auto
   show "flow t0 x0 s \<in> C" if "s \<in> {t0 -- t}" for s
   proof -
     have "flow t0 x0 s = uc.solution s" "uc.solution s \<in> C"
       using solves_odeD[OF uc.solution_solves_ode] that assms
       by (auto simp: closed_segment_iv_subset_domain
         intro!:  maximal_existence_flowI(2)[where K="{t0 -- t}"])
     thus ?thesis by simp
   qed
 qed
 
 lemma flow_has_vderiv_on: "(flow t0 x0 has_vderiv_on (\<lambda>t. f t (flow t0 x0 t))) (existence_ivl t0 x0)"
   by (rule solves_ode_vderivD[OF flow_solves_ode[OF iv_defined]])
 
 lemmas flow_has_vderiv_on_compose[derivative_intros] =
   has_vderiv_on_compose2[OF flow_has_vderiv_on, THEN has_vderiv_on_eq_rhs]
 
 end
 
 lemma unique_on_intersection:
   assumes sols: "(x solves_ode f) U X" "(y solves_ode f) V X"
   assumes iv_mem: "t0 \<in> U" "t0 \<in> V" and subs: "U \<subseteq> T" "V \<subseteq> T"
   assumes ivls: "is_interval U" "is_interval V"
   assumes iv: "x t0 = y t0"
   assumes mem: "t \<in> U" "t \<in> V"
   shows "x t = y t"
 proof -
   from
     maximal_existence_flow(2)[OF sols(1) refl          ivls(1) iv_mem(1) subs(1) mem(1)]
     maximal_existence_flow(2)[OF sols(2) iv[symmetric] ivls(2) iv_mem(2) subs(2) mem(2)]
   show ?thesis by simp
 qed
 
 lemma unique_solution:
   assumes sols: "(x solves_ode f) U X" "(y solves_ode f) U X"
   assumes iv_mem: "t0 \<in> U" and subs: "U \<subseteq> T"
   assumes ivls: "is_interval U"
   assumes iv: "x t0 = y t0"
   assumes mem: "t \<in> U"
   shows "x t = y t"
   by (metis unique_on_intersection assms)
 
 lemma
   assumes s: "s \<in> existence_ivl t0 x0"
   assumes t: "t + s \<in> existence_ivl s (flow t0 x0 s)"
   shows flow_trans: "flow t0 x0 (s + t) = flow s (flow t0 x0 s) (s + t)"
     and existence_ivl_trans: "s + t \<in> existence_ivl t0 x0"
 proof -
   note ll_on_open_it_axioms
   moreover
   from ll_on_open_it_axioms
   have iv_defined: "t0 \<in> T" "x0 \<in> X"
     and iv_defined': "s \<in> T" "flow t0 x0 s \<in> X"
     using ll_on_open_it.mem_existence_ivl_iv_defined s t
     by blast+
 
   have "{t0--s} \<subseteq> existence_ivl t0 x0"
     by (simp add: s segment_subset_existence_ivl iv_defined)
 
   have "s \<in> existence_ivl s (flow t0 x0 s)"
     by (rule ll_on_open_it.existence_ivl_initial_time; fact)
   have "{s--t + s} \<subseteq> existence_ivl s (flow t0 x0 s)"
     by (rule ll_on_open_it.segment_subset_existence_ivl; fact)
 
   have unique: "flow t0 x0 u = flow s (flow t0 x0 s) u"
     if "u \<in> {s--t + s}" "u \<in> {t0--s}" for u
     using
       ll_on_open_it_axioms
       ll_on_open_it.flow_solves_ode[OF ll_on_open_it_axioms iv_defined]
       ll_on_open_it.flow_solves_ode[OF ll_on_open_it_axioms iv_defined']
       s
     apply (rule ll_on_open_it.unique_on_intersection)
     using \<open>s \<in> existence_ivl s (flow t0 x0 s)\<close> existence_ivl_subset
       \<open>flow t0 x0 s \<in> X\<close> \<open>s \<in> T\<close> iv_defined s t ll_on_open_it.in_existence_between_zeroI
       that ll_on_open_it_axioms ll_on_open_it.mem_existence_ivl_subset
     by (auto simp: is_interval_existence_ivl)
 
   let ?un = "{t0 -- s} \<union> {s -- t + s}"
   let ?if = "\<lambda>t. if t \<in> {t0 -- s} then flow t0 x0 t else flow s (flow t0 x0 s) t"
   have "(?if solves_ode (\<lambda>t. if t \<in> {t0 -- s} then f t else f t)) ?un (X \<union> X)"
     apply (rule connection_solves_ode)
     subgoal by (rule solves_ode_on_subset[OF flow_solves_ode[OF iv_defined] \<open>{t0--s} \<subseteq> _\<close> order_refl])
     subgoal
       by (rule solves_ode_on_subset[OF ll_on_open_it.flow_solves_ode[OF ll_on_open_it_axioms iv_defined']
           \<open>{s--t + s} \<subseteq> _\<close> order_refl])
     subgoal by simp
     subgoal by simp
     subgoal by (rule unique) auto
     subgoal by simp
     done
   then have ifsol: "(?if solves_ode f) ?un X"
     by simp
   moreover
   have "?un \<subseteq> existence_ivl t0 x0"
     using existence_ivl_subset[of x0]
       ll_on_open_it.existence_ivl_subset[OF ll_on_open_it_axioms, of s "flow t0 x0 s"]
       \<open>{t0 -- s} \<subseteq> _\<close> \<open>{s--t + s} \<subseteq> _\<close>
     by (intro existence_ivl_maximal_interval[OF ifsol]) (auto intro!: is_real_interval_union)
   then show "s + t \<in> existence_ivl t0 x0"
     by (auto simp: ac_simps)
   have "(flow t0 x0 solves_ode f) ?un X"
     using \<open>{t0--s} \<subseteq> _\<close> \<open>{s -- t + s} \<subseteq> _\<close>
     by (intro solves_ode_on_subset[OF flow_solves_ode \<open>?un \<subseteq> _\<close> order_refl] iv_defined)
   moreover have "s \<in> ?un"
     by simp
   ultimately have "?if (s + t) = flow t0 x0 (s + t)"
     apply (rule ll_on_open_it.unique_solution)
     using existence_ivl_subset[of x0]
       ll_on_open_it.existence_ivl_subset[OF ll_on_open_it_axioms, of s "flow t0 x0 s"]
       \<open>{t0 -- s} \<subseteq> _\<close> \<open>{s--t + s} \<subseteq> _\<close>
     by (auto intro!: is_real_interval_union simp: ac_simps)
   with unique[of "s + t"]
   show "flow t0 x0 (s + t) = flow s (flow t0 x0 s) (s + t)"
     by (auto split: if_splits simp: ac_simps)
 qed
 
 lemma
   assumes t: "t \<in> existence_ivl t0 x0"
   shows flows_reverse: "flow t (flow t0 x0 t) t0 = x0"
     and existence_ivl_reverse: "t0 \<in> existence_ivl t (flow t0 x0 t)"
 proof -
   have iv_defined: "t0 \<in> T" "x0 \<in> X"
     using mem_existence_ivl_iv_defined t by blast+
   show "t0 \<in> existence_ivl t (flow t0 x0 t)"
     using assms
     by (metis (no_types, opaque_lifting) closed_segment_commute closed_segment_subset_interval
         ends_in_segment(2) general.csol(2-4)
         general.existence_ivl_maximal_segment general.is_interval_existence_ivl
         is_interval_closed_segment_1 iv_defined ll_on_open_it.equals_flowI
         local.existence_ivl_initial_time local.flow_initial_time local.ll_on_open_it_axioms)
   then have "flow t (flow t0 x0 t) (t + (t0 - t)) = flow t0 x0 (t + (t0 - t))"
     by (intro flow_trans[symmetric]) (auto simp: t iv_defined)
   then show "flow t (flow t0 x0 t) t0 = x0"
     by (simp add: iv_defined)
 qed
 
 lemma flow_has_derivative:
   assumes "t \<in> existence_ivl t0 x0"
   shows "(flow t0 x0 has_derivative (\<lambda>i. i *\<^sub>R f t (flow t0 x0 t))) (at t)"
 proof -
   have "(flow t0 x0 has_derivative (\<lambda>i. i *\<^sub>R f t (flow t0 x0 t))) (at t within existence_ivl t0 x0)"
     using flow_has_vderiv_on
     by (auto simp: has_vderiv_on_def has_vector_derivative_def assms mem_existence_ivl_iv_defined[OF assms])
   then show ?thesis
     by (simp add: at_within_open[OF assms open_existence_ivl])
 qed
 
 
 lemma flow_has_vector_derivative:
   assumes "t \<in> existence_ivl t0 x0"
   shows "(flow t0 x0 has_vector_derivative f t (flow t0 x0 t)) (at t)"
   using flow_has_derivative[OF assms]
   by (simp add: has_vector_derivative_def)
 
 lemma flow_has_vector_derivative_at_0:
   assumes"t \<in> existence_ivl t0 x0"
   shows "((\<lambda>h. flow t0 x0 (t + h)) has_vector_derivative f t (flow t0 x0 t)) (at 0)"
 proof -
   from flow_has_vector_derivative[OF assms]
   have
     "((+) t has_vector_derivative 1) (at 0)"
     "(flow t0 x0 has_vector_derivative f t (flow t0 x0 t)) (at (t + 0))"
     by (auto intro!: derivative_eq_intros)
   from vector_diff_chain_at[OF this]
   show ?thesis by (simp add: o_def)
 qed
 
 lemma
   assumes "t \<in> existence_ivl t0 x0"
   shows closed_segment_subset_existence_ivl: "closed_segment t0 t \<subseteq> existence_ivl t0 x0"
     and ivl_subset_existence_ivl: "{t0 .. t} \<subseteq> existence_ivl t0 x0"
     and ivl_subset_existence_ivl': "{t .. t0} \<subseteq> existence_ivl t0 x0"
   using assms in_existence_between_zeroI
   by (auto simp: closed_segment_eq_real_ivl)
 
 lemma flow_fixed_point:
   assumes t: "t \<in> existence_ivl t0 x0"
   shows "flow t0 x0 t = x0 + ivl_integral t0 t (\<lambda>t. f t (flow t0 x0 t))"
 proof -
   have "(flow t0 x0 has_vderiv_on (\<lambda>s. f s (flow t0 x0 s))) {t0 -- t}"
     using closed_segment_subset_existence_ivl[OF t]
     by (auto intro!: has_vector_derivative_at_within flow_has_vector_derivative
       simp: has_vderiv_on_def)
   from fundamental_theorem_of_calculus_ivl_integral[OF this]
   have "((\<lambda>t. f t (flow t0 x0 t)) has_ivl_integral flow t0 x0 t - x0) t0 t"
     by (simp add: mem_existence_ivl_iv_defined[OF assms])
   from this[THEN ivl_integral_unique]
   show ?thesis by simp
 qed
 
 lemma flow_continuous: "t \<in> existence_ivl t0 x0 \<Longrightarrow> continuous (at t) (flow t0 x0)"
   by (metis has_derivative_continuous flow_has_derivative)
 
 lemma flow_tendsto: "t \<in> existence_ivl t0 x0 \<Longrightarrow> (ts \<longlongrightarrow> t) F \<Longrightarrow>
     ((\<lambda>s. flow t0 x0 (ts s)) \<longlongrightarrow> flow t0 x0 t) F"
   by (rule isCont_tendsto_compose[OF flow_continuous])
 
 lemma flow_continuous_on: "continuous_on (existence_ivl t0 x0) (flow t0 x0)"
   by (auto intro!: flow_continuous continuous_at_imp_continuous_on)
 
 lemma flow_continuous_on_intro:
   "continuous_on s g \<Longrightarrow>
   (\<And>xa. xa \<in> s \<Longrightarrow> g xa \<in> existence_ivl t0 x0) \<Longrightarrow>
   continuous_on s (\<lambda>xa. flow t0 x0 (g xa))"
   by (auto intro!: continuous_on_compose2[OF flow_continuous_on])
 
 lemma f_flow_continuous:
   assumes "t \<in> existence_ivl t0 x0"
   shows "isCont (\<lambda>t. f t (flow t0 x0 t)) t"
   by (rule continuous_on_interior)
     (insert existence_ivl_subset assms,
       auto intro!: flow_in_domain flow_continuous_on continuous_intros
         simp: interior_open open_existence_ivl)
 
 lemma exponential_initial_condition:
   assumes y0: "t \<in> existence_ivl t0 y0"
   assumes z0: "t \<in> existence_ivl t0 z0"
   assumes "Y \<subseteq> X"
   assumes remain: "\<And>s. s \<in> closed_segment t0 t \<Longrightarrow> flow t0 y0 s \<in> Y"
     "\<And>s. s \<in> closed_segment t0 t \<Longrightarrow> flow t0 z0 s \<in> Y"
   assumes lipschitz: "\<And>s. s \<in> closed_segment t0 t \<Longrightarrow> K-lipschitz_on Y (f s)"
   shows "norm (flow t0 y0 t - flow t0 z0 t) \<le> norm (y0 - z0) * exp ((K + 1) * abs (t - t0))"
 proof cases
   assume "y0 = z0"
   thus ?thesis
     by simp
 next
   assume ne: "y0 \<noteq> z0"
   define K' where "K' \<equiv> K + 1"
   from lipschitz have "K'-lipschitz_on Y (f s)" if "s \<in> {t0 -- t}" for s
     using that
     by (auto simp: lipschitz_on_def K'_def
       intro!: order_trans[OF _ mult_right_mono[of K "K + 1"]])
 
   from mem_existence_ivl_iv_defined[OF y0] mem_existence_ivl_iv_defined[OF z0]
   have "t0 \<in> T" and inX: "y0 \<in> X" "z0 \<in> X" by auto
 
   from remain[of t0] inX \<open>t0 \<in> T \<close> have "y0 \<in> Y" "z0 \<in> Y" by auto
 
   define v where "v \<equiv> \<lambda>t. norm (flow t0 y0 t - flow t0 z0 t)"
   {
     fix s
     assume s: "s \<in> {t0 -- t}"
     with s
       closed_segment_subset_existence_ivl[OF y0]
       closed_segment_subset_existence_ivl[OF z0]
     have
       y0': "s \<in> existence_ivl t0 y0" and
       z0': "s \<in> existence_ivl t0 z0"
       by (auto simp: closed_segment_eq_real_ivl)
     have integrable:
       "(\<lambda>t. f t (flow t0 y0 t)) integrable_on {t0--s}"
       "(\<lambda>t. f t (flow t0 z0 t)) integrable_on {t0--s}"
       using closed_segment_subset_existence_ivl[OF y0']
         closed_segment_subset_existence_ivl[OF z0']
         \<open>y0 \<in> X\<close> \<open>z0 \<in> X\<close> \<open>t0 \<in> T\<close>
       by (auto intro!: continuous_at_imp_continuous_on f_flow_continuous
         integrable_continuous_closed_segment)
     hence int: "flow t0 y0 s - flow t0 z0 s =
         y0 - z0 + ivl_integral t0 s (\<lambda>t. f t (flow t0 y0 t) - f t (flow t0 z0 t))"
       unfolding v_def
       using flow_fixed_point[OF y0'] flow_fixed_point[OF z0']
         s
       by (auto simp: algebra_simps ivl_integral_diff)
     have "v s \<le> v t0 + K' *  integral {t0 -- s} (\<lambda>t. v t)"
       using closed_segment_subset_existence_ivl[OF y0'] closed_segment_subset_existence_ivl[OF z0'] s
         using closed_segment_closed_segment_subset[OF _ _ s, of _ t0, simplified]
       by (subst integral_mult)
         (auto simp: integral_mult v_def int inX \<open>t0 \<in> T\<close>
           simp del: Henstock_Kurzweil_Integration.integral_mult_right
           intro!: norm_triangle_le ivl_integral_norm_bound_integral
             integrable_continuous_closed_segment continuous_intros
             continuous_at_imp_continuous_on flow_continuous f_flow_continuous
             lipschitz_on_normD[OF \<open>_ \<Longrightarrow> K'-lipschitz_on _ _\<close>] remain)
   } note le = this
   have cont: "continuous_on {t0 -- t} v"
     using closed_segment_subset_existence_ivl[OF y0] closed_segment_subset_existence_ivl[OF z0] inX
     by (auto simp: v_def \<open>t0 \<in> T\<close>
       intro!: continuous_at_imp_continuous_on continuous_intros flow_continuous)
   have nonneg: "\<And>t. v t \<ge> 0"
     by (auto simp: v_def)
   from ne have pos: "v t0 > 0"
     by (auto simp: v_def \<open>t0 \<in> T\<close> inX)
   have lippos: "K' > 0"
   proof -
     have "0 \<le> dist (f t0 y0) (f t0 z0)" by simp
     also from lipschitz_onD[OF lipschitz \<open>y0 \<in> Y\<close> \<open>z0 \<in> Y\<close>, of t0]ne
     have "\<dots> \<le> K * dist y0 z0"
       by simp
     finally have "0 \<le> K"
       by (metis dist_le_zero_iff ne zero_le_mult_iff)
     thus ?thesis by (simp add: K'_def)
   qed
   from le cont nonneg pos \<open>0 < K'\<close>
   have "v t \<le> v t0 * exp (K' * abs (t - t0))"
     by (rule gronwall_general_segment) simp_all
   thus ?thesis
     by (simp add: v_def K'_def \<open>t0 \<in> T\<close> inX)
 qed
 
 lemma
   existence_ivl_cballs:
   assumes iv_defined: "t0 \<in> T" "x0 \<in> X"
   obtains t u L
   where
     "\<And>y. y \<in> cball x0 u \<Longrightarrow> cball t0 t \<subseteq> existence_ivl t0 y"
     "\<And>s y. y \<in> cball x0 u \<Longrightarrow> s \<in> cball t0 t \<Longrightarrow> flow t0 y s \<in> cball y u"
     "L-lipschitz_on (cball t0 t\<times>cball x0 u) (\<lambda>(t, x). flow t0 x t)"
     "\<And>y. y \<in> cball x0 u \<Longrightarrow> cball y u \<subseteq> X"
     "0 < t" "0 < u"
 proof -
   note iv_defined
   from local_unique_solutions[OF this]
   obtain t u L where tu: "0 < t" "0 < u"
     and subsT: "cball t0 t \<subseteq> existence_ivl t0 x0"
     and subs': "cball x0 (2 * u) \<subseteq> X"
     and lipschitz: "\<And>s. s \<in> cball t0 t \<Longrightarrow> L-lipschitz_on (cball x0 (2*u)) (f s)"
     and usol: "\<And>y. y \<in> cball x0 u \<Longrightarrow> (flow t0 y usolves_ode f from t0) (cball t0 t) (cball y u)"
     and subs: "\<And>y. y \<in> cball x0 u \<Longrightarrow> cball y u \<subseteq> X"
     by metis
   {
     fix y assume y: "y \<in> cball x0 u"
     from subs[OF y] \<open>0 < u\<close> have "y \<in> X" by auto
     note iv' = \<open>t0 \<in> T\<close> \<open>y \<in> X\<close>
     from usol[OF y, THEN usolves_odeD(1)]
     have sol1: "(flow t0 y solves_ode f) (cball t0 t) (cball y u)" .
     from sol1 order_refl subs[OF y]
     have sol: "(flow t0 y solves_ode f) (cball t0 t) X"
       by (rule solves_ode_on_subset)
     note * = maximal_existence_flow[OF sol flow_initial_time
         is_interval_cball_1 _ order_trans[OF subsT existence_ivl_subset],
         unfolded centre_in_cball, OF iv' less_imp_le[OF \<open>0 < t\<close>]]
     have eivl: "cball t0 t \<subseteq> existence_ivl t0 y"
       by (rule *)
     have "flow t0 y s \<in> cball y u" if "s \<in> cball t0 t" for s
       by (rule solves_odeD(2)[OF sol1 that])
     note eivl this
   } note * = this
   note *
   moreover
   have cont_on_f_flow:
     "\<And>x1 S. S \<subseteq> cball t0 t \<Longrightarrow> x1 \<in> cball x0 u \<Longrightarrow> continuous_on S (\<lambda>t. f t (flow t0 x1 t))"
     using subs[of x0] \<open>u > 0\<close> *(1) iv_defined
     by (auto intro!: continuous_at_imp_continuous_on f_flow_continuous)
   have "bounded ((\<lambda>(t, x). f t x) ` (cball t0 t \<times> cball x0 (2 * u)))"
     using subs' subsT existence_ivl_subset[of x0]
     by (auto intro!: compact_imp_bounded compact_continuous_image compact_Times
       continuous_intros simp: split_beta')
   then obtain B where B: "\<And>s y. s \<in> cball t0 t \<Longrightarrow> y \<in> cball x0 (2 * u) \<Longrightarrow> norm (f s y) \<le> B" "B > 0"
     by (auto simp: bounded_pos cball_def)
   have flow_in_cball: "flow t0 x1 s \<in> cball x0 (2 * u)"
     if s: "s \<in> cball t0 t" and x1: "x1 \<in> cball x0 u"
     for s::real and x1
   proof -
     from *(2)[OF x1 s] have "flow t0 x1 s \<in> cball x1 u" .
     also have "\<dots> \<subseteq> cball x0 (2 * u)"
       using x1
       by (auto intro!: dist_triangle_le[OF add_mono, of _ x1 u _ u, simplified]
         simp: dist_commute)
     finally show ?thesis .
   qed
   have "(B + exp ((L + 1) * \<bar>t\<bar>))-lipschitz_on (cball t0 t\<times>cball x0 u) (\<lambda>(t, x). flow t0 x t)"
   proof (rule lipschitz_onI, safe)
     fix t1 t2 :: real and x1 x2
     assume t1: "t1 \<in> cball t0 t" and t2: "t2 \<in> cball t0 t"
       and x1: "x1 \<in> cball x0 u" and x2: "x2 \<in> cball x0 u"
     have t1_ex: "t1 \<in> existence_ivl t0 x1"
       and t2_ex: "t2 \<in> existence_ivl t0 x1" "t2 \<in> existence_ivl t0 x2"
       and "x1 \<in> cball x0 (2*u)" "x2 \<in> cball x0 (2*u)"
       using *(1)[OF x1] *(1)[OF x2] t1 t2 x1 x2 tu by auto
     have "dist (flow t0 x1 t1) (flow t0 x2 t2) \<le>
       dist (flow t0 x1 t1) (flow t0 x1 t2) + dist (flow t0 x1 t2) (flow t0 x2 t2)"
       by (rule dist_triangle)
     also have "dist (flow t0 x1 t2) (flow t0 x2 t2) \<le> dist x1 x2 * exp ((L + 1) * \<bar>t2 - t0\<bar>)"
       unfolding dist_norm
     proof (rule exponential_initial_condition[where Y = "cball x0 (2 * u)"])
       fix s assume "s \<in> closed_segment t0 t2" hence s: "s \<in> cball t0 t"
         using t2
         by (auto simp: dist_real_def closed_segment_eq_real_ivl split: if_split_asm)
       show "flow t0 x1 s \<in> cball x0 (2 * u)"
         by (rule flow_in_cball[OF s x1])
       show "flow t0 x2 s \<in> cball x0 (2 * u)"
         by (rule flow_in_cball[OF s x2])
       show "L-lipschitz_on (cball x0 (2 * u)) (f s)" if "s \<in> closed_segment t0 t2" for s
         using that centre_in_cball convex_contains_segment less_imp_le t2 tu(1)
         by (blast intro!: lipschitz)
     qed (fact)+
     also have "\<dots> \<le> dist x1 x2 * exp ((L + 1) * \<bar>t\<bar>)"
       using \<open>u > 0\<close> t2
       by (auto
         intro!: mult_left_mono add_nonneg_nonneg lipschitz[THEN lipschitz_on_nonneg]
         simp: cball_eq_empty cball_eq_sing' dist_real_def)
     also
     have "x1 \<in> X"
       using x1 subs[of x0] \<open>u > 0\<close>
       by auto
     have *: "\<bar>t0 - t1\<bar> \<le> t \<Longrightarrow> x \<in> {t0--t1} \<Longrightarrow> \<bar>t0 - x\<bar> \<le> t"
       "\<bar>t0 - t2\<bar> \<le> t \<Longrightarrow> x \<in> {t0--t2} \<Longrightarrow> \<bar>t0 - x\<bar> \<le> t"
       "\<bar>t0 - t1\<bar> \<le> t \<Longrightarrow> \<bar>t0 - t2\<bar> \<le> t \<Longrightarrow> x \<in> {t1--t2} \<Longrightarrow> \<bar>t0 - x\<bar> \<le> t"
       for x
       using t1 t2 t1_ex x1 flow_in_cball[OF _ x1]
       by (auto simp: closed_segment_eq_real_ivl split: if_splits)
 
     have integrable:
       "(\<lambda>t. f t (flow t0 x1 t)) integrable_on {t0--t1}"
       "(\<lambda>t. f t (flow t0 x1 t)) integrable_on {t0--t2}"
       "(\<lambda>t. f t (flow t0 x1 t)) integrable_on {t1--t2}"
       using t1 t2 t1_ex x1 flow_in_cball[OF _ x1]
       by (auto intro!: order_trans[OF integral_bound[where B=B]] cont_on_f_flow B
         integrable_continuous_closed_segment
         intro: *
         simp: dist_real_def integral_minus_sets')
 
     have *: "\<bar>t0 - t1\<bar> \<le> t \<Longrightarrow> \<bar>t0 - t2\<bar> \<le> t \<Longrightarrow> s \<in> {t1--t2} \<Longrightarrow> \<bar>t0 - s\<bar> \<le> t" for s
       by (auto simp: closed_segment_eq_real_ivl split: if_splits)
     note [simp] = t1_ex t2_ex \<open>x1 \<in> X\<close> integrable
     have "dist (flow t0 x1 t1) (flow t0 x1 t2) \<le> dist t1 t2 * B"
       using t1 t2 x1 flow_in_cball[OF _ x1] \<open>t0 \<in> T\<close>
         ivl_integral_combine[of "\<lambda>t. f t (flow t0 x1 t)" t2 t0 t1]
         ivl_integral_combine[of "\<lambda>t. f t (flow t0 x1 t)" t1 t0 t2]
       by (auto simp: flow_fixed_point dist_norm add.commute closed_segment_commute
           norm_minus_commute ivl_integral_minus_sets' ivl_integral_minus_sets
         intro!: order_trans[OF ivl_integral_bound[where B=B]] cont_on_f_flow B dest: *)
     finally
     have "dist (flow t0 x1 t1) (flow t0 x2 t2) \<le>
         dist t1 t2 * B + dist x1 x2 * exp ((L + 1) * \<bar>t\<bar>)"
       by arith
     also have "\<dots> \<le> dist (t1, x1) (t2, x2) * B + dist (t1, x1) (t2, x2) * exp ((L + 1) * \<bar>t\<bar>)"
       using \<open>B > 0\<close>
       by (auto intro!: add_mono mult_right_mono simp: dist_prod_def)
     finally show "dist (flow t0 x1 t1) (flow t0 x2 t2)
        \<le> (B + exp ((L + 1) * \<bar>t\<bar>)) * dist (t1, x1) (t2, x2)"
       by (simp add: algebra_simps)
   qed (simp add: \<open>0 < B\<close> less_imp_le)
   ultimately
   show thesis using subs tu ..
 qed
 
 context
 fixes x0
 assumes iv_defined: "t0 \<in> T" "x0 \<in> X"
 begin
 
 lemma existence_ivl_notempty: "existence_ivl t0 x0 \<noteq> {}"
   using existence_ivl_initial_time iv_defined
   by auto
 
 lemma initial_time_bounds:
   shows "bdd_above (existence_ivl t0 x0) \<Longrightarrow> t0 < Sup (existence_ivl t0 x0)" (is "?a \<Longrightarrow> _")
     and "bdd_below (existence_ivl t0 x0) \<Longrightarrow> Inf (existence_ivl t0 x0) < t0" (is "?b \<Longrightarrow> _")
 proof -
   from local_unique_solutions[OF iv_defined]
   obtain te where te: "te > 0" "cball t0 te \<subseteq> existence_ivl t0 x0"
     by metis
   then
   show "t0 < Sup (existence_ivl t0 x0)" if bdd: "bdd_above (existence_ivl t0 x0)"
     using less_cSup_iff[OF existence_ivl_notempty bdd, of t0] iv_defined
     by (auto simp: dist_real_def intro!: bexI[where x="t0 + te"])
 
   from te show "Inf (existence_ivl t0 x0) < t0" if bdd: "bdd_below (existence_ivl t0 x0)"
     unfolding cInf_less_iff[OF existence_ivl_notempty bdd, of t0]
     by (auto simp: dist_real_def iv_defined intro!: bexI[where x="t0 - te"])
 qed
 
 lemma
   flow_leaves_compact_ivl_right:
   assumes bdd: "bdd_above (existence_ivl t0 x0)"
   defines "b \<equiv> Sup (existence_ivl t0 x0)"
   assumes "b \<in> T"
   assumes "compact K"
   assumes "K \<subseteq> X"
   obtains t where "t \<ge> t0" "t \<in> existence_ivl t0 x0" "flow t0 x0 t \<notin> K"
 proof (atomize_elim, rule ccontr, auto)
   note iv_defined
   note ne = existence_ivl_notempty
   assume K[rule_format]: "\<forall>t. t \<in> existence_ivl t0 x0 \<longrightarrow> t0 \<le> t \<longrightarrow> flow t0 x0 t \<in> K"
   have b_upper: "t \<le> b" if "t \<in> existence_ivl t0 x0" for t
     unfolding b_def
     by (rule cSup_upper[OF that bdd])
 
   have less_b_iff: "y < b \<longleftrightarrow> (\<exists>x\<in>existence_ivl t0 x0. y < x)" for y
     unfolding b_def less_cSup_iff[OF ne bdd] ..
   have "t0 \<le> b"
     by (simp add: iv_defined b_upper)
   then have geI: "t \<in> {t0--<b} \<Longrightarrow> t0 \<le> t" for t
     by (auto simp: half_open_segment_real)
   have subset: "{t0 --< b} \<subseteq> existence_ivl t0 x0"
     using \<open>t0 \<le> b\<close> in_existence_between_zeroI
     by (auto simp: half_open_segment_real iv_defined less_b_iff)
   have sol: "(flow t0 x0 solves_ode f) {t0 --< b} K"
     apply (rule solves_odeI)
     apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF flow_solves_ode] subset])
     using subset iv_defined
     by (auto intro!: K geI)
   have cont: "continuous_on ({t0--b} \<times> K) (\<lambda>(t, x). f t x)"
     using \<open>K \<subseteq> X\<close> closed_segment_subset_domainI[OF iv_defined(1) \<open>b \<in> T\<close>]
     by (auto simp: split_beta intro!: continuous_intros)
 
   from initial_time_bounds(1)[OF bdd] have "t0 \<noteq> b" by (simp add: b_def)
   from solves_ode_half_open_segment_continuation[OF sol cont \<open>compact K\<close> \<open>t0 \<noteq> b\<close>]
   obtain l where lim: "(flow t0 x0 \<longlongrightarrow> l) (at b within {t0--<b})"
     and limsol: "((\<lambda>t. if t = b then l else flow t0 x0 t) solves_ode f) {t0--b} K" .
   have "b \<in> existence_ivl t0 x0"
     using \<open>t0 \<noteq> b\<close> closed_segment_subset_domainI[OF \<open>t0 \<in> T\<close> \<open>b \<in> T\<close>]
     by (intro existence_ivl_maximal_segment[OF solves_ode_on_subset[OF limsol order_refl \<open>K \<subseteq> X\<close>]])
       (auto simp: iv_defined)
 
   have "flow t0 x0 b \<in> X"
     by (simp add: \<open>b \<in> existence_ivl t0 x0\<close> flow_in_domain iv_defined)
 
   from ll_on_open_it.local_unique_solutions[OF ll_on_open_it_axioms \<open>b \<in> T\<close> \<open>flow t0 x0 b \<in> X\<close>]
   obtain e where "e > 0" "cball b e \<subseteq> existence_ivl b (flow t0 x0 b)"
     by metis
   then have "e + b \<in> existence_ivl b (flow t0 x0 b)"
     by (auto simp: dist_real_def)
   from existence_ivl_trans[OF \<open>b \<in> existence_ivl t0 x0\<close> \<open>e + b \<in> existence_ivl _ _\<close>]
   have "b + e \<in> existence_ivl t0 x0" .
   from b_upper[OF this] \<open>e > 0\<close>
   show False
     by simp
 qed
 
 lemma
   flow_leaves_compact_ivl_left:
   assumes bdd: "bdd_below (existence_ivl t0 x0)"
   defines "b \<equiv> Inf (existence_ivl t0 x0)"
   assumes "b \<in> T"
   assumes "compact K"
   assumes "K \<subseteq> X"
   obtains t where "t \<le> t0" "t \<in> existence_ivl t0 x0" "flow t0 x0 t \<notin> K"
 proof -
   interpret rev: ll_on_open "(preflect t0 ` T)" "(\<lambda>t. - f (preflect t0 t))" X ..
   from antimono_preflect bdd have bdd_rev: "bdd_above (rev.existence_ivl t0 x0)"
     unfolding rev_existence_ivl_eq
     by (rule bdd_above_image_antimono)
   note ne = existence_ivl_notempty
   have "Sup (rev.existence_ivl t0 x0) = preflect t0 b"
     using continuous_at_Inf_antimono[OF antimono_preflect _ ne bdd]
     by (simp add: continuous_preflect b_def rev_existence_ivl_eq)
   then have Sup_mem: "Sup (rev.existence_ivl t0 x0) \<in> preflect t0 ` T"
     using \<open>b \<in> T\<close> by auto
 
   have rev_iv: "t0 \<in> preflect t0 ` T" "x0 \<in> X" using iv_defined by auto
   from rev.flow_leaves_compact_ivl_right[OF rev_iv bdd_rev Sup_mem \<open>compact K\<close> \<open>K \<subseteq> X\<close>]
   obtain t where "t0 \<le> t" "t \<in> rev.existence_ivl t0 x0" "rev.flow t0 x0 t \<notin> K" .
 
   then have "preflect t0 t \<le> t0" "preflect t0 t \<in> existence_ivl t0 x0" "flow t0 x0 (preflect t0 t) \<notin> K"
     by (auto simp: rev_existence_ivl_eq rev_flow_eq)
   thus ?thesis ..
 qed
 
 lemma
   sup_existence_maximal:
   assumes "\<And>t. t0 \<le> t \<Longrightarrow> t \<in> existence_ivl t0 x0 \<Longrightarrow> flow t0 x0 t \<in> K"
   assumes "compact K" "K \<subseteq> X"
   assumes "bdd_above (existence_ivl t0 x0)"
   shows "Sup (existence_ivl t0 x0) \<notin> T"
   using flow_leaves_compact_ivl_right[of K] assms by force
 
 lemma
   inf_existence_minimal:
   assumes "\<And>t. t \<le> t0 \<Longrightarrow> t \<in> existence_ivl t0 x0 \<Longrightarrow> flow t0 x0 t \<in> K"
   assumes "compact K" "K \<subseteq> X"
   assumes "bdd_below (existence_ivl t0 x0)"
   shows "Inf (existence_ivl t0 x0) \<notin> T"
   using flow_leaves_compact_ivl_left[of K] assms
   by force
 
 end
 
 lemma
   subset_mem_compact_implies_subset_existence_interval:
   assumes ivl: "t0 \<in> T'" "is_interval T'" "T' \<subseteq> T"
   assumes iv_defined: "x0 \<in> X"
   assumes mem_compact: "\<And>t. t \<in> T' \<Longrightarrow> t \<in> existence_ivl t0 x0 \<Longrightarrow> flow t0 x0 t \<in> K"
   assumes K: "compact K" "K \<subseteq> X"
   shows "T' \<subseteq> existence_ivl t0 x0"
 proof (rule ccontr)
   assume "\<not> T' \<subseteq> existence_ivl t0 x0"
   then obtain t' where t': "t' \<notin> existence_ivl t0 x0" "t' \<in> T'"
     by auto
   from assms have iv_defined: "t0 \<in> T" "x0 \<in> X" by auto
   show False
   proof (cases rule: not_in_connected_cases[OF connected_existence_ivl t'(1) existence_ivl_notempty[OF iv_defined]])
     assume bdd: "bdd_below (existence_ivl t0 x0)"
     assume t'_lower: "t' \<le> y" if "y \<in> existence_ivl t0 x0" for y
     have i: "Inf (existence_ivl t0 x0) \<in> T'"
       using initial_time_bounds[OF iv_defined] iv_defined
       apply -
       by (rule mem_is_intervalI[of _ t' t0])
         (auto simp: ivl t' bdd intro!: t'_lower cInf_greatest[OF existence_ivl_notempty[OF iv_defined]])
     have *: "t \<in> T'" if "t \<le> t0" "t \<in> existence_ivl t0 x0" for t
       by (rule mem_is_intervalI[OF \<open>is_interval T'\<close> i \<open>t0 \<in> T'\<close>]) (auto intro!: cInf_lower that bdd)
     from inf_existence_minimal[OF iv_defined mem_compact K bdd, OF *]
     show False using i ivl by auto
   next
     assume bdd: "bdd_above (existence_ivl t0 x0)"
     assume t'_upper: "y \<le> t'" if "y \<in> existence_ivl t0 x0" for y
     have s: "Sup (existence_ivl t0 x0) \<in> T'"
       using initial_time_bounds[OF iv_defined]
       apply -
       apply (rule mem_is_intervalI[of _ t0 t'])
       by (auto simp: ivl t' bdd intro!: t'_upper cSup_least[OF existence_ivl_notempty[OF iv_defined]])
     have *: "t \<in> T'" if "t0 \<le> t" "t \<in> existence_ivl t0 x0" for t
       by (rule mem_is_intervalI[OF \<open>is_interval T'\<close> \<open>t0 \<in> T'\<close> s]) (auto intro!: cSup_upper that bdd)
     from sup_existence_maximal[OF iv_defined mem_compact K bdd, OF *]
     show False using s ivl by auto
   qed
 qed
 
 lemma
   mem_compact_implies_subset_existence_interval:
   assumes iv_defined: "t0 \<in> T" "x0 \<in> X"
   assumes mem_compact: "\<And>t. t \<in> T \<Longrightarrow> t \<in> existence_ivl t0 x0 \<Longrightarrow> flow t0 x0 t \<in> K"
   assumes K: "compact K" "K \<subseteq> X"
   shows "T \<subseteq> existence_ivl t0 x0"
   by (rule subset_mem_compact_implies_subset_existence_interval; (fact | rule order_refl interval iv_defined))
 
 lemma
   global_right_existence_ivl_explicit:
   assumes "b \<ge> t0"
   assumes b: "b \<in> existence_ivl t0 x0"
   obtains d K where "d > 0" "K > 0"
     "ball x0 d \<subseteq> X"
     "\<And>y. y \<in> ball x0 d \<Longrightarrow> b \<in> existence_ivl t0 y"
     "\<And>t y. y \<in> ball x0 d \<Longrightarrow> t \<in> {t0 .. b} \<Longrightarrow>
       dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * abs (t - t0))"
 proof -
   note iv_defined = mem_existence_ivl_iv_defined[OF b]
   define seg where "seg \<equiv> (\<lambda>t. flow t0 x0 t) ` (closed_segment t0 b)"
   have [simp]: "x0 \<in> seg"
     by (auto simp: seg_def intro!: image_eqI[where x=t0] simp: closed_segment_eq_real_ivl iv_defined)
   have "seg \<noteq> {}" by (auto simp: seg_def closed_segment_eq_real_ivl)
   moreover
   have "compact seg"
     using iv_defined b
     by (auto simp: seg_def closed_segment_eq_real_ivl
         intro!: compact_continuous_image continuous_at_imp_continuous_on flow_continuous;
       metis (erased, opaque_lifting) atLeastAtMost_iff closed_segment_eq_real_ivl
         closed_segment_subset_existence_ivl contra_subsetD order.trans)
   moreover note open_domain(2)
   moreover have "seg \<subseteq> X"
     using closed_segment_subset_existence_ivl b
     by (auto simp: seg_def intro!: flow_in_domain iv_defined)
   ultimately
   obtain e where e: "0 < e" "{x. infdist x seg \<le> e} \<subseteq> X"
     thm compact_in_open_separated
     by (rule compact_in_open_separated)
   define A where "A \<equiv> {x. infdist x seg \<le> e}"
 
   have "A \<subseteq> X" using e by (simp add: A_def)
 
   have mem_existence_ivlI: "\<And>s. t0 \<le> s \<Longrightarrow> s \<le> b \<Longrightarrow> s \<in> existence_ivl t0 x0"
     by (rule in_existence_between_zeroI[OF b]) (auto simp: closed_segment_eq_real_ivl)
 
   have "compact A"
     unfolding A_def
     by (rule compact_infdist_le) fact+
   have "compact {t0 .. b}" "{t0 .. b} \<subseteq> T"
     subgoal by simp
     subgoal
       using mem_existence_ivlI mem_existence_ivl_subset[of _ x0] iv_defined b ivl_subset_existence_ivl
       by blast
     done
   from lipschitz_on_compact[OF this \<open>compact A\<close> \<open>A \<subseteq> X\<close>]
   obtain K' where K': "\<And>t. t \<in> {t0 .. b} \<Longrightarrow> K'-lipschitz_on A (f t)"
     by metis
   define K where "K \<equiv> K' + 1"
   have "0 < K" "0 \<le> K"
     using assms lipschitz_on_nonneg[OF K', of t0]
     by (auto simp: K_def)
   have K: "\<And>t. t \<in> {t0 .. b} \<Longrightarrow> K-lipschitz_on A (f t)"
     unfolding K_def
     using \<open>_ \<Longrightarrow> lipschitz_on K' A _\<close>
     by (rule lipschitz_on_mono) auto
 
   have [simp]: "x0 \<in> A" using \<open>0 < e\<close> by (auto simp: A_def)
 
 
   define d where "d \<equiv> min e (e * exp (-K * (b - t0)))"
   hence d: "0 < d" "d \<le> e" "d \<le> e * exp (-K * (b - t0))"
     using e by auto
 
   have d_times_exp_le: "d * exp (K * (t - t0)) \<le> e" if "t0 \<le> t" "t \<le> b" for t
   proof -
     from that have "d * exp (K * (t - t0)) \<le> d * exp (K * (b - t0))"
       using \<open>0 \<le> K\<close> \<open>0 < d\<close>
       by (auto intro!: mult_left_mono)
     also have "d * exp (K * (b - t0)) \<le> e"
       using d by (auto simp: exp_minus divide_simps)
     finally show ?thesis .
   qed
   have "ball x0 d \<subseteq> X" using d \<open>A \<subseteq> X\<close>
     by (auto simp: A_def dist_commute intro!: infdist_le2[where a=x0])
   note iv_defined
   {
     fix y
     assume y: "y \<in> ball x0 d"
     hence "y \<in> A" using d
       by (auto simp: A_def dist_commute intro!: infdist_le2[where a=x0])
     hence "y \<in> X" using \<open>A \<subseteq> X\<close> by auto
     note y_iv = \<open>t0 \<in> T\<close> \<open>y \<in> X\<close>
     have in_A: "flow t0 y t \<in> A" if t: "t0 \<le> t" "t \<in> existence_ivl t0 y" "t \<le> b" for t
     proof (rule ccontr)
       assume flow_out: "flow t0 y t \<notin> A"
       obtain t' where t':
         "t0 \<le> t'"
         "t' \<le> t"
         "\<And>t. t \<in> {t0 .. t'} \<Longrightarrow> flow t0 x0 t \<in> A"
         "infdist (flow t0 y t') seg \<ge> e"
         "\<And>t. t \<in> {t0 .. t'} \<Longrightarrow> flow t0 y t \<in> A"
       proof -
         let ?out = "((\<lambda>t. infdist (flow t0 y t) seg) -` {e..}) \<inter> {t0..t}"
         have "compact ?out"
           unfolding compact_eq_bounded_closed
         proof safe
           show "bounded ?out" by (auto intro!: bounded_closed_interval)
           have "continuous_on {t0 .. t} ((\<lambda>t. infdist (flow t0 y t) seg))"
             using closed_segment_subset_existence_ivl t iv_defined
             by (force intro!: continuous_at_imp_continuous_on
               continuous_intros flow_continuous
               simp: closed_segment_eq_real_ivl)
           thus "closed ?out"
             by (simp add: continuous_on_closed_vimage)
         qed
         moreover
         have "t \<in> (\<lambda>t. infdist (flow t0 y t) seg) -` {e..} \<inter> {t0..t}"
           using flow_out \<open>t0 \<le> t\<close>
           by (auto simp: A_def)
         hence "?out \<noteq> {}"
           by blast
         ultimately have "\<exists>s\<in>?out. \<forall>t\<in>?out. s \<le> t"
           by (rule compact_attains_inf)
         then obtain t' where t':
           "\<And>s. e \<le> infdist (flow t0 y s) seg \<Longrightarrow> t0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> t' \<le> s"
           "e \<le> infdist (flow t0 y t') seg"
           "t0 \<le> t'" "t' \<le> t"
           by (auto simp: vimage_def Ball_def) metis
         have flow_in: "flow t0 x0 s \<in> A" if s: "s \<in> {t0 .. t'}" for s
         proof -
           from s have "s \<in> closed_segment t0 b"
             using \<open>t \<le> b\<close> t' by (auto simp: closed_segment_eq_real_ivl)
           then show ?thesis
             using s \<open>e > 0\<close> by (auto simp: seg_def A_def)
         qed
         have "flow t0 y t' \<in> A" if "t' = t0"
           using y d iv_defined that
           by (auto simp:  A_def \<open>y \<in> X\<close> infdist_le2[where a=x0] dist_commute)
         moreover
         have "flow t0 y s \<in> A" if s: "s \<in> {t0 ..< t'}" for s
         proof -
           from s have "s \<in> closed_segment t0 b"
             using \<open>t \<le> b\<close> t' by (auto simp: closed_segment_eq_real_ivl)
           from t'(1)[of s]
           have "t' > s \<Longrightarrow> t0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> e > infdist (flow t0 y s) seg"
             by force
           then show ?thesis
             using s t' \<open>e > 0\<close> by (auto simp: seg_def A_def)
         qed
         moreover
         note left_of_in = this
         have "closed A" using \<open>compact A\<close> by (auto simp: compact_eq_bounded_closed)
         have "((\<lambda>s. flow t0 y s) \<longlongrightarrow> flow t0 y t') (at_left t')"
           using closed_segment_subset_existence_ivl[OF t(2)] t' \<open>y \<in> X\<close> iv_defined
           by (intro flow_tendsto) (auto intro!: tendsto_intros simp: closed_segment_eq_real_ivl)
         with \<open>closed A\<close> _ _ have "t' \<noteq> t0 \<Longrightarrow> flow t0 y t' \<in> A"
         proof (rule Lim_in_closed_set)
           assume "t' \<noteq> t0"
           hence "t' > t0" using t' by auto
           hence "eventually (\<lambda>x. x \<ge> t0) (at_left t')"
             by (metis eventually_at_left less_imp_le)
           thus "eventually (\<lambda>x. flow t0 y x \<in> A) (at_left t')"
             unfolding eventually_at_filter
             by eventually_elim (auto intro!: left_of_in)
         qed simp
         ultimately have flow_y_in: "s \<in> {t0 .. t'} \<Longrightarrow> flow t0 y s \<in> A" for s
           by (cases "s = t'"; fastforce)
         have
           "t0 \<le> t'"
           "t' \<le> t"
           "\<And>t. t \<in> {t0 .. t'} \<Longrightarrow> flow t0 x0 t \<in> A"
           "infdist (flow t0 y t') seg \<ge> e"
           "\<And>t. t \<in> {t0 .. t'} \<Longrightarrow> flow t0 y t \<in> A"
           by (auto intro!: flow_in flow_y_in) fact+
         thus ?thesis ..
       qed
       {
         fix s assume s: "s \<in> {t0 .. t'}"
         hence "t0 \<le> s" by simp
         have "s \<le> b"
           using t t' s b
           by auto
         hence sx0: "s \<in> existence_ivl t0 x0"
           by (simp add: \<open>t0 \<le> s\<close> mem_existence_ivlI)
         have sy: "s \<in> existence_ivl t0 y"
           by (meson atLeastAtMost_iff contra_subsetD s t'(1) t'(2) that(2) ivl_subset_existence_ivl)
         have int: "flow t0 y s - flow t0 x0 s =
             y - x0 + (integral {t0 .. s} (\<lambda>t. f t (flow t0 y t)) -
               integral {t0 .. s} (\<lambda>t. f t (flow t0 x0 t)))"
           using iv_defined s
           unfolding flow_fixed_point[OF sx0] flow_fixed_point[OF sy]
           by (simp add: algebra_simps ivl_integral_def)
         have "norm (flow t0 y s - flow t0 x0 s) \<le> norm (y - x0) +
           norm (integral {t0 .. s} (\<lambda>t. f t (flow t0 y t)) -
             integral {t0 .. s} (\<lambda>t. f t (flow t0 x0 t)))"
           unfolding int
           by (rule norm_triangle_ineq)
         also
         have "norm (integral {t0 .. s} (\<lambda>t. f t (flow t0 y t)) -
             integral {t0 .. s} (\<lambda>t. f t (flow t0 x0 t))) =
           norm (integral {t0 .. s} (\<lambda>t. f t (flow t0 y t) - f t (flow t0 x0 t)))"
           using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
           by (subst Henstock_Kurzweil_Integration.integral_diff)
             (auto intro!: integrable_continuous_real continuous_at_imp_continuous_on
               f_flow_continuous
               simp: closed_segment_eq_real_ivl)
         also have "\<dots> \<le> (integral {t0 .. s} (\<lambda>t. norm (f t (flow t0 y t) - f t (flow t0 x0 t))))"
           using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
           by (intro integral_norm_bound_integral)
             (auto intro!: integrable_continuous_real continuous_at_imp_continuous_on
             f_flow_continuous continuous_intros
               simp: closed_segment_eq_real_ivl)
       also have "\<dots> \<le> (integral {t0 .. s} (\<lambda>t. K * norm ((flow t0 y t) - (flow t0 x0 t))))"
           using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
             iv_defined s t'(3,5) \<open>s \<le> b\<close>
           by (auto simp del: Henstock_Kurzweil_Integration.integral_mult_right intro!: integral_le integrable_continuous_real
             continuous_at_imp_continuous_on lipschitz_on_normD[OF K]
             flow_continuous f_flow_continuous continuous_intros
             simp: closed_segment_eq_real_ivl)
         also have "\<dots> = K * integral {t0 .. s} (\<lambda>t. norm (flow t0 y t - flow t0 x0 t))"
           using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
           by (subst integral_mult)
              (auto intro!: integrable_continuous_real continuous_at_imp_continuous_on
                lipschitz_on_normD[OF K] flow_continuous f_flow_continuous continuous_intros
                simp: closed_segment_eq_real_ivl)
         finally
         have norm: "norm (flow t0 y s - flow t0 x0 s) \<le>
           norm (y - x0) + K * integral {t0 .. s} (\<lambda>t. norm (flow t0 y t - flow t0 x0 t))"
           by arith
         note norm \<open>s \<le> b\<close> sx0 sy
       } note norm_le = this
       from norm_le(2) t' have "t' \<in> closed_segment t0 b"
         by (auto simp: closed_segment_eq_real_ivl)
       hence "infdist (flow t0 y t') seg \<le> dist (flow t0 y t') (flow t0 x0 t')"
         by (auto simp: seg_def infdist_le)
       also have "\<dots> \<le> norm (flow t0 y t' - flow t0 x0 t')"
         by (simp add: dist_norm)
       also have "\<dots> \<le> norm (y - x0) * exp (K * \<bar>t' - t0\<bar>)"
         unfolding K_def
         apply (rule exponential_initial_condition[OF _ _ _ _ _ K'])
         subgoal by (metis atLeastAtMost_iff local.norm_le(4) order_refl t'(1))
         subgoal by (metis atLeastAtMost_iff local.norm_le(3) order_refl t'(1))
         subgoal using e by (simp add: A_def)
         subgoal by (metis closed_segment_eq_real_ivl t'(1,5))
         subgoal by (metis closed_segment_eq_real_ivl t'(1,3))
         subgoal by (simp add: closed_segment_eq_real_ivl local.norm_le(2) t'(1))
         done
       also have "\<dots> < d * exp (K * (t - t0))"
         using y d t' t
         by (intro mult_less_le_imp_less)
            (auto simp: dist_norm[symmetric] dist_commute intro!: mult_mono \<open>0 \<le> K\<close>)
       also have "\<dots> \<le> e"
         by (rule d_times_exp_le; fact)
       finally
       have "infdist (flow t0 y t') seg < e" .
       with \<open>infdist (flow t0 y t') seg \<ge> e\<close> show False
         by (auto simp: frontier_def)
     qed
 
     have "{t0..b} \<subseteq> existence_ivl t0 y"
     by (rule subset_mem_compact_implies_subset_existence_interval[OF
       _ is_interval_cc \<open>{t0..b} \<subseteq> T\<close> \<open>y \<in> X\<close> in_A \<open>compact A\<close> \<open>A \<subseteq> X\<close>])
       (auto simp: \<open>t0 \<le> b\<close>)
     with \<open>t0 \<le> b\<close> have b_in: "b \<in> existence_ivl t0 y"
       by force
     {
       fix t assume t: "t \<in> {t0 .. b}"
       also have "{t0 .. b} = {t0 -- b}"
         by (auto simp: closed_segment_eq_real_ivl assms)
       also note closed_segment_subset_existence_ivl[OF b_in]
       finally have t_in: "t \<in> existence_ivl t0 y" .
 
       note t
       also note \<open>{t0 .. b} = {t0 -- b}\<close>
       also note closed_segment_subset_existence_ivl[OF assms(2)]
       finally have t_in': "t \<in> existence_ivl t0 x0" .
       have "norm (flow t0 y t - flow t0 x0 t) \<le> norm (y - x0) * exp (K * \<bar>t - t0\<bar>)"
         unfolding K_def
         using t closed_segment_subset_existence_ivl[OF b_in] \<open>0 < e\<close>
         by (intro in_A exponential_initial_condition[OF t_in t_in' \<open>A \<subseteq> X\<close> _ _ K'])
           (auto simp: closed_segment_eq_real_ivl A_def seg_def)
       hence "dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * \<bar>t - t0\<bar>)"
         by (auto simp: dist_norm[symmetric] dist_commute)
     }
     note b_in this
   } from \<open>d > 0\<close> \<open>K > 0\<close> \<open>ball x0 d \<subseteq> X\<close> this show ?thesis ..
 qed
 
 lemma
   global_left_existence_ivl_explicit:
   assumes "b \<le> t0"
   assumes b: "b \<in> existence_ivl t0 x0"
   assumes iv_defined: "t0 \<in> T" "x0 \<in> X"
   obtains d K where "d > 0" "K > 0"
     "ball x0 d \<subseteq> X"
     "\<And>y. y \<in> ball x0 d \<Longrightarrow> b \<in> existence_ivl t0 y"
     "\<And>t y. y \<in> ball x0 d \<Longrightarrow> t \<in> {b .. t0} \<Longrightarrow> dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * abs (t - t0))"
 proof -
   interpret rev: ll_on_open "(preflect t0 ` T)" "(\<lambda>t. - f (preflect t0 t))" X ..
   have t0': "t0 \<in> preflect t0 ` T" "x0 \<in> X"
     by (auto intro!: iv_defined)
   from assms have "preflect t0 b \<ge> t0" "preflect t0 b \<in> rev.existence_ivl t0 x0"
     by (auto simp: rev_existence_ivl_eq)
   from rev.global_right_existence_ivl_explicit[OF this]
   obtain d K where dK: "d > 0" "K > 0"
     "ball x0 d \<subseteq> X"
     "\<And>y. y \<in> ball x0 d \<Longrightarrow> preflect t0 b \<in> rev.existence_ivl t0 y"
     "\<And>t y. y \<in> ball x0 d \<Longrightarrow> t \<in> {t0 .. preflect t0 b} \<Longrightarrow> dist (rev.flow t0 x0 t) (rev.flow t0 y t) \<le> dist x0 y * exp (K * abs (t - t0))"
     by (auto simp: rev_flow_eq \<open>x0 \<in> X\<close>)
 
   have ex_ivlI: "dist x0 y < d \<Longrightarrow> t \<in> existence_ivl t0 y" if "b \<le> t" "t \<le> t0" for t y
     using that dK(4)[of y] dK(3) iv_defined
     by (auto simp: subset_iff rev_existence_ivl_eq[of ]
       closed_segment_eq_real_ivl iv_defined in_existence_between_zeroI)
   have "b \<in> existence_ivl t0 y" if "dist x0 y < d" for y
     using that dK
     by (subst existence_ivl_eq_rev) (auto simp: iv_defined intro!: image_eqI[where x="preflect t0 b"])
   with dK have "d > 0" "K > 0"
     "ball x0 d \<subseteq> X"
     "\<And>y. y \<in> ball x0 d \<Longrightarrow> b \<in> existence_ivl t0 y"
     "\<And>t y. y \<in> ball x0 d \<Longrightarrow> t \<in> {b .. t0} \<Longrightarrow> dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * abs (t - t0))"
     by (auto simp: flow_eq_rev iv_defined ex_ivlI \<open>x0 \<in> X\<close> subset_iff
       intro!: order_trans[OF dK(5)] image_eqI[where x="preflect t0 b"])
   then show ?thesis ..
 qed
 
 lemma
   global_existence_ivl_explicit:
   assumes a: "a \<in> existence_ivl t0 x0"
   assumes b: "b \<in> existence_ivl t0 x0"
   assumes le: "a \<le> b"
   obtains d K where "d > 0" "K > 0"
     "ball x0 d \<subseteq> X"
     "\<And>y. y \<in> ball x0 d \<Longrightarrow> a \<in> existence_ivl t0 y"
     "\<And>y. y \<in> ball x0 d \<Longrightarrow> b \<in> existence_ivl t0 y"
     "\<And>t y. y \<in> ball x0 d \<Longrightarrow> t \<in> {a .. b} \<Longrightarrow>
       dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * abs (t - t0))"
 proof -
   note iv_defined = mem_existence_ivl_iv_defined[OF a]
   define r where "r \<equiv> Max {t0, a, b}"
   define l where "l \<equiv> Min {t0, a, b}"
   have r: "r \<ge> t0" "r \<in> existence_ivl t0 x0"
     using a b by (auto simp: max_def r_def iv_defined)
   obtain dr Kr where right:
     "0 < dr" "0 < Kr" "ball x0 dr \<subseteq> X"
     "\<And>y. y \<in> ball x0 dr \<Longrightarrow> r \<in> existence_ivl t0 y"
     "\<And>y t. y \<in> ball x0 dr \<Longrightarrow> t \<in> {t0..r} \<Longrightarrow> dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (Kr * \<bar>t - t0\<bar>)"
     by (rule global_right_existence_ivl_explicit[OF r]) blast
 
   have l: "l \<le> t0" "l \<in> existence_ivl t0 x0"
     using a b by (auto simp: min_def l_def iv_defined)
   obtain dl Kl where left:
     "0 < dl" "0 < Kl" "ball x0 dl \<subseteq> X"
     "\<And>y. y \<in> ball x0 dl \<Longrightarrow> l \<in> existence_ivl t0 y"
     "\<And>y t. y \<in> ball x0 dl \<Longrightarrow> t \<in> {l .. t0} \<Longrightarrow> dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (Kl * \<bar>t - t0\<bar>)"
     by (rule global_left_existence_ivl_explicit[OF l iv_defined]) blast
 
   define d where "d \<equiv> min dr dl"
   define K where "K \<equiv> max Kr Kl"
 
   note iv_defined
   have "0 < d" "0 < K" "ball x0 d \<subseteq> X"
     using left right by (auto simp: d_def K_def)
   moreover
   {
     fix y assume y: "y \<in> ball x0 d"
     hence "y \<in> X" using \<open>ball x0 d \<subseteq> X\<close> by auto
     from y
       closed_segment_subset_existence_ivl[OF left(4), of y]
       closed_segment_subset_existence_ivl[OF right(4), of y]
     have "a \<in> existence_ivl t0 y" "b \<in> existence_ivl t0 y"
       by (auto simp: d_def l_def r_def min_def max_def closed_segment_eq_real_ivl split: if_split_asm)
   }
   moreover
   {
     fix t y
     assume y: "y \<in> ball x0 d"
       and t: "t \<in> {a .. b}"
     from y have "y \<in> X" using \<open>ball x0 d \<subseteq> X\<close> by auto
     have "dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * abs (t - t0))"
     proof cases
       assume "t \<ge> t0"
       hence "dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (Kr * abs (t - t0))"
         using y t
         by (intro right) (auto simp: d_def r_def)
       also have "exp (Kr * abs (t - t0)) \<le> exp (K * abs (t - t0))"
         by (auto simp: mult_left_mono K_def max_def mult_right_mono)
       finally show ?thesis by (simp add: mult_left_mono)
     next
       assume "\<not>t \<ge> t0"
       hence "dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (Kl * abs (t - t0))"
         using y t
         by (intro left) (auto simp: d_def l_def)
       also have "exp (Kl * abs (t - t0)) \<le> exp (K * abs (t - t0))"
         by (auto simp: mult_left_mono K_def max_def mult_right_mono)
       finally show ?thesis by (simp add: mult_left_mono)
     qed
   } ultimately show ?thesis ..
 qed
 
 lemma eventually_exponential_separation:
   assumes a: "a \<in> existence_ivl t0 x0"
   assumes b: "b \<in> existence_ivl t0 x0"
   assumes le: "a \<le> b"
   obtains K where "K > 0" "\<forall>\<^sub>F y in at x0. \<forall>t\<in>{a..b}. dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * \<bar>t - t0\<bar>)"
 proof -
   from global_existence_ivl_explicit[OF assms]
   obtain d K where *: "d > 0" "K > 0"
     "ball x0 d \<subseteq> X"
     "\<And>y. y \<in> ball x0 d \<Longrightarrow> a \<in> existence_ivl t0 y"
     "\<And>y. y \<in> ball x0 d \<Longrightarrow> b \<in> existence_ivl t0 y"
     "\<And>t y. y \<in> ball x0 d \<Longrightarrow> t \<in> {a .. b} \<Longrightarrow>
       dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * abs (t - t0))"
     by auto
   note \<open>K > 0\<close>
   moreover
   have "eventually (\<lambda>y. y \<in> ball x0 d) (at x0)"
     using \<open>d > 0\<close>[THEN eventually_at_ball]
     by eventually_elim simp
   hence "eventually (\<lambda>y. \<forall>t\<in>{a..b}. dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * \<bar>t - t0\<bar>)) (at x0)"
     by eventually_elim (safe intro!: *)
   ultimately show ?thesis ..
 qed
 
 lemma eventually_mem_existence_ivl:
   assumes b: "b \<in> existence_ivl t0 x0"
   shows "\<forall>\<^sub>F x in at x0. b \<in> existence_ivl t0 x"
 proof -
   from mem_existence_ivl_iv_defined[OF b] have iv_defined: "t0 \<in> T" "x0 \<in> X" by simp_all
   note eiit = existence_ivl_initial_time[OF iv_defined]
   {
     fix a b
     assume assms: "a \<in> existence_ivl t0 x0" "b \<in> existence_ivl t0 x0" "a \<le> b"
     from global_existence_ivl_explicit[OF assms]
     obtain d K where *: "d > 0" "K > 0"
       "ball x0 d \<subseteq> X"
       "\<And>y. y \<in> ball x0 d \<Longrightarrow> a \<in> existence_ivl t0 y"
       "\<And>y. y \<in> ball x0 d \<Longrightarrow> b \<in> existence_ivl t0 y"
       "\<And>t y. y \<in> ball x0 d \<Longrightarrow> t \<in> {a .. b} \<Longrightarrow>
         dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * abs (t - t0))"
       by auto
     have "eventually (\<lambda>y. y \<in> ball x0 d) (at x0)"
       using \<open>d > 0\<close>[THEN eventually_at_ball]
       by eventually_elim simp
     then have "\<forall>\<^sub>F x in at x0. a \<in> existence_ivl t0 x \<and> b \<in> existence_ivl t0 x"
       by (eventually_elim) (auto intro!: *)
   } from this[OF b eiit] this[OF eiit b]
   show ?thesis
     by (cases "t0 \<le> b") (auto simp: eventually_mono)
 qed
 
 lemma uniform_limit_flow:
   assumes a: "a \<in> existence_ivl t0 x0"
   assumes b: "b \<in> existence_ivl t0 x0"
   assumes le: "a \<le> b"
   shows "uniform_limit {a .. b} (flow t0) (flow t0 x0) (at x0)"
 proof (rule uniform_limitI)
   fix e::real assume "0 < e"
   from eventually_exponential_separation[OF assms] obtain K where "0 < K"
     "\<forall>\<^sub>F y in at x0. \<forall>t\<in>{a..b}. dist (flow t0 x0 t) (flow t0 y t) \<le> dist x0 y * exp (K * \<bar>t - t0\<bar>)"
     by auto
   note this(2)
   moreover
   let ?m = "max (abs (b - t0)) (abs (a - t0))"
   have "eventually (\<lambda>y. \<forall>t\<in>{a..b}. dist x0 y * exp (K * \<bar>t - t0\<bar>) \<le> dist x0 y * exp (K * ?m)) (at x0)"
     using \<open>a \<le> b\<close> \<open>0 < K\<close>
     by (auto intro!: mult_left_mono always_eventually)
   moreover
   have "eventually (\<lambda>y. dist x0 y * exp (K * ?m) < e) (at x0)"
     using \<open>0 < e\<close> by (auto intro!: order_tendstoD tendsto_eq_intros)
   ultimately
   show "eventually (\<lambda>y. \<forall>t\<in>{a..b}. dist (flow t0 y t) (flow t0 x0 t) < e) (at x0)"
     by eventually_elim (force simp: dist_commute)
 qed
 
 lemma eventually_at_fst:
   assumes "eventually P (at (fst x))"
   assumes "P (fst x)"
   shows "eventually (\<lambda>h. P (fst h)) (at x)"
   using assms
   unfolding eventually_at_topological
   by (metis open_vimage_fst rangeI range_fst vimageE vimageI)
 
 lemma eventually_at_snd:
   assumes "eventually P (at (snd x))"
   assumes "P (snd x)"
   shows "eventually (\<lambda>h. P (snd h)) (at x)"
   using assms
   unfolding eventually_at_topological
   by (metis open_vimage_snd rangeI range_snd vimageE vimageI)
 
 lemma
   shows open_state_space: "open (Sigma X (existence_ivl t0))"
   and flow_continuous_on_state_space:
     "continuous_on (Sigma X (existence_ivl t0)) (\<lambda>(x, t). flow t0 x t)"
 proof (safe intro!: topological_space_class.openI continuous_at_imp_continuous_on)
   fix t x assume "x \<in> X" and t: "t \<in> existence_ivl t0 x"
   have iv_defined: "t0 \<in> T" "x \<in> X"
     using mem_existence_ivl_iv_defined[OF t] by auto
   from \<open>x \<in> X\<close> t open_existence_ivl
   obtain e where e: "e > 0" "cball t e \<subseteq> existence_ivl t0 x"
     by (metis open_contains_cball)
   hence ivl: "t - e \<in> existence_ivl t0 x" "t + e \<in> existence_ivl t0 x" "t - e \<le> t + e"
     by (auto simp: cball_def dist_real_def)
   obtain d K where dK:
     "0 < d" "0 < K" "ball x d \<subseteq> X"
     "\<And>y. y \<in> ball x d \<Longrightarrow> t - e \<in> existence_ivl t0 y"
     "\<And>y. y \<in> ball x d \<Longrightarrow> t + e \<in> existence_ivl t0 y"
     "\<And>y s. y \<in> ball x d \<Longrightarrow> s \<in> {t - e..t + e} \<Longrightarrow>
       dist (flow t0 x s) (flow t0 y s) \<le> dist x y * exp (K * \<bar>s - t0\<bar>)"
     by (rule global_existence_ivl_explicit[OF ivl]) blast
   let ?T = "ball x d \<times> ball t e"
   have "open ?T" by (auto intro!: open_Times)
   moreover have "(x, t) \<in> ?T" by (auto simp: dK \<open>0 < e\<close>)
   moreover have "?T \<subseteq> Sigma X (existence_ivl t0)"
   proof safe
     fix s y assume y: "y \<in> ball x d" and s: "s \<in> ball t e"
     with \<open>ball x d \<subseteq> X\<close> show "y \<in> X" by auto
     have "ball t e \<subseteq> closed_segment t0 (t - e) \<union> closed_segment t0 (t + e)"
       by (auto simp: closed_segment_eq_real_ivl dist_real_def)
     with \<open>y \<in> X\<close> s closed_segment_subset_existence_ivl[OF dK(4)[OF y]]
       closed_segment_subset_existence_ivl[OF dK(5)[OF y]]
     show "s \<in> existence_ivl t0 y"
       by auto
   qed
   ultimately show "\<exists>T. open T \<and> (x, t) \<in> T \<and> T \<subseteq> Sigma X (existence_ivl t0)"
     by blast
   have **: "\<forall>\<^sub>F s in at 0. norm (flow t0 (x + fst s) (t + snd s) - flow t0 x t) < 2 * eps"
     if "eps > 0" for eps :: real
   proof -
     have "\<forall>\<^sub>F s in at 0. norm (flow t0 (x + fst s) (t + snd s) - flow t0 x t) =
       norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s) +
         (flow t0 x (t + snd s) - flow t0 x t))"
       by auto
     moreover
     have "\<forall>\<^sub>F s in at 0.
         norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s) +
           (flow t0 x (t + snd s) - flow t0 x t)) \<le>
         norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s)) +
           norm (flow t0 x (t + snd s) - flow t0 x t)"
       by eventually_elim (rule norm_triangle_ineq)
     moreover
     have "\<forall>\<^sub>F s in at 0. t + snd s \<in> ball t e"
       by (auto simp: dist_real_def intro!: order_tendstoD[OF _ \<open>0 < e\<close>]
         intro!: tendsto_eq_intros)
     moreover from uniform_limit_flow[OF ivl, THEN uniform_limitD, OF \<open>eps > 0\<close>]
     have "\<forall>\<^sub>F (h::(_ )) in at (fst (0::'a*real)).
       \<forall>t\<in>{t - e..t + e}. dist (flow t0 x t) (flow t0 (x + h) t) < eps"
       by (subst (asm) at_to_0)
         (auto simp: eventually_filtermap dist_commute ac_simps)
     hence "\<forall>\<^sub>F (h::(_ * real)) in at 0.
       \<forall>t\<in>{t - e..t + e}. dist (flow t0 x t) (flow t0 (x + fst h) t) < eps"
       by (rule eventually_at_fst) (simp add: \<open>eps > 0\<close>)
     moreover
     have "\<forall>\<^sub>F h in at (snd (0::'a * _)). norm (flow t0 x (t + h) - flow t0 x t) < eps"
       using flow_continuous[OF t, unfolded isCont_def, THEN tendstoD, OF \<open>eps > 0\<close>]
       by (subst (asm) at_to_0)
         (auto simp: eventually_filtermap dist_norm ac_simps)
     hence "\<forall>\<^sub>F h::('a * _) in at 0. norm (flow t0 x (t + snd h) - flow t0 x t) < eps"
       by (rule eventually_at_snd) (simp add: \<open>eps > 0\<close>)
     ultimately
     show ?thesis
     proof eventually_elim
       case (elim s)
       note elim(1)
       also note elim(2)
       also note elim(5)
       also
       from elim(3) have "t + snd s \<in> {t - e..t + e}"
         by (auto simp: dist_real_def algebra_simps)
       from elim(4)[rule_format, OF this]
       have "norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s)) < eps"
         by (auto simp: dist_commute dist_norm[symmetric])
       finally
       show ?case by simp
     qed
   qed
   have *: "\<forall>\<^sub>F s in at 0. norm (flow t0 (x + fst s) (t + snd s) - flow t0 x t) < eps"
     if "eps > 0" for eps::real
   proof -
     from that have "eps / 2 > 0" by simp
     from **[OF this] show ?thesis by auto
   qed
   show "isCont (\<lambda>(x, y). flow t0 x y) (x, t)"
     unfolding isCont_iff
     by (rule LIM_zero_cancel)
       (auto simp: split_beta' norm_conv_dist[symmetric] intro!: tendstoI *)
 qed
 
 lemmas flow_continuous_on_compose[continuous_intros] =
   continuous_on_compose_Pair[OF flow_continuous_on_state_space]
 
 lemma flow_isCont_state_space: "t \<in> existence_ivl t0 x0 \<Longrightarrow> isCont (\<lambda>(x, t). flow t0 x t) (x0, t)"
   using flow_continuous_on_state_space[of] mem_existence_ivl_iv_defined[of t x0]
   using continuous_on_eq_continuous_at open_state_space by fastforce
 
 lemma
   flow_absolutely_integrable_on[integrable_on_simps]:
   assumes "s \<in> existence_ivl t0 x0"
   shows "(\<lambda>x. norm (flow t0 x0 x)) integrable_on closed_segment t0 s"
   using assms
   by (auto simp: closed_segment_eq_real_ivl intro!: integrable_continuous_real continuous_intros
     flow_continuous_on_intro
     intro: in_existence_between_zeroI)
 
 lemma existence_ivl_eq_domain:
   assumes iv_defined: "t0 \<in> T" "x0 \<in> X"
   assumes bnd: "\<And>tm tM t x. tm \<in> T \<Longrightarrow> tM \<in> T \<Longrightarrow> \<exists>M. \<exists>L. \<forall>t \<in> {tm .. tM}. \<forall>x \<in> X. norm (f t x) \<le> M + L * norm x"
   assumes "is_interval T" "X = UNIV"
   shows "existence_ivl t0 x0 = T"
 proof -
   from assms have XI: "x \<in> X" for x by auto
   {
     fix tm tM assume tm: "tm \<in> T" and tM: "tM \<in> T" and tmtM: "tm \<le> t0" "t0 \<le> tM"
     from bnd[OF tm tM] obtain M' L'
     where bnd': "\<And>x t. x \<in> X \<Longrightarrow> tm \<le> t \<Longrightarrow> t \<le> tM \<Longrightarrow> norm (f t x) \<le> M' + L' * norm x"
       by force
     define M where "M \<equiv> norm M' + 1"
     define L where "L \<equiv> norm L' + 1"
     have bnd: "\<And>x t. x \<in> X \<Longrightarrow> tm \<le> t \<Longrightarrow> t \<le> tM \<Longrightarrow> norm (f t x) \<le> M + L * norm x"
       by (auto simp: M_def L_def intro!: bnd'[THEN order_trans] add_mono mult_mono)
     have "M > 0" "L > 0" by (auto simp: L_def M_def)
 
     let ?r = "(norm x0 + \<bar>tm - tM\<bar> * M + 1) * exp (L * \<bar>tm - tM\<bar>)"
     define K where "K \<equiv> cball (0::'a) ?r"
     have K: "compact K" "K \<subseteq> X"
       by (auto simp: K_def \<open>X = UNIV\<close>)
     {
       fix t assume t: "t \<in> existence_ivl t0 x0"  and le: "tm \<le> t" "t \<le> tM"
       {
         fix s assume sc: "s \<in> closed_segment t0 t"
         then have s: "s \<in> existence_ivl t0 x0" and le: "tm \<le> s" "s \<le> tM" using t le sc
           using closed_segment_subset_existence_ivl
           apply -
           subgoal by force
           subgoal by (metis (full_types) atLeastAtMost_iff closed_segment_eq_real_ivl order_trans tmtM(1))
           subgoal by (metis (full_types) atLeastAtMost_iff closed_segment_eq_real_ivl order_trans tmtM(2))
           done
         from sc have nle: "norm (t0 - s) \<le> norm (t0 - t)" by (auto simp: closed_segment_eq_real_ivl split: if_split_asm)
         from flow_fixed_point[OF s]
         have "norm (flow t0 x0 s) \<le> norm x0 + integral (closed_segment t0 s) (\<lambda>t. M + L * norm (flow t0 x0 t))"
           using tmtM
           using closed_segment_subset_existence_ivl[OF s] le
           by (auto simp:
             intro!: norm_triangle_le norm_triangle_ineq4[THEN order.trans]
               ivl_integral_norm_bound_integral bnd
               integrable_continuous_closed_segment
               integrable_continuous_real
               continuous_intros
               continuous_on_subset[OF flow_continuous_on]
               flow_in_domain
               mem_existence_ivl_subset)
           (auto simp: closed_segment_eq_real_ivl split: if_splits)
         also have "\<dots> = norm x0 + norm (t0 - s) * M + L * integral (closed_segment t0 s) (\<lambda>t. norm (flow t0 x0 t))"
           by (simp add: integral_add integrable_on_simps \<open>s \<in> existence_ivl _ _\<close>
             integral_const_closed_segment abs_minus_commute)
         also have "norm (t0 - s) * M \<le> norm (t0 - t) * M "
           using nle \<open>M > 0\<close> by auto
         also have "\<dots> \<le> \<dots> + 1" by simp
         finally have "norm (flow t0 x0 s) \<le> norm x0 + norm (t0 - t) * M + 1 +
             L * integral (closed_segment t0 s) (\<lambda>t. norm (flow t0 x0 t))" by simp
       }
       then have "norm (flow t0 x0 t) \<le> (norm x0 + norm (t0 - t) * M + 1) * exp (L * \<bar>t - t0\<bar>)"
         using closed_segment_subset_existence_ivl[OF t]
         by (intro gronwall_more_general_segment[where a=t0 and b = t and t = t])
           (auto simp: \<open>0 < L\<close> \<open>0 < M\<close> less_imp_le
             intro!: add_nonneg_pos mult_nonneg_nonneg add_nonneg_nonneg continuous_intros
               flow_continuous_on_intro)
       also have "\<dots> \<le> ?r"
         using le tmtM
         by (auto simp: less_imp_le \<open>0 < M\<close> \<open>0 < L\<close> abs_minus_commute intro!: mult_mono)
       finally
       have "flow t0 x0 t \<in> K" by (simp add: dist_norm K_def)
     } note flow_compact = this
 
     have "{tm..tM} \<subseteq> existence_ivl t0 x0"
       using tmtM tm \<open>x0 \<in> X\<close> \<open>compact K\<close> \<open>K \<subseteq> X\<close> mem_is_intervalI[OF \<open>is_interval T\<close> \<open>tm \<in> T\<close> \<open>tM \<in> T\<close>]
       by (intro subset_mem_compact_implies_subset_existence_interval[OF _ _ _ _flow_compact])
          (auto simp: tmtM is_interval_cc)
   } note bnds = this
 
   show "existence_ivl t0 x0 = T"
   proof safe
     fix x assume x: "x \<in> T"
     from bnds[OF x iv_defined(1)] bnds[OF iv_defined(1) x]
     show "x \<in> existence_ivl t0 x0"
       by (cases "x \<le> t0") auto
   qed (insert existence_ivl_subset, fastforce)
 qed
 
 lemma flow_unique:
   assumes "t \<in> existence_ivl t0 x0"
   assumes "phi t0 = x0"
   assumes "\<And>t. t \<in> existence_ivl t0 x0 \<Longrightarrow> (phi has_vector_derivative f t (phi t)) (at t)"
   assumes "\<And>t. t \<in> existence_ivl t0 x0 \<Longrightarrow> phi t \<in> X"
   shows "flow t0 x0 t = phi t"
   apply (rule maximal_existence_flow[where K="existence_ivl t0 x0"])
   subgoal by (auto intro!: solves_odeI simp: has_vderiv_on_def assms at_within_open[OF _ open_existence_ivl])
   subgoal by fact
   subgoal by simp
   subgoal using mem_existence_ivl_iv_defined[OF \<open>t \<in> existence_ivl t0 x0\<close>] by simp
   subgoal by (simp add: existence_ivl_subset)
   subgoal by fact
   done
 
 lemma flow_unique_on:
   assumes "t \<in> existence_ivl t0 x0"
   assumes "phi t0 = x0"
   assumes "(phi has_vderiv_on (\<lambda>t. f t (phi t))) (existence_ivl t0 x0)"
   assumes "\<And>t. t \<in> existence_ivl t0 x0 \<Longrightarrow> phi t \<in> X"
   shows "flow t0 x0 t = phi t"
   using flow_unique[where phi=phi, OF assms(1,2) _ assms(4)] assms(3)
   by (auto simp: has_vderiv_on_open)
 
 end \<comment> \<open>@{thm local_lipschitz}\<close>
 
 locale two_ll_on_open =
   F: ll_on_open T1 F X + G: ll_on_open T2 G X
   for F T1 G T2 X J x0 +
   fixes e::real and K
   assumes t0_in_J: "0 \<in> J"
   assumes J_subset: "J \<subseteq> F.existence_ivl 0 x0"
   assumes J_ivl: "is_interval J"
   assumes F_lipschitz: "\<And>t. t \<in> J \<Longrightarrow> K-lipschitz_on X (F t)"
   assumes K_pos: "0 < K"
   assumes F_G_norm_ineq: "\<And>t x. t \<in> J \<Longrightarrow> x \<in> X \<Longrightarrow> norm (F t x - G t x) < e"
 begin
 
 context begin
 
 lemma F_iv_defined: "0 \<in> T1" "x0 \<in> X"
   subgoal using F.existence_ivl_initial_time_iff J_subset t0_in_J by blast
   subgoal using F.mem_existence_ivl_iv_defined(2) J_subset t0_in_J by blast
   done
 
 lemma e_pos: "0 < e"
   using le_less_trans[OF norm_ge_zero F_G_norm_ineq[OF t0_in_J F_iv_defined(2)]]
   by assumption
 
 qualified definition "flow0 t = F.flow 0 x0 t"
 qualified definition "Y t = G.flow 0 x0 t"
 
 lemma norm_X_Y_bound:
 shows "\<forall>t \<in> J \<inter> G.existence_ivl 0 x0. norm (flow0 t - Y t) \<le> e / K * (exp(K * \<bar>t\<bar>) - 1)"
 proof(safe)
   fix t assume "t \<in> J"
   assume tG: "t \<in> G.existence_ivl 0 x0"
   have "0 \<in> J" by (simp add: t0_in_J)
 
   let ?u="\<lambda>t. norm (flow0 t - Y t)"
   show "norm (flow0 t - Y t) \<le> e / K * (exp (K * \<bar>t\<bar>) - 1)"
   proof(cases "0 \<le> t")
     assume "0 \<le> t"
     hence [simp]: "\<bar>t\<bar> = t" by simp
 
     have t0_t_in_J: "{0..t} \<subseteq> J"
       using \<open>t \<in> J\<close> \<open>0 \<in> J\<close> J_ivl
       using mem_is_interval_1_I atLeastAtMost_iff subsetI by blast
 
     note F_G_flow_cont[continuous_intros] =
       continuous_on_subset[OF F.flow_continuous_on]
       continuous_on_subset[OF G.flow_continuous_on]
 
     have "?u t + e/K \<le> e/K * exp(K * t)"
     proof(rule gronwall[where g="\<lambda>t. ?u t + e/K", OF _ _ _ _ K_pos \<open>0 \<le> t\<close> order.refl])
       fix s assume "0 \<le> s" "s \<le> t"
       hence "{0..s} \<subseteq> J" using t0_t_in_J by auto
 
       hence t0_s_in_existence:
         "{0..s} \<subseteq> F.existence_ivl 0 x0"
         "{0..s} \<subseteq> G.existence_ivl 0 x0"
         using J_subset tG \<open>0 \<le> s\<close> \<open>s \<le> t\<close> G.ivl_subset_existence_ivl[OF tG]
         by auto
 
       hence s_in_existence:
         "s \<in> F.existence_ivl 0 x0"
         "s \<in> G.existence_ivl 0 x0"
           using \<open>0 \<le> s\<close> by auto
 
       note cont_statements[continuous_intros] =
         F_iv_defined (*  G.iv_defined *)
         F.flow_in_domain
         G.flow_in_domain
         F.mem_existence_ivl_subset
         G.mem_existence_ivl_subset
 
       have [integrable_on_simps]:
         "continuous_on {0..s} (\<lambda>s. F s (F.flow 0 x0 s))"
         "continuous_on {0..s} (\<lambda>s. G s (G.flow 0 x0 s))"
         "continuous_on {0..s} (\<lambda>s. F s (G.flow 0 x0 s))"
         "continuous_on {0..s} (\<lambda>s. G s (F.flow 0 x0 s))"
         using t0_s_in_existence
         by (auto intro!: continuous_intros integrable_continuous_real)
 
       have "flow0 s - Y s = integral {0..s} (\<lambda>s. F s (flow0 s) - G s (Y s))"
         using \<open>0 \<le> s\<close>
         by (simp add: flow0_def Y_def Henstock_Kurzweil_Integration.integral_diff integrable_on_simps ivl_integral_def
                F.flow_fixed_point[OF s_in_existence(1)]
                G.flow_fixed_point[OF s_in_existence(2)])
       also have "... = integral {0..s} (\<lambda>s. (F s (flow0 s) - F s (Y s)) + (F s (Y s) - G s (Y s)))"
         by simp
       also have "... = integral {0..s} (\<lambda>s. F s (flow0 s) - F s (Y s)) + integral {0..s} (\<lambda>s. F s (Y s) - G s (Y s))"
         by (simp add: Henstock_Kurzweil_Integration.integral_diff Henstock_Kurzweil_Integration.integral_add flow0_def Y_def integrable_on_simps)
       finally have "?u s \<le> norm (integral {0..s} (\<lambda>s. F s (flow0 s) - F s (Y s))) + norm (integral {0..s} (\<lambda>s. F s (Y s) - G s (Y s)))"
         by (simp add: norm_triangle_ineq)
       also have "... \<le> integral {0..s} (\<lambda>s. norm (F s (flow0 s) - F s (Y s))) + integral {0..s} (\<lambda>s. norm (F s (Y s) - G s (Y s)))"
         using t0_s_in_existence
         by (auto simp add: flow0_def Y_def
           intro!: add_mono continuous_intros continuous_on_imp_absolutely_integrable_on)
       also have "... \<le> integral {0..s} (\<lambda>s. K * ?u s) + integral {0..s} (\<lambda>s. e)"
       proof (rule add_mono[OF integral_le integral_le])
         show "norm (F x (flow0 x) - F x (Y x)) \<le> K * norm (flow0 x - Y x)" if "x \<in> {0..s}" for x
           using F_lipschitz[unfolded lipschitz_on_def, THEN conjunct2] that
             cont_statements(1,2,4)
             t0_s_in_existence F_iv_defined (* G.iv_defined *)
           by (metis F_lipschitz flow0_def Y_def \<open>{0..s} \<subseteq> J\<close> lipschitz_on_normD F.flow_in_domain
             G.flow_in_domain subsetCE)
         show "\<And>x. x \<in> {0..s} \<Longrightarrow> norm (F x (Y x) - G x (Y x)) \<le> e"
           using F_G_norm_ineq cont_statements(2,3) t0_s_in_existence
           using Y_def \<open>{0..s} \<subseteq> J\<close> cont_statements(5) subset_iff G.flow_in_domain
           by (metis eucl_less_le_not_le)
       qed (simp_all add: t0_s_in_existence continuous_intros integrable_on_simps flow0_def Y_def)
       also have "... = K * integral {0..s} (\<lambda>s. ?u s + e / K)"
         using K_pos t0_s_in_existence
         by (simp_all add: algebra_simps Henstock_Kurzweil_Integration.integral_add flow0_def Y_def continuous_intros
           continuous_on_imp_absolutely_integrable_on)
       finally show "?u s + e / K \<le> e / K + K * integral {0..s} (\<lambda>s. ?u s + e / K)"
         by simp
     next
       show "continuous_on {0..t} (\<lambda>t. norm (flow0 t - Y t) + e / K)"
         using t0_t_in_J J_subset G.ivl_subset_existence_ivl[OF tG]
         by (auto simp add: flow0_def Y_def intro!: continuous_intros)
     next
       fix s assume "0 \<le> s" "s \<le> t"
       show "0 \<le> norm (flow0 s - Y s) + e / K"
         using e_pos K_pos by simp
     next
       show "0 < e / K" using e_pos K_pos by simp
     qed
     thus ?thesis by (simp add: algebra_simps)
   next
     assume "\<not>0 \<le> t"
     hence "t \<le> 0" by simp
     hence [simp]: "\<bar>t\<bar> = -t" by simp
 
     have t0_t_in_J: "{t..0} \<subseteq> J"
       using \<open>t \<in> J\<close> \<open>0 \<in> J\<close> J_ivl \<open>\<not> 0 \<le> t\<close> atMostAtLeast_subset_convex is_interval_convex_1
       by auto
 
     note F_G_flow_cont[continuous_intros] =
       continuous_on_subset[OF F.flow_continuous_on]
       continuous_on_subset[OF G.flow_continuous_on]
 
     have "?u t + e/K \<le> e/K * exp(- K * t)"
     proof(rule gronwall_left[where g="\<lambda>t. ?u t + e/K", OF _ _ _ _ K_pos order.refl \<open>t \<le> 0\<close>])
       fix s assume "t \<le> s" "s \<le> 0"
       hence "{s..0} \<subseteq> J" using t0_t_in_J by auto
 
       hence t0_s_in_existence:
         "{s..0} \<subseteq> F.existence_ivl 0 x0"
         "{s..0} \<subseteq> G.existence_ivl 0 x0"
         using J_subset G.ivl_subset_existence_ivl'[OF tG] \<open>s \<le> 0\<close> \<open>t \<le> s\<close>
         by auto
 
       hence s_in_existence:
         "s \<in> F.existence_ivl 0 x0"
         "s \<in> G.existence_ivl 0 x0"
           using \<open>s \<le> 0\<close> by auto
 
       note cont_statements[continuous_intros] =
         F_iv_defined
         F.flow_in_domain
         G.flow_in_domain
         F.mem_existence_ivl_subset
         G.mem_existence_ivl_subset
       then have [continuous_intros]:
         "{s..0} \<subseteq> T1"
         "{s..0} \<subseteq> T2"
         "F.flow 0 x0 ` {s..0} \<subseteq> X"
         "G.flow 0 x0 ` {s..0} \<subseteq> X"
         "s \<le> x \<Longrightarrow> x \<le> 0 \<Longrightarrow> x \<in> F.existence_ivl 0 x0"
         "s \<le> x \<Longrightarrow> x \<le> 0 \<Longrightarrow> x \<in> G.existence_ivl 0 x0" for x
         using t0_s_in_existence
         by auto
       have "flow0 s - Y s = - integral {s..0} (\<lambda>s. F s (flow0 s) - G s (Y s))"
         using t0_s_in_existence \<open>s \<le> 0\<close>
         by (simp add: flow0_def Y_def ivl_integral_def
                F.flow_fixed_point[OF s_in_existence(1)]
                G.flow_fixed_point[OF s_in_existence(2)]
                continuous_intros integrable_on_simps Henstock_Kurzweil_Integration.integral_diff)
       also have "... = - integral {s..0} (\<lambda>s. (F s (flow0 s) - F s (Y s)) + (F s (Y s) - G s (Y s)))"
         by simp
       also have "... = - (integral {s..0} (\<lambda>s. F s (flow0 s) - F s (Y s)) + integral {s..0} (\<lambda>s. F s (Y s) - G s (Y s)))"
         using t0_s_in_existence
         by (subst Henstock_Kurzweil_Integration.integral_add) (simp_all add: integral_add flow0_def Y_def continuous_intros integrable_on_simps)
       finally have "?u s \<le> norm (integral {s..0} (\<lambda>s. F s (flow0 s) - F s (Y s))) + norm (integral {s..0} (\<lambda>s. F s (Y s) - G s (Y s)))"
         by (metis (no_types, lifting) norm_minus_cancel norm_triangle_ineq)
       also have "... \<le> integral {s..0} (\<lambda>s. norm (F s (flow0 s) - F s (Y s))) + integral {s..0} (\<lambda>s. norm (F s (Y s) - G s (Y s)))"
         using t0_s_in_existence
         by (auto simp add: flow0_def Y_def intro!: continuous_intros continuous_on_imp_absolutely_integrable_on add_mono)
       also have "... \<le> integral {s..0} (\<lambda>s. K * ?u s) + integral {s..0} (\<lambda>s. e)"
       proof (rule add_mono[OF integral_le integral_le])
         show "norm (F x (flow0 x) - F x (Y x)) \<le> K * norm (flow0 x - Y x)" if "x\<in>{s..0}" for x
           using F_lipschitz[unfolded lipschitz_on_def, THEN conjunct2]
             cont_statements(1,2,4) that
             t0_s_in_existence F_iv_defined (* G.iv_defined *)
           by (metis F_lipschitz flow0_def Y_def \<open>{s..0} \<subseteq> J\<close> lipschitz_on_normD F.flow_in_domain
             G.flow_in_domain subsetCE)
         show "\<And>x. x \<in> {s..0} \<Longrightarrow> norm (F x (Y x) - G x (Y x)) \<le> e"
           using F_G_norm_ineq Y_def \<open>{s..0} \<subseteq> J\<close> cont_statements(5) subset_iff t0_s_in_existence(2)
           using Y_def \<open>{s..0} \<subseteq> J\<close> cont_statements(5) subset_iff G.flow_in_domain
           by (metis eucl_less_le_not_le)
       qed (simp_all add: t0_s_in_existence continuous_intros integrable_on_simps flow0_def Y_def)
       also have "... = K * integral {s..0} (\<lambda>s. ?u s + e / K)"
         using K_pos t0_s_in_existence
         by (simp_all add: algebra_simps Henstock_Kurzweil_Integration.integral_add t0_s_in_existence continuous_intros integrable_on_simps flow0_def Y_def)
       finally show "?u s + e / K \<le> e / K + K * integral {s..0} (\<lambda>s. ?u s + e / K)"
         by simp
     next
       show "continuous_on {t..0} (\<lambda>t. norm (flow0 t - Y t) + e / K)"
         using t0_t_in_J J_subset G.ivl_subset_existence_ivl'[OF tG] F_iv_defined
         by (auto simp add: flow0_def Y_def intro!: continuous_intros)
     next
       fix s assume "t \<le> s" "s \<le> 0"
       show "0 \<le> norm (flow0 s - Y s) + e / K"
         using e_pos K_pos by simp
     next
       show "0 < e / K" using e_pos K_pos by simp
     qed
     thus ?thesis by (simp add: algebra_simps)
   qed
 qed
 
 end
 
 end
 
 locale auto_ll_on_open =
   fixes f::"'a::{banach, heine_borel} \<Rightarrow> 'a" and X
   assumes auto_local_lipschitz: "local_lipschitz UNIV X (\<lambda>_::real. f)"
   assumes auto_open_domain[intro!, simp]: "open X"
 begin
 
 text \<open>autonomous flow and existence interval \<close>
 
 definition "flow0 x0 t = ll_on_open.flow UNIV (\<lambda>_. f) X 0 x0 t"
 
 definition "existence_ivl0 x0 = ll_on_open.existence_ivl UNIV (\<lambda>_. f) X 0 x0"
 
 sublocale ll_on_open_it UNIV "\<lambda>_. f" X 0
   rewrites "flow = (\<lambda>t0 x0 t. flow0 x0 (t - t0))"
        and "existence_ivl = (\<lambda>t0 x0. (+) t0 ` existence_ivl0 x0)"
        and "(+) 0 = (\<lambda>x::real. x)"
        and "s - 0 = s"
        and "(\<lambda>x. x) ` S = S"
        and "s \<in> (+) t ` S \<longleftrightarrow> s - t \<in> (S::real set)"
        and "P (s + t - s) = P (t::real)"\<comment> \<open>TODO: why does just the equation not work?\<close>
        and "P (t + s - s) = P t"\<comment> \<open>TODO: why does just the equation not work?\<close>
 proof -
   interpret ll_on_open UNIV "\<lambda>_. f" X
     by unfold_locales (auto intro!: continuous_on_const auto_local_lipschitz)
   show "ll_on_open_it UNIV (\<lambda>_. f) X" ..
   show "(+) 0 = (\<lambda>x::real. x)" "(\<lambda>x. x) ` S = S" "s - 0 = s" "P (t + s - s) = P t" "P (s + t - s) = P (t::real)"
     by auto
   show "flow = (\<lambda>t0 x0 t. flow0 x0 (t - t0))"
     unfolding flow0_def
     by (metis flow_def flow_shift_autonomous1 flow_shift_autonomous2 mem_existence_ivl_iv_defined(2))
   show "existence_ivl = (\<lambda>t0 x0. (+) t0 ` existence_ivl0 x0)"
     unfolding existence_ivl0_def
     apply (safe intro!: ext)
     subgoal using image_iff mem_existence_ivl_shift_autonomous1 by fastforce
     subgoal premises prems for t0 x0 x s
     proof -
       have f2: "\<forall>x1 x2. (x2::real) - x1 = - 1 * x1 + x2"
         by auto
       have "- 1 * t0 + (t0 + s) = s"
         by auto
       then show ?thesis
         using f2 prems mem_existence_ivl_iv_defined(2) mem_existence_ivl_shift_autonomous2
         by presburger
     qed
     done
   show "(s \<in> (+) t ` S) = (s - t \<in> S)" by force
 qed
 \<comment> \<open>at this point, there should be no theorems about \<open>existence_ivl\<close>, only \<open>existence_ivl0\<close>.
 Moreover, \<open>(+) _ ` _\<close> and \<open>_ + _ - _\<close> etc should have been removed\<close>
 
 lemma existence_ivl_zero: "x0 \<in> X \<Longrightarrow> 0 \<in> existence_ivl0 x0" by simp
 
 lemmas [continuous_intros del] = continuous_on_f
 lemmas continuous_on_f_comp[continuous_intros] = continuous_on_f[OF continuous_on_const _ subset_UNIV]
 
 lemma
   flow_in_compact_right_existence:
   assumes "\<And>t. 0 \<le> t \<Longrightarrow> t \<in> existence_ivl0 x \<Longrightarrow> flow0 x t \<in> K"
   assumes "compact K" "K \<subseteq> X"
   assumes "x \<in> X" "t \<ge> 0"
   shows "t \<in> existence_ivl0 x"
 proof (rule ccontr)
   assume "t \<notin> existence_ivl0 x"
   have "bdd_above (existence_ivl0 x)"
     by (rule bdd_above_is_intervalI[OF is_interval_existence_ivl \<open>0 \<le> t\<close> existence_ivl_zero]) fact+
   from sup_existence_maximal[OF UNIV_I \<open>x \<in> X\<close> assms(1-3) this]
   show False by auto
 qed
 
 lemma
   flow_in_compact_left_existence:
   assumes "\<And>t. t \<le> 0 \<Longrightarrow> t \<in> existence_ivl0 x \<Longrightarrow> flow0 x t \<in> K"
   assumes "compact K" "K \<subseteq> X"
   assumes "x \<in> X" "t \<le> 0"
   shows "t \<in> existence_ivl0 x"
 proof (rule ccontr)
   assume "t \<notin> existence_ivl0 x"
   have "bdd_below (existence_ivl0 x)"
     by (rule bdd_below_is_intervalI[OF is_interval_existence_ivl \<open>t \<le> 0\<close> _ existence_ivl_zero]) fact+
   from inf_existence_minimal[OF UNIV_I \<open>x \<in> X\<close> assms(1-3) this]
   show False by auto
 qed
 
 end
 
 locale compact_continuously_diff =
   derivative_on_prod T X f "\<lambda>(t, x). f' x o\<^sub>L snd_blinfun"
     for T X and f::"real \<Rightarrow> 'a::{banach,perfect_space,heine_borel} \<Rightarrow> 'a"
     and f'::"'a \<Rightarrow> ('a, 'a) blinfun" +
   assumes compact_domain: "compact X"
   assumes convex: "convex X"
   assumes nonempty_domains: "T \<noteq> {}" "X \<noteq> {}"
   assumes continuous_derivative: "continuous_on X f'"
 begin
 
 lemma ex_onorm_bound:
   "\<exists>B. \<forall>x \<in> X. norm (f' x) \<le> B"
 proof -
   from _ compact_domain have "compact (f' ` X)"
     by (intro compact_continuous_image continuous_derivative)
   hence "bounded (f' ` X)" by (rule compact_imp_bounded)
   thus ?thesis
     by (auto simp add: bounded_iff cball_def norm_blinfun.rep_eq)
 qed
 
 definition "onorm_bound = (SOME B. \<forall>x \<in> X. norm (f' x) \<le> B)"
 
 lemma onorm_bound: assumes "x \<in> X" shows "norm (f' x) \<le> onorm_bound"
   unfolding onorm_bound_def
   using someI_ex[OF ex_onorm_bound] assms
   by blast
 
 sublocale closed_domain X
   using compact_domain by unfold_locales (rule compact_imp_closed)
 
 sublocale global_lipschitz T X f onorm_bound
 proof (unfold_locales, rule lipschitz_onI)
   fix t z y
   assume "t \<in> T" "y \<in> X" "z \<in> X"
   then have "norm (f t y - f t z) \<le> onorm_bound * norm (y - z)"
     using onorm_bound
     by (intro differentiable_bound[where f'=f', OF convex])
        (auto intro!: derivative_eq_intros simp: norm_blinfun.rep_eq)
   thus "dist (f t y) (f t z) \<le> onorm_bound * dist y z"
     by (auto simp: dist_norm norm_Pair)
 next
   from nonempty_domains obtain x where x: "x \<in> X" by auto
   show "0 \<le> onorm_bound"
     using dual_order.trans local.onorm_bound norm_ge_zero x by blast
 qed
 
 end \<comment> \<open>@{thm compact_domain}\<close>
 
 locale unique_on_compact_continuously_diff = self_mapping +
   compact_interval T +
   compact_continuously_diff T X f
 begin
 
 sublocale unique_on_closed t0 T x0 f X onorm_bound
   by unfold_locales (auto intro!: f' has_derivative_continuous_on)
 
 end
 
 locale c1_on_open =
   fixes f::"'a::{banach, perfect_space, heine_borel} \<Rightarrow> 'a" and f' X
   assumes open_dom[simp]: "open X"
   assumes derivative_rhs:
     "\<And>x. x \<in> X \<Longrightarrow> (f has_derivative blinfun_apply (f' x)) (at x)"
   assumes continuous_derivative: "continuous_on X f'"
 begin
 
 lemmas continuous_derivative_comp[continuous_intros] =
   continuous_on_compose2[OF continuous_derivative]
 
 lemma derivative_tendsto[tendsto_intros]:
   assumes [tendsto_intros]: "(g \<longlongrightarrow> l) F"
     and "l \<in> X"
   shows "((\<lambda>x. f' (g x)) \<longlongrightarrow> f' l) F"
   using continuous_derivative[simplified continuous_on] assms
   by (auto simp: at_within_open[OF _ open_dom]
     intro!: tendsto_eq_intros
     intro: tendsto_compose)
 
 lemma c1_on_open_rev[intro, simp]: "c1_on_open (-f) (-f') X"
   using derivative_rhs continuous_derivative
   by unfold_locales
     (auto intro!: continuous_intros derivative_eq_intros
     simp: fun_Compl_def blinfun.bilinear_simps)
 
 lemma derivative_rhs_compose[derivative_intros]:
   "((g has_derivative g') (at x within s)) \<Longrightarrow> g x \<in> X \<Longrightarrow>
     ((\<lambda>x. f (g x)) has_derivative
       (\<lambda>xa. blinfun_apply (f' (g x)) (g' xa)))
     (at x within s)"
   by (metis has_derivative_compose[of g g' x s f "f' (g x)"] derivative_rhs)
 
 sublocale auto_ll_on_open
 proof (standard, rule local_lipschitzI)
   fix x and t::real
   assume "x \<in> X"
   with open_contains_cball[of "UNIV::real set"] open_UNIV
     open_contains_cball[of X] open_dom
   obtain u v where uv: "cball t u \<subseteq> UNIV" "cball x v \<subseteq> X" "u > 0" "v > 0"
     by blast
   let ?T = "cball t u" and ?X = "cball x v"
   have "bounded ?X" by simp
   have "compact (cball x v)"
     by simp
   interpret compact_continuously_diff ?T ?X "\<lambda>_. f" f'
     using uv
     by unfold_locales
       (auto simp: convex_cball cball_eq_empty split_beta'
         intro!: derivative_eq_intros continuous_on_compose2[OF continuous_derivative]
           continuous_intros)
   have "onorm_bound-lipschitz_on ?X f"
     using lipschitz[of t] uv
     by auto
   thus "\<exists>u>0. \<exists>L. \<forall>t \<in> cball t u \<inter> UNIV. L-lipschitz_on (cball x u \<inter> X) f"
     by (intro exI[where x=v])
       (auto intro!: exI[where x=onorm_bound] \<open>0 < v\<close> simp: Int_absorb2 uv)
 qed (auto intro!: continuous_intros)
 
 end \<comment> \<open>@{thm derivative_rhs}\<close>
 
 locale c1_on_open_euclidean = c1_on_open f f' X
   for f::"'a::euclidean_space \<Rightarrow> _" and f' X
 begin
 lemma c1_on_open_euclidean_anchor: True ..
 
 definition "vareq x0 t = f' (flow0 x0 t)"
 
 interpretation var: ll_on_open "existence_ivl0 x0" "vareq x0" UNIV
   apply standard
   apply (auto intro!: c1_implies_local_lipschitz[where f' = "\<lambda>(t, x). vareq x0 t"] continuous_intros
       derivative_eq_intros
       simp: split_beta' blinfun.bilinear_simps vareq_def)
   using local.mem_existence_ivl_iv_defined(2) apply blast
   using local.existence_ivl_reverse local.mem_existence_ivl_iv_defined(2) apply blast
   using local.mem_existence_ivl_iv_defined(2) apply blast
   using local.existence_ivl_reverse local.mem_existence_ivl_iv_defined(2) apply blast
   done
 
 context begin
 
 lemma continuous_on_A[continuous_intros]:
   assumes "continuous_on S a"
   assumes "continuous_on S b"
   assumes "\<And>s. s \<in> S \<Longrightarrow> a s \<in> X"
   assumes "\<And>s. s \<in> S \<Longrightarrow> b s \<in> existence_ivl0 (a s)"
   shows "continuous_on S (\<lambda>s. vareq (a s) (b s))"
 proof -
   have "continuous_on S (\<lambda>x. f' (flow0 (a x) (b x)))"
     by (auto intro!: continuous_intros assms flow_in_domain)
   then show ?thesis
     by (rule continuous_on_eq) (auto simp: assms vareq_def)
 qed
 
 lemmas [intro] = mem_existence_ivl_iv_defined
 
 context
   fixes x0::'a
 begin
 
 lemma flow0_defined: "xa \<in> existence_ivl0 x0 \<Longrightarrow> flow0 x0 xa \<in> X"
   by (auto simp: flow_in_domain)
 
 lemma continuous_on_flow0: "continuous_on (existence_ivl0 x0) (flow0 x0)"
   by (auto simp: intro!: continuous_intros)
 
 lemmas continuous_on_flow0_comp[continuous_intros] = continuous_on_compose2[OF continuous_on_flow0]
 
 lemma varexivl_eq_exivl:
   assumes "t \<in> existence_ivl0 x0"
   shows "var.existence_ivl x0 t a = existence_ivl0 x0"
 proof (rule var.existence_ivl_eq_domain)
   fix s t x
   assume s: "s \<in> existence_ivl0 x0" and t: "t \<in> existence_ivl0 x0"
   then have "{s .. t} \<subseteq> existence_ivl0 x0"
     by (metis atLeastatMost_empty_iff2 empty_subsetI real_Icc_closed_segment var.closed_segment_subset_domain)
   then have "continuous_on {s .. t} (vareq x0)"
     by (auto simp: closed_segment_eq_real_ivl intro!: continuous_intros flow0_defined)
   then have "compact ((vareq x0) ` {s .. t})"
     using compact_Icc
     by (rule compact_continuous_image)
   then obtain B where B: "\<And>u. u \<in> {s .. t} \<Longrightarrow> norm (vareq x0 u) \<le> B"
     by (force dest!: compact_imp_bounded simp: bounded_iff)
   show "\<exists>M L. \<forall>t\<in>{s..t}. \<forall>x\<in>UNIV. norm (blinfun_apply (vareq x0 t) x) \<le> M + L * norm x"
     by (rule exI[where x=0], rule exI[where x=B])
       (auto intro!: order_trans[OF norm_blinfun] mult_right_mono B simp:)
 qed (auto intro: assms)
 
 definition "vector_Dflow u0 t \<equiv> var.flow x0 0 u0 t"
 
 qualified abbreviation "Y z t \<equiv> flow0 (x0 + z) t"
 
 text \<open>Linearity of the solution to the variational equation.
   TODO: generalize this and some other things for arbitrary linear ODEs\<close>
 lemma vector_Dflow_linear:
 assumes "t \<in> existence_ivl0 x0"
 shows "vector_Dflow (\<alpha> *\<^sub>R a + \<beta> *\<^sub>R b) t = \<alpha> *\<^sub>R vector_Dflow a t + \<beta> *\<^sub>R vector_Dflow b t"
 proof -
   note mem_existence_ivl_iv_defined[OF assms, intro, simp]
   have "((\<lambda>c. \<alpha> *\<^sub>R var.flow x0 0 a c + \<beta> *\<^sub>R var.flow x0 0 b c) solves_ode (\<lambda>x. vareq x0 x)) (existence_ivl0 x0) UNIV"
     by (auto intro!: derivative_intros var.flow_has_vector_derivative solves_odeI
       simp: blinfun.bilinear_simps varexivl_eq_exivl vareq_def[symmetric])
   moreover
   have "\<alpha> *\<^sub>R var.flow x0 0 a 0 + \<beta> *\<^sub>R var.flow x0 0 b 0 = \<alpha> *\<^sub>R a + \<beta> *\<^sub>R b" by simp
   moreover note is_interval_existence_ivl[of x0]
   ultimately show ?thesis
     unfolding vareq_def[symmetric] vector_Dflow_def
     by (rule var.maximal_existence_flow) (auto simp: assms)
 qed
 
 lemma linear_vector_Dflow:
 assumes "t \<in> existence_ivl0 x0"
 shows "linear (\<lambda>z. vector_Dflow z t)"
 using vector_Dflow_linear[OF assms, of 1 _ 1] vector_Dflow_linear[OF assms, of _ _ 0]
 by (auto intro!: linearI)
 
 lemma bounded_linear_vector_Dflow:
 assumes "t \<in> existence_ivl0 x0"
 shows "bounded_linear (\<lambda>z. vector_Dflow z t)"
 by (simp add: linear_linear linear_vector_Dflow assms)
 
 lemma vector_Dflow_continuous_on_time: "x0 \<in> X \<Longrightarrow> continuous_on (existence_ivl0 x0) (\<lambda>t. vector_Dflow z t)"
   using var.flow_continuous_on[of x0 0 z] varexivl_eq_exivl
   unfolding vector_Dflow_def
   by (auto simp:  )
 
 proposition proposition_17_6_weak:
   \<comment> \<open>from "Differential Equations, Dynamical Systems, and an Introduction to Chaos",
     Hirsch/Smale/Devaney\<close>
 assumes "t \<in> existence_ivl0 x0"
 shows "(\<lambda>y. (Y (y - x0) t - flow0 x0 t - vector_Dflow (y - x0) t) /\<^sub>R norm (y - x0)) \<midarrow> x0 \<rightarrow> 0"
 proof-
   note x0_def = mem_existence_ivl_iv_defined[OF assms]
   have "0 \<in> existence_ivl0 x0"
     by (simp add: x0_def)
 
   text \<open>Find some \<open>J \<subseteq> existence_ivl0 x0\<close> with \<open>0 \<in> J\<close> and \<open>t \<in> J\<close>.\<close>
   define t0 where "t0 \<equiv> min 0 t"
   define t1 where "t1 \<equiv> max 0 t"
   define J where "J \<equiv> {t0..t1}"
 
   have "t0 \<le> 0" "0 \<le> t1" "0 \<in> J" "J \<noteq> {}" "t \<in> J" "compact J"
   and J_in_existence: "J \<subseteq> existence_ivl0 x0"
     using ivl_subset_existence_ivl ivl_subset_existence_ivl' x0_def assms
     by (auto simp add: J_def t0_def t1_def min_def max_def)
 
   {
     fix z S
     assume assms: "x0 + z \<in> X" "S \<subseteq> existence_ivl0 (x0 + z)"
     have "continuous_on S (Y z)"
       using flow_continuous_on assms(1)
       by (intro continuous_on_subset[OF _ assms(2)]) (simp add:)
   }
   note [continuous_intros] = this integrable_continuous_real blinfun.continuous_on
 
   have U_continuous[continuous_intros]: "\<And>z. continuous_on J (vector_Dflow z)"
     by(rule continuous_on_subset[OF vector_Dflow_continuous_on_time[OF \<open>x0 \<in> X\<close>] J_in_existence])
 
   from \<open>t \<in> J\<close>
   have "t0 \<le> t"
   and "t \<le> t1"
   and "t0 \<le> t1"
   and "t0 \<in> existence_ivl0 x0"
   and "t \<in> existence_ivl0 x0"
   and "t1 \<in> existence_ivl0 x0"
     using J_def J_in_existence by auto
   from global_existence_ivl_explicit[OF \<open>t0 \<in> existence_ivl0 x0\<close> \<open>t1 \<in> existence_ivl0 x0\<close> \<open>t0 \<le> t1\<close>]
   obtain u K where uK_def:
     "0 < u"
     "0 < K"
     "ball x0 u \<subseteq> X"
     "\<And>y. y \<in> ball x0 u \<Longrightarrow> t0 \<in> existence_ivl0 y"
     "\<And>y. y \<in> ball x0 u \<Longrightarrow> t1 \<in> existence_ivl0 y"
     "\<And>t y. y \<in> ball x0 u \<Longrightarrow> t \<in> J \<Longrightarrow> dist (flow0 x0 t) (Y (y - x0) t) \<le> dist x0 y * exp (K * \<bar>t\<bar>)"
     by (auto simp add: J_def)
 
   have J_in_existence_ivl: "\<And>y. y \<in> ball x0 u \<Longrightarrow> J \<subseteq> existence_ivl0 y"
     unfolding J_def
     using uK_def
     by (simp add: real_Icc_closed_segment segment_subset_existence_ivl t0_def t1_def)
   have ball_in_X: "\<And>z. z \<in> ball 0 u \<Longrightarrow> x0 + z \<in> X"
     using uK_def(3)
     by (auto simp: dist_norm)
 
   have flow0_J_props: "flow0 x0 ` J \<noteq> {}" "compact (flow0 x0 ` J)" "flow0 x0` J \<subseteq> X"
     using \<open>t0 \<le> t1\<close>
     using J_def(1) J_in_existence
     by (auto simp add: J_def intro!:
       compact_continuous_image continuous_intros flow_in_domain)
 
   have [continuous_intros]: "continuous_on J (\<lambda>s. f' (flow0 x0 s))"
     using J_in_existence
     by (auto intro!: continuous_intros flow_in_domain simp:)
 
   text \<open> Show the thesis via cases \<open>t = 0\<close>, \<open>0 < t\<close> and \<open>t < 0\<close>. \<close>
   show ?thesis
   proof(cases "t = 0")
     assume "t = 0"
     show ?thesis
     unfolding \<open>t = 0\<close> Lim_at
     proof(simp add: dist_norm[of _ 0] del: zero_less_dist_iff, safe, rule exI, rule conjI[OF \<open>0 < u\<close>], safe)
       fix e::real and x assume "0 < e" "dist x x0 < u"
       hence "x \<in> X"
         using uK_def(3)
         by (auto simp: dist_commute)
       hence "inverse (norm (x - x0)) * norm (Y (x - x0) 0 - flow0 x0 0 - vector_Dflow (x - x0) 0) = 0"
         using x0_def
         by (simp add: vector_Dflow_def)
       thus "inverse (norm (x - x0)) * norm (flow0 x 0 - flow0 x0 0 - vector_Dflow (x - x0) 0) < e"
         using \<open>0 < e\<close> by auto
     qed
   next
     assume "t \<noteq> 0"
     show ?thesis
     proof(unfold Lim_at, safe)
       fix e::real assume "0 < e"
       then obtain e' where "0 < e'" "e' < e"
         using dense by auto
 
       obtain N
         where N_ge_SupS: "Sup { norm (f' (flow0 x0 s)) |s. s \<in> J } \<le> N" (is "Sup ?S \<le> N")
           and N_gr_0: "0 < N"
         \<comment> \<open>We need N to be an upper bound of @{term ?S}, but also larger than zero.\<close>
         by (meson le_cases less_le_trans linordered_field_no_ub)
       have N_ineq: "\<And>s. s \<in> J \<Longrightarrow> norm (f' (flow0 x0 s)) \<le> N"
         proof-
           fix s assume "s \<in> J"
           have "?S = (norm o f' o flow0 x0) ` J" by auto
           moreover have "continuous_on J (norm o f' o flow0 x0)"
             using J_in_existence
             by (auto intro!: continuous_intros)
           ultimately have  "\<exists>a b. ?S = {a..b} \<and> a \<le> b"
             using continuous_image_closed_interval[OF \<open>t0 \<le> t1\<close>]
             by (simp add: J_def)
           then obtain a b where "?S = {a..b}" and "a \<le> b" by auto
           hence "bdd_above ?S" by simp
           from \<open>s \<in> J\<close>  cSup_upper[OF _ this]
           have "norm (f' (flow0 x0 s)) \<le> Sup ?S"
             by auto
           thus "norm (f' (flow0 x0 s)) \<le> N"
             using N_ge_SupS by simp
         qed
 
       text \<open> Define a small region around \<open>flow0 ` J\<close>, that is a subset of the domain \<open>X\<close>. \<close>
       from compact_in_open_separated[OF flow0_J_props(1,2) auto_open_domain flow0_J_props(3)]
         obtain e_domain where e_domain_def: "0 < e_domain" "{x. infdist x (flow0 x0 ` J) \<le> e_domain} \<subseteq> X"
         by auto
       define G where "G \<equiv> {x\<in>X. infdist x (flow0 x0 ` J) < e_domain}"
       have G_vimage: "G = ((\<lambda>x. infdist x (flow0 x0 ` J)) -` {..<e_domain}) \<inter> X"
         by (auto simp: G_def)
       have "open G" "G \<subseteq> X"
         unfolding G_vimage
         by (auto intro!: open_Int open_vimage continuous_intros continuous_at_imp_continuous_on)
 
       text \<open>Define a compact subset H of G. Inside H, we can guarantee
          an upper bound on the Taylor remainder.\<close>
       define e_domain2 where "e_domain2 \<equiv> e_domain / 2"
       have "e_domain2 > 0" "e_domain2 < e_domain" using \<open>e_domain > 0\<close>
         by (simp_all add: e_domain2_def)
       define H where "H \<equiv> {x. infdist x (flow0 x0 ` J) \<le> e_domain2}"
       have H_props: "H \<noteq> {}" "compact H" "H \<subseteq> G"
         proof-
           have "x0 \<in> flow0 x0 ` J"
             unfolding image_iff
             using \<open>0 \<in> J\<close>  x0_def
             by force
 
           hence "x0 \<in> H"
             using \<open>0 < e_domain2\<close>
             by (simp add: H_def x0_def)
           thus "H \<noteq> {}"
             by auto
         next
           show "compact H"
             unfolding H_def
             using \<open>0 < e_domain2\<close> flow0_J_props
             by (intro compact_infdist_le) simp_all
         next
           show "H \<subseteq> G"
           proof
             fix x assume "x \<in> H"
             then have *: "infdist x (flow0 x0 ` J) < e_domain"
               using \<open>0 < e_domain\<close>
               by (simp add: H_def e_domain2_def)
             then have "x \<in> X"
               using e_domain_def(2)
               by auto
             with * show "x \<in> G"
               unfolding G_def
               by auto
           qed
         qed
 
       have f'_cont_on_G: "(\<And>x. x \<in> G \<Longrightarrow> isCont f' x)"
         using continuous_on_interior[OF continuous_on_subset[OF continuous_derivative \<open>G \<subseteq> X\<close>]]
         by (simp add: interior_open[OF \<open>open G\<close>])
 
       define e1 where "e1 \<equiv> e' / (\<bar>t\<bar> * exp (K * \<bar>t\<bar>) * exp (N * \<bar>t\<bar>))"
         \<comment> \<open>@{term e1} is the bounding term for the Taylor remainder.\<close>
       have "0 < \<bar>t\<bar>"
         using \<open>t \<noteq> 0\<close>
         by simp
       hence "0 < e1"
         using \<open>0 < e'\<close>
         by (simp add: e1_def)
 
       text \<open> Taylor expansion of f on set G. \<close>
       from uniform_explicit_remainder_Taylor_1[where f=f and f'=f',
         OF derivative_rhs[OF subsetD[OF \<open>G \<subseteq> X\<close>]] f'_cont_on_G \<open>open G\<close> H_props \<open>0 < e1\<close>]
       obtain d_Taylor R
       where Taylor_expansion:
         "0 < d_Taylor"
         "\<And>x z. f z = f x + (f' x) (z - x) + R x z"
         "\<And>x y. x \<in> H \<Longrightarrow> y \<in> H \<Longrightarrow> dist x y < d_Taylor \<Longrightarrow> norm (R x y) \<le> e1 * dist x y"
         "continuous_on (G \<times> G) (\<lambda>(a, b). R a b)"
           by auto
 
       text \<open> Find d, such that solutions are always at least \<open>min (e_domain/2) d_Taylor\<close> apart,
          i.e. always in H. This later gives us the bound on the remainder. \<close>
       have "0 < min (e_domain/2) d_Taylor"
         using \<open>0 < d_Taylor\<close> \<open>0 < e_domain\<close>
         by auto
       from uniform_limit_flow[OF \<open>t0 \<in> existence_ivl0 x0\<close> \<open>t1 \<in> existence_ivl0 x0\<close> \<open>t0 \<le> t1\<close>,
         THEN uniform_limitD, OF this, unfolded eventually_at]
       obtain d_ivl where d_ivl_def:
         "0 < d_ivl"
         "\<And>x. 0 < dist x x0 \<Longrightarrow> dist x x0 < d_ivl \<Longrightarrow>
           (\<forall>t\<in>J. dist (flow0 x0 t) (Y (x - x0) t) < min (e_domain / 2) d_Taylor)"
         by (auto simp: dist_commute J_def)
 
       define d where "d \<equiv> min u d_ivl"
       have "0 < d" using \<open>0 < u\<close> \<open>0 < d_ivl\<close>
         by (simp add: d_def)
       hence "d \<le> u" "d \<le> d_ivl"
         by (auto simp: d_def)
 
       text \<open> Therefore, any flow0 starting in \<open>ball x0 d\<close> will be in G. \<close>
       have Y_in_G: "\<And>y. y \<in> ball x0 d \<Longrightarrow> (\<lambda>s. Y (y - x0) s) ` J \<subseteq> G"
         proof
           fix x y assume assms: "y \<in> ball x0 d" "x \<in> (\<lambda>s. Y (y - x0) s) ` J"
           show "x \<in> G"
           proof(cases)
             assume "y = x0"
             from assms(2)
             have "x \<in> flow0 x0 ` J"
               by (simp add: \<open>y = x0\<close>)
             thus "x \<in> G"
               using \<open>0 < e_domain\<close> \<open>flow0 x0 ` J \<subseteq> X\<close>
               by (auto simp: G_def)
           next
             assume "y \<noteq> x0"
             hence "0 < dist y x0"
               by (simp add: dist_norm)
             from d_ivl_def(2)[OF this] \<open>d \<le> d_ivl\<close>  \<open>0 < e_domain\<close> assms(1)
             have dist_flow0_Y: "\<And>t. t \<in> J \<Longrightarrow> dist (flow0 x0 t) (Y (y - x0) t) < e_domain"
               by (auto simp: dist_commute)
 
             from assms(2)
             obtain t where t_def: "t \<in> J" "x = Y (y - x0) t"
               by auto
             have "x \<in> X"
               unfolding t_def(2)
               using uK_def(3) assms(1) \<open>d \<le> u\<close> subsetD[OF J_in_existence_ivl t_def(1)]
               by (auto simp: intro!: flow_in_domain)
 
             have "flow0 x0 t \<in> flow0 x0 ` J" using t_def by auto
             from dist_flow0_Y[OF t_def(1)]
             have "dist x (flow0 x0 t) < e_domain"
               by (simp add: t_def(2) dist_commute)
             from le_less_trans[OF infdist_le[OF \<open>flow0 x0 t \<in> flow0 x0 ` J\<close>] this] \<open>x \<in> X\<close>
             show "x \<in> G"
               by (auto simp: G_def)
           qed
         qed
       from this[of x0] \<open>0 < d\<close>
       have X_in_G: "flow0 x0 ` J \<subseteq> G"
         by simp
 
       show "\<exists>d>0. \<forall>x. 0 < dist x x0 \<and> dist x x0 < d \<longrightarrow>
                      dist ((Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) /\<^sub>R norm (x - x0)) 0 < e"
       proof(rule exI, rule conjI[OF \<open>0 < d\<close>], safe, unfold norm_conv_dist[symmetric])
         fix x assume x_x0_dist: "0 < dist x x0" "dist x x0 < d"
         hence x_in_ball': "x \<in> ball x0 d"
           by (simp add: dist_commute)
         hence x_in_ball: "x \<in> ball x0 u"
           using \<open>d \<le> u\<close>
           by simp
 
         text \<open> First, some prerequisites. \<close>
         from x_in_ball
         have z_in_ball: "x - x0 \<in> ball 0 u"
           using \<open>0 < u\<close>
           by (simp add: dist_norm)
         hence [continuous_intros]: "dist x0 x < u"
           by (auto simp: dist_norm)
 
         from J_in_existence_ivl[OF x_in_ball]
         have J_in_existence_ivl_x: "J \<subseteq> existence_ivl0 x" .
         from ball_in_X[OF z_in_ball]
         have x_in_X[continuous_intros]: "x \<in> X"
           by simp
 
         text \<open> On all of \<open>J\<close>, we can find upper bounds for the distance of \<open>flow0\<close> and \<open>Y\<close>. \<close>
         have dist_flow0_Y: "\<And>s. s \<in> J \<Longrightarrow> dist (flow0 x0 s) (Y (x - x0) s) \<le> dist x0 x * exp (K * \<bar>t\<bar>)"
           using t0_def t1_def uK_def(2)
           by (intro order_trans[OF uK_def(6)[OF x_in_ball] mult_left_mono])
              (auto simp add: J_def intro!: mult_mono)
         from d_ivl_def x_x0_dist \<open>d \<le> d_ivl\<close>
         have dist_flow0_Y2: "\<And>t. t \<in> J \<Longrightarrow> dist (flow0 x0 t) (Y (x - x0) t) < min (e_domain2) d_Taylor"
           by (auto simp: e_domain2_def)
 
         let ?g = "\<lambda>t. norm (Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t)"
         let ?C = "\<bar>t\<bar> * dist x0 x * exp (K * \<bar>t\<bar>) * e1"
         text \<open> Find an upper bound to \<open>?g\<close>, i.e. show that
              \<open>?g s \<le> ?C + N * integral {a..b} ?g\<close>
            for \<open>{a..b} = {0..s}\<close> or \<open>{a..b} = {s..0}\<close> for some \<open>s \<in> J\<close>.
            We can then apply Grönwall's inequality to obtain a true bound for \<open>?g\<close>. \<close>
         have g_bound: "?g s \<le> ?C + N * integral {a..b} ?g"
           if s_def: "s \<in> {a..b}"
           and J'_def: "{a..b} \<subseteq> J"
           and ab_cases: "(a = 0 \<and> b = s) \<or> (a = s \<and> b = 0)"
           for s a b
         proof -
           from that have "s \<in> J" by auto
 
           have s_in_existence_ivl_x0: "s \<in> existence_ivl0 x0"
             using J_in_existence \<open>s \<in> J\<close> by auto
           have s_in_existence_ivl: "\<And>y. y \<in> ball x0 u \<Longrightarrow> s \<in> existence_ivl0 y"
             using J_in_existence_ivl \<open>s \<in> J\<close> by auto
           have s_in_existence_ivl2: "\<And>z. z \<in> ball 0 u \<Longrightarrow> s \<in> existence_ivl0 (x0 + z)"
             using s_in_existence_ivl
             by (simp add: dist_norm)
 
           text \<open>Prove continuities beforehand.\<close>
           note continuous_on_0_s[continuous_intros] = continuous_on_subset[OF _ \<open>{a..b} \<subseteq> J\<close>]
 
           have[continuous_intros]: "continuous_on J (flow0 x0)"
             using J_in_existence
             by (auto intro!: continuous_intros simp:)
           {
             fix z S
             assume assms: "x0 + z \<in> X" "S \<subseteq> existence_ivl0 (x0 + z)"
             have "continuous_on S (\<lambda>s. f (Y z s))"
             proof(rule continuous_on_subset[OF _ assms(2)])
               show "continuous_on (existence_ivl0 (x0 + z)) (\<lambda>s. f (Y z s))"
                 using assms
                 by (auto intro!: continuous_intros flow_in_domain flow_continuous_on simp:)
             qed
           }
           note [continuous_intros] = this
 
           have [continuous_intros]: "continuous_on J (\<lambda>s. f (flow0 x0 s))"
             by(rule continuous_on_subset[OF _ J_in_existence])
               (auto intro!: continuous_intros flow_continuous_on flow_in_domain simp: x0_def)
 
           have [continuous_intros]: "\<And>z. continuous_on J (\<lambda>s. f' (flow0 x0 s) (vector_Dflow z s))"
           proof-
             fix z
             have a1: "continuous_on J (flow0 x0)"
               by (auto intro!: continuous_intros)
 
             have a2: "(\<lambda>s. (flow0 x0 s, vector_Dflow z s)) ` J \<subseteq> (flow0 x0 ` J) \<times> ((\<lambda>s. vector_Dflow z s) ` J)"
               by auto
             have a3: "continuous_on ((\<lambda>s. (flow0 x0 s, vector_Dflow z s)) ` J) (\<lambda>(x, u). f' x u)"
               using assms flow0_J_props
               by (auto intro!: continuous_intros simp: split_beta')
             from continuous_on_compose[OF continuous_on_Pair[OF a1 U_continuous] a3]
             show "continuous_on J (\<lambda>s. f' (flow0 x0 s) (vector_Dflow z s))"
               by simp
           qed
 
           have [continuous_intros]: "continuous_on J (\<lambda>s. R (flow0 x0 s) (Y (x - x0) s))"
             using J_in_existence J_in_existence_ivl[OF x_in_ball] X_in_G \<open>{a..b} \<subseteq> J\<close> Y_in_G
               x_x0_dist
             by (auto intro!: continuous_intros continuous_on_compose_Pair[OF Taylor_expansion(4)]
               simp: dist_commute subset_iff)
           hence [continuous_intros]:
             "(\<lambda>s. R (flow0 x0 s) (Y (x - x0) s)) integrable_on J"
             unfolding J_def
             by (rule integrable_continuous_real)
 
           have i1: "integral {a..b} (\<lambda>s. f (flow0 x s)) - integral {a..b} (\<lambda>s. f (flow0 x0 s)) =
               integral {a..b} (\<lambda>s. f (flow0 x s) - f (flow0 x0 s))"
             using J_in_existence_ivl[OF x_in_ball]
             apply (intro Henstock_Kurzweil_Integration.integral_diff[symmetric])
              by (auto intro!: continuous_intros existence_ivl_reverse)
           have i2:
             "integral {a..b} (\<lambda>s. f (flow0 x s) - f (flow0 x0 s) - (f' (flow0 x0 s)) (vector_Dflow (x - x0) s)) =
               integral {a..b} (\<lambda>s. f (flow0 x s) - f (flow0 x0 s)) -
               integral {a..b} (\<lambda>s. f' (flow0 x0 s) (vector_Dflow (x - x0) s))"
             using J_in_existence_ivl[OF x_in_ball]
             by (intro Henstock_Kurzweil_Integration.integral_diff[OF Henstock_Kurzweil_Integration.integrable_diff])
               (auto intro!: continuous_intros existence_ivl_reverse)
           from ab_cases
           have "?g s = norm (integral {a..b} (\<lambda>s'. f (Y (x - x0) s')) -
             integral {a..b} (\<lambda>s'. f (flow0 x0 s')) -
             integral {a..b} (\<lambda>s'. (f' (flow0 x0 s')) (vector_Dflow (x - x0) s')))"
           proof(safe)
             assume "a = 0" "b = s"
             hence "0 \<le> s" using \<open>s \<in> {a..b}\<close> by simp
 
             text\<open> Integral equations for flow0, Y and U. \<close>
             have flow0_integral_eq: "flow0 x0 s = x0 + ivl_integral 0 s (\<lambda>s. f (flow0 x0 s))"
               by (rule flow_fixed_point[OF s_in_existence_ivl_x0])
             have Y_integral_eq: "flow0 x s = x0 + (x - x0) + ivl_integral 0 s (\<lambda>s. f (Y (x - x0) s))"
               using flow_fixed_point \<open>0 \<le> s\<close> s_in_existence_ivl2[OF z_in_ball] ball_in_X[OF z_in_ball]
               by (simp add:)
             have U_integral_eq: "vector_Dflow (x - x0) s = (x - x0) + ivl_integral 0 s (\<lambda>s. vareq x0 s (vector_Dflow (x - x0) s))"
               unfolding vector_Dflow_def
               by (rule var.flow_fixed_point)
                 (auto simp: \<open>0 \<le> s\<close> x0_def varexivl_eq_exivl s_in_existence_ivl_x0)
             show "?g s = norm (integral {0..s} (\<lambda>s'. f (Y (x - x0) s')) -
                 integral {0..s} (\<lambda>s'. f (flow0 x0 s')) -
                 integral {0..s} (\<lambda>s'. blinfun_apply (f' (flow0 x0 s')) (vector_Dflow (x - x0) s')))"
               using \<open>0 \<le> s\<close>
               unfolding vareq_def[symmetric]
               by (simp add: flow0_integral_eq Y_integral_eq U_integral_eq ivl_integral_def)
           next
             assume "a = s" "b = 0"
             hence "s \<le> 0" using \<open>s \<in> {a..b}\<close> by simp
 
             have flow0_integral_eq_left: "flow0 x0 s = x0 + ivl_integral 0 s (\<lambda>s. f (flow0 x0 s))"
               by (rule flow_fixed_point[OF s_in_existence_ivl_x0])
             have Y_integral_eq_left: "Y (x - x0) s = x0 + (x - x0) + ivl_integral 0 s (\<lambda>s. f (Y (x - x0) s))"
               using flow_fixed_point \<open>s \<le> 0\<close> s_in_existence_ivl2[OF z_in_ball] ball_in_X[OF z_in_ball]
               by simp
             have U_integral_eq_left: "vector_Dflow (x - x0) s = (x - x0) + ivl_integral 0 s (\<lambda>s. vareq x0 s (vector_Dflow (x - x0) s))"
               unfolding vector_Dflow_def
               by (rule var.flow_fixed_point)
                 (auto simp: \<open>s \<le> 0\<close> x0_def varexivl_eq_exivl s_in_existence_ivl_x0)
 
             have "?g s =
               norm (- integral {s..0} (\<lambda>s'. f (Y (x - x0) s')) +
                 integral {s..0} (\<lambda>s'. f (flow0 x0 s')) +
                 integral {s..0} (\<lambda>s'. vareq x0 s' (vector_Dflow (x - x0) s')))"
               unfolding flow0_integral_eq_left Y_integral_eq_left U_integral_eq_left
               using \<open>s \<le> 0\<close>
               by (simp add: ivl_integral_def)
             also have "... = norm (integral {s..0} (\<lambda>s'. f (Y (x - x0) s')) -
                 integral {s..0} (\<lambda>s'. f (flow0 x0 s')) -
                 integral {s..0} (\<lambda>s'. vareq x0 s' (vector_Dflow (x - x0) s')))"
               by (subst norm_minus_cancel[symmetric], simp)
             finally show "?g s =
               norm (integral {s..0} (\<lambda>s'. f (Y (x - x0) s')) -
                 integral {s..0} (\<lambda>s'. f (flow0 x0 s')) -
                 integral {s..0} (\<lambda>s'. blinfun_apply (f' (flow0 x0 s')) (vector_Dflow (x - x0) s')))"
               unfolding vareq_def .
           qed
           also have "... =
             norm (integral {a..b} (\<lambda>s. f (Y (x - x0) s) - f (flow0 x0 s) - (f' (flow0 x0 s)) (vector_Dflow (x - x0) s)))"
             by (simp add: i1 i2)
           also have "... \<le>
             integral {a..b} (\<lambda>s. norm (f (Y (x - x0) s) - f (flow0 x0 s) - f' (flow0 x0 s) (vector_Dflow (x - x0) s)))"
             using x_in_X J_in_existence_ivl_x J_in_existence \<open>{a..b} \<subseteq> J\<close>
             by (auto intro!: continuous_intros continuous_on_imp_absolutely_integrable_on
                 existence_ivl_reverse)
           also have "... = integral {a..b}
               (\<lambda>s. norm (f' (flow0 x0 s) (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s) + R (flow0 x0 s) (Y (x - x0) s)))"
           proof (safe intro!: integral_spike[OF negligible_empty, simplified] arg_cong[where f=norm])
             fix s' assume "s' \<in> {a..b}"
             show "f' (flow0 x0 s') (Y (x - x0) s' - flow0 x0 s' - vector_Dflow (x - x0) s') + R (flow0 x0 s') (Y (x - x0) s') =
               f (Y (x - x0) s') - f (flow0 x0 s') - f' (flow0 x0 s') (vector_Dflow (x - x0) s')"
               by (simp add: blinfun.diff_right Taylor_expansion(2)[of "flow0 x s'" "flow0 x0 s'"])
           qed
           also have "... \<le> integral {a..b}
             (\<lambda>s. norm (f' (flow0 x0 s) (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s)) +
               norm (R (flow0 x0 s) (Y (x - x0) s)))"
             using J_in_existence_ivl[OF x_in_ball] norm_triangle_ineq
             using \<open>continuous_on J (\<lambda>s. R (flow0 x0 s) (Y (x - x0) s))\<close>
             by (auto intro!: continuous_intros integral_le)
           also have "... =
             integral {a..b} (\<lambda>s. norm (f' (flow0 x0 s) (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s))) +
             integral {a..b} (\<lambda>s. norm (R (flow0 x0 s) (Y (x - x0) s)))"
             using J_in_existence_ivl[OF x_in_ball]
             using \<open>continuous_on J (\<lambda>s. R (flow0 x0 s) (Y (x - x0) s))\<close>
             by (auto intro!: continuous_intros Henstock_Kurzweil_Integration.integral_add)
           also have "... \<le> N * integral {a..b} ?g + ?C" (is "?l1 + ?r1 \<le> _")
           proof(rule add_mono)
             have "?l1 \<le> integral {a..b} (\<lambda>s. norm (f' (flow0 x0 s)) * norm (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s))"
               using norm_blinfun J_in_existence_ivl[OF x_in_ball]
               by (auto intro!: continuous_intros integral_le)
 
             also have "... \<le> integral {a..b} (\<lambda>s. N * norm (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s))"
               using J_in_existence_ivl[OF x_in_ball] N_ineq[OF \<open>{a..b} \<subseteq> J\<close>[THEN subsetD]]
               by (intro integral_le) (auto intro!: continuous_intros mult_right_mono)
               
             also have "... = N * integral {a..b} (\<lambda>s. norm ((Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s)))"
               unfolding real_scaleR_def[symmetric]
               by(rule integral_cmul)
             finally show "?l1 \<le> N * integral {a..b} ?g" .
           next
             have "?r1 \<le> integral {a..b} (\<lambda>s. e1 * dist (flow0 x0 s) (Y (x - x0) s))"
               using J_in_existence_ivl[OF x_in_ball] \<open>0 < e_domain\<close> dist_flow0_Y2 \<open>0 < e_domain2\<close>
               by (intro integral_le)
                 (force
                   intro!: continuous_intros Taylor_expansion(3) order_trans[OF infdist_le]
                    dest!: \<open>{a..b} \<subseteq> J\<close>[THEN subsetD]
                    intro: less_imp_le
                    simp: dist_commute H_def)+
             also have "... \<le> integral {a..b} (\<lambda>s. e1 * (dist x0 x * exp (K * \<bar>t\<bar>)))"
               apply(rule integral_le)
               subgoal using J_in_existence_ivl[OF x_in_ball] by (force intro!: continuous_intros)
               subgoal by force
               subgoal by (force dest!: \<open>{a..b} \<subseteq> J\<close>[THEN subsetD]
                 intro!: less_imp_le[OF \<open>0 < e1\<close>] mult_left_mono[OF dist_flow0_Y])
               done
             also have "... \<le> ?C"
               using \<open>s \<in> J\<close> x_x0_dist \<open>0 < e1\<close> \<open>{a..b} \<subseteq> J\<close> \<open>0 < \<bar>t\<bar>\<close> t0_def t1_def
               by (auto simp: integral_const_real J_def(1))
             finally show "?r1 \<le> ?C" .
           qed
           finally show ?thesis
             by simp
         qed
         have g_continuous: "continuous_on J ?g"
           using J_in_existence_ivl[OF x_in_ball] J_in_existence
           using J_def(1) U_continuous
           by (auto simp: J_def intro!: continuous_intros)
         note [continuous_intros] = continuous_on_subset[OF g_continuous]
         have C_gr_zero: "0 < ?C"
           using \<open>0 < \<bar>t\<bar>\<close> \<open>0 < e1\<close> x_x0_dist(1)
           by (simp add: dist_commute)
         have "0 \<le> t \<or> t \<le> 0" by auto
         then have "?g t \<le> ?C * exp (N * \<bar>t\<bar>)"
         proof
           assume "0 \<le> t"
           moreover
           have "continuous_on {0..t} (vector_Dflow (x - x0))"
             using U_continuous
             by (rule continuous_on_subset) (auto simp: J_def t0_def t1_def)
           then have "norm (Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) \<le>
             \<bar>t\<bar> * dist x0 x * exp (K * \<bar>t\<bar>) * e1 * exp (N * t)"
             using \<open>t \<in> J\<close> J_def \<open>t0 \<le> 0\<close> J_in_existence J_in_existence_ivl_x
             by (intro gronwall[OF g_bound _ _ C_gr_zero \<open>0 < N\<close> \<open>0 \<le> t\<close> order.refl])
                (auto intro!: continuous_intros simp: )
           ultimately show ?thesis by simp
         next
           assume "t \<le> 0"
           moreover
           have "continuous_on {t .. 0} (vector_Dflow (x - x0))"
             using U_continuous
             by (rule continuous_on_subset) (auto simp: J_def t0_def t1_def)
           then have "norm (Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) \<le>
             \<bar>t\<bar> * dist x0 x * exp (K * \<bar>t\<bar>) * e1 * exp (- N * t)"
             using \<open>t \<in> J\<close> J_def \<open>0 \<le> t1\<close> J_in_existence J_in_existence_ivl_x
             by (intro gronwall_left[OF g_bound _ _ C_gr_zero \<open>0 < N\<close> order.refl \<open>t \<le> 0\<close>])
                 (auto intro!: continuous_intros)
           ultimately show ?thesis
             by simp
         qed
         also have "... = dist x x0 * (\<bar>t\<bar> * exp (K * \<bar>t\<bar>) * e1 * exp (N * \<bar>t\<bar>))"
           by (auto simp: dist_commute)
         also have "... < norm (x - x0) * e"
           unfolding e1_def
           using \<open>e' < e\<close> \<open>0 < \<bar>t\<bar>\<close> \<open>0 < e1\<close> x_x0_dist(1)
           by (simp add: dist_norm)
         finally show "norm ((Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) /\<^sub>R norm (x - x0)) < e"
           by (simp, metis x_x0_dist(1) dist_norm divide_inverse mult.commute pos_divide_less_eq)
       qed
     qed
   qed
 qed
 
 lemma local_lipschitz_A:
   "OT \<subseteq> existence_ivl0 x0 \<Longrightarrow> local_lipschitz OT (OS::('a \<Rightarrow>\<^sub>L 'a) set) (\<lambda>t. (o\<^sub>L) (vareq x0 t))"
   by (rule local_lipschitz_subset[OF _ _ subset_UNIV, where T="existence_ivl0 x0"])
      (auto simp: split_beta' vareq_def
       intro!: c1_implies_local_lipschitz[where f'="\<lambda>(t, x). comp3 (f' (flow0 x0 t))"]
         derivative_eq_intros blinfun_eqI ext
         continuous_intros flow_in_domain)
 
 lemma total_derivative_ll_on_open:
   "ll_on_open (existence_ivl0 x0) (\<lambda>t. blinfun_compose (vareq x0 t)) (UNIV::('a \<Rightarrow>\<^sub>L 'a) set)"
   by standard (auto intro!: continuous_intros local_lipschitz_A[OF order_refl])
 
 end
 
 end
 
 sublocale mvar: ll_on_open "existence_ivl0 x0" "\<lambda>t. blinfun_compose (vareq x0 t)" "UNIV::('a \<Rightarrow>\<^sub>L 'a) set" for x0
   by (rule total_derivative_ll_on_open)
 
 lemma mvar_existence_ivl_eq_existence_ivl[simp]:\<comment> \<open>TODO: unify with @{thm varexivl_eq_exivl}\<close>
   assumes "t \<in> existence_ivl0 x0"
   shows "mvar.existence_ivl x0 t = (\<lambda>_. existence_ivl0 x0)"
 proof (rule ext, rule mvar.existence_ivl_eq_domain)
   fix s t x
   assume s: "s \<in> existence_ivl0 x0" and t: "t \<in> existence_ivl0 x0"
   then have "{s .. t} \<subseteq> existence_ivl0 x0"
     by (meson atLeastAtMost_iff is_interval_1 is_interval_existence_ivl subsetI)
   then have "continuous_on {s .. t} (vareq x0)"
     by (auto intro!: continuous_intros)
   then have "compact (vareq x0 ` {s .. t})"
     using compact_Icc
     by (rule compact_continuous_image)
   then obtain B where B: "\<And>u. u \<in> {s .. t} \<Longrightarrow> norm (vareq x0 u) \<le> B"
     by (force dest!: compact_imp_bounded simp: bounded_iff)
   show "\<exists>M L. \<forall>t\<in>{s .. t}. \<forall>x\<in>UNIV. norm (vareq x0 t o\<^sub>L x) \<le> M + L * norm x"
     unfolding o_def
     by (rule exI[where x=0], rule exI[where x=B])
       (auto intro!: order_trans[OF norm_blinfun_compose] mult_right_mono B)
 qed (auto intro: assms)
 
 lemma
   assumes "t \<in> existence_ivl0 x0"
   shows "continuous_on (UNIV \<times> existence_ivl0 x0) (\<lambda>(x, ta). mvar.flow x0 t x ta)"
 proof -
   from mvar.flow_continuous_on_state_space[of x0 t, unfolded mvar_existence_ivl_eq_existence_ivl[OF assms]]
   show "continuous_on (UNIV \<times> existence_ivl0 x0) (\<lambda>(x, ta). mvar.flow x0 t x ta)" .
 qed
 
 definition "Dflow x0 = mvar.flow x0 0 id_blinfun"
 
 lemma var_eq_mvar:
   assumes "t0 \<in> existence_ivl0 x0"
   assumes "t \<in> existence_ivl0 x0"
   shows "var.flow x0 t0 i t = mvar.flow x0 t0 id_blinfun t i"
   by (rule var.flow_unique)
      (auto intro!: assms derivative_eq_intros mvar.flow_has_derivative
        simp: varexivl_eq_exivl assms has_vector_derivative_def blinfun.bilinear_simps)
 
 lemma Dflow_zero[simp]: "x \<in> X \<Longrightarrow> Dflow x 0 = 1\<^sub>L"
   unfolding Dflow_def
   by (subst mvar.flow_initial_time) auto
 
 
 subsection \<open>Differentiability of the flow0\<close>
 
 text \<open> \<open>U t\<close>, i.e. the solution of the variational equation, is the space derivative at the initial
   value \<open>x0\<close>. \<close>
 lemma flow_dx_derivative:
 assumes "t \<in> existence_ivl0 x0"
 shows "((\<lambda>x0. flow0 x0 t) has_derivative (\<lambda>z. vector_Dflow x0 z t)) (at x0)"
   unfolding has_derivative_at2
   using assms
   by (intro iffD1[OF LIM_equal proposition_17_6_weak[OF assms]] conjI[OF bounded_linear_vector_Dflow[OF assms]])
     (simp add: diff_diff_add inverse_eq_divide)
 
 lemma flow_dx_derivative_blinfun:
 assumes "t \<in> existence_ivl0 x0"
 shows "((\<lambda>x. flow0 x t) has_derivative Blinfun (\<lambda>z. vector_Dflow x0 z t)) (at x0)"
 by (rule has_derivative_Blinfun[OF flow_dx_derivative[OF assms]])
 
 definition "flowderiv x0 t = comp12 (Dflow x0 t) (blinfun_scaleR_left (f (flow0 x0 t)))"
 
 lemma flowderiv_eq: "flowderiv x0 t (\<xi>\<^sub>1, \<xi>\<^sub>2) = (Dflow x0 t) \<xi>\<^sub>1 + \<xi>\<^sub>2 *\<^sub>R f (flow0 x0 t)"
   by (auto simp: flowderiv_def)
 
 lemma W_continuous_on: "continuous_on (Sigma X existence_ivl0) (\<lambda>(x0, t). Dflow x0 t)"
   \<comment> \<open>TODO: somewhere here is hidden continuity wrt rhs of ODE, extract it!\<close>
   unfolding continuous_on split_beta'
 proof (safe intro!: tendstoI)
   fix e'::real and t x assume x: "x \<in> X" and tx: "t \<in> existence_ivl0 x" and e': "e' > 0"
   let ?S = "Sigma X existence_ivl0"
 
   have "(x, t) \<in> ?S" using x tx by auto
   from open_prod_elim[OF open_state_space this]
   obtain OX OT where OXOT: "open OX" "open OT" "(x, t) \<in> OX \<times> OT" "OX \<times> OT \<subseteq> ?S"
     by blast
   then obtain dx dt
   where dx: "dx > 0" "cball x dx \<subseteq> OX"
     and dt: "dt > 0" "cball t dt \<subseteq> OT"
     by (force simp: open_contains_cball)
 
   from OXOT dt dx have "cball t dt \<subseteq> existence_ivl0 x" "cball x dx \<subseteq> X"
     apply (auto simp: subset_iff)
     subgoal for ta
       apply (drule spec[where x=ta])
       apply (drule spec[where x=t])+
       apply auto
       done
     done
 
   have one_exivl: "mvar.existence_ivl x 0 = (\<lambda>_. existence_ivl0 x)"
     by (rule mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF \<open>x \<in> X\<close>]])
 
   have *: "closed ({t .. 0} \<union> {0 .. t})" "{t .. 0} \<union> {0 .. t} \<noteq> {}"
     by auto
   let ?T = "{t .. 0} \<union> {0 .. t} \<union> cball t dt"
   have "compact ?T"
     by (auto intro!: compact_Un)
   have "?T \<subseteq> existence_ivl0 x"
     by (intro Un_least ivl_subset_existence_ivl' ivl_subset_existence_ivl \<open>x \<in> X\<close>
       \<open>t \<in> existence_ivl0 x\<close> \<open>cball t dt \<subseteq> existence_ivl0 x\<close>)
 
   have "compact (mvar.flow x 0 id_blinfun ` ?T)"
     using \<open>?T \<subseteq> _\<close> \<open>x \<in> X\<close>
       mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF \<open>x \<in> X\<close>]]
     by (auto intro!: \<open>0 < dx\<close> compact_continuous_image \<open>compact ?T\<close>
       continuous_on_subset[OF mvar.flow_continuous_on])
 
   let ?line = "mvar.flow x 0 id_blinfun ` ?T"
   let ?X = "{x. infdist x ?line \<le> dx}"
   have "compact ?X"
     using \<open>?T \<subseteq> _\<close> \<open>x \<in> X\<close>
       mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF \<open>x \<in> X\<close>]]
     by (auto intro!: compact_infdist_le \<open>0 < dx\<close> compact_continuous_image compact_Un
       continuous_on_subset[OF mvar.flow_continuous_on ])
 
   from mvar.local_lipschitz \<open>?T \<subseteq> _\<close>
   have llc: "local_lipschitz ?T ?X (\<lambda>t. (o\<^sub>L) (vareq x t))"
     by (rule local_lipschitz_subset) auto
 
   have cont: "\<And>xa. xa \<in> ?X \<Longrightarrow> continuous_on ?T (\<lambda>t. vareq x t o\<^sub>L xa)"
     using \<open>?T \<subseteq> _\<close>
     by (auto intro!: continuous_intros \<open>x \<in> X\<close>)
 
   from local_lipschitz_compact_implies_lipschitz[OF llc \<open>compact ?X\<close> \<open>compact ?T\<close> cont]
   obtain K' where K': "\<And>ta. ta \<in> ?T \<Longrightarrow> K'-lipschitz_on ?X ((o\<^sub>L) (vareq x ta))"
     by blast
   define K where "K \<equiv> abs K' + 1"
   have "K > 0"
     by (simp add: K_def)
   have K: "\<And>ta. ta \<in> ?T \<Longrightarrow> K-lipschitz_on ?X ((o\<^sub>L) (vareq x ta))"
     by (auto intro!: lipschitz_onI mult_right_mono order_trans[OF lipschitz_onD[OF K']] simp: K_def)
 
   have ex_ivlI: "\<And>y. y \<in> cball x dx \<Longrightarrow> ?T \<subseteq> existence_ivl0 y"
     using dx dt OXOT
     by (intro Un_least ivl_subset_existence_ivl' ivl_subset_existence_ivl; force)
 
   have cont: "continuous_on ((?T \<times> ?X) \<times> cball x dx) (\<lambda>((ta, xa), y). (vareq y ta o\<^sub>L xa))"
     using \<open>cball x dx \<subseteq> X\<close> ex_ivlI
     by (force intro!: continuous_intros simp: split_beta' )
 
   have "mvar.flow x 0 id_blinfun t \<in> mvar.flow x 0 id_blinfun ` ({t..0} \<union> {0..t} \<union> cball t dt)"
     by auto
   then have mem: "(t, mvar.flow x 0 id_blinfun t, x) \<in> ?T \<times> ?X \<times> cball x dx"
     by (auto simp: \<open>0 < dx\<close> less_imp_le)
 
   define e where "e \<equiv> min e' (dx / 2) / 2"
   have "e > 0" using \<open>e' > 0\<close> by (auto simp: e_def \<open>0 < dx\<close>)
   define d where "d \<equiv> e * K / (exp (K * (abs t + abs dt + 1)) - 1)"
   have "d > 0" by (auto simp: d_def intro!: mult_pos_pos divide_pos_pos \<open>0 < e\<close> \<open>K > 0\<close>)
 
   have cmpct: "compact ((?T \<times> ?X) \<times> cball x dx)" "compact (?T \<times> ?X)"
     using \<open>compact ?T\<close> \<open>compact ?X\<close>
     by (auto intro!: compact_cball compact_Times)
 
   have compact_line: "compact ?line"
     using \<open>{t..0} \<union> {0..t} \<union> cball t dt \<subseteq> existence_ivl0 x\<close> one_exivl
     by (force intro!: compact_continuous_image \<open>compact ?T\<close> continuous_on_subset[OF mvar.flow_continuous_on] simp: \<open>x \<in> X\<close>)
 
   from compact_uniformly_continuous[OF cont cmpct(1), unfolded uniformly_continuous_on_def,
       rule_format, OF \<open>0 < d\<close>]
   obtain d' where d': "d' > 0"
     "\<And>ta xa xa' y. ta \<in> ?T \<Longrightarrow> xa \<in> ?X \<Longrightarrow> xa'\<in>cball x dx \<Longrightarrow> y\<in>cball x dx \<Longrightarrow> dist xa' y < d' \<Longrightarrow>
       dist (vareq xa' ta o\<^sub>L xa) (vareq y ta o\<^sub>L xa) < d"
     by (auto simp: dist_prod_def)
   {
     fix y
     assume dxy: "dist x y < d'"
     assume "y \<in> cball x dx"
     then have "y \<in> X"
       using dx dt OXOT by force+
 
     have two_exivl: "mvar.existence_ivl y 0 = (\<lambda>_. existence_ivl0 y)"
       by (rule mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF \<open>y \<in> X\<close>]])
 
     let ?X' = "\<Union>x \<in> ?line. ball x dx"
     have "open ?X'" by auto
     have "?X' \<subseteq> ?X"
       by (auto intro!: infdist_le2 simp: dist_commute)
 
     interpret oneR: ll_on_open "existence_ivl0 x" "(\<lambda>t. (o\<^sub>L) (vareq x t))" ?X'
       by standard (auto intro!: \<open>x \<in> X\<close> continuous_intros local_lipschitz_A[OF order_refl])
     interpret twoR: ll_on_open "existence_ivl0 y" "(\<lambda>t. (o\<^sub>L) (vareq y t))" ?X'
       by standard (auto intro!: \<open>y \<in> X\<close> continuous_intros local_lipschitz_A[OF order_refl])
     interpret both:
       two_ll_on_open "(\<lambda>t. (o\<^sub>L) (vareq x t))" "existence_ivl0 x" "(\<lambda>t. (o\<^sub>L) (vareq y t))" "existence_ivl0 y" ?X' ?T "id_blinfun" d K
     proof unfold_locales
       show "0 < K" by (simp add: \<open>0 < K\<close>)
       show iv_defined: "0 \<in> {t..0} \<union> {0..t} \<union> cball t dt"
         by auto
       show "is_interval ({t..0} \<union> {0..t} \<union> cball t dt)"
         by (auto simp: is_interval_def dist_real_def)
       show "{t..0} \<union> {0..t} \<union> cball t dt \<subseteq> oneR.existence_ivl 0 id_blinfun"
         apply (rule oneR.maximal_existence_flow[where x="mvar.flow x 0 id_blinfun"])
         subgoal
           apply (rule solves_odeI)
           apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF mvar.flow_solves_ode[of 0 x id_blinfun]]])
           subgoal using \<open>x \<in> X\<close> \<open>?T \<subseteq> _\<close> \<open>0 < dx\<close> by simp
           subgoal by simp
           subgoal by (simp add: \<open>cball t dt \<subseteq> existence_ivl0 x\<close> ivl_subset_existence_ivl ivl_subset_existence_ivl' one_exivl tx)
           subgoal using dx by (auto; force)
           done
         subgoal by (simp add: \<open>x \<in> X\<close>)
         subgoal by fact
         subgoal using iv_defined by blast
         subgoal using \<open>{t..0} \<union> {0..t} \<union> cball t dt \<subseteq> existence_ivl0 x\<close> by blast
         done
       fix s assume s: "s \<in> ?T"
       then show "K-lipschitz_on ?X' ((o\<^sub>L) (vareq x s))"
         by (intro lipschitz_on_subset[OF K \<open>?X' \<subseteq> ?X\<close>]) auto
       fix j assume j: "j \<in> ?X'"
       show "norm ((vareq x s o\<^sub>L j) - (vareq y s o\<^sub>L j)) < d"
         unfolding dist_norm[symmetric]
         apply (rule d')
         subgoal by (rule s)
         subgoal using \<open>?X' \<subseteq> ?X\<close> j ..
         subgoal using \<open>dx > 0\<close> by simp
         subgoal using \<open>y \<in> cball x dx\<close> by simp
         subgoal using dxy by simp
         done
     qed
     have less_e: "norm (Dflow x s - both.Y s) < e"
       if s: "s \<in> ?T \<inter> twoR.existence_ivl 0 id_blinfun" for s
     proof -
       from s have s_less: "\<bar>s\<bar> < \<bar>t\<bar> + \<bar>dt\<bar> + 1"
         by (auto simp: dist_real_def)
       note both.norm_X_Y_bound[rule_format, OF s]
       also have "d / K * (exp (K * \<bar>s\<bar>) - 1) =
           e * ((exp (K * \<bar>s\<bar>) - 1) / (exp (K * (\<bar>t\<bar> + \<bar>dt\<bar> + 1)) - 1))"
         by (simp add: d_def)
       also have "\<dots> < e * 1"
         by (rule mult_strict_left_mono[OF _ \<open>0 < e\<close>])
            (simp add: add_nonneg_pos \<open>0 < K\<close> \<open>0 < e\<close> s_less)
       also have "\<dots> = e" by simp
       also
       from s have s: "s \<in> ?T" by simp
       have "both.flow0 s = Dflow x s"
         unfolding both.flow0_def Dflow_def
         apply (rule oneR.maximal_existence_flow[where K="?T"])
         subgoal
           apply (rule solves_odeI)
           apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF mvar.flow_solves_ode[of 0 x id_blinfun]]])
           subgoal using \<open>x \<in> X\<close> \<open>0 < dx\<close> by simp
           subgoal by simp
           subgoal by (simp add: \<open>cball t dt \<subseteq> existence_ivl0 x\<close> ivl_subset_existence_ivl ivl_subset_existence_ivl' one_exivl tx)
           subgoal using dx by (auto; force)
           done
         subgoal by (simp add: \<open>x \<in> X\<close>)
         subgoal by (rule both.J_ivl)
         subgoal using both.t0_in_J by blast
         subgoal using \<open>{t..0} \<union> {0..t} \<union> cball t dt \<subseteq> existence_ivl0 x\<close> by blast
         subgoal using s by blast
         done
       finally show ?thesis .
     qed
 
     have "e < dx" using \<open>dx > 0\<close> by (auto simp: e_def)
 
     let ?i = "{y. infdist y (mvar.flow x 0 id_blinfun ` ?T) \<le> e}"
     have 1: "?i \<subseteq> (\<Union>x\<in>mvar.flow x 0 id_blinfun ` ?T. ball x dx)"
     proof -
       have cl: "closed ?line" "?line \<noteq> {}" using compact_line
         by (auto simp: compact_imp_closed)
       have "?i \<subseteq> (\<Union>y\<in>mvar.flow x 0 id_blinfun ` ?T. cball y e)"
       proof safe
         fix x
         assume H: "infdist x ?line \<le> e"
         from infdist_attains_inf[OF cl, of x]
         obtain y where "y \<in> ?line" "infdist x ?line = dist x y" by auto
         then show "x \<in> (\<Union>x\<in>?line. cball x e)"
           using H
           by (auto simp: dist_commute)
       qed
       also have "\<dots> \<subseteq> (\<Union>x\<in>?line. ball x dx)"
         using \<open>e < dx\<close>
         by auto
       finally show ?thesis .
     qed
     have 2: "twoR.flow 0 id_blinfun s \<in> ?i"
       if "s \<in> ?T" "s \<in> twoR.existence_ivl 0 id_blinfun" for s
     proof -
       from that have sT: "s \<in> ?T \<inter> twoR.existence_ivl 0 id_blinfun"
         by force
       from less_e[OF this]
       have "dist (twoR.flow 0 id_blinfun s) (mvar.flow x 0 id_blinfun s) \<le> e"
         unfolding Dflow_def both.Y_def dist_commute dist_norm by simp
       then show ?thesis
         using sT by (force intro: infdist_le2)
     qed
     have T_subset: "?T \<subseteq> twoR.existence_ivl 0 id_blinfun"
       apply (rule twoR.subset_mem_compact_implies_subset_existence_interval[
           where K="{x. infdist x ?line \<le> e}"])
       subgoal using \<open>0 < dt\<close> by force
       subgoal by (rule both.J_ivl)
       subgoal using \<open>y \<in> cball x dx\<close> ex_ivlI by blast
       subgoal using both.F_iv_defined(2) by blast
       subgoal by (rule 2)
       subgoal using \<open>dt > 0\<close> by (intro compact_infdist_le) (auto intro!: compact_line \<open>0 < e\<close>)
       subgoal by (rule 1)
       done
     also have "twoR.existence_ivl 0 id_blinfun \<subseteq> existence_ivl0 y"
       by (rule twoR.existence_ivl_subset)
     finally have "?T \<subseteq> existence_ivl0 y" .
     have "norm (Dflow x s - Dflow y s) < e" if s: "s \<in> ?T" for s
     proof -
       from s have "s \<in> ?T \<inter> twoR.existence_ivl 0 id_blinfun" using T_subset by force
       from less_e[OF this] have "norm (Dflow x s - both.Y s) < e" .
       also have "mvar.flow y 0 id_blinfun s = twoR.flow 0 id_blinfun s"
         apply (rule mvar.maximal_existence_flow[where K="?T"])
         subgoal
           apply (rule solves_odeI)
           apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF twoR.flow_solves_ode[of 0 id_blinfun]]])
           subgoal using \<open>y \<in> X\<close> by simp
           subgoal using both.F_iv_defined(2) by blast
           subgoal using T_subset by blast
           subgoal by simp
           done
         subgoal using \<open>y \<in> X\<close> auto_ll_on_open.existence_ivl_zero auto_ll_on_open_axioms both.F_iv_defined(2) twoR.flow_initial_time by blast
         subgoal by (rule both.J_ivl)
         subgoal using both.t0_in_J by blast
         subgoal using \<open>{t..0} \<union> {0..t} \<union> cball t dt \<subseteq> existence_ivl0 y\<close> by blast
         subgoal using s by blast
         done
       then have "both.Y s = Dflow y s"
         unfolding both.Y_def Dflow_def
         by simp
       finally show ?thesis .
     qed
   } note cont_data = this
   have "\<forall>\<^sub>F (y, s) in at (x, t) within ?S. dist x y < d'"
     unfolding at_within_open[OF \<open>(x, t) \<in> ?S\<close> open_state_space] UNIV_Times_UNIV[symmetric]
     using \<open>d' > 0\<close>
     by (intro eventually_at_Pair_within_TimesI1)
       (auto simp: eventually_at less_imp_le dist_commute)
   moreover
   have "\<forall>\<^sub>F (y, s) in at (x, t) within ?S. y \<in> cball x dx"
     unfolding at_within_open[OF \<open>(x, t) \<in> ?S\<close> open_state_space] UNIV_Times_UNIV[symmetric]
     using \<open>dx > 0\<close>
     by (intro eventually_at_Pair_within_TimesI1)
       (auto simp: eventually_at less_imp_le dist_commute)
   moreover
   have "\<forall>\<^sub>F (y, s) in at (x, t) within ?S. s \<in> ?T"
     unfolding at_within_open[OF \<open>(x, t) \<in> ?S\<close> open_state_space] UNIV_Times_UNIV[symmetric]
     using \<open>dt > 0\<close>
     by (intro eventually_at_Pair_within_TimesI2)
       (auto simp: eventually_at less_imp_le dist_commute)
   moreover
   have "0 \<in> existence_ivl0 x" by (simp add: \<open>x \<in> X\<close>)
   have "\<forall>\<^sub>F y in at t within existence_ivl0 x. dist (mvar.flow x 0 id_blinfun y) (mvar.flow x 0 id_blinfun t) < e"
     using mvar.flow_continuous_on[of x 0 id_blinfun]
     using \<open>0 < e\<close> tx
     by (auto simp add: continuous_on one_exivl dest!: tendstoD)
   then have "\<forall>\<^sub>F (y, s) in at (x, t) within ?S. dist (Dflow x s) (Dflow x t) < e"
     using \<open>0 < e\<close>
     unfolding at_within_open[OF \<open>(x, t) \<in> ?S\<close> open_state_space] UNIV_Times_UNIV[symmetric] Dflow_def
     by (intro eventually_at_Pair_within_TimesI2)
       (auto simp: at_within_open[OF tx open_existence_ivl])
   ultimately
   have "\<forall>\<^sub>F (y, s) in at (x, t) within ?S. dist (Dflow y s) (Dflow x t) < e'"
     apply eventually_elim
   proof (safe del: UnE, goal_cases)
     case (1 y s)
     have "dist (Dflow y s) (Dflow x t) \<le> dist (Dflow y s) (Dflow x s) + dist (Dflow x s) (Dflow x t)"
       by (rule dist_triangle)
     also
     have "dist (Dflow x s) (Dflow x t) < e"
       by (rule 1)
     also have "dist (Dflow y s) (Dflow x s) < e"
       unfolding dist_norm norm_minus_commute
       using 1
       by (intro cont_data)
     also have "e + e \<le> e'" by (simp add: e_def)
     finally show "dist (Dflow y s) (Dflow x t) < e'" by arith
   qed
   then show "\<forall>\<^sub>F ys in at (x, t) within ?S. dist (Dflow (fst ys) (snd ys)) (Dflow (fst (x, t)) (snd (x, t))) < e'"
     by (simp add: split_beta')
 qed
 
 lemma W_continuous_on_comp[continuous_intros]:
   assumes h: "continuous_on S h" and g: "continuous_on S g"
   shows "(\<And>s. s \<in> S \<Longrightarrow> h s \<in> X) \<Longrightarrow> (\<And>s. s \<in> S \<Longrightarrow> g s \<in> existence_ivl0 (h s)) \<Longrightarrow>
     continuous_on S (\<lambda>s. Dflow (h s) (g s))"
   using continuous_on_compose[OF continuous_on_Pair[OF h g] continuous_on_subset[OF W_continuous_on]]
   by auto
 
 lemma f_flow_continuous_on: "continuous_on (Sigma X existence_ivl0) (\<lambda>(x0, t). f (flow0 x0 t))"
   using flow_continuous_on_state_space
   by (auto intro!: continuous_on_f flow_in_domain simp: split_beta')
 
 lemma
   flow_has_space_derivative:
   assumes "t \<in> existence_ivl0 x0"
   shows "((\<lambda>x0. flow0 x0 t) has_derivative Dflow x0 t) (at x0)"
   by (rule flow_dx_derivative_blinfun[THEN has_derivative_eq_rhs])
     (simp_all add: var_eq_mvar assms blinfun.blinfun_apply_inverse Dflow_def vector_Dflow_def
       mem_existence_ivl_iv_defined[OF assms])
 
 lemma
   flow_has_flowderiv:
   assumes "t \<in> existence_ivl0 x0"
   shows "((\<lambda>(x0, t). flow0 x0 t) has_derivative flowderiv x0 t) (at (x0, t) within S)"
 proof -
   have Sigma: "(x0, t) \<in> Sigma X existence_ivl0"
     using assms by auto
   from open_state_space assms obtain e' where e': "e' > 0" "ball (x0, t) e' \<subseteq> Sigma X existence_ivl0"
     by (force simp: open_contains_ball)
   define e where "e = e' / sqrt 2"
   have "0 < e" using e' by (auto simp: e_def)
   have "ball x0 e \<times> ball t e \<subseteq> ball (x0, t) e'"
     by (auto simp: dist_prod_def real_sqrt_sum_squares_less e_def)
   also note e'(2)
   finally have subs: "ball x0 e \<times> ball t e \<subseteq> Sigma X existence_ivl0" .
 
 
   have d1: "((\<lambda>x0. flow0 x0 s) has_derivative blinfun_apply (Dflow y s)) (at y within ball x0 e)"
     if "y \<in> ball x0 e" "s \<in> ball t e" for y s
     using subs that
     by (subst at_within_open; force intro!: flow_has_space_derivative)
   have d2: "(flow0 y has_derivative blinfun_apply (blinfun_scaleR_left (f (flow0 y s)))) (at s within ball t e)"
     if "y \<in> ball x0 e" "s \<in> ball t e" for y s
     using subs that
     unfolding has_vector_derivative_eq_has_derivative_blinfun[symmetric]
     by (subst at_within_open; force intro!: flow_has_vector_derivative)
   have "((\<lambda>(x0, t). flow0 x0 t) has_derivative flowderiv x0 t) (at (x0, t) within ball x0 e \<times> ball t e)"
     using subs
     unfolding UNIV_Times_UNIV[symmetric]
     by (intro has_derivative_partialsI[OF d1 d2, THEN has_derivative_eq_rhs])
        (auto intro!: \<open>0 < e\<close> continuous_intros flow_in_domain
           continuous_on_imp_continuous_within[where s="Sigma X existence_ivl0"]
           assms
         simp: flowderiv_def split_beta' flow0_defined assms mem_ball)
   then have "((\<lambda>(x0, t). flow0 x0 t) has_derivative flowderiv x0 t) (at (x0, t) within Sigma X existence_ivl0)"
     by (auto simp: at_within_open[OF _ open_state_space] at_within_open[OF _ open_Times] assms \<open>0 < e\<close>
         mem_existence_ivl_iv_defined[OF assms])
   then show ?thesis unfolding at_within_open[OF Sigma open_state_space]
     by (rule has_derivative_at_withinI)
 qed
 
 lemma flow0_comp_has_derivative:
   assumes h: "h s \<in> existence_ivl0 (g s)"
   assumes [derivative_intros]: "(g has_derivative g') (at s within S)"
   assumes [derivative_intros]: "(h has_derivative h') (at s within S)"
   shows "((\<lambda>x. flow0 (g x) (h x)) has_derivative (\<lambda>x. blinfun_apply (flowderiv (g s) (h s)) (g' x, h' x)))
      (at s within S)"
   by (rule has_derivative_compose[where f="\<lambda>x. (g x, h x)" and s=S,
         OF _ flow_has_flowderiv[OF h], simplified])
     (auto intro!: derivative_eq_intros)
 
 lemma flowderiv_continuous_on: "continuous_on (Sigma X existence_ivl0) (\<lambda>(x0, t). flowderiv x0 t)"
   unfolding flowderiv_def split_beta'
   by (subst blinfun_of_matrix_works[where f="comp12 (Dflow (fst x) (snd x))
             (blinfun_scaleR_left (f (flow0 (fst x) (snd x))))" for x, symmetric])
     (auto intro!: continuous_intros flow_in_domain)
 
 lemma flowderiv_continuous_on_comp[continuous_intros]:
   assumes "continuous_on S x"
   assumes "continuous_on S t"
   assumes "\<And>s. s \<in> S \<Longrightarrow> x s \<in> X" "\<And>s. s \<in> S \<Longrightarrow> t s \<in> existence_ivl0 (x s)"
   shows "continuous_on S (\<lambda>xa. flowderiv (x xa) (t xa))"
   by (rule continuous_on_compose2[OF flowderiv_continuous_on, where f="\<lambda>s. (x s, t s)",
         unfolded split_beta' fst_conv snd_conv])
     (auto intro!: continuous_intros assms)
 
 lemmas [intro] = flow_in_domain
 
 lemma vareq_trans: "t0 \<in> existence_ivl0 x0 \<Longrightarrow> t \<in> existence_ivl0 (flow0 x0 t0) \<Longrightarrow>
   vareq (flow0 x0 t0) t = vareq x0 (t0 + t)"
   by (auto simp: vareq_def flow_trans)
 
 lemma diff_existence_ivl_trans:
   "t0 \<in> existence_ivl0 x0 \<Longrightarrow> t \<in> existence_ivl0 x0 \<Longrightarrow> t - t0 \<in> existence_ivl0 (flow0 x0 t0)" for t
   by (metis (no_types, opaque_lifting) add.left_neutral diff_add_eq
       local.existence_ivl_reverse local.existence_ivl_trans local.flows_reverse)
 
 lemma has_vderiv_on_blinfun_compose_right[derivative_intros]:
   assumes "(g has_vderiv_on g') T"
   assumes "\<And>x. x \<in> T \<Longrightarrow> gd' x = g' x o\<^sub>L d"
   shows "((\<lambda>x. g x o\<^sub>L d) has_vderiv_on gd') T"
   using assms
   by (auto simp: has_vderiv_on_def has_vector_derivative_def blinfun_ext blinfun.bilinear_simps
       intro!: derivative_eq_intros ext)
 
 lemma has_vderiv_on_blinfun_compose_left[derivative_intros]:
   assumes "(g has_vderiv_on g') T"
   assumes "\<And>x. x \<in> T \<Longrightarrow> gd' x = d o\<^sub>L g' x"
   shows "((\<lambda>x. d o\<^sub>L g x) has_vderiv_on gd') T"
   using assms
   by (auto simp: has_vderiv_on_def has_vector_derivative_def blinfun_ext blinfun.bilinear_simps
       intro!: derivative_eq_intros ext)
 
 lemma mvar_flow_shift:
   assumes "t0 \<in> existence_ivl0 x0" "t1 \<in> existence_ivl0 x0"
   shows "mvar.flow x0 t0 d t1 = Dflow (flow0 x0 t0) (t1 - t0) o\<^sub>L d"
 proof -
   have "mvar.flow x0 t0 d t1 = mvar.flow x0 t0 d (t0 + (t1 - t0))"
     by simp
   also have "\<dots> = mvar.flow x0 t0 (mvar.flow x0 t0 d t0) t1"
     by (subst mvar.flow_trans) (auto simp add: assms)
   also have "\<dots> = Dflow (flow0 x0 t0) (t1 - t0) o\<^sub>L d"
     apply (rule mvar.flow_unique_on)
        apply (auto simp add: assms mvar.flow_initial_time_if blinfun_ext Dflow_def
         intro!: derivative_intros derivative_eq_intros)
       apply (auto simp: assms has_vderiv_on_open has_vector_derivative_def
         intro!: derivative_eq_intros blinfun_eqI)
      apply (subst mvar_existence_ivl_eq_existence_ivl)
     by (auto simp add: vareq_trans assms diff_existence_ivl_trans)
   finally show ?thesis .
 qed
 
 lemma Dflow_trans:
   assumes "h \<in> existence_ivl0 x0"
   assumes "i \<in> existence_ivl0 (flow0 x0 h)"
   shows "Dflow x0 (h + i) = Dflow (flow0 x0 h) i o\<^sub>L (Dflow x0 h)"
 proof -
   have [intro, simp]: "h + i \<in> existence_ivl0 x0" "i + h \<in> existence_ivl0 x0" "x0 \<in> X"
     using assms
     by (auto simp add: add.commute existence_ivl_trans)
   show ?thesis
     unfolding Dflow_def
     apply (subst mvar.flow_trans[where s=h and t=i])
     subgoal by (auto simp: assms)
     subgoal by (auto simp: assms)
     by (subst mvar_flow_shift) (auto simp: assms Dflow_def )
 qed
 
 lemma Dflow_trans_apply:
   assumes "h \<in> existence_ivl0 x0"
   assumes "i \<in> existence_ivl0 (flow0 x0 h)"
   shows "Dflow x0 (h + i) d0 = Dflow (flow0 x0 h) i (Dflow x0 h d0)"
 proof -
   have [intro, simp]: "h + i \<in> existence_ivl0 x0" "i + h \<in> existence_ivl0 x0" "x0 \<in> X"
     using assms
     by (auto simp add: add.commute existence_ivl_trans)
   show ?thesis
     unfolding Dflow_def
     apply (subst mvar.flow_trans[where s=h and t=i])
     subgoal by (auto simp: assms)
     subgoal by (auto simp: assms)
     by (subst mvar_flow_shift) (auto simp: assms Dflow_def )
 qed
 
 
 end \<comment> \<open>@{thm c1_on_open_euclidean_anchor}\<close>
 
 end
diff --git a/thys/Poincare_Bendixson/Limit_Set.thy b/thys/Poincare_Bendixson/Limit_Set.thy
--- a/thys/Poincare_Bendixson/Limit_Set.thy
+++ b/thys/Poincare_Bendixson/Limit_Set.thy
@@ -1,473 +1,474 @@
 section \<open>Limit Sets\<close>
 theory Limit_Set
   imports Invariance
 begin
 
 context auto_ll_on_open begin
 text \<open>Positive limit point, assuming \<open>{0..} \<subseteq> existence_ivl0 x\<close>\<close>
 
 (* TODO: Perhaps a more intrinsic definition would be better here *)
 definition "\<omega>_limit_point x p \<longleftrightarrow>
   {0..} \<subseteq> existence_ivl0 x \<and>
   (\<exists>s. s \<longlonglongrightarrow>\<^bsub>\<^esub> \<infinity> \<and> (flow0 x \<circ> s) \<longlonglongrightarrow> p)"
 
 text \<open> Also called the \<open>\<omega>\<close>-limit set of x \<close>
 definition "\<omega>_limit_set x = {p. \<omega>_limit_point x p}"
 
 definition "\<alpha>_limit_point x p \<longleftrightarrow>
   {..0} \<subseteq> existence_ivl0 x \<and>
   (\<exists>s. s \<longlonglongrightarrow>\<^bsub>\<^esub> -\<infinity> \<and> (flow0 x \<circ> s) \<longlonglongrightarrow> p)"
 
 text \<open> Also called the \<open>\<alpha>\<close>-limit set of x \<close>
 definition "\<alpha>_limit_set x =
   {p. \<alpha>_limit_point x p}"
 
 end context auto_ll_on_open begin
 
 lemma \<alpha>_limit_point_eq_rev: "\<alpha>_limit_point x p = rev.\<omega>_limit_point x p"
   unfolding \<alpha>_limit_point_def rev.\<omega>_limit_point_def
   apply (auto simp: rev_eq_flow[abs_def] o_def filterlim_uminus_at_bot rev_existence_ivl_eq0 subset_iff
       intro: exI[where x="uminus o s" for s])
   using neg_0_le_iff_le by fastforce
 
 lemma \<alpha>_limit_set_eq_rev: "\<alpha>_limit_set x = rev.\<omega>_limit_set x"
   unfolding \<alpha>_limit_set_def rev.\<omega>_limit_set_def \<alpha>_limit_point_eq_rev ..
 
 lemma \<omega>_limit_pointE:
   assumes "\<omega>_limit_point x p"
   obtains s where
     "filterlim s at_top sequentially"
     "(flow0 x \<circ> s) \<longlonglongrightarrow> p"
     "\<forall>n. b \<le> s n"
   using assms filterlim_at_top_choose_lower \<omega>_limit_point_def by blast
 
 lemma \<omega>_limit_set_eq:
   assumes "{0..} \<subseteq> existence_ivl0 x"
   shows "\<omega>_limit_set x = (INF \<tau> \<in> {0..}. closure (flow0 x ` {\<tau>..}))"
   unfolding \<omega>_limit_set_def
 proof safe
   fix p t
   assume pt: "0 \<le> (t::real)" "\<omega>_limit_point x p"
   from \<omega>_limit_pointE[OF pt(2)]
   obtain s where
     "filterlim s at_top sequentially"
     "(flow0 x \<circ> s) \<longlonglongrightarrow> p"
     "\<forall>n. t \<le> s n" by blast
   thus "p \<in> closure (flow0 x ` {t..})" unfolding closure_sequential
     by (metis atLeast_iff comp_apply imageI)
 next
   fix p
   assume "p \<in> (\<Inter>\<tau>\<in>{0..}. closure (flow0 x ` {\<tau>..}))"
   then have "\<And>t. t \<ge>0 \<Longrightarrow> p \<in> closure (flow0 x ` {t..})" by blast
   then have "\<And>t e. t \<ge>0 \<Longrightarrow> e > 0 \<Longrightarrow> (\<exists>tt \<ge> t. dist (flow0 x tt) p < e)"
     unfolding closure_approachable
     by fastforce
   from approachable_sequenceE[OF this]
   obtain s where "filterlim s at_top sequentially" "(flow0 x \<circ> s) \<longlonglongrightarrow> p" by auto
   thus "\<omega>_limit_point x p" unfolding \<omega>_limit_point_def using assms by auto
 qed
 
 lemma \<omega>_limit_set_empty:
   assumes "\<not> ({0..} \<subseteq> existence_ivl0 x)"
   shows "\<omega>_limit_set x = {}"
   unfolding \<omega>_limit_set_def \<omega>_limit_point_def
   by (simp add: assms)
 
 lemma \<omega>_limit_set_closed: "closed (\<omega>_limit_set x)"
   using \<omega>_limit_set_eq
   by (metis \<omega>_limit_set_empty closed_INT closed_closure closed_empty)
 
 (* TODO: Walter gives a more direct proof *)
 lemma \<omega>_limit_set_positively_invariant:
   shows "positively_invariant (\<omega>_limit_set x)"
   unfolding positively_invariant_def trapped_forward_def
 proof safe
   fix dummy p t
   assume xa: "p \<in> \<omega>_limit_set x"
     "t \<in> existence_ivl0 p"
     "0 \<le> t"
   have "p \<in> X" using mem_existence_ivl_iv_defined(2) xa(2) by blast
   have exist: "{0..} \<subseteq> existence_ivl0 x" using xa(1)
     unfolding \<omega>_limit_set_def \<omega>_limit_point_def by auto
   from xa(1)
   obtain s where s:
     "filterlim s at_top sequentially"
     "(flow0 x \<circ> s) \<longlonglongrightarrow> p"
     "\<forall>n. 0 \<le> s n"
     unfolding \<omega>_limit_set_def by (auto elim!:\<omega>_limit_pointE)
   define r where "r = (\<lambda>n. t + s n)"
   have rlim: "filterlim r at_top sequentially" unfolding r_def
     by (auto intro: filterlim_tendsto_add_at_top[OF _ s(1)])
   define dom where "dom = image (flow0 x) {0..} \<union> {p} "
   have domin: "\<forall>n. (flow0 x \<circ> s) n \<in> dom" "p \<in> dom" unfolding dom_def o_def
     using exist by(auto simp add: s(3))
   have xt: "\<And>x. x \<in> dom \<Longrightarrow> t \<in> existence_ivl0 x" unfolding dom_def using xa(2)
     apply auto
     apply (rule existence_ivl_trans')
     using exist xa(3) apply auto[1]
     using exist  by auto
   have cont: "continuous_on dom (\<lambda>x. flow0 x t)"
     apply (rule flow_continuous_on_compose)
        apply auto
     using \<open>p \<in> X\<close>  exist local.dom_def local.flow_in_domain apply auto[1]
     using xt .
   then have f1: "((\<lambda>x. flow0 x t) \<circ> (flow0 x \<circ> s)) \<longlonglongrightarrow> flow0 p t" using domin s(2)
     unfolding continuous_on_sequentially
     by blast
   have ff:"\<And>n. (flow0 x \<circ> r) n = ((\<lambda>x. flow0 x t) \<circ> (flow0 x \<circ> s)) n"
     unfolding o_def r_def
   proof -
     fix n
     have s:"s n \<in> existence_ivl0 x"
       using s(3) exist by auto
     then have t:"t \<in> existence_ivl0 (flow0 x (s n))"
       using domin(1) xt by auto
     from flow_trans[OF s t]
     show "flow0 x (t + s n) = flow0 (flow0 x (s n)) t"
       by (simp add: add.commute)
   qed
   have f2: "(flow0 x \<circ> r) \<longlonglongrightarrow> flow0 p t" using f1 unfolding ff .
   show "flow0 p t \<in> \<omega>_limit_set x" using exist f2 rlim
     unfolding \<omega>_limit_set_def \<omega>_limit_point_def
     using flow_in_domain r_def s(3) xa(2) xa(3) by auto
 qed
 
 lemma \<omega>_limit_set_invariant:
   shows "invariant (\<omega>_limit_set x)"
   unfolding invariant_iff_pos_invariant_and_compl_pos_invariant
 proof safe
   show "positively_invariant (\<omega>_limit_set x)"
     using \<omega>_limit_set_positively_invariant .
 next
   show "positively_invariant (X - \<omega>_limit_set x)"
     unfolding positively_invariant_def trapped_forward_def
     apply safe
     using local.flow_in_domain apply blast
   proof -
     fix dummy p t 
     assume xa: "p \<in> X" "p \<notin> \<omega>_limit_set x"
       "t \<in> existence_ivl0 p" "0 \<le> t"
       and f: "flow0 p t \<in> \<omega>_limit_set x"
     have exist: "{0..} \<subseteq> existence_ivl0 x" using f
       unfolding \<omega>_limit_set_def \<omega>_limit_point_def by auto
     from f
     obtain s where s:
       "filterlim s at_top sequentially"
       "(flow0 x \<circ> s) \<longlonglongrightarrow> flow0 p t"
       "\<forall>n. t \<le> s n"
       unfolding \<omega>_limit_set_def by (auto elim!:\<omega>_limit_pointE)
     define r where "r = (\<lambda>n. (-t) + s n)"
     have "(\<lambda>x. -t) \<longlonglongrightarrow> -t" by simp
     from filterlim_tendsto_add_at_top[OF this s(1)]
     have rlim: "filterlim r at_top sequentially" unfolding r_def by simp
     define dom where "dom = image (flow0 x) {t..} \<union> {flow0 p t} "
     have domin: "\<forall>n. (flow0 x \<circ> s) n \<in> dom" "flow0 p t \<in> dom" unfolding dom_def o_def
       using exist by(auto simp add: s(3))
     have xt: "\<And>x. x \<in> dom \<Longrightarrow> -t \<in> existence_ivl0 x" unfolding dom_def using xa(2)
       apply auto
       using local.existence_ivl_reverse xa(3) apply auto[1]
       by (metis exist atLeast_iff diff_conv_add_uminus diff_ge_0_iff_ge linordered_ab_group_add_class.zero_le_double_add_iff_zero_le_single_add local.existence_ivl_trans' order_trans subset_iff xa(4))
     have cont: "continuous_on dom (\<lambda>x. flow0 x (-t))"
       apply (rule flow_continuous_on_compose)
          apply auto
       using local.mem_existence_ivl_iv_defined(2) xt apply blast
       by (simp add: xt)
     then have f1: "((\<lambda>x. flow0 x (-t)) \<circ> (flow0 x \<circ> s)) \<longlonglongrightarrow> flow0 (flow0 p t) (-t)" using domin s(2)
       unfolding continuous_on_sequentially
       by blast
     have ff:"\<And>n. (flow0 x \<circ> r) n = ((\<lambda>x. flow0 x (-t)) \<circ> (flow0 x \<circ> s)) n"
       unfolding o_def r_def
     proof -
       fix n
       have s:"s n \<in> existence_ivl0 x"
         using s(3) exist \<open>0\<le> t\<close> by (meson atLeast_iff order_trans subset_eq)
       then have t:"-t \<in> existence_ivl0 (flow0 x (s n))"
         using domin(1) xt by auto
       from flow_trans[OF s t]
       show "flow0 x (-t + s n) = flow0 (flow0 x (s n)) (-t)"
         by (simp add: add.commute)
     qed
     have "(flow0 x \<circ> r) \<longlonglongrightarrow> flow0 (flow0 p t) (-t)" using f1 unfolding ff .
     then have f2: "(flow0 x \<circ> r) \<longlonglongrightarrow> p" using flows_reverse xa(3) by auto
     then have "p \<in> \<omega>_limit_set x" unfolding \<omega>_limit_set_def \<omega>_limit_point_def
       using rlim exist by auto
     thus False using xa(2) by auto
   qed
 qed
 
 end context auto_ll_on_open begin
 
 lemma \<alpha>_limit_set_eq:
   assumes "{..0} \<subseteq> existence_ivl0 x"
   shows "\<alpha>_limit_set x = (INF \<tau> \<in> {..0}. closure (flow0 x ` {..\<tau>}))"
   using rev.\<omega>_limit_set_eq[of x, OF assms[folded infinite_rev_existence_ivl0_rewrites]]
   unfolding \<alpha>_limit_set_eq_rev rev_flow_image_eq image_uminus_atLeast 
   by (smt INT_extend_simps(10) Sup.SUP_cong image_uminus_atMost)
 
 lemma \<alpha>_limit_set_closed:
   shows "closed (\<alpha>_limit_set x)"
   unfolding \<alpha>_limit_set_eq_rev by (rule rev.\<omega>_limit_set_closed)
 
 lemma \<alpha>_limit_set_positively_invariant:
   shows "negatively_invariant (\<alpha>_limit_set x)"
   unfolding negatively_invariant_eq_rev \<alpha>_limit_set_eq_rev
   by (simp add: rev.\<omega>_limit_set_positively_invariant)
 
 lemma \<alpha>_limit_set_invariant:
   shows "invariant (\<alpha>_limit_set x)"
   unfolding invariant_eq_rev \<alpha>_limit_set_eq_rev
   by (simp add: rev.\<omega>_limit_set_invariant)
 
 text \<open> Fundamental properties of the positive limit set \<close>
 
 context
   fixes x K
   assumes K: "compact K" "K \<subseteq> X"
   assumes x: "x \<in> X" "trapped_forward x K"
 begin
 
 text \<open>Bunch of facts for what's to come\<close>
 private lemma props:
   shows "{0..} \<subseteq> existence_ivl0 x" "seq_compact K"
    apply (rule trapped_sol_right)
   using x K by (auto simp add: compact_imp_seq_compact)
 
 private lemma flowimg:
   shows "flow0 x ` (existence_ivl0 x \<inter> {0..}) = flow0 x ` {0..}"
   using props(1) by auto
 
 lemma \<omega>_limit_set_in_compact_subset:
   shows "\<omega>_limit_set x \<subseteq> K"
   unfolding \<omega>_limit_set_def
 proof safe
   fix p s
   assume "\<omega>_limit_point x p"
   from \<omega>_limit_pointE[OF this]
   obtain s where s:
     "filterlim s at_top sequentially"
     "(flow0 x \<circ> s) \<longlonglongrightarrow> p"
     "\<forall>n. 0 \<le> s n" by blast
   then have fin: "\<forall>n. (flow0 x \<circ> s) n \<in> K" using s(3) x K props(1)
     unfolding trapped_forward_def
     by (simp add: subset_eq)
   from seq_compactE[OF props(2) fin]
   show "p \<in> K" using s(2)
     by (metis LIMSEQ_subseq_LIMSEQ LIMSEQ_unique)
 qed
 
 lemma \<omega>_limit_set_in_compact_compact:
   shows "compact (\<omega>_limit_set x)"
 proof -
   from \<omega>_limit_set_in_compact_subset 
   have "bounded (\<omega>_limit_set x)"
     using bounded_subset compact_imp_bounded
     using K(1) by auto
   thus ?thesis using \<omega>_limit_set_closed
     by (simp add: compact_eq_bounded_closed)
 qed
 
 lemma \<omega>_limit_set_in_compact_nonempty:
   shows "\<omega>_limit_set x \<noteq> {}"
 proof -
   have fin: "\<forall>n. (flow0 x \<circ> real) n \<in> K" using x K props(1)
     by (simp add: flowimg image_subset_iff trapped_forward_def)
   from seq_compactE[OF props(2) this]
   obtain r l where "l \<in> K" "strict_mono r" "(flow0 x \<circ> real \<circ> r) \<longlonglongrightarrow> l" by blast
   then have "\<omega>_limit_point x l" unfolding \<omega>_limit_point_def using props(1)
     by (smt comp_def filterlim_sequentially_iff_filterlim_real filterlim_subseq tendsto_at_top_eq_left)
   thus ?thesis unfolding \<omega>_limit_set_def by auto
 qed
 
 lemma \<omega>_limit_set_in_compact_existence:
   shows "\<And>y. y \<in> \<omega>_limit_set x \<Longrightarrow> existence_ivl0 y = UNIV"
 proof -
   fix y
   assume y: "y \<in> \<omega>_limit_set x"
   then have "y \<in> X" using \<omega>_limit_set_in_compact_subset K by blast 
   from \<omega>_limit_set_invariant
   have "\<And>t. t \<in> existence_ivl0 y \<Longrightarrow> flow0 y t \<in> \<omega>_limit_set x"
     unfolding invariant_def trapped_iff_on_existence_ivl0 using y by blast 
   then have t: "\<And>t. t \<in> existence_ivl0 y \<Longrightarrow> flow0 y t \<in> K"
     using \<omega>_limit_set_in_compact_subset by blast
   thus "existence_ivl0 y = UNIV" 
     by (meson \<open>y \<in> X\<close> existence_ivl_zero existence_ivl_initial_time_iff existence_ivl_subset mem_compact_implies_subset_existence_interval subset_antisym K)
 qed
 
 lemma \<omega>_limit_set_in_compact_tendsto:
   shows "((\<lambda>t. infdist (flow0 x t) (\<omega>_limit_set x)) \<longlongrightarrow> 0) at_top"
 proof (rule ccontr)
   assume "\<not> ((\<lambda>t. infdist (flow0 x t) (\<omega>_limit_set x)) \<longlongrightarrow> 0) at_top"
   from not_tendsto_frequentlyE[OF this]
   obtain S where S: "open S" "0 \<in> S"
     "\<exists>\<^sub>F t in at_top. infdist (flow0 x t) (\<omega>_limit_set x) \<notin> S" .
   then obtain e where "e > 0" "ball 0 e \<subseteq> S" using openE by blast
   then have "\<And>x. x \<ge>0 \<Longrightarrow> x \<notin> S \<Longrightarrow> x \<ge> e" by force
   then have "\<forall>xa. infdist (flow0 x xa) (\<omega>_limit_set x) \<notin> S \<longrightarrow>
         infdist (flow0 x xa) (\<omega>_limit_set x) \<ge> e" using infdist_nonneg by blast  
   from frequently_mono[OF this S(3)]
   have "\<exists>\<^sub>F t in at_top. infdist (flow0 x t) (\<omega>_limit_set x) \<ge> e" by blast
   then have "\<forall>n. \<exists>\<^sub>F t in at_top. infdist (flow0 x t) (\<omega>_limit_set x) \<ge> e \<and> real n \<le> t"
     by (auto intro!: eventually_frequently_conj)
   from frequently_at_topE[OF this]
   obtain s where s: "\<And>i. e \<le> infdist (flow0 x (s i)) (\<omega>_limit_set x)"
     "\<And>i. real i \<le> s i" "strict_mono s" by force
   then have sf: "filterlim s at_top sequentially"
     using filterlim_at_top_mono filterlim_real_sequentially not_eventuallyD by blast 
   have fin: "\<forall>n. (flow0 x \<circ> s) n \<in> K"  using x K props(1) s unfolding flowimg trapped_forward_def
     by (metis atLeast_iff comp_apply image_subset_iff of_nat_0_le_iff order_trans)
   from seq_compactE[OF props(2) this]
   obtain r l where r:"strict_mono r" and l: "l \<in> K" "(flow0 x \<circ> s \<circ> r) \<longlonglongrightarrow> l" by blast
   moreover from filterlim_at_top_strict_mono[OF s(3) r(1) sf]
   have "filterlim (s \<circ> r) at_top sequentially" .
   moreover have "\<omega>_limit_point x l" unfolding \<omega>_limit_point_def using props(1) calculation
     by (metis comp_assoc)
   ultimately have "infdist l (\<omega>_limit_set x) = 0" by (simp add: \<omega>_limit_set_def)
   then have c1:"((\<lambda>y. infdist y (\<omega>_limit_set x)) \<circ> (flow0 x \<circ> s \<circ> r)) \<longlonglongrightarrow> 0"
     by (auto intro!: tendsto_compose_at[OF l(2)] tendsto_eq_intros)
   have c2: "\<And>i. e \<le> infdist (flow0 x ((s \<circ> r) i)) (\<omega>_limit_set x)" using s(1) by simp
   show False using c1 c2 \<open>e > 0\<close> unfolding o_def
     using Lim_bounded2
     by (metis (no_types, lifting) ball_eq_empty centre_in_ball empty_iff)
 qed
 
 lemma \<omega>_limit_set_in_compact_connected:
   shows "connected (\<omega>_limit_set x)"
   unfolding connected_closed_set[OF \<omega>_limit_set_closed]
 proof clarsimp
   fix Apre Bpre
   assume pre: "closed Apre" "Apre \<union> Bpre = \<omega>_limit_set x" "closed Bpre"
     "Apre \<noteq> {}" "Bpre \<noteq> {}" "Apre \<inter> Bpre = {}"
     (* TODO: this move is very strange *)
   then obtain A B where "Apre \<subseteq> A" "Bpre \<subseteq> B" "open A" "open B" and disj:"A \<inter> B = {}"
     by (meson t4_space)
   then have "\<omega>_limit_set x \<subseteq> A \<union> B"
     "\<omega>_limit_set x \<inter> A \<noteq> {}" "\<omega>_limit_set x \<inter> B \<noteq> {}" using pre by auto
   then obtain p q where
     p: "\<omega>_limit_point x p" "p \<in> A"
     and q: "\<omega>_limit_point x q" "q \<in> B"
     using \<omega>_limit_set_def by auto
   from \<omega>_limit_pointE[OF p(1)]
   obtain ps where ps: "filterlim ps at_top sequentially"
     "(flow0 x \<circ> ps) \<longlonglongrightarrow> p" "\<forall>n. 0 \<le> ps n" by blast
   from \<omega>_limit_pointE[OF q(1)]
   obtain qs where qs: "filterlim qs at_top sequentially"
     "(flow0 x \<circ> qs) \<longlonglongrightarrow> q" "\<forall>n. 0 \<le> qs n" by blast
   have "\<forall>n. \<exists>\<^sub>F t in at_top. flow0 x t \<notin> A \<and> flow0 x t \<notin> B" unfolding frequently_at_top
   proof safe
     fix dummy mpre
     obtain m where "m \<ge> (0::real)" "m > mpre"
       by (meson approximation_preproc_push_neg(1) gt_ex le_cases order_trans) 
     from ps obtain a where a:"a > m" "(flow0 x a) \<in> A"
       using \<open>open A\<close> p unfolding tendsto_def filterlim_at_top eventually_sequentially
       by (metis approximation_preproc_push_neg(1) comp_apply gt_ex le_cases order_trans)
     from qs obtain b where b:"b > a" "(flow0 x b) \<in> B"
       using \<open>open B\<close> q unfolding tendsto_def filterlim_at_top eventually_sequentially
       by (metis approximation_preproc_push_neg(1) comp_apply gt_ex le_cases order_trans)
     have "continuous_on {a..b} (flow0 x)"
       by (metis Icc_subset_Ici_iff \<open>0 \<le> m\<close> \<open>m < a\<close> approximation_preproc_push_neg(2) atMost_iff atMost_subset_iff continuous_on_subset le_cases local.flow_continuous_on props(1) subset_eq)
     from connected_continuous_image[OF this connected_Icc]
     have c:"connected (flow0 x ` {a..b})" .
     have "\<exists>t\<in> {a..b}. flow0 x t \<notin> A \<and> flow0 x t \<notin> B"
     proof (rule ccontr)
       assume "\<not> (\<exists>t\<in>{a..b}. flow0 x t \<notin> A \<and> flow0 x t \<notin> B)"
       then have "flow0 x ` {a..b} \<subseteq> A \<union> B" by blast
       from topological_space_class.connectedD[OF c \<open>open A\<close> \<open>open B\<close> _ this]
       show False using a b disj by force
     qed
     thus "\<exists>n>mpre. flow0 x n \<notin> A \<and> flow0 x n \<notin> B"
       by (smt \<open>mpre < m\<close> a(1) atLeastAtMost_iff)
   qed
   from frequently_at_topE'[OF this filterlim_real_sequentially]
   obtain s where s: "\<forall>i. flow0 x (s i) \<notin> A \<and> flow0 x (s i) \<notin> B"
     "strict_mono s" "\<And>n. real n \<le> s n" by blast
   then have "\<forall>n. (flow0 x \<circ> s) n \<in> K"
     by (smt atLeast_iff comp_apply flowimg image_subset_iff of_nat_0_le_iff trapped_forward_def x(2))
   from seq_compactE[OF props(2) this]
   obtain r l where r: "l \<in> K" "strict_mono r" "(flow0 x \<circ> s \<circ> r) \<longlonglongrightarrow> l" by blast
   have "filterlim s at_top sequentially"
     using s filterlim_at_top_mono filterlim_real_sequentially not_eventuallyD by blast 
   from filterlim_at_top_strict_mono[OF s(2) r(2) this]
   have "filterlim (s \<circ> r) at_top sequentially" .
   then have "\<omega>_limit_point x l" unfolding \<omega>_limit_point_def using props(1) r
     by (metis comp_assoc)
   moreover have "l \<notin> A" using s(1) r(3) \<open>open A\<close> unfolding tendsto_def by auto
   moreover have "l \<notin> B" using s(1) r(3) \<open>open B\<close> unfolding tendsto_def by auto
   ultimately show False using \<open>\<omega>_limit_set x \<subseteq> A \<union> B\<close> unfolding \<omega>_limit_set_def
     by auto
 qed
 
 lemma \<omega>_limit_set_in_compact_\<omega>_limit_set_contained:
   shows "\<forall>y \<in> \<omega>_limit_set x. \<omega>_limit_set y \<subseteq> \<omega>_limit_set x"
 proof safe
   fix y z
   assume "y \<in> \<omega>_limit_set x" "z \<in> \<omega>_limit_set y"
   then have "\<omega>_limit_point y z" unfolding \<omega>_limit_set_def by auto
   from \<omega>_limit_pointE[OF this]
   obtain s where s: "(flow0 y \<circ> s) \<longlonglongrightarrow> z" .
   have "\<forall>n. (flow0 y \<circ> s) n \<in> \<omega>_limit_set x"
     using \<open>y \<in> \<omega>_limit_set x\<close> invariant_def
       \<omega>_limit_set_in_compact_existence \<omega>_limit_set_invariant trapped_iff_on_existence_ivl0
     by force
   thus "z \<in> \<omega>_limit_set x" using closed_sequential_limits s \<omega>_limit_set_closed
     by blast
 qed
 
 lemma \<omega>_limit_set_in_compact_\<alpha>_limit_set_contained:
   assumes zpx: "z \<in> \<omega>_limit_set x"
   shows "\<alpha>_limit_set z \<subseteq> \<omega>_limit_set x"
 proof
   fix w assume "w \<in> \<alpha>_limit_set z"
   then obtain s where s: "(flow0 z \<circ> s) \<longlonglongrightarrow> w"
     unfolding \<alpha>_limit_set_def \<alpha>_limit_point_def
     by auto
   from \<omega>_limit_set_invariant have "invariant (\<omega>_limit_set x)" .
   then have "\<forall>n. (flow0 z \<circ> s) n \<in> \<omega>_limit_set x"
     using \<omega>_limit_set_in_compact_existence[OF zpx] zpx
     using invariant_def trapped_iff_on_existence_ivl0 by fastforce
-  from closed_sequentially[OF \<omega>_limit_set_closed this s]
-  show "w \<in> \<omega>_limit_set x" .
+  from closed_sequentially[OF \<omega>_limit_set_closed] this s
+  show "w \<in> \<omega>_limit_set x"
+    by blast
 qed
 
 end
 
 text \<open> Fundamental properties of the negative limit set \<close>
 
 end context auto_ll_on_open begin
 
 context
   fixes x K
   assumes x: "x \<in> X" "trapped_backward x K"
   assumes K: "compact K" "K \<subseteq> X"
 begin
 
 private lemma xrev: "x \<in> X" "rev.trapped_forward x K"
   using trapped_backward_iff_rev_trapped_forward x(2) 
   by (auto simp: rev_existence_ivl_eq0 rev_eq_flow x(1))
 
 lemma \<alpha>_limit_set_in_compact_subset: "\<alpha>_limit_set x \<subseteq> K"
   and \<alpha>_limit_set_in_compact_compact: "compact (\<alpha>_limit_set x)"
   and \<alpha>_limit_set_in_compact_nonempty: "\<alpha>_limit_set x \<noteq> {}"
   and \<alpha>_limit_set_in_compact_connected: "connected (\<alpha>_limit_set x)"
   and \<alpha>_limit_set_in_compact_\<alpha>_limit_set_contained:
   "\<forall>y \<in> \<alpha>_limit_set x. \<alpha>_limit_set y \<subseteq> \<alpha>_limit_set x"
   and \<alpha>_limit_set_in_compact_tendsto: "((\<lambda>t. infdist (flow0 x t) (\<alpha>_limit_set x)) \<longlongrightarrow> 0) at_bot"
   using rev.\<omega>_limit_set_in_compact_subset[OF K xrev]
   using rev.\<omega>_limit_set_in_compact_compact[OF K xrev]
   using rev.\<omega>_limit_set_in_compact_nonempty[OF K xrev]
   using rev.\<omega>_limit_set_in_compact_connected[OF K xrev]
   using rev.\<omega>_limit_set_in_compact_\<omega>_limit_set_contained[OF K xrev]
   using rev.\<omega>_limit_set_in_compact_tendsto[OF K xrev]
   unfolding invariant_eq_rev \<alpha>_limit_set_eq_rev existence_ivl_eq_rev flow_eq_rev0 filterlim_at_bot_mirror
     minus_minus
   .
 
 lemma \<alpha>_limit_set_in_compact_existence:
   shows "\<And>y. y \<in> \<alpha>_limit_set x \<Longrightarrow> existence_ivl0 y = UNIV"
   using rev.\<omega>_limit_set_in_compact_existence[OF K xrev]
   unfolding \<alpha>_limit_set_eq_rev existence_ivl_eq_rev0
   by auto
 
 end
 end
 
 end
diff --git a/thys/Poincare_Bendixson/ODE_Misc.thy b/thys/Poincare_Bendixson/ODE_Misc.thy
--- a/thys/Poincare_Bendixson/ODE_Misc.thy
+++ b/thys/Poincare_Bendixson/ODE_Misc.thy
@@ -1,1111 +1,1112 @@
 section \<open>Additions to the ODE Library\<close>
 theory ODE_Misc
   imports
     Ordinary_Differential_Equations.ODE_Analysis
     Analysis_Misc
 begin
 
 lemma local_lipschitz_compact_bicomposeE:
   assumes ll: "local_lipschitz T X f"
   assumes cf: "\<And>x. x \<in> X \<Longrightarrow> continuous_on I (\<lambda>t. f t x)"
   assumes cI: "compact I"
   assumes "I \<subseteq> T"
   assumes cv: "continuous_on I v"
   assumes cw: "continuous_on I w"
   assumes v: "v ` I \<subseteq> X"
   assumes w: "w ` I \<subseteq> X"
   obtains L where "L > 0" "\<And>x. x \<in> I \<Longrightarrow> dist (f x (v x)) (f x (w x)) \<le> L * dist (v x) (w x)"
 proof -
   from v w have "v ` I \<union> w ` I \<subseteq> X" by auto
   with ll \<open>I \<subseteq> T\<close> have llI:"local_lipschitz I (v ` I \<union> w ` I) f"
     by (rule local_lipschitz_subset)
   have cvwI: "compact (v ` I \<union> w ` I)"
     by (auto intro!: compact_continuous_image cv cw cI)    
 
   from local_lipschitz_compact_implies_lipschitz[OF llI cvwI \<open>compact I\<close> cf]
   obtain L where L: "\<And>t. t \<in> I \<Longrightarrow> L-lipschitz_on (v ` I \<union> w ` I) (f t)"
     using v w
     by blast
   define L' where "L' = max L 1"
   with L have "L' > 0" "\<And>x. x \<in> I \<Longrightarrow> dist (f x (v x)) (f x (w x)) \<le> L' * dist (v x) (w x)"
      apply (auto simp: lipschitz_on_def L'_def)
     by (smt Un_iff image_eqI mult_right_mono zero_le_dist)
   then show ?thesis ..
 qed
 
 subsection \<open>Comparison Principle\<close>
 
 lemma comparison_principle_le:
   fixes f::"real \<Rightarrow> real \<Rightarrow> real"
     and \<phi> \<psi>::"real \<Rightarrow> real"
   assumes ll: "local_lipschitz X Y f"
   assumes cf: "\<And>x. x \<in> Y \<Longrightarrow> continuous_on {a..b} (\<lambda>t. f t x)"
   assumes abX: "{a .. b} \<subseteq> X"
   assumes \<phi>': "\<And>x. x \<in> {a .. b} \<Longrightarrow> (\<phi> has_real_derivative \<phi>' x) (at x)"
   assumes \<psi>': "\<And>x. x \<in> {a .. b} \<Longrightarrow> (\<psi> has_real_derivative \<psi>' x) (at x)"
   assumes \<phi>_in: "\<phi> ` {a..b} \<subseteq> Y"
   assumes \<psi>_in: "\<psi> ` {a..b} \<subseteq> Y"
   assumes init: "\<phi> a \<le> \<psi> a"
   assumes defect: "\<And>x. x \<in> {a .. b} \<Longrightarrow> \<phi>' x - f x (\<phi> x) \<le> \<psi>' x - f x (\<psi> x)"
   shows "\<forall>x \<in> {a .. b}. \<phi> x \<le> \<psi> x" (is "?th1")
     (*
     "(\<forall>x \<in> {a .. b}. \<phi> x < \<psi> x) \<or> (\<exists>c\<in>{a..b}. (\<forall>x\<in>{a..c}. \<phi> x \<le> \<psi> x) \<and> (\<forall>x\<in>{c<..b}. \<phi> x < \<psi> x))"
     (is "?th2")
 *)
   unfolding atomize_conj
   apply (cases "a \<le> b")
    defer subgoal by simp
 proof -
   assume "a \<le> b"
   note \<phi>_cont = has_real_derivative_imp_continuous_on[OF \<phi>']
   note \<psi>_cont = has_real_derivative_imp_continuous_on[OF \<psi>']
   from local_lipschitz_compact_bicomposeE[OF ll cf compact_Icc abX \<phi>_cont \<psi>_cont \<phi>_in \<psi>_in]
   obtain L where L: "L > 0" "\<And>x. x \<in> {a..b} \<Longrightarrow> dist (f x (\<phi> x)) (f x (\<psi> x)) \<le> L * dist (\<phi> x) (\<psi> x)" by blast
   define w where "w x = \<psi> x - \<phi> x" for x
 
   have w'[derivative_intros]: "\<And>x. x \<in> {a .. b} \<Longrightarrow> (w has_real_derivative \<psi>' x - \<phi>' x) (at x)"
     using \<phi>' \<psi>'
     by (auto simp: has_vderiv_on_def w_def[abs_def] intro!: derivative_eq_intros)
   note w_cont[continuous_intros] = has_real_derivative_imp_continuous_on[OF w', THEN continuous_on_compose2]
   have "w d \<ge> 0" if "d \<in> {a .. b}" for d
   proof (rule ccontr, unfold not_le)
     assume "w d < 0"
     let ?N = "(w -` {..0} \<inter> {a .. d})"
     from \<open>w d < 0\<close> that have "d \<in> ?N" by auto
     then have "?N \<noteq> {}" by auto
     have "closed ?N"
       unfolding compact_eq_bounded_closed
       using that
       by (intro conjI closed_vimage_Int) (auto intro!: continuous_intros)
 
     let ?N' = "{a0 \<in> {a .. d}. w ` {a0 .. d} \<subseteq> {..0}}"
     from \<open>w d < 0\<close> that have "d \<in> ?N'" by simp
     then have "?N' \<noteq> {}" by auto
     have "compact ?N'"
       unfolding compact_eq_bounded_closed
     proof
       have "?N' \<subseteq> {a .. d}" using that by auto
       then show "bounded ?N'"
         by (rule bounded_subset[rotated]) simp
       have "w u \<le> 0" if "(\<forall>n. x n \<in> ?N')" "x \<longlonglongrightarrow> l" "l \<le> u" "u \<le> d" for x l u
       proof cases
         assume "l = u"
         have "\<forall>n. x n \<in> ?N" using that(1) by force
-        from closed_sequentially[OF \<open>closed ?N\<close> this \<open>x \<longlonglongrightarrow> l\<close>]
-        show ?thesis by (auto simp: \<open>l = u\<close>)
+        from closed_sequentially[OF \<open>closed ?N\<close>] this \<open>x \<longlonglongrightarrow> l\<close>
+        show ?thesis
+          using \<open>l = u\<close> by blast
       next
         assume "l \<noteq> u" with that have "l < u" by auto
         from order_tendstoD(2)[OF \<open>x \<longlonglongrightarrow> l\<close> \<open>l < u\<close>] obtain n where "x n < u"
           by (auto dest: eventually_happens)
         with that show ?thesis using \<open>l < u\<close>
           by (auto dest!: spec[where x=n] simp: image_subset_iff)
       qed
       then show "closed ?N'"
         unfolding closed_sequential_limits
         by (auto simp: Lim_bounded Lim_bounded2)
     qed
 
     from compact_attains_inf[OF \<open>compact ?N'\<close> \<open>?N' \<noteq> {}\<close>]
     obtain a0 where a0: "a \<le> a0" "a0 \<le> d" "w ` {a0..d} \<subseteq> {..0}"
       and a0_least: "\<And>x. a \<le> x \<Longrightarrow> x \<le> d \<Longrightarrow> w ` {x..d} \<subseteq> {..0} \<Longrightarrow> a0 \<le> x"
       by auto
     have a0d: "{a0 .. d} \<subseteq> {a .. b}" using that a0
       by auto
     have L_w_bound: "L * w x \<le> \<psi>' x - \<phi>' x" if "x \<in> {a0 .. d}" for x
     proof -
       from set_mp[OF a0d that] have "x \<in> {a .. b}" .
       from defect[OF this]
       have "\<phi>' x - \<psi>' x \<le> dist (f x (\<phi> x)) (f x (\<psi> x))"
         by (simp add: dist_real_def)
       also have "\<dots> \<le> L * dist (\<phi> x) (\<psi> x)"
         using \<open>x \<in> {a .. b}\<close>
         by (rule L)
       also have "\<dots> \<le> -L * w x"
         using \<open>0 < L\<close> a0 that
         by (force simp add: dist_real_def abs_real_def w_def algebra_split_simps )
       finally show ?thesis
         by simp
     qed
     have mono: "mono_on {a0..d} (\<lambda>x. w x * exp(-L*x))"
       apply (rule mono_onI)
       apply (rule DERIV_nonneg_imp_nondecreasing, assumption)
       using a0d
       by (auto intro!: exI[where x="(\<psi>' x - \<phi>' x) * exp (- (L * x)) - exp (- (L * x)) * L * w x" for x]
           derivative_eq_intros L_w_bound simp: )
     then have "w a0 * exp (-L * a0) \<le> w d * exp (-L * d)"
       by (rule mono_onD) (use that a0 in auto)
     also have "\<dots> < 0" using \<open>w d < 0\<close> by (simp add: algebra_split_simps)
     finally have "w a0 * exp (- L * a0) < 0" .
     then have "w a0 < 0" by (simp add: algebra_split_simps)
     have "a0 \<le> a"
     proof (rule ccontr, unfold not_le)
       assume "a < a0"
       have "continuous_on {a.. a0} w"
         by (rule continuous_intros, assumption) (use a0 a0d in auto)
       from continuous_on_Icc_at_leftD[OF this \<open>a < a0\<close>]
       have "(w \<longlongrightarrow> w a0) (at_left a0)" .
       from order_tendstoD(2)[OF this \<open>w a0 < 0\<close>] have "\<forall>\<^sub>F x in at_left a0. w x < 0" .
       moreover have "\<forall>\<^sub>F x in at_left a0. a < x"
         by (rule order_tendstoD) (auto intro!: \<open>a < a0\<close>)
       ultimately have "\<forall>\<^sub>F x in at_left a0. a < x \<and> w x < 0" by eventually_elim auto
       then obtain a1' where "a1'<a0" and a1_neg: "\<And>y. y > a1' \<Longrightarrow> y < a0 \<Longrightarrow> a < y \<and> w y < 0"
         unfolding eventually_at_left_field by auto
       define a1 where "a1 = (a1' + a0)/2"
       have "a1 < a0" using \<open>a1' < a0\<close> by (auto simp: a1_def)
       have "a \<le> a1"
         using \<open>a < a0\<close> a1_neg by (force simp: a1_def)
       moreover have "a1 \<le> d"
         using \<open>a1' < a0\<close> a0(2) by (auto simp: a1_def)
       moreover have "w ` {a1..a0} \<subseteq> {..0}"
         using \<open>w a0 < 0\<close> a1_neg a0(3)
         by (auto simp: a1_def) smt
       moreover have "w ` {a0..d} \<subseteq> {..0}" using a0 by auto
       ultimately
       have "a0 \<le> a1"
         apply (intro a0_least) apply assumption apply assumption
         by (smt atLeastAtMost_iff image_subset_iff)
       with \<open>a1<a0\<close> show False by simp
     qed
     then have "a0 = a" using \<open>a \<le> a0\<close> by simp
     with \<open>w a0 < 0\<close> have "w a < 0" by simp
     with init show False
       by (auto simp: w_def)
   qed
   then show ?thesis
     by (auto simp: w_def)
 qed
 
 lemma local_lipschitz_mult:
   shows "local_lipschitz  (UNIV::real set) (UNIV::real set) (*)"
   apply (auto intro!: c1_implies_local_lipschitz[where f'="\<lambda>p. blinfun_mult_left (fst p)"])
    apply (simp add: has_derivative_mult_right mult_commute_abs)
   by (auto intro!: continuous_intros)
 
 lemma comparison_principle_le_linear:
   fixes \<phi> :: "real \<Rightarrow> real"
   assumes "continuous_on {a..b} g"
   assumes "(\<And>t. t \<in> {a..b} \<Longrightarrow> (\<phi> has_real_derivative \<phi>' t) (at t))"
   assumes "\<phi> a \<le> 0"
   assumes "(\<And>t. t \<in> {a..b} \<Longrightarrow> \<phi>' t \<le> g t *\<^sub>R \<phi> t)"
   shows "\<forall>t\<in>{a..b}. \<phi> t \<le> 0"
 proof -
   have *: "\<And>x. continuous_on {a..b} (\<lambda>t. g t * x)"
     using assms(1) continuous_on_mult_right by blast
   then have "local_lipschitz (g`{a..b}) UNIV (*)"
     using local_lipschitz_subset[OF local_lipschitz_mult] by blast 
   from local_lipschitz_compose1[OF this assms(1)]
   have "local_lipschitz {a..b} UNIV (\<lambda>t. (*) (g t))" .
   from comparison_principle_le[OF this _ _ assms(2) _ _ _ assms(3), of b "\<lambda>t.0"] * assms(4)
   show ?thesis by auto
 qed
 
 subsection \<open>Locally Lipschitz ODEs\<close>
 
 context ll_on_open_it begin
 
 lemma flow_lipschitzE:
   assumes "{a .. b} \<subseteq> existence_ivl t0 x"
   obtains L where "L-lipschitz_on {a .. b} (flow t0 x)"
 proof -
   have f': "(flow t0 x has_derivative (\<lambda>i. i *\<^sub>R f t (flow t0 x t))) (at t within {a .. b})" if "t \<in> {a .. b}" for t
     using flow_has_derivative[of t x] assms that
     by (auto simp: has_derivative_at_withinI)
 
   have "compact ((\<lambda>t. f t (flow t0 x t)) ` {a .. b})"
     using assms
     apply (auto intro!: compact_continuous_image continuous_intros)
     using local.existence_ivl_empty2 apply fastforce
      apply (meson atLeastAtMost_iff general.existence_ivl_subset in_mono)
     by (simp add: general.flow_in_domain subset_iff)
   then obtain C where "t \<in> {a .. b} \<Longrightarrow> norm (f t (flow t0 x t)) \<le> C" for t
     by (fastforce dest!: compact_imp_bounded simp: bounded_iff intro: that)
   then have "t \<in> {a..b} \<Longrightarrow> onorm (\<lambda>i. i *\<^sub>R f t (flow t0 x t)) \<le> max 0 C" for t
     apply (subst onorm_scaleR_left) 
      apply (auto simp: onorm_id max_def)
     by (metis diff_0_right diff_mono diff_self norm_ge_zero)
   from bounded_derivative_imp_lipschitz[OF f' _ this]
   have "(max 0 C)-lipschitz_on {a..b} (flow t0 x)"
     by auto
   then show ?thesis ..
 qed
 
 lemma flow_undefined0: "t \<notin> existence_ivl t0 x \<Longrightarrow> flow t0 x t = 0"
   unfolding flow_def by auto
 
 lemma csols_undefined: "x \<notin> X \<Longrightarrow> csols t0 x = {}"
   apply (auto simp: csols_def)
   using general.existence_ivl_empty2 general.existence_ivl_maximal_segment
   apply blast
   done
 
 lemmas existence_ivl_undefined = existence_ivl_empty2
 
 end
 
 subsection \<open>Reverse flow as Sublocale\<close>
 
 lemma range_preflect_0[simp]: "range (preflect 0) = UNIV"
   by (auto simp: preflect_def)
 lemma range_uminus[simp]: "range uminus = (UNIV::'a::ab_group_add set)"
   by auto
 
 context auto_ll_on_open begin
 
 sublocale rev: auto_ll_on_open "-f" rewrites "-(-f) = f"
    apply unfold_locales
   using auto_local_lipschitz auto_open_domain
   unfolding fun_Compl_def local_lipschitz_minus
   by auto
 
 lemma existence_ivl_eq_rev0: "existence_ivl0 y = uminus ` rev.existence_ivl0 y" for y
   by (auto simp: existence_ivl_eq_rev rev.existence_ivl0_def preflect_def)
 
 lemma rev_existence_ivl_eq0: "rev.existence_ivl0 y = uminus ` existence_ivl0 y" for y
   using uminus_uminus_image[of "rev.existence_ivl0 y"]
   by (simp add: existence_ivl_eq_rev0)
 
 lemma flow_eq_rev0: "flow0 y t = rev.flow0 y (-t)" for y t
   apply (cases "t \<in> existence_ivl0 y")
   subgoal
     apply (subst flow_eq_rev(2), assumption)
     apply (subst rev.flow0_def)
     by (simp add: preflect_def)
   subgoal
     apply (frule flow_undefined0)
     by (auto simp: existence_ivl_eq_rev0 rev.flow_undefined0)
   done
 
 lemma rev_eq_flow: "rev.flow0 y t = flow0 y (-t)" for y t
   apply (subst flow_eq_rev0)
   using uminus_uminus_image[of "rev.existence_ivl0 y"]
   apply -
   apply (subst (asm) existence_ivl_eq_rev0[symmetric])
   by auto
 
 lemma rev_flow_image_eq: "rev.flow0 x ` S = flow0 x ` (uminus ` S)"
   unfolding rev_eq_flow[abs_def]
   by force
 
 lemma flow_image_eq_rev: "flow0 x ` S = rev.flow0 x ` (uminus ` S)"
   unfolding rev_eq_flow[abs_def]
   by force
 
 end
 
 context c1_on_open begin
 
 sublocale rev: c1_on_open "-f" "-f'" rewrites "-(-f) = f" and "-(-f') = f'"
   by (rule c1_on_open_rev) auto
 
 end
 
 context c1_on_open_euclidean begin
 
 sublocale rev: c1_on_open_euclidean "-f" "-f'" rewrites "-(-f) = f" and "-(-f') = f'"
   by unfold_locales auto
 
 end
 
 
 subsection \<open>Autonomous LL ODE : Existence Interval and trapping on the interval\<close>
 
 lemma bdd_above_is_intervalI: "bdd_above I"
   if "is_interval I" "a \<le> b" "a \<in> I" "b \<notin> I" for I::"real set"
   by (meson bdd_above_def is_interval_1 le_cases that) 
 
 lemma bdd_below_is_intervalI: "bdd_below I"
   if "is_interval I" "a \<le> b" "a \<notin> I" "b \<in> I" for I::"real set"
   by (meson bdd_below_def is_interval_1 le_cases that) 
 
 context auto_ll_on_open begin
 
 lemma open_existence_ivl0:
   assumes x : "x \<in> X"
   shows "\<exists>a b. a < 0 \<and> 0 < b \<and> {a..b} \<subseteq> existence_ivl0 x"
 proof -
   have a1:"0 \<in> existence_ivl0 x"
     by (simp add: x)
   have a2: "open (existence_ivl0 x)"
     by (simp add: x)
   from a1 a2 obtain d where "d > 0" "ball 0 d \<subseteq> existence_ivl0 x"
     using openE by blast
   have "{-d/2..d/2} \<subseteq> ball 0 d"
     using \<open>0 < d\<close> dist_norm mem_ball by auto
   thus ?thesis
     by (smt \<open>0 < d\<close> \<open>ball 0 d \<subseteq> existence_ivl0 x\<close> divide_minus_left half_gt_zero order_trans)
 qed
 
 lemma open_existence_ivl':
   assumes x : "x \<in> X"
   obtains a where "a > 0"  "{-a..a} \<subseteq> existence_ivl0 x"
 proof -
   from open_existence_ivl0[OF assms(1)]
   obtain a b where ab: "a < 0" "0 < b" "{a..b} \<subseteq> existence_ivl0 x" by auto
   then have "min (-a) b > 0" by linarith
   have "{-min (-a) b .. min(-a) b} \<subseteq> {a..b}" by auto
   thus ?thesis using ab(3) that[OF \<open>min (-a) b > 0\<close>] by blast
 qed
 
 lemma open_existence_ivl_on_compact:
   assumes C: "C \<subseteq> X" and "compact C" "C \<noteq> {}"
   obtains a where "a > 0" "\<And>x. x \<in> C \<Longrightarrow> {-a..a} \<subseteq> existence_ivl0 x"
 proof -
   from existence_ivl_cballs
   have "\<forall>x\<in>C. \<exists>e>0. \<exists>t>0. \<forall>y\<in>cball x e. cball 0 t\<subseteq>existence_ivl0 y"
     by (metis (full_types) C Int_absorb1 Int_iff UNIV_I)
   then
   obtain d' t' where *:
     "\<forall>x\<in>C. 0 < d' x \<and> t' x > 0 \<and> (\<forall>y\<in>cball x (d' x). cball 0 (t' x) \<subseteq> existence_ivl0 y)"
     by metis
   with compactE_image[OF \<open>compact C\<close>, of C "\<lambda>x. ball x (d' x)"]
   obtain C' where "C' \<subseteq> C" and [simp]: "finite C'" and C_subset: "C \<subseteq> (\<Union>c\<in>C'. ball c (d' c))"
     by force
   from C_subset \<open>C \<noteq> {}\<close> have [simp]: "C' \<noteq> {}" by auto
   define d where "d = Min (d' ` C')"
   define t where "t = Min (t' ` C')"
   have "t > 0" using * \<open>C' \<subseteq> C\<close>
     by (auto simp: t_def)
   moreover have "{-t .. t} \<subseteq> existence_ivl0 x" if "x \<in> C" for x
   proof -
     from C_subset that \<open>C' \<subseteq> C\<close>
     obtain c where c: "c \<in> C'" "x \<in> ball c (d' c)" "c \<in> C" by force
     then have "{-t .. t} \<subseteq> cball 0 (t' c)"
       by (auto simp: abs_real_def t_def minus_le_iff)
     also
     from c have "cball 0 (t' c) \<subseteq> existence_ivl0 x"
       using *[rule_format, OF \<open>c \<in> C\<close>] by auto
     finally show ?thesis .
   qed
   ultimately show ?thesis ..
 qed
 
 definition "trapped_forward x K \<longleftrightarrow> (flow0 x ` (existence_ivl0 x \<inter> {0..}) \<subseteq> K)"
   \<comment> \<open>TODO: use this for backwards trapped, invariant, and all assumptions\<close>
 
 definition "trapped_backward x K \<longleftrightarrow> (flow0 x ` (existence_ivl0 x \<inter> {..0}) \<subseteq> K)"
 
 definition "trapped x K \<longleftrightarrow> trapped_forward x K \<and> trapped_backward x K"
 
 lemma trapped_iff_on_existence_ivl0:
   "trapped x K \<longleftrightarrow> (flow0 x ` (existence_ivl0 x) \<subseteq> K)"
   unfolding trapped_def trapped_forward_def trapped_backward_def
   apply (auto)
   by (metis IntI atLeast_iff atMost_iff image_subset_iff less_eq_real_def linorder_not_less)
 end
 
 context auto_ll_on_open begin
 
 lemma infinite_rev_existence_ivl0_rewrites:
   "{0..} \<subseteq> rev.existence_ivl0 x \<longleftrightarrow> {..0} \<subseteq> existence_ivl0 x"
   "{..0} \<subseteq> rev.existence_ivl0 x \<longleftrightarrow> {0..} \<subseteq> existence_ivl0 x"
    apply (auto simp add: rev.rev_existence_ivl_eq0 subset_iff)
   using neg_le_0_iff_le apply fastforce
   using neg_0_le_iff_le by fastforce
 
 lemma trapped_backward_iff_rev_trapped_forward:
   "trapped_backward x K  \<longleftrightarrow> rev.trapped_forward x K"
   unfolding trapped_backward_def rev.trapped_forward_def
   by (auto simp add: rev_flow_image_eq existence_ivl_eq_rev0 image_subset_iff)
 
 text \<open>If solution is trapped in a compact set at some time
   on its existence interval then it is trapped forever\<close>
 lemma trapped_sol_right:
   \<comment> \<open>TODO: when building on afp-devel (??? outdated):
     \<^url>\<open>https://bitbucket.org/isa-afp/afp-devel/commits/0c3edf9248d5389197f248c723b625c419e4d3eb\<close>\<close>
   assumes "compact K" "K \<subseteq> X"
   assumes "x \<in> X" "trapped_forward x K"
   shows "{0..} \<subseteq> existence_ivl0 x"
 proof (rule ccontr)
   assume "\<not> {0..} \<subseteq> existence_ivl0 x"
   from this obtain t where "0 \<le> t" "t \<notin> existence_ivl0 x" by blast
   then have bdd: "bdd_above (existence_ivl0 x)" 
     by (auto intro!: bdd_above_is_intervalI \<open>x \<in> X\<close>)
   from flow_leaves_compact_ivl_right [OF UNIV_I \<open>x \<in> X\<close> bdd UNIV_I assms(1-2)]
   show False by (metis assms(4) trapped_forward_def IntI atLeast_iff image_subset_iff)
 qed
 
 lemma trapped_sol_right_gen:
   assumes "compact K" "K \<subseteq> X"
   assumes "t \<in> existence_ivl0 x" "trapped_forward (flow0 x t) K"
   shows "{t..} \<subseteq> existence_ivl0 x"
 proof -
   have "x \<in> X"
     using assms(3) local.existence_ivl_empty_iff by fastforce 
   have xtk: "flow0 x t \<in> X"
     by (simp add: assms(3) local.flow_in_domain)
   from trapped_sol_right[OF assms(1-2) xtk assms(4)] have "{0..} \<subseteq> existence_ivl0 (flow0 x t)" .
   thus "{t..} \<subseteq> existence_ivl0 x"
     using existence_ivl_trans[OF assms(3)]
     by (metis add.commute atLeast_iff diff_add_cancel le_add_same_cancel1 subset_iff)
 qed
 
 lemma trapped_sol_left:
   \<comment> \<open>TODO: when building on afp-devel:
     \<^url>\<open>https://bitbucket.org/isa-afp/afp-devel/commits/0c3edf9248d5389197f248c723b625c419e4d3eb\<close>\<close>
   assumes "compact K" "K \<subseteq> X"
   assumes "x \<in> X" "trapped_backward x K"
   shows "{..0} \<subseteq> existence_ivl0 x"
 proof (rule ccontr)
   assume "\<not> {..0} \<subseteq> existence_ivl0 x"
   from this obtain t where "t \<le> 0" "t \<notin> existence_ivl0 x" by blast
   then have bdd: "bdd_below (existence_ivl0 x)" 
     by (auto intro!: bdd_below_is_intervalI \<open>x \<in> X\<close>)
   from flow_leaves_compact_ivl_left [OF UNIV_I \<open>x \<in> X\<close> bdd UNIV_I assms(1-2)]
   show False
     by (metis IntI assms(4) atMost_iff auto_ll_on_open.trapped_backward_def auto_ll_on_open_axioms image_subset_iff)
 qed
 
 lemma trapped_sol_left_gen:
   assumes "compact K" "K \<subseteq> X"
   assumes "t \<in> existence_ivl0 x" "trapped_backward (flow0 x t) K"
   shows "{..t} \<subseteq> existence_ivl0 x"
 proof -
   have "x \<in> X"
     using assms(3) local.existence_ivl_empty_iff by fastforce 
   have xtk: "flow0 x t \<in> X"
     by (simp add: assms(3) local.flow_in_domain)
   from trapped_sol_left[OF assms(1-2) xtk assms(4)] have "{..0} \<subseteq> existence_ivl0 (flow0 x t)" .
   thus "{..t} \<subseteq> existence_ivl0 x"
     using existence_ivl_trans[OF assms(3)]
     by (metis add.commute add_le_same_cancel1 atMost_iff diff_add_cancel subset_eq)
 qed
 
 lemma trapped_sol:
   assumes "compact K" "K \<subseteq> X"
   assumes "x \<in> X" "trapped x K"
   shows "existence_ivl0 x = UNIV"
   by (metis (mono_tags, lifting) assms existence_ivl_zero image_subset_iff interval local.existence_ivl_initial_time_iff local.existence_ivl_subset local.subset_mem_compact_implies_subset_existence_interval order_refl subset_antisym trapped_iff_on_existence_ivl0)
 
 (* Follows from rectification *)
 lemma regular_locally_noteq:\<comment> \<open>TODO: should be true in \<open>ll_on_open_it\<close>\<close>
   assumes "x \<in> X" "f x \<noteq> 0"
   shows "eventually (\<lambda>t. flow0 x t \<noteq> x) (at 0)"
 proof -
   have nf:"norm (f x) > 0" by (simp add: assms(2)) 
       (* By continuity of solutions and f probably *)
   obtain a where
     a: "a>0"
     "{-a--a} \<subseteq> existence_ivl0 x"
     "0 \<in> {-a--a}"
     "\<And>t. t \<in> {-a--a} \<Longrightarrow> norm(f (flow0 x t) - f (flow0 x 0)) \<le> norm(f x)/2"
   proof -
     from open_existence_ivl'[OF assms(1)]
     obtain a1 where a1: "a1 > 0" "{-a1..a1} \<subseteq> existence_ivl0 x" .
     have "continuous (at 0) (\<lambda>t. norm(f (flow0 x t) - f (flow0 x 0) ))"
       apply (auto intro!: continuous_intros)
       by (simp add: assms(1) local.f_flow_continuous)
     then obtain a2 where "a2>0"
       "\<forall>t. norm t < a2 \<longrightarrow>
              norm (f (flow0 x t) - f (flow0 x 0)) < norm(f x)/2"
       unfolding continuous_at_real_range
       by (metis abs_norm_cancel cancel_comm_monoid_add_class.diff_cancel diff_zero half_gt_zero nf norm_zero)
     then have 
       t: "\<And>t. t \<in> {-a2<--<a2} \<Longrightarrow> norm(f (flow0 x t) - f (flow0 x 0)) \<le> norm(f x)/2"
       by (smt open_segment_bound(2) open_segment_bound1 real_norm_def)
     define a where "a = min a1 (a2/2)"
     have t1:"a > 0" unfolding a_def using \<open>a1 > 0\<close> \<open>a2 > 0\<close> by auto
     then have t3:"0 \<in>{-a--a}"
       using closed_segment_eq_real_ivl by auto
     have "{-a--a} \<subseteq> {-a1..a1}" unfolding a_def using \<open>a1 > 0\<close> \<open>a2 > 0\<close>
       using ODE_Auxiliarities.closed_segment_eq_real_ivl by auto
     then have t2:"{-a--a} \<subseteq> existence_ivl0 x" using a1 by auto
     have "{-a--a} \<subseteq> {-a2<--<a2}" unfolding a_def using \<open>a1 > 0\<close> \<open>a2 > 0\<close>
       by (smt Diff_iff closed_segment_eq_real_ivl atLeastAtMost_iff empty_iff half_gt_zero insert_iff pos_half_less segment(1) subset_eq)
     then have t4:"\<And>t. t \<in> {-a--a} \<Longrightarrow> norm(f (flow0 x t) - f (flow0 x 0)) \<le> norm(f x)/2" using t by auto
     show ?thesis using t1 t2 t3 t4 that by auto
   qed
   have "\<And>t. t \<in> {-a--a} \<Longrightarrow> (flow0 x has_vector_derivative f (flow0 x t)) (at t within {-a--a})"
     apply (rule has_vector_derivative_at_within)
     using a(2) by (auto intro!:flow_has_vector_derivative)
   from vector_differentiable_bound_linearization[OF this _ a(4)]
   have nb:"\<And>c d. {c--d} \<subseteq> {-a--a} \<Longrightarrow>
    norm (flow0 x d - flow0 x c - (d - c) *\<^sub>R f (flow0 x 0))  \<le> norm (d - c) * (norm (f x) / 2)"
     using a(3) by blast
   have "\<And>t. dist t 0 < a \<Longrightarrow> t \<noteq> 0 \<Longrightarrow> flow0 x t \<noteq> x"
   proof (rule ccontr)
     fix t
     assume "dist t 0 < a" "t \<noteq> 0" "\<not> flow0 x t \<noteq> x"
     then have tx:"flow0 x t = x" by auto
     have "t \<in> {-a--a}"
       using closed_segment_eq_real_ivl \<open>dist t 0 < a\<close> by auto
     have "t > 0 \<or> t < 0" using \<open>t \<noteq> 0\<close> by linarith
     moreover {
       assume "t > 0"
       then have "{0--t} \<subseteq> {-a--a}"
         by (simp add: \<open>t \<in> {-a--a}\<close> a(3) subset_closed_segment) 
       from nb[OF this] have
         "norm (flow0 x t - x - t *\<^sub>R f x) \<le> norm t * (norm (f x) / 2)"
         by (simp add: assms(1))
       then have "norm (t *\<^sub>R f x) \<le> norm t * (norm (f x) / 2)" using tx by auto
       then have False using nf
         using \<open>0 < t\<close> by auto 
     }
     moreover {
       assume "t < 0"
       then have "{t--0} \<subseteq> {-a--a}"
         by (simp add: \<open>t \<in> {-a--a}\<close> a(3) subset_closed_segment) 
       from nb[OF this] have
         "norm (x - flow0 x t + t *\<^sub>R f x) \<le> norm t * (norm (f x) / 2)"
         by (simp add: assms(1))
       then have "norm (t *\<^sub>R f x) \<le> norm t * (norm (f x) / 2)" using tx by auto
       then have False using nf
         using \<open>t < 0\<close> by auto 
     }
     ultimately show False by blast
   qed
   thus ?thesis unfolding eventually_at
     using a(1) by blast
 qed
 
 lemma compact_max_time_flow_in_closed:
   assumes "closed M" and t_ex: "t \<in> existence_ivl0 x"
   shows "compact {s \<in> {0..t}. flow0 x ` {0..s} \<subseteq> M}" (is "compact ?C")
   unfolding compact_eq_bounded_closed
 proof
   have "bounded {0 .. t}" by auto
   then show "bounded ?C"
     by (rule bounded_subset) auto
   show "closed ?C"
     unfolding closed_def
   proof (rule topological_space_class.openI, clarsimp)
     \<comment> \<open>TODO: there must be a more abstract argument for this, e.g., with
       @{thm continuous_on_closed_vimageI} and then reasoning about the connected component around 0?\<close>
     fix s
     assume notM: "s \<le> t \<longrightarrow> 0 \<le> s \<longrightarrow> \<not> flow0 x ` {0..s} \<subseteq> M"
     consider "0 \<le> s" "s \<le> t" "flow0 x s \<notin> M" | "0 \<le> s" "s \<le> t" "flow0 x s \<in> M" | "s < 0" | "s > t"
       by arith
     then show "\<exists>T. open T \<and> s \<in> T \<and> T \<subseteq> - {s. 0 \<le> s \<and> s \<le> t \<and> flow0 x ` {0..s} \<subseteq> M}"
     proof cases
       assume s: "0 \<le> s" "s \<le> t" and sM: "flow0 x s \<notin> M"
       have "isCont (flow0 x) s"
         using s ivl_subset_existence_ivl[OF t_ex]
         by (auto intro!: flow_continuous)
       from this[unfolded continuous_at_open, rule_format, of "-M"] sM \<open>closed M\<close>
       obtain S where "open S" "s \<in> S" "(\<forall>x'\<in>S. flow0 x x' \<in> - M)"
         by auto
       then show ?thesis
         by (force intro!: exI[where x=S])
     next
       assume s: "0 \<le> s" "s \<le> t" and sM: "flow0 x s \<in> M"
       from this notM obtain s0 where s0: "0 \<le> s0" "s0 < s" "flow0 x s0 \<notin> M"
         by force
       from order_tendstoD(1)[OF tendsto_ident_at \<open>s0 < s\<close>, of UNIV, unfolded eventually_at_topological]
       obtain S where "open S" "s \<in> S" "\<And>x. x \<in> S \<Longrightarrow> x \<noteq> s \<Longrightarrow> s0 < x"
         by auto
       then show ?thesis using s0
         by (auto simp: intro!: exI[where x=S]) (smt atLeastAtMost_iff image_subset_iff)
     qed (force intro: exI[where x="{t<..}"] exI[where x="{..<0}"])+
   qed
 qed
 
 lemma flow_in_closed_max_timeE:
   assumes "closed M" "t \<in> existence_ivl0 x" "0 \<le> t" "x \<in> M"
   obtains T where "0 \<le> T" "T \<le> t" "flow0 x ` {0..T} \<subseteq> M"
     "\<And>s'. 0 \<le> s' \<Longrightarrow> s' \<le> t \<Longrightarrow> flow0 x ` {0..s'} \<subseteq> M \<Longrightarrow> s' \<le> T"
 proof -
   let ?C = "{s \<in> {0..t}. flow0 x ` {0..s} \<subseteq> M}"
   have "?C \<noteq> {}"
     using assms
     using local.mem_existence_ivl_iv_defined
     by (auto intro!: exI[where x=0])
   from compact_max_time_flow_in_closed[OF assms(1,2)]
   have "compact ?C" .
   from compact_attains_sup[OF this \<open>?C \<noteq> {}\<close>]
   obtain s where s: "0 \<le> s" "s \<le> t" "flow0 x ` {0..s} \<subseteq> M"
     and s_max: "\<And>s'. 0 \<le> s' \<Longrightarrow> s' \<le> t \<Longrightarrow> flow0 x ` {0..s'} \<subseteq> M \<Longrightarrow> s' \<le> s"
     by auto
   then show ?thesis ..
 qed
 
 lemma flow_leaves_closed_at_frontierE:
   assumes "closed M" and t_ex: "t \<in> existence_ivl0 x" and "0 \<le> t" "x \<in> M" "flow0 x t \<notin> M"
   obtains s where "0 \<le> s" "s < t" "flow0 x ` {0..s} \<subseteq> M"
     "flow0 x s \<in> frontier M"
     "\<exists>\<^sub>F s' in at_right s. flow0 x s' \<notin> M"
 proof -
   from flow_in_closed_max_timeE[OF assms(1-4)] assms(5)
   obtain s where s: "0 \<le> s" "s < t" "flow0 x ` {0..s} \<subseteq> M"
     and s_max: "\<And>s'. 0 \<le> s' \<Longrightarrow> s' \<le> t \<Longrightarrow> flow0 x ` {0..s'} \<subseteq> M \<Longrightarrow> s' \<le> s"
     by (smt atLeastAtMost_iff image_subset_iff)
   note s
   moreover
   have "flow0 x s \<notin> interior M"
   proof
     assume interior: "flow0 x s \<in> interior M"
     have "s \<in> existence_ivl0 x" using ivl_subset_existence_ivl[OF \<open>t \<in> _\<close>] s by auto
     from flow_continuous[OF this, THEN isContD, THEN topological_tendstoD, OF open_interior interior]
     have "\<forall>\<^sub>F s' in at s. flow0 x s' \<in> interior M" by auto
     then have "\<forall>\<^sub>F s' in at_right s. flow0 x s' \<in> interior M"
       by (auto simp: eventually_at_split)
     moreover have "\<forall>\<^sub>F s' in at_right s. s' < t"
       using tendsto_ident_at \<open>s < t\<close>
       by (rule order_tendstoD)
     ultimately have "\<forall>\<^sub>F s' in at_right s. flow0 x s' \<in> M \<and> s' < t"
       by eventually_elim (use interior_subset[of M] in auto)
     then obtain s' where s': "s < s'" "s' < t" "\<And>y. y > s \<Longrightarrow> y \<le> s' \<Longrightarrow> flow0 x y \<in> M"
       by (auto simp: eventually_at_right_field_le)
     have s'_ivl: "flow0 x ` {0..s'} \<subseteq> M"
     proof safe
       fix s'' assume "s'' \<in> {0 .. s'}"
       then show "flow0 x s'' \<in> M"
         using s interior_subset[of M] s'
         by (cases "s'' \<le> s") auto
     qed
     with s_max[of s'] \<open>s' < t\<close> \<open>0 \<le> s\<close> \<open>s < s'\<close> show False by auto
   qed
   then have "flow0 x s \<in> frontier M"
     using s closure_subset[of M]
     by (force simp: frontier_def)
   moreover
   have "compact (flow0 x -` M \<inter> {s..t})" (is "compact ?C")
     unfolding compact_eq_bounded_closed
   proof
     have "bounded {s .. t}" by simp
     then show "bounded ?C"
       by (rule bounded_subset) auto
     show "closed ?C"
       using \<open>closed M\<close> assms mem_existence_ivl_iv_defined(2)[OF t_ex] ivl_subset_existence_ivl[OF t_ex] \<open>0 \<le> s\<close>
       by (intro closed_vimage_Int) (auto intro!: continuous_intros)
   qed
   have "\<exists>\<^sub>F s' in at_right s. flow0 x s' \<notin> M"
     apply (rule ccontr)
     unfolding not_frequently
   proof -
     assume "\<forall>\<^sub>F s' in at_right s. \<not> flow0 x s' \<notin> M"
     moreover have "\<forall>\<^sub>F s' in at_right s. s' < t"
       using tendsto_ident_at \<open>s < t\<close>
       by (rule order_tendstoD)
     ultimately have "\<forall>\<^sub>F s' in at_right s. flow0 x s' \<in> M \<and> s' < t" by eventually_elim auto
     then obtain s' where s': "s < s'"
       "\<And>y. y > s \<Longrightarrow> y < s' \<Longrightarrow> flow0 x y \<in> M"
       "\<And>y. y > s \<Longrightarrow> y < s' \<Longrightarrow> y < t"
       by (auto simp: eventually_at_right_field)
     define s'' where "s'' = (s + s') / 2"
     have "0 \<le> s''" "s'' \<le> t"  "s < s''" "s'' < s'"
       using s s'
       by (auto simp del: divide_le_eq_numeral1 le_divide_eq_numeral1 simp: s''_def) fastforce
     then have "flow0 x ` {0..s''} \<subseteq> M"
       using s s'
       apply auto
       subgoal for u
         by (cases "u\<le>s") auto
       done
     from s_max[OF \<open>0 \<le> s''\<close> \<open>s''\<le> t\<close> this] \<open>s'' > s\<close>
     show False by simp
   qed
   ultimately show ?thesis ..
 qed
 
 
 subsection \<open>Connectedness\<close>
 
 lemma fcontX:
   shows "continuous_on X f"
   using auto_local_lipschitz local_lipschitz_continuous_on by blast
 
 lemma fcontx:
   assumes "x \<in> X"
   shows "continuous (at x) f"
 proof -
   have "open X" by simp
   from continuous_on_eq_continuous_at[OF this]
   show ?thesis using fcontX assms(1) by blast
 qed
 
 lemma continuous_at_imp_cball:
   assumes "continuous (at x) g"
   assumes "g x > (0::real)"
   obtains r where "r > 0" "\<forall>y \<in> cball x r. g y > 0"
 proof -
   from assms(1)
   obtain d where "d>0" "g ` (ball x d) \<subseteq> ball (g x) ((g x)/2)"
     by (meson assms(2) continuous_at_ball half_gt_zero)
   then have "\<forall>y \<in> cball x (d/2). g y > 0"
     by (smt assms(2) dist_norm image_subset_iff mem_ball mem_cball pos_half_less real_norm_def)
   thus ?thesis
     using \<open>0 < d\<close> that half_gt_zero by blast
 qed
 
 text \<open> \<open>flow0\<close> is \<open>path_connected\<close> \<close>
 lemma flow0_path_connected_time:
   assumes "ts \<subseteq> existence_ivl0 x" "path_connected ts"
   shows "path_connected (flow0 x ` ts)"
 proof -
   have "continuous_on ts (flow0 x)"
     by (meson assms continuous_on_sequentially flow_continuous_on subsetD)
   from path_connected_continuous_image[OF this assms(2)] 
   show ?thesis .
 qed
 
 lemma flow0_path_connected:
   assumes "path_connected D"
     "path_connected ts"
     "\<And>x. x \<in> D \<Longrightarrow> ts \<subseteq> existence_ivl0 x"
   shows "path_connected ( (\<lambda>(x, y). flow0 x y) ` (D \<times> ts))"
 proof -
   have "D \<times> ts \<subseteq> Sigma X existence_ivl0"
     using assms(3) subset_iff by fastforce
   then have a1:"continuous_on (D \<times> ts) (\<lambda>(x, y). flow0 x y)"
     using flow_continuous_on_state_space continuous_on_subset by blast 
   have a2 : "path_connected (D \<times> ts)" using path_connected_Times assms by auto
   from path_connected_continuous_image[OF a1 a2]
   show ?thesis .
 qed
 
 end
 
 subsection \<open>Return Time and Implicit Function Theorem\<close>
 
 context c1_on_open_euclidean begin
 
 lemma flow_implicit_function:
   \<comment> \<open>TODO: generalization of @{thm returns_to_implicit_function}!\<close>
   fixes s::"'a::euclidean_space \<Rightarrow> real" and S::"'a set"
   assumes t: "t \<in> existence_ivl0 x" and x: "x \<in> X" and st: "s (flow0 x t) = 0"
   assumes Ds: "\<And>x. (s has_derivative blinfun_apply (Ds x)) (at x)"
   assumes DsC: "isCont Ds (flow0 x t)"
   assumes nz: "Ds (flow0 x t) (f (flow0 x t)) \<noteq> 0"
   obtains u e
   where "s (flow0 x (u x)) = 0"
     "u x = t"
     "(\<And>y. y \<in> cball x e \<Longrightarrow> s (flow0 y (u y)) = 0)"
     "continuous_on (cball x e) u"
     "(\<lambda>t. (t, u t)) ` cball x e \<subseteq> Sigma X existence_ivl0"
     "0 < e" "(u has_derivative (- blinfun_scaleR_left
                    (inverse (blinfun_apply (Ds (flow0 x t)) (f (flow0 x t)))) o\<^sub>L
                       (Ds (flow0 x t) o\<^sub>L flowderiv x t) o\<^sub>L embed1_blinfun)) (at x)"
 proof -
   note [derivative_intros] = has_derivative_compose[OF _ Ds]
   have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
   note cls[simp, intro] = closed_levelset[OF cont_s]
   then have xt1: "(x, t) \<in> Sigma X existence_ivl0"
     by (auto simp: t x)
   have D: "(\<And>x. x \<in> Sigma X existence_ivl0 \<Longrightarrow>
       ((\<lambda>(x, t). s (flow0 x t)) has_derivative
        blinfun_apply (Ds (flow0 (fst x) (snd x)) o\<^sub>L (flowderiv (fst x) (snd x))))
        (at x))"
     by (auto intro!: derivative_eq_intros)
   have C: "isCont (\<lambda>x. Ds (flow0 (fst x) (snd x)) o\<^sub>L flowderiv (fst x) (snd x))
    (x, t)"
     using flowderiv_continuous_on[unfolded continuous_on_eq_continuous_within,
         rule_format, OF xt1]
     using at_within_open[OF xt1 open_state_space]
     by (auto intro!: continuous_intros tendsto_eq_intros x t
         isCont_tendsto_compose[OF DsC, unfolded poincare_map_def]
         simp: split_beta' isCont_def)
   have Z: "(case (x, t) of (x, t) \<Rightarrow> s (flow0 x t)) = 0"
     by (auto simp: st)
   have I1: "blinfun_scaleR_left (inverse (Ds (flow0 x t)(f (flow0 x t)))) o\<^sub>L 
     ((Ds (flow0 (fst (x, t))
             (snd (x, t))) o\<^sub>L
        flowderiv (fst (x, t))
         (snd (x, t))) o\<^sub>L
       embed2_blinfun)
      = 1\<^sub>L"
     using nz
     by (auto intro!: blinfun_eqI
         simp: flowderiv_def blinfun.bilinear_simps inverse_eq_divide poincare_map_def)
   have I2: "((Ds (flow0 (fst (x, t))
             (snd (x, t))) o\<^sub>L
        flowderiv (fst (x, t))
         (snd (x, t))) o\<^sub>L
       embed2_blinfun) o\<^sub>L blinfun_scaleR_left (inverse (Ds (flow0 x t)(f (flow0 x t))))
      = 1\<^sub>L"
     using nz
     by (auto intro!: blinfun_eqI
         simp: flowderiv_def blinfun.bilinear_simps inverse_eq_divide poincare_map_def)
   show ?thesis
     apply (rule implicit_function_theorem[where f="\<lambda>(x, t). s (flow0 x t)"
           and S="Sigma X existence_ivl0", OF D xt1 open_state_space order_refl C Z I1 I2])
      apply blast
     unfolding split_beta' fst_conv snd_conv poincare_map_def[symmetric]
     ..
 qed
 
 lemma flow_implicit_function_at:
   fixes s::"'a::euclidean_space \<Rightarrow> real" and S::"'a set"
   assumes x: "x \<in> X" and st: "s x = 0"
   assumes Ds: "\<And>x. (s has_derivative blinfun_apply (Ds x)) (at x)"
   assumes DsC: "isCont Ds x"
   assumes nz: "Ds x (f x) \<noteq> 0"
   assumes pos: "e > 0"
   obtains u d
   where
     "0 < d"
     "u x = 0"
     "\<And>y. y \<in> cball x d \<Longrightarrow> s (flow0 y (u y)) = 0"
     "\<And>y. y \<in> cball x d \<Longrightarrow> \<bar>u y\<bar> < e"
     "\<And>y. y \<in> cball x d \<Longrightarrow> u y \<in> existence_ivl0 y"
     "continuous_on (cball x d) u"
     "(u has_derivative -Ds x /\<^sub>R (Ds x) (f x)) (at x)"
 proof -
   have x0: "flow0 x 0 = x" by (simp add: x)
   from flow_implicit_function[OF existence_ivl_zero[OF x] x, unfolded x0, of s, OF st Ds DsC nz]
   obtain u d0 where
     s0: "s (flow0 x (u x)) = 0"
     and u0: "u x = 0"
     and u: "\<And>y. y \<in> cball x d0 \<Longrightarrow> s (flow0 y (u y)) = 0"
     and uc: "continuous_on (cball x d0) u"
     and uex: "(\<lambda>t. (t, u t)) ` cball x d0 \<subseteq> Sigma X existence_ivl0"
     and d0: "0 < d0"
     and u': "(u has_derivative
      blinfun_apply
       (- blinfun_scaleR_left (inverse (blinfun_apply (Ds x) (f x))) o\<^sub>L (Ds x o\<^sub>L flowderiv x 0) o\<^sub>L embed1_blinfun))
      (at x)"
     by blast
   have "at x within cball x d0 = at x" by (rule at_within_interior) (auto simp: \<open>0 < d0\<close>)
   then have "(u \<longlongrightarrow> 0) (at x)"
     using uc d0 by (auto simp: continuous_on_def u0 dest!: bspec[where x=x])
   from tendstoD[OF this \<open>0 < e\<close>] pos u0
   obtain d1 where d1: "0 < d1" "\<And>xa. dist xa x \<le> d1 \<Longrightarrow> \<bar>u xa\<bar> < e"
     unfolding eventually_at_le
     by force
   define d where "d = min d0 d1"
   have "0 < d" by (auto simp: d_def d0 d1)
   moreover note u0
   moreover have "\<And>y. y \<in> cball x d \<Longrightarrow> s (flow0 y (u y)) = 0" by (auto intro!: u simp: d_def)
   moreover have "\<And>y. y \<in> cball x d \<Longrightarrow> \<bar>u y\<bar> < e" using d1 by (auto simp: d_def dist_commute)
   moreover have "\<And>y. y \<in> cball x d \<Longrightarrow> u y \<in> existence_ivl0 y"
     using uex by (force simp: d_def)
   moreover have "continuous_on (cball x d) u"
     using uc by (rule continuous_on_subset) (auto simp: d_def)
   moreover
   have "(u has_derivative -Ds x /\<^sub>R (Ds x) (f x)) (at x)"
     using u'
     by (rule has_derivative_subst) (auto intro!: ext simp: x x0 flowderiv_def blinfun.bilinear_simps)
   ultimately show ?thesis ..
 qed
 
 lemma returns_to_implicit_function_gen:
   \<comment> \<open>TODO: generalizes proof of @{thm returns_to_implicit_function}!\<close>
   fixes s::"'a::euclidean_space \<Rightarrow> real"
   assumes rt: "returns_to {x \<in> S. s x = 0} x" (is "returns_to ?P x")
   assumes cS: "closed S"
   assumes Ds: "\<And>x. (s has_derivative blinfun_apply (Ds x)) (at x)"
     "isCont Ds (poincare_map ?P x)"
     "Ds (poincare_map ?P x) (f (poincare_map ?P x)) \<noteq> 0"
   obtains u e
   where "s (flow0 x (u x)) = 0"
     "u x = return_time ?P x"
     "(\<And>y. y \<in> cball x e \<Longrightarrow> s (flow0 y (u y)) = 0)"
     "continuous_on (cball x e) u"
     "(\<lambda>t. (t, u t)) ` cball x e \<subseteq> Sigma X existence_ivl0"
     "0 < e" "(u has_derivative (- blinfun_scaleR_left
                    (inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) o\<^sub>L
                       (Ds (poincare_map ?P x) o\<^sub>L flowderiv x (return_time ?P x)) o\<^sub>L embed1_blinfun)) (at x)"
 proof -
   note [derivative_intros] = has_derivative_compose[OF _ Ds(1)]
   have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds(1)])
   note cls[simp, intro] = closed_levelset[OF cont_s]
   let ?t1 = "return_time ?P x"
   have cls[simp, intro]: "closed {x \<in> S. s x = 0}"
     by (rule closed_levelset_within) (auto intro!: cS continuous_on_subset[OF cont_s])
 
   have *: "poincare_map ?P x = flow0 x (return_time {x \<in> S. s x = 0} x)"
     by (simp add: poincare_map_def)
   have "return_time {x \<in> S. s x = 0} x \<in> existence_ivl0 x"
     "x \<in> X"
     "s (poincare_map ?P x) = 0"
     using poincare_map_returns rt
     by (auto intro!: return_time_exivl rt)
   note E = flow_implicit_function[of "return_time ?P x" x s Ds, OF this[unfolded *] Ds[unfolded *],
       folded *]
   show ?thesis
     by (rule E) rule
 qed
 
 text \<open>c.f. Perko Section 3.7 Lemma 2 part 1.\<close>
 
 lemma flow_transversal_surface_finite_intersections:
   fixes s::"'a \<Rightarrow> 'b::real_normed_vector"
     and Ds::"'a \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b"
   assumes "closed S"
   assumes "\<And>x. (s has_derivative (Ds x)) (at x)"
   assumes "\<And>x. x \<in> S \<Longrightarrow> s x = 0 \<Longrightarrow> Ds x (f x) \<noteq> 0"
   assumes "a \<le> b" "{a .. b} \<subseteq> existence_ivl0 x"
   shows "finite {t\<in>{a..b}. flow0 x t \<in> {x \<in> S. s x = 0}}"
     \<comment> \<open>TODO: define notion of (compact/closed)-(continuous/differentiable/C1)-surface?\<close>
 proof cases
   note Ds = \<open>\<And>x. (s has_derivative (Ds x)) (at x)\<close>
   note transversal = \<open>\<And>x. x \<in> S \<Longrightarrow> s x = 0 \<Longrightarrow> Ds x (f x) \<noteq> 0\<close>
   assume "a < b"
   show ?thesis
   proof (rule ccontr)
     let ?S = "{x \<in> S. s x = 0}"
     let ?T = "{t\<in>{a..b}. flow0 x t \<in> {x \<in> S. s x = 0}}"
     define \<phi> where "\<phi> = flow0 x"
     have [THEN continuous_on_compose2, continuous_intros]: "continuous_on S s"
       by (auto simp: intro!: has_derivative_continuous_on Ds intro: has_derivative_at_withinI)
     assume "infinite ?T"
     from compact_sequentialE[OF compact_Icc[of a b] this]
     obtain t tl where t: "t n \<in> ?T" "flow0 x (t n) \<in> ?S" "t n \<in> {a .. b}" "t n \<noteq> tl"
       and tl: "t \<longlonglongrightarrow> tl" "tl \<in> {a..b}"
     for n
       by force
     have tl_ex: "tl \<in> existence_ivl0 x" using \<open>{a .. b} \<subseteq> existence_ivl0 x\<close> \<open>tl \<in> {a .. b}\<close> by auto
     have "closed ?S"
       by (auto intro!: closed_levelset_within \<open>closed S\<close> continuous_intros)
     moreover
     have "\<forall>n. flow0 x (t n) \<in> ?S"
       using t by auto
     moreover
     have flow_t: "(\<lambda>n. flow0 x (t n)) \<longlonglongrightarrow> flow0 x tl"
       by (auto intro!: tendsto_eq_intros tl_ex tl)
     ultimately have "flow0 x tl \<in> ?S"
-      by (rule closed_sequentially)
+      by (metis (no_types, lifting) closed_sequentially)
 
     let ?qt = "\<lambda>t. (flow0 x t - flow0 x tl) /\<^sub>R (t - tl)"
     from flow_has_vector_derivative[OF tl_ex, THEN has_vector_derivative_withinD]
     have qt_tendsto: "?qt \<midarrow>tl\<rightarrow> f (flow0 x tl)" .
     let ?q = "\<lambda>n. ?qt (t n)"
     have "filterlim t (at tl) sequentially"
       using tl(1)
       by (rule filterlim_atI) (simp add: t)
     with qt_tendsto have "?q \<longlonglongrightarrow> f (flow0 x tl)"
       by (rule filterlim_compose)
     then have "((\<lambda>n. Ds (flow0 x tl) (?q n))) \<longlonglongrightarrow> Ds (flow0 x tl) (f (flow0 x tl))"
       by (auto intro!: tendsto_intros)
     moreover
 
     from flow_lipschitzE[OF \<open>{a .. b} \<subseteq> existence_ivl0 x\<close>] obtain L' where L': "L'-lipschitz_on {a..b} (flow0 x)" .
     define L where "L = L' + 1"
     from lipschitz_on_le[OF L', of L] lipschitz_on_nonneg[OF L']
     have L: "L-lipschitz_on {a .. b} (flow0 x)" and "L > 0"
       by (auto simp: L_def)
     from flow_lipschitzE[OF \<open>{a .. b} \<subseteq> existence_ivl0 x\<close>] obtain L' where "L'-lipschitz_on {a..b} (flow0 x)" .
         \<comment> \<open>TODO: is this reasoning (below) with this Lipschitz constant really necessary?\<close>
     have s[simp]: "s (flow0 x (t n)) = 0""s (flow0 x tl) = 0"
       for n
       using t \<open>flow0 x tl \<in> ?S\<close>
       by auto
 
     from Ds(1)[of "flow0 x tl", unfolded has_derivative_within]
     have "(\<lambda>y. (1 / norm (y - flow0 x tl)) *\<^sub>R (s y - (s (flow0 x tl) + blinfun_apply (Ds (flow0 x tl)) (y - flow0 x tl)))) \<midarrow>flow0 x tl\<rightarrow> 0"
       by auto
     then have "((\<lambda>y. (1 / norm (y - flow0 x tl)) *\<^sub>R (s y - (s (flow0 x tl) + blinfun_apply (Ds (flow0 x tl)) (y - flow0 x tl)))) \<longlongrightarrow> 0)
       (nhds (flow0 x tl))"
       by (rule tendsto_nhds_continuousI) simp
 
     from filterlim_compose[OF this flow_t]
     have "(\<lambda>xa. (blinfun_apply (Ds (flow0 x tl)) (flow0 x (t xa) - flow0 x tl)) /\<^sub>R norm (flow0 x (t xa) - flow0 x tl))
       \<longlonglongrightarrow> 0"
       using t
       by (auto simp: inverse_eq_divide tendsto_minus_cancel_right)
     from tendsto_mult[OF tendsto_const[of "L"] tendsto_norm[OF this, simplified, simplified divide_inverse_commute[symmetric]]]\<comment> \<open>TODO: uuugly\<close>
     have Ds0: "(\<lambda>xa. norm (blinfun_apply (Ds (flow0 x tl)) (flow0 x (t xa) - flow0 x tl)) / (norm (flow0 x (t xa) - flow0 x tl)/(L))) \<longlonglongrightarrow> 0"
       by (auto simp: ac_simps)
 
     from _ Ds0 have "((\<lambda>n. Ds (flow0 x tl) (?q n)) \<longlonglongrightarrow> 0)"
       apply (rule Lim_null_comparison)
       apply (rule eventuallyI)
       unfolding norm_scaleR blinfun.scaleR_right abs_inverse divide_inverse_commute[symmetric]
       subgoal for n
         apply (cases "flow0 x (t n) = flow0 x tl")
         subgoal by (simp add: blinfun.bilinear_simps)
         subgoal
           apply (rule divide_left_mono)
           using lipschitz_onD[OF L, of "t n" tl] \<open>0 < L\<close> t(3) tl(2)
           by (auto simp: algebra_split_simps zero_less_divide_iff dist_norm pos_divide_le_eq
               intro!: add_pos_nonneg)
         done
       done
     ultimately have "Ds (flow0 x tl) (f (flow0 x tl)) = 0"
       by (rule LIMSEQ_unique)
     moreover have "Ds (flow0 x tl) (f (flow0 x tl)) \<noteq> 0"
       by (rule transversal) (use \<open>flow0 x tl \<in> ?S\<close> in auto)
     ultimately show False by auto
   qed
 qed (use assms in auto)
 
 lemma uniform_limit_flow0_state:\<comment> \<open>TODO: is that something more general?\<close>
   assumes "compact C"
   assumes "C \<subseteq> X"
   shows "uniform_limit C (\<lambda>s x. flow0 x s) (\<lambda>x. flow0 x 0) (at 0)"
 proof (cases "C = {}")
   case True then show ?thesis by auto
 next
   case False show ?thesis
   proof (rule uniform_limitI)
     fix e::real assume "0 < e"
     {
       fix x assume "x \<in> C"
       with assms have "x \<in> X" by auto
       from existence_ivl_cballs[OF UNIV_I \<open>x \<in> X\<close>]
       obtain t L u where "\<And>y. y \<in> cball x u \<Longrightarrow> cball 0 t \<subseteq> existence_ivl0 y"
         "\<And>s y. y \<in> cball x u \<Longrightarrow> s \<in> cball 0 t \<Longrightarrow> flow0 y s \<in> cball y u"
         "L-lipschitz_on (cball 0 t\<times>cball x u) (\<lambda>(t, x). flow0 x t)"
         "\<And>y. y \<in> cball x u \<Longrightarrow> cball y u \<subseteq> X"
         "0 < t" "0 < u"
         by metis
       then have "\<exists>L. \<exists>u>0. \<exists>t>0. L-lipschitz_on (cball 0 t\<times>cball x u) (\<lambda>(t, x). flow0 x t)" by blast
     } then have "\<forall>x\<in>C. \<exists>L. \<exists>u>0. \<exists>t>0. L-lipschitz_on (cball 0 t\<times>cball x u) (\<lambda>(t, x). flow0 x t)" ..
     then obtain L d' u' where
       L: "\<And>x. x \<in> C \<Longrightarrow> (L x)-lipschitz_on (cball 0 (d' x)\<times>cball x (u' x)) (\<lambda>(t, x). flow0 x t)"
       and d': "\<And>x. x \<in> C \<Longrightarrow> d' x > 0"
       and u': "\<And>x. x \<in> C \<Longrightarrow> u' x > 0"
       by metis
     have "C \<subseteq> (\<Union>c\<in>C. ball c (u' c))" using u' by auto
     from compactE_image[OF \<open>compact C\<close> _ this]
     obtain C' where "C' \<subseteq> C" and [simp]: "finite C'" and C'_cover: "C \<subseteq> (\<Union>c\<in>C'. ball c (u' c))"
       by auto
     from C'_cover obtain c' where c': "x \<in> C \<Longrightarrow> x \<in> ball (c' x) (u' (c' x))" "x \<in> C \<Longrightarrow> c' x \<in> C'" for x
       by (auto simp: subset_iff) metis
     have "\<forall>\<^sub>F s in at 0. \<forall>x\<in>ball c (u' c). dist (flow0 x s) (flow0 x 0) < e" if "c \<in> C'" for c
     proof -
       have cC: "c \<in> C"
         using c' \<open>c \<in> C'\<close> d' \<open>C' \<subseteq> C\<close>
         by auto
       have *: "dist (flow0 x s) (flow0 x 0) \<le> L c * \<bar>s\<bar>"
         if "x\<in>ball c (u' c)"
           "s \<in> cball 0 (d' c)"
         for x s
       proof -
         from L[OF cC, THEN lipschitz_onD, of "(0, x)" "(s, x)"] d'[OF cC] that
         show ?thesis
           by (auto simp: dist_prod_def dist_commute)
       qed
       have "\<forall>\<^sub>F s in at 0. abs s < d' c"
         by (rule order_tendstoD tendsto_intros)+ (use d' cC in auto)
       moreover have "\<forall>\<^sub>F s in at 0. L c * \<bar>s\<bar> < e"
         by (rule order_tendstoD tendsto_intros)+ (use \<open>0 < e\<close> in auto)
       ultimately show ?thesis
         apply eventually_elim
         apply (use * in auto)
         by smt
     qed
     then have "\<forall>\<^sub>F s in at 0. \<forall>c\<in>C'. \<forall>x\<in>ball c (u' c). dist (flow0 x s) (flow0 x 0) < e"
       by (simp add: eventually_ball_finite_distrib)
     then show "\<forall>\<^sub>F s in at 0. \<forall>x\<in>C. dist (flow0 x s) (flow0 x 0) < e"
       apply eventually_elim
       apply auto
       subgoal for s x
         apply (drule bspec[where x="c' x"])
          apply (simp add: c'(2))
         apply (drule bspec) prefer 2 apply assumption
         apply auto
         using c'(1) by auto
       done
   qed
 qed
 
 end
 
 subsection \<open>Fixpoints\<close>
 
 context auto_ll_on_open begin
 
 lemma fixpoint_sol:
   assumes "x \<in> X" "f x = 0"
   shows "existence_ivl0 x = UNIV" "flow0 x t = x"
 proof -
   have sol: "((\<lambda>t::real. x) solves_ode (\<lambda>_. f)) UNIV X"
     apply (rule solves_odeI)
     by(auto simp add: assms intro!: derivative_intros)
   from maximal_existence_flow[OF sol] have
     "UNIV \<subseteq> existence_ivl0 x" "flow0 x t = x" by auto
   thus "existence_ivl0 x = UNIV" "flow0 x t = x" by auto
 qed
 
 end
 
 end
\ No newline at end of file
diff --git a/thys/Roth_Arithmetic_Progressions/Roth_Arithmetic_Progressions.thy b/thys/Roth_Arithmetic_Progressions/Roth_Arithmetic_Progressions.thy
--- a/thys/Roth_Arithmetic_Progressions/Roth_Arithmetic_Progressions.thy
+++ b/thys/Roth_Arithmetic_Progressions/Roth_Arithmetic_Progressions.thy
@@ -1,1501 +1,1502 @@
 section\<open>Roth's Theorem on Arithmetic Progressions\<close>
 
 theory Roth_Arithmetic_Progressions
   imports Szemeredi_Regularity.Szemeredi
       "Random_Graph_Subgraph_Threshold.Subgraph_Threshold"
       "Ergodic_Theory.Asymptotic_Density"
       "HOL-Library.Ramsey" "HOL-Library.Nat_Bijection"
 
 begin
 
 subsection \<open>Miscellaneous Preliminaries\<close>
 
 lemma sum_prod_le_prod_sum:
   fixes a :: "'a \<Rightarrow> 'b::linordered_idom"
   assumes "\<And>i. i \<in> I \<Longrightarrow> a i \<ge> 0 \<and> b i \<ge> 0"
   shows "(\<Sum>i\<in>I. \<Sum>j\<in>I. a i * b j) \<le> (\<Sum>i\<in>I. a i) * (\<Sum>i\<in>I. b i)"
   using assms
   by (induction I rule: infinite_finite_induct) (auto simp add: algebra_simps sum.distrib sum_distrib_left)
 
 lemma real_mult_gt_cube: "A \<ge> (X ::real) \<Longrightarrow> B \<ge> X \<Longrightarrow> C \<ge> X \<Longrightarrow> X \<ge> 0 \<Longrightarrow> A * B * C \<ge> X^3"
   by (simp add: mult_mono' power3_eq_cube)
 
 lemma triple_sigma_rewrite_card: 
   assumes "finite X" "finite Y" "finite Z"
   shows "card {(x,y,z) . x \<in> X \<and> (y,z) \<in> Y \<times> Z \<and> P x y z} = (\<Sum>x\<in> X . card {(y,z) \<in> Y \<times> Z. P x y z})"
 proof -
   define W where "W \<equiv> \<lambda>x. {(y,z) \<in> Y \<times> Z. P x y z}"
   have "W x \<subseteq> Y \<times> Z" for x
     by (auto simp: W_def)
   then have [simp]: "finite (W x)" for x
     by (meson assms finite_SigmaI infinite_super)
   have eq: "{(x,y,z) . x \<in> X \<and> (y,z) \<in> Y \<times> Z \<and> P x y z} = (\<Union>x\<in>X. \<Union>(y,z)\<in>W x. {(x,y,z)})"
     by (auto simp: W_def)
   show ?thesis
     unfolding eq by (simp add: disjoint_iff assms card_UN_disjoint) (simp add: W_def)
 qed
 
 lemma all_edges_between_mono1:
   "Y \<subseteq> Z \<Longrightarrow> all_edges_between Y X G \<subseteq> all_edges_between Z X G"
   by (auto simp: all_edges_between_def)
 
 lemma all_edges_between_mono2:
   "Y \<subseteq> Z \<Longrightarrow> all_edges_between X Y G \<subseteq> all_edges_between X Z G"
   by (auto simp: all_edges_between_def)
 
 lemma uwellformed_alt_fst: 
   assumes "uwellformed G" "{x, y} \<in> uedges G"
   shows "x \<in> uverts G"
   using uwellformed_def assms by simp
 
 lemma uwellformed_alt_snd: 
   assumes "uwellformed G" "{x, y} \<in> uedges G"
   shows "y \<in> uverts G"
   using uwellformed_def assms by simp
 
 lemma all_edges_between_subset_times: "all_edges_between X Y G \<subseteq> (X \<inter> \<Union>(uedges G)) \<times> (Y \<inter> \<Union>(uedges G))"
   by (auto simp: all_edges_between_def)
 
 lemma finite_all_edges_between':
   assumes "finite (uverts G)" "uwellformed G"
   shows "finite (all_edges_between X Y G)"
 proof -
   have "finite (\<Union>(uedges G))"
     by (meson Pow_iff all_edges_subset_Pow assms finite_Sup subsetD wellformed_all_edges)
   with all_edges_between_subset_times show ?thesis
     by (metis finite_Int finite_SigmaI finite_subset)
 qed
 
 lemma all_edges_between_E_diff: 
   "all_edges_between X Y (V,E-E') = all_edges_between X Y (V,E) - all_edges_between X Y (V,E')"
   by (auto simp: all_edges_between_def)
 
 lemma all_edges_between_E_Un: 
   "all_edges_between X Y (V,E\<union>E') = all_edges_between X Y (V,E) \<union> all_edges_between X Y (V,E')"
   by (auto simp: all_edges_between_def)
 
 lemma all_edges_between_E_UN:
   "all_edges_between X Y (V, \<Union>i\<in>I. E i) = (\<Union>i\<in>I. all_edges_between X Y (V,E i))"
   by (auto simp: all_edges_between_def)
 
 lemma all_edges_preserved: "\<lbrakk>all_edges_between A B G' = all_edges_between A B G; X \<subseteq> A; Y \<subseteq> B\<rbrakk>
     \<Longrightarrow> all_edges_between X Y G' = all_edges_between X Y G"
   by (auto simp: all_edges_between_def)
 
 lemma subgraph_edge_wf:
   assumes "uwellformed G" "uverts H = uverts G" "uedges H \<subseteq> uedges G"
   shows "uwellformed H"
   by (metis assms subsetD uwellformed_def)
 
 
 subsection \<open>Preliminaries on Neighbors in Graphs\<close>
 
 definition neighbor_in_graph::  " uvert \<Rightarrow> uvert \<Rightarrow> ugraph \<Rightarrow>  bool"
   where "neighbor_in_graph x y G \<equiv> (x \<in> (uverts G) \<and> y \<in> (uverts G) \<and> {x,y} \<in> (uedges G))"
 
 definition neighbors :: "uvert \<Rightarrow> ugraph \<Rightarrow> uvert set" where
   "neighbors x G  \<equiv> {y \<in> uverts G . neighbor_in_graph x y G}"
 
 definition neighbors_ss:: "uvert \<Rightarrow> uvert set \<Rightarrow> ugraph \<Rightarrow> uvert set" where
   "neighbors_ss x Y G \<equiv> {y \<in> Y . neighbor_in_graph x y G}"
 
 lemma all_edges_betw_sigma_neighbor: 
 "uwellformed G \<Longrightarrow> all_edges_between X Y G = (SIGMA x:X. neighbors_ss x Y G)"
   by (auto simp add: all_edges_between_def neighbors_ss_def neighbor_in_graph_def 
       uwellformed_alt_fst uwellformed_alt_snd)
 
 lemma card_all_edges_betw_neighbor: 
   assumes "finite X" "finite Y" "uwellformed G"
   shows "card (all_edges_between X Y G) = (\<Sum>x\<in>X. card (neighbors_ss x Y G))"
   using all_edges_betw_sigma_neighbor assms by (simp add: neighbors_ss_def)
 
 
 subsection \<open>Preliminaries on Triangles in Graphs\<close>
 
 definition triangle_in_graph:: "uvert \<Rightarrow> uvert \<Rightarrow> uvert \<Rightarrow> ugraph \<Rightarrow> bool"
   where "triangle_in_graph x y z G 
          \<equiv> ({x,y} \<in> uedges G) \<and> ({y,z} \<in> uedges G) \<and> ({x,z} \<in> uedges G)"
 
 definition triangle_triples
   where "triangle_triples X Y Z G \<equiv> {(x,y,z) \<in> X \<times> Y \<times> Z. triangle_in_graph x y z G}"
 
 lemma triangle_commu1:
   assumes "triangle_in_graph x y z G"
   shows "triangle_in_graph y x z G"
   using assms triangle_in_graph_def by (auto simp add: insert_commute)
 
 lemma triangle_vertices_distinct1:
   assumes wf: "uwellformed G"
   assumes tri: "triangle_in_graph x y z G"
   shows "x \<noteq> y"
 proof (rule ccontr)
   assume a: "\<not> x \<noteq> y"
   have "card {x, y} = 2" using tri wf triangle_in_graph_def
     using uwellformed_def by blast 
   thus False using a by simp
 qed
 
 lemma triangle_vertices_distinct2: 
   assumes "uwellformed G" "triangle_in_graph x y z G"
   shows "y \<noteq> z"
   by (metis assms triangle_vertices_distinct1 triangle_in_graph_def) 
 
 lemma triangle_in_graph_edge_point: 
   assumes "uwellformed G"
   shows "triangle_in_graph x y z G \<longleftrightarrow> {y, z} \<in> uedges G \<and> neighbor_in_graph x y G \<and> neighbor_in_graph x z G"
   by (auto simp add: triangle_in_graph_def neighbor_in_graph_def assms uwellformed_alt_fst uwellformed_alt_snd)
 
 definition 
   "unique_triangles G 
     \<equiv> \<forall>e \<in> uedges G. \<exists>!T. \<exists>x y z. T = {x,y,z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> T"
 
 definition triangle_free_graph:: "ugraph \<Rightarrow> bool"
   where "triangle_free_graph G \<equiv> \<not>(\<exists> x y z. triangle_in_graph x y z G )"
 
 lemma triangle_free_graph_empty: "uedges G = {} \<Longrightarrow> triangle_free_graph G"
   by (simp add: triangle_free_graph_def triangle_in_graph_def)
 
 lemma edge_vertices_not_equal: 
   assumes "uwellformed G" "{x,y} \<in> uedges G"
   shows "x \<noteq> y"
   using assms triangle_in_graph_def triangle_vertices_distinct1 by blast
 
 lemma triangle_in_graph_verts: 
   assumes "uwellformed G" "triangle_in_graph x y z G"
   shows "x \<in> uverts G" "y \<in> uverts G" "z\<in> uverts G"
 proof -
   have 1: "{x, y} \<in> uedges G" using triangle_in_graph_def
     using assms(2) by auto 
   then show "x \<in> uverts G" using uwellformed_alt_fst assms by blast
   then show "y \<in> uverts G" using 1 uwellformed_alt_snd assms by blast
   have "{x, z} \<in> uedges G" using triangle_in_graph_def assms(2) by auto
   then show "z \<in> uverts G" using uwellformed_alt_snd assms by blast
 qed
 
   
 definition triangle_set :: "ugraph \<Rightarrow> uvert set set"
   where "triangle_set G \<equiv> { {x,y,z} | x y z. triangle_in_graph x y z G}"
 
 fun mk_triangle_set :: "(uvert \<times> uvert \<times> uvert) \<Rightarrow> uvert set" 
   where "mk_triangle_set (x,y,z) = {x,y,z}"
 
 lemma finite_triangle_set:
   assumes fin: "finite (uverts G)" and wf: "uwellformed G"
   shows "finite (triangle_set G)"
 proof -
   have "triangle_set G \<subseteq> Pow (uverts G)"
     using PowI local.wf triangle_in_graph_def triangle_set_def uwellformed_def by auto
   then show ?thesis
     by (meson fin finite_Pow_iff infinite_super)
 qed
 
 lemma card_triangle_3: 
   assumes "t \<in> triangle_set G" "uwellformed G"
   shows "card t = 3"
   using assms by (auto simp: triangle_set_def edge_vertices_not_equal triangle_in_graph_def)
 
 lemma triangle_set_power_set_ss: "uwellformed G \<Longrightarrow> triangle_set G \<subseteq> Pow (uverts G)"
   by (auto simp add: triangle_set_def triangle_in_graph_def uwellformed_alt_fst uwellformed_alt_snd)
 
 lemma triangle_in_graph_ss: 
   assumes "uedges Gnew \<subseteq> uedges G" 
   assumes "triangle_in_graph x y z Gnew"
   shows "triangle_in_graph x y z G"
 using assms triangle_in_graph_def by auto 
 
 lemma triangle_set_graph_edge_ss: 
   assumes "uedges Gnew \<subseteq> uedges G" 
   assumes "uverts Gnew = uverts G"
   shows "triangle_set Gnew \<subseteq> triangle_set G"
   using assms unfolding triangle_set_def by (blast intro: triangle_in_graph_ss)
 
 lemma triangle_set_graph_edge_ss_bound: 
   fixes G :: "ugraph" and Gnew :: "ugraph"
   assumes "uwellformed G" "finite (uverts G)" "uedges Gnew \<subseteq> uedges G" "uverts Gnew = uverts G"
   shows "card (triangle_set G) \<ge> card (triangle_set Gnew)"
   by (simp add: assms card_mono finite_triangle_set triangle_set_graph_edge_ss)
 
 
 subsection \<open>The Triangle Counting Lemma and the Triangle Removal Lemma\<close>
 
 text\<open>We begin with some more auxiliary material to be used in the main lemmas.\<close>
 
 lemma regular_pair_neighbor_bound: 
   fixes \<epsilon>::real
   assumes finG: "finite (uverts G)"
   assumes xss: "X \<subseteq> uverts G" and yss: "Y \<subseteq> uverts G" and "card X > 0"
     and wf: "uwellformed G"
-    and eg0: "\<epsilon> > 0" and "regular_pair X Y G \<epsilon>" and ed: "edge_density X Y G \<ge> 2*\<epsilon>"
+    and eg0: "\<epsilon> > 0" and "\<epsilon>-regular_pair X Y G" and ed: "edge_density X Y G \<ge> 2*\<epsilon>"
   defines "X' \<equiv> {x \<in> X. card (neighbors_ss x Y G) < (edge_density X Y G - \<epsilon>) * card (Y)}"
   shows "card X' < \<epsilon> * card X" 
     (is "card (?X') < \<epsilon> * _")
 proof (cases "?X' = {}")
   case False \<comment>\<open>Following Gowers's proof - more in depth with reasoning on contradiction\<close>
   let ?rxy = "1/(card X' * card Y)" 
   show ?thesis 
   proof (rule ccontr)
     assume "\<not> (card (X') <  \<epsilon> * card X) " 
     then have a: "(card(X') \<ge>  \<epsilon> * card X) " by simp
     have fin: "finite X" "finite Y" using assms finite_subset by auto
     have ebound: "\<epsilon> \<le> 1/2"
       by (metis ed edge_density_le1 le_divide_eq_numeral1(1) mult.commute order_trans)
     have finx: "finite X'" using fin X'_def by simp 
     have "\<And> x. x \<in> X'\<Longrightarrow> (card (neighbors_ss x Y G)) < (edge_density X Y G - \<epsilon>) * (card Y)"
       unfolding X'_def by blast 
     then have "(\<Sum>x\<in>X'. card (neighbors_ss x Y G)) < (\<Sum>x\<in>X'. ((edge_density X Y G - \<epsilon>) * (card Y)))"
       using False sum_strict_mono X'_def
       by (smt (verit, del_insts) finx of_nat_sum)
     then have upper: "(\<Sum>x\<in>X'. card (neighbors_ss x Y G)) < (card X') * ((edge_density X Y G - \<epsilon>) * (card Y))"
       by (simp add: sum_bounded_above)
     have yge0: "card Y > 0"
       by (metis gr0I mult_eq_0_iff of_nat_0 of_nat_less_0_iff upper)
     have "?rxy > 0"
       using card_0_eq finx False yge0 X'_def by fastforce 
     then have upper2: "?rxy * (\<Sum>x\<in>X'. card (neighbors_ss x Y G)) < ?rxy * (card X') * ((edge_density X Y G - \<epsilon>) * (card Y))"
       by (smt (verit) mult.assoc mult_le_cancel_left upper)
     have "?rxy * (card X') * ((edge_density X Y G - \<epsilon>) * (card Y)) = edge_density X Y G - \<epsilon>"
       using False X'_def finx by force
     with \<open>\<epsilon> > 0\<close> upper2 have con: "edge_density X Y G - ?rxy * (\<Sum>x\<in>X'. card (neighbors_ss x Y G)) > \<epsilon>" 
       by linarith
     have "\<bar>edge_density X Y G - ?rxy * (\<Sum>x\<in>X'. card (neighbors_ss x Y G))\<bar> 
         = \<bar>?rxy * (card (all_edges_between X' Y G)) - edge_density X Y G\<bar>"
       using card_all_edges_betw_neighbor fin wf by (simp add: X'_def)
     also have "... = \<bar>edge_density X' Y G - edge_density X Y G\<bar>"
       by (simp add: edge_density_def)
     also have "... \<le> \<epsilon>"
       using assms ebound yge0 a by (force simp add: X'_def regular_pair_def)
     finally show False using con by linarith
   qed 
 qed (simp add: \<open>card X > 0\<close> eg0)
 
 lemma neighbor_set_meets_e_reg_cond:
   fixes \<epsilon>::real 
   assumes "edge_density X Y G \<ge> 2*\<epsilon>"
   and "card (neighbors_ss x Y G) \<ge> (edge_density X Y G - \<epsilon>) * card Y"
 shows "card (neighbors_ss x Y G) \<ge> \<epsilon> * card (Y)"
   by (smt (verit) assms mult_right_mono of_nat_0_le_iff)
 
 lemma all_edges_btwn_neighbor_sets_lower_bound: 
   fixes \<epsilon>::real 
-  assumes rp2: "regular_pair Y Z G \<epsilon>"
+  assumes rp2: "\<epsilon>-regular_pair Y Z G"
     and ed1: "edge_density X Y G  \<ge> 2*\<epsilon>" and ed2: "edge_density X Z G  \<ge> 2*\<epsilon>" 
     and cond1: "card (neighbors_ss x Y G) \<ge> (edge_density X Y G - \<epsilon>) * card Y"
     and cond2: "card (neighbors_ss x Z G) \<ge> (edge_density X Z G - \<epsilon>) * card Z"
   shows "card (all_edges_between (neighbors_ss x Y G) (neighbors_ss x Z G) G) 
       \<ge> (edge_density Y Z G - \<epsilon>) * card (neighbors_ss x Y G) * card (neighbors_ss x Z G)"
     (is "card (all_edges_between ?Y' ?Z' G) \<ge> (edge_density Y Z G - \<epsilon>) * card ?Y' * card ?Z'")
 proof -
   have yss': "?Y' \<subseteq> Y" using neighbors_ss_def by simp
   have zss': "?Z' \<subseteq> Z" using neighbors_ss_def by simp
   have min_sizeY: "card ?Y' \<ge> \<epsilon> * card Y"
     using cond1 ed1 neighbor_set_meets_e_reg_cond by blast 
   have min_sizeZ: "card ?Z' \<ge> \<epsilon> * card Z"
     using cond2 ed2 neighbor_set_meets_e_reg_cond by blast 
   then have "\<bar> edge_density ?Y' ?Z' G - edge_density Y Z G \<bar> \<le> \<epsilon>"
     using min_sizeY yss' zss' assms by (force simp add: regular_pair_def)
   then have "edge_density Y Z G - \<epsilon> \<le> (card (all_edges_between ?Y' ?Z' G)/(card ?Y' * card ?Z'))" 
     using edge_density_def by simp
   then have "(card ?Y' * card ?Z') * (edge_density Y Z G - \<epsilon>) \<le> (card (all_edges_between ?Y' ?Z' G))"
     by (fastforce simp: divide_simps mult.commute simp flip: of_nat_mult split: if_split_asm)
   then show ?thesis
     by (metis (no_types, lifting) mult.assoc mult_of_nat_commute of_nat_mult) 
 qed
 
 
 text\<open>We are now ready to show the Triangle Counting Lemma:\<close>
 
 theorem triangle_counting_lemma:
   fixes \<epsilon>::real 
   assumes xss: "X \<subseteq> uverts G" and yss: "Y \<subseteq> uverts G" and zss: "Z \<subseteq> uverts G" and en0: "\<epsilon> > 0"
     and finG: "finite (uverts G)" and wf: "uwellformed G"    
-    and rp1: "regular_pair X Y G \<epsilon>" and rp2: "regular_pair Y Z G \<epsilon>" and rp3: "regular_pair X Z G \<epsilon>"
+    and rp1: "\<epsilon>-regular_pair X Y G" and rp2: "\<epsilon>-regular_pair Y Z G" and rp3: "\<epsilon>-regular_pair X Z G"
     and ed1: "edge_density X Y G \<ge> 2*\<epsilon>" and ed2: "edge_density X Z G \<ge> 2*\<epsilon>" and ed3: "edge_density Y Z G \<ge> 2*\<epsilon>"
   shows "card (triangle_triples X Y Z G)
         \<ge> (1-2*\<epsilon>) * (edge_density X Y G - \<epsilon>) * (edge_density X Z G - \<epsilon>) * (edge_density Y Z G - \<epsilon>)*
            card X * card Y * card Z" 
 proof -
   let ?T_all = "{(x,y,z) \<in> X \<times> Y \<times> Z. (triangle_in_graph x y z G)}"
   let ?ediff = "\<lambda>X Y. edge_density X Y G - \<epsilon>"
   define XF where "XF \<equiv> \<lambda>Y. {x \<in> X. card(neighbors_ss x Y G) < ?ediff X Y * card Y}"
   have fin: "finite X" "finite Y" "finite Z" using finG rev_finite_subset xss yss zss by auto
   then have "card X > 0"
     using card_0_eq ed1 edge_density_def en0  by fastforce
   
   text\<open> Obtain a subset of @{term X} where all elements meet minimum numbers for neighborhood size
 in @{term Y} and @{term Z}.\<close>
   
   define X2 where "X2 \<equiv> X - (XF Y \<union> XF Z)"
   have xss: "X2 \<subseteq> X" and finx2: "finite X2"
     by (auto simp add: X2_def fin)
   
   text \<open>Reasoning on the minimum size of @{term X2}:\<close>
   have part1: "(XF Y \<union> XF Z) \<union> X2 = X"
     by (auto simp: XF_def X2_def)
   have card_XFY: "card (XF Y) <  \<epsilon> * card X" 
     using regular_pair_neighbor_bound assms \<open>card X > 0\<close> by (simp add: XF_def)
   
   text\<open> We now repeat the same argument as above to the regular pair @{term X} @{term Z} in @{term G}.\<close>
   have card_XFZ: "card (XF Z) < \<epsilon> * card X"
     using regular_pair_neighbor_bound assms \<open>card X > 0\<close> by (simp add: XF_def)
   have "card (XF Y \<union> XF Z) \<le> 2 * \<epsilon> * (card X)"
     by (smt (verit) card_XFY card_XFZ card_Un_le comm_semiring_class.distrib of_nat_add of_nat_mono)
   then have "card X2 \<ge> card X - 2 * \<epsilon> * card X" 
     using part1 by (smt (verit, del_insts) card_Un_le of_nat_add of_nat_mono) 
   then have minx2: "card X2 \<ge> (1 - 2 * \<epsilon>) * card X"
     by (metis mult.commute mult_cancel_left2 right_diff_distrib)
   
   text \<open>Reasoning on the minimum number of edges between neighborhoods of @{term X} in @{term Y} 
 and @{term Z}.\<close>
  
   have edyzgt0: "?ediff Y Z > 0" and edxygt0: "?ediff X Y > 0" 
     using ed1 ed3 \<open>\<epsilon> > 0\<close> by linarith+
   have card_y_bound: "card (neighbors_ss x Y G) \<ge> ?ediff X Y * card Y"
     and card_z_bound: "card (neighbors_ss x Z G) \<ge> ?ediff X Z * card Z"
     if "x \<in> X2" for x
     using that by (auto simp: XF_def X2_def)
   have card_y_bound': 
           "(\<Sum>x\<in> X2. ?ediff Y Z * (card (neighbors_ss x Y G)) * (card (neighbors_ss x Z G))) \<ge>
            (\<Sum>x\<in> X2. ?ediff Y Z * ?ediff X Y * (card Y) * (card (neighbors_ss x Z G)))" 
       by (rule sum_mono) (smt (verit, best) mult.left_commute card_y_bound edyzgt0 mult.commute mult_right_mono of_nat_0_le_iff)
   have card_z_bound': 
          "(\<Sum>x\<in> X2. ?ediff Y Z * ?ediff X Y * (card Y) * (card (neighbors_ss x Z G))) \<ge>
           (\<Sum>x\<in> X2. ?ediff Y Z * ?ediff X Y * (card Y) * ?ediff X Z * (card Z))" 
       using card_z_bound mult_left_mono edxygt0 edyzgt0 by (fastforce intro!: sum_mono)
   have eq_set: "\<And>x. {(y,z). y \<in> Y \<and> z \<in> Z \<and> {y, z} \<in> uedges G \<and> neighbor_in_graph x y G \<and> neighbor_in_graph x z G } = 
                      {(y,z). y \<in> (neighbors_ss x Y G) \<and> z \<in> (neighbors_ss x Z G) \<and> {y, z} \<in> uedges G }"
     by (auto simp: neighbors_ss_def)
   have "card ?T_all = (\<Sum>x\<in> X . card {(y,z) \<in> Y \<times> Z. triangle_in_graph x y z G})"
     using triple_sigma_rewrite_card fin by force  
   also have "\<dots> = (\<Sum>x\<in> X . card {(y,z). y \<in> Y \<and> z \<in> Z \<and> {y, z} \<in> uedges G \<and> neighbor_in_graph x y G \<and> neighbor_in_graph x z G })"
     using triangle_in_graph_edge_point assms by auto
   also have "... = (\<Sum>x \<in> X. card (all_edges_between (neighbors_ss x Y G) (neighbors_ss x Z G) G))"
     using all_edges_between_def eq_set by presburger
   finally have l: "card ?T_all \<ge> (\<Sum>x\<in> X2 . card (all_edges_between (neighbors_ss x Y G) (neighbors_ss x Z G) G))"
     by (simp add: fin xss sum_mono2)
   have "(\<Sum>x\<in> X2. ?ediff Y Z * (card (neighbors_ss x Y G)) * (card (neighbors_ss x Z G))) \<le> 
         (\<Sum>x\<in> X2. real (card (all_edges_between (neighbors_ss x Y G) (neighbors_ss x Z G) G)))"
         (is "sum ?F _ \<le> sum ?G _")
   proof (rule sum_mono)
     show  "\<And>x. x \<in> X2 \<Longrightarrow> ?F x \<le> ?G x"
       using all_edges_btwn_neighbor_sets_lower_bound card_y_bound card_z_bound ed1 ed2 rp2 by blast
   qed
   then have "card ?T_all \<ge> card X2 * ?ediff Y Z * ?ediff X Y * card Y * ?ediff X Z * card Z" 
     using card_z_bound' card_y_bound' l of_nat_le_iff [symmetric, where 'a=real] by force
   then have "real (card ?T_all) \<ge> ((1 - 2 * \<epsilon>) * card X) * ?ediff Y Z * 
       ?ediff X Y * (card Y) * ?ediff X Z * (card Z)"
     by (smt (verit, best) ed2 edxygt0 edyzgt0 en0 minx2 mult_right_mono of_nat_0_le_iff)
   then show ?thesis by (simp add: triangle_triples_def mult.commute mult.left_commute) 
 qed
 
 
-definition regular_graph :: "uvert set set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool"
-  where "regular_graph P G \<epsilon> \<equiv> \<forall>R S. R\<in>P \<longrightarrow> S\<in>P \<longrightarrow> regular_pair R S G \<epsilon>" for \<epsilon>::real
+definition regular_graph :: "real \<Rightarrow> uvert set set \<Rightarrow> ugraph \<Rightarrow> bool"  
+           ("_-regular'_graph" [999]1000)
+  where "\<epsilon>-regular_graph P G \<equiv> \<forall>R S. R\<in>P \<longrightarrow> S\<in>P \<longrightarrow> \<epsilon>-regular_pair R S G" for \<epsilon>::real
 
 text \<open>A minimum density, but empty edge sets are excluded.\<close>
 
 definition edge_dense :: "nat set \<Rightarrow> nat set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool"
   where "edge_dense X Y G \<epsilon> \<equiv> all_edges_between X Y G = {} \<or> edge_density X Y G \<ge> \<epsilon>"
 
 definition dense_graph :: "uvert set set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool"
   where "dense_graph P G \<epsilon> \<equiv> \<forall>R S. R\<in>P \<longrightarrow> S\<in>P \<longrightarrow> edge_dense R S G \<epsilon>" for \<epsilon>::real
 
 definition decent :: "nat set \<Rightarrow> nat set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool"
   where "decent X Y G \<eta> \<equiv> all_edges_between X Y G = {} \<or> (card X \<ge> \<eta> \<and> card Y \<ge> \<eta>)" for \<eta>::real
 
 definition decent_graph :: "uvert set set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool"
   where "decent_graph P G \<eta> \<equiv> \<forall>R S. R\<in>P \<longrightarrow> S\<in>P \<longrightarrow> decent R S G \<eta>" 
 
 text \<open>The proof of the triangle counting lemma requires ordered triples. For each unordered triple 
 there are six permutations, hence the factor of $1/6$ here.\<close>
 
 lemma card_convert_triangle_rep:
   fixes G :: "ugraph" 
   assumes "X \<subseteq> uverts G" and "Y \<subseteq> uverts G" and "Z \<subseteq> uverts G" and fin: "finite (uverts G)" 
 and wf: "uwellformed G"
   shows "card (triangle_set G) \<ge> 1/6 * card {(x,y,z) \<in> X \<times> Y \<times> Z . (triangle_in_graph x y z G)}"
          (is  "_ \<ge> 1/6 * card ?TT")
 proof -
   define tofl where "tofl \<equiv> \<lambda>l::nat list. (hd l, hd(tl l), hd(tl(tl l)))"
   have in_tofl: "(x,y,z) \<in> tofl ` permutations_of_set {x,y,z}" if "x\<noteq>y" "y\<noteq>z" "x\<noteq>z" for x y z
   proof -
     have "distinct[x,y,z]"
       using that by simp
     then show ?thesis
       unfolding tofl_def image_iff 
       by (smt (verit, best) list.sel(1) list.sel(3) set_simps permutations_of_setI set_empty)
   qed
   have "?TT \<subseteq> {(x,y,z). (triangle_in_graph x y z G)}"
     by auto
   also have "\<dots> \<subseteq> (\<Union>t \<in> triangle_set G. tofl ` permutations_of_set t)"
     using edge_vertices_not_equal [OF wf] in_tofl 
     by (clarsimp simp add: triangle_set_def triangle_in_graph_def) metis
   finally have "?TT \<subseteq> (\<Union>t \<in> triangle_set G. tofl ` permutations_of_set t)" .
   then have "card ?TT \<le> card(\<Union>t \<in> triangle_set G. tofl ` permutations_of_set t)" 
     by (intro card_mono finite_UN_I finite_triangle_set) (auto simp: assms)
   also have "\<dots> \<le> (\<Sum>t \<in> triangle_set G. card (tofl ` permutations_of_set t))"
     using card_UN_le fin finite_triangle_set local.wf by blast
   also have "\<dots> \<le> (\<Sum>t \<in> triangle_set G. card (permutations_of_set t))"
     by (meson card_image_le finite_permutations_of_set sum_mono)
   also have "\<dots> \<le> (\<Sum>t \<in> triangle_set G. fact 3)"
     by (rule sum_mono) (metis card.infinite card_permutations_of_set card_triangle_3 eq_refl local.wf nat.case numeral_3_eq_3)
   also have "\<dots> = 6 * card (triangle_set G)"
     by (simp add: eval_nat_numeral)
   finally have "card ?TT \<le> 6 * card (triangle_set G)" .
   then show ?thesis
     by (simp add: divide_simps)
 qed
 
 lemma card_convert_triangle_rep_bound: 
   fixes G :: "ugraph" and t :: real
   assumes "X \<subseteq> uverts G" and "Y \<subseteq> uverts G" and "Z \<subseteq> uverts G" and fin: "finite (uverts G)" 
 and wf: "uwellformed G"
   assumes "card {(x,y,z) \<in> X \<times> Y \<times> Z . (triangle_in_graph x y z G)} \<ge> t"
   shows "card (triangle_set G) \<ge> 1/6 *t"
 proof -
   define t' where "t' \<equiv> card {(x,y,z) \<in> X \<times> Y \<times> Z . (triangle_in_graph x y z G)}"
   have "t' \<ge> t" using assms t'_def by simp
   then have tgt: "1/6 * t' \<ge> 1/6 * t" by simp
   have "card (triangle_set G) \<ge> 1/6 *t'" using t'_def card_convert_triangle_rep assms by simp
   thus ?thesis using tgt by linarith
 qed
 
 lemma edge_density_eq0:
   assumes "all_edges_between A B G = {}" and "X \<subseteq> A" "Y \<subseteq> B"
   shows "edge_density X Y G = 0"
 proof -
   have "all_edges_between X Y G = {}"
     by (metis all_edges_between_mono1 all_edges_between_mono2 assms subset_empty)
   then show ?thesis
     by (auto simp: edge_density_def)
 qed
 
 text\<open>The following is the Triangle Removal Lemma.\<close>
 
 theorem triangle_removal_lemma:
   fixes \<epsilon> :: real
   assumes egt: "\<epsilon> > 0"
   shows "\<exists>\<delta>::real > 0. \<forall>G. card(uverts G) > 0 \<longrightarrow> uwellformed G \<longrightarrow> 
           card (triangle_set G) \<le> \<delta> * card(uverts G) ^ 3 \<longrightarrow>
           (\<exists>G'. triangle_free_graph G' \<and> uverts G' = uverts G \<and> uedges G' \<subseteq> uedges G \<and> 
           card (uedges G - uedges G') \<le> \<epsilon> * (card (uverts G))\<^sup>2)"
     (is "\<exists>\<delta>::real > 0. \<forall>G. _ \<longrightarrow> _ \<longrightarrow> _ \<longrightarrow> (\<exists>Gnew. ?\<Phi> G Gnew)")
 proof (cases "\<epsilon> < 1")
   case False
   show ?thesis
   proof (intro exI conjI strip)
     fix G
     define Gnew where "Gnew \<equiv> ((uverts G), {}::uedge set)"
     assume G: "uwellformed G" "card(uverts G) > 0"
     then show "triangle_free_graph Gnew" "uverts Gnew = uverts G" "uedges Gnew \<subseteq> uedges G"
       by (auto simp: Gnew_def triangle_free_graph_empty)
     have "real (card (uedges G)) \<le> (card (uverts G))\<^sup>2"
       by (meson G card_gt_0_iff max_edges_graph of_nat_le_iff)
     also have "\<dots> \<le> \<epsilon> * (card (uverts G))\<^sup>2"
       using False mult_le_cancel_right1 by fastforce
     finally show "real (card (uedges G - uedges Gnew)) \<le> \<epsilon> * ((card (uverts G))\<^sup>2)"
       by (simp add: Gnew_def)
   qed (rule zero_less_one)
 next
   case True
   have e4gt: "\<epsilon>/4 > 0" using \<open>\<epsilon> > 0\<close> by auto
   then obtain M0 where 
     M0: "\<And>G. card (uverts G) > 0 \<Longrightarrow> \<exists>P. regular_partition (\<epsilon>/4) G P \<and> card P \<le> M0" 
     and "M0>0"
     by (metis Szemeredi_Regularity_Lemma le0 neq0_conv not_le not_numeral_le_zero)
   define D0 where "D0 \<equiv> 1/6 *(1-(\<epsilon>/2))*((\<epsilon>/4)^3)*((\<epsilon> /(4*M0))^3)"
   have "D0 > 0" 
     using \<open>0 < \<epsilon>\<close> \<open>\<epsilon> < 1\<close> \<open>M0 > 0\<close> by (simp add: D0_def zero_less_mult_iff)
   then obtain \<delta>:: "real" where \<delta>: "0 < \<delta>" "\<delta> < D0"
     by (meson dense)
   show ?thesis
   proof (rule exI, intro conjI strip)
     fix G
     assume "card(uverts G) > 0" and wf: "uwellformed G"
     then have fin: "finite (uverts G)"
       by (simp add: card_gt_0_iff)
     
     text\<open>Assume that, for a yet to be determined $\delta$, we have:\<close>
     assume ineq: "real (card (triangle_set G)) \<le> \<delta> * card (uverts G) ^ 3"
     
     text\<open>Step 1: Partition: Using Szemer\'{e}di's Regularity Lemma, we get an $\epsilon/4$ partition. \<close>
     let ?n = "card (uverts G)"
     have vne: "uverts G \<noteq> {}"
       using \<open>0 < card (uverts G)\<close> by force 
     then have ngt0: "?n > 0"
       by (simp add: fin card_gt_0_iff)
     with M0 obtain P where M: "regular_partition (\<epsilon>/4) G P" and "card P \<le> M0"
       by blast
     define M where "M \<equiv> card P"
     have "finite P"
       by (meson M fin finite_elements regular_partition_def)
     with M0 have "M > 0"
       unfolding M_def
       by (metis M card_gt_0_iff partition_onD1 partition_on_empty regular_partition_def vne)
     let ?e4M = "\<epsilon> / (4 * real M)"
     define D where "D \<equiv> 1/6 *(1-(\<epsilon>/2)) * ((\<epsilon>/4)^3) * ?e4M^3"
     have "D > 0" 
       using \<open>0 < \<epsilon>\<close> \<open>\<epsilon> < 1\<close> \<open>M > 0\<close> by (simp add: D_def zero_less_mult_iff)
     have "D0 \<le> D"
       unfolding D0_def D_def using \<open>0 < \<epsilon>\<close> \<open>\<epsilon> < 1\<close> \<open>card P \<le> M0\<close> \<open>M > 0\<close>
       by (intro mult_mono) (auto simp: frac_le M_def)
     have fin_part: "finite_graph_partition (uverts G) P M"
       using M unfolding regular_partition_def finite_graph_partition_def
       by (metis M_def \<open>0 < M\<close> card_gt_0_iff)
     then have fin_P: "finite R" and card_P_gt0: "card R > 0" if "R\<in>P" for R
       using fin finite_graph_partition_finite finite_graph_partition_gt0 that by auto
     have card_P_le: "card R \<le> ?n" if "R\<in>P" for R
       by (meson card_mono fin fin_part finite_graph_partition_subset that)
     have P_disjnt: "\<And>R S. \<lbrakk>R \<noteq> S; R \<in> P; S \<in> P\<rbrakk> \<Longrightarrow> R \<inter> S = {}"
       using fin_part
       by (metis disjnt_def finite_graph_partition_def insert_absorb pairwise_insert partition_on_def) 
     have sum_card_P: "(\<Sum>R\<in>P. card R) = ?n"
       using card_finite_graph_partition fin fin_part by meson
     
     text\<open>Step 2. Cleaning. For each ordered pair of parts $(P_i,P_j)$, remove all edges between 
       $P_i$ and $P_j$ if (a) it is an irregular pair, (b) its edge density ${} < \epsilon/2$, 
       (c) either $P_i$ or $P_j$ is small (${}\le(\epsilon/4M)n$)
     Process (a) removes at most $(\epsilon/4)n^2$ edges. 
     Process (b) removes at most $(\epsilon/2)n^2$ edges.
     Process (c) removes at most $(\epsilon/4)n^2$ edges. 
    The remaining graph is triangle-free for some choice of $\delta$. \<close>
     
     define edge where "edge \<equiv> \<lambda>R S. mk_uedge ` (all_edges_between R S G)"
     have edge_commute: "edge R S = edge S R" for R S
       by (force simp add: edge_def all_edges_between_swap [of S] split: prod.split)
     have card_edge_le_card: "card (edge R S) \<le> card (all_edges_between R S G)" for R S
       by (simp add: card_image_le edge_def fin finite_all_edges_between' local.wf)
     have card_edge_le: "card (edge R S) \<le> card R * card S" if "R\<in>P" "S\<in>P" for R S
       by (meson card_edge_le_card fin_P le_trans max_all_edges_between that)
     
     text \<open>Obtain the set of edges meeting condition (a).\<close>
     
-    define irreg_pairs where "irreg_pairs \<equiv> {(R,S). R \<in> P \<and> S \<in> P \<and> \<not> regular_pair R S G (\<epsilon>/4)}"
+    define irreg_pairs where "irreg_pairs \<equiv> {(R,S). R \<in> P \<and> S \<in> P \<and> \<not> (\<epsilon>/4)-regular_pair R S G}"
     define Ea where "Ea \<equiv> (\<Union>(R,S) \<in> irreg_pairs. edge R S)"
     
     text \<open>Obtain the set of edges meeting condition (b).\<close>
     
     define low_density_pairs
       where "low_density_pairs \<equiv> {(R,S). R \<in> P \<and> S \<in> P \<and> \<not> edge_dense R S G (\<epsilon>/2)}"
     define Eb where "Eb \<equiv> (\<Union>(i,j) \<in> low_density_pairs. edge i j)"
     
     text \<open>Obtain the set of edges meeting condition (c).\<close>
     
     define small where "small \<equiv> \<lambda>R. R \<in> P \<and> card R \<le> ?e4M * ?n"
     let ?SMALL = "Collect small"
     define small_pairs where "small_pairs \<equiv> {(R,S). R \<in> P \<and> S \<in> P \<and> (small R \<or> small S)}"
     define Ec where "Ec \<equiv> (\<Union>R \<in> ?SMALL. \<Union>S \<in> P. edge R S)"
     have Ec_def': "Ec = (\<Union>(i,j) \<in> small_pairs. edge i j)"
       by (force simp: edge_commute small_pairs_def small_def Ec_def)
     have eabound: "card Ea \<le> (\<epsilon>/4) * ?n^2"  \<comment>\<open>Count the edge bound for @{term Ea}\<close>
     proof - 
       have \<section>: "\<And>R S. \<lbrakk>R \<in> P; S \<in> P\<rbrakk> \<Longrightarrow> card (edge R S) \<le> card R * card S"
         unfolding edge_def
         by (meson card_image_le fin_P finite_all_edges_between max_all_edges_between order_trans)
       have "irreg_pairs \<subseteq> P \<times> P"
         by (auto simp: irreg_pairs_def)
       then have "finite irreg_pairs"
         by (meson \<open>finite P\<close> finite_SigmaI finite_subset)
       have "card Ea \<le> (\<Sum>(R,S)\<in>irreg_pairs. card (edge R S))"
         by (simp add: Ea_def card_UN_le [OF \<open>finite irreg_pairs\<close>] case_prod_unfold)
-      also have "\<dots> \<le> (\<Sum>(R,S) \<in> {(R,S). R\<in>P \<and> S\<in>P \<and> \<not> regular_pair R S G (\<epsilon>/4)}. card R * card S)"
+      also have "\<dots> \<le> (\<Sum>(R,S) \<in> {(R,S). R\<in>P \<and> S\<in>P \<and> \<not> (\<epsilon>/4)-regular_pair R S G}. card R * card S)"
         unfolding irreg_pairs_def using \<section> by (force intro: sum_mono)
       also have "\<dots> = (\<Sum>(R,S) \<in> irregular_set (\<epsilon>/4) G P. card R * card S)"
         by (simp add: irregular_set_def)
       finally have "card Ea \<le> (\<Sum>(R,S) \<in> irregular_set (\<epsilon>/4) G P. card R * card S)" .
       with M show ?thesis
         unfolding regular_partition_def by linarith 
     qed
     have ebbound: "card Eb \<le> (\<epsilon>/2) * (?n^2)"  \<comment>\<open>Count the edge bound for @{term Eb}.\<close>
     proof -
       have \<section>: "\<And>R S. \<lbrakk>R \<in> P; S \<in> P; \<not> edge_dense R S G (\<epsilon> / 2)\<rbrakk>
            \<Longrightarrow> real (card (edge R S)) * 2 \<le> \<epsilon> * real (card R) * real (card S)"
         by (simp add: divide_simps edge_dense_def edge_density_def card_P_gt0) 
            (smt (verit, best) card_edge_le_card of_nat_le_iff mult.assoc)
       have subs: "low_density_pairs \<subseteq> P \<times> P"
         by (auto simp: low_density_pairs_def)
       then have "finite low_density_pairs"
         by (metis \<open>finite P\<close> finite_SigmaI finite_subset)
       have "real (card Eb) \<le> (\<Sum>(i,j)\<in>low_density_pairs. real (card (edge i j)))"
         unfolding Eb_def 
         by (smt (verit, ccfv_SIG) \<open>finite low_density_pairs\<close> card_UN_le of_nat_mono of_nat_sum 
  case_prod_unfold sum_mono)
       also have "\<dots> \<le> (\<Sum>(R,S)\<in>low_density_pairs. \<epsilon>/2 * card R * card S)"
         unfolding low_density_pairs_def by (force intro: sum_mono \<section>)
       also have "\<dots> \<le> (\<Sum>(R,S)\<in>P \<times> P. \<epsilon>/2 * card R * card S)"
         using subs \<open>\<epsilon> > 0\<close> by (intro sum_mono2) (auto simp: \<open>finite P\<close>)
       also have "\<dots> = \<epsilon>/2 * (\<Sum>(R,S)\<in>P \<times> P. card R * card S)"
         by (simp add: sum_distrib_left case_prod_unfold mult_ac)
       also have "\<dots> \<le> (\<epsilon>/2) * (?n^2)"
         using \<open>\<epsilon>>0\<close> sum_prod_le_prod_sum 
         by (simp add: power2_eq_square sum_product flip: sum.cartesian_product sum_card_P)
       finally show ?thesis .
     qed
     have ecbound: "card Ec \<le> (\<epsilon>/4) * (?n^2)"  \<comment>\<open>Count the edge bound for @{term Ec}.\<close>
     proof - 
       have edge_bound: "(card (edge R S)) \<le> ?e4M * ?n^2"
         if "S \<in> P" "small R" for R S
       proof -
         have "real (card R) \<le> \<epsilon> * ?n / (4 * real M)"
           using that by (simp add: small_def)
         with card_P_le [OF \<open>S\<in>P\<close>]
         have *: "real (card R) * real (card S) \<le> \<epsilon> * card (uverts G) / (4 * real M) * ?n"
           by (meson mult_mono of_nat_0_le_iff of_nat_mono order.trans)
         also have "\<dots> = ?e4M * ?n^2"
           by (simp add: power2_eq_square)
         finally show ?thesis
           by (smt (verit) card_edge_le of_nat_mono of_nat_mult small_def that)
       qed
       have subs: "?SMALL \<subseteq> P"
         by (auto simp: small_def)
       then obtain card_sp: "card (?SMALL) \<le> M" and "finite ?SMALL"
         using M_def \<open>finite P\<close> card_mono by (metis finite_subset)
       have "real (card Ec) \<le> (\<Sum>R \<in> ?SMALL. real (card (\<Union>S \<in> P. edge R S)))"
         unfolding Ec_def
         by (smt (verit, ccfv_SIG) \<open>finite ?SMALL\<close> card_UN_le of_nat_mono of_nat_sum case_prod_unfold sum_mono)
       also have "\<dots> \<le> (\<Sum>R \<in> ?SMALL. ?e4M * ?n^2)"
       proof (intro sum_mono)
         fix R assume i: "R \<in> Collect small"
         then have "R\<in>P" and card_Pi: "card R \<le> ?e4M * ?n"
           by (auto simp: small_def)
         let ?UE = "\<Union>(edge R ` (P))"
         have *: "real (card ?UE) \<le> real (card R * ?n)" 
         proof -
           have "?UE \<subseteq> mk_uedge ` (all_edges_between R (uverts G) G)"
             apply (simp add: edge_def UN_subset_iff Ball_def)
             by (meson all_edges_between_mono2 fin_part finite_graph_partition_subset image_mono)
           then have "card ?UE \<le> card (all_edges_between R (uverts G) G)"
             by (meson card_image_le card_mono fin finite_all_edges_between' finite_imageI wf le_trans)
           then show ?thesis
             by (meson of_nat_mono fin fin_P max_all_edges_between order.trans \<open>R\<in>P\<close>)
         qed
         also have "\<dots> \<le> ?e4M * real (?n\<^sup>2)"
           using card_Pi \<open>M > 0\<close> \<open>?n > 0\<close> by (force simp add: divide_simps power2_eq_square)
         finally show "real (card ?UE) \<le> ?e4M * real (?n\<^sup>2)" .
       qed
       also have "\<dots> \<le> card ?SMALL * (?e4M * ?n^2)"
         by simp
       also have "\<dots> \<le> M * (?e4M * ?n^2)"
         using egt by (intro mult_right_mono) (auto simp add: card_sp)
       also have "\<dots> \<le> (\<epsilon>/4) * (?n^2)"
         using \<open>M > 0\<close> by simp
       finally show ?thesis .
     qed
     \<comment>\<open>total count\<close>
     have prev1: "card (Ea \<union> Eb \<union> Ec) \<le> card (Ea \<union> Eb) + card Ec" by (simp add: card_Un_le)
     also have "\<dots> \<le> card Ea + card Eb + card Ec" by (simp add: card_Un_le)
     also have prev: "\<dots> \<le> (\<epsilon>/4)*(?n^2) + (\<epsilon>/2)*(?n^2) + (\<epsilon>/4)*(?n^2)"
       using eabound ebbound ecbound by linarith 
     finally have cutedgesbound: "card (Ea \<union> Eb \<union> Ec) \<le> \<epsilon> * (?n^2)" by simp
 
     define Gnew where "Gnew \<equiv> (uverts G, uedges G - (Ea \<union> Eb \<union> Ec))"
     show "\<exists>Gnew. ?\<Phi> G Gnew"
     proof (intro exI conjI)
       show verts: "uverts Gnew = uverts G" by (simp add: Gnew_def)
       have diffedges: "(Ea \<union> Eb \<union> Ec) \<subseteq> uedges G" 
         by (auto simp: Ea_def Eb_def Ec_def all_edges_between_def edge_def)
       then show edges: "uedges Gnew \<subseteq> uedges G"  
         by (simp add: Gnew_def)
       then have "uedges G - (uedges Gnew) = uedges G \<inter> (Ea \<union> Eb \<union> Ec) " 
         by (simp add: Gnew_def Diff_Diff_Int) 
       then have "uedges G - (uedges Gnew) = (Ea \<union> Eb \<union> Ec)" using diffedges
         by (simp add: Int_absorb1) 
       then have cardbound: "card (uedges G - uedges Gnew) \<le> \<epsilon> * (?n^2)" 
         using cutedgesbound by simp
       have graph_partition_new: "finite_graph_partition (uverts Gnew) P M" using verts
         by (simp add: fin_part) 
       have new_wf: "uwellformed Gnew" using subgraph_edge_wf verts edges wf by simp
       have new_fin: "finite (uverts Gnew)" using verts fin by simp
       
       text\<open> The notes by Bell and Grodzicki are quite useful for understanding the lines below.
          See pg 4 in the middle after the summary of the min edge counts.\<close>
       
       have irreg_pairs_swap: "(R,S) \<in> irreg_pairs \<longleftrightarrow> (S, R) \<in> irreg_pairs" for R S
         by (auto simp: irreg_pairs_def regular_pair_commute)
       have low_density_pairs_swap: "(R,S) \<in> low_density_pairs \<longleftrightarrow> (S,R) \<in> low_density_pairs" for R S
         by (simp add: low_density_pairs_def edge_density_commute edge_dense_def)
            (use all_edges_between_swap in blast)
       have small_pairs_swap: "(R,S) \<in> small_pairs \<longleftrightarrow> (S,R) \<in> small_pairs" for R S
         by (auto simp: small_pairs_def)
 
       have all_edges_if: 
         "all_edges_between R S Gnew 
          = (if (R,S) \<in> irreg_pairs \<union> low_density_pairs \<union> small_pairs then {} 
             else all_edges_between R S G)" 
         (is "?lhs = ?rhs")
         if ij: "R \<in> P" "S \<in> P" for R S
       proof
         show "?lhs \<subseteq> ?rhs"
           using that fin_part unfolding Gnew_def Ea_def Eb_def Ec_def'
           apply (simp add: all_edges_between_E_diff all_edges_between_E_Un all_edges_between_E_UN)
           apply (auto simp: edge_def in_mk_uedge_img_iff all_edges_between_def)
           done
       next
         have Ea: "all_edges_between R S (V, Ea) = {}"  
           if "(R,S) \<notin> irreg_pairs" for V
           using ij that P_disjnt
           by (auto simp: Ea_def doubleton_eq_iff edge_def all_edges_between_def irreg_pairs_def; 
               metis regular_pair_commute disjoint_iff_not_equal)
         have Eb: "all_edges_between R S (V, Eb) = {}"  
           if "(R,S) \<notin> low_density_pairs" for V
           using ij that  
           apply (auto simp: Eb_def edge_def all_edges_between_def low_density_pairs_def edge_dense_def)
            apply metis
           by (metis IntI P_disjnt doubleton_eq_iff edge_density_commute equals0D)
         have Ec: "all_edges_between R S (V, Ec) = {}"
           if "(R,S) \<notin> small_pairs" for V
           using ij that 
           by (auto simp: Ec_def' doubleton_eq_iff edge_def all_edges_between_def small_pairs_def;
               metis P_disjnt disjoint_iff)
         show "?rhs \<subseteq> ?lhs"
           by (auto simp add: Gnew_def Ea Eb Ec all_edges_between_E_diff all_edges_between_E_Un)
       qed
 
-      have rp: "regular_pair R S Gnew (\<epsilon>/4)" if ij: "R \<in> P" "S \<in> P"  for R S
+      have rp: "(\<epsilon>/4)-regular_pair R S Gnew" if ij: "R \<in> P" "S \<in> P" for R S
       proof (cases "(R,S) \<in> irreg_pairs")
         case False
         have ed: "edge_density X Y Gnew =
             (if (R,S) \<in> irreg_pairs \<union> low_density_pairs \<union> small_pairs then 0
              else edge_density X Y G)" 
           if "X \<subseteq> R" "Y \<subseteq> S" for X Y
           using all_edges_if that ij False 
           by (smt (verit) all_edges_preserved edge_density_eq0 edge_density_def) 
         show ?thesis
           using that False \<open>\<epsilon> > 0\<close>
           by (auto simp add: irreg_pairs_def regular_pair_def less_le ed)
       next
         case True
         then have ed: "edge_density X Y Gnew = 0"  if "X \<subseteq> R" "Y \<subseteq> S" for X Y
           by (meson edge_density_eq0 all_edges_if that \<open>R \<in> P\<close> \<open>S \<in> P\<close> UnCI)
         with egt that show ?thesis
           by (auto simp: regular_pair_def ed)
       qed
-      then have reg_pairs: "regular_graph P Gnew (\<epsilon>/4)"
+      then have reg_pairs: "(\<epsilon>/4)-regular_graph P Gnew"
         by (meson regular_graph_def)
 
       have "edge_dense R S Gnew (\<epsilon>/2)" 
         if "R \<in> P" "S \<in> P" for R S
       proof (cases "(R,S) \<in> low_density_pairs")
         case False
         have ed: "edge_density R S Gnew =
             (if (R,S) \<in> irreg_pairs \<union> low_density_pairs \<union> small_pairs then 0
              else edge_density R S G)" 
           using all_edges_if that that by (simp add: edge_density_def)
         with that \<open>\<epsilon> > 0\<close> False show ?thesis
           by (auto simp: low_density_pairs_def edge_dense_def all_edges_if)
       next
         case True
         then have "edge_density R S Gnew = 0" 
           by (simp add: all_edges_if edge_density_def that)
         with \<open>\<epsilon> > 0\<close> that show ?thesis
           by (simp add: True all_edges_if edge_dense_def)
       qed
       then have density_bound: "dense_graph P Gnew (\<epsilon>/2)"
         by (meson dense_graph_def)
 
       have min_subset_size: "decent_graph P Gnew (?e4M * ?n)"
         using \<open>\<epsilon> > 0\<close> 
         by (auto simp: decent_graph_def small_pairs_def small_def decent_def all_edges_if)
       show "triangle_free_graph Gnew"
       proof (rule ccontr) 
         assume non: "\<not>?thesis"
         then obtain x y z where trig_ex: "triangle_in_graph x y z Gnew" 
           using triangle_free_graph_def non by auto
         then have xin: "x \<in> (uverts Gnew)" and yin: "y \<in> (uverts Gnew)" and zin: "z \<in> (uverts Gnew)" 
           using triangle_in_graph_verts new_wf by auto
         then obtain R S T where xinp: "x \<in> R" and ilt: "R\<in>P" and yinp: "y \<in> S" and jlt: "S\<in>P"
                           and zinp: "z \<in> T" and klt: "T\<in>P" 
           by (metis graph_partition_new xin Union_iff finite_graph_partition_equals)
         then have finitesubsets: "finite R" "finite S" "finite T"
           using new_fin fin_part finite_graph_partition_finite fin by auto
         have subsets: "R \<subseteq> uverts Gnew" "S \<subseteq> uverts Gnew" "T \<subseteq> uverts Gnew" 
           using finite_graph_partition_subset ilt jlt klt graph_partition_new by auto
         have min_sizes: "card R \<ge> ?e4M*?n" "card S \<ge> ?e4M*?n" "card T \<ge> ?e4M*?n"
           using trig_ex min_subset_size xinp yinp zinp ilt jlt klt
           by (auto simp: triangle_in_graph_def decent_graph_def decent_def all_edges_between_def)
         have min_dens: "edge_density R S Gnew \<ge> \<epsilon>/2" "edge_density R T Gnew \<ge> \<epsilon>/2" "edge_density S T Gnew \<ge> \<epsilon>/2" 
           using density_bound ilt jlt klt xinp yinp zinp trig_ex 
           by (auto simp: dense_graph_def edge_dense_def all_edges_between_def triangle_in_graph_def)
         then have min_dens_diff: 
           "edge_density R S Gnew - \<epsilon>/4 \<ge> \<epsilon>/4" "edge_density R T Gnew - \<epsilon>/4 \<ge> \<epsilon>/4" "edge_density S T Gnew - \<epsilon>/4 \<ge> \<epsilon>/4" 
           by auto
         have mincard0: "(card R) * (card S) * (card T) \<ge> 0" by simp
         have gtcube: "((edge_density R S Gnew) - \<epsilon>/4)*((edge_density R T Gnew) - \<epsilon>/4) *((edge_density S T Gnew) - \<epsilon>/4) \<ge> (\<epsilon>/4)^3"
           using min_dens_diff e4gt real_mult_gt_cube by auto 
         then have c1: "((edge_density R S Gnew) - \<epsilon>/4)*((edge_density R T Gnew) - \<epsilon>/4) *((edge_density S T Gnew) - \<epsilon>/4) \<ge> 0"
           by (smt (verit) e4gt zero_less_power) 
         have "?e4M * ?n \<ge> 0"
           using egt by force
         then have "card R * card S * card T \<ge> (?e4M * ?n)^3"
           by (metis min_sizes of_nat_mult real_mult_gt_cube)
         then have cardgtbound:"card R * card S * card T \<ge> ?e4M^ 3 * ?n^3"
           by (metis of_nat_power power_mult_distrib)
 
         have "(1-\<epsilon>/2) * (\<epsilon>/4)^3 * (\<epsilon>/(4*M))^3 * ?n^3 \<le> (1-\<epsilon>/2) * (\<epsilon>/4)^3 * card R * card S * card T"
           using cardgtbound ordered_comm_semiring_class.comm_mult_left_mono True e4gt by fastforce
         also have "... \<le> (1-2*(\<epsilon>/4)) * (edge_density R S Gnew - \<epsilon>/4) * (edge_density R T Gnew - \<epsilon>/4) 
                         * (edge_density S T Gnew - \<epsilon>/4) * card R * card S * card T"
           using gtcube c1 \<open>\<epsilon> < 1\<close> mincard0 by (simp add: mult.commute mult.left_commute mult_left_mono)
         also have "... \<le> card (triangle_triples R S T Gnew)"
           by (smt (verit, best) e4gt ilt jlt klt min_dens_diff new_fin new_wf rp subsets triangle_counting_lemma)
         finally have "card (triangle_set Gnew) \<ge> D * ?n^3"
           using card_convert_triangle_rep_bound new_wf new_fin subsets 
           by (auto simp: triangle_triples_def D_def)
         then have g_tset_bound: "card (triangle_set G) \<ge> D * ?n^3" 
           using triangle_set_graph_edge_ss_bound by (smt (verit) edges fin local.wf of_nat_mono verts)
         have "card (triangle_set G) > \<delta> * ?n^3" 
         proof -
           have "?n^3 > 0"
             by (simp add: \<open>uverts G \<noteq> {}\<close> card_gt_0_iff fin)
           with \<delta> \<open>D0 \<le> D\<close> have "D * ?n^3 > \<delta> * ?n^3"
             by force
           thus "card (triangle_set G) > \<delta> * ?n ^3" 
             using g_tset_bound unfolding D_def by linarith 
         qed
         thus False
           using ineq by linarith
       qed
       show "real (card (uedges G - uedges Gnew)) \<le> \<epsilon> * real ((card (uverts G))\<^sup>2)"
         using cardbound edges verts by blast 
     qed
   qed (rule \<open>0 < \<delta>\<close>)
 qed
 
 subsection \<open>Roth's Theorem\<close>
 
 text\<open>We will first need the following corollary of the Triangle Removal Lemma.\<close>
 
 text \<open>See \<^url>\<open>https://en.wikipedia.org/wiki/Ruzsa--Szemerédi_problem\<close>.
 Suggested by Yaël Dillies
 \<close>
 corollary Diamond_free:
   fixes \<epsilon> :: real 
   assumes "0 < \<epsilon>"
   shows "\<exists>N>0. \<forall>G. card(uverts G) > N \<longrightarrow> uwellformed G \<longrightarrow> unique_triangles G \<longrightarrow>
           card (uedges G) \<le> \<epsilon> * (card (uverts G))\<^sup>2"
 proof -
   have "\<epsilon>/3 > 0"
     using assms by auto
   then obtain \<delta>::real where "\<delta> > 0"
     and \<delta>: "\<And>G. \<lbrakk>card(uverts G) > 0; uwellformed G; card (triangle_set G) \<le> \<delta> * card(uverts G) ^ 3\<rbrakk> 
                 \<Longrightarrow> \<exists>G'. triangle_free_graph G' \<and> uverts G' = uverts G \<and> (uedges G' \<subseteq> uedges G) \<and> 
                          card (uedges G - uedges G') \<le> \<epsilon>/3 * (card (uverts G))\<^sup>2"
     using triangle_removal_lemma by metis
   obtain N::nat where N: "real N \<ge> 1 / (3*\<delta>)"
     by (meson real_arch_simple)
   show ?thesis
   proof (intro exI conjI strip)
     show "N > 0"
       using N \<open>0 < \<delta>\<close> zero_less_iff_neq_zero by fastforce
     fix G 
     let ?n = "card (uverts G)"
     assume G_gt_N: "N < ?n"
       and wf: "uwellformed G"
       and uniq: "unique_triangles G"
     have G_ne: "?n > 0"
       using G_gt_N by linarith
     let ?TWO = "(\<lambda>t. [t]\<^bsup>2\<^esup>)"
     have tri_nsets_2: "[{x,y,z}]\<^bsup>2\<^esup> = {{x,y},{y,z},{x,z}}" if "triangle_in_graph x y z G" for x y z
       using that unfolding nsets_def triangle_in_graph_def card_2_iff doubleton_eq_iff
       by (blast dest!: edge_vertices_not_equal [OF wf])
     have tri_nsets_3: "{{x,y},{y,z},{x,z}} \<in> [uedges G]\<^bsup>3\<^esup>" if "triangle_in_graph x y z G" for x y z
       using that by (simp add: nsets_def card_3_iff triangle_in_graph_def) 
                     (metis doubleton_eq_iff edge_vertices_not_equal [OF wf])
     have sub: "?TWO ` triangle_set G \<subseteq> [uedges G]\<^bsup>3\<^esup>"
       using tri_nsets_2 tri_nsets_3 triangle_set_def by auto
     have "\<And>i. i \<in> triangle_set G \<Longrightarrow> ?TWO i \<noteq> {}"
       using tri_nsets_2 triangle_set_def by auto
     moreover have dfam: "disjoint_family_on ?TWO (triangle_set G)"
       using sub [unfolded image_subset_iff] uniq
       unfolding disjoint_family_on_def triangle_set_def nsets_def unique_triangles_def
       by (smt (verit) disjoint_iff_not_equal insert_subset mem_Collect_eq mk_disjoint_insert )  
     ultimately have inj: "inj_on ?TWO (triangle_set G)"
       by (simp add: disjoint_family_on_iff_disjoint_image)
     have \<section>: "\<exists>T\<in>triangle_set G. e \<in> [T]\<^bsup>2\<^esup>" if "e \<in> uedges G" for e
       using uniq [unfolded unique_triangles_def] that local.wf
       apply (simp add: triangle_set_def triangle_in_graph_def nsets_def uwellformed_def)
       by (metis (mono_tags, lifting) finite.emptyI finite.insertI finite_subset)
     with sub have "\<Union>(?TWO ` triangle_set G) = uedges G"
       by (auto simp: image_subset_iff nsets_def)
     then have "card (\<Union>(?TWO ` triangle_set G)) = card (uedges G)"
       by simp
     moreover have "card (\<Union>(?TWO ` triangle_set G)) = 3 * card (triangle_set G)"
     proof (subst card_UN_disjoint' [OF dfam])
       show "finite ([i]\<^bsup>2\<^esup>)" if "i \<in> triangle_set G" for i 
         using that tri_nsets_2 triangle_set_def by fastforce
       show "finite (triangle_set G)"
         by (meson G_ne card_gt_0_iff local.wf finite_triangle_set)
       have "card ([i]\<^bsup>2\<^esup>) = 3" if "i \<in> triangle_set G" for i
         using that wf nsets_def tri_nsets_2 tri_nsets_3 triangle_set_def by fastforce
       then show "(\<Sum>i\<in>triangle_set G. card ([i]\<^bsup>2\<^esup>)) = 3 * card (triangle_set G)"
         by simp
     qed
     ultimately have 3: "3 * card (triangle_set G) = card (uedges G)" 
       by auto
     have "card (uedges G) \<le> card (all_edges(uverts G))"
       by (meson G_ne all_edges_finite card_gt_0_iff card_mono local.wf wellformed_all_edges)
     also have "\<dots> = ?n choose 2"
       by (metis G_ne card_all_edges card_eq_0_iff not_less0)
     also have "\<dots> \<le> ?n\<^sup>2"
       by (metis binomial_eq_0_iff binomial_le_pow linorder_not_le zero_le)
     finally have "card (uedges G) \<le> ?n\<^sup>2" .
     with 3 have "card (triangle_set G) \<le> ?n\<^sup>2 / 3" by linarith
     also have "\<dots> \<le> \<delta> * ?n ^ 3"
     proof -
       have "1 \<le> 3 * \<delta> * N"
         using N \<open>\<delta> > 0\<close> by (simp add: field_simps)
       also have "\<dots> \<le> 3 * \<delta> * ?n"
         using G_gt_N \<open>0 < \<delta>\<close> by force
       finally have "1 * ?n^2 \<le> (3 * \<delta> * ?n) * ?n^2"
         by (simp add: G_ne)
       then show ?thesis
         by (simp add: eval_nat_numeral mult_ac)
     qed
     finally have "card (triangle_set G) \<le> \<delta> * ?n ^ 3" .
     then obtain Gnew where Gnew: "triangle_free_graph Gnew" "uverts Gnew = uverts G" 
       "uedges Gnew \<subseteq> uedges G" and card_edge_diff: "card (uedges G - uedges Gnew) \<le> \<epsilon>/3 * ?n\<^sup>2"
       using G_ne \<delta> local.wf by meson
     
     text\<open>Deleting an edge removes at most one triangle from the graph by assumption,
          so the number of edges removed in this process is at least the number of triangles.\<close>
     
     obtain TF where TF: "\<And>e. e \<in> uedges G \<Longrightarrow> \<exists>x y z. TF e = {x,y,z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> TF e"
       using uniq unfolding unique_triangles_def by metis
     have False
       if non: "\<And>e. e \<in> uedges G - uedges Gnew \<Longrightarrow> {x,y,z} \<noteq> TF e"
         and tri: "triangle_in_graph x y z G" for x y z
     proof -
       have "\<not> triangle_in_graph x y z Gnew"
         using Gnew triangle_free_graph_def by blast
       with tri obtain e where eG: "e \<in> uedges G - uedges Gnew" and esub: "e \<subseteq> {x,y,z}"
         using insert_commute triangle_in_graph_def by auto
       then show False
         by (metis DiffD1 TF tri uniq unique_triangles_def non [OF eG])
     qed
     then have "triangle_set G \<subseteq> TF ` (uedges G - uedges Gnew)"
       unfolding triangle_set_def by blast
     moreover have "finite (uedges G - uedges Gnew)"
       by (meson G_ne card_gt_0_iff finite_Diff finite_graph_def wf wellformed_finite)
     ultimately have "card (triangle_set G) \<le> card (uedges G - uedges Gnew)"
       by (meson surj_card_le)
     then show "card (uedges G) \<le> \<epsilon> * ?n\<^sup>2"
       using 3 card_edge_diff by linarith
   qed
 qed
 
 text\<open>We are now ready to proceed to the proof of Roth's Theorem for Arithmetic Progressions. \<close>
 
 definition progression3 :: "'a::comm_monoid_add \<Rightarrow> 'a \<Rightarrow> 'a set"
   where "progression3 k d \<equiv> {k, k+d, k+d+d}"
 
 lemma p3_int_iff: "progression3 (int k) (int d) \<subseteq> int ` A \<longleftrightarrow> progression3 k d \<subseteq> A"
   apply (simp add: progression3_def image_iff)
   by (smt (verit, best) int_plus of_nat_eq_iff)
 
 text\<open>We assume that a set of naturals $A \subseteq \{...<N \}$ does not have any arithmetic progression. 
 We will then show that @{term A} is of cardinality $o(N)$.\<close>
 
 lemma RothArithmeticProgressions_aux:
   fixes \<epsilon>::real
   assumes "\<epsilon> > 0"
   obtains M where "\<forall>N \<ge> M. \<forall>A \<subseteq> {..<N}. (\<nexists>k d. d>0 \<and> progression3 k d \<subseteq> A) \<longrightarrow> card A < \<epsilon> * real N"
 proof -
   obtain L where "L>0"
     and L: "\<And>G. \<lbrakk>card(uverts G) > L; uwellformed G; unique_triangles G\<rbrakk> 
                 \<Longrightarrow> card (uedges G) \<le> \<epsilon>/12 * (card (uverts G))\<^sup>2"
     by (metis assms Diamond_free less_divide_eq_numeral1(1) mult_eq_0_iff)
   show thesis
   proof (intro strip that)
     fix N A
     assume "L \<le> N" and A: "A \<subseteq> {..<N}"
       and non: "\<nexists>k d. 0 < d \<and> progression3 k d \<subseteq> A"
     then have "N > 0" using \<open>0 < L\<close> by linarith
     define M where "M \<equiv> Suc (2*N)"
     have M_mod_bound[simp]: "x mod M < M" for x
       by (simp add: M_def)
     have "odd M" "M>0" "N<M" by (auto simp: M_def)
     have "coprime M (Suc N)"
       unfolding M_def
       by (metis add_2_eq_Suc coprime_Suc_right_nat coprime_mult_right_iff mult_Suc_right)
     then have cop: "coprime M (1 + int N)"
       by (metis coprime_int_iff of_nat_Suc)
     have A_sub_M: "int ` A \<subseteq> {..<M}"
       using A by (force simp: M_def)
     have non_img_A: "\<nexists>k d. d > 0 \<and> progression3 k d \<subseteq> int ` A"
       by (metis imageE insert_subset non p3_int_iff pos_int_cases progression3_def)
     
     text\<open>Construct a tripartite graph @{term G} whose three parts are copies of @{text"\<int>/M\<int>"}.\<close>
     
     define part_of where "part_of \<equiv> \<lambda>\<xi>. (\<lambda>i. prod_encode (\<xi>,i)) ` {..<M}"
     define label_of_part where "label_of_part \<equiv> \<lambda>p. fst (prod_decode p)"
     define from_part where "from_part \<equiv> \<lambda>p. snd (prod_decode p)"
     have enc_iff [simp]: "prod_encode (a,i) \<in> part_of a' \<longleftrightarrow> a'=a \<and> i<M" for a a' i
       using \<open>0 < M\<close> by (clarsimp simp: part_of_def image_iff Bex_def) presburger
     have part_of_M: "p \<in> part_of a \<Longrightarrow> from_part p < M" for a p
       using from_part_def part_of_def by fastforce
     have disjnt_part_of: "a \<noteq> b \<Longrightarrow> disjnt (part_of a) (part_of b)" for a b
       by (auto simp: part_of_def disjnt_iff)
     have from_enc [simp]: "from_part (prod_encode (a,i)) = i" for a i
       by (simp add: from_part_def)
     have finpart [iff]: "finite (part_of a)" for a
       by (simp add: part_of_def \<open>0 < M\<close>)
     have cardpart [simp]: "card (part_of a) = M" for a
       using \<open>0 < M\<close>
       by (simp add: part_of_def eq_nat_nat_iff inj_on_def card_image)
     let ?X = "part_of 0"
     let ?Y = "part_of (Suc 0)"
     let ?Z = "part_of (Suc (Suc 0))"
     define diff where "diff \<equiv> \<lambda>a b. (int a - int b) mod (int M)"
     have inj_on_diff: "inj_on (\<lambda>x. diff x a) {..<M}" for a
       apply (clarsimp simp: diff_def inj_on_def)
       by (metis diff_add_cancel mod_add_left_eq mod_less nat_int of_nat_mod)
     have eq_mod_M: "(x - y) mod int M = (x' - y) mod int M \<Longrightarrow> x mod int M = x' mod int M" for x x' y
       by (simp add: mod_eq_dvd_iff)
 
     have diff_invert: "diff y x = int a \<longleftrightarrow> y = (x + a) mod M" if "y < M" "a\<in>A" for x y a
     proof -
       have "a < M"
         using A \<open>N < M\<close> that by auto
       show ?thesis
       proof
         assume "diff y x = int a"
         with that \<open>a<M\<close> have "int y = int (x+a) mod int M"
           by (smt (verit) diff_def eq_mod_M mod_less of_nat_add zmod_int)
         with that show "y = (x + a) mod M"
           by (metis nat_int zmod_int)
       qed (simp add: \<open>a < M\<close> diff_def mod_diff_left_eq zmod_int)
     qed
 
     define diff2 where "diff2 \<equiv> \<lambda>a b. ((int a - int b) * int(Suc N)) mod (int M)"
     have inj_on_diff2: "inj_on (\<lambda>x. diff2 x a) {..<M}" for a
       apply (clarsimp simp: diff2_def inj_on_def)
       by (metis eq_mod_M mult_mod_cancel_right [OF _ cop] int_int_eq mod_less zmod_int)
     have [simp]: "(1 + int N) mod int M = 1 + int N"
       using M_def \<open>0 < N\<close> by auto
     have diff2_by2: "(diff2 a b * 2) mod M = diff a b" for a b
     proof -
       have "int M dvd ((int a - int b) * int M)"
         by simp
       then have "int M dvd ((int a - int b) * int (Suc N) * 2 - (int a - int b))"
         by (auto simp: M_def algebra_simps)
       then show ?thesis
         by (metis diff2_def diff_def mod_eq_dvd_iff mod_mult_left_eq)
     qed
     have diff2_invert: "diff2 (((x + a) mod M + a) mod M) x = int a" if "a\<in>A" for x a
     proof -
       have 1: "((x + a) mod M + a) mod M = (x + 2*a) mod M"
         by (metis group_cancel.add1 mod_add_left_eq mult_2)
       have "(int ((x + 2*a) mod M) - int x) * (1 + int N) mod int M 
              = (int (x + 2*a) - int x) * (1 + int N) mod int M"
         by (metis mod_diff_left_eq mod_mult_cong of_nat_mod)
       also have "\<dots> = int (a * (Suc M)) mod int M"
         by (simp add: algebra_simps M_def)
       also have "\<dots> = int a mod int M"
         by simp
       also have "\<dots> = int a"
         using A M_def subsetD that by auto
       finally show ?thesis
         using that by (auto simp: 1 diff2_def)
     qed
 
     define Edges where "Edges \<equiv> \<lambda>X Y df. {{x,y}| x y. x \<in> X \<and> y \<in> Y \<and> df(from_part y) (from_part x) \<in> int ` A}"
     have Edges_subset: "Edges X Y df \<subseteq> Pow (X \<union> Y)" for X Y df
       by (auto simp: Edges_def)
     define XY where "XY \<equiv> Edges ?X ?Y diff"
     define YZ where "YZ \<equiv> Edges ?Y ?Z diff"
     define XZ where "XZ \<equiv> Edges ?X ?Z diff2"
     obtain [simp]: "finite XY" "finite YZ" "finite XZ"
       using Edges_subset unfolding XY_def YZ_def XZ_def
       by (metis finite_Pow_iff finite_UnI finite_subset finpart)
     define G where "G \<equiv> (?X \<union> ?Y \<union> ?Z, XY \<union> YZ \<union> XZ)"
     have finG: "finite (uverts G)" and cardG: "card (uverts G) = 3*M"
       by (simp_all add: G_def card_Un_disjnt disjnt_part_of)
     then have "card(uverts G) > L"
       using M_def \<open>L \<le> N\<close> by linarith 
     have "uwellformed G"
       by (fastforce simp: card_insert_if part_of_def G_def XY_def YZ_def XZ_def Edges_def uwellformed_def)
     have [simp]: "{prod_encode (\<xi>,x), prod_encode (\<xi>,y)} \<notin> XY"  
                  "{prod_encode (\<xi>,x), prod_encode (\<xi>,y)} \<notin> YZ"
                  "{prod_encode (\<xi>,x), prod_encode (\<xi>,y)} \<notin> XZ" for x y \<xi>
       by (auto simp: XY_def YZ_def XZ_def Edges_def doubleton_eq_iff)
     have label_ne_XY [simp]: "label_of_part p \<noteq> label_of_part q" if "{p,q} \<in> XY" for p q
       using that by (auto simp add: XY_def part_of_def Edges_def doubleton_eq_iff label_of_part_def)
     then have [simp]: "{p} \<notin> XY" for p
       by (metis insert_absorb2)
     have label_ne_YZ [simp]: "label_of_part p \<noteq> label_of_part q" if "{p,q} \<in> YZ" for p q
       using that by (auto simp add: YZ_def part_of_def Edges_def doubleton_eq_iff label_of_part_def)
     then have [simp]: "{p} \<notin> YZ" for p
       by (metis insert_absorb2)
     have label_ne_XZ [simp]: "label_of_part p \<noteq> label_of_part q" if "{p,q} \<in> XZ" for p q
       using that by (auto simp add: XZ_def part_of_def Edges_def doubleton_eq_iff label_of_part_def)
     then have [simp]: "{p} \<notin> XZ" for p
       by (metis insert_absorb2)
     have label012: "label_of_part v < 3" if "v \<in> uverts G" for v
       using that by (auto simp add: G_def eval_nat_numeral part_of_def label_of_part_def)
 
     have Edges_distinct: "\<And>p q r \<xi> \<zeta> \<gamma> \<beta> df df'. \<lbrakk>{p,q} \<in> Edges (part_of \<xi>) (part_of \<zeta>) df;
            {q,r} \<in> Edges (part_of \<xi>) (part_of \<zeta>) df;
            {p,r} \<in> Edges (part_of \<gamma>) (part_of \<beta>) df'; \<xi> \<noteq> \<zeta>; \<gamma> \<noteq> \<beta>\<rbrakk> \<Longrightarrow> False"
       apply (auto simp: disjnt_iff Edges_def doubleton_eq_iff conj_disj_distribR ex_disj_distrib)
       apply (metis disjnt_iff disjnt_part_of)+
       done
     have uniq: "\<exists>i<M. \<exists>d\<in>A. \<exists>x \<in> {p,q,r}. \<exists>y \<in> {p,q,r}. \<exists>z \<in> {p,q,r}. 
                    x = prod_encode(0, i)
                  \<and> y = prod_encode(1, (i+d) mod M)
                  \<and> z = prod_encode(2, (i+d+d) mod M)"
       if T: "triangle_in_graph p q r G" for p q r
     proof -
       obtain x y z where xy: "{x,y} \<in> XY" and yz: "{y,z} \<in> YZ" and xz: "{x,z} \<in> XZ"
         and x: "x \<in> {p,q,r}" and y: "y \<in> {p,q,r}" and z: "z \<in> {p,q,r}"
         using T apply (simp add: triangle_in_graph_def G_def XY_def YZ_def XZ_def)
         by (smt (verit, ccfv_SIG) Edges_distinct Zero_not_Suc insert_commute n_not_Suc_n)
       then have "x \<in> ?X" "y \<in> ?Y" "z \<in> ?Z"
         by (auto simp: XY_def YZ_def XZ_def Edges_def doubleton_eq_iff; metis disjnt_iff disjnt_part_of)+
       then obtain i j k where i: "x = prod_encode(0,i)" and j: "y = prod_encode(1,j)" 
         and k: "z = prod_encode(2,k)"
         by (metis One_nat_def Suc_1 enc_iff prod_decode_aux.cases prod_decode_inverse)
       obtain a1 where "a1 \<in> A" and a1: "(int j - int i) mod int M = int a1"
         using xy \<open>x \<in> ?X\<close> i j by (auto simp add: XY_def Edges_def doubleton_eq_iff diff_def)
       obtain a3 where "a3 \<in> A" and a3: "(int k - int j) mod int M = int a3"
         using yz \<open>x \<in> ?X\<close> j k by (auto simp add: YZ_def Edges_def doubleton_eq_iff diff_def)
       obtain a2 where "a2 \<in> A" and a2: "(int k - int i) mod int M = int (a2 * 2) mod int M"
         using xz \<open>x \<in> ?X\<close> i k apply (auto simp add: XZ_def Edges_def doubleton_eq_iff)
         by (metis diff2_by2 diff_def int_plus mult_2_right)
       obtain "a1<N" "a2<N" "a3<N"
         using A \<open>a1 \<in> A\<close> \<open>a2 \<in> A\<close> \<open>a3 \<in> A\<close> by blast
       then obtain "a1+a3 < M" "a2 * 2 < M"
         by (simp add: M_def)
       then have "int (a2 * 2) = int (a2 * 2) mod M"
         by force
       also have "\<dots> = int (a1 + a3) mod int M"
         using a1 a2 a3 by (smt (verit, del_insts) int_plus mod_add_eq)
       also have "\<dots> = int (a1+a3)"
         using \<open>a1 + a3 < M\<close> by force
       finally have "a2*2 = a1+a3"
         by presburger
       then obtain equal: "a3 - a2 = a2 - a1" "a2 - a3 = a1 - a2"
         by (metis Nat.diff_cancel diff_cancel2 mult_2_right)
       with \<open>a1 \<in> A\<close> \<open>a2 \<in> A\<close> \<open>a3 \<in> A\<close> have "progression3 a1 (a2 - a1) \<subseteq> A"
         apply (clarsimp simp: progression3_def)
         by (metis diff_is_0_eq' le_add_diff_inverse nle_le)
       with non equal have "a2 = a1"
         unfolding progression3_def
         by (metis \<open>a2 \<in> A\<close> \<open>a3 \<in> A\<close> add.right_neutral diff_is_0_eq insert_subset 
             le_add_diff_inverse not_gr_zero)
       then have "a3 = a2"
         using \<open>a2 * 2 = a1 + a3\<close> by force
       have k_minus_j: "(int k - int j) mod int M = int a1"
         by (simp add: \<open>a2 = a1\<close> \<open>a3 = a2\<close> a3)
       have i_to_j: "j mod M = (i+a1) mod M"
         by (metis a1 add_diff_cancel_left' add_diff_eq mod_add_right_eq nat_int of_nat_add of_nat_mod)
       have j_to_k: "k mod M = (j+a1) mod M"
         by (metis \<open>a2 = a1\<close> \<open>a3 = a2\<close> a3 add_diff_cancel_left' add_diff_eq mod_add_right_eq 
             nat_int of_nat_add of_nat_mod)
       have "i<M"
         using \<open>x \<in> ?X\<close> i by simp
       then show ?thesis
         using i j k x y z \<open>a1 \<in> A\<close>
         by (metis \<open>y \<in> ?Y\<close> \<open>z \<in>?Z\<close> enc_iff i_to_j j_to_k mod_add_left_eq mod_less)
     qed
 
     text\<open>Every edge of the graph G lies in exactly one triangle.\<close>
     have "unique_triangles G"
       unfolding unique_triangles_def
     proof (intro strip)
       fix e
       assume "e \<in> uedges G"
       then consider "e \<in> XY" | "e \<in> YZ" | "e \<in> XZ"
         using G_def by fastforce
       then show "\<exists>!T. \<exists>x y z. T = {x, y, z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> T"
       proof cases
         case 1
         then obtain i j a where eeq: "e = {prod_encode(0,i), prod_encode(1,j)}"
           and "i<M" and "j<M"
           and df: "diff j i = int a" and "a \<in> A"
           by (auto simp: XY_def Edges_def part_of_def)
         let ?x = "prod_encode (0, i)"
         let ?y = "prod_encode (1, j)"
         let ?z = "prod_encode (2, (j+a) mod M)"
         have yeq: "j = (i+a) mod M"
           using diff_invert using \<open>a \<in> A\<close> df \<open>j<M\<close> by blast
         with \<open>a \<in> A\<close> \<open>j<M\<close> have "{?y,?z} \<in> YZ"
           by (fastforce simp: YZ_def Edges_def image_iff diff_invert)
         moreover have "{?x,?z} \<in> XZ"
           using \<open>a \<in> A\<close> by (fastforce simp: XZ_def Edges_def yeq diff2_invert \<open>i<M\<close>)
         ultimately have T: "triangle_in_graph ?x ?y ?z G"
           using \<open>e \<in> uedges G\<close> by (force simp add: G_def eeq triangle_in_graph_def)
         show ?thesis
         proof (intro ex1I)
           show "\<exists>x y z. {?x,?y,?z} = {x, y, z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> {?x,?y,?z}"
             using T eeq by blast
           fix T
           assume "\<exists>p q r. T = {p, q, r} \<and> triangle_in_graph p q r G \<and> e \<subseteq> T"
           then obtain p q r where Teq: "T = {p,q,r}"
             and tri: "triangle_in_graph p q r G" and "e \<subseteq> T"
             by blast
           with uniq
           obtain i' a' x y z where "i'<M" "a' \<in> A"  
                  and x: "x \<in> {p,q,r}" and y: "y \<in> {p,q,r}" and z: "z \<in> {p,q,r}"
                  and xeq: "x = prod_encode(0, i')"
                  and yeq: "y = prod_encode(1, (i'+a') mod M)"
                  and zeq: "z = prod_encode(2, (i'+a'+a') mod M)"
             by metis
           then have sets_eq: "{x,y,z} = {p,q,r}" by auto
           with Teq \<open>e \<subseteq> T\<close> have esub': "e \<subseteq> {x,y,z}" by blast
           have "a' < M"
             using A \<open>N < M\<close> \<open>a' \<in> A\<close> by auto
           obtain "?x \<in> e" "?y \<in> e" using eeq by force
           then have "x = ?x"
             using esub' eeq yeq zeq by simp
           then have "y = ?y"
             using esub' eeq zeq by simp
           obtain eq': "i' = i" "(i'+a') mod M = j"
             using \<open>x = ?x\<close> xeq using \<open>y =?y\<close> yeq by auto
           then have "diff (i'+a') i' = int a'"
             by (simp add: diff_def \<open>a' < M\<close>)
           then have "a' = a"
             by (metis eq' df diff_def mod_diff_left_eq nat_int zmod_int)
           then have "z = ?z"
             by (metis \<open>y = ?y\<close> mod_add_left_eq prod_encode_eq snd_conv yeq zeq)
           then show "T = {?x,?y,?z}"
             using Teq \<open>x = ?x\<close> \<open>y = ?y\<close> sets_eq by presburger
         qed
       next
         case 2
         then obtain j k a where eeq: "e = {prod_encode(1,j), prod_encode(2,k)}"
           and "j<M" "k<M"
           and df: "diff k j = int a" and "a \<in> A"
           by (auto simp: YZ_def Edges_def part_of_def numeral_2_eq_2)
         let ?x = "prod_encode (0, (M+j-a) mod M)"
         let ?y = "prod_encode (1, j)"
         let ?z = "prod_encode (2, k)"
         have zeq: "k = (j+a) mod M"
           using diff_invert using \<open>a \<in> A\<close> df \<open>k<M\<close> by blast
         with \<open>a \<in> A\<close> \<open>k<M\<close> have "{?x,?z} \<in> XZ"
           unfolding XZ_def Edges_def image_iff
           apply (clarsimp simp: mod_add_left_eq doubleton_eq_iff conj_disj_distribR ex_disj_distrib)
           apply (smt (verit, ccfv_threshold) A \<open>N < M\<close> diff2_invert le_add_diff_inverse2 lessThan_iff 
                      linorder_not_less mod_add_left_eq  mod_add_self1 not_add_less1 order.strict_trans subsetD)
           done
         moreover 
         have "a < N" using A \<open>a \<in> A\<close> by blast
         with \<open>N < M\<close> have "((M + j - a) mod M + a) mod M = j mod M"
           by (simp add: mod_add_left_eq)
         then have "{?x,?y} \<in> XY"
           using \<open>a \<in> A\<close> \<open>j<M\<close> unfolding XY_def Edges_def
           by (force simp add: zeq image_iff diff_invert  doubleton_eq_iff ex_disj_distrib)
         ultimately have T: "triangle_in_graph ?x ?y ?z G"
           using \<open>e \<in> uedges G\<close> by (auto simp: G_def eeq triangle_in_graph_def)
         show ?thesis
         proof (intro ex1I)
           show "\<exists>x y z. {?x,?y,?z} = {x, y, z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> {?x,?y,?z}"
             using T eeq by blast
           fix T
           assume "\<exists>p q r. T = {p, q, r} \<and> triangle_in_graph p q r G \<and> e \<subseteq> T"
           then obtain p q r where Teq: "T = {p,q,r}" and tri: "triangle_in_graph p q r G" and "e \<subseteq> T"
             by blast
           with uniq
           obtain i' a' x y z where "i'<M" "a' \<in> A"  
                  and x: "x \<in> {p,q,r}" and y: "y \<in> {p,q,r}" and z: "z \<in> {p,q,r}"
                  and xeq: "x = prod_encode(0, i')"
                  and yeq: "y = prod_encode(1, (i'+a') mod M)"
                  and zeq: "z = prod_encode(2, (i'+a'+a') mod M)"
             by metis
           then have sets_eq: "{x,y,z} = {p,q,r}" by auto
           with Teq \<open>e \<subseteq> T\<close> have esub': "e \<subseteq> {x,y,z}" by blast
           have "a' < M"
             using A \<open>N < M\<close> \<open>a' \<in> A\<close> by auto
           obtain "?y \<in> e" "?z \<in> e"
             using eeq by force
           then have "y = ?y"
             using esub' eeq xeq zeq by simp
           then have "z = ?z"
             using esub' eeq xeq by simp
           obtain eq': "(i'+a') mod M = j" "(i'+a'+a') mod M = k"
             using \<open>y = ?y\<close> yeq using \<open>z =?z\<close> zeq by auto
           then have "diff (i'+a'+a') (i'+a') = int a'"
             by (simp add: diff_def \<open>a' < M\<close>)
           then have "a' = a"
             by (metis M_mod_bound \<open>a' \<in> A\<close> df diff_invert eq' mod_add_eq mod_if of_nat_eq_iff)
           have "(M + ((i'+a') mod M) - a') mod M = (M + (i' + a') - a') mod M"
             by (metis Nat.add_diff_assoc2 \<open>a' < M\<close> less_imp_le_nat mod_add_right_eq)
           with \<open>i' < M\<close> have "(M + ((i'+a') mod M) - a') mod M = i'"
             by force
           with \<open>a' = a\<close> eq' have "(M + j - a) mod M = i'"
             by force
           with xeq have "x = ?x" by blast
           then show "T = {?x,?y,?z}"
             using Teq \<open>z = ?z\<close> \<open>y = ?y\<close> sets_eq by presburger
         qed
       next
         case 3
         then obtain i k a where eeq: "e = {prod_encode(0,i), prod_encode(2,k)}"
           and "i<M" and "k<M"
           and df: "diff2 k i = int a" and "a \<in> A"
           by (auto simp: XZ_def Edges_def part_of_def eval_nat_numeral)
         let ?x = "prod_encode (0, i)"
         let ?y = "prod_encode (1, (i+a) mod M)"
         let ?z = "prod_encode (2, k)"
         have keq: "k = (i+a+a) mod M"
           using diff2_invert [OF \<open>a \<in> A\<close>, of i] df \<open>k<M\<close> using inj_on_diff2 [of i]
           by (simp add: inj_on_def Ball_def mod_add_left_eq)
         with \<open>a \<in> A\<close>  have "{?x,?y} \<in> XY"
           using \<open>a \<in> A\<close> \<open>i<M\<close> \<open>k<M\<close> apply (auto simp: XY_def Edges_def)
           by (metis M_mod_bound diff_invert enc_iff from_enc imageI)
         moreover have "{?y,?z} \<in> YZ"
           apply (auto simp: YZ_def Edges_def image_iff eval_nat_numeral)
           by (metis M_mod_bound \<open>a \<in> A\<close> diff_invert enc_iff from_enc mod_add_left_eq keq)
         ultimately have T: "triangle_in_graph ?x ?y ?z G"
           using \<open>e \<in> uedges G\<close> by (force simp add: G_def eeq triangle_in_graph_def)
         show ?thesis
         proof (intro ex1I)
           show "\<exists>x y z. {?x,?y,?z} = {x, y, z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> {?x,?y,?z}"
             using T eeq by blast
           fix T
           assume "\<exists>p q r. T = {p, q, r} \<and> triangle_in_graph p q r G \<and> e \<subseteq> T"
           then obtain p q r where Teq: "T = {p,q,r}" and tri: "triangle_in_graph p q r G" and "e \<subseteq> T"
             by blast
           with uniq obtain i' a' x y z where "i'<M" "a' \<in> A"  
                  and x: "x \<in> {p,q,r}" and y: "y \<in> {p,q,r}" and z: "z \<in> {p,q,r}"
                  and xeq: "x = prod_encode(0, i')"
                  and yeq: "y = prod_encode(1, (i'+a') mod M)"
                  and zeq: "z = prod_encode(2, (i'+a'+a') mod M)"
             by metis
           then have sets_eq: "{x,y,z} = {p,q,r}" by auto
           with Teq \<open>e \<subseteq> T\<close> have esub': "e \<subseteq> {x,y,z}" by blast
           have "a' < M"
             using A \<open>N < M\<close> \<open>a' \<in> A\<close> by auto
           obtain "?x \<in> e" "?z \<in> e" using eeq by force
           then have "x = ?x"
             using esub' eeq yeq zeq by simp
           then have "z = ?z"
             using esub' eeq yeq by simp
           obtain eq': "i' = i" "(i'+a'+a') mod M = k"
             using \<open>x = ?x\<close> xeq using \<open>z =?z\<close> zeq by auto
           then have "diff (i'+a') i' = int a'"
             by (simp add: diff_def \<open>a' < M\<close>)
           then have "a' = a"
             by (metis \<open>a' \<in> A\<close> add.commute df diff2_invert eq' mod_add_right_eq nat_int)
           then have "y = ?y"
             by (metis \<open>x = ?x\<close> prod_encode_eq snd_conv yeq xeq)
           then show "T = {?x,?y,?z}"
             using Teq \<open>x = ?x\<close> \<open>z = ?z\<close> sets_eq by presburger
         qed
       qed
     qed
     have *: "card (uedges G) \<le> \<epsilon>/12 * (card (uverts G))\<^sup>2"
       using L \<open>L < card (uverts G)\<close> \<open>unique_triangles G\<close> \<open>uwellformed G\<close> by blast
 
     have diff_cancel: "\<exists>j<M. diff j i = int a" if "a \<in> A" for i a
       using M_mod_bound diff_invert that by blast
     have diff2_cancel: "\<exists>j<M. diff2 j i = int a" if "a \<in> A" for i a
       using M_mod_bound diff2_invert that by blast
 
     have card_Edges: "card (Edges (part_of \<xi>) (part_of \<zeta>) df) = M * card A" (is "card ?E = _")
       if "\<xi> \<noteq> \<zeta>" and df_cancel: "\<forall>a\<in>A. \<forall>i<M. \<exists>j<M. df j i = int a" 
                  and df_inj: "\<forall>a. inj_on (\<lambda>x. df x a) {..<M}"  for \<xi> \<zeta> df
     proof -
       define R where "R \<equiv> \<lambda>\<xi> Y df u p. \<exists>x y i a. u = {x,y} \<and> p = (i,a) \<and> x = prod_encode (\<xi>,i) 
                                           \<and> y \<in> Y \<and> a \<in> A \<and> df(from_part y) (from_part x) = int a"
       have R_uniq: "\<lbrakk>R \<xi> (part_of \<zeta>) df u p; R \<xi> (part_of \<zeta>) df u p'; \<xi> \<noteq> \<zeta>\<rbrakk> \<Longrightarrow> p' = p" for u p p' \<xi> \<zeta> df
         by (auto simp add: R_def doubleton_eq_iff)
       define f where "f \<equiv> \<lambda>\<xi> Y df u. @p. R \<xi> Y df u p"
       have f_if_R: "f \<xi> (part_of \<zeta>) df u = p" if "R \<xi> (part_of \<zeta>) df u p" "\<xi> \<noteq> \<zeta>" for u p \<xi> \<zeta> df
         using R_uniq f_def that by blast
       have "bij_betw (f \<xi> (part_of \<zeta>) df) ?E ({..<M} \<times> A)"
         unfolding bij_betw_def inj_on_def
       proof (intro conjI strip)
         fix u u'
         assume "u \<in> ?E" and "u' \<in> ?E" 
           and eq: "f \<xi> (part_of \<zeta>) df u = f \<xi> (part_of \<zeta>) df u'"
         obtain x y a where u: "u = {x,y}" "x \<in> part_of \<xi>" "y \<in> part_of \<zeta>" "a \<in> A" 
           and df: "df (from_part y) (from_part x) = int a"
           using \<open>u \<in> ?E\<close> by (force simp add: Edges_def image_iff)
         then obtain i where i: "x = prod_encode (\<xi>,i)"
           using part_of_def by blast
         with u df R_def f_if_R that have fu: "f \<xi> (part_of \<zeta>) df u = (i,a)"
           by blast
         obtain x' y' a' where u': "u' = {x',y'}" "x' \<in> part_of \<xi>" "y' \<in> part_of \<zeta>" "a'\<in>A" 
            and df': "df (from_part y') (from_part x') = int a'"
           using \<open>u' \<in> ?E\<close> by (force simp add: Edges_def image_iff)
         then obtain i' where i': "x' = prod_encode (\<xi>,i')"
           using part_of_def by blast
         with u' df' R_def f_if_R that have fu': "f \<xi> (part_of \<zeta>) df u' = (i',a')" 
           by blast
         have "i'=i" "a' = a"
           using fu fu' eq by auto
         with i i' have "x = x'"
           by meson
         moreover have "from_part y = from_part y'"
           using df df' \<open>x = x'\<close> \<open>a' = a\<close> df_inj u'(3) u(3) 
           by (clarsimp simp add: inj_on_def) (metis part_of_M lessThan_iff)
         ultimately show "u = u'"
           using u u' by (metis enc_iff from_part_def prod.collapse prod_decode_inverse)
       next
         have "f \<xi> (part_of \<zeta>) df ` ?E \<subseteq> {..<M} \<times> A"
         proof (clarsimp simp: Edges_def)
           fix i a x y b
           assume "x \<in> part_of \<xi>" "y \<in> part_of \<zeta>" "df (from_part y) (from_part x) = int b"
             "b \<in> A" and feq: "(i, a) = f \<xi> (part_of \<zeta>) df {x, y}"
           then have "R \<xi> (part_of \<zeta>) df {x,y} (from_part x, b)"
             by (auto simp: R_def doubleton_eq_iff part_of_def)
           then have "(from_part x, b) = (i, a)"
             by (simp add: f_if_R feq from_part_def that)
           then show "i < M \<and> a \<in> A"
             using \<open>x \<in> part_of \<xi>\<close> \<open>b \<in> A\<close> part_of_M by fastforce
         qed
         moreover have "{..<M} \<times> A \<subseteq> f \<xi> (part_of \<zeta>) df ` ?E"
         proof clarsimp
           fix i a assume "a \<in> A" and "i < M"
           then obtain j where "j<M" and j: "df j i = int a"
             using df_cancel by metis
           then have fj: "f \<xi> (part_of \<zeta>) df {prod_encode (\<xi>, i), prod_encode (\<zeta>, j)} = (i,a)"
             by (metis R_def \<open>a \<in> A\<close> enc_iff f_if_R from_enc \<open>\<xi> \<noteq> \<zeta>\<close>)
           then have "{prod_encode (\<xi>,i), prod_encode (\<zeta>, j mod M)} \<in> Edges (part_of \<xi>) (part_of \<zeta>) df"
             apply (clarsimp simp: Edges_def doubleton_eq_iff)
             by (metis \<open>a \<in> A\<close> \<open>i < M\<close> \<open>j < M\<close> enc_iff from_enc image_eqI j mod_if)
           then show "(i,a) \<in> f \<xi> (part_of \<zeta>) df ` Edges (part_of \<xi>) (part_of \<zeta>) df"
             using \<open>j < M\<close> fj image_iff by fastforce
         qed
         ultimately show "f \<xi> (part_of \<zeta>) df ` ?E = {..<M} \<times> A" by blast
       qed
       then show ?thesis
         by (simp add: bij_betw_same_card card_cartesian_product)
     qed
     have [simp]: "disjnt XY YZ" "disjnt XY XZ" "disjnt YZ XZ"
       using disjnt_part_of unfolding XY_def YZ_def XZ_def Edges_def disjnt_def 
       by (clarsimp simp add: disjoint_iff doubleton_eq_iff, meson disjnt_iff n_not_Suc_n nat.discI)+
     have [simp]: "card XY = M * card A" "card YZ = M * card A"
       by (simp_all add: XY_def YZ_def card_Edges diff_cancel inj_on_diff)
     have [simp]: "card XZ = M * card A"
       by (simp_all add: XZ_def card_Edges diff2_cancel inj_on_diff2)
     have "card (uedges G) = 3 * M * card A"
       by (simp add: G_def card_Un_disjnt)
     then have "card A \<le> \<epsilon> * (real M / 4)"
       using * \<open>0 < M\<close> by (simp add: cardG power2_eq_square)
     also have "\<dots> < \<epsilon> * N"
       using \<open>N>0\<close> by (simp add: M_def assms)
     finally show "card A < \<epsilon> * N" .
   qed
 qed
 
 text\<open>We finally present the main statement formulated using the upper asymptotic density condition.\<close>
 
 theorem RothArithmeticProgressions:
   assumes "upper_asymptotic_density A > 0"
   shows "\<exists>k d. d>0 \<and> progression3 k d \<subseteq> A"
 proof (rule ccontr)
   assume non: "\<nexists>k d. 0 < d \<and> progression3 k d \<subseteq> A"
   obtain M where X: "\<forall>N \<ge> M. \<forall>A' \<subseteq> {..<N}. (\<nexists>k d. d>0 \<and> progression3 k d \<subseteq> A') 
                           \<longrightarrow> card A' < upper_asymptotic_density A / 2 * real N"
     by (metis half_gt_zero RothArithmeticProgressions_aux assms)
   then have "\<forall>N \<ge> M. card (A \<inter> {..<N}) < upper_asymptotic_density A / 2 * N"
     by (meson order_trans inf_le1 inf_le2 non)
   then have "upper_asymptotic_density A \<le> upper_asymptotic_density A / 2"
     by (force simp add: eventually_sequentially less_eq_real_def intro!: upper_asymptotic_densityI)
   with assms show False by linarith
 qed
 
 end
 
 
 
diff --git a/thys/Szemeredi_Regularity/Szemeredi.thy b/thys/Szemeredi_Regularity/Szemeredi.thy
--- a/thys/Szemeredi_Regularity/Szemeredi.thy
+++ b/thys/Szemeredi_Regularity/Szemeredi.thy
@@ -1,1003 +1,1007 @@
 section \<open>Szemerédi's Regularity Lemma\<close>
 
 theory Szemeredi
   imports Complex_Main "HOL-Library.Disjoint_Sets" "Girth_Chromatic.Ugraphs" "HOL-Analysis.Convex"
 
 begin
 
 text\<open>We formalise Szemerédi's Regularity Lemma, which is a major result in the study of large graphs
 (extremal graph theory).
 We follow Yufei Zhao's notes ``Graph Theory and Additive Combinatorics'' (MIT),
 latest version here: \<^url>\<open>https://yufeizhao.com/gtacbook/\<close>
 and W.T. Gowers's notes ``Topics in Combinatorics'' (University of Cambridge, Lent 2004, Chapter 3)
 \<^url>\<open>https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf\<close>.
 We also used an earlier version of Zhao's book: \<^url>\<open>https://yufeizhao.com/gtac/gtac.pdf\<close>.\<close>
 
 
 subsection \<open>Partitions\<close>
 
 subsubsection \<open>Partitions indexed by integers\<close>
 
 definition finite_graph_partition :: "[uvert set, uvert set set, nat] \<Rightarrow> bool"
   where "finite_graph_partition V P n \<equiv> partition_on V P \<and> finite P \<and> card P = n"
 
 lemma finite_graph_partition_0 [iff]:
   "finite_graph_partition V P 0 \<longleftrightarrow> V = {} \<and> P = {}"
   by (auto simp: finite_graph_partition_def partition_on_def)
 
 lemma finite_graph_partition_empty [iff]:
   "finite_graph_partition {} P n \<longleftrightarrow> P = {} \<and> n = 0"
   by (auto simp: finite_graph_partition_def partition_on_def)
 
 lemma finite_graph_partition_equals:
   "finite_graph_partition V P n \<Longrightarrow> (\<Union>P) = V"
   by (meson finite_graph_partition_def partition_on_def)
 
 lemma finite_graph_partition_subset:
   "\<lbrakk>finite_graph_partition V P n; X \<in> P\<rbrakk> \<Longrightarrow> X \<subseteq> V"
   using finite_graph_partition_equals by blast
 
 lemma trivial_graph_partition_exists:
   assumes "V \<noteq> {}"
   shows "finite_graph_partition V {V} (Suc 0)"
   by (simp add: assms finite_graph_partition_def partition_on_space)
 
 lemma finite_graph_partition_finite:
   assumes "finite_graph_partition V P k" "finite V" "X \<in> P"
   shows "finite X"
   by (meson assms finite_graph_partition_subset infinite_super)
 
 lemma finite_graph_partition_gt0:
   assumes "finite_graph_partition V P k" "finite V" "X \<in> P"
   shows "card X > 0"
   by (metis assms card_0_eq finite_graph_partition_def finite_graph_partition_finite gr_zeroI partition_on_def)
 
 lemma card_finite_graph_partition:
   assumes "finite_graph_partition V P k" "finite V"
   shows "(\<Sum>X\<in>P. card X) = card V"
   by (metis assms finite_graph_partition_def finite_graph_partition_finite product_partition)
 
 subsubsection \<open>Tools to combine the refinements of the partition @{term "P i"} for each @{term i}\<close>
 
 text \<open>These are needed to retain the ``intuitive'' idea of partitions as indexed by integers.\<close>
 
 subsection \<open>Edges\<close>
 
 text \<open>All edges between two sets of vertices, @{term X} and @{term Y}, in a graph, @{term G}\<close>
 
 definition all_edges_between :: "nat set \<Rightarrow> nat set \<Rightarrow> nat set \<times> nat set set \<Rightarrow> (nat \<times> nat) set"
   where "all_edges_between X Y G \<equiv> {(x,y). x\<in>X \<and> y\<in>Y \<and> {x,y} \<in> uedges G}"
 
 lemma all_edges_between_subset: "all_edges_between X Y G \<subseteq> X\<times>Y"
   by (auto simp: all_edges_between_def)
 
 lemma max_all_edges_between: 
   assumes "finite X" "finite Y"
   shows "card (all_edges_between X Y G) \<le> card X * card Y"
   by (metis assms card_mono finite_SigmaI all_edges_between_subset card_cartesian_product)
 
 lemma all_edges_between_empty [simp]:
   "all_edges_between {} Z G = {}" "all_edges_between Z {} G = {}"
   by (auto simp: all_edges_between_def)
 
 lemma all_edges_between_disjnt1:
   assumes "disjnt X Y"
   shows "disjnt (all_edges_between X Z G) (all_edges_between Y Z G)"
   using assms by (auto simp: all_edges_between_def disjnt_iff)
 
 lemma all_edges_between_disjnt2:
   assumes "disjnt Y Z"
   shows "disjnt (all_edges_between X Y G) (all_edges_between X Z G)"
   using assms by (auto simp: all_edges_between_def disjnt_iff)
 
 lemma all_edges_between_Un1:
   "all_edges_between (X \<union> Y) Z G = all_edges_between X Z G \<union> all_edges_between Y Z G"
   by (auto simp: all_edges_between_def)
 
 lemma all_edges_between_Un2:
   "all_edges_between X (Y \<union> Z) G = all_edges_between X Y G \<union> all_edges_between X Z G"
   by (auto simp: all_edges_between_def)
 
 lemma finite_all_edges_between:
   assumes "finite X" "finite Y"
   shows "finite (all_edges_between X Y G)"
   by (meson all_edges_between_subset assms finite_cartesian_product finite_subset)
 
 subsection \<open>Edge Density and Regular Pairs\<close>
 
 text \<open>The edge density between two sets of vertices, @{term X} and @{term Y}, in @{term G}.
       Authors disagree on whether the sets are assumed to be disjoint!.
       Quite a few authors assume disjointness, e.g. Malliaris and Shelah \<^url>\<open>https://www.jstor.org/stable/23813167\<close>.\<close>
 definition "edge_density X Y G \<equiv> card(all_edges_between X Y G) / (card X * card Y)"
 
 lemma edge_density_ge0: "edge_density X Y G \<ge> 0"
   by (auto simp: edge_density_def)
 
 lemma edge_density_le1: "edge_density K Y G \<le> 1"
 proof (cases "finite K \<and> finite Y")
   case True
   then show ?thesis 
     using of_nat_mono [OF max_all_edges_between, of K Y]
     by (fastforce simp add: edge_density_def divide_simps)
 qed (auto simp: edge_density_def)
 
 lemma all_edges_between_swap:
   "all_edges_between X Y G = (\<lambda>(x,y). (y,x)) ` (all_edges_between Y X G)"
   unfolding all_edges_between_def
   by (auto simp add: insert_commute image_iff split: prod.split)
 
 lemma card_all_edges_between_commute:
   "card (all_edges_between X Y G) = card (all_edges_between Y X G)"
 proof -
   have "inj_on (\<lambda>(x, y). (y, x)) A" for A :: "(nat*nat)set"
     by (auto simp: inj_on_def)
   then show ?thesis
     by (simp add: all_edges_between_swap [of X Y] card_image)
 qed
 
 lemma edge_density_commute: "edge_density X Y G = edge_density Y X G"
   by (simp add: edge_density_def card_all_edges_between_commute mult.commute)
 
 
 text \<open>$\epsilon$-regular pairs, for two sets of vertices. Again, authors disagree on whether the
 sets need to be disjoint, though it seems that overlapping sets cause double-counting. Authors also
 disagree about whether or not to use the strict subset relation here. The proofs below are easier if
 it is strict but later proofs require the non-strict version. The two definitions can be proved to
 be equivalent under fairly mild conditions, but even those conditions turn out to be onerous.\<close>
 
-definition regular_pair::  "uvert set  \<Rightarrow> uvert set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool"
-  where "regular_pair X Y G \<epsilon> \<equiv> 
+definition regular_pair::  "real \<Rightarrow> uvert set  \<Rightarrow> uvert set \<Rightarrow> ugraph \<Rightarrow> bool" 
+     ("_-regular'_pair" [999]1000)
+  where "\<epsilon>-regular_pair X Y G \<equiv> 
     \<forall>A B. A \<subseteq> X \<and> B \<subseteq> Y \<and> (card A \<ge> \<epsilon> * card X) \<and> (card B \<ge> \<epsilon> * card Y) \<longrightarrow>
               \<bar>edge_density A B G - edge_density X Y G\<bar> \<le> \<epsilon>" for \<epsilon>::real
 
-lemma regular_pair_commute: "regular_pair X Y G \<epsilon> \<longleftrightarrow> regular_pair Y X G \<epsilon>"
+lemma regular_pair_commute: "\<epsilon>-regular_pair X Y G \<longleftrightarrow> \<epsilon>-regular_pair Y X G"
   by (metis edge_density_commute regular_pair_def)
 
 lemma edge_density_Un:
   assumes "disjnt X1 X2" "finite X1" "finite X2"
   shows "edge_density (X1 \<union> X2) Y G = (edge_density X1 Y G * card X1 + edge_density X2 Y G * card X2) / (card X1 + card X2)"
 proof (cases "finite Y")
   case True
   with assms show ?thesis 
     by (simp add: edge_density_def all_edges_between_disjnt1 all_edges_between_Un1 finite_all_edges_between card_Un_disjnt card_ge_0_finite divide_simps)
 qed (simp add: edge_density_def)
 
 lemma edge_density_partition:
   assumes "finite_graph_partition U P n"
   shows "edge_density U W G = (\<Sum>X\<in>P. edge_density X W G * card X) / card U"
 proof (cases "finite U")
   case True
   have "finite P"
     using assms finite_graph_partition_def by blast
   then show ?thesis
     using True assms
   proof (induction P arbitrary: n U)
     case empty
     then show ?case
       by (simp add: edge_density_def finite_graph_partition_def partition_on_def)
   next
     case (insert X P)
     then have "n > 0"
       by (metis finite_graph_partition_0 gr_zeroI insert_not_empty)
     with insert.prems insert.hyps 
     have UX: "finite_graph_partition (U-X) P (n-1)"
       by (auto simp: finite_graph_partition_def partition_on_def disjnt_iff pairwise_insert)
     then have finU: "finite (\<Union>P)"
       by (simp add: finite_graph_partition_equals insert)
     then have sumXP: "card U = card X + card (\<Union>P)"
       by (metis UX card_finite_graph_partition finite_graph_partition_equals insert.hyps insert.prems sum.insert)
     have FUX: "finite (U - X)"
       by (simp add: insert.prems)
     have XUP: "X \<union> (\<Union>P) = U"
       using finite_graph_partition_equals insert.prems(2) by auto
     then have "edge_density U W G = edge_density (X \<union> \<Union>P) W G"
       by auto
     also have "\<dots> = (edge_density X W G * card X + edge_density (\<Union>P) W G * card (\<Union>P)) 
                   / (card X + card (\<Union>P))"
     proof (rule edge_density_Un)
       show "disjnt X (\<Union>P)"
         using UX disjnt_iff finite_graph_partition_equals by auto
       show "finite X"
         using XUP \<open>finite U\<close> by blast
     qed (use finU in auto)
     also have "\<dots> = (edge_density X W G * card X + edge_density (U-X) W G * card (\<Union>P)) 
                   / card U"
       using UX card_finite_graph_partition finite_graph_partition_equals insert.prems(1) insert.prems(2) sumXP by auto
     also have "\<dots> = (\<Sum>Y \<in> insert X P. edge_density Y W G * card Y) / card U"
       using UX insert.prems insert.hyps 
       apply (simp add: insert.IH [OF FUX UX] divide_simps algebra_simps finite_graph_partition_equals)
       by (metis (no_types, lifting) Diff_eq_empty_iff finite_graph_partition_empty sum.empty)
     finally show ?case .
   qed
 qed (simp add: edge_density_def)
 
 text\<open>Let @{term P}, @{term Q} be partitions of a set of vertices @{term V}. 
   Then @{term P} refines @{term Q} if for all @{term \<open>A \<in> P\<close>} there is @{term \<open>B \<in> Q\<close>} 
   such that @{term \<open>A \<subseteq> B\<close>}.\<close>
 
 text \<open>For the sake of generality, and following Zhao's Online Lecture 
 \<^url>\<open>https://www.youtube.com/watch?v=vcsxCFSLyP8&t=16s\<close>
 we do not impose disjointness: we do not include @{term "i\<noteq>j"} below.\<close>
 
 definition irregular_set:: "[real, ugraph, uvert set set] \<Rightarrow> (uvert set \<times> uvert set) set"
-  where "irregular_set \<equiv> \<lambda>\<epsilon>::real. \<lambda>G P. {(R,S)|R S. R\<in>P \<and> S\<in>P \<and> \<not> regular_pair R S G \<epsilon>}"
+  ("_-irregular'_set" [999]1000)
+  where "\<epsilon>-irregular_set \<equiv> \<lambda>G P. {(R,S)|R S. R\<in>P \<and> S\<in>P \<and> \<not> \<epsilon>-regular_pair R S G}"
+  for \<epsilon>::real
 
 text\<open>A regular partition may contain a few irregular pairs as long as their total size is bounded as follows.\<close>
-definition regular_partition:: "[real, ugraph, uvert set set] \<Rightarrow> bool"
+definition regular_partition:: "[real, ugraph, uvert set set] \<Rightarrow> bool" 
+    ("_-regular'_partition" [999]1000)
   where
-  "regular_partition \<equiv> \<lambda>\<epsilon>::real. \<lambda>G P . 
+  "\<epsilon>-regular_partition \<equiv> \<lambda>G P . 
      partition_on (uverts G) P \<and>
-     (\<Sum>(R,S) \<in> irregular_set \<epsilon> G P. card R * card S) \<le> \<epsilon> * (card (uverts G))\<^sup>2"
+     (\<Sum>(R,S) \<in> irregular_set \<epsilon> G P. card R * card S) \<le> \<epsilon> * (card (uverts G))\<^sup>2" for \<epsilon>::real
 
-lemma irregular_set_subset: "irregular_set \<epsilon> G P \<subseteq> P \<times> P"
+lemma irregular_set_subset: "\<epsilon>-irregular_set G P \<subseteq> P \<times> P"
   by (auto simp: irregular_set_def)
 
-lemma irregular_set_swap: "(i,j) \<in> irregular_set \<epsilon> G P \<longleftrightarrow> (j,i) \<in> irregular_set \<epsilon> G P"
+lemma irregular_set_swap: "(i,j) \<in> \<epsilon>-irregular_set G P \<longleftrightarrow> (j,i) \<in> \<epsilon>-irregular_set G P"
   by (auto simp add: irregular_set_def regular_pair_commute)
 
-lemma finite_irregular_set [simp]: "finite P \<Longrightarrow> finite (irregular_set \<epsilon> G P)"
+lemma finite_irregular_set [simp]: "finite P \<Longrightarrow> finite (\<epsilon>-irregular_set G P)"
   by (metis finite_SigmaI finite_subset irregular_set_subset)
 
 subsection \<open>Energy of a Graph\<close>
 
 text \<open>Definition 3.7 (Energy), written @{term "q(U,W)"}\<close>
 definition energy_graph_subsets:: "[uvert set, uvert set, ugraph] \<Rightarrow> real" where
   "energy_graph_subsets U W G \<equiv>
      card U * card W * (edge_density U W G)\<^sup>2 / (card (uverts G))\<^sup>2"
 
 text \<open>Definition for partitions\<close>
 definition energy_graph_partitions :: "[ugraph, uvert set set, uvert set set] \<Rightarrow> real"
   where "energy_graph_partitions G P Q \<equiv> \<Sum>R\<in>P.\<Sum>S\<in>Q. energy_graph_subsets R S G"
 
 lemma energy_graph_subsets_0 [simp]: 
      "energy_graph_subsets {} B G = 0" "energy_graph_subsets A {} G = 0"
   by (auto simp: energy_graph_subsets_def)
 
 lemma energy_graph_subsets_ge0 [simp]:
   "energy_graph_subsets U W G \<ge> 0"
   by (auto simp: energy_graph_subsets_def)
 
 lemma energy_graph_partitions_ge0 [simp]:
   "energy_graph_partitions G U W \<ge> 0"
   by (auto simp: sum_nonneg energy_graph_partitions_def)
 
 lemma energy_graph_subsets_commute: 
   "energy_graph_subsets U W G = energy_graph_subsets W U G"
   by (simp add: energy_graph_subsets_def edge_density_commute)
 
 lemma energy_graph_partitions_commute:
   "energy_graph_partitions G W U = energy_graph_partitions G U W"
   by (simp add: energy_graph_partitions_def energy_graph_subsets_commute sum.swap [where A=W])
 
 text\<open>Definition 3.7 (Energy of a Partition), or following Gowers, mean square density:
  a version of energy for a single partition of the vertex set. \<close> 
 
 abbreviation mean_square_density :: "[ugraph, uvert set set] \<Rightarrow> real"
   where "mean_square_density G P \<equiv> energy_graph_partitions G P P"
 
 lemma mean_square_density: 
   "mean_square_density G U \<equiv> 
           (\<Sum>R\<in>U. \<Sum>S\<in>U. card R * card S * (edge_density R S G)\<^sup>2) / (card (uverts G))\<^sup>2"
   by (simp add: energy_graph_partitions_def energy_graph_subsets_def sum_divide_distrib)
 
 text\<open>Observation: the energy is between 0 and 1 because the edge density is bounded above by 1.\<close>
 
 lemma sum_partition_le:
   assumes "finite_graph_partition V P k" "finite V"
   shows "(\<Sum>R\<in>P. \<Sum>S\<in>P. real (card R * card S)) \<le> (real(card V))\<^sup>2"
 proof -
   have "finite P"
     using assms finite_graph_partition_def by blast
   then show ?thesis
     using assms
   proof (induction P arbitrary: V k)
     case (insert X P)
     have [simp]: "finite Y" if "Y \<in> insert X P" for Y
       by (meson finite_graph_partition_finite insert.prems that)
     have C: "card Y \<le> card V" if"Y \<in> insert X P" for Y
       by (meson card_mono finite_graph_partition_subset insert.prems that)
     have D [simp]: "(\<Sum>Y\<in>P. real (card Y)) = real (card V) - real (card X)"
       by (smt (verit) card_finite_graph_partition insert.hyps insert.prems of_nat_sum sum.cong sum.insert)
     have "disjnt X (\<Union>P)"
       using insert.prems insert.hyps
       by (auto simp add: finite_graph_partition_def disjnt_iff pairwise_insert partition_on_def)
     with insert have *: "(\<Sum>R\<in>P. \<Sum>S\<in>P. real (card R * card S)) \<le> (real (card (V - X)))\<^sup>2"
       unfolding finite_graph_partition_def
       by (simp add: lessThan_Suc partition_on_insert disjoint_family_on_insert sum.distrib)
     have [simp]: "V \<inter>X = X"
       using finite_graph_partition_equals insert.prems by blast 
     have "(\<Sum>R \<in> insert X P. \<Sum>S \<in> insert X P. real (card R * card S)) 
       = real (card X * card X) + 2 * (card V - card X) * card X
         + (\<Sum>R\<in>P. \<Sum>S\<in>P. real (card R * card S))"
       using \<open>X \<notin> P\<close> \<open>finite P\<close>
       by (simp add: C of_nat_diff sum.distrib algebra_simps flip: sum_distrib_right)
     also have "\<dots> \<le> real (card X * card X) + 2 * (card V - card X) * card X + (real (card (V - X)))\<^sup>2"
       using * by linarith
     also have "\<dots> \<le> (real (card V))\<^sup>2"
       by (simp add: of_nat_diff C card_Diff_subset_Int algebra_simps power2_eq_square)
     finally show ?case .
   qed auto
 qed
 
 lemma mean_square_density_bounded: 
   assumes "finite_graph_partition (uverts G) P k" "finite (uverts G)" 
   shows "mean_square_density G P \<le> 1"
 proof-
   have "(\<Sum>R\<in>P. \<Sum>S\<in>P. real (card R * card S) * (edge_density R S G)\<^sup>2) 
      \<le> (\<Sum>R\<in>P. \<Sum>S\<in>P. real (card R * card S))"
     by (intro sum_mono mult_right_le_one_le) (auto simp: abs_square_le_1 edge_density_ge0 edge_density_le1)
   also have "\<dots> \<le> (real(card (uverts G)))\<^sup>2"
     using sum_partition_le assms by blast 
   finally show ?thesis 
     by (simp add: mean_square_density divide_simps)
 qed
 
 subsection \<open>Partitioning and Energy\<close>
 
 text\<open>See Gowers's remark after Lemma 11. 
  Further partitioning of subsets of the vertex set cannot make the energy decrease. 
  We follow Gowers's proof, which avoids the use of probability.\<close>
 
 lemma sum_products_le:
   fixes a :: "'a \<Rightarrow> real"
   assumes "\<And>i. i \<in> I \<Longrightarrow> a i \<ge> 0"
   shows "(\<Sum>i\<in>I. a i * b i)\<^sup>2 \<le> (\<Sum>i\<in>I. a i) * (\<Sum>i\<in>I. a i * (b i)\<^sup>2)"  (is "?L \<le> ?R")
 proof -
   have "?L = (\<Sum>i\<in>I. sqrt (a i) * (sqrt (a i) * b i))\<^sup>2"
     by (smt (verit, ccfv_SIG) assms mult.assoc real_sqrt_mult_self sum.cong)
   also have "... \<le> (\<Sum>i\<in>I. (sqrt (a i))\<^sup>2) * (\<Sum>i\<in>I. (sqrt (a i) * b i)\<^sup>2)"
     by (rule Cauchy_Schwarz_ineq_sum)
   also have "... = ?R"
     by (smt (verit) assms mult.assoc mult.commute power2_eq_square real_sqrt_pow2 sum.cong)
   finally show ?thesis .
 qed
 
 lemma energy_graph_partition_half:
   assumes P: "finite_graph_partition U P n"
   shows "card U * (edge_density U W G)\<^sup>2 \<le> (\<Sum>R\<in>P. card R * (edge_density R W G)\<^sup>2)"
 proof (cases "finite U")
   case True
   have \<section>: "(\<Sum>R\<in>P. card R * edge_density R W G)\<^sup>2 
          \<le> (sum card P) * (\<Sum>R\<in>P. card R * (edge_density R W G)\<^sup>2)"
     by (simp add: sum_products_le)
   have "card U * (edge_density U W G)\<^sup>2 = (\<Sum>R\<in>P. card R * (edge_density U W G)\<^sup>2)"
     by (metis \<open>finite U\<close> P sum_distrib_right card_finite_graph_partition of_nat_sum)
   also have "\<dots> = edge_density U W G * (\<Sum>R\<in>P. edge_density U W G * card R)"
     by (simp add: sum_distrib_left power2_eq_square mult_ac)
   also have "\<dots> = (\<Sum>R\<in>P. edge_density R W G * real (card R)) * edge_density U W G"
   proof -
     have "edge_density U W G * (\<Sum>R\<in>P. edge_density R W G * card R) 
         = edge_density U W G * (edge_density U W G * (\<Sum>R\<in>P. card R))"
       using \<open>finite U\<close> assms card_finite_graph_partition  by (auto simp: edge_density_partition [OF P])
     then show ?thesis
       by (simp add: mult.commute sum_distrib_left)
   qed
   also have "\<dots> = (\<Sum>R\<in>P. card R * edge_density R W G) * edge_density U W G"
     by (simp add: sum_distrib_left mult_ac)
   also have "\<dots> = (\<Sum>R\<in>P. card R * edge_density R W G)\<^sup>2 / card U"
     using assms by (simp add: edge_density_partition [OF P] mult_ac flip: power2_eq_square)
   also have "\<dots> \<le> (\<Sum>R\<in>P. card R * (edge_density R W G)\<^sup>2)"
     using \<section> P card_finite_graph_partition \<open>finite U\<close> 
     by (force simp add: mult_ac divide_simps simp flip: of_nat_sum)
   finally show ?thesis .
 qed (simp add: sum_nonneg)
 
 proposition energy_graph_partition_increase:
   assumes P: "finite_graph_partition U P k" and V: "finite_graph_partition W Q l"
   shows "energy_graph_partitions G P Q \<ge> energy_graph_subsets U W G" 
 proof -
   have "(card U * card W) * (edge_density U W G)\<^sup>2 = card W * (card U * (edge_density U W G)\<^sup>2)"
     by (simp add: mult_ac)
   also have "\<dots> \<le> card W * (\<Sum>R\<in>P. card R * (edge_density R W G)\<^sup>2)"
     by (intro mult_left_mono energy_graph_partition_half) (use assms in auto)
   also have "\<dots> = (\<Sum>R\<in>P. card R * (card W * (edge_density W R G)\<^sup>2))"
     by (simp add: sum_distrib_left edge_density_commute mult_ac)
   also have "\<dots> \<le> (\<Sum>R\<in>P. card R * (\<Sum>S\<in>Q. card S * (edge_density S R G)\<^sup>2))"
     by (intro mult_left_mono energy_graph_partition_half sum_mono) (use assms in auto)
   also have "\<dots> \<le> (\<Sum>R\<in>P. \<Sum>S\<in>Q. (card R * card S) * (edge_density R S G)\<^sup>2)"
     by (simp add: sum_distrib_left edge_density_commute mult_ac)
   finally
   have "(card U * card W) * (edge_density U W G)\<^sup>2 
     \<le> (\<Sum>R\<in>P. \<Sum>S\<in>Q. (card R * card S) * (edge_density R S G)\<^sup>2)" .
   then show ?thesis
     unfolding energy_graph_partitions_def energy_graph_subsets_def
     by (simp add: divide_simps flip: sum_divide_distrib)
 qed
 
 text \<open>The following is the fully general version of Gowers's Lemma 11  
 Further partitioning of subsets of the vertex set cannot make the energy decrease.
 Note that @{term V} should be @{term "uverts G"} even though this more general version holds.\<close>
 
 lemma energy_graph_partitions_increase_half:
   assumes ref: "refines V Q P" and "finite V" and part_VP: "partition_on V P"
     and U: "{} \<notin> U"
   shows "energy_graph_partitions G Q U \<ge> energy_graph_partitions G P U" 
         (is "?egQ \<ge> ?egP")
 proof -
   have "\<exists>F. partition_on R F \<and> F = {S\<in>Q. S \<subseteq> R}" if "R\<in>P" for R
     using ref refines_obtains_subset that by blast
   then obtain F where F: "\<And>R. R \<in> P \<Longrightarrow> partition_on R (F R) \<and> F R = {S\<in>Q. S \<subseteq> R}"
     by fastforce
   have injF: "inj_on F P"
     by (metis F inj_on_inverseI partition_on_def)
   have finite_P: "finite R" if "R \<in> P" for R
     by (metis Union_upper \<open>finite V\<close> part_VP finite_subset partition_on_def that)
   then have finite_F: "finite (F R)" if "R \<in> P" for R
     using that by (simp add: F)
   have dFP: "disjoint (F ` P)"
     using part_VP 
     by (smt (verit, best) F Union_upper disjnt_iff disjointD le_inf_iff pairwise_imageI partition_on_def subset_empty)
   have F_ne: "F R \<noteq> {}" if "R \<in> P" for R
     by (metis F Sup_empty part_VP partition_on_def that)
   have F_sums_Q: "(\<Sum>R\<in>P. \<Sum>U\<in>F R. f U) = (\<Sum>S\<in>Q. f S)" for f :: "nat set \<Rightarrow> real"
   proof -
     have "Q = (\<Union>R \<in> P. F R)"
       using ref by (force simp add: refines_def dest: F)
     then have "(\<Sum>S\<in>Q. f S) = sum f (\<Union>R \<in> P. F R)"
       by blast
     also have "\<dots> = (sum \<circ> sum) f (F ` P)"
       by (smt (verit, best) dFP disjnt_def finite_F image_iff pairwiseD sum.Union_disjoint)
     also have "\<dots> = (\<Sum>R \<in> P. \<Sum>U\<in>F R. f U)"
       unfolding comp_apply by (metis injF sum.reindex_cong)
     finally show ?thesis
       by simp
   qed
   have "?egP = (\<Sum>R \<in> P. \<Sum>T\<in>U. energy_graph_subsets R T G)"
     by (simp add: energy_graph_partitions_def)
   also have "\<dots> \<le> (\<Sum>R\<in>P. \<Sum>T\<in>U. energy_graph_partitions G (F R) {T})"
   proof -
     have "finite_graph_partition R (F R) (card (F R))"
       if "R \<in> P" for R
       by (meson F finite_F finite_graph_partition_def that) 
     moreover have "finite_graph_partition T {T} (Suc 0)"
       if "T \<in> U" for T
       using U by (metis that trivial_graph_partition_exists)
     ultimately show ?thesis
       using finite_P by (intro sum_mono energy_graph_partition_increase) auto
   qed
   also have "\<dots> = (\<Sum>R \<in> P. \<Sum>D \<in> F R. \<Sum>T\<in>U. energy_graph_subsets D T G)"
     by (simp add: energy_graph_partitions_def sum.swap [where B = "U"])
   also have "\<dots> = ?egQ"
     by (simp add: energy_graph_partitions_def F_sums_Q)
   finally show ?thesis .
 qed
 
 proposition energy_graph_partitions_increase:
   assumes "refines V Q P" "refines V' Q' P'" 
     and "finite V" "finite V'" 
   shows "energy_graph_partitions G Q Q' \<ge> energy_graph_partitions G P P'"
 proof -
   obtain "{} \<notin> P'" "{} \<notin> Q"
     using assms unfolding refines_def partition_on_def by presburger
   then show ?thesis
     using assms unfolding refines_def
     by (smt (verit, ccfv_SIG) assms energy_graph_partitions_commute energy_graph_partitions_increase_half)
 qed
 
 text \<open>The original version of Gowers's Lemma 11 (also in Zhao)
       is not general enough to be used for anything.\<close>
 corollary mean_square_density_increase:
   assumes "refines V Q P" "finite V"
   shows "mean_square_density G Q \<ge> mean_square_density G P"
   using assms energy_graph_partitions_increase by presburger 
 
 
 text\<open>The Energy Boost Lemma says that an 
 irregular partition increases the energy substantially. We assume that @{term "\<U> \<subseteq> uverts G"} 
 and @{term "\<W> \<subseteq> uverts G"} are not irregular, as witnessed by their subsets @{term"U1 \<subseteq> \<U>"} and @{term"W1 \<subseteq> \<W>"}.
 The proof follows Lemma 12 of Gowers. \<close>
 
 definition "part2 X Y \<equiv> if X \<subset> Y then {X,Y-X} else {Y}"
 
 lemma card_part2: "card (part2 X Y) \<le> 2"
   by (simp add: part2_def card_insert_if)
 
 lemma sum_part2: "\<lbrakk>X \<subseteq> Y; f{} = 0\<rbrakk> \<Longrightarrow> sum f (part2 X Y) = f X + f (Y-X)"
   by (force simp add: part2_def sum.insert_if)
 
 lemma partition_part2:
   assumes "A \<subseteq> B" "A \<noteq> {}"
   shows "partition_on B (part2 A B)"
   using assms by (auto simp add: partition_on_def part2_def disjnt_iff pairwise_insert)
 
 proposition energy_boost:
   fixes \<epsilon>::real and U W G
   defines "alpha \<equiv> edge_density U W G"
   defines "u \<equiv> \<lambda>X Y. edge_density X Y G - alpha"
   assumes "finite U" "finite W"
     and "U' \<subseteq> U" "W' \<subseteq> W" "\<epsilon> > 0"
     and U': "card U' \<ge> \<epsilon> * card U" and W': "card W' \<ge> \<epsilon> * card W"
     and gt: "\<bar>u U' W'\<bar> > \<epsilon>"
   shows "(\<Sum>A \<in> part2 U' U. \<Sum>B \<in> part2 W' W. energy_graph_subsets A B G)
          \<ge> energy_graph_subsets U W G + \<epsilon>^4 * (card U * card W) / (card (uverts G))\<^sup>2"
           (is "?lhs \<ge> ?rhs")
 proof -
   define UF where "UF \<equiv> part2 U' U"
   define WF where "WF \<equiv> part2 W' W"
   obtain [simp]: "finite U" "finite W"
     using assms by (meson finite_subset)
   obtain card': "card U' > 0" "card W' > 0"
     using gt \<open>\<epsilon> > 0\<close> U' W'
     by (force simp: u_def alpha_def edge_density_def mult_le_0_iff zero_less_mult_iff)
   then obtain card: "card U > 0" "card W > 0"
     using assms by fastforce
   then obtain [simp]: "finite U'" "finite W'"
     by (meson card' card_ge_0_finite)
   obtain [simp]: "W' \<noteq> W - W'" "U' \<noteq> U - U'"
     by (metis DiffD2 card' all_not_in_conv card.empty less_irrefl)
   have UF_ne: "card x \<noteq> 0" if "x \<in> UF" for x
     using card' assms that by (auto simp: UF_def part2_def split: if_split_asm)
   have WF_ne: "card x \<noteq> 0" if "x \<in> WF" for x
     using card' assms that by (auto simp: WF_def part2_def split: if_split_asm)
   have cardUW: "card U = card U' + card(U - U')" "card W = card W' + card(W - W')"
     using card card' \<open>U' \<subseteq> U\<close> \<open>W' \<subseteq> W\<close>
     by (metis card_eq_0_iff card_Diff_subset card_mono le_add_diff_inverse less_le)+
   have "U = (U - U') \<union> U'" "disjnt (U - U') U'"
     using \<open>U' \<subseteq> U\<close> by (force simp: disjnt_iff)+
   then have CU: "card (all_edges_between U Z G) 
           = card (all_edges_between (U - U') Z G) + card (all_edges_between U' Z G)" 
       if "finite Z" for Z 
     by (metis \<open>finite U'\<close> all_edges_between_Un1 all_edges_between_disjnt1 \<open>finite U\<close> 
         card_Un_disjnt finite_Diff finite_all_edges_between that)
 
   have "W = (W - W') \<union> W'" "disjnt (W - W') W'"
     using \<open>W' \<subseteq> W\<close> by (force simp: disjnt_iff)+
   then have CW: "card (all_edges_between Z W G) 
           = card (all_edges_between Z (W - W') G) + card (all_edges_between Z W' G)"
     if "finite Z" for Z
     by (metis \<open>finite W'\<close> all_edges_between_Un2 all_edges_between_disjnt2 \<open>finite W\<close>
         card_Un_disjnt finite_Diff2 finite_all_edges_between that)
   have *: "(\<Sum>X\<in>UF. \<Sum>Y\<in>WF. real (card (all_edges_between X Y G))) 
          = card (all_edges_between U W G)"
     by (simp add: UF_def WF_def cardUW CU CW sum_part2 \<open>U' \<subseteq> U\<close> \<open>W' \<subseteq> W\<close>)
   have **: "real (card U) * real (card W) = (\<Sum>X\<in>UF. \<Sum>Y\<in>WF. card X * card Y)"
     by (simp add: UF_def WF_def cardUW sum_part2 \<open>U' \<subseteq> U\<close> \<open>W' \<subseteq> W\<close> algebra_simps)
 
   let ?S = "\<Sum>X\<in>UF. \<Sum>Y\<in>WF. (card X * card Y) / (card U * card W) * (edge_density X Y G)\<^sup>2"
   define T where "T \<equiv> (\<Sum>X\<in>UF. \<Sum>Y\<in>WF. (card X * card Y) / (card U * card W) * (edge_density X Y G))"
   have \<section>: "2 * T = alpha + alpha * (\<Sum>X\<in>UF. \<Sum>Y\<in>WF. (card X * card Y) / (card U * card W))"
     unfolding alpha_def T_def
     by (simp add: * ** edge_density_def divide_simps sum_part2 \<open>U' \<subseteq> U\<close> \<open>W' \<subseteq> W\<close> UF_ne WF_ne flip: sum_divide_distrib)
   have "\<epsilon> * \<epsilon> \<le> u U' W' * u U' W'"
     by (metis abs_ge_zero abs_mult_self_eq \<open>\<epsilon> > 0\<close> gt less_le mult_mono)
   then have "(\<epsilon>*\<epsilon>)*(\<epsilon>*\<epsilon>) \<le> (card U' * card W') / (card U * card W) * (u U' W')\<^sup>2"
     using card mult_mono [OF U' W']  \<open>\<epsilon> > 0\<close>
     apply (simp add: divide_simps eval_nat_numeral)
     by (smt (verit, del_insts) mult.assoc mult.commute mult_mono' of_nat_0_le_iff zero_le_mult_iff)
   also have "\<dots> \<le> (\<Sum>X\<in>UF. \<Sum>Y\<in>WF.  (card X * card Y) / (card U * card W) * (u X Y)\<^sup>2)"
     by (simp add: UF_def WF_def sum_part2 \<open>U' \<subseteq> U\<close> \<open>W' \<subseteq> W\<close>)
   also have "\<dots> = ?S - 2 * T * alpha
                  + alpha\<^sup>2 * (\<Sum>X\<in>UF. \<Sum>Y\<in>WF. (card X * card Y) / (card U * card W))"
     by (simp add: u_def T_def power2_diff mult_ac ring_distribs divide_simps 
           sum_distrib_left sum_distrib_right sum_subtractf sum.distrib flip: sum_divide_distrib)
   also have "\<dots> = ?S - alpha\<^sup>2"
     using \<section> by (simp add: power2_eq_square algebra_simps)
   finally have 12: "alpha\<^sup>2 + \<epsilon>^4 \<le> ?S"
     by (simp add: eval_nat_numeral)
   have "?rhs = (alpha\<^sup>2 + \<epsilon>^4) * (card U * card W / (card (uverts G))\<^sup>2)"
     unfolding alpha_def energy_graph_subsets_def
     by (simp add: ring_distribs divide_simps power2_eq_square)
   also have "\<dots> \<le> ?S * (card U * card W / (card (uverts G))\<^sup>2)"
     by (rule mult_right_mono [OF 12]) auto
   also have "\<dots> = ?lhs"
     using card unfolding energy_graph_subsets_def UF_def WF_def
     by (auto simp add: algebra_simps sum_part2 \<open>U' \<subseteq> U\<close> \<open>W' \<subseteq> W\<close> )
   finally show ?thesis .
 qed
 
 subsection \<open>Energy boost for partitions\<close>
 
 text\<open>We can always find a refinement that increases the energy by a certain amount.\<close>
 
 text \<open>A necessary lemma for the tower of exponentials in the result. Angeliki's proof\<close>
 lemma le_tower_2: "k * (2 ^ Suc k) \<le> 2^(2^k)"
 proof (induction k rule: less_induct)
   case (less k)
   show ?case 
   proof (cases "k \<le> Suc (Suc 0)")
     case False
     define j where "j = k - Suc 0"
     have kj: "k = Suc j"
       using False j_def by force
     with False have \<section>: "(2^j + 3) \<le> (2::nat) ^ k"
       by (simp add: Suc_leI le_less_trans not_less_eq_eq numeral_3_eq_3)
     have "k * (2 ^ Suc k) \<le> 6 * j * 2^j"
       using False by (simp add: kj)
     also have "\<dots> \<le> 6 * 2^(2^j)"
       using kj less.IH by force
     also have "\<dots> < 2^(2^j + 3)"
       by (simp add: power_add) 
     also have "\<dots> \<le> 2^2^k"
       by (simp add: \<section>)
     finally show ?thesis
       by simp      
   qed (auto simp: le_Suc_eq)
 qed
 
 
 text \<open>The bound $2 ^{k+1}$  comes from a different source by Zhao:
 ``Graph Theory and Additive Combinatorics'', \<^url>\<open>https://yufeizhao.com/gtacbook/\<close>.
 It's needed because our @{term regular_partition} includes the diagonal; 
 otherwise, $k 2^k$ would work. Gowers'  version has a flatly incorrect bound.\<close>
 proposition exists_refinement:
   assumes fgp: "finite_graph_partition (uverts G) P k" and "finite (uverts G)" 
-    and irreg: "\<not> regular_partition \<epsilon> G P" and "\<epsilon> > 0"
+    and irreg: "\<not> \<epsilon>-regular_partition G P" and "\<epsilon> > 0"
   obtains Q where "refines (uverts G) Q P"                     
                     "mean_square_density G Q \<ge> mean_square_density G P + \<epsilon>^5" 
                     "\<And>R. R\<in>P \<Longrightarrow> card {S\<in>Q. S \<subseteq> R} \<le> 2 ^ Suc k"
                     "card Q \<le> k * 2 ^ Suc k"
 proof -
-  define sum_pp where "sum_pp \<equiv> (\<Sum>(R,S) \<in> irregular_set \<epsilon> G P. card R * card S)"
+  define sum_pp where "sum_pp \<equiv> (\<Sum>(R,S) \<in> \<epsilon>-irregular_set G P. card R * card S)"
   have cardP: "card P = k"
     using fgp finite_graph_partition_def by force
   then have "k \<noteq> 0"
     using assms unfolding regular_partition_def irregular_set_def finite_graph_partition_def by fastforce
   with assms have G_nonempty: "0 < card (uverts G)"
     by (metis card_gt_0_iff finite_graph_partition_empty)
   have part_GP: "partition_on (uverts G) P"
     using fgp finite_graph_partition_def by blast 
   then have finP: "finite R" "R \<noteq> {}" if "R\<in>P" for R
     using assms that partition_onD3 finite_graph_partition_finite by blast+
   have spp: "sum_pp > \<epsilon> * (card (uverts G))\<^sup>2"
     by (metis irreg not_le part_GP regular_partition_def sum_pp_def)
   then have sum_irreg_pos: "sum_pp > 0"
     using \<open>\<epsilon> > 0\<close> G_nonempty less_asym by fastforce
   have "\<exists>X\<subseteq>R. \<exists>Y\<subseteq>S. \<epsilon> * card R \<le> card X \<and> \<epsilon> * card S \<le> card Y \<and>
                      \<bar>edge_density X Y G - edge_density R S G\<bar> > \<epsilon>"
-    if "(R,S) \<in> irregular_set \<epsilon> G P" for R S
+    if "(R,S) \<in> \<epsilon>-irregular_set G P" for R S
     using that fgp finite_graph_partition_subset by (simp add: irregular_set_def regular_pair_def not_le) 
   then obtain X0 Y0 
-    where XY0_psub_P: "\<And>R S. \<lbrakk>(R,S) \<in> irregular_set \<epsilon> G P\<rbrakk> \<Longrightarrow> X0 R S \<subseteq> R \<and> Y0 R S \<subseteq> S"
+    where XY0_psub_P: "\<And>R S. \<lbrakk>(R,S) \<in> \<epsilon>-irregular_set G P\<rbrakk> \<Longrightarrow> X0 R S \<subseteq> R \<and> Y0 R S \<subseteq> S"
     and XY0_eps:
-    "\<And>R S. (R,S) \<in> irregular_set \<epsilon> G P
+    "\<And>R S. (R,S) \<in> \<epsilon>-irregular_set G P
         \<Longrightarrow> \<epsilon> * card R \<le> card (X0 R S) \<and> \<epsilon> * card S \<le> card (Y0 R S) \<and>
             \<bar>edge_density (X0 R S) (Y0 R S) G - edge_density R S G\<bar> > \<epsilon>"
     by metis
   obtain iP where iP: "bij_betw iP P {..<k}"
     by (metis fgp finite_graph_partition_def to_nat_on_finite cardP)
   define X where "X \<equiv> \<lambda>R S. if iP R < iP S then Y0 S R else X0 R S"
   define Y where "Y \<equiv> \<lambda>R S. if iP R < iP S then X0 S R else Y0 R S"
-  have XY_psub_P: "\<And>R S. \<lbrakk>(R,S) \<in> irregular_set \<epsilon> G P\<rbrakk> \<Longrightarrow> X R S \<subseteq> R \<and> Y R S \<subseteq> S"
+  have XY_psub_P: "\<And>R S. \<lbrakk>(R,S) \<in> \<epsilon>-irregular_set G P\<rbrakk> \<Longrightarrow> X R S \<subseteq> R \<and> Y R S \<subseteq> S"
     using XY0_psub_P by (force simp: X_def Y_def irregular_set_swap)
   have XY_eps:
-    "\<And>R S. (R,S) \<in> irregular_set \<epsilon> G P
+    "\<And>R S. (R,S) \<in> \<epsilon>-irregular_set G P
         \<Longrightarrow> \<epsilon> * card R \<le> card (X R S) \<and> \<epsilon> * card S \<le> card (Y R S) \<and>
             \<bar>edge_density (X R S) (Y R S) G - edge_density R S G\<bar> > \<epsilon>"
     using XY0_eps by (force simp: X_def Y_def edge_density_commute irregular_set_swap)
   have card_elem_P: "card R > 0" if "R\<in>P" for R
     by (metis card_eq_0_iff finP neq0_conv that)
-  have XY_nonempty: "X R S \<noteq> {}" "Y R S \<noteq> {}" if "(R,S) \<in> irregular_set \<epsilon> G P" for R S
+  have XY_nonempty: "X R S \<noteq> {}" "Y R S \<noteq> {}" if "(R,S) \<in> \<epsilon>-irregular_set G P" for R S
     using XY_eps [OF that] that \<open>\<epsilon> > 0\<close> card_elem_P [of R] card_elem_P [of S]
     by (auto simp: irregular_set_def mult_le_0_iff)
 
   text\<open>By the assumption that our partition is irregular, there are many irregular pairs.
        For each irregular pair, find pairs of subsets that witness irregularity.\<close>
-  define XP where "XP R \<equiv> ((\<lambda>S. part2 (X R S) R) ` {S. (R,S) \<in> irregular_set \<epsilon> G P})" for R
-  define YP where "YP S \<equiv> ((\<lambda>R. part2 (Y R S) S) ` {R. (R,S) \<in> irregular_set \<epsilon> G P})" for S
+  define XP where "XP R \<equiv> ((\<lambda>S. part2 (X R S) R) ` {S. (R,S) \<in> \<epsilon>-irregular_set G P})" for R
+  define YP where "YP S \<equiv> ((\<lambda>R. part2 (Y R S) S) ` {R. (R,S) \<in> \<epsilon>-irregular_set G P})" for S
 
   text \<open>include degenerate partition to ensure it works whether or not there's an irregular pair\<close>
   define PP where "PP \<equiv> \<lambda>R. insert {R} (XP R \<union> YP R)"
   define QS where "QS R \<equiv> common_refinement (PP R)" for R
   define r where "r R \<equiv> card (QS R)" for R
   have "finite P"
     using fgp finite_graph_partition_def by blast
   then have finPP: "finite (PP R)" for R
     by (simp add: PP_def XP_def YP_def irregular_set_def)
   have inPP_fin: "P \<in> PP R \<Longrightarrow> finite P" for P R
     by (auto simp: PP_def XP_def YP_def part2_def)
   have finite_QS: "finite (QS R)" for R
     by (simp add: QS_def finPP finite_common_refinement inPP_fin)
 
   have part_QS: "partition_on R (QS R)" if "R \<in> P" for R
     unfolding QS_def
   proof (intro partition_on_common_refinement partition_onI)
     show "\<And>\<A>. \<A> \<in> PP R \<Longrightarrow> {} \<notin> \<A>"
       using that XY_nonempty XY_psub_P finP
       by (fastforce simp add: PP_def XP_def YP_def part2_def)
   qed (auto simp: disjnt_iff PP_def XP_def YP_def part2_def dest: XY_psub_P)
 
   have part_P_QS: "finite_graph_partition R (QS R) (r R)" if "R\<in>P" for R
     by (simp add: finite_QS finite_graph_partition_def part_QS r_def that)
   then have fin_SQ [simp]: "finite (QS R)" if "R\<in>P" for R
     using QS_def finite_QS by force
   have QS_ne: "{} \<notin> QS R" if "R\<in>P" for R
     using QS_def part_QS partition_onD3 that by blast 
   have QS_subset_P: "q \<in> QS R \<Longrightarrow> q \<subseteq> R" if "R\<in>P" for R q
     by (meson finite_graph_partition_subset part_P_QS that)
   then have QS_inject: "R = R'" 
     if "R\<in>P" "R'\<in>P" "q \<in> QS R" "q \<in> QS R'" for R R' q
     by (metis UnionI disjnt_iff equals0I pairwiseD part_GP part_QS partition_on_def that)
   define Q where "Q \<equiv> (\<Union>R\<in>P. QS R)"
   define m where "m \<equiv> \<Sum>R\<in>P. r R"
   show thesis
   proof
     show ref_QP: "refines (uverts G) Q P"
       unfolding refines_def
     proof (intro conjI strip part_GP)
       fix X
       assume "X \<in> Q"
       then show "\<exists>Y\<in>P. X \<subseteq> Y"
         by (metis QS_subset_P Q_def UN_iff)
     next
       show "partition_on (uverts G) Q"
       proof (intro conjI partition_onI)
         show "\<Union>Q = uverts G"
         proof
           show "\<Union>Q \<subseteq> uverts G"
             using QS_subset_P Q_def fgp finite_graph_partition_equals by fastforce
           show "uverts G \<subseteq> \<Union>Q"
             by (metis Q_def Sup_least UN_upper Union_mono part_GP part_QS partition_onD1)
         qed
         show "disjnt p q" if "p \<in> Q" and "q \<in> Q" and "p \<noteq> q" for p q
         proof -
           from that 
           obtain R S where "R\<in>P" "S\<in>P" 
             and *: "p \<in> QS R" "q \<in> QS S"
             by (auto simp: Q_def QS_def)
           show ?thesis
           proof (cases "R=S")
             case True
             then show ?thesis
               using part_QS [of R]
               by (metis \<open>R \<in> P\<close> * pairwiseD partition_on_def \<open>p \<noteq> q\<close>)
           next
             case False
             with * show ?thesis
               by (metis QS_subset_P \<open>R \<in> P\<close> \<open>S \<in> P\<close> disjnt_iff pairwiseD part_GP partition_on_def subsetD)
           qed
         qed
         show "{} \<notin> Q"
           using QS_ne Q_def by blast
       qed
     qed 
     have disj_QSP: "disjoint_family_on QS P"
       unfolding disjoint_family_on_def by (metis Int_emptyI QS_inject)
     let ?PP = "P \<times> P"
-    let ?REG = "?PP - irregular_set \<epsilon> G P"
-    define sum_eps where "sum_eps \<equiv> (\<Sum>(R,S) \<in> irregular_set \<epsilon> G P. \<epsilon>^4 * (card R * card S) / (card (uverts G))\<^sup>2)"
+    let ?REG = "?PP - \<epsilon>-irregular_set G P"
+    define sum_eps where "sum_eps \<equiv> (\<Sum>(R,S) \<in> \<epsilon>-irregular_set G P. \<epsilon>^4 * (card R * card S) / (card (uverts G))\<^sup>2)"
     have A: "energy_graph_subsets R S G + \<epsilon>^4 * (card R * card S) / (card (uverts G))\<^sup>2
           \<le> energy_graph_partitions G (part2 (X R S) R) (part2 (Y R S) S)"
           (is "?L \<le> ?R")
-          if *: "(R,S) \<in> irregular_set \<epsilon> G P" for R S
+          if *: "(R,S) \<in> \<epsilon>-irregular_set G P" for R S
     proof -
       have "R\<in>P" "S\<in>P"
         using * by (auto simp: irregular_set_def)
       have "?L \<le> (\<Sum>A \<in> part2 (X R S) R. \<Sum>B \<in> part2 (Y R S) S. energy_graph_subsets A B G)"
         using XY_psub_P [OF *] XY_eps [OF *] assms
         by (intro energy_boost \<open>R \<in> P\<close> \<open>S \<in> P\<close> finP \<open>\<epsilon>>0\<close>) auto
       also have "\<dots> \<le> ?R"
         by (simp add: energy_graph_partitions_def)
       finally show ?thesis .
     qed
     have B: "energy_graph_partitions G (part2 (X R S) R) (part2 (Y R S) S)
           \<le> energy_graph_partitions G (QS R) (QS S)"
-      if "(R,S) \<in> irregular_set \<epsilon> G P" for R S
+      if "(R,S) \<in> \<epsilon>-irregular_set G P" for R S
     proof -
       have "R\<in>P" "S\<in>P" using that by (auto simp: irregular_set_def)
       have [simp]: "\<not> X R S \<subset> R \<longleftrightarrow> X R S = R" "\<not> Y R S \<subset> S \<longleftrightarrow> Y R S = S"
         using XY_psub_P that by blast+
       have XPX: "part2 (X R S) R \<in> PP R"
         using that by (simp add: PP_def XP_def)
       have I: "partition_on R (QS R)"
         using QS_def \<open>R \<in> P\<close> part_QS by force
       moreover have "\<forall>q \<in> QS R. \<exists>b \<in> part2 (X R S) R. q \<subseteq> b"
         using common_refinement_exists [OF _ XPX] by (simp add: QS_def)
       ultimately have ref_XP: "refines R (QS R) (part2 (X R S) R)"
         by (simp add: refines_def XY_nonempty XY_psub_P that partition_part2)
       have YPY: "part2 (Y R S) S \<in> PP S"
         using that by (simp add: PP_def YP_def)
       have J: "partition_on S (QS S)"
         using QS_def \<open>S \<in> P\<close> part_QS by force
       moreover have "\<forall>q \<in> QS S. \<exists>b \<in> part2 (Y R S) S. q \<subseteq> b"
         using common_refinement_exists [OF _ YPY] by (simp add: QS_def)
       ultimately have ref_YP: "refines S (QS S) (part2 (Y R S) S)"
         by (simp add: XY_nonempty XY_psub_P that partition_part2 refines_def)
       show ?thesis
         using \<open>R \<in> P\<close> \<open>S \<in> P\<close>
         by (simp add: finP energy_graph_partitions_increase [OF ref_XP ref_YP])
     qed
     have "mean_square_density G P + \<epsilon>^5 \<le> mean_square_density G P + sum_eps"
     proof -
       have "\<epsilon>^5 = (\<epsilon> * (card (uverts G))\<^sup>2) * (\<epsilon>^4 / (card (uverts G))\<^sup>2)"
         using G_nonempty by (simp add: field_simps eval_nat_numeral)
       also have "\<dots> \<le> sum_pp * (sum_eps / sum_pp)"
       proof (rule mult_mono)
         show "\<epsilon>^4 / real ((card (uverts G))\<^sup>2) \<le> sum_eps / sum_pp"
           using sum_irreg_pos sum_eps_def sum_pp_def
           by (auto simp add: case_prod_unfold sum.neutral simp flip: sum_distrib_left sum_divide_distrib of_nat_sum of_nat_mult)
       qed (use spp sum_nonneg in auto)
       also have "\<dots> \<le> sum_eps"
         by (simp add: sum_irreg_pos)
       finally show ?thesis by simp
     qed
-    also have "\<dots> = (\<Sum>(i,j)\<in>?REG. energy_graph_subsets i j G) 
-                   + (\<Sum>(i,j)\<in>irregular_set \<epsilon> G P. energy_graph_subsets i j G) + sum_eps"
+    also have "\<dots> = (\<Sum>(i,j) \<in> ?REG. energy_graph_subsets i j G) 
+                   + (\<Sum>(i,j) \<in> \<epsilon>-irregular_set G P. energy_graph_subsets i j G) + sum_eps"
       by (simp add: \<open>finite P\<close> energy_graph_partitions_def sum.cartesian_product irregular_set_subset sum.subset_diff)
     also have "\<dots> \<le> (\<Sum>(i,j) \<in> ?REG. energy_graph_subsets i j G)
-                   + (\<Sum>(i,j) \<in> irregular_set \<epsilon> G P. energy_graph_partitions G (part2 (X i j) i) (part2 (Y i j) j))"
+                   + (\<Sum>(i,j) \<in> \<epsilon>-irregular_set G P. energy_graph_partitions G (part2 (X i j) i) (part2 (Y i j) j))"
       using A unfolding sum_eps_def case_prod_unfold
       by (force intro: sum_mono simp flip: sum.distrib)
     also have "\<dots> \<le> (\<Sum>(i,j) \<in> ?REG. energy_graph_partitions G (QS i) (QS j))
-                   + (\<Sum>(i,j) \<in> irregular_set \<epsilon> G P. energy_graph_partitions G (part2 (X i j) i) (part2 (Y i j) j))"
+                   + (\<Sum>(i,j) \<in> \<epsilon>-irregular_set G P. energy_graph_partitions G (part2 (X i j) i) (part2 (Y i j) j))"
       by (auto intro!: part_P_QS sum_mono energy_graph_partition_increase)
     also have "\<dots> \<le> (\<Sum>(i,j) \<in> ?REG. energy_graph_partitions G (QS i) (QS j)) 
-                  + (\<Sum>(i,j) \<in> irregular_set \<epsilon> G P. energy_graph_partitions G (QS i) (QS j))"
+                  + (\<Sum>(i,j) \<in> \<epsilon>-irregular_set G P. energy_graph_partitions G (QS i) (QS j))"
       using B
     proof (intro sum_mono add_mono ordered_comm_monoid_add_class.sum_mono2)
     qed (auto split: prod.split)
     also have "\<dots> = (\<Sum>(i,j) \<in> ?PP. energy_graph_partitions G (QS i) (QS j))"
       by (metis (no_types, lifting) \<open>finite P\<close> finite_SigmaI irregular_set_subset sum.subset_diff)
     also have "\<dots> = (\<Sum>i\<in>P. \<Sum>j\<in>P. energy_graph_partitions G (QS i) (QS j))"
       by (simp flip: sum.cartesian_product)
     also have "\<dots> = (\<Sum>A \<in> Q. \<Sum>B \<in> Q. energy_graph_subsets A B G)"
       unfolding energy_graph_partitions_def Q_def
       by (simp add: disj_QSP \<open>finite P\<close> sum.UNION_disjoint_family sum.swap [of _ "P" "QS _"])
     also have "\<dots> = mean_square_density G Q"
       by (simp add: mean_square_density energy_graph_subsets_def sum_divide_distrib)
     finally show "mean_square_density G P + \<epsilon> ^ 5 \<le> mean_square_density G Q" .
 
     define QinP where "QinP \<equiv> \<lambda>i. {j\<in>Q. j \<subseteq> i}"
     show card_QP: "card (QinP i) \<le> 2 ^ Suc k"
       if "i \<in> P" for i 
     proof -
       have less_cardP: "iP i < k"
         using iP bij_betwE that by blast
       have card_cr: "card (QS i) \<le> 2 ^ Suc k"
       proof -
         have "card (QS i) \<le> prod card (PP i)"
           by (simp add: QS_def card_common_refinement finPP inPP_fin) 
         also have "\<dots> = prod card (XP i \<union> YP i)"
           using finPP by (simp add: PP_def prod.insert_if)
         also have "\<dots> \<le> 2 ^ Suc k" 
         proof (rule prod_le_power)
           define XS where "XS \<equiv> (\<Union>R \<in> {R\<in>P. iP R \<le> iP i}. {part2 (X0 i R) i})"
           define YS where "YS \<equiv> (\<Union>R \<in> {R\<in>P. iP R \<ge> iP i}. {part2 (Y0 R i) i})"
           have 1: "{R \<in> P. iP R \<le> iP i} \<subseteq> iP -` {..iP i} \<inter> P"
             by auto
           have "card XS \<le> card {R \<in> P. iP R \<le> iP i}"
             by (force simp add: XS_def \<open>finite P\<close> intro: order_trans [OF card_UN_le])
           also have "\<dots> \<le> card (iP -` {..iP i} \<inter> P)"
             using 1 by (simp add: \<open>finite P\<close> card_mono)
           also have "\<dots> \<le> Suc (iP i)"
             by (metis card_vimage_inj_on_le bij_betw_def card_atMost finite_atMost iP)
           finally have cXS: "card XS \<le> Suc (iP i)" .
           have 2: "{R \<in> P. iP R \<ge> iP i} \<subseteq> iP -` {iP i..<k} \<inter> P"
             by clarsimp (meson bij_betw_apply iP lessThan_iff nat_less_le)
           have "card YS \<le> card {R \<in> P. iP R \<ge> iP i}"
             by (force simp add: YS_def \<open>finite P\<close> intro: order_trans [OF card_UN_le])
           also have "\<dots> \<le> card (iP -` {iP i..<k} \<inter> P)"
             using 2 by (simp add: \<open>finite P\<close> card_mono)
           also have "\<dots> \<le> card {iP i..<k}"
             by (meson bij_betw_def card_vimage_inj_on_le finite_atLeastLessThan iP)
           finally have "card YS \<le> k - iP i" 
             by simp
           with less_cardP cXS have k': "card XS + card YS \<le> Suc k"
             by linarith
           have finXYS: "finite (XS \<union> YS)"
             unfolding XS_def YS_def using \<open>finite P\<close> by (auto intro: finite_vimageI) 
           have "XP i \<union> YP i \<subseteq> XS \<union> YS"
             apply (simp add: XP_def X_def YP_def Y_def XS_def YS_def irregular_set_def image_def subset_iff)
             by (metis insert_iff linear not_le)
           then have "card (XP i \<union> YP i) \<le> card XS + card YS"
             by (meson card_Un_le card_mono finXYS order_trans)
           then show "card (XP i \<union> YP i) \<le> Suc k"
             using k' le_trans by blast
           fix x
           assume "x \<in> XP i \<union> YP i"
           then show "0 \<le> card x \<and> card x \<le> 2"
             using XP_def YP_def card_part2 by force
         qed auto
         finally show ?thesis .
       qed
       have "i' = i" if "q \<subseteq> i" "i'\<in>P" "q \<in> QS i'" for i' q
         by (metis QS_ne QS_subset_P \<open>i \<in> P\<close> disjnt_iff equals0I pairwiseD part_GP partition_on_def subset_eq that)
       then have "QinP i \<subseteq> QS i"
         by (auto simp: QinP_def Q_def)
       then have "card (QinP i) \<le> card (QS i)"
         by (simp add: card_mono that)
       also have "\<dots> \<le> 2 ^ Suc k"
         using QS_def card_cr by presburger
       finally show ?thesis .
     qed
     have "card Q \<le> card (\<Union>i\<in>P. QinP i)"
       unfolding Q_def
     proof (rule card_mono)
       show "(\<Union> (QS ` P)) \<subseteq> (\<Union>i\<in>P. QinP i)"
         using ref_QP QS_subset_P Q_def QinP_def by blast
       show "finite (\<Union>i\<in>P. QinP i)"
         by (simp add: Q_def QinP_def \<open>finite P\<close>)
     qed 
     also have "\<dots> \<le> (\<Sum>i\<in>P. 2 ^ Suc k)"
       by (smt (verit) \<open>finite P\<close> card_QP card_UN_le order_trans sum_mono)
     finally show "card Q \<le> k * 2 ^ Suc k" 
       by (simp add: cardP)
   qed
 qed
 
 subsection \<open>The Regularity Proof Itself\<close>
 
 text\<open>We start with a trivial partition (one part). If it is already $\epsilon$-regular, we are done. If
 not, we refine it by applying lemma @{thm[source]"exists_refinement"} above, which increases the
 energy. We can repeat this step, but it cannot increase forever: by @{thm [source]
 mean_square_density_bounded} it cannot exceed~1. This defines an algorithm that must stop
 after at most $\epsilon^{-5}$ steps, resulting in an $\epsilon$-regular partition.\<close>
 theorem Szemeredi_Regularity_Lemma:
   assumes "\<epsilon> > 0"
-  obtains M where "\<And>G. card (uverts G) > 0 \<Longrightarrow> \<exists>P. regular_partition \<epsilon> G P \<and> card P \<le> M"
+  obtains M where "\<And>G. card (uverts G) > 0 \<Longrightarrow> \<exists>P. \<epsilon>-regular_partition G P \<and> card P \<le> M"
 proof 
   fix G
   assume "card (uverts G) > 0"
   then obtain finG: "finite (uverts G)" and nonempty: "uverts G \<noteq> {}"
     by (simp add: card_gt_0_iff) 
   define \<Phi> where "\<Phi> \<equiv> \<lambda>Q P. refines (uverts G) Q P \<and> 
                                  mean_square_density G Q \<ge> mean_square_density G P + \<epsilon>^5 \<and> 
                                  card Q \<le> card P * 2 ^ Suc (card P)"
-  define nxt where "nxt \<equiv> \<lambda>P. if regular_partition \<epsilon> G P then P else SOME Q. \<Phi> Q P"
+  define nxt where "nxt \<equiv> \<lambda>P. if \<epsilon>-regular_partition G P then P else SOME Q. \<Phi> Q P"
   define iter where "iter \<equiv> \<lambda>i. (nxt ^^ i) {uverts G}"
   define last where "last \<equiv> Suc (nat\<lceil>1 / \<epsilon> ^ 5\<rceil>)"
   have iter_Suc [simp]: "iter (Suc i) = nxt (iter i)" for i
     by (simp add: iter_def)
   have \<Phi>: "\<Phi> (nxt P) P"
-    if Pk: "partition_on (uverts G) P" and irreg: "\<not> regular_partition \<epsilon> G P" for P
+    if Pk: "partition_on (uverts G) P" and irreg: "\<not> \<epsilon>-regular_partition G P" for P
   proof -
     have "finite_graph_partition (uverts G) P (card P)"
       by (meson Pk finG finite_elements finite_graph_partition_def)
     then show ?thesis
       using that exists_refinement [OF _ finG irreg assms] irreg Pk
       unfolding \<Phi>_def nxt_def by (smt (verit) someI)
   qed
   have partition_on: "partition_on (uverts G) (iter i)" for i
   proof (induction i)
     case 0
     then show ?case
       by (simp add: iter_def nonempty trivial_graph_partition_exists partition_on_space)
   next
     case (Suc i)
     with \<Phi> show ?case
       by (metis \<Phi>_def iter_Suc nxt_def refines_def)
   qed
-  have False if irreg: "\<And>i. i\<le>last \<Longrightarrow> \<not> regular_partition \<epsilon> G (iter i)"
+  have False if irreg: "\<And>i. i\<le>last \<Longrightarrow> \<not> \<epsilon>-regular_partition G (iter i)"
   proof -
     have \<Phi>_loop: "\<Phi> (nxt (iter i)) (iter i)" if "i\<le>last" for i
       using \<Phi> irreg partition_on that by blast
     have iter_grow: "mean_square_density G (iter i) \<ge> i * \<epsilon>^5" if "i\<le>last" for i
       using that
     proof (induction i)
       case (Suc i)
       then show ?case
         by (clarsimp simp: algebra_simps) (smt (verit, best) Suc_leD \<Phi>_def \<Phi>_loop)
     qed (auto simp: iter_def)
     have "last * \<epsilon>^5 \<le> mean_square_density G (iter last)"
       by (simp add: iter_grow)
     also have "\<dots> \<le> 1"
       by (meson finG finite_elements finite_graph_partition_def mean_square_density_bounded partition_on)
     finally have "real last * \<epsilon> ^ 5 \<le> 1" .
     with assms show False
       unfolding last_def by (meson lessI natceiling_lessD not_less pos_divide_less_eq zero_less_power)
   qed
-  then obtain i where "i \<le> last" and "regular_partition \<epsilon> G (iter i)"
+  then obtain i where "i \<le> last" and "\<epsilon>-regular_partition G (iter i)"
     by force
-  then have reglar: "regular_partition \<epsilon> G (iter (i + d))" for d
+  then have reglar: "\<epsilon>-regular_partition G (iter (i + d))" for d
     by (induction d) (auto simp add: nxt_def)
   define tower where "tower \<equiv> \<lambda>k. (power(2::nat) ^^ k) 2"
   have [simp]: "tower (Suc k) = 2 ^ tower k" for k
     by (simp add: tower_def)
   have iter_tower: "card (iter i) \<le> tower (2*i)" for i
   proof (induction i)
     case (Suc i)
     then have Qm: "card (iter i) \<le> tower (2 * i)"
       by simp
     then have *: "card (nxt (iter i)) \<le> card (iter i) * 2 ^ Suc (card (iter i))"
       using \<Phi> by (simp add: \<Phi>_def nxt_def partition_on)
     also have "\<dots> \<le> 2 ^ 2 ^ tower (2 * i)"
       by (metis One_nat_def Suc.IH le_tower_2 lessI numeral_2_eq_2 order.trans power_increasing_iff)
     finally show ?case
       by (simp add: Qm)
   qed (auto simp: iter_def tower_def)
-  then show "\<exists>P. regular_partition \<epsilon> G P \<and> card P \<le> tower(2 * last)"
+  then show "\<exists>P. \<epsilon>-regular_partition G P \<and> card P \<le> tower(2 * last)"
     by (metis \<open>i \<le> last\<close> nat_le_iff_add reglar)
 qed 
 
 text \<open>The actual value of the bound is visible above: a tower of exponentials of height $2(1 + \epsilon^{-5})$.\<close>
 
 end