diff --git a/thys/Affine_Arithmetic/Affine_Approximation.thy b/thys/Affine_Arithmetic/Affine_Approximation.thy
--- a/thys/Affine_Arithmetic/Affine_Approximation.thy
+++ b/thys/Affine_Arithmetic/Affine_Approximation.thy
@@ -1,3922 +1,3874 @@
  section \<open>Approximation with Affine Forms\<close>
 theory Affine_Approximation
 imports
   "HOL-Decision_Procs.Approximation"
   "HOL-Library.Monad_Syntax"
   "HOL-Library.Mapping"
   Executable_Euclidean_Space
   Affine_Form
   Straight_Line_Program
 begin
 text \<open>\label{sec:approxaffine}\<close>
 
 lemma convex_on_imp_above_tangent:\<comment> \<open>TODO: generalizes @{thm convex_on_imp_above_tangent}\<close>
   assumes convex: "convex_on A f" and connected: "connected A"
   assumes c: "c \<in> A" and x : "x \<in> A"
   assumes deriv: "(f has_field_derivative f') (at c within A)"
   shows   "f x - f c \<ge> f' * (x - c)"
 proof (cases x c rule: linorder_cases)
   assume xc: "x > c"
   let ?A' = "{c<..<x}"
   have subs: "?A' \<subseteq> A" using xc x c
     by (simp add: connected connected_contains_Ioo)
   have "at c within ?A' \<noteq> bot"
     using xc
     by (simp add: at_within_eq_bot_iff)
   moreover from deriv have "((\<lambda>y. (f y - f c) / (y - c)) \<longlongrightarrow> f') (at c within ?A')"
     unfolding has_field_derivative_iff using subs
     by (blast intro: tendsto_mono at_le)
   moreover from eventually_at_right_real[OF xc]
     have "eventually (\<lambda>y. (f y - f c) / (y - c) \<le> (f x - f c) / (x - c)) (at_right c)"
   proof eventually_elim
     fix y assume y: "y \<in> {c<..<x}"
     with convex connected x c have "f y \<le> (f x - f c) / (x - c) * (y - c) + f c"
       using interior_subset[of A]
       by (intro convex_onD_Icc' convex_on_subset[OF convex] connected_contains_Icc) auto
     hence "f y - f c \<le> (f x - f c) / (x - c) * (y - c)" by simp
     thus "(f y - f c) / (y - c) \<le> (f x - f c) / (x - c)" using y xc by (simp add: divide_simps)
   qed
   hence "eventually (\<lambda>y. (f y - f c) / (y - c) \<le> (f x - f c) / (x - c)) (at c within ?A')"
     by (simp add: eventually_at_filter eventually_mono)
   ultimately have "f' \<le> (f x - f c) / (x - c)" by (simp add: tendsto_upperbound)
   thus ?thesis using xc by (simp add: field_simps)
 next
   assume xc: "x < c"
   let ?A' = "{x<..<c}"
   have subs: "?A' \<subseteq> A" using xc x c
     by (simp add: connected connected_contains_Ioo)
   have "at c within ?A' \<noteq> bot"
     using xc
     by (simp add: at_within_eq_bot_iff)
   moreover from deriv have "((\<lambda>y. (f y - f c) / (y - c)) \<longlongrightarrow> f') (at c within ?A')"
     unfolding has_field_derivative_iff using subs
     by (blast intro: tendsto_mono at_le)
   moreover from eventually_at_left_real[OF xc]
     have "eventually (\<lambda>y. (f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)) (at_left c)"
   proof eventually_elim
     fix y assume y: "y \<in> {x<..<c}"
     with convex connected x c have "f y \<le> (f x - f c) / (c - x) * (c - y) + f c"
       using interior_subset[of A]
       by (intro convex_onD_Icc'' convex_on_subset[OF convex] connected_contains_Icc) auto
     hence "f y - f c \<le> (f x - f c) * ((c - y) / (c - x))" by simp
     also have "(c - y) / (c - x) = (y - c) / (x - c)" using y xc by (simp add: field_simps)
     finally show "(f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)" using y xc
       by (simp add: divide_simps)
   qed
   hence "eventually (\<lambda>y. (f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)) (at c within ?A')"
     by (simp add: eventually_at_filter eventually_mono)
   ultimately have "f' \<ge> (f x - f c) / (x - c)" by (simp add: tendsto_lowerbound)
   thus ?thesis using xc by (simp add: field_simps)
 qed simp_all
 
 
 text \<open>Approximate operations on affine forms.\<close>
 
 lemma Affine_notempty[intro, simp]: "Affine X \<noteq> {}"
   by (auto simp: Affine_def valuate_def)
 
 lemma truncate_up_lt: "x < y \<Longrightarrow> x < truncate_up prec y"
   by (rule less_le_trans[OF _ truncate_up])
 
 lemma truncate_up_pos_eq[simp]: "0 < truncate_up p x \<longleftrightarrow> 0 < x"
   by (auto simp: truncate_up_lt) (metis (poly_guards_query) not_le truncate_up_nonpos)
 
 lemma inner_scaleR_pdevs_0: "inner_scaleR_pdevs 0 One_pdevs = zero_pdevs"
   unfolding inner_scaleR_pdevs_def
   by transfer (auto simp: unop_pdevs_raw_def)
 
 lemma Affine_aform_of_point_eq[simp]: "Affine (aform_of_point p) = {p}"
   by (simp add: Affine_aform_of_ivl aform_of_point_def)
 
 lemma mem_Affine_aform_of_point: "x \<in> Affine (aform_of_point x)"
   by simp
 
 lemma
   aform_val_aform_of_ivl_innerE:
   assumes "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes "a \<le> b" "c \<in> Basis"
   obtains f where "aform_val e (aform_of_ivl a b) \<bullet> c = aform_val f (aform_of_ivl (a \<bullet> c) (b \<bullet> c))"
     "f \<in> UNIV \<rightarrow> {-1 .. 1}"
 proof -
   have [simp]: "a \<bullet> c \<le> b \<bullet> c"
     using assms by (auto simp: eucl_le[where 'a='a])
   have "(\<lambda>x. x \<bullet> c) ` Affine (aform_of_ivl a b) = Affine (aform_of_ivl (a \<bullet> c) (b \<bullet> c))"
     using assms
     by (auto simp: Affine_aform_of_ivl eucl_le[where 'a='a]
       image_eqI[where x="\<Sum>i\<in>Basis. (if i = c then x else a \<bullet> i) *\<^sub>R i" for x])
   then obtain f where
       "aform_val e (aform_of_ivl a b) \<bullet> c = aform_val f (aform_of_ivl (a \<bullet> c) (b \<bullet> c))"
       "f \<in> UNIV \<rightarrow> {-1 .. 1}"
     using assms
     by (force simp: Affine_def valuate_def)
   thus ?thesis ..
 qed
 
 lift_definition coord_pdevs::"nat \<Rightarrow> real pdevs" is "\<lambda>n i. if i = n then 1 else 0" by auto
 
 lemma pdevs_apply_coord_pdevs [simp]: "pdevs_apply (coord_pdevs i) x = (if x = i then 1 else 0)"
   by transfer simp
 
 lemma degree_coord_pdevs[simp]: "degree (coord_pdevs i) = Suc i"
   by (auto intro!: degree_eqI)
 
 lemma pdevs_val_coord_pdevs[simp]: "pdevs_val e (coord_pdevs i) = e i"
   by (auto simp: pdevs_val_sum if_distrib sum.delta cong: if_cong)
 
 definition "aforms_of_ivls ls us = map
     (\<lambda>(i, (l, u)). ((l + u)/2, scaleR_pdevs ((u - l)/2) (coord_pdevs i)))
     (zip [0..<length ls] (zip ls us))"
 
 lemma
   aforms_of_ivls:
   assumes "length ls = length us" "length xs = length ls"
   assumes "\<And>i. i < length xs \<Longrightarrow> xs ! i \<in> {ls ! i .. us ! i}"
   shows "xs \<in> Joints (aforms_of_ivls ls us)"
 proof -
   {
     fix i assume "i < length xs"
     then have "\<exists>e. e \<in> {-1 .. 1} \<and> xs ! i = (ls ! i + us ! i) / 2 + e * (us ! i - ls ! i) / 2"
       using assms
       by (force intro!: exI[where x="(xs ! i - (ls ! i + us ! i) / 2) / (us ! i - ls ! i) * 2"]
           simp: divide_simps algebra_simps)
   } then obtain e where e: "e i \<in> {-1 .. 1}"
     "xs ! i = (ls ! i + us ! i) / 2 + e i * (us ! i - ls ! i) / 2" 
     if "i < length xs" for i
     using that by metis
   define e' where "e' i = (if i < length xs then e i else 0)" for i
   show ?thesis
     using e assms
     by (auto simp: aforms_of_ivls_def Joints_def valuate_def e'_def aform_val_def
         intro!: image_eqI[where x=e'] nth_equalityI)
 qed
 
 
 subsection \<open>Approximate Operations\<close>
 
 definition "max_pdev x = fold (\<lambda>x y. if infnorm (snd x) \<ge> infnorm (snd y) then x else y) (list_of_pdevs x) (0, 0)"
 
 
 subsubsection \<open>set of generated endpoints\<close>
 
 fun points_of_list where
   "points_of_list x0 [] = [x0]"
 | "points_of_list x0 ((i, x)#xs) = (points_of_list (x0 + x) xs @ points_of_list (x0 - x) xs)"
 
 primrec points_of_aform where
   "points_of_aform (x, xs) = points_of_list x (list_of_pdevs xs)"
 
 
 subsubsection \<open>Approximate total deviation\<close>
 
 definition sum_list'::"nat \<Rightarrow> 'a list \<Rightarrow> 'a::executable_euclidean_space"
   where "sum_list' p xs = fold (\<lambda>a b. eucl_truncate_up p (a + b)) xs 0"
 
 definition "tdev' p x = sum_list' p (map (abs o snd) (list_of_pdevs x))"
 
 lemma
   eucl_fold_mono:
   fixes f::"'a::ordered_euclidean_space\<Rightarrow>'a\<Rightarrow>'a"
   assumes mono: "\<And>w x y z. w \<le> x \<Longrightarrow> y \<le> z \<Longrightarrow> f w y \<le> f x z"
   shows "x \<le> y \<Longrightarrow> fold f xs x \<le> fold f xs y"
   by (induct xs arbitrary: x y) (auto simp: mono)
 
 lemma sum_list_add_le_fold_eucl_truncate_up:
   fixes z::"'a::executable_euclidean_space"
   shows "sum_list xs + z \<le> fold (\<lambda>x y. eucl_truncate_up p (x + y)) xs z"
 proof (induct xs arbitrary: z)
   case (Cons x xs)
   have "sum_list (x # xs) + z = sum_list xs + (z + x)"
     by simp
   also have "\<dots> \<le> fold (\<lambda>x y. eucl_truncate_up p (x + y)) xs (z + x)"
     using Cons by simp
   also have "\<dots> \<le> fold (\<lambda>x y. eucl_truncate_up p (x + y)) xs (eucl_truncate_up p (x + z))"
     by (auto intro!: add_mono eucl_fold_mono eucl_truncate_up eucl_truncate_up_mono simp: ac_simps)
   finally show ?case by simp
 qed simp
 
 lemma sum_list_le_sum_list':
   "sum_list xs \<le> sum_list' p xs"
   unfolding sum_list'_def
   using sum_list_add_le_fold_eucl_truncate_up[of xs 0] by simp
 
 lemma sum_list'_sum_list_le:
   "y \<le> sum_list xs \<Longrightarrow> y \<le> sum_list' p xs"
   by (metis sum_list_le_sum_list' order.trans)
 
 lemma tdev': "tdev x \<le> tdev' p x"
   unfolding tdev'_def
 proof -
   have "tdev x = (\<Sum>i = 0 ..< degree x. \<bar>pdevs_apply x i\<bar>)"
     by (auto intro!: sum.mono_neutral_cong_left simp: tdev_def)
   also have "\<dots> = (\<Sum>i \<leftarrow> rev [0 ..< degree x]. \<bar>pdevs_apply x i\<bar>)"
     by (metis atLeastLessThan_upt sum_list_rev rev_map sum_set_upt_conv_sum_list_nat)
   also have
     "\<dots> = sum_list (map (\<lambda>xa. \<bar>pdevs_apply x xa\<bar>) [xa\<leftarrow>rev [0..<degree x] . pdevs_apply x xa \<noteq> 0])"
     unfolding filter_map map_map o_def
     by (subst sum_list_map_filter) auto
   also note sum_list_le_sum_list'[of _ p]
   also have "[xa\<leftarrow>rev [0..<degree x] . pdevs_apply x xa \<noteq> 0] =
       rev (sorted_list_of_set (pdevs_domain x))"
     by (subst rev_is_rev_conv[symmetric])
       (auto simp: filter_map rev_filter intro!: sorted_distinct_set_unique
         sorted_filter[of "\<lambda>x. x", simplified] degree_gt)
   finally
   show "tdev x \<le> sum_list' p (map (abs \<circ> snd) (list_of_pdevs x))"
     by (auto simp: list_of_pdevs_def o_def rev_map filter_map rev_filter)
 qed
 
 lemma tdev'_le: "x \<le> tdev y \<Longrightarrow> x \<le> tdev' p y"
   by (metis order.trans tdev')
 
 lemmas abs_pdevs_val_le_tdev' = tdev'_le[OF abs_pdevs_val_le_tdev]
 
 lemma tdev'_uminus_pdevs[simp]: "tdev' p (uminus_pdevs x) = tdev' p x"
   by (auto simp: tdev'_def o_def rev_map filter_map rev_filter list_of_pdevs_def pdevs_domain_def)
 
 abbreviation Radius::"'a::ordered_euclidean_space aform \<Rightarrow> 'a"
   where "Radius X \<equiv> tdev (snd X)"
 
 abbreviation Radius'::"nat\<Rightarrow>'a::executable_euclidean_space aform \<Rightarrow> 'a"
   where "Radius' p X \<equiv> tdev' p (snd X)"
 
 lemma Radius'_uminus_aform[simp]: "Radius' p (uminus_aform X) = Radius' p X"
   by (auto simp: uminus_aform_def)
 
 
 subsubsection \<open>truncate partial deviations\<close>
 
 definition trunc_pdevs_raw::"nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a::executable_euclidean_space"
   where "trunc_pdevs_raw p x i = eucl_truncate_down p (x i)"
 
 lemma nonzeros_trunc_pdevs_raw:
   "{i. trunc_pdevs_raw r x i \<noteq> 0} \<subseteq> {i. x i \<noteq> 0}"
   by (auto simp: trunc_pdevs_raw_def[abs_def])
 
 lift_definition trunc_pdevs::"nat \<Rightarrow> 'a::executable_euclidean_space pdevs \<Rightarrow> 'a pdevs"
   is trunc_pdevs_raw
   by (auto intro!: finite_subset[OF nonzeros_trunc_pdevs_raw])
 
 definition trunc_err_pdevs_raw::"nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a::executable_euclidean_space"
   where "trunc_err_pdevs_raw p x i = trunc_pdevs_raw p x i - x i"
 
 lemma nonzeros_trunc_err_pdevs_raw:
   "{i. trunc_err_pdevs_raw r x i \<noteq> 0} \<subseteq> {i. x i \<noteq> 0}"
   by (auto simp: trunc_pdevs_raw_def trunc_err_pdevs_raw_def[abs_def])
 
 lift_definition trunc_err_pdevs::"nat \<Rightarrow> 'a::executable_euclidean_space pdevs \<Rightarrow> 'a pdevs"
   is trunc_err_pdevs_raw
   by (auto intro!: finite_subset[OF nonzeros_trunc_err_pdevs_raw])
 
 term float_plus_down
 
 lemma pdevs_apply_trunc_pdevs[simp]:
   fixes x y::"'a::euclidean_space"
   shows "pdevs_apply (trunc_pdevs p X) n = eucl_truncate_down p (pdevs_apply X n)"
   by transfer (simp add: trunc_pdevs_raw_def)
 
 lemma pdevs_apply_trunc_err_pdevs[simp]:
   fixes x y::"'a::euclidean_space"
   shows "pdevs_apply (trunc_err_pdevs p X) n =
     eucl_truncate_down p (pdevs_apply X n) - (pdevs_apply X n)"
   by transfer (auto simp: trunc_err_pdevs_raw_def trunc_pdevs_raw_def)
 
 lemma pdevs_val_trunc_pdevs:
   fixes x y::"'a::euclidean_space"
   shows "pdevs_val e (trunc_pdevs p X) = pdevs_val e X + pdevs_val e (trunc_err_pdevs p X)"
 proof -
   have "pdevs_val e X + pdevs_val e (trunc_err_pdevs p X) =
       pdevs_val e (add_pdevs X (trunc_err_pdevs p X))"
     by simp
   also have "\<dots> = pdevs_val e (trunc_pdevs p X)"
     by (auto simp: pdevs_val_def trunc_pdevs_raw_def trunc_err_pdevs_raw_def)
   finally show ?thesis by simp
 qed
 
 lemma pdevs_val_trunc_err_pdevs:
   fixes x y::"'a::euclidean_space"
   shows "pdevs_val e (trunc_err_pdevs p X) = pdevs_val e (trunc_pdevs p X) - pdevs_val e X"
   by (simp add: pdevs_val_trunc_pdevs)
 
 definition truncate_aform::"nat \<Rightarrow> 'a aform \<Rightarrow> 'a::executable_euclidean_space aform"
   where "truncate_aform p x = (eucl_truncate_down p (fst x), trunc_pdevs p (snd x))"
 
 definition truncate_error_aform::"nat \<Rightarrow> 'a aform \<Rightarrow> 'a::executable_euclidean_space aform"
   where "truncate_error_aform p x =
     (eucl_truncate_down p (fst x) - fst x, trunc_err_pdevs p (snd x))"
 
 lemma
   abs_aform_val_le:
   assumes "e \<in> UNIV \<rightarrow> {- 1..1}"
   shows "abs (aform_val e X) \<le> eucl_truncate_up p (\<bar>fst X\<bar> + tdev' p (snd X))"
 proof -
   have "abs (aform_val e X) \<le> \<bar>fst X\<bar> + \<bar>pdevs_val e (snd X)\<bar>"
     by (auto simp: aform_val_def intro!: abs_triangle_ineq)
   also have "\<bar>pdevs_val e (snd X)\<bar> \<le> tdev (snd X)"
     using assms by (rule abs_pdevs_val_le_tdev)
   also note tdev'
   also note eucl_truncate_up
   finally show ?thesis by simp
 qed
 
 
 subsubsection \<open>truncation with error bound\<close>
 
 definition "trunc_bound_eucl p s =
   (let
     d = eucl_truncate_down p s;
     ed = abs (d - s) in
   (d, eucl_truncate_up p ed))"
 
 lemma trunc_bound_euclE:
   obtains err where
   "\<bar>err\<bar> \<le> snd (trunc_bound_eucl p x)"
   "fst (trunc_bound_eucl p x) = x + err"
 proof atomize_elim
   have "fst (trunc_bound_eucl p x) = x + (eucl_truncate_down p x - x)"
     (is "_ = _ + ?err")
     by (simp_all add: trunc_bound_eucl_def Let_def)
   moreover have "abs ?err \<le> snd (trunc_bound_eucl p x)"
     by (simp add: trunc_bound_eucl_def Let_def eucl_truncate_up)
   ultimately show "\<exists>err. \<bar>err\<bar> \<le> snd (trunc_bound_eucl p x) \<and> fst (trunc_bound_eucl p x) = x + err"
     by auto
 qed
 
 definition "trunc_bound_pdevs p x = (trunc_pdevs p x, tdev' p (trunc_err_pdevs p x))"
 
 lemma pdevs_apply_fst_trunc_bound_pdevs[simp]: "pdevs_apply (fst (trunc_bound_pdevs p x)) =
   pdevs_apply (trunc_pdevs p x)"
   by (simp add: trunc_bound_pdevs_def)
 
 lemma trunc_bound_pdevsE:
   assumes "e \<in> UNIV \<rightarrow> {- 1..1}"
   obtains err where
   "\<bar>err\<bar> \<le> snd (trunc_bound_pdevs p x)"
   "pdevs_val e (fst ((trunc_bound_pdevs p x))) = pdevs_val e x + err"
 proof atomize_elim
   have "pdevs_val e (fst (trunc_bound_pdevs p x)) = pdevs_val e x +
     pdevs_val e (add_pdevs (trunc_pdevs p x) (uminus_pdevs x))"
     (is "_ = _ + ?err")
     by (simp_all add: trunc_bound_pdevs_def Let_def)
   moreover have "abs ?err \<le> snd (trunc_bound_pdevs p x)"
     using assms
     by (auto simp add: pdevs_val_trunc_pdevs trunc_bound_pdevs_def Let_def eucl_truncate_up
       intro!: order_trans[OF abs_pdevs_val_le_tdev tdev'])
   ultimately show "\<exists>err. \<bar>err\<bar> \<le> snd (trunc_bound_pdevs p x) \<and>
       pdevs_val e (fst ((trunc_bound_pdevs p x))) = pdevs_val e x + err"
     by auto
 qed
 
 lemma
   degree_add_pdevs_le:
   assumes "degree X \<le> n"
   assumes "degree Y \<le> n"
   shows "degree (add_pdevs X Y) \<le> n"
   using assms
   by (auto intro!: degree_le)
 
 
 lemma truncate_aform_error_aform_cancel:
   "aform_val e (truncate_aform p z) = aform_val e z + aform_val e (truncate_error_aform p z) "
   by (simp add: truncate_aform_def aform_val_def truncate_error_aform_def pdevs_val_trunc_pdevs)
 
 lemma error_absE:
   assumes "abs err \<le> k"
   obtains e::real where "err = e * k" "e \<in> {-1 .. 1}"
   using assms
   by atomize_elim
     (safe intro!: exI[where x="err / abs k"] divide_atLeastAtMost_1_absI, auto)
 
 lemma eucl_truncate_up_nonneg_eq_zero_iff:
   "x \<ge> 0 \<Longrightarrow> eucl_truncate_up p x = 0 \<longleftrightarrow> x = 0"
   by (metis (poly_guards_query) eq_iff eucl_truncate_up eucl_truncate_up_zero)
 
 lemma
   aform_val_consume_error:
   assumes "abs err \<le> abs (pdevs_apply (snd X) n)"
   shows "aform_val (e(n := 0)) X + err = aform_val (e(n := err/pdevs_apply (snd X) n)) X"
   using assms
   by (auto simp add: aform_val_def)
 
 lemma
   aform_val_consume_errorE:
   fixes X::"real aform"
   assumes "abs err \<le> abs (pdevs_apply (snd X) n)"
   obtains err' where "aform_val (e(n := 0)) X + err = aform_val (e(n := err')) X" "err' \<in> {-1 .. 1}"
   by atomize_elim
     (rule aform_val_consume_error assms aform_val_consume_error exI conjI
       divide_atLeastAtMost_1_absI)+
 
 lemma
   degree_trunc_pdevs_le:
   assumes "degree X \<le> n"
   shows "degree (trunc_pdevs p X) \<le> n"
   using assms
   by (auto intro!: degree_le)
 
 lemma pdevs_val_sum_less_degree:
   "pdevs_val e X = (\<Sum>i<d. e i *\<^sub>R pdevs_apply X i)" if "degree X \<le> d"
   unfolding pdevs_val_pdevs_domain
   apply (rule sum.mono_neutral_cong_left)
   using that
   by force+
 
 
 subsubsection \<open>general affine operation\<close>
 
 definition "affine_binop (X::real aform) Y a b c d k =
   (a * fst X + b * fst Y + c,
     pdev_upd (add_pdevs (scaleR_pdevs a (snd X)) (scaleR_pdevs b (snd Y))) k d)"
 
 lemma pdevs_domain_One_pdevs[simp]: "pdevs_domain (One_pdevs::'a::executable_euclidean_space pdevs) =
   {0..<DIM('a)}"
   apply (auto simp: length_Basis_list split: if_splits)
   subgoal for i
     using nth_Basis_list_in_Basis[of i, where 'a='a]
     by (auto simp: length_Basis_list)
   done
 
 lemma pdevs_val_One_pdevs:
   "pdevs_val e (One_pdevs::'a::executable_euclidean_space pdevs) = (\<Sum>i<DIM('a). e i *\<^sub>R Basis_list ! i)"
   by (auto simp: pdevs_val_pdevs_domain length_Basis_list intro!:sum.cong)
 
 lemma affine_binop:
   assumes "degree_aforms [X, Y] \<le> k"
   shows "aform_val e (affine_binop X Y a b c d k) =
     a * aform_val e X + b * aform_val e Y + c + e k * d"
   using assms
   by (auto simp: aform_val_def affine_binop_def degrees_def
       pdevs_val_msum_pdevs degree_add_pdevs_le pdevs_val_One_pdevs Basis_list_real_def
       algebra_simps)
 
 definition "affine_binop' p (X::real aform) Y a b c d k =
   (let
     \<comment> \<open>TODO: more round-off operations here?\<close>
     (r, e1) = trunc_bound_eucl p (a * fst X + b * fst Y + c);
     (Z, e2) = trunc_bound_pdevs p (add_pdevs (scaleR_pdevs a (snd X)) (scaleR_pdevs b (snd Y)))
   in
     (r, pdev_upd Z k (sum_list' p [e1, e2, d]))
   )"
 
 lemma sum_list'_noneg_eq_zero_iff: "sum_list' p xs = 0 \<longleftrightarrow> (\<forall>x\<in>set xs. x = 0)" if "\<And>x. x \<in> set xs \<Longrightarrow> x \<ge> 0"
 proof safe
   fix x assume x: "sum_list' p xs = 0" "x \<in> set xs"
   from that have "0 \<le> sum_list xs" by (auto intro!: sum_list_nonneg)
   with that x have "sum_list xs = 0"
     by (metis antisym sum_list_le_sum_list')
   then have "(\<Sum>i<length xs.  xs ! i) = 0"
     by (auto simp: sum_list_sum_nth atLeast0LessThan)
   then show "x = 0" using x(2) that
     by (subst (asm) sum_nonneg_eq_0_iff) (auto simp: in_set_conv_nth)
 next
   show "\<forall>x\<in>set xs. x = 0 \<Longrightarrow> sum_list' p xs = 0"
     by (induction xs) (auto simp: sum_list'_def)
 qed
 
 lemma affine_binop'E:
   assumes deg: "degree_aforms [X, Y] \<le> k"
   assumes e: "e \<in> UNIV \<rightarrow> {- 1..1}"
   assumes d: "abs u \<le> d"
   obtains ek where
     "a * aform_val e X + b * aform_val e Y + c + u = aform_val (e(k:=ek)) (affine_binop' p X Y a b c d k)"
     "ek \<in> {-1 .. 1}"
 proof -
   have "a * aform_val e X + b * aform_val e Y + c + u =
     (a * fst X + b * fst Y + c) + pdevs_val e (add_pdevs (scaleR_pdevs a (snd X)) (scaleR_pdevs b (snd Y))) + u"
     (is "_ = ?c + pdevs_val _ ?ps + _")
     by (auto simp: aform_val_def algebra_simps)
 
   from trunc_bound_euclE[of p ?c] obtain ec where ec: "abs ec \<le> snd (trunc_bound_eucl p ?c)"
     "fst (trunc_bound_eucl p ?c) - ec = ?c"
     by (auto simp: algebra_simps)
 
   moreover
 
   from trunc_bound_pdevsE[OF e, of p ?ps]
   obtain eps where eps: "\<bar>eps\<bar> \<le> snd (trunc_bound_pdevs p ?ps)"
     "pdevs_val e (fst (trunc_bound_pdevs p ?ps)) - eps = pdevs_val e ?ps"
     by (auto simp: algebra_simps)
 
   moreover
   define ek where "ek = (u - ec - eps)/
         sum_list' p [snd (trunc_bound_eucl p ?c), snd (trunc_bound_pdevs p ?ps), d]"
   have "degree (fst (trunc_bound_pdevs p ?ps)) \<le>
       degree_aforms [X, Y]"
     by (auto simp: trunc_bound_pdevs_def degrees_def intro!: degree_trunc_pdevs_le degree_add_pdevs_le)
   moreover
   from this have "pdevs_apply (fst (trunc_bound_pdevs p ?ps)) k = 0"
     using deg order_trans by blast
   ultimately have "a * aform_val e X + b * aform_val e Y + c + u =
     aform_val (e(k:=ek)) (affine_binop' p X Y a b c d k)"
     apply (auto simp: affine_binop'_def algebra_simps aform_val_def split: prod.splits)
     subgoal for x y z
       apply (cases "sum_list' p [x, z, d] = 0")
       subgoal
         apply simp
         apply (subst (asm) sum_list'_noneg_eq_zero_iff)
         using d deg
         by auto
       subgoal
         apply (simp add: divide_simps algebra_simps ek_def)
         using \<open>pdevs_apply (fst (trunc_bound_pdevs p (add_pdevs (scaleR_pdevs a (snd X)) (scaleR_pdevs b (snd Y))))) k = 0\<close> by auto
       done
     done
   moreover have "ek \<in> {-1 .. 1}"
     unfolding ek_def
     apply (rule divide_atLeastAtMost_1_absI)
     apply (rule abs_triangle_ineq4[THEN order_trans])
     apply (rule order_trans)
      apply (rule add_right_mono)
      apply (rule abs_triangle_ineq4)
     using ec(1) eps(1)
     by (auto simp: sum_list'_def eucl_truncate_up_real_def add.assoc
         intro!: order_trans[OF _ abs_ge_self] order_trans[OF _ truncate_up_le] add_mono d )
   ultimately show ?thesis ..
 qed
 
 subsubsection \<open>Inf/Sup\<close>
 
 definition "Inf_aform' p X = eucl_truncate_down p (fst X - tdev' p (snd X))"
 
 definition "Sup_aform' p X = eucl_truncate_up p (fst X + tdev' p (snd X))"
 
 lemma Inf_aform':
   shows "Inf_aform' p X \<le> Inf_aform X"
   unfolding Inf_aform_def Inf_aform'_def
   by (auto intro!: eucl_truncate_down_le add_left_mono tdev')
 
 lemma Sup_aform':
   shows "Sup_aform X \<le> Sup_aform' p X"
   unfolding Sup_aform_def Sup_aform'_def
   by (rule eucl_truncate_up_le add_left_mono tdev')+
 
 lemma Inf_aform_le_Sup_aform[intro]:
   "Inf_aform X \<le> Sup_aform X"
   by (simp add: Inf_aform_def Sup_aform_def algebra_simps)
 
 lemma Inf_aform'_le_Sup_aform'[intro]:
   "Inf_aform' p X \<le> Sup_aform' p X"
   by (metis Inf_aform' Inf_aform_le_Sup_aform Sup_aform' order.trans)
 
 definition
-  "ivls_of_aforms prec = map (\<lambda>a. Some (float_of (Inf_aform' prec a), float_of(Sup_aform' prec a)))"
+  "ivls_of_aforms prec = map (\<lambda>a. Interval' (float_of (Inf_aform' prec a)) (float_of(Sup_aform' prec a)))"
 
 lemma
   assumes "\<And>i. e'' i \<le> 1"
   assumes "\<And>i. -1 \<le> e'' i"
   shows Inf_aform'_le: "Inf_aform' p r \<le> aform_val e'' r"
     and Sup_aform'_le: "aform_val e'' r \<le> Sup_aform' p r"
   by (auto intro!: order_trans[OF Inf_aform'] order_trans[OF _ Sup_aform'] Inf_aform Sup_aform
     simp: Affine_def valuate_def intro!: image_eqI[where x=e''] assms)
 
 
 lemma InfSup_aform'_in_float[intro, simp]:
   "Inf_aform' p X \<in> float" "Sup_aform' p X \<in> float"
   by (auto simp: Inf_aform'_def eucl_truncate_down_real_def
       Sup_aform'_def eucl_truncate_up_real_def)
 
 theorem ivls_of_aforms: "xs \<in> Joints XS \<Longrightarrow> bounded_by xs (ivls_of_aforms prec XS)"
-  by (auto simp: bounded_by_def ivls_of_aforms_def Affine_def valuate_def Pi_iff
+  by (auto simp: bounded_by_def ivls_of_aforms_def Affine_def valuate_def Pi_iff set_of_eq
       intro!: Inf_aform'_le Sup_aform'_le
-      dest!: nth_in_AffineI split: option.splits)
+      dest!: nth_in_AffineI split: Interval'_splits)
 
 definition "isFDERIV_aform prec N xs fas AS = isFDERIV_approx prec N xs fas (ivls_of_aforms prec AS)"
 
 theorem isFDERIV_aform:
   assumes "isFDERIV_aform prec N xs fas AS"
   assumes "vs \<in> Joints AS"
   shows "isFDERIV N xs fas vs"
   apply (rule isFDERIV_approx)
   apply (rule ivls_of_aforms)
   apply (rule assms)
   apply (rule assms[unfolded isFDERIV_aform_def])
   done
 
 definition "env_len env l = (\<forall>xs \<in> env. length xs = l)"
 
 lemma env_len_takeI: "env_len xs d1 \<Longrightarrow> d1 \<ge> d \<Longrightarrow> env_len (take d ` xs) d"
   by (auto simp: env_len_def)
 
 subsection \<open>Min Range approximation\<close>
 
 lemma
   linear_lower:
   fixes x::real
   assumes "\<And>x. x \<in> {a .. b} \<Longrightarrow> (f has_field_derivative f' x) (at x within {a .. b})"
   assumes "\<And>x. x \<in> {a .. b} \<Longrightarrow> f' x \<le> u"
   assumes "x \<in> {a .. b}"
   shows "f b + u * (x - b) \<le> f x"
 proof -
   from assms(2-)
     mvt_very_simple[of x b f "\<lambda>x. (*) (f' x)",
       rule_format,
       OF _ has_derivative_subset[OF assms(1)[simplified has_field_derivative_def]]]
   obtain y where "y \<in> {x .. b}"  "f b - f x = (b - x) * f' y"
     by (auto simp: Bex_def ac_simps)
   moreover hence "f' y \<le> u" using assms by auto
   ultimately have "f b - f x \<le> (b - x) * u"
     by (auto intro!: mult_left_mono)
   thus ?thesis by (simp add: algebra_simps)
 qed
 
 lemma
   linear_lower2:
   fixes x::real
   assumes "\<And>x. x \<in> {a .. b} \<Longrightarrow> (f has_field_derivative f' x) (at x within {a .. b})"
   assumes "\<And>x. x \<in> {a .. b} \<Longrightarrow> l \<le> f' x"
   assumes "x \<in> {a .. b}"
   shows "f x \<ge> f a + l * (x - a)"
 proof -
   from assms(2-)
     mvt_very_simple[of a x f "\<lambda>x. (*) (f' x)",
       rule_format,
       OF _ has_derivative_subset[OF assms(1)[simplified has_field_derivative_def]]]
   obtain y where "y \<in> {a .. x}"  "f x - f a = (x - a) * f' y"
     by (auto simp: Bex_def ac_simps)
   moreover hence "l \<le> f' y" using assms by auto
   ultimately have "(x - a) * l \<le> f x - f a"
     by (auto intro!: mult_left_mono)
   thus ?thesis by (simp add: algebra_simps)
 qed
 
 lemma
   linear_upper:
   fixes x::real
   assumes "\<And>x. x \<in> {a .. b} \<Longrightarrow> (f has_field_derivative f' x) (at x within {a .. b})"
   assumes "\<And>x. x \<in> {a .. b} \<Longrightarrow> f' x \<le> u"
   assumes "x \<in> {a .. b}"
   shows "f x \<le> f a + u * (x - a)"
 proof -
   from assms(2-)
     mvt_very_simple[of a x f "\<lambda>x. (*) (f' x)",
       rule_format,
       OF _ has_derivative_subset[OF assms(1)[simplified has_field_derivative_def]]]
   obtain y where "y \<in> {a .. x}"  "f x - f a = (x - a) * f' y"
     by (auto simp: Bex_def ac_simps)
   moreover hence "f' y \<le> u" using assms by auto
   ultimately have "(x - a) * u \<ge> f x - f a"
     by (auto intro!: mult_left_mono)
   thus ?thesis by (simp add: algebra_simps)
 qed
 
 lemma
   linear_upper2:
   fixes x::real
   assumes "\<And>x. x \<in> {a .. b} \<Longrightarrow> (f has_field_derivative f' x) (at x within {a .. b})"
   assumes "\<And>x. x \<in> {a .. b} \<Longrightarrow> l \<le> f' x"
   assumes "x \<in> {a .. b}"
   shows "f x \<le> f b + l * (x - b)"
 proof -
   from assms(2-)
     mvt_very_simple[of x b f "\<lambda>x. (*) (f' x)",
       rule_format,
       OF _ has_derivative_subset[OF assms(1)[simplified has_field_derivative_def]]]
   obtain y where "y \<in> {x .. b}"  "f b - f x = (b - x) * f' y"
     by (auto simp: Bex_def ac_simps)
   moreover hence "l \<le> f' y" using assms by auto
   ultimately have "f b - f x \<ge> (b - x) * l"
     by (auto intro!: mult_left_mono)
   thus ?thesis by (simp add: algebra_simps)
 qed
 
 lemma linear_enclosure:
   fixes x::real
   assumes "\<And>x. x \<in> {a .. b} \<Longrightarrow> (f has_field_derivative f' x) (at x within {a .. b})"
   assumes "\<And>x. x \<in> {a .. b} \<Longrightarrow> f' x \<le> u"
   assumes "x \<in> {a .. b}"
   shows "f x \<in> {f b + u * (x - b) .. f a + u * (x - a)}"
   using linear_lower[OF assms] linear_upper[OF assms]
   by auto
 
-definition "mid_err ivl = ((fst ivl + snd ivl::float)/2, (snd ivl - fst ivl)/2)"
+definition "mid_err ivl = ((lower ivl + upper ivl::float)/2, (upper ivl - lower ivl)/2)"
 
 lemma degree_aform_uminus_aform[simp]: "degree_aform (uminus_aform X) = degree_aform X"
   by (auto simp: uminus_aform_def)
 
 
 subsubsection \<open>Addition\<close>
 
 definition add_aform::"'a::real_vector aform \<Rightarrow> 'a aform \<Rightarrow> 'a aform"
   where "add_aform x y = (fst x + fst y, add_pdevs (snd x) (snd y))"
 
 lemma aform_val_add_aform:
   shows "aform_val e (add_aform X Y) = aform_val e X + aform_val e Y"
   by (auto simp: add_aform_def aform_val_def)
 
 type_synonym aform_err = "real aform \<times> real"
 
 definition add_aform'::"nat \<Rightarrow> aform_err \<Rightarrow> aform_err \<Rightarrow> aform_err"
   where "add_aform' p x y =
     (let
       z0 = trunc_bound_eucl p (fst (fst x) + fst (fst y));
       z = trunc_bound_pdevs p (add_pdevs (snd (fst x)) (snd (fst y)))
       in ((fst z0, fst z), (sum_list' p [snd z0, snd z, abs (snd x), abs (snd y)])))"
 
 abbreviation degree_aform_err::"aform_err \<Rightarrow> nat"
   where "degree_aform_err X \<equiv> degree_aform (fst X)"
 
 lemma degree_aform_err_add_aform':
   assumes "degree_aform_err x \<le> n"
   assumes "degree_aform_err y \<le> n"
   shows "degree_aform_err (add_aform' p x y) \<le> n"
   using assms
   by (auto simp: add_aform'_def Let_def trunc_bound_pdevs_def
       intro!: degree_pdev_upd_le degree_trunc_pdevs_le degree_add_pdevs_le)
 
 definition "aform_err e Xe = {aform_val e (fst Xe) - snd Xe .. aform_val e (fst Xe) + snd Xe::real}"
 
 lemma aform_errI: "x \<in> aform_err e Xe"
   if "abs (x - aform_val e (fst Xe)) \<le> snd Xe"
   using that by (auto simp: aform_err_def abs_real_def algebra_simps split: if_splits)
 
 lemma add_aform':
   assumes e: "e \<in> UNIV \<rightarrow> {- 1..1}"
   assumes x: "x \<in> aform_err e X"
   assumes y: "y \<in> aform_err e Y"
   shows "x + y \<in> aform_err e (add_aform' p X Y)"
 proof -
   let ?t1 = "trunc_bound_eucl p (fst (fst X) + fst (fst Y))"
   from trunc_bound_euclE
   obtain e1 where abs_e1: "\<bar>e1\<bar> \<le> snd ?t1" and e1: "fst ?t1 = fst (fst X) + fst (fst Y) + e1"
     by blast
   let ?t2 = "trunc_bound_pdevs p (add_pdevs (snd (fst X)) (snd (fst Y)))"
   from trunc_bound_pdevsE[OF e, of p "add_pdevs (snd (fst X)) (snd (fst Y))"]
   obtain e2 where abs_e2: "\<bar>e2\<bar> \<le> snd (?t2)"
     and e2: "pdevs_val e (fst ?t2) = pdevs_val e (add_pdevs (snd (fst X)) (snd (fst Y))) + e2"
     by blast
 
   have e_le: "\<bar>e1 + e2 + snd X + snd Y\<bar> \<le> snd (add_aform' p (X) Y)"
     apply (auto simp: add_aform'_def Let_def )
     apply (rule sum_list'_sum_list_le)
     apply (simp add: add.assoc)
     by (intro order.trans[OF abs_triangle_ineq] add_mono abs_e1 abs_e2 order_refl)
   then show ?thesis
     apply (intro aform_errI)
     using x y abs_e1 abs_e2
     apply (simp add: aform_val_def aform_err_def add_aform_def add_aform'_def Let_def e1 e2 assms)
     by (auto intro!: order_trans[OF _ sum_list_le_sum_list'] )
 qed
 
 
 subsubsection \<open>Scaling\<close>
 
 definition aform_scaleR::"real aform \<Rightarrow> 'a::real_vector \<Rightarrow> 'a aform"
   where "aform_scaleR x y = (fst x *\<^sub>R y, pdevs_scaleR (snd x) y)"
 
 lemma aform_val_scaleR_aform[simp]:
   shows "aform_val e (aform_scaleR X y) = aform_val e X *\<^sub>R y"
   by (auto simp: aform_scaleR_def aform_val_def scaleR_left_distrib)
 
 
 subsubsection \<open>Multiplication\<close>
 
 lemma aform_val_mult_exact:
   "aform_val e x * aform_val e y =
     fst x * fst y +
     pdevs_val e (add_pdevs (scaleR_pdevs (fst y) (snd x)) (scaleR_pdevs (fst x) (snd y))) +
     (\<Sum>i<d. e i *\<^sub>R pdevs_apply (snd x) i)*(\<Sum>i<d. e i *\<^sub>R pdevs_apply (snd y) i)"
    if "degree (snd x) \<le> d" "degree (snd y) \<le> d"
    using that
   by (auto simp: pdevs_val_sum_less_degree[where d=d] aform_val_def algebra_simps)
 
 lemma sum_times_bound:\<comment> \<open>TODO: this gives better bounds for the remainder of multiplication\<close>
   "(\<Sum>i<d. e i * f i::real) * (\<Sum>i<d. e i * g i) =
    (\<Sum>i<d. (e i)\<^sup>2 * (f i * g i)) +
    (\<Sum>(i, j) | i < j \<and> j < d. (e i * e j) * (f j * g i + f i * g j))" for d::nat
 proof -
   have "(\<Sum>i<d. e i * f i)*(\<Sum>i<d. e i * g i) = (\<Sum>(i, j)\<in>{..<d} \<times> {..<d}. e i * f i * (e j * g j))"
     unfolding sum_product sum.cartesian_product ..
   also have "\<dots> = (\<Sum>(i, j)\<in>{..<d} \<times> {..<d} \<inter> {(i, j). i = j}. e i * f i * (e j * g j)) +
     ((\<Sum>(i, j)\<in>{..<d} \<times> {..<d} \<inter> {(i, j). i < j}. e i * f i * (e j * g j)) +
     (\<Sum>(i, j)\<in>{..<d} \<times> {..<d} \<inter> {(i, j). j < i}. e i * f i * (e j * g j)))"
     (is "_ = ?a + (?b + ?c)")
     by (subst sum.union_disjoint[symmetric], force, force, force)+ (auto intro!: sum.cong)
   also have "?c = (\<Sum>(i, j)\<in>{..<d} \<times> {..<d} \<inter> {(i, j). i < j}. e i * f j * (e j * g i))"
     by (rule sum.reindex_cong[of "\<lambda>(x, y). (y, x)"]) (auto intro!: inj_onI)
   also have "?b + \<dots> = (\<Sum>(i, j)\<in>{..<d} \<times> {..<d} \<inter> {(i, j). i < j}. (e i * e j) * (f j * g i + f i * g j))"
     by (auto simp: algebra_simps sum.distrib split_beta')
   also have "\<dots> = (\<Sum>(i, j) | i < j \<and> j < d. (e i * e j) * (f j * g i + f i * g j))"
     by (rule sum.cong) auto
   also have "?a = (\<Sum>i<d. (e i)\<^sup>2 * (f i * g i))"
     by (rule sum.reindex_cong[of "\<lambda>i. (i, i)"]) (auto simp: power2_eq_square intro!: inj_onI)
   finally show ?thesis by simp
 qed
 
 definition mult_aform::"aform_err \<Rightarrow> aform_err \<Rightarrow> aform_err"
   where "mult_aform x y = ((fst (fst x) * fst (fst y),
     (add_pdevs (scaleR_pdevs (fst (fst y)) (snd (fst x))) (scaleR_pdevs (fst (fst x)) (snd (fst y))))),
      (tdev (snd (fst x)) * tdev (snd (fst y)) +
       abs (snd x) * (abs (fst (fst y)) + Radius (fst y)) +
       abs (snd y) * (abs (fst (fst x)) + Radius (fst x)) + abs (snd x) * abs (snd y)
      ))"
 
 lemma mult_aformE:
   fixes X Y::"aform_err"
   assumes e: "e \<in> UNIV \<rightarrow> {- 1..1}"
   assumes x: "x \<in> aform_err e X"
   assumes y: "y \<in> aform_err e Y"
   shows "x * y \<in> aform_err e (mult_aform X Y)"
 proof -
   define ex where "ex \<equiv> x - aform_val e (fst X)"
   define ey where "ey \<equiv> y - aform_val e (fst Y)"
 
   have [intro, simp]: "\<bar>ex\<bar> \<le> \<bar>snd X\<bar>" "\<bar>ey\<bar> \<le> \<bar>snd Y\<bar>"
     using x y
     by (auto simp: ex_def ey_def aform_err_def)
   have "x * y =
     fst (fst X) * fst (fst Y) +
     fst (fst Y) * pdevs_val e (snd (fst X)) +
     fst (fst X) * pdevs_val e (snd (fst Y)) +
 
     (pdevs_val e (snd (fst X)) * pdevs_val e (snd (fst Y)) +
     ex * (fst (fst Y) + pdevs_val e (snd (fst Y))) +
     ey * (fst (fst X) + pdevs_val e (snd (fst X))) +
     ex * ey)"
     (is "_ = ?c + ?d + ?e + ?err")
     by (auto simp: ex_def ey_def algebra_simps aform_val_def)
 
   have abs_err: "abs ?err \<le> snd (mult_aform X Y)"
     by (auto simp: mult_aform_def abs_mult
         intro!: abs_triangle_ineq[THEN order_trans] add_mono mult_mono
           abs_pdevs_val_le_tdev e)
   show ?thesis
     apply (auto simp: intro!: aform_errI order_trans[OF _ abs_err])
     apply (subst mult_aform_def)
     apply (auto simp: aform_val_def ex_def ey_def algebra_simps)
     done
 qed
 
 definition mult_aform'::"nat \<Rightarrow> aform_err \<Rightarrow> aform_err \<Rightarrow> aform_err"
   where "mult_aform' p x y = (
     let
       (fx, sx) = x;
       (fy, sy) = y;
       ex = abs sx;
       ey = abs sy;
       z0 = trunc_bound_eucl p (fst fx * fst fy);
       u = trunc_bound_pdevs p (scaleR_pdevs (fst fy) (snd fx));
       v = trunc_bound_pdevs p (scaleR_pdevs (fst fx) (snd fy));
       w = trunc_bound_pdevs p (add_pdevs (fst u) (fst v));
       tx = tdev' p (snd fx);
       ty = tdev' p (snd fy);
       l = truncate_up p (tx * ty);
       ee = truncate_up p (ex * ey);
       e1 = truncate_up p (ex * truncate_up p (abs (fst fy) + ty));
       e2 = truncate_up p (ey * truncate_up p (abs (fst fx) + tx))
     in
       ((fst z0, (fst w)), (sum_list' p [ee, e1, e2, l, snd z0, snd u, snd v, snd w])))"
 
 lemma aform_errE:
   "abs (x - aform_val e (fst X)) \<le> snd X"
   if "x \<in> aform_err e X"
   using that by (auto simp: aform_err_def)
 
 lemma mult_aform'E:
   fixes X Y::"aform_err"
   assumes e: "e \<in> UNIV \<rightarrow> {- 1..1}"
   assumes x: "x \<in> aform_err e X"
   assumes y: "y \<in> aform_err e Y"
   shows "x * y \<in> aform_err e (mult_aform' p X Y)"
 proof -
   let ?z0 = "trunc_bound_eucl p (fst (fst X) * fst (fst Y))"
   from trunc_bound_euclE
   obtain e1 where abs_e1: "\<bar>e1\<bar> \<le> snd ?z0" and e1: "fst ?z0 = fst (fst X) * fst (fst Y) + e1"
     by blast
   let ?u = "trunc_bound_pdevs p (scaleR_pdevs (fst (fst Y)) (snd (fst X)))"
   from trunc_bound_pdevsE[OF e]
   obtain e2 where abs_e2: "\<bar>e2\<bar> \<le> snd (?u)"
     and e2: "pdevs_val e (fst ?u) = pdevs_val e (scaleR_pdevs (fst (fst Y)) (snd (fst X))) + e2"
     by blast
   let ?v = "trunc_bound_pdevs p (scaleR_pdevs (fst (fst X)) (snd (fst Y)))"
   from trunc_bound_pdevsE[OF e]
   obtain e3 where abs_e3: "\<bar>e3\<bar> \<le> snd (?v)"
     and e3: "pdevs_val e (fst ?v) = pdevs_val e (scaleR_pdevs (fst (fst X)) (snd (fst Y))) + e3"
     by blast
   let ?w = "trunc_bound_pdevs p (add_pdevs (fst ?u) (fst ?v))"
   from trunc_bound_pdevsE[OF e]
   obtain e4 where abs_e4: "\<bar>e4\<bar> \<le> snd (?w)"
     and e4: "pdevs_val e (fst ?w) = pdevs_val e (add_pdevs (fst ?u) (fst ?v)) + e4"
     by blast
   let ?tx = "tdev' p (snd (fst X))" and ?ty = "tdev' p (snd (fst Y))"
   let ?l = "truncate_up p (?tx * ?ty)"
   let ?ee = "truncate_up p (abs (snd X) * abs (snd Y))"
   let ?e1 = "truncate_up p (abs (snd X) * truncate_up p (\<bar>fst (fst Y)\<bar> + ?ty))"
   let ?e2 = "truncate_up p (abs (snd Y) * truncate_up p (\<bar>fst (fst X)\<bar> + ?tx))"
 
   let ?e0 = "x * y - fst (fst X) * fst (fst Y) -
       fst (fst X) * pdevs_val e (snd (fst Y)) -
       fst (fst Y) * pdevs_val e (snd (fst X))"
   let ?err = "?e0 - (e1 + e2  + e3 + e4)"
   have "abs ?err \<le> abs ?e0 + abs e1 + abs e2 + abs e3 + abs e4"
     by arith
   also have "\<dots> \<le> abs ?e0 + snd ?z0 + snd ?u + snd ?v + snd ?w"
     unfolding abs_mult
     by (auto intro!: add_mono mult_mono e abs_pdevs_val_le_tdev' abs_ge_zero abs_e1 abs_e2 abs_e3
       abs_e4 intro: tdev'_le)
   also
   have asdf: "snd (mult_aform X Y) \<le> tdev' p (snd (fst X)) * tdev' p (snd (fst Y)) + ?e1 + ?e2 + ?ee"
     by (auto simp: mult_aform_def intro!: add_mono mult_mono order_trans[OF _ tdev'] truncate_up_le)
   have "abs ?e0 \<le> ?ee + ?e1 + ?e2 + tdev' p (snd (fst X)) * tdev' p (snd (fst Y))"
     using mult_aformE[OF e x y, THEN aform_errE, THEN order_trans, OF asdf]
     by (simp add: aform_val_def mult_aform_def) arith
   also have "tdev' p (snd (fst X)) * tdev' p (snd (fst Y)) \<le> ?l"
     by (auto intro!: truncate_up_le)
   also have "?ee + ?e1 + ?e2 + ?l + snd ?z0 + snd ?u + snd ?v + snd ?w \<le>
       sum_list' p [?ee, ?e1, ?e2, ?l, snd ?z0, snd ?u, snd ?v, snd ?w]"
     by (rule order_trans[OF _ sum_list_le_sum_list']) simp
   also have "\<dots> \<le> (snd (mult_aform' p X Y))"
     by (auto simp: mult_aform'_def Let_def assms split: prod.splits)
   finally have err_le: "abs ?err \<le> (snd (mult_aform' p X Y))" by arith
 
   show ?thesis
     apply (rule aform_errI[OF order_trans[OF _ err_le]])
     apply (subst mult_aform'_def)
     using e1 e2 e3 e4
     apply (auto simp: aform_val_def Let_def assms split: prod.splits)
     done
 qed
 
 lemma degree_aform_mult_aform':
   assumes "degree_aform_err x \<le> n"
   assumes "degree_aform_err y \<le> n"
   shows "degree_aform_err (mult_aform' p x y) \<le> n"
   using assms
   by (auto simp: mult_aform'_def Let_def trunc_bound_pdevs_def split: prod.splits
       intro!: degree_pdev_upd_le degree_trunc_pdevs_le degree_add_pdevs_le)
 
 lemma
   fixes x a b::real
   assumes "a > 0"
   assumes "x \<in> {a ..b}"
   assumes "- inverse (b*b) \<le> alpha"
   shows inverse_linear_lower: "inverse b + alpha * (x - b) \<le> inverse x" (is ?lower)
     and inverse_linear_upper: "inverse x \<le> inverse a + alpha * (x - a)" (is ?upper)
 proof -
   have deriv_inv:
     "\<And>x. x \<in> {a .. b} \<Longrightarrow> (inverse has_field_derivative - inverse (x*x)) (at x within {a .. b})"
     using assms
     by (auto intro!: derivative_eq_intros)
   show ?lower
     using assms
     by (intro linear_lower[OF deriv_inv])
         (auto simp: mult_mono intro!:  order_trans[OF _ assms(3)])
   show ?upper
     using assms
     by (intro linear_upper[OF deriv_inv])
         (auto simp: mult_mono intro!:  order_trans[OF _ assms(3)])
 qed
 
 
 subsubsection \<open>Inverse\<close>
 
 definition inverse_aform'::"nat \<Rightarrow> real aform \<Rightarrow> real aform \<times> real" where
   "inverse_aform' p X = (
     let l = Inf_aform' p X in
     let u = Sup_aform' p X in
     let a = min (abs l) (abs u) in
     let b = max (abs l) (abs u) in
     let sq = truncate_up p (b * b) in
     let alpha = - real_divl p 1 sq in
     let dmax = truncate_up p (real_divr p 1 a - alpha * a) in
     let dmin = truncate_down p (real_divl p 1 b - alpha * b) in
     let zeta' = truncate_up p ((dmin + dmax) / 2) in
     let zeta = if l < 0 then - zeta' else zeta' in
     let delta = truncate_up p (zeta - dmin) in
     let res1 = trunc_bound_eucl p (alpha * fst X) in
     let res2 = trunc_bound_eucl p (fst res1 + zeta) in
     let zs = trunc_bound_pdevs p (scaleR_pdevs alpha (snd X)) in
     ((fst res2, fst zs), (sum_list' p [delta, snd res1, snd res2, snd zs])))"
 
 lemma inverse_aform'E:
   fixes X::"real aform"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes Inf_pos: "Inf_aform' p X > 0"
   assumes "x = aform_val e X"
   shows "inverse x \<in> aform_err e (inverse_aform' p X)"
 proof -
   define l where "l = Inf_aform' p X"
   define u where "u = Sup_aform' p X"
   define a where "a = min (abs l) (abs u)"
   define b where "b = max (abs l) (abs u)"
   define sq where "sq = truncate_up p (b * b)"
   define alpha where "alpha = - (real_divl p 1 sq)"
   define d_max' where "d_max' = truncate_up p (real_divr p 1 a - alpha * a)"
   define d_min' where "d_min' = truncate_down p (real_divl p 1 b - alpha * b)"
   define zeta where "zeta = truncate_up p ((d_min' + d_max') / 2)"
   define delta where "delta = truncate_up p (zeta - d_min')"
   note vars = l_def u_def a_def b_def sq_def alpha_def d_max'_def d_min'_def zeta_def delta_def
   let ?x = "aform_val e X"
 
   have "0 < l" using assms by (auto simp add: l_def Inf_aform_def)
   have "l \<le> u" by (auto simp: l_def u_def)
 
   hence a_def': "a = l" and b_def': "b = u" and "0 < a" "0 < b"
     using \<open>0 < l\<close> by (simp_all add: a_def b_def)
   have "0 < ?x"
     by (rule less_le_trans[OF Inf_pos order.trans[OF Inf_aform' Inf_aform], OF e])
   have "a \<le> ?x"
     by (metis order.trans Inf_aform e Inf_aform' a_def' l_def)
   have "?x \<le> b"
     by (metis order.trans Sup_aform e Sup_aform' b_def' u_def)
   hence "?x \<in> {?x .. b}"
     by simp
 
   have "- inverse (b * b) \<le> alpha"
     by (auto simp add: alpha_def inverse_mult_distrib[symmetric] inverse_eq_divide sq_def
       intro!: order_trans[OF real_divl] divide_left_mono truncate_up mult_pos_pos \<open>0 < b\<close>)
 
   {
     note \<open>0 < a\<close>
     moreover
     have "?x \<in> {a .. b}" using \<open>a \<le> ?x\<close> \<open>?x \<le> b\<close> by simp
     moreover
     note \<open>- inverse (b * b) \<le> alpha\<close>
     ultimately have "inverse ?x \<le> inverse a + alpha * (?x - a)"
       by (rule inverse_linear_upper)
     also have "\<dots> = alpha * ?x + (inverse a - alpha * a)"
       by (simp add: algebra_simps)
     also have "inverse a - (alpha * a) \<le> (real_divr p 1 a - alpha * a)"
       by (auto simp: inverse_eq_divide real_divr)
     also have "\<dots> \<le> (truncate_down p (real_divl p 1 b - alpha * b) +
           (real_divr p 1 a - alpha * a)) / 2 +
         (truncate_up p (real_divr p 1 a - alpha * a) -
           truncate_down p (real_divl p 1 b - alpha * b)) / 2"
       (is "_ \<le> (truncate_down p ?lb + ?ra) / 2 + (truncate_up p ?ra - truncate_down p ?lb) / 2")
       by (auto simp add: field_simps
         intro!: order_trans[OF _ add_left_mono[OF mult_left_mono[OF truncate_up]]])
     also have "(truncate_down p ?lb + ?ra) / 2 \<le>
         truncate_up p ((truncate_down p ?lb + truncate_up p ?ra) / 2)"
       by (intro truncate_up_le divide_right_mono add_left_mono truncate_up) auto
     also
     have "(truncate_up p ?ra - truncate_down p ?lb) / 2 + truncate_down p ?lb \<le>
         (truncate_up p ((truncate_down p ?lb + truncate_up p ?ra) / 2))"
       by (rule truncate_up_le) (simp add: field_simps)
     hence "(truncate_up p ?ra - truncate_down p ?lb) / 2 \<le> truncate_up p
         (truncate_up p ((truncate_down p ?lb + truncate_up p ?ra) / 2) - truncate_down p ?lb)"
       by (intro truncate_up_le) (simp add: field_simps)
     finally have "inverse ?x \<le> alpha * ?x + zeta + delta"
       by (auto simp: zeta_def delta_def d_min'_def d_max'_def right_diff_distrib ac_simps)
   } note upper = this
 
   {
     have "alpha * b + truncate_down p (real_divl p 1 b - alpha * b) \<le> inverse b"
       by (rule order_trans[OF add_left_mono[OF truncate_down]])
         (auto simp: inverse_eq_divide real_divl)
     hence "zeta + alpha * b \<le> delta + inverse b"
       by (auto simp: zeta_def delta_def d_min'_def d_max'_def right_diff_distrib
         intro!: order_trans[OF _ add_right_mono[OF truncate_up]])
     hence "alpha * ?x + zeta - delta \<le> inverse b + alpha * (?x - b)"
       by (simp add: algebra_simps)
     also
     {
       note \<open>0 < aform_val e X\<close>
       moreover
       note \<open>aform_val e X \<in> {aform_val e X .. b}\<close>
       moreover
 
       note \<open>- inverse (b * b) \<le> alpha\<close>
       ultimately
       have "inverse b + alpha * (aform_val e X - b) \<le> inverse (aform_val e X)"
         by (rule inverse_linear_lower)
     }
     finally have "alpha * (aform_val e X) + zeta - delta \<le> inverse (aform_val e X)" .
   } note lower = this
 
 
   have "inverse (aform_val e X) = alpha * (aform_val e X) + zeta +
       (inverse (aform_val e X) - alpha * (aform_val e X) - zeta)"
     (is "_ = _ + ?linerr")
     by simp
   also
   have "?linerr \<in> {- delta .. delta}"
     using lower upper by simp
   hence linerr_le: "abs ?linerr \<le> delta"
     by auto
 
   let ?z0 = "trunc_bound_eucl p (alpha * fst X)"
   from trunc_bound_euclE
   obtain e1 where abs_e1: "\<bar>e1\<bar> \<le> snd ?z0" and e1: "fst ?z0 = alpha * fst X + e1"
     by blast
   let ?z1 = "trunc_bound_eucl p (fst ?z0 + zeta)"
   from trunc_bound_euclE
   obtain e1' where abs_e1': "\<bar>e1'\<bar> \<le> snd ?z1" and e1': "fst ?z1 = fst ?z0 + zeta + e1'"
     by blast
 
   let ?zs = "trunc_bound_pdevs p (scaleR_pdevs alpha (snd X))"
   from trunc_bound_pdevsE[OF e]
   obtain e2 where abs_e2: "\<bar>e2\<bar> \<le> snd (?zs)"
     and e2: "pdevs_val e (fst ?zs) = pdevs_val e (scaleR_pdevs alpha (snd X)) + e2"
     by blast
 
   have "alpha * (aform_val e X) + zeta =
       aform_val e (fst (inverse_aform' p X)) + (- e1 - e1' - e2)"
     unfolding inverse_aform'_def Let_def vars[symmetric]
     using \<open>0 < l\<close>
     by (simp add: aform_val_def assms e1') (simp add: e1 e2 algebra_simps)
   also
   let ?err = "(- e1 - e1' - e2 + inverse (aform_val e X) - alpha * aform_val e X - zeta)"
   {
     have "abs ?err \<le> abs ?linerr + abs e1 + abs e1' + abs e2"
       by simp
     also have "\<dots> \<le> delta + snd ?z0 + snd ?z1 + snd ?zs"
       by (blast intro: add_mono linerr_le abs_e1 abs_e1' abs_e2)
     also have "\<dots> \<le> (snd (inverse_aform' p X))"
       unfolding inverse_aform'_def Let_def vars[symmetric]
       using \<open>0 < l\<close>
       by (auto simp add: inverse_aform'_def pdevs_apply_trunc_pdevs assms vars[symmetric]
         intro!: order.trans[OF _ sum_list'_sum_list_le])
     finally have "abs ?err \<le> snd (inverse_aform' p X)" by simp
   } note err_le = this
   have "aform_val (e) (fst (inverse_aform' p X)) + (- e1 - e1' - e2) +
     (inverse (aform_val e X) - alpha * aform_val e X - zeta) =
     aform_val e (fst (inverse_aform' p X)) + ?err"
     by simp
   finally
   show ?thesis
     apply (intro aform_errI)
     using err_le
     by (auto simp: assms)
 qed
 
 definition "inverse_aform p a =
   do {
     let l = Inf_aform' p a;
     let u = Sup_aform' p a;
     if (l \<le> 0 \<and> 0 \<le> u) then None
     else if (l \<le> 0) then (Some (apfst uminus_aform (inverse_aform' p (uminus_aform a))))
     else Some (inverse_aform' p a)
   }"
 
 lemma eucl_truncate_up_eq_eucl_truncate_down:
   "eucl_truncate_up p x = - (eucl_truncate_down p (- x))"
   by (auto simp: eucl_truncate_up_def eucl_truncate_down_def truncate_up_eq_truncate_down sum_negf)
 
 lemma inverse_aformE:
   fixes X::"real aform"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
     and disj: "Inf_aform' p X > 0 \<or> Sup_aform' p X < 0"
   obtains Y where
     "inverse_aform p X = Some Y"
     "inverse (aform_val e X) \<in> aform_err e Y"
 proof -
   {
     assume neg: "Sup_aform' p X < 0"
     from neg have [simp]: "Inf_aform' p X \<le> 0"
       by (metis Inf_aform'_le_Sup_aform' dual_order.strict_trans1 less_asym not_less)
     from neg disj have "0 < Inf_aform' p (uminus_aform X)"
       by (auto simp: Inf_aform'_def Sup_aform'_def eucl_truncate_up_eq_eucl_truncate_down ac_simps)
     from inverse_aform'E[OF e(1) this]
     have iin: "inverse (aform_val e (uminus_aform X)) \<in> aform_err e (inverse_aform' p (uminus_aform X))"
       by simp
     let ?Y = "apfst uminus_aform (inverse_aform' p (uminus_aform X))"
     have "inverse_aform p X = Some ?Y"
       "inverse (aform_val e X) \<in> aform_err e ?Y"
       using neg iin by (auto simp: inverse_aform_def aform_err_def)
     then have ?thesis ..
   } moreover {
     assume pos: "Inf_aform' p X > 0"
     from pos have eq: "inverse_aform p X = Some (inverse_aform' p X)"
       by (auto simp: inverse_aform_def)
     moreover
     from inverse_aform'E[OF e(1) pos refl]
     have "inverse (aform_val e X) \<in> aform_err e (inverse_aform' p X)" .
     ultimately have ?thesis ..
   } ultimately show ?thesis
     using assms by auto
 qed
 
 definition aform_err_to_aform::"aform_err \<Rightarrow> nat \<Rightarrow> real aform"
   where "aform_err_to_aform X n = (fst (fst X),  pdev_upd (snd (fst X)) n (snd X))"
 
 lemma aform_err_to_aformE:
   assumes "x \<in> aform_err e X"
   assumes deg: "degree_aform_err X \<le> n"
   obtains err where "x = aform_val (e(n:=err)) (aform_err_to_aform X n)"
     "-1 \<le> err" "err \<le> 1"
 proof -
   from aform_errE[OF assms(1)] have "\<bar>x - aform_val e (fst X)\<bar> \<le> snd X" by auto
   from error_absE[OF this] obtain err where err:
     "x - aform_val e (fst X) = err * snd X" "err \<in> {- 1..1}"
     by auto
   have "x = aform_val (e(n:=err)) (aform_err_to_aform X n)"
     "-1 \<le> err" "err \<le> 1"
     using err deg
     by (auto simp: aform_val_def aform_err_to_aform_def)
   then show ?thesis ..
 qed
 
 definition aform_to_aform_err::"real aform \<Rightarrow> nat \<Rightarrow> aform_err"
   where "aform_to_aform_err X n = ((fst X,  pdev_upd (snd X) n 0), abs (pdevs_apply (snd X) n))"
 
 lemma aform_to_aform_err: "aform_val e X \<in> aform_err e (aform_to_aform_err X n)"
   if "e \<in> UNIV \<rightarrow> {-1 .. 1}"
 proof -
   from that have abs_e[simp]: "\<And>i. \<bar>e i\<bar> \<le> 1" by (auto simp: abs_real_def)
   have "- e n * pdevs_apply (snd X) n \<le> \<bar>pdevs_apply (snd X) n\<bar>"
   proof -
     have "- e n * pdevs_apply (snd X) n \<le> \<bar>- e n * pdevs_apply (snd X) n\<bar>"
       by auto
     also have "\<dots> \<le> abs (pdevs_apply (snd X) n)"
       using that
       by (auto simp: abs_mult intro!: mult_left_le_one_le)
     finally show ?thesis .
   qed
   moreover have "e n * pdevs_apply (snd X) n \<le> \<bar>pdevs_apply (snd X) n\<bar>"
   proof -
     have "e n * pdevs_apply (snd X) n \<le> \<bar>e n * pdevs_apply (snd X) n\<bar>"
       by auto
     also have "\<dots> \<le> abs (pdevs_apply (snd X) n)"
       using that
       by (auto simp: abs_mult intro!: mult_left_le_one_le)
     finally show ?thesis .
   qed
   ultimately
   show ?thesis
     by (auto simp: aform_to_aform_err_def aform_err_def aform_val_def)
 qed
 
 definition "acc_err p x e \<equiv> (fst x, truncate_up p (snd x + e))"
 
-definition "ivl_err l u \<equiv> (((u + l)/2, zero_pdevs::real pdevs), (u - l) / 2)"
+definition ivl_err :: "real interval \<Rightarrow> (real \<times> real pdevs) \<times> real"
+  where "ivl_err ivl \<equiv> (((upper ivl + lower ivl)/2, zero_pdevs::real pdevs), (upper ivl - lower ivl) / 2)"
 
 lemma inverse_aform:
   fixes X::"real aform"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes "inverse_aform p X = Some Y"
   shows "inverse (aform_val e X) \<in> aform_err e Y"
 proof -
   from assms have "Inf_aform' p X > 0 \<or> 0 > Sup_aform' p X"
     by (auto simp: inverse_aform_def Let_def bind_eq_Some_conv split: if_splits)
   from inverse_aformE[OF e this] obtain Y where
     "inverse_aform p X = Some Y" "inverse (aform_val e X) \<in> aform_err e Y"
     by auto
   with assms show ?thesis by auto
 qed
 
 lemma aform_err_acc_err_leI:
   "fx \<in> aform_err e (acc_err p X err)"
   if "aform_val e (fst X) - (snd X + err) \<le> fx" "fx \<le> aform_val e (fst X) + (snd X + err)"
   using truncate_up[of "(snd X + err)" p] truncate_down[of p "(snd X + err)"] that
   by (auto simp: aform_err_def acc_err_def)
 
 lemma aform_err_acc_errI:
   "fx \<in> aform_err e (acc_err p X err)"
   if "fx \<in> aform_err e (fst X, snd X + err)"
   using truncate_up[of "(snd X + err)" p] truncate_down[of p "(snd X + err)"] that
   by (auto simp: aform_err_def acc_err_def)
 
 lemma minus_times_le_abs: "- (err * B) \<le> \<bar>B\<bar>" if "-1 \<le> err" "err \<le> 1" for err::real
 proof -
   have [simp]: "abs err \<le> 1" using that by (auto simp: )
   have "- (err * B) \<le> abs (- err * B)" by auto
   also have "\<dots> \<le> abs B"
     by (auto simp: abs_mult intro!: mult_left_le_one_le)
   finally show ?thesis by simp
 qed
 
 lemma times_le_abs: "err * B \<le> \<bar>B\<bar>" if "-1 \<le> err" "err \<le> 1" for err::real
 proof -
   have [simp]: "abs err \<le> 1" using that by (auto simp: )
   have "err * B \<le> abs (err * B)" by auto
   also have "\<dots> \<le> abs B"
     by (auto simp: abs_mult intro!: mult_left_le_one_le)
   finally show ?thesis by simp
 qed
 
 lemma aform_err_lemma1: "- 1 \<le> err \<Longrightarrow> err \<le> 1 \<Longrightarrow>
   X1 + (A - e d * B + err * B) - e1 \<le> x \<Longrightarrow>
   X1 + (A - e d * B) - truncate_up p (\<bar>B\<bar> + e1) \<le> x"
   apply (rule order_trans)
    apply (rule diff_mono)
     apply (rule order_refl)
    apply (rule truncate_up_le[where x="e1 - err * B"])
   by (auto simp: minus_times_le_abs)
   
 lemma aform_err_lemma2: "- 1 \<le> err \<Longrightarrow> err \<le> 1 \<Longrightarrow>
     x \<le> X1 + (A - e d * B + err * B) + e1 \<Longrightarrow>
     x \<le> X1 + (A - e d * B) + truncate_up p (\<bar>B\<bar> + e1)"
   apply (rule order_trans[rotated])
    apply (rule add_mono)
     apply (rule order_refl)
    apply (rule truncate_up_le[where x="e1 + err * B"])
   by (auto simp: times_le_abs)
 
 lemma aform_err_acc_err_aform_to_aform_errI:
   "x \<in> aform_err e (acc_err p (aform_to_aform_err X1 d) e1)"
   if "-1 \<le> err" "err \<le> 1" "x \<in> aform_err (e(d := err)) (X1, e1)"
   using that
   by (auto simp: acc_err_def aform_err_def aform_val_def aform_to_aform_err_def
       aform_err_to_aform_def aform_err_lemma1 aform_err_lemma2)
 
 definition "map_aform_err I p X =
   (do {
     let X0 = aform_err_to_aform X (degree_aform_err X);
     (X1, e1) \<leftarrow> I X0;
     Some (acc_err p (aform_to_aform_err X1 (degree_aform_err X)) e1)
   })"
 
 lemma map_aform_err:
   "i x \<in> aform_err e Y"
   if I: "\<And>e X Y. e \<in> UNIV \<rightarrow> {-1 .. 1} \<Longrightarrow> I X = Some Y \<Longrightarrow> i (aform_val e X) \<in> aform_err e Y"
   and e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   and Y: "map_aform_err I p X = Some Y"
   and x: "x \<in> aform_err e X"
 proof -
   obtain X1 e1 where
     X1: "(I (aform_err_to_aform X (degree_aform_err X))) = Some (X1, e1)"
     and Y: "Y = acc_err p (aform_to_aform_err X1 (degree_aform (fst X))) e1"
     using Y by (auto simp: map_aform_err_def bind_eq_Some_conv Let_def)
   from aform_err_to_aformE[OF x] obtain err where
     err: "x = aform_val (e(degree_aform_err X := err)) (aform_err_to_aform X  (degree_aform_err X)) "
     (is "_ = aform_val ?e _")
     and "- 1 \<le> err" "err \<le> 1"
     by auto
   then have e': "?e \<in> UNIV \<rightarrow> {-1 .. 1}" using e by auto
   from err have "i x =
       i (aform_val (e(degree_aform_err X := err)) (aform_err_to_aform X  (degree_aform_err X)))"
     by simp
   also note I[OF e' X1]
   also have "aform_err (e(degree_aform_err X := err)) (X1, e1) \<subseteq> aform_err e Y"
     apply rule
     unfolding Y using \<open>-1 \<le> err\<close> \<open>err \<le> 1\<close>
     by (rule aform_err_acc_err_aform_to_aform_errI)
   finally show ?thesis .
 qed
 
 definition "inverse_aform_err p X = map_aform_err (inverse_aform p) p X"
 
 lemma inverse_aform_err:
   "inverse x \<in> aform_err e Y"
   if  e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   and Y: "inverse_aform_err p X = Some Y"
   and x: "x \<in> aform_err e X"
   using map_aform_err[OF inverse_aform[where p=p] e Y[unfolded inverse_aform_err_def] x]
   by auto
 
 subsection \<open>Reduction (Summarization of Coefficients)\<close>
 text \<open>\label{sec:affinesummarize}\<close>
 
 definition "pdevs_of_centered_ivl r = (inner_scaleR_pdevs r One_pdevs)"
 
 lemma pdevs_of_centered_ivl_eq_pdevs_of_ivl[simp]: "pdevs_of_centered_ivl r = pdevs_of_ivl (-r) r"
   by (auto simp: pdevs_of_centered_ivl_def pdevs_of_ivl_def algebra_simps intro!: pdevs_eqI)
 
 lemma filter_pdevs_raw_nonzeros: "{i. filter_pdevs_raw s f i \<noteq> 0} = {i. f i \<noteq> 0} \<inter> {x. s x (f x)}"
   by (auto simp: filter_pdevs_raw_def)
 
 definition summarize_pdevs::
   "nat \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> 'a::executable_euclidean_space pdevs \<Rightarrow> 'a pdevs"
   where "summarize_pdevs p I d x =
     (let t = tdev' p (filter_pdevs (-I) x)
      in msum_pdevs d (filter_pdevs I x) (pdevs_of_centered_ivl t))"
 
 definition summarize_threshold
   where "summarize_threshold p t x y \<longleftrightarrow> infnorm y \<ge> t * infnorm (eucl_truncate_up p (tdev' p x))"
 
 lemma error_abs_euclE:
   fixes err::"'a::ordered_euclidean_space"
   assumes "abs err \<le> k"
   obtains e::"'a \<Rightarrow> real" where "err = (\<Sum>i\<in>Basis. (e i * (k \<bullet> i)) *\<^sub>R i)" "e \<in> UNIV \<rightarrow> {-1 .. 1}"
 proof atomize_elim
   {
     fix i::'a
     assume "i \<in> Basis"
     hence "abs (err \<bullet> i) \<le> (k \<bullet> i)" using assms by (auto simp add: eucl_le[where 'a='a] abs_inner)
     hence "\<exists>e. (err  \<bullet> i = e * (k \<bullet> i)) \<and> e \<in> {-1..1}"
       by (rule error_absE) auto
   }
   then obtain e where e:
     "\<And>i. i \<in> Basis \<Longrightarrow> err \<bullet> i = e i * (k \<bullet> i)"
     "\<And>i. i \<in> Basis \<Longrightarrow> e i \<in> {-1 .. 1}"
     by metis
   have singleton: "\<And>b. b \<in> Basis \<Longrightarrow> (\<Sum>i\<in>Basis. e i * (k \<bullet> i) * (if i = b then 1 else 0)) =
     (\<Sum>i\<in>{b}. e i * (k \<bullet> i) * (if i = b then 1 else 0))"
     by (rule sum.mono_neutral_cong_right) auto
   show "\<exists>e::'a\<Rightarrow>real. err = (\<Sum>i\<in>Basis. (e i * (k \<bullet> i)) *\<^sub>R i) \<and> (e \<in> UNIV \<rightarrow> {-1..1})"
     using e
     by (auto intro!: exI[where x="\<lambda>i. if i \<in> Basis then e i else 0"] euclidean_eqI[where 'a='a]
       simp: inner_sum_left inner_Basis singleton)
 qed
 
 lemma summarize_pdevsE:
   fixes x::"'a::executable_euclidean_space pdevs"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes d: "degree x \<le> d"
   obtains e' where "pdevs_val e x = pdevs_val e' (summarize_pdevs p I d x)"
     "\<And>i. i < d \<Longrightarrow> e i = e' i"
     "e' \<in> UNIV \<rightarrow> {-1 .. 1}"
 proof atomize_elim
   have "pdevs_val e x = (\<Sum>i<degree x. e i *\<^sub>R pdevs_apply x i)"
     by (auto simp add: pdevs_val_sum intro!: sum.cong)
   also have "\<dots> = (\<Sum>i \<in> {..<degree x} \<inter> {i. I i (pdevs_apply x i)}. e i *\<^sub>R pdevs_apply x i) +
     (\<Sum>i\<in> {..<degree x} - {i. I i (pdevs_apply x i)}. e i *\<^sub>R pdevs_apply x i)"
     (is "_ = ?large + ?small")
     by (subst sum.union_disjoint[symmetric]) (auto simp: ac_simps intro!: sum.cong)
   also have "?large = pdevs_val e (filter_pdevs I x)"
     by (simp add: pdevs_val_filter_pdevs)
   also have "?small = pdevs_val e (filter_pdevs (-I) x)"
     by (simp add: pdevs_val_filter_pdevs Collect_neg_eq Diff_eq)
   also
   have "abs \<dots> \<le> tdev' p (filter_pdevs (-I) x)" (is "abs ?r \<le> ?t")
     using e by (rule abs_pdevs_val_le_tdev')
   hence "?r \<in> {-?t .. ?t}"
     by (metis abs_le_D1 abs_le_D2 atLeastAtMost_iff minus_le_iff)
   from in_ivl_affine_of_ivlE[OF this] obtain e2
     where "?r = aform_val e2 (aform_of_ivl (- ?t) ?t)"
       and e2: "e2 \<in> UNIV \<rightarrow> {- 1..1}"
     by metis
   note this(1)
   also
   define e' where "e' i = (if i < d then e i else e2 (i - d))" for i
   hence "aform_val e2 (aform_of_ivl (- ?t) ?t) =
       pdevs_val (\<lambda>i. e' (i + d)) (pdevs_of_ivl (- ?t) ?t)"
     by (auto simp: aform_of_ivl_def aform_val_def)
   also
   have "pdevs_val e (filter_pdevs I x) = pdevs_val e' (filter_pdevs I x)"
     using assms by (auto simp: e'_def pdevs_val_sum intro!: sum.cong)
   finally have "pdevs_val e x =
       pdevs_val e' (filter_pdevs I x) + pdevs_val (\<lambda>i. e' (i + d)) (pdevs_of_ivl (- ?t) ?t)"
     .
   also note pdevs_val_msum_pdevs[symmetric, OF order_trans[OF degree_filter_pdevs_le d]]
   finally have "pdevs_val e x = pdevs_val e' (summarize_pdevs p I d x)"
     by (auto simp: summarize_pdevs_def Let_def)
   moreover have "e' \<in> UNIV \<rightarrow> {-1 .. 1}" using e e2 by (auto simp: e'_def Pi_iff)
   moreover have "\<forall>i < d. e' i = e i"
     by (auto simp: e'_def)
   ultimately show "\<exists>e'. pdevs_val e x = pdevs_val e' (summarize_pdevs p I d x) \<and>
       (\<forall>i<d. e i = e' i) \<and> e' \<in> UNIV \<rightarrow> {- 1..1}"
     by auto
 qed
 
 definition "summarize_pdevs_list p I d xs =
   map (\<lambda>(d, x). summarize_pdevs p (\<lambda>i _. I i (pdevs_applys xs i)) d x) (zip [d..<d + length xs] xs)"
 
 lemma filter_pdevs_cong[cong]:
   assumes "x = y"
   assumes "\<And>i. i \<in> pdevs_domain y \<Longrightarrow> P i (pdevs_apply x i) = Q i (pdevs_apply y i)"
   shows "filter_pdevs P x = filter_pdevs Q y"
   using assms
   by (force intro!: pdevs_eqI)
 
 lemma summarize_pdevs_cong[cong]:
   assumes "p = q" "a = c" "b = d"
   assumes PQ: "\<And>i. i \<in> pdevs_domain d \<Longrightarrow> P i (pdevs_apply b i) = Q i (pdevs_apply d i)"
   shows "summarize_pdevs p P a b = summarize_pdevs q Q c d"
 proof -
   have "(filter_pdevs P b) = filter_pdevs Q d"
     "(filter_pdevs (\<lambda>a b. \<not> P a b) b) = filter_pdevs (\<lambda>a b. \<not> Q a b) d"
     using assms
     by (auto intro!: filter_pdevs_cong)
   then show ?thesis by (auto simp add: assms summarize_pdevs_def Let_def)
 qed
 
 lemma lookup_eq_None_iff: "(Mapping.lookup M x = None) = (x \<notin> Mapping.keys M)"
   by (transfer) auto
 
 lemma lookup_eq_SomeD:
   "(Mapping.lookup M x = Some y) \<Longrightarrow> (x \<in> Mapping.keys M)"
   by transfer auto
 
 definition "domain_pdevs xs = (\<Union>(pdevs_domain ` (set xs)))"
 
 definition "pdevs_mapping xs =
   (let
     D = sorted_list_of_set (domain_pdevs xs);
     M = Mapping.tabulate D (pdevs_applys xs);
     zeroes = replicate (length xs) 0
   in Mapping.lookup_default zeroes M)"
 
 lemma pdevs_mapping_eq[simp]: "pdevs_mapping xs = pdevs_applys xs"
   unfolding pdevs_mapping_def pdevs_applys_def
   apply (auto simp: Mapping.lookup_default_def lookup_eq_None_iff domain_pdevs_def
       split: option.splits intro!: ext)
   subgoal by (auto intro!: nth_equalityI)
   subgoal apply (auto intro!: nth_equalityI dest: )
     subgoal
       apply (frule lookup_eq_SomeD)
       apply auto
       by (metis distinct_sorted_list_of_set keys_tabulate length_map lookup_eq_SomeD lookup_tabulate option.inject)
     subgoal
       apply (frule lookup_eq_SomeD)
       apply (auto simp: map_nth)
       by (metis (mono_tags, lifting) keys_tabulate
           lookup_eq_SomeD lookup_tabulate option.inject distinct_sorted_list_of_set)
     done
   done
 
 lemma compute_summarize_pdevs_list[code]:
   "summarize_pdevs_list p I d xs =
     (let M = pdevs_mapping xs
     in map (\<lambda>(x, y). summarize_pdevs p (\<lambda>i _. I i (M i)) x y) (zip [d..<d + length xs] xs))"
   unfolding summarize_pdevs_list_def pdevs_mapping_eq
   by auto
 
 lemma
   in_centered_ivlE:
   fixes r t::real
   assumes "r \<in> {-t .. t}"
   obtains e where "e \<in> {-1 .. 1}" "r = e * t"
   using assms
   by (atomize_elim) (auto intro!: exI[where x="r / t"] simp: divide_simps)
 
 lift_definition singleton_pdevs::"'a \<Rightarrow> 'a::real_normed_vector pdevs" is "\<lambda>x i. if i = 0 then x else 0"
   by auto
 lemmas [simp] = singleton_pdevs.rep_eq
 
 lemma singleton_0[simp]: "singleton_pdevs 0 = zero_pdevs"
   by (auto intro!: pdevs_eqI)
 
 lemma degree_singleton_pdevs[simp]: "degree (singleton_pdevs x) = (if x = 0 then 0 else Suc 0)"
   by (auto simp: intro!: degree_eqI)
 
 lemma pdevs_val_singleton_pdevs[simp]: "pdevs_val e (singleton_pdevs x) = e 0 *\<^sub>R x"
   by (auto simp: pdevs_val_sum if_distrib sum.delta cong: if_cong)
 
 lemma pdevs_of_ivl_real:
   fixes a b::real
   shows "pdevs_of_ivl a b = singleton_pdevs ((b - a) / 2)"
   by (auto simp: pdevs_of_ivl_def Basis_list_real_def intro!: pdevs_eqI)
 
 lemma summarize_pdevs_listE:
   fixes X::"real pdevs list"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes d: "degrees X \<le> d"
   obtains e' where "pdevs_vals e X = pdevs_vals e' (summarize_pdevs_list p I d X)"
     "\<And>i. i < d \<Longrightarrow> e i = e' i"
     "e' \<in> UNIV \<rightarrow> {-1 .. 1}"
 proof -
   let ?I = "{i. I i (pdevs_applys X i)}"
   let ?J = "\<lambda>i x. I i (pdevs_applys X i)"
 
   have "pdevs_vals e X = map (\<lambda>x. \<Sum>i<degree x. e i *\<^sub>R pdevs_apply x i) X"
     using d
     by (auto simp: pdevs_vals_def
         simp del: real_scaleR_def
         intro!: pdevs_val_sum_le
         dest!: degrees_leD)
   also have "\<dots> = map (\<lambda>x.
       (\<Sum>i\<in>{..<degree x} \<inter> ?I. e i * pdevs_apply x i) +
       (\<Sum>i\<in>{..<degree x} - ?I. e i * pdevs_apply x i)) X"
     by (rule map_cong[OF refl], subst sum.union_disjoint[symmetric]) (auto intro!: sum.cong)
   also
   have "\<dots> = map (\<lambda>x. pdevs_val e (filter_pdevs ?J x) + pdevs_val e (filter_pdevs (-?J) x)) X"
     (is "_ = map (\<lambda>x. ?large x + ?small x) _")
     by (auto simp: pdevs_val_filter_pdevs Diff_eq Compl_eq)
   also have "\<dots> = map snd (zip [d..<d + length X] \<dots>)" by simp
   also have "\<dots> = map (\<lambda>(d, x). ?large x + ?small x) (zip [d..<d + length X] X)"
     (is "_ = map _ ?z")
     unfolding map_zip_map2
     by simp
   also have "\<dots> = map (\<lambda>(d', x). ?large x + ?small (snd (?z ! (d' - d)))) ?z"
     by (auto simp: in_set_zip)
   also
   let ?t = "\<lambda>x. tdev' p (filter_pdevs (-?J) x)"
   let ?x = "\<lambda>d'. snd (?z ! (d' - d))"
   {
     fix d' assume "d \<le> d'" "d' < d + length X"
     have "abs (?small (?x d')) \<le> ?t (?x d')"
       using \<open>e \<in> _\<close> by (rule abs_pdevs_val_le_tdev')
     then have "?small (?x d') \<in> {-?t (?x d') .. ?t (?x d')}"
       by auto
     from in_centered_ivlE[OF this] have "\<exists>e\<in>{-1 .. 1}. ?small (?x d') = e * ?t (?x d')" by blast
   } then obtain e'' where e'':
     "e'' d' \<in> {-1 .. 1}"
     "?small (?x d') = e'' d' * ?t (?x d')"
     if "d' \<in> {d ..< d + length X}" for d'
     apply atomize_elim
     unfolding all_conj_distrib[symmetric] imp_conjR[symmetric]
     unfolding Ball_def[symmetric] atLeastAtMost_iff[symmetric]
     apply (rule bchoice)
     apply (auto simp: Bex_def )
     done
   define e' where "e' \<equiv> \<lambda>i. if i < d then e i else if i < d + length X then e'' i else 0"
   have e': "e' d' \<in> {-1 .. 1}"
     "?small (?x d') = e' d' * ?t (?x d')"
     if "d' \<in> {d ..< d + length X}" for d'
     using e'' that
     by (auto simp: e'_def split: if_splits)
   then have *: "pdevs_val e (filter_pdevs (\<lambda>a b. \<not> I a (pdevs_applys X a)) (?x d')) =
     e' d' * ?t (?x d')" if "d' \<in> {d ..< d + length X}" for d'
     using that
     by auto
   have "map (\<lambda>(d', x). ?large x + ?small (?x d')) ?z =
       map (\<lambda>(d', x). ?large x + e' d' * ?t (?x d')) ?z"
     apply (auto simp: in_set_zip)
     subgoal for n
       using e'(2)[of "d + n"]
       by auto
     done
   also have "\<dots> = map (\<lambda>(d', x). pdevs_val e' (summarize_pdevs p ?J d' x)) (zip [d..<d + length X] X)"
     apply (auto simp: summarize_pdevs_def pdevs_val_msum_pdevs Let_def in_set_zip)
     apply (subst pdevs_val_msum_pdevs)
     using d
      apply (auto intro!: degree_filter_pdevs_le[THEN order_trans])
     subgoal by (auto dest!: degrees_leD nth_mem)
     apply (auto simp: pdevs_of_ivl_real intro!: )
     subgoal premises prems
     proof -
       have "degree (filter_pdevs (\<lambda>i x. I i (pdevs_applys X i)) (X ! n)) \<le> d" if "n < length X" for n
         using d that
         by (intro degree_filter_pdevs_le[THEN order_trans]) (simp add: degrees_leD)
       then show ?thesis
         using prems e''
         apply (intro pdevs_val_degree_cong)
          apply (auto dest!: )
         apply (auto simp: e'_def)
         apply (meson \<open>\<And>n. \<lbrakk>n < length X; degrees X \<le> d\<rbrakk> \<Longrightarrow> degree (X ! n) \<le> d + n\<close> degree_filter_pdevs_le less_le_trans)
         by (meson less_le_trans trans_less_add1)
     qed
     done
   also have "\<dots> = pdevs_vals e' (summarize_pdevs_list p I d X)"
     by (auto simp: summarize_pdevs_list_def pdevs_vals_def)
   finally have "pdevs_vals e X = pdevs_vals e' (summarize_pdevs_list p I d X)" .
   moreover have "(\<And>i. i < d \<Longrightarrow> e i = e' i)" "e' \<in> UNIV \<rightarrow> {- 1..1}"
     using \<open>e \<in> _\<close> e''
     by (auto simp: e'_def)
   ultimately show ?thesis ..
 qed
 
 fun list_ex2 where
   "list_ex2 P [] xs = False"
 | "list_ex2 P xs [] = False"
 | "list_ex2 P (x#xs) (y#ys) = (P x y \<or> list_ex2 P xs ys)"
 
 lemma list_ex2_iff:
   "list_ex2 P xs ys \<longleftrightarrow> (\<not>list_all2 (-P) (take (length ys) xs) (take (length xs) ys))"
   by (induction P xs ys rule: list_ex2.induct) auto
 
 definition "summarize_aforms p C d (X::real aform list) =
   (zip (map fst X) (summarize_pdevs_list p (C X) d (map snd X)))"
 
 lemma aform_vals_pdevs_vals:
   "aform_vals e X = map (\<lambda>(x, y). x + y) (zip (map fst X) (pdevs_vals e (map snd X)))"
   by (auto simp: pdevs_vals_def aform_vals_def aform_val_def[abs_def]
       map_zip_map map_zip_map2 split_beta' zip_same_conv_map)
 
 lemma summarize_aformsE:
   fixes X::"real aform list"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes d: "degree_aforms X \<le> d"
   obtains e' where "aform_vals e X = aform_vals e' (summarize_aforms p C d X)"
     "\<And>i. i < d \<Longrightarrow> e i = e' i"
     "e' \<in> UNIV \<rightarrow> {-1 .. 1}"
 proof -
   define Xs where "Xs = map snd X"
   have "aform_vals e X = map (\<lambda>(x, y). x + y) (zip (map fst X) (pdevs_vals e Xs))"
     by (auto simp: aform_vals_pdevs_vals Xs_def)
   also obtain e' where e': "e' \<in> UNIV \<rightarrow> {-1 .. 1}"
     "\<And>i. i < d \<Longrightarrow> e i = e' i"
     "pdevs_vals e Xs = pdevs_vals e' (summarize_pdevs_list p (C X) d Xs)"
     using summarize_pdevs_listE[OF e d, of p "C X"]
     by (metis Xs_def)
   note this(3)
   also have "map (\<lambda>(x, y). x + y) (zip (map fst X) \<dots>) = aform_vals e' (summarize_aforms p C d X)"
     unfolding aform_vals_pdevs_vals
     by (simp add: summarize_aforms_def Let_def Xs_def summarize_pdevs_list_def
         split_beta')
   finally have "aform_vals e X = aform_vals e' (summarize_aforms p C d X)"
     "\<And>i. i < d \<Longrightarrow> e i = e' i"
     "e' \<in> UNIV \<rightarrow> {-1 .. 1}"
     using e' d
     by (auto simp: Xs_def)
   then show ?thesis ..
 qed
 
 text \<open>Different reduction strategies:\<close>
 
 definition "collect_threshold p ta t (X::real aform list) =
   (let
     Xs = map snd X;
     as = map (\<lambda>X. max ta (t * tdev' p X)) Xs
   in (\<lambda>(i::nat) xs. list_ex2 (\<le>) as (map abs xs)))"
 
 definition "collect_girard p m (X::real aform list) =
   (let
     Xs = map snd X;
     M = pdevs_mapping Xs;
     D = domain_pdevs Xs;
     N = length X
   in if card D \<le> m then (\<lambda>_ _. True) else
     let
       Ds = sorted_list_of_set D;
       ortho_indices = map fst (take (2 * N) (sort_key (\<lambda>(i, r). r) (map (\<lambda>i. let xs = M i in (i, sum_list' p xs - fold max xs 0)) Ds)));
       _ = ()
     in (\<lambda>i (xs::real list). i \<in> set ortho_indices))"
 
 
 
 subsection \<open>Splitting with heuristics\<close>
 
 definition "abs_pdevs = unop_pdevs abs"
 
 definition "abssum_of_pdevs_list X = fold (\<lambda>a b. (add_pdevs (abs_pdevs a) b)) X zero_pdevs"
 
 definition "split_aforms xs i = (let splits = map (\<lambda>x. split_aform x i) xs in (map fst splits, map snd splits))"
 
 definition "split_aforms_largest_uncond X =
   (let (i, x) = max_pdev (abssum_of_pdevs_list (map snd X)) in split_aforms X i)"
 
-definition "Inf_aform_err p Rd = (float_of (truncate_down p (Inf_aform' p (fst Rd) - (snd Rd))))"
-definition "Sup_aform_err p Rd = (float_of (truncate_up p (Sup_aform' p (fst Rd) + (snd Rd))))"
-
-definition "approx_un p f a = do {
-  (rd) \<leftarrow> a;
-  (l, u) \<leftarrow> f (Inf_aform_err p rd) (Sup_aform_err p rd);
-  Some (ivl_err (real_of_float l) ((real_of_float u)))
+definition "Inf_aform_err p Rd = (float_of (truncate_down p (Inf_aform' p (fst Rd) - abs(snd Rd))))"
+definition "Sup_aform_err p Rd = (float_of (truncate_up p (Sup_aform' p (fst Rd) + abs(snd Rd))))"
+
+context includes interval.lifting begin
+lift_definition ivl_of_aform_err::"nat \<Rightarrow> aform_err \<Rightarrow> float interval"
+  is "\<lambda>p Rd. (Inf_aform_err p Rd, Sup_aform_err p Rd)"
+  by (auto simp: aform_err_def  Inf_aform_err_def Sup_aform_err_def
+      intro!: truncate_down_le truncate_up_le add_increasing[OF _ Inf_aform'_le_Sup_aform'])
+lemma lower_ivl_of_aform_err: "lower (ivl_of_aform_err p Rd) = Inf_aform_err p Rd"
+  and upper_ivl_of_aform_err: "upper (ivl_of_aform_err p Rd) = Sup_aform_err p Rd"
+  by (transfer, simp)+
+end
+
+definition approx_un::"nat
+     \<Rightarrow> (float interval \<Rightarrow> float interval option)
+        \<Rightarrow> ((real \<times> real pdevs) \<times> real) option
+           \<Rightarrow> ((real \<times> real pdevs) \<times> real) option"
+  where "approx_un p f a = do {
+  rd \<leftarrow> a;
+  ivl \<leftarrow> f (ivl_of_aform_err p rd);
+  Some (ivl_err (real_interval ivl))
 }"
 
-definition interval_extension1::"(float \<Rightarrow> float \<Rightarrow> (float * float) option) \<Rightarrow> (real \<Rightarrow> real) \<Rightarrow> bool"
-  where "interval_extension1 F f \<longleftrightarrow> (\<forall>l u i s. F l u = Some (i, s) \<longrightarrow> f ` {l .. u} \<subseteq> {i .. s})"
+definition interval_extension1::"(float interval \<Rightarrow> (float interval) option) \<Rightarrow> (real \<Rightarrow> real) \<Rightarrow> bool"
+  where "interval_extension1 F f \<longleftrightarrow> (\<forall>ivl ivl'. F ivl = Some ivl' \<longrightarrow> (\<forall>x. x \<in>\<^sub>r ivl \<longrightarrow> f x \<in>\<^sub>r ivl'))"
 
 lemma interval_extension1D:
   assumes "interval_extension1 F f"
-  assumes "F l u = Some (i, s)"
-  shows "f ` {l .. u} \<subseteq> {i .. s}"
+  assumes "F ivl = Some ivl'"
+  assumes "x \<in>\<^sub>r ivl"
+  shows "f x \<in>\<^sub>r ivl'"
   using assms by (auto simp: interval_extension1_def)
 
 lemma approx_un_argE:
   assumes au: "approx_un p F X = Some Y"
   obtains X' where "X = Some X'"
   using assms
   by (auto simp: approx_un_def bind_eq_Some_conv)
 
 lemma degree_aform_independent_from:
   "degree_aform (independent_from d1 X) \<le> d1 + degree_aform X"
   by (auto simp: independent_from_def degree_msum_pdevs_le)
 
 lemma degree_aform_of_ivl:
   fixes a b::"'a::executable_euclidean_space"
   shows "degree_aform (aform_of_ivl a b) \<le> length (Basis_list::'a list)"
   by (auto simp: aform_of_ivl_def degree_pdevs_of_ivl_le)
 
-lemma aform_err_ivl_err[simp]: "aform_err e (ivl_err (l') (u')) = {l'..u'}"
-  by (auto simp: aform_err_def ivl_err_def aform_val_def divide_simps)
+lemma aform_err_ivl_err[simp]: "aform_err e (ivl_err ivl') = set_of ivl'"
+  by (auto simp: aform_err_def ivl_err_def aform_val_def divide_simps set_of_eq)
 
 lemma Inf_Sup_aform_err:
   fixes X
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   defines "X' \<equiv> fst X"
   shows "aform_err e X \<subseteq> {Inf_aform_err p X .. Sup_aform_err p X}"
   using Inf_aform[OF e, of X'] Sup_aform[OF e, of X'] Inf_aform'[of p X'] Sup_aform'[of X' p]
   by (auto simp: aform_err_def X'_def Inf_aform_err_def Sup_aform_err_def
       intro!: truncate_down_le truncate_up_le)
 
+lemma ivl_of_aform_err:
+  fixes X
+  assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
+  shows "x \<in> aform_err e X \<Longrightarrow> x \<in>\<^sub>r ivl_of_aform_err p X"
+  using Inf_Sup_aform_err[OF e, of X p]
+  by (auto simp: set_of_eq lower_ivl_of_aform_err upper_ivl_of_aform_err)
+
 lemma approx_unE:
   assumes ie: "interval_extension1 F f"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes au: "approx_un p F X'err = Some Ye"
-  assumes x: "case X'err of None \<Rightarrow> True | Some X'err \<Rightarrow> x \<in> aform_err e (X'err)"
+  assumes x: "case X'err of None \<Rightarrow> True | Some X'err \<Rightarrow> x \<in> aform_err e X'err"
   shows "f x \<in> aform_err e Ye"
 proof -
-  from au obtain l' u' X' err
-    where F: " F (Inf_aform_err p (X', err)) (Sup_aform_err p (X', err)) = Some (l', u')"
-        (is "F ?i ?s = _")
-      and Y: "Ye = ivl_err (real_of_float l') (real_of_float u')"
-         (is "_ = (ivl_err ?l'  ?u')")
+  from au obtain ivl' X' err
+    where F: "F (ivl_of_aform_err p (X', err)) = Some (ivl')"
+      and Y: "Ye = ivl_err (real_interval ivl')"
      and X'err: "X'err = Some (X', err)"
     by (auto simp: approx_un_def bind_eq_Some_conv)
 
   from x
   have "x \<in> aform_err e (X', err)" by (auto simp: X'err)
-  also note Inf_Sup_aform_err[OF e, where p=p]
-  finally have "x \<in> {?i .. ?s}" .
-  then have "f x \<in> f ` {real_of_float ?i .. real_of_float ?s}" by (rule imageI)
-  also note interval_extension1D[OF ie F]
-  also have "{real_of_float l'..real_of_float u'} = aform_err e Ye" unfolding Y aform_err_ivl_err ..
+  from ivl_of_aform_err[OF e this]
+  have "x \<in>\<^sub>r ivl_of_aform_err p (X', err)" .
+  from interval_extension1D[OF ie F this]
+  have "f x \<in>\<^sub>r ivl'" .
+  also have "\<dots> = aform_err e Ye"
+    unfolding Y aform_err_ivl_err ..
   finally show ?thesis .
 qed
 
 definition "approx_bin p f rd sd = do {
-  (l, u) \<leftarrow> f (Inf_aform_err p rd) (Sup_aform_err p rd)
-             (Inf_aform_err p sd) (Sup_aform_err p sd);
-  Some (ivl_err (real_of_float l) ((real_of_float u)))
+  ivl \<leftarrow> f (ivl_of_aform_err p rd)
+             (ivl_of_aform_err p sd);
+  Some (ivl_err (real_interval ivl))
 }"
 
-definition interval_extension2::"(float \<Rightarrow> float \<Rightarrow> float \<Rightarrow> float \<Rightarrow> (float * float) option) \<Rightarrow> (real \<Rightarrow> real \<Rightarrow> real) \<Rightarrow> bool"
-  where "interval_extension2 F f \<longleftrightarrow> (\<forall>l u l' u' i s. F l u l' u' = Some (i, s) \<longrightarrow>
-    (\<lambda>(x, y). f x y) ` ({l .. u} \<times> {l' .. u'}) \<subseteq> {i .. s})"
+definition interval_extension2::"(float interval \<Rightarrow> float interval \<Rightarrow> float interval option) \<Rightarrow> (real \<Rightarrow> real \<Rightarrow> real) \<Rightarrow> bool"
+  where "interval_extension2 F f \<longleftrightarrow> (\<forall>ivl1 ivl2 ivl. F ivl1 ivl2 = Some ivl \<longrightarrow>
+    (\<forall>x y. x \<in>\<^sub>r ivl1 \<longrightarrow> y \<in>\<^sub>r ivl2 \<longrightarrow> f x y \<in>\<^sub>r ivl))"
 
 lemma interval_extension2D:
   assumes "interval_extension2 F f"
-  assumes "F l u l' u' = Some (i, s)"
-  shows "(\<lambda>(x, y). f x y) ` ({l .. u} \<times> {l' .. u'}) \<subseteq> {i .. s}"
+  assumes "F ivl1 ivl2 = Some ivl"
+  shows "x \<in>\<^sub>r ivl1 \<Longrightarrow> y \<in>\<^sub>r ivl2 \<Longrightarrow> f x y \<in>\<^sub>r ivl"
   using assms by (auto simp: interval_extension2_def)
 
 lemma approx_binE:
   assumes ie: "interval_extension2 F f"
   assumes w: "w \<in> aform_err e (W', errw)"
   assumes x: "x \<in> aform_err e (X', errx)"
   assumes ab: "approx_bin p F ((W', errw)) ((X', errx)) = Some Ye"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "f w x \<in> aform_err e Ye"
 proof -
-  from ab obtain l' u'
-    where F: "F (Inf_aform_err p (W', errw)) (Sup_aform_err p (W', errw))
-        (Inf_aform_err p (X', errx)) (Sup_aform_err p (X', errx)) = Some (l', u')"
-             (is "F ?i ?s ?i' ?s' = _")
-      and Y: "Ye = ivl_err (real_of_float l') (real_of_float u')"
-      (is "_ = ivl_err ?l' ?u'")
+  from ab obtain ivl'
+    where F: "F (ivl_of_aform_err p (W', errw)) (ivl_of_aform_err p (X', errx)) = Some ivl'"
+      and Y: "Ye = ivl_err (real_interval ivl')"
     by (auto simp: approx_bin_def bind_eq_Some_conv max_def)
-  { note w
-    also note Inf_Sup_aform_err[OF e, where p=p]
-    finally have "w \<in> {?i .. ?s}" .
-  } moreover {
-    note x
-    also note Inf_Sup_aform_err[OF e, where p=p]
-    finally have "x \<in> {?i' .. ?s'}" .
-  } ultimately
-  have "f w x \<in> (\<lambda>(a, b). f a b) ` ({real_of_float ?i .. ?s} \<times> {real_of_float ?i' .. ?s'})"
-    by auto
-  also note interval_extension2D[OF ie F]
-  also have "{real_of_float l'..real_of_float u'} = aform_err e Ye" unfolding Y aform_err_ivl_err ..
+  from interval_extension2D[OF ie F
+        ivl_of_aform_err[OF e, where p=p, OF w]
+        ivl_of_aform_err[OF e, where p=p, OF x]]
+  have "f w x \<in>\<^sub>r ivl'" .
+  also have "\<dots> = aform_err e Ye" unfolding Y aform_err_ivl_err ..
   finally show ?thesis .
 qed
 
 definition "min_aform_err p a1 (a2::aform_err) =
   (let
-    i1 = Inf_aform_err p a1;
-    s1 = Sup_aform_err p a1;
-    i2 = Inf_aform_err p a2;
-    s2 = Sup_aform_err p a2
-  in if s1 < i2 then a1
-      else if s2 < i1 then a2
-      else ivl_err (min i1 i2) (min s1 s2))"
+    ivl1 = ivl_of_aform_err p a1;
+    ivl2 = ivl_of_aform_err p a2
+  in if upper ivl1 < lower ivl2 then a1
+      else if upper ivl2 < lower ivl1 then a2
+      else ivl_err (real_interval (min_interval ivl1 ivl2)))"
 
 definition "max_aform_err p a1 (a2::aform_err) =
   (let
-    i1 = Inf_aform_err p a1;
-    s1 = Sup_aform_err p a1;
-    i2 = Inf_aform_err p a2;
-    s2 = Sup_aform_err p a2
-   in if s1 < i2 then (a2)
-        else if s2 < i1 then (a1)
-        else ivl_err (max i1 i2) (max s1 s2))"
+    ivl1 = ivl_of_aform_err p a1;
+    ivl2 = ivl_of_aform_err p a2
+  in if upper ivl1 < lower ivl2 then a2
+      else if upper ivl2 < lower ivl1 then a1
+      else ivl_err (real_interval (max_interval ivl1 ivl2)))"
 
 
 subsection \<open>Approximate Min Range - Kind Of Trigonometric Functions\<close>
 
 definition affine_unop :: "nat \<Rightarrow> real \<Rightarrow> real \<Rightarrow> real \<Rightarrow> aform_err \<Rightarrow> aform_err" where
 "affine_unop p a b d X = (let
     ((x, xs), xe) = X;
     (ax, axe) = trunc_bound_eucl p (a * x);
     (y, ye) = trunc_bound_eucl p (ax + b);
     (ys, yse) = trunc_bound_pdevs p (scaleR_pdevs a xs)
     in ((y, ys), sum_list' p [truncate_up p (\<bar>a\<bar> * xe), axe, ye, yse, d]))"
   \<comment> \<open>TODO: also do binop\<close>
 
 lemma aform_err_leI:
   "y \<in> aform_err e (c, d)"
   if "y \<in> aform_err e (c, d')" "d' \<le> d"
   using that by (auto simp: aform_err_def)
 
 lemma aform_err_eqI:
   "y \<in> aform_err e (c, d)"
   if "y \<in> aform_err e (c, d')" "d' = d"
   using that by (auto simp: aform_err_def)
 
 lemma sum_list'_append[simp]: "sum_list' p (ds@[d]) = truncate_up p (d + sum_list' p ds)"
   unfolding sum_list'_def
   by (simp add: eucl_truncate_up_real_def)
 
 lemma aform_err_sum_list':
   "y \<in> aform_err e (c, sum_list' p ds)"
   if "y \<in> aform_err e (c, sum_list ds)"
   using that(1)
   apply (rule aform_err_leI)
   by (rule sum_list_le_sum_list')
 
 lemma aform_err_trunc_bound_eucl:
   "y \<in> aform_err e ((fst (trunc_bound_eucl p X), xs), snd (trunc_bound_eucl p X) + d)"
   if y: "y \<in> aform_err e ((X, xs), d)"
   using that
 proof -
   from aform_errE[OF y]
   have "\<bar>y - aform_val e (X, xs)\<bar> \<le> d" by auto
   then show ?thesis
     apply (intro aform_errI)
     apply (rule trunc_bound_euclE[of p X])
     by (auto simp: aform_val_def)
 qed
 
 lemma trunc_err_pdevsE:
   assumes "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   obtains err where
   "\<bar>err\<bar> \<le> tdev' p (trunc_err_pdevs p xs)"
   "pdevs_val e (trunc_pdevs p xs) = pdevs_val e xs + err"
   using trunc_bound_pdevsE[of e p xs]
   by (auto simp: trunc_bound_pdevs_def assms)
 
 lemma aform_err_trunc_bound_pdevsI:
   "y \<in> aform_err e ((c, fst (trunc_bound_pdevs p xs)), snd (trunc_bound_pdevs p xs) + d)"
   if y: "y \<in> aform_err e ((c, xs), d)"
   and e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   using that
 proof -
   define exs where "exs = trunc_err_pdevs p xs"
   from aform_errE[OF y]
   have "\<bar>y - aform_val e (c, xs)\<bar> \<le> d" by auto
   then show ?thesis
     apply (intro aform_errI)
     apply (rule trunc_err_pdevsE[OF e, of p xs])
     by (auto simp: aform_val_def trunc_bound_pdevs_def)
 qed
 
 lemma aform_err_addI:
   "y \<in> aform_err e ((a + b, xs), d)"
   if "y - b \<in> aform_err e ((a, xs), d)"
   using that
   by (auto simp: aform_err_def aform_val_def)
 
 theorem affine_unop:
   assumes x: "x \<in> aform_err e X"
   assumes f: "\<bar>f x - (a * x + b)\<bar> \<le> d"
     and e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "f x \<in> aform_err e (affine_unop p a b d X)"
 proof -
   show ?thesis
     unfolding affine_unop_def Let_def
     apply (auto simp: split_beta')
     apply (rule aform_err_sum_list')
     apply simp
     apply (rule aform_err_eqI)
      apply (rule aform_err_trunc_bound_eucl)
      apply (rule aform_err_addI)
      apply (rule aform_err_trunc_bound_eucl)
      apply (rule aform_err_trunc_bound_pdevsI)
     using e
       apply auto
     apply (rule aform_errI)
     apply (auto simp: aform_val_def)
   proof -
     define x' where "x' = (fst (fst X) + pdevs_val e (snd (fst X)))"
     have x_x': "\<bar>x - x'\<bar> \<le> snd X"
       using aform_errE[OF x]
       by (auto simp: x'_def aform_val_def)
     have "\<bar>f x - b - (a * fst (fst X) + a * pdevs_val e (snd (fst X)))\<bar> =
       \<bar>f x - (a * x + b) + a * (x - x')\<bar>"
       by (simp add: algebra_simps x'_def)
     also have "\<dots> \<le> \<bar>f x - (a * x + b)\<bar> + \<bar>a * (x - x')\<bar>"
       by (rule abs_triangle_ineq)
     also note f
     also have "\<bar>a * (x - x')\<bar> \<le> truncate_up p (\<bar>a\<bar> * snd X)"
       by (rule truncate_up_le)
         (auto simp: abs_mult intro!: mult_left_mono x_x')
     finally show "\<bar>f x - b - (a * fst (fst X) + a * pdevs_val e (snd (fst X)))\<bar> \<le>
         truncate_up p (\<bar>a\<bar> * snd X) + d"
       by auto
   qed
 qed
 
 lemma min_range_coeffs_ge:
   "\<bar>f x - (a * x + b)\<bar> \<le> d"
   if l: "l \<le> x" and u: "x \<le> u"
     and f': "\<And>y. y \<in> {l .. u} \<Longrightarrow> (f has_real_derivative f' y) (at y)"
     and a: "\<And>y. y \<in> {l..u} \<Longrightarrow> a \<le> f' y"
     and d: "d \<ge> (f u - f l - a * (u - l)) / 2 + \<bar>(f l + f u - a * (l + u)) / 2 - b\<bar>"
   for a b d::real
 proof (rule order_trans[OF _ d])
   note f'_at = has_field_derivative_at_within[OF f']
   from l u have lu: "x \<in> {l .. u}" and llu: "l \<in> {l .. u}" by simp_all
 
   define m where "m = (f l + f u - a * (l + u)) / 2"
   have "\<bar>f x - (a * x + b)\<bar> = \<bar>f x - (a * x + m) + (m - b)\<bar>" by (simp add: algebra_simps)
   also have "\<dots> \<le> \<bar>f x - (a * x + m)\<bar> + \<bar>m - b\<bar>" by (rule abs_triangle_ineq)
   also have "\<bar>f x - (a * x + m)\<bar> \<le> (f u - f l - a * (u - l)) / 2"
   proof (rule abs_leI)
     have "f x \<ge> f l + a * (x - l)" (is "?l \<ge> ?r")
       apply (rule order_trans) prefer 2
        apply (rule linear_lower2[OF f'_at, of l u a])
       subgoal by assumption
       subgoal by (rule a)
       subgoal
         using lu
         by (auto intro!: mult_right_mono)
       subgoal using lu by auto
       done
     also have "a * x + m - (f u - f l - a * (u - l)) / 2 \<le> ?r"
       by (simp add: algebra_simps m_def field_simps)
     finally (xtrans) show "- (f x - (a * x + m)) \<le> (f u - f l - a * (u - l)) / 2"
       by (simp add: algebra_simps m_def divide_simps)
   next
     have "f x \<le> f u + a * (x - u)"
       apply (rule order_trans)
        apply (rule linear_upper2[OF f'_at, of l u a])
       subgoal by assumption
       subgoal by (rule a)
       subgoal
         using lu
         by (auto intro!: mult_right_mono)
       subgoal using lu by auto
       done
     also have "\<dots> \<le> a * x + m + (f u - f l - a * (u - l)) / 2"
       by (simp add: m_def divide_simps algebra_simps)
     finally show "f x - (a * x + m) \<le> (f u - f l - a * (u - l)) / 2"
       by (simp add: algebra_simps m_def divide_simps)
   qed
   also have "\<bar>m - b\<bar> = abs ((f l + f u - a * (l + u)) / 2 - b)"
     unfolding m_def ..
   finally show "\<bar>f x - (a * x + b)\<bar> \<le> (f u - f l - a * (u - l)) / 2 + \<bar>(f l + f u - a * (l + u)) / 2 - b\<bar>"
     by (simp)
 qed
 
 lemma min_range_coeffs_le:
   "\<bar>f x - (a * x + b)\<bar> \<le> d"
   if l: "l \<le> x" and u: "x \<le> u"
     and f': "\<And>y. y \<in> {l .. u} \<Longrightarrow> (f has_real_derivative f' y) (at y)"
     and a: "\<And>y. y \<in> {l .. u} \<Longrightarrow> f' y \<le> a"
     and d: "d \<ge> (f l - f u + a * (u - l)) / 2 + \<bar>(f l + f u - a * (l + u)) / 2 - b\<bar>"
   for a b d::real
 proof (rule order_trans[OF _ d])
   note f'_at = has_field_derivative_at_within[OF f']
   from l u have lu: "x \<in> {l .. u}" and llu: "l \<in> {l .. u}" by simp_all
 
   define m where "m = (f l + f u - a * (l + u)) / 2"
   have "\<bar>f x - (a * x + b)\<bar> = \<bar>f x - (a * x + m) + (m - b)\<bar>" by (simp add: algebra_simps)
   also have "\<dots> \<le> \<bar>f x - (a * x + m)\<bar> + \<bar>m - b\<bar>" by (rule abs_triangle_ineq)
   also have "\<bar>f x - (a * x + m)\<bar> \<le> (f l - f u + a * (u - l)) / 2"
   proof (rule abs_leI)
     have "f x \<ge> f u + a * (x - u)" (is "?l \<ge> ?r")
       apply (rule order_trans) prefer 2
        apply (rule linear_lower[OF f'_at, of l u a])
       subgoal by assumption
       subgoal by (rule a)
       subgoal
         using lu
         by (auto intro!: mult_right_mono)
       subgoal using lu by auto
       done
     also have "a * x + m - (f l - f u + a * (u - l)) / 2 \<le> ?r"
       using lu
       by (auto simp add: algebra_simps m_def field_simps intro!: mult_left_mono_neg)
     finally (xtrans) show "- (f x - (a * x + m)) \<le> (f l - f u + a * (u - l)) / 2"
       by (simp add: algebra_simps m_def divide_simps)
   next
     have "f x \<le> f l + a * (x - l)"
       apply (rule order_trans)
        apply (rule linear_upper[OF f'_at, of l u a])
       subgoal by assumption
       subgoal by (rule a)
       subgoal
         using lu
         by (auto intro!: mult_right_mono)
       subgoal using lu by auto
       done
     also have "\<dots> \<le> a * x + m + (f l - f u + a * (u - l)) / 2"
       using lu
       by (auto simp add: algebra_simps m_def field_simps intro!: mult_left_mono_neg)
     finally show "f x - (a * x + m) \<le> (f l - f u + a * (u - l)) / 2"
       by (simp add: algebra_simps m_def divide_simps)
   qed
   also have "\<bar>m - b\<bar> = abs ((f l + f u - a * (l + u)) / 2 - b)"
     unfolding m_def ..
   finally show "\<bar>f x - (a * x + b)\<bar> \<le> (f l - f u + a * (u - l)) / 2 + \<bar>(f l + f u - a * (l + u)) / 2 - b\<bar>"
     by (simp)
 qed
 
 context includes floatarith_notation begin
 
 definition "range_reducer p l =
   (if l < 0 \<or> l > 2 * lb_pi p
   then approx p (Pi * (Num (-2)) * (Floor (Num (l * Float 1 (-1)) / Pi))) []
   else Some 0)"
 
-lemmas approx_emptyD = approx[OF bounded_by_None[of Nil] sym, simplified]
+lemmas approx_emptyD = approx[OF bounded_by_None[of Nil], simplified]
 
 lemma range_reducerE:
-  assumes "range_reducer p l = Some (r, r')"
-  obtains n::int where "r \<le> n * (2 * pi)" "n * (2 * pi) \<le> r'"
+  assumes "range_reducer p l = Some ivl"
+  obtains n::int where "n * (2 * pi) \<in>\<^sub>r ivl"
 proof (cases "l \<ge> 0 \<and> l \<le> 2 * lb_pi p")
   case False
-  with assms have
-    "r \<le> - \<lfloor>l / (2 * pi)\<rfloor> * (2 * pi)"
-    "- \<lfloor>l / (2 * pi)\<rfloor> * (2 * pi) \<le> r'"
+  with assms have "- \<lfloor>l / (2 * pi)\<rfloor> * (2 * pi) \<in>\<^sub>r ivl"
     by (auto simp: range_reducer_def bind_eq_Some_conv inverse_eq_divide
         algebra_simps dest!: approx_emptyD)
   then show ?thesis ..
 next
-  case True then have "r \<le> real_of_int 0 * (2 * pi)" "real_of_int 0 * (2 * pi) \<le> r'" using assms
-    by (auto simp: range_reducer_def zero_prod_def)
+  case True then have "real_of_int 0 * (2 * pi) \<in>\<^sub>r ivl" using assms
+    by (auto simp: range_reducer_def zero_in_float_intervalI)
   then show ?thesis ..
 qed
 
 definition "range_reduce_aform_err p X = do {
-  let l = Inf_aform_err p X;
-  let u = Sup_aform_err p X;
-  (r, r') \<leftarrow> range_reducer p l;
-  Some (add_aform' p X (ivl_err (real_of_float r) (real_of_float r')))
+  r \<leftarrow> range_reducer p (lower (ivl_of_aform_err p X));
+  Some (add_aform' p X (ivl_err (real_interval r)))
 }"
 
 lemma range_reduce_aform_errE:
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes x: "x \<in> aform_err e X"
   assumes "range_reduce_aform_err p X = Some Y"
   obtains n::int where "x + n * (2 * pi) \<in> aform_err e Y"
 proof -
-  from assms obtain r r'
+  from assms obtain r
     where x: "x \<in> aform_err e X"
-     and r: "range_reducer p (Inf_aform_err p X) = Some (r, r')"
-     and Y:  "Y = add_aform' p X (ivl_err (real_of_float r) (real_of_float r'))"
+     and r: "range_reducer p (lower (ivl_of_aform_err p X)) = Some r"
+     and Y:  "Y = add_aform' p X (ivl_err (real_interval r))"
     by (auto simp: range_reduce_aform_err_def bind_eq_Some_conv mid_err_def split: prod.splits)
   from range_reducerE[OF r]
-  obtain n::int where "r \<le> n * (2 * pi)" "n * (2 * pi) \<le> r'"
+  obtain n::int where "n * (2 * pi) \<in>\<^sub>r r"
     by auto
-  then have "n * (2 * pi) \<in> aform_err e (ivl_err (real_of_float r) (real_of_float r'))"
-    by (auto simp: aform_val_def ac_simps divide_simps abs_real_def intro!: aform_errI)
+  then have "n * (2 * pi) \<in> aform_err e (ivl_err (real_interval r))"
+    by (auto simp: aform_val_def ac_simps divide_simps abs_real_def set_of_eq intro!: aform_errI)
   from add_aform'[OF e x this, of p]
   have "x + n * (2 * pi) \<in> aform_err e Y"
     by (auto simp: Y)
   then show ?thesis ..
 qed
 
 definition "min_range_mono p F DF l u X = do {
   let L = Num l;
   let U = Num u;
-  (a, _) \<leftarrow> approx p (Min (DF L) (DF U)) [];
+  aivl \<leftarrow> approx p (Min (DF L) (DF U)) [];
+  let a = lower aivl;
   let A = Num a;
   bivl \<leftarrow> approx p (Half (F L + F U - A * (L + U))) [];
   let (b, be) = mid_err bivl;
   let (B, Be) = (Num (float_of b), Num (float_of be));
-  (_, d) \<leftarrow> approx p ((Half (F U - F L - A * (U - L))) + Be) [];
-  Some (affine_unop p a b (real_of_float d) X)
+  divl \<leftarrow> approx p ((Half (F U - F L - A * (U - L))) + Be) [];
+  Some (affine_unop p a b (real_of_float (upper divl)) X)
 }"
 
 lemma min_range_mono:
   assumes x: "x \<in> aform_err e X"
   assumes "l \<le> x" "x \<le> u"
   assumes "min_range_mono p F DF l u X = Some Y"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes F: "\<And>x. x \<in> {real_of_float l .. u} \<Longrightarrow> interpret_floatarith (F (Num x)) [] = f x"
   assumes DF: "\<And>x. x \<in> {real_of_float l .. u} \<Longrightarrow> interpret_floatarith (DF (Num x)) [] = f' x"
   assumes f': "\<And>x. x \<in> {real_of_float l .. u} \<Longrightarrow> (f has_real_derivative f' x) (at x)"
   assumes f'_le: "\<And>x. x \<in> {real_of_float l .. u} \<Longrightarrow> min (f' l) (f' u) \<le> f' x"
   shows "f x \<in> aform_err e Y"
 proof -
-  from assms obtain a bl bu du
-    where bl: "bl \<le> (f l + f u - a * (l + u)) / 2"
-      and bu: "(f l + f u - a * (l + u))/2 \<le> bu"
-      and Y: "Y = affine_unop p (a) ((bl + bu) / 2) (du) X"
-      and du: "(f u - f l - a * (u - l)) / 2 + (bu - bl) / 2 \<le> du"
+  from assms obtain a b be bivl divl
+    where bivl: "(f l + f u - a * (l + u))/2 \<in>\<^sub>r bivl"
+      and Y: "Y = affine_unop p a b (upper divl) X"
+      and du: "(f u - f l - a * (u - l)) / 2 + be \<in>\<^sub>r divl"
       and a: "a \<le> f' l" "a \<le> f' u"
-    by (auto simp: min_range_mono_def Let_def bind_eq_Some_conv mid_err_def
+      and b_def: "b = (lower bivl + upper bivl) / 2"
+      and be_def: "be = (upper bivl - lower bivl) / 2"
+    by (auto simp: min_range_mono_def Let_def bind_eq_Some_conv mid_err_def set_of_eq
+        simp del: eq_divide_eq_numeral1
         split: prod.splits if_splits dest!: approx_emptyD)
-  then obtain b be where b_def: "b = (bl + bu) / 2" and be_def: "be = (bu - bl) / 2"
-    by blast
   have diff_le: "real_of_float a \<le> f' y" if "real_of_float l \<le> y" "y \<le> u" for y
     using f'_le[of y] that a
     by auto
   have le_be: "\<bar>(f (l) + f (u) - a * (real_of_float l + u)) / 2 - b\<bar> \<le> be"
-    using bl bu
+    using bivl
     unfolding b_def be_def
-    by (auto simp: abs_real_def divide_simps)
-  have "\<bar>f x - (a * x + b)\<bar> \<le> du"
+    by (auto simp: abs_real_def divide_simps set_of_eq)
+  have "\<bar>f x - (a * x + b)\<bar> \<le> upper divl"
     apply (rule min_range_coeffs_ge)
         apply (rule \<open>l \<le> x\<close>)
        apply (rule \<open>x \<le> u\<close>)
       apply (rule f') apply assumption
     using diff_le apply force
     apply (rule order_trans[OF add_mono[OF order_refl]])
      apply (rule le_be)
-    using du bl bu
+    using bivl du
     unfolding b_def[symmetric] be_def[symmetric]
-    by auto
+    by (auto simp: set_of_eq)
   from affine_unop[where f=f and p = p, OF \<open>x \<in> _\<close> this e]
-  have "f x \<in> aform_err e (affine_unop p (real_of_float a) b du X)"
+  have "f x \<in> aform_err e (affine_unop p (real_of_float a) b (upper divl) X)"
     by (auto simp: Y)
   then show ?thesis
     by (simp add: Y b_def)
 qed
 
 definition "min_range_antimono p F DF l u X = do {
   let L = Num l;
   let U = Num u;
-  (_, a) \<leftarrow> approx p (Max (DF L) (DF U)) [];
+  aivl \<leftarrow> approx p (Max (DF L) (DF U)) [];
+  let a = upper aivl;
   let A = Num a;
   bivl \<leftarrow> approx p (Half (F L + F U - A * (L + U))) [];
   let (b, be) = mid_err bivl;
   let (B, Be) = (Num (float_of b), Num (float_of be));
-  (_, d) \<leftarrow> approx p (Add (Half (F L - F U + A * (U - L))) Be) [];
-  Some (affine_unop p a b (real_of_float d) X)
+  divl \<leftarrow> approx p (Add (Half (F L - F U + A * (U - L))) Be) [];
+  Some (affine_unop p a b (real_of_float (upper divl)) X)
 }"
 
 lemma min_range_antimono:
   assumes x: "x \<in> aform_err e X"
   assumes "l \<le> x" "x \<le> u"
   assumes "min_range_antimono p F DF l u X = Some Y"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes F: "\<And>x. x \<in> {real_of_float l .. u} \<Longrightarrow> interpret_floatarith (F (Num x)) [] = f x"
   assumes DF: "\<And>x. x \<in> {real_of_float l .. u} \<Longrightarrow> interpret_floatarith (DF (Num x)) [] = f' x"
   assumes f': "\<And>x. x \<in> {real_of_float l .. u} \<Longrightarrow> (f has_real_derivative f' x) (at x)"
   assumes f'_le: "\<And>x. x \<in> {real_of_float l .. u} \<Longrightarrow> f' x \<le> max (f' l) (f' u)"
   shows "f x \<in> aform_err e Y"
 proof -
-  from assms obtain a bl bu du
-    where bl: "bl \<le> (f l + f u - a * (l + u)) / 2"
-      and bu: "(f l + f u - a * (l + u))/2 \<le> bu"
-      and Y: "Y = affine_unop p (a) ((bl + bu) / 2) (du) X"
-      and du: "(f l - f u + a * (u - l)) / 2 + (bu - bl) / 2 \<le> du"
-      and a: "f' l \<le> a" "f' u \<le> a"
-    by (auto simp: min_range_antimono_def Let_def bind_eq_Some_conv mid_err_def
+  from assms obtain a b be aivl bivl divl
+    where bivl: "(f l + f u - real_of_float a * (l + u)) / 2 \<in>\<^sub>r bivl"
+    and Y: "Y = affine_unop p a b (real_of_float (upper divl)) X"
+    and du: "(f l - f u + a * (u - l)) / 2 + be \<in>\<^sub>r divl"
+    and a: "f' l \<le> a" "f' u \<le> a"
+    and a_def: "a = upper aivl"
+    and b_def: "b = (lower bivl + upper bivl) / 2"
+    and be_def: "be = (upper bivl - lower bivl) / 2"
+    by (auto simp: min_range_antimono_def Let_def bind_eq_Some_conv mid_err_def set_of_eq
+        simp del: eq_divide_eq_numeral1
         split: prod.splits if_splits dest!: approx_emptyD)
-  then obtain b be where b_def: "b = (bl + bu) / 2" and be_def: "be = (bu - bl) / 2"
-    by blast
   have diff_le: "f' y \<le> real_of_float a" if "real_of_float l \<le> y" "y \<le> u" for y
     using f'_le[of y] that a
     by auto
   have le_be: "\<bar>(f (l) + f (u) - a * (real_of_float l + u)) / 2 - b\<bar> \<le> be"
-    using bl bu
+    using bivl
     unfolding b_def be_def
-    by (auto simp: abs_real_def divide_simps)
-  have "\<bar>f x - (a * x + b)\<bar> \<le> du"
+    by (auto simp: abs_real_def divide_simps set_of_eq)
+  have "\<bar>f x - (a * x + b)\<bar> \<le> upper divl"
     apply (rule min_range_coeffs_le)
         apply (rule \<open>l \<le> x\<close>)
        apply (rule \<open>x \<le> u\<close>)
       apply (rule f') apply assumption
     using diff_le apply force
     apply (rule order_trans[OF add_mono[OF order_refl]])
      apply (rule le_be)
-    using du bl bu
+    using du bivl
     unfolding b_def[symmetric] be_def[symmetric]
-    by auto
+    by (auto simp: set_of_eq)
   from affine_unop[where f=f and p = p, OF \<open>x \<in> _\<close> this e]
-  have "f x \<in> aform_err e (affine_unop p (real_of_float a) b du X)"
+  have "f x \<in> aform_err e (affine_unop p (real_of_float a) b (upper divl) X)"
     by (auto simp: Y)
   then show ?thesis
     by (simp add: Y b_def)
 qed
 
 definition "cos_aform_err p X = do {
   X \<leftarrow> range_reduce_aform_err p X;
-  let l = Inf_aform_err p X;
-  let u = Sup_aform_err p X;
+  let ivl = ivl_of_aform_err p X;
+  let l = lower ivl;
+  let u = upper ivl;
   let L = Num l;
   let U = Num u;
   if l \<ge> 0 \<and> u \<le> lb_pi p then
    min_range_antimono p Cos (\<lambda>x. (Minus (Sin x))) l u X
   else if l \<ge> ub_pi p \<and> u \<le> 2 * lb_pi p then
    min_range_mono p Cos (\<lambda>x. (Minus (Sin x))) l u X
   else do {
-    let (a, b) = (bnds_cos p l u);
-    Some (ivl_err a b)
+    Some (ivl_err (real_interval (cos_float_interval p ivl)))
   }
 }"
 
 lemma abs_half_enclosure:
   fixes r::real
   assumes "bl \<le> r" "r \<le> bu"
   shows "\<bar>r - (bl + bu) / 2\<bar> \<le> (bu - bl) / 2"
   using assms
   by (auto simp: abs_real_def divide_simps)
 
 lemma cos_aform_err:
   assumes x: "x \<in> aform_err e X0"
   assumes "cos_aform_err p X0 = Some Y"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "cos x \<in> aform_err e Y"
 proof -
-  from assms obtain X l u where
+  from assms obtain X ivl l u where
     X: "range_reduce_aform_err p X0 = Some X"
-    and l: "l = Inf_aform_err p X"
-    and u: "u = Sup_aform_err p X"
+    and ivl_def: "ivl = ivl_of_aform_err p X"
+    and l_def: "l = lower ivl"
+    and u_def: "u = upper ivl"
     by (auto simp: cos_aform_err_def bind_eq_Some_conv)
   from range_reduce_aform_errE[OF e x X]
   obtain n where xn: "x + real_of_int n * (2 * pi) \<in> aform_err e X"
     by auto
   define xn where "xn = x + n * (2 * pi)"
   with xn have xn: "xn \<in> aform_err e X" by auto
-  with l u have lxn: "l \<le> xn" and uxn: "xn \<le> u"
-    using Inf_Sup_aform_err[OF e, of X p]
-    by auto
+  from ivl_of_aform_err[OF e xn, of p, folded ivl_def]
+  have "xn \<in>\<^sub>r ivl" .
+  then have lxn: "l \<le> xn" and uxn: "xn \<le> u"
+    by (auto simp: l_def u_def set_of_eq)
   consider "l \<ge> 0" "u \<le> lb_pi p"
     | "l < 0 \<or> u > lb_pi p" "l \<ge> ub_pi p" "u \<le> 2 * lb_pi p"
     | "l < 0 \<or> u > lb_pi p" "l < ub_pi p \<or> u > 2 * lb_pi p"
     by arith
   then show ?thesis
   proof cases
     case 1
     then have min_eq_Some: "min_range_antimono p Cos (\<lambda>x. Minus (Sin x)) l u X = Some Y"
       and bounds: "0 \<le> l" "u \<le> (lb_pi p)"
       using assms(2)
-      unfolding cos_aform_err_def X l u
-      by (auto simp: X l[symmetric] u[symmetric] split: prod.splits)
+      unfolding cos_aform_err_def X l_def u_def
+      by (auto simp: X Let_def simp flip: l_def u_def ivl_def  split: prod.splits)
     have bounds: "0 \<le> l" "u \<le> pi" using bounds pi_boundaries[of p] by auto
     have diff_le: "- sin y \<le> max (- sin (real_of_float l)) (- sin (real_of_float u))"
       if "real_of_float l \<le> y" "y \<le> real_of_float u" for y
     proof -
       consider "y \<le> pi / 2" | "y \<ge> pi / 2" by arith
       then show ?thesis
       proof cases
         case 1
         then have "- sin y \<le> - sin l"
           using that bounds
           by (auto intro!: sin_monotone_2pi_le)
         then show ?thesis by auto
       next
         case 2
         then have "- sin y \<le> - sin u"
           using that bounds
           unfolding sin_minus_pi[symmetric]
           apply (intro sin_monotone_2pi_le)
           by (auto intro!: )
         then show ?thesis by auto
       qed
     qed
     have "cos xn \<in> aform_err e Y"
       apply (rule min_range_antimono[OF xn lxn uxn min_eq_Some e, where f'="\<lambda>x. - sin x"])
       subgoal by simp
       subgoal by simp
       subgoal by (auto intro!: derivative_eq_intros)
       subgoal by (rule diff_le) auto
       done
     then show ?thesis
       unfolding xn_def
       by (simp add: )
   next
     case 2
     then have min_eq_Some: "min_range_mono p Cos (\<lambda>x. Minus (Sin x)) l u X = Some Y"
       and bounds: "ub_pi p \<le> l" "u \<le> 2 * lb_pi p"
       using assms(2)
-      unfolding cos_aform_err_def X l u
-      by (auto simp: X l[symmetric] u[symmetric] split: prod.splits)
+      unfolding cos_aform_err_def X
+      by (auto simp: X Let_def simp flip: l_def u_def ivl_def split: prod.splits)
     have bounds: "pi \<le> l" "u \<le> 2 * pi" using bounds pi_boundaries[of p] by auto
     have diff_le: "min (- sin (real_of_float l)) (- sin (real_of_float u)) \<le> - sin y"
       if "real_of_float l \<le> y" "y \<le> real_of_float u" for y
     proof -
       consider "y \<le> 3 * pi / 2" | "y \<ge> 3 * pi / 2" by arith
       then show ?thesis
       proof cases
         case 1
         then have "- sin l \<le> - sin y"
           unfolding sin_minus_pi[symmetric]
           apply (intro sin_monotone_2pi_le)
           using that bounds
           by (auto)
         then show ?thesis by auto
       next
         case 2
         then have "- sin u \<le> - sin y"
           unfolding sin_2pi_minus[symmetric]
           using that bounds
           apply (intro sin_monotone_2pi_le)
           by (auto intro!: )
         then show ?thesis by auto
       qed
     qed
     have "cos xn \<in> aform_err e Y"
       apply (rule min_range_mono[OF xn lxn uxn min_eq_Some e, where f'="\<lambda>x. - sin x"])
       subgoal by simp
       subgoal by simp
       subgoal by (auto intro!: derivative_eq_intros)
       subgoal by (rule diff_le) auto
       done
     then show ?thesis
       unfolding xn_def
       by (simp add: )
   next
     case 3
-    then obtain l' u' where
-      "bnds_cos p l u = (l', u')"
-      "Y = ivl_err (real_of_float l') (real_of_float u')"
+    then obtain ivl' where
+      "cos_float_interval p ivl = ivl'"
+      "Y = ivl_err (real_interval ivl')"
       using assms(2)
-      unfolding cos_aform_err_def X l u
-      by (auto simp: X l[symmetric] u[symmetric] split: prod.splits)
-    with bnds_cos[of l' u' p, rule_format, of l u xn] lxn uxn
+      unfolding cos_aform_err_def X l_def u_def
+      by (auto simp: X simp flip: l_def u_def ivl_def split: prod.splits)
+    with cos_float_intervalI[OF \<open>xn \<in>\<^sub>r ivl\<close>, of p]
     show ?thesis
       by (auto simp: xn_def)
   qed
 qed
 
 definition "sqrt_aform_err p X = do {
-  let l = Inf_aform_err p X;
-  let u = Sup_aform_err p X;
+  let ivl = ivl_of_aform_err p X;
+  let l = lower ivl;
+  let u = upper ivl;
   if 0 < l then min_range_mono p Sqrt (\<lambda>x. Half (Inverse (Sqrt x))) l u X
-  else Some (ivl_err (lb_sqrt p l) (ub_sqrt p u))
+  else Some (ivl_err (real_interval (sqrt_float_interval p ivl)))
 }"
 
 lemma sqrt_aform_err:
   assumes x: "x \<in> aform_err e X"
   assumes "sqrt_aform_err p X = Some Y"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "sqrt x \<in> aform_err e Y"
 proof -
-  obtain l u where l: "l = Inf_aform_err p X"
-    and u: "u = Sup_aform_err p X"
+  obtain l u ivl
+    where ivl_def: "ivl = ivl_of_aform_err p X"
+    and l_def: "l = lower ivl"
+    and u_def: "u = upper ivl"
     by auto
-  from x l u have lx: "l \<le> x" and ux: "x \<le> u"
-    using Inf_Sup_aform_err[OF e, of X p]
-    by auto
+  from ivl_of_aform_err[OF e x, of p, folded ivl_def]
+  have ivl: "x \<in>\<^sub>r ivl" .
+  then have lx: "l \<le> x" and ux: "x \<le> u"
+    by (auto simp flip: ivl_def simp: l_def u_def set_of_eq)
   consider "l > 0" | "l \<le> 0"
     by arith
   then show ?thesis
   proof cases
     case 1
     then have min_eq_Some: "min_range_mono p Sqrt (\<lambda>x. Half (Inverse (Sqrt x))) l u X = Some Y"
       and bounds: "0 < l"
       using assms(2)
-      unfolding sqrt_aform_err_def l u
-      by (auto simp: l[symmetric] u[symmetric] split: prod.splits if_splits)
+      unfolding sqrt_aform_err_def
+      by (auto simp: Let_def simp flip: l_def u_def ivl_def split: prod.splits)
     have "sqrt x \<in> aform_err e Y"
       apply (rule min_range_mono[OF x lx ux min_eq_Some e, where f'="\<lambda>x. 1 / (2 * sqrt x)"])
       subgoal by simp
       subgoal by (simp add: divide_simps)
       subgoal using bounds by (auto intro!: derivative_eq_intros simp: inverse_eq_divide)
       subgoal using \<open>l > 0\<close> by (auto simp: inverse_eq_divide min_def divide_simps)
       done
     then show ?thesis
       by (simp add: )
   next
     case 2
-    then have "Y = ivl_err (lb_sqrt p l) (ub_sqrt p u)"
+    then have "Y = ivl_err (real_interval (sqrt_float_interval p ivl))"
       using assms(2)
-      unfolding sqrt_aform_err_def l u
-      by (auto simp: l[symmetric] u[symmetric] split: prod.splits)
-    with bnds_sqrt[rule_format, OF conjI[OF refl], of x l u p] lx ux
+      unfolding sqrt_aform_err_def
+      by (auto simp: Let_def simp flip: ivl_def l_def u_def split: prod.splits)
+    with sqrt_float_intervalI[OF ivl]
     show ?thesis
-      by (auto simp: )
+      by (auto simp: set_of_eq)
   qed
 qed
 
 definition "ln_aform_err p X = do {
-  let l = Inf_aform_err p X;
-  let u = Sup_aform_err p X;
-  if 0 < l then min_range_mono p Ln inverse l u X
+  let ivl = ivl_of_aform_err p X;
+  let l = lower ivl;
+  if 0 < l then min_range_mono p Ln inverse l (upper ivl) X
   else None
 }"
 
 lemma ln_aform_err:
   assumes x: "x \<in> aform_err e X"
   assumes "ln_aform_err p X = Some Y"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "ln x \<in> aform_err e Y"
 proof -
-  obtain l u where l: "l = Inf_aform_err p X"
-    and u: "u = Sup_aform_err p X"
+  obtain ivl l u
+    where l_def: "l = lower ivl"
+      and u_def: "u = upper ivl"
+      and ivl_def: "ivl = ivl_of_aform_err p X"
     by auto
-  from x l u have lx: "l \<le> x" and ux: "x \<le> u"
-    using Inf_Sup_aform_err[OF e, of X p]
-    by auto
+  from ivl_of_aform_err[OF e x, of p, folded ivl_def]
+  have "x \<in>\<^sub>r ivl" .
+  then have lx: "l \<le> x" and ux: "x \<le> u"
+    by (auto simp: set_of_eq l_def u_def)
   consider "l > 0" | "l \<le> 0"
     by arith
   then show ?thesis
   proof cases
     case 1
     then have min_eq_Some: "min_range_mono p Ln inverse l u X = Some Y"
       and bounds: "0 < l"
       using assms(2)
-      unfolding ln_aform_err_def l u
-      by (auto simp: l[symmetric] u[symmetric] split: prod.splits if_splits)
+      unfolding ln_aform_err_def
+      by (auto simp: Let_def simp flip: ivl_def l_def u_def split: prod.splits if_splits)
     have "ln x \<in> aform_err e Y"
       apply (rule min_range_mono[OF x lx ux min_eq_Some e, where f'=inverse])
       subgoal by simp
       subgoal by (simp add: divide_simps)
       subgoal using bounds by (auto intro!: derivative_eq_intros simp: inverse_eq_divide)
       subgoal using \<open>l > 0\<close> by (auto simp: inverse_eq_divide min_def divide_simps)
       done
     then show ?thesis
       by (simp add: )
   next
     case 2
     then show ?thesis using assms
-      by (auto simp: ln_aform_err_def Let_def l[symmetric])
+      by (auto simp: ln_aform_err_def Let_def l_def ivl_def)
   qed
 qed
 
 definition "exp_aform_err p X = do {
-  let l = Inf_aform_err p X;
-  let u = Sup_aform_err p X;
-  min_range_mono p Exp Exp l u X
+  let ivl = ivl_of_aform_err p X;
+  min_range_mono p Exp Exp (lower ivl) (upper ivl) X
 }"
 
 lemma exp_aform_err:
   assumes x: "x \<in> aform_err e X"
   assumes "exp_aform_err p X = Some Y"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "exp x \<in> aform_err e Y"
 proof -
-  obtain l u where l: "l = Inf_aform_err p X"
-    and u: "u = Sup_aform_err p X"
+  obtain l u ivl
+    where l_def: "l = lower ivl"
+      and u_def: "u = upper ivl"
+      and ivl_def: "ivl = ivl_of_aform_err p X"
     by auto
-  from x l u have lx: "l \<le> x" and ux: "x \<le> u"
-    using Inf_Sup_aform_err[OF e, of X p]
-    by auto
+  from ivl_of_aform_err[OF e x, of p, folded ivl_def]
+  have "x \<in>\<^sub>r ivl" .
+  then have lx: "l \<le> x" and ux: "x \<le> u"
+    by (auto simp: ivl_def l_def u_def set_of_eq)
   have min_eq_Some: "min_range_mono p Exp Exp l u X = Some Y"
     using assms(2)
-    unfolding exp_aform_err_def l u
-    by (auto simp: l[symmetric] u[symmetric] split: prod.splits if_splits)
+    unfolding exp_aform_err_def
+    by (auto simp: Let_def simp flip: ivl_def u_def l_def split: prod.splits if_splits)
   have "exp x \<in> aform_err e Y"
     apply (rule min_range_mono[OF x lx ux min_eq_Some e, where f'=exp])
     subgoal by simp
     subgoal by (simp add: divide_simps)
     subgoal by (auto intro!: derivative_eq_intros simp: inverse_eq_divide)
     subgoal by (auto simp: inverse_eq_divide min_def divide_simps)
     done
   then show ?thesis
     by (simp add: )
 qed
 
 definition "arctan_aform_err p X = do {
   let l = Inf_aform_err p X;
   let u = Sup_aform_err p X;
   min_range_mono p Arctan (\<lambda>x. 1 / (Num 1 + x * x)) l u X
 }"
 
 lemma pos_add_nonneg_ne_zero: "a > 0 \<Longrightarrow> b \<ge> 0 \<Longrightarrow> a + b \<noteq> 0"
   for a b::real
   by arith
 
 lemma arctan_aform_err:
   assumes x: "x \<in> aform_err e X"
   assumes "arctan_aform_err p X = Some Y"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "arctan x \<in> aform_err e Y"
 proof -
   obtain l u where l: "l = Inf_aform_err p X"
     and u: "u = Sup_aform_err p X"
     by auto
   from x l u have lx: "l \<le> x" and ux: "x \<le> u"
     using Inf_Sup_aform_err[OF e, of X p]
     by auto
   have min_eq_Some: "min_range_mono p Arctan (\<lambda>x. 1 / (Num 1 + x * x))  l u X = Some Y"
     using assms(2)
     unfolding arctan_aform_err_def l u
     by (auto simp: l[symmetric] u[symmetric] split: prod.splits if_splits)
   have "arctan x \<in> aform_err e Y"
     apply (rule min_range_mono[OF x lx ux min_eq_Some e, where f'="\<lambda>x. inverse (1 + x\<^sup>2)"])
     subgoal by simp
     subgoal by (simp add: power2_eq_square inverse_eq_divide)
     subgoal by (auto intro!: derivative_eq_intros simp: inverse_eq_divide)
     subgoal for x
       apply (cases "x \<le> 0")
       subgoal
         apply (rule min.coboundedI1)
         apply (rule deriv_nonneg_imp_mono[of "real_of_float l" x])
         by (auto intro!: derivative_eq_intros simp: mult_le_0_iff pos_add_nonneg_ne_zero)
       subgoal
         apply (rule min.coboundedI2)
         apply (rule le_imp_inverse_le)
         by (auto intro!: power_mono add_pos_nonneg)
       done
     done
   then show ?thesis
     by (simp add: )
 qed
 
 subsection \<open>Power, TODO: compare with Min-range approximation?!\<close>
 
 definition "power_aform_err p (X::aform_err) n =
   (if n = 0 then ((1, zero_pdevs), 0)
   else if n = 1 then X
   else
     let x0 = float_of (fst (fst X));
       xs = snd (fst X);
       xe = float_of (snd X);
       C = the (approx p (Num x0 ^\<^sub>e n) []);
       (c, ce) = mid_err C;
       NX = the (approx p (Num (of_nat n) * (Num x0 ^\<^sub>e (n - 1))) []);
       (nx, nxe) = mid_err NX;
       Y = scaleR_pdevs nx xs;
       (Y', Y_err) = trunc_bound_pdevs p Y;
       t = tdev' p xs;
       Ye = truncate_up p (nxe * t);
-      (_, ERR) = the (approx p
+      err = the (approx p
         (Num (of_nat n) * Num xe * Abs (Num x0) ^\<^sub>e (n - 1) + 
         (Sum\<^sub>e (\<lambda>k. Num (of_nat (n choose k)) * Abs (Num x0) ^\<^sub>e (n - k) * (Num xe + Num (float_of t)) ^\<^sub>e k)
-          [2..<Suc n])) [])
+          [2..<Suc n])) []);
+      ERR = upper err
     in ((c, Y'), sum_list' p [ce, Y_err, Ye, real_of_float ERR]))"
 
 lemma bounded_by_Nil: "bounded_by [] []"
   by (auto simp: bounded_by_def)
 
 lemma plain_floatarith_approx:
   assumes "plain_floatarith 0 f"
-  shows "interpret_floatarith f [] \<in>
-    {real_of_float (fst (the (approx p f []))) .. real_of_float (snd (the (approx p f [])))}"
+  shows "interpret_floatarith f [] \<in>\<^sub>r (the (approx p f []))"
 proof -
   from plain_floatarith_approx_not_None[OF assms(1), of Nil p]
-  obtain l u where "Some (l, u) = approx p f []"
+  obtain ivl where "approx p f [] = Some ivl"
     by auto
-  from this[symmetric] approx[OF bounded_by_Nil this]
+  from this approx[OF bounded_by_Nil this]
   show ?thesis
     by auto
 qed
 
 lemma plain_floatarith_Sum\<^sub>e:
   "plain_floatarith n (Sum\<^sub>e f xs) \<longleftrightarrow> list_all (\<lambda>i. plain_floatarith n (f i)) xs"
   by (induction xs) (auto simp: zero_floatarith_def plus_floatarith_def)
 
 lemma sum_list'_float[simp]: "sum_list' p xs \<in> float"
   by (induction xs rule: rev_induct) (auto simp: sum_list'_def eucl_truncate_up_real_def)
 
 lemma tdev'_float[simp]: "tdev' p xs \<in> float"
   by (auto simp: tdev'_def)
 
 lemma
   fixes x y::real
   assumes "abs (x - y) \<le> e"
   obtains err where "x = y + err" "abs err \<le> e"
   using assms
   apply atomize_elim
   apply (rule exI[where x="x - y"])
   by (auto simp: abs_real_def)
 
 theorem power_aform_err:
   assumes "x \<in> aform_err e X"
   assumes floats[simp]: "fst (fst X) \<in> float" "snd X \<in> float"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "x ^ n \<in> aform_err e (power_aform_err p X n)"
 proof -
   consider "n = 0" | "n = 1" | "n \<ge> 2"
     by arith
   then show ?thesis
   proof cases
     case 1
     then show ?thesis by (auto simp: aform_err_def power_aform_err_def aform_val_def)
   next
     case 2
     then show ?thesis
       using assms
       by (auto simp: aform_err_def power_aform_err_def aform_val_def)
   next
     case n: 3
     define x0 where "x0 = (fst (fst X))"
     define xs where "xs = snd (fst X)"
     define xe where "xe = (snd X)"
     have [simp]: "x0 \<in> float" "xe \<in> float" using assms by (auto simp: x0_def xe_def)
   
     define xe' where "xe' = x - aform_val e (x0, xs)"
     from aform_errE[OF assms(1)]
     have xe': "\<bar>xe'\<bar> \<le> xe"
       by (auto simp: x0_def xs_def xe_def xe'_def)
     then have xe_nonneg: "0 \<le> xe"
       by (auto simp: )
-  
+
     define t where "t = tdev' p xs"
     have t: "tdev xs \<le> t" "t \<in> float" by (auto simp add: t_def tdev'_le)
     then have t_nonneg: "0 \<le> t" using tdev_nonneg[of xs] by arith
     note t_pdevs = abs_pdevs_val_le_tdev[OF e, THEN order_trans, OF t(1)]
-  
+
     have rewr1: "{..n} = (insert 0 (insert 1 {2..n}))" using n by auto
     have "x = (pdevs_val e xs + xe') + x0"
       by (simp add: xe'_def aform_val_def)
     also have "\<dots> ^ n = x0 ^ n + n * x0 ^ (n - Suc 0) * pdevs_val e xs +
       (n * xe' * x0 ^ (n - Suc 0) +
         (\<Sum>k = 2..n. real (n choose k) * (pdevs_val e xs + xe') ^ k * x0 ^ (n - k)))"
       (is "_ = _ + ?err")
       apply (subst binomial_ring)
       unfolding rewr1
       using n
       apply (simp add: algebra_simps)
       done
     also
-  
-    let ?ERR = "(Num (of_nat n) * Num (float_of xe) * Abs (Num (float_of x0)) ^\<^sub>e (n - 1) + 
+
+    let ?ERR = "(Num (of_nat n) * Num (float_of xe) * Abs (Num (float_of x0)) ^\<^sub>e (n - 1) +
           (Sum\<^sub>e (\<lambda>k. Num (of_nat (n choose k)) * Abs (Num (float_of x0)) ^\<^sub>e (n - k) *
             (Num (float_of xe) + Num (float_of t)) ^\<^sub>e k)
             [2..<Suc n]))"
-    define ERR where "ERR = snd (the (approx p ?ERR []))"
+    define err where "err = the (approx p ?ERR [])"
+    define ERR where "ERR = upper err"
     have ERR: "abs ?err \<le> ERR"
     proof -
       have err_aerr: "abs (?err) \<le> n * xe * abs x0 ^ (n - Suc 0) +
           (\<Sum>k = 2..n. real (n choose k) * (t + xe) ^ k * abs x0 ^ (n - k))"
         (is "_ \<le> ?aerr")
         by (auto simp: abs_mult power_abs intro!: sum_mono mult_mono power_mono xe'
             mult_nonneg_nonneg zero_le_power t_nonneg xe_nonneg add_nonneg_nonneg
             sum_abs[THEN order_trans] abs_triangle_ineq[THEN order_trans] add_mono t_pdevs)
       also
       have rewr: "{2 .. n} = {2 ..<Suc n}"
         using n
         by (auto simp: )
       have "plain_floatarith 0 ?ERR"
         by (auto simp add: zero_floatarith_def plain_floatarith_Sum\<^sub>e times_floatarith_def
             plus_floatarith_def intro!: list_allI)
       from plain_floatarith_approx[OF this, of p]
       have "ERR \<ge> ?aerr"
         using n
-        by (auto simp: ERR_def sum_list_distinct_conv_sum_set rewr t x0_def algebra_simps)
+        by (auto simp: set_of_eq err_def ERR_def sum_list_distinct_conv_sum_set rewr t x0_def
+            algebra_simps)
       finally show ?thesis .
     qed
-  
+
     let ?x0n = "Num (float_of x0) ^\<^sub>e n"
     define C where "C = the (approx p ?x0n [])"
     have "plain_floatarith 0 ?x0n" by simp
     from plain_floatarith_approx[OF this, of p]
-    have C: "x0 ^ n \<in> {fst C .. snd C}"
-      by (auto simp: C_def x0_def)
-    
+    have C: "x0 ^ n \<in> {lower C .. upper C}"
+      by (auto simp: C_def x0_def set_of_eq)
+
     define c where "c = fst (mid_err C)"
     define ce where "ce = snd (mid_err C)"
     define ce' where "ce' = x0 ^ n - c"
     have ce': "abs (ce') \<le> ce"
       using C
       by (auto simp: ce'_def c_def ce_def abs_diff_le_iff mid_err_def divide_simps)
     have "x0 ^ n = c + ce'" by (simp add: ce'_def)
     also
-  
+
     let ?NX = "(Num (of_nat n) * (Num (float_of x0) ^\<^sub>e (n - 1)))"
     define NX where "NX = the (approx p ?NX [])"
     have "plain_floatarith 0 ?NX" by (simp add: times_floatarith_def)
     from plain_floatarith_approx[OF this, of p]
-    have NX: "n * x0 ^ (n - 1) \<in> {fst NX .. snd NX}"
-      by (auto simp: NX_def x0_def)
-    
+    have NX: "n * x0 ^ (n - 1) \<in> {lower NX .. upper NX}"
+      by (auto simp: NX_def x0_def set_of_eq)
+
     define nx where "nx = fst (mid_err NX)"
     define nxe where "nxe = snd (mid_err NX)"
     define nx' where "nx' = n * x0 ^ (n - 1) - nx"
     define Ye where "Ye = truncate_up p (nxe * t)"
     have Ye: "Ye \<ge> nxe * t" by (auto simp: Ye_def truncate_up_le)
     have nx: "abs (nx') \<le> nxe" "0 \<le> nxe"
       using NX
       by (auto simp: nx_def nxe_def abs_diff_le_iff mid_err_def divide_simps nx'_def)
     have Ye: "abs (nx' * pdevs_val e xs) \<le> Ye"
       by (auto simp: Ye_def abs_mult intro!: truncate_up_le mult_mono nx t_pdevs)
     have "n * x0 ^ (n - Suc 0) = nx + nx'" by (simp add: nx'_def)
     also
-  
+
     define Y where "Y = scaleR_pdevs nx xs"
     have Y: "pdevs_val e Y = nx * pdevs_val e xs"
       by (simp add: Y_def)
     have "(nx + nx') * pdevs_val e xs = pdevs_val e Y + nx' * pdevs_val e xs"
       unfolding Y by (simp add: algebra_simps)
     also
-  
+
     define Y' where "Y' = fst (trunc_bound_pdevs p Y)"
     define Y_err where "Y_err = snd (trunc_bound_pdevs p Y)"
     have Y_err: "abs (- pdevs_val e (trunc_err_pdevs p Y)) \<le> Y_err"
       by (auto simp: Y_err_def trunc_bound_pdevs_def abs_pdevs_val_le_tdev' e)
     have "pdevs_val e Y = pdevs_val e Y' + - pdevs_val e (trunc_err_pdevs p Y)"
       by (simp add: Y'_def trunc_bound_pdevs_def pdevs_val_trunc_err_pdevs)
     finally
     have "\<bar>x ^ n - aform_val e (c, Y') \<bar> =
       \<bar>ce' + - pdevs_val e (trunc_err_pdevs p Y) + nx' * pdevs_val e xs + ?err\<bar>"
       by (simp add: algebra_simps aform_val_def)
     also have "\<dots> \<le> ce + Y_err + Ye + ERR"
       by (intro ERR abs_triangle_ineq[THEN order_trans] add_mono ce' Ye Y_err)
     also have "\<dots> \<le> sum_list' p [ce, Y_err, Ye, real_of_float ERR]"
       by (auto intro!: sum_list'_sum_list_le)
     finally show ?thesis
       using n
       by (intro aform_errI)
         (auto simp: power_aform_err_def c_def Y'_def C_def Y_def ERR_def x0_def nx_def xs_def NX_def
-          ce_def Y_err_def Ye_def xe_def nxe_def t_def Let_def split_beta')
+          ce_def Y_err_def Ye_def xe_def nxe_def t_def Let_def split_beta' set_of_eq err_def)
   qed
 qed
 
 definition [code_abbrev]: "is_float r \<longleftrightarrow> r \<in> float"
 lemma [code]: "is_float (real_of_float f) = True"
   by (auto simp: is_float_def)
 
 definition "powr_aform_err p X A = (
     if Inf_aform_err p X > 0 then do {
       L \<leftarrow> ln_aform_err p X;
       exp_aform_err p (mult_aform' p A L)
     }
-    else approx_bin p (bnds_powr p) X A)"
-
-lemma interval_extension_powr: "interval_extension2 (bnds_powr p) (powr)"
-  using bnds_powr[of _ _ p]
-  by (force simp: interval_extension2_def)
+    else approx_bin p (powr_float_interval p) X A)"
+
+lemma interval_extension_powr: "interval_extension2 (powr_float_interval p) (powr)"
+  using powr_float_interval_eqI[of p]
+  by (auto simp: interval_extension2_def)
 
 theorem powr_aform_err:
   assumes x: "x \<in> aform_err e X"
   assumes a: "a \<in> aform_err e A"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes Y: "powr_aform_err p X A = Some Y"
   shows "x powr a \<in> aform_err e Y"
 proof cases
   assume pos: "Inf_aform_err p X > 0"
   with Inf_Sup_aform_err[OF e, of X p] x
   have "x > 0" by auto
   then have "x powr a = exp (a * ln x)"
     by (simp add: powr_def)
   also
   from pos obtain L where L: "ln_aform_err p X = Some L"
     and E: "exp_aform_err p (mult_aform' p A L) = Some Y"
     using Y
     by (auto simp: bind_eq_Some_conv powr_aform_err_def)
   from ln_aform_err[OF x L e] have "ln x \<in> aform_err e L" .
   from mult_aform'E[OF e a this] have "a * ln x \<in> aform_err e (mult_aform' p A L)" .
   from exp_aform_err[OF this E e]
   have "exp (a * ln x) \<in> aform_err e Y" .
   finally show ?thesis .
 next
   from x a have xa: "x \<in> aform_err e (fst X, snd X)" "a \<in> aform_err e (fst A, snd A)" by simp_all
   assume "\<not> Inf_aform_err p X > 0"
-  then have "approx_bin p (bnds_powr p) (fst X, snd X) (fst A, snd A) = Some Y"
+  then have "approx_bin p (powr_float_interval p) (fst X, snd X) (fst A, snd A) = Some Y"
     using Y by (auto simp: powr_aform_err_def)
   from approx_binE[OF interval_extension_powr xa this e]
   show "x powr a \<in> aform_err e Y" .
 qed
 
 fun
   approx_floatarith :: "nat \<Rightarrow> floatarith \<Rightarrow> aform_err list \<Rightarrow> (aform_err) option"
 where
   "approx_floatarith p (Add a b) vs =
     do {
       a1 \<leftarrow> approx_floatarith p a vs;
       a2 \<leftarrow> approx_floatarith p b vs;
       Some (add_aform' p a1 a2)
     }"
 | "approx_floatarith p (Mult a b) vs =
     do {
       a1 \<leftarrow> approx_floatarith p a vs;
       a2 \<leftarrow> approx_floatarith p b vs;
       Some (mult_aform' p a1 a2)
     }"
 | "approx_floatarith p (Inverse a) vs =
     do {
       a \<leftarrow> approx_floatarith p a vs;
       inverse_aform_err p a
     }"
 | "approx_floatarith p (Minus a) vs =
     map_option (apfst uminus_aform) (approx_floatarith p a vs)"
 | "approx_floatarith p (Num f) vs =
     Some (num_aform (real_of_float f), 0)"
 | "approx_floatarith p (Var i) vs =
   (if i < length vs then Some (vs ! i) else None)"
 | "approx_floatarith p (Abs a) vs =
     do {
       r \<leftarrow> approx_floatarith p a vs;
-      let i = Inf_aform_err p r;
-      let s = Sup_aform_err p r;
+      let ivl = ivl_of_aform_err p r;
+      let i = lower ivl;
+      let s = upper ivl;
       if i > 0 then Some r
       else if s < 0 then Some (apfst uminus_aform r)
       else do {
-        Some (ivl_err 0 (max (- i) \<bar>s\<bar>))
+        Some (ivl_err (real_interval (abs_interval ivl)))
       }
     }"
 | "approx_floatarith p (Min a b) vs =
     do {
       a1 \<leftarrow> approx_floatarith p a vs;
       a2 \<leftarrow> approx_floatarith p b vs;
       Some (min_aform_err p a1 a2)
     }"
 | "approx_floatarith p (Max a b) vs =
     do {
       a1 \<leftarrow> approx_floatarith p a vs;
       a2 \<leftarrow> approx_floatarith p b vs;
       Some (max_aform_err p a1 a2)
     }"
 | "approx_floatarith p (Floor a) vs =
-    approx_un p (\<lambda>l u. Some (floor_fl l, floor_fl u)) (approx_floatarith p a vs)"
+    approx_un p (\<lambda>ivl. Some (floor_float_interval ivl)) (approx_floatarith p a vs)"
 | "approx_floatarith p (Cos a) vs =
     do {
       a \<leftarrow> approx_floatarith p a vs;
       cos_aform_err p a
     }"
-| "approx_floatarith p Pi vs = Some (ivl_err (lb_pi p) (ub_pi p))"
+| "approx_floatarith p Pi vs = Some (ivl_err (real_interval (pi_float_interval p)))"
 | "approx_floatarith p (Sqrt a) vs =
     do {
       a \<leftarrow> approx_floatarith p a vs;
       sqrt_aform_err p a
     }"
 | "approx_floatarith p (Ln a) vs =
     do {
       a \<leftarrow> approx_floatarith p a vs;
       ln_aform_err p a
     }"
 | "approx_floatarith p (Arctan a) vs =
     do {
       a \<leftarrow> approx_floatarith p a vs;
       arctan_aform_err p a
     }"
 | "approx_floatarith p (Exp a) vs =
     do {
       a \<leftarrow> approx_floatarith p a vs;
       exp_aform_err p a
     }"
 | "approx_floatarith p (Power a n) vs =
     do {
       ((a, as), e) \<leftarrow> approx_floatarith p a vs;
       if is_float a \<and> is_float e then Some (power_aform_err p ((a, as), e) n)
       else None
     }"
 | "approx_floatarith p (Powr a b) vs =
     do {
       ae1 \<leftarrow> approx_floatarith p a vs;
       ae2 \<leftarrow> approx_floatarith p b vs;
       powr_aform_err p ae1 ae2
     }"
 
 lemma uminus_aform_uminus_aform[simp]: "uminus_aform (uminus_aform z) = (z::'a::real_vector aform)"
   by (auto intro!: prod_eqI pdevs_eqI simp: uminus_aform_def)
 
-lemma interval_extension_cos: "interval_extension1 (\<lambda>l u. Some (bnds_cos p l u)) cos"
-  using bnds_cos
-  by (auto simp: interval_extension1_def) metis+
-
-lemma interval_extension_power: "interval_extension1 (\<lambda>l u. Some (float_power_bnds p n l u)) (\<lambda>x. x ^ n)"
-  using bnds_power
-  by (auto simp: interval_extension1_def bind_eq_Some_conv; metis)
-
-lemma interval_extension_ln: "interval_extension1 (\<lambda>l u. do {l' \<leftarrow> lb_ln p l; u' \<leftarrow> ub_ln p u; Some (l', u')}) ln"
-  using bnds_ln[of _ _ p]
-  by (auto simp del: lb_ln.simps ub_ln.simps simp: interval_extension1_def bind_eq_Some_conv; metis)
-
-lemma interval_extension_arctan: "interval_extension1 (\<lambda>l u. Some (lb_arctan p l, ub_arctan p u)) arctan"
-  using bnds_arctan
-  by (auto simp del: lb_arctan.simps ub_arctan.simps simp: interval_extension1_def; metis)
-
-lemma interval_extension_exp: "interval_extension1 (\<lambda>l u. Some (lb_exp p l, ub_exp p u)) exp"
-  using bnds_exp
-  by (auto simp: interval_extension1_def; metis)
-
-lemma interval_extension_sqrt: "interval_extension1 (\<lambda>l u. Some (lb_sqrt p l, ub_sqrt p u)) sqrt"
-  using bnds_sqrt
-  by (auto simp: interval_extension1_def; metis)
-
-lemma interval_extension_floor: "interval_extension1 (\<lambda>l u. Some (floor_fl l, floor_fl u)) floor"
-  by (auto simp: interval_extension1_def floor_fl.rep_eq floor_mono)
-
 lemma degree_aform_inverse_aform':
   "degree_aform X \<le> n \<Longrightarrow> degree_aform (fst (inverse_aform' p X)) \<le> n"
   unfolding inverse_aform'_def
   by (auto simp: Let_def trunc_bound_pdevs_def intro!: degree_pdev_upd_le degree_trunc_pdevs_le)
 
 lemma degree_aform_inverse_aform:
   assumes "inverse_aform p X = Some Y"
   assumes "degree_aform X \<le> n"
   shows "degree_aform (fst Y) \<le> n"
-  using assms 
+  using assms
   by (auto simp: inverse_aform_def Let_def degree_aform_inverse_aform' split: if_splits)
 
-lemma degree_aform_ivl_err[simp]: "degree_aform (fst (ivl_err a b)) = 0"
+lemma degree_aform_ivl_err[simp]: "degree_aform (fst (ivl_err a)) = 0"
   by (auto simp: ivl_err_def)
 
 lemma degree_aform_approx_bin:
   assumes "approx_bin p ivl X Y = Some Z"
   assumes "degree_aform (fst X) \<le> m"
   assumes "degree_aform (fst Y) \<le> m"
   shows "degree_aform (fst Z) \<le> m"
   using assms
   by (auto simp: approx_bin_def bind_eq_Some_conv Basis_list_real_def
       intro!: order_trans[OF degree_aform_independent_from]
       order_trans[OF degree_aform_of_ivl])
 
 lemma degree_aform_approx_un:
   assumes "approx_un p ivl X = Some Y"
   assumes "case X of None \<Rightarrow> True | Some X \<Rightarrow> degree_aform (fst X) \<le> d1"
   shows "degree_aform (fst Y) \<le> d1"
   using assms
   by (auto simp: approx_un_def bind_eq_Some_conv Basis_list_real_def
       intro!: order_trans[OF degree_aform_independent_from]
       order_trans[OF degree_aform_of_ivl])
 
 lemma degree_aform_num_aform[simp]: "degree_aform (num_aform x) = 0"
   by (auto simp: num_aform_def)
 
 lemma degree_max_aform:
   assumes "degree_aform_err x \<le> d"
   assumes "degree_aform_err y \<le> d"
   shows "degree_aform_err (max_aform_err p x y) \<le> d"
   using assms
   by (auto simp: max_aform_err_def Let_def Basis_list_real_def split: prod.splits
       intro!: order_trans[OF degree_aform_independent_from] order_trans[OF degree_aform_of_ivl])
 
 lemma degree_min_aform:
   assumes "degree_aform_err x \<le> d"
   assumes "degree_aform_err y \<le> d"
   shows "degree_aform_err ((min_aform_err p x y)) \<le> d"
   using assms
   by (auto simp: min_aform_err_def Let_def Basis_list_real_def split: prod.splits
       intro!: order_trans[OF degree_aform_independent_from] order_trans[OF degree_aform_of_ivl])
 
 lemma degree_aform_acc_err:
   "degree_aform (fst (acc_err p X e)) \<le> d"
   if "degree_aform (fst X) \<le> d"
   using that by (auto simp: acc_err_def)
 
 lemma degree_pdev_upd_degree:
   assumes "degree b \<le> Suc n"
   assumes "degree b \<le> Suc (degree_aform_err X)"
   assumes "degree_aform_err X \<le> n"
   shows "degree (pdev_upd b (degree_aform_err X) 0) \<le> n"
   using assms
   by (auto intro!: degree_le)
 
 lemma degree_aform_err_inverse_aform_err:
   assumes "inverse_aform_err p X = Some Y"
   assumes "degree_aform_err X \<le> n"
   shows "degree_aform_err Y \<le> n"
   using assms
   apply (auto simp: inverse_aform_err_def bind_eq_Some_conv aform_to_aform_err_def
       acc_err_def map_aform_err_def
       aform_err_to_aform_def
       intro!: degree_aform_acc_err)
   apply (rule degree_pdev_upd_degree)
     apply (auto dest!: degree_aform_inverse_aform)
   apply (meson degree_pdev_upd_le nat_le_linear not_less_eq_eq order_trans)
   apply (meson degree_pdev_upd_le nat_le_linear not_less_eq_eq order_trans)
   done
 
 lemma degree_aform_err_affine_unop:
   "degree_aform_err (affine_unop p a b d X) \<le> n"
   if "degree_aform_err X \<le> n"
   using that
   by (auto simp: affine_unop_def trunc_bound_pdevs_def degree_trunc_pdevs_le split: prod.splits)
 
 
 lemma degree_aform_err_min_range_mono:
   assumes "min_range_mono p F D l u X = Some Y"
   assumes "degree_aform_err X \<le> n"
   shows "degree_aform_err Y \<le> n"
   using assms
   by (auto simp: min_range_mono_def bind_eq_Some_conv aform_to_aform_err_def
       acc_err_def map_aform_err_def mid_err_def range_reduce_aform_err_def
       aform_err_to_aform_def Let_def split: if_splits prod.splits
       intro!: degree_aform_err_affine_unop)
 
 lemma degree_aform_err_min_range_antimono:
   assumes "min_range_antimono p F D l u X = Some Y"
   assumes "degree_aform_err X \<le> n"
   shows "degree_aform_err Y \<le> n"
   using assms
   by (auto simp: min_range_antimono_def bind_eq_Some_conv aform_to_aform_err_def
       acc_err_def map_aform_err_def mid_err_def range_reduce_aform_err_def
       aform_err_to_aform_def Let_def split: if_splits prod.splits
       intro!: degree_aform_err_affine_unop)
 
 lemma degree_aform_err_cos_aform_err:
   assumes "cos_aform_err p X = Some Y"
   assumes "degree_aform_err X \<le> n"
   shows "degree_aform_err Y \<le> n"
   using assms
   apply (auto simp: cos_aform_err_def bind_eq_Some_conv aform_to_aform_err_def
       acc_err_def map_aform_err_def mid_err_def range_reduce_aform_err_def
       aform_err_to_aform_def Let_def split: if_splits prod.splits
       intro!: degree_aform_err_affine_unop)
   apply (metis degree_aform_err_add_aform' degree_aform_err_min_range_antimono degree_aform_ivl_err zero_le)
   apply (metis degree_aform_err_add_aform' degree_aform_err_min_range_mono degree_aform_ivl_err zero_le)
   apply (metis degree_aform_err_add_aform' degree_aform_err_min_range_mono degree_aform_ivl_err zero_le)
   apply (metis degree_aform_err_add_aform' degree_aform_err_min_range_antimono degree_aform_ivl_err zero_le)
   apply (metis degree_aform_err_add_aform' degree_aform_err_min_range_antimono degree_aform_ivl_err zero_le)
   apply (metis degree_aform_err_add_aform' degree_aform_err_min_range_antimono degree_aform_ivl_err zero_le)
   done
 
 lemma degree_aform_err_sqrt_aform_err:
   assumes "sqrt_aform_err p X = Some Y"
   assumes "degree_aform_err X \<le> n"
   shows "degree_aform_err Y \<le> n"
   using assms
   apply (auto simp: sqrt_aform_err_def Let_def split: if_splits)
   apply (metis degree_aform_err_min_range_mono)
   done
 
 lemma degree_aform_err_arctan_aform_err:
   assumes "arctan_aform_err p X = Some Y"
   assumes "degree_aform_err X \<le> n"
   shows "degree_aform_err Y \<le> n"
   using assms
   apply (auto simp: arctan_aform_err_def bind_eq_Some_conv)
   apply (metis degree_aform_err_min_range_mono)
   done
 
 lemma degree_aform_err_exp_aform_err:
   assumes "exp_aform_err p X = Some Y"
   assumes "degree_aform_err X \<le> n"
   shows "degree_aform_err Y \<le> n"
   using assms
   apply (auto simp: exp_aform_err_def bind_eq_Some_conv)
   apply (metis degree_aform_err_min_range_mono)
   done
 
 lemma degree_aform_err_ln_aform_err:
   assumes "ln_aform_err p X = Some Y"
   assumes "degree_aform_err X \<le> n"
   shows "degree_aform_err Y \<le> n"
   using assms
   apply (auto simp: ln_aform_err_def Let_def split: if_splits)
   apply (metis degree_aform_err_add_aform' degree_aform_err_min_range_mono degree_aform_ivl_err zero_le)
   done
 
 lemma degree_aform_err_power_aform_err:
   assumes "degree_aform_err X \<le> n"
   shows "degree_aform_err (power_aform_err p X m) \<le> n"
   using assms
   by (auto simp: power_aform_err_def Let_def trunc_bound_pdevs_def degree_trunc_pdevs_le
       split: if_splits prod.splits)
 
 lemma degree_aform_err_powr_aform_err:
   assumes "powr_aform_err p X Z = Some Y"
   assumes "degree_aform_err X \<le> n"
   assumes "degree_aform_err Z \<le> n"
   shows "degree_aform_err Y \<le> n"
   using assms
   apply (auto simp: powr_aform_err_def bind_eq_Some_conv degree_aform_mult_aform'
       dest!: degree_aform_err_ln_aform_err degree_aform_err_exp_aform_err
       split: if_splits)
   apply (metis degree_aform_mult_aform' fst_conv order_trans snd_conv)
   apply (rule degree_aform_approx_bin, assumption)
   apply auto
   done
 
 lemma approx_floatarith_degree:
   assumes "approx_floatarith p ra VS = Some X"
   assumes "\<And>V. V \<in> set VS \<Longrightarrow> degree_aform_err V \<le> d"
   shows "degree_aform_err X \<le> d"
   using assms
 proof (induction ra arbitrary: X)
   case (Add ra1 ra2)
   then show ?case 
     by (auto simp: bind_eq_Some_conv intro!: degree_aform_err_add_aform' degree_aform_acc_err)
 next
   case (Minus ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv)
 next
   case (Mult ra1 ra2)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: degree_aform_mult_aform' degree_aform_acc_err)
 next
   case (Inverse ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro: degree_aform_err_inverse_aform_err)
 next
   case (Cos ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro: degree_aform_err_cos_aform_err)
 next
   case (Arctan ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro: degree_aform_err_arctan_aform_err)
 next
   case (Abs ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv Let_def Basis_list_real_def
         intro!: order_trans[OF degree_aform_independent_from] order_trans[OF degree_aform_of_ivl]
           degree_aform_acc_err
         split: if_splits) 
 next
   case (Max ra1 ra2)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: degree_max_aform degree_aform_acc_err)
 next
   case (Min ra1 ra2)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: degree_min_aform degree_aform_acc_err)
 next
   case Pi
   then show ?case
     by (auto simp: bind_eq_Some_conv Let_def Basis_list_real_def
         intro!: order_trans[OF degree_aform_independent_from] order_trans[OF degree_aform_of_ivl]
           degree_aform_acc_err
         split: if_splits)
 next
   case (Sqrt ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro: degree_aform_err_sqrt_aform_err)
 next
   case (Exp ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro: degree_aform_err_exp_aform_err)
 next
   case (Powr ra1 ra2)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro: degree_aform_err_powr_aform_err)
 next
   case (Ln ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro: degree_aform_err_ln_aform_err)
 next
   case (Power ra x2a)
   then show ?case
     by (auto intro!: degree_aform_err_power_aform_err simp: bind_eq_Some_conv split: if_splits)
 next
   case (Floor ra)
   then show ?case
     apply -
     by (rule degree_aform_approx_un) (auto split: option.splits)
 next
   case (Var x)
   then show ?case
     by (auto simp: max_def split: if_splits)
       (use Var.prems(2) nat_le_linear nth_mem order_trans in blast)+
 next
   case (Num x)
   then show ?case by auto
 qed
 
 definition affine_extension2 where
   "affine_extension2 fnctn_aff fnctn \<longleftrightarrow> (
     \<forall>d a1 a2 X e2.
       fnctn_aff d a1 a2 = Some X \<longrightarrow>
       e2 \<in> UNIV \<rightarrow> {- 1..1} \<longrightarrow>
       d \<ge> degree_aform a1 \<longrightarrow>
       d \<ge> degree_aform a2 \<longrightarrow>
       (\<exists>e3 \<in> UNIV \<rightarrow> {- 1..1}.
         (fnctn (aform_val e2 a1) (aform_val e2 a2) = aform_val e3 X \<and>
           (\<forall>n. n < d \<longrightarrow> e3 n = e2 n) \<and>
           aform_val e2 a1 = aform_val e3 a1 \<and> aform_val e2 a2 = aform_val e3 a2)))"
 
 lemma affine_extension2E:
   assumes "affine_extension2 fnctn_aff fnctn"
   assumes "fnctn_aff d a1 a2 = Some X"
     "e \<in> UNIV \<rightarrow> {- 1..1}"
     "d \<ge> degree_aform a1"
     "d \<ge> degree_aform a2"
   obtains e' where "e' \<in> UNIV \<rightarrow> {- 1..1}"
     "fnctn (aform_val e a1) (aform_val e a2) = aform_val e' X"
     "\<And>n. n < d \<Longrightarrow> e' n = e n"
     "aform_val e a1 = aform_val e' a1"
     "aform_val e a2 = aform_val e' a2"
   using assms
   unfolding affine_extension2_def
   by metis
 
 lemma aform_err_uminus_aform:
   "- x \<in> aform_err e (uminus_aform X, ba)"
   if "e \<in> UNIV \<rightarrow> {-1 .. 1}" "x \<in> aform_err e (X, ba)"
   using that by (auto simp: aform_err_def)
 
 definition "aforms_err e (xs::aform_err list) = listset (map (aform_err e) xs)"
 
 lemma aforms_err_Nil[simp]: "aforms_err e [] = {[]}"
   and aforms_err_Cons: "aforms_err e (x#xs) = set_Cons (aform_err e x) (aforms_err e xs)"
   by (auto simp: aforms_err_def)
 
 lemma in_set_ConsI: "a#b \<in> set_Cons A B"
   if "a \<in> A" and "b \<in> B"
   using that
   by (auto simp: set_Cons_def)
 
 lemma mem_aforms_err_Cons_iff[simp]: "x#xs \<in> aforms_err e (X#XS) \<longleftrightarrow> x \<in> aform_err e X \<and> xs \<in> aforms_err e XS"
   by (auto simp: aforms_err_Cons set_Cons_def)
 
 lemma mem_aforms_err_Cons_iff_Ex_conv: "x \<in> aforms_err e (X#XS) \<longleftrightarrow> (\<exists>y ys. x = y#ys \<and> y \<in> aform_err e X \<and> ys \<in> aforms_err e XS)"
   by (auto simp: aforms_err_Cons set_Cons_def)
 
 lemma listset_Cons_mem_conv:
   "a # vs \<in> listset AVS \<longleftrightarrow> (\<exists>A VS. AVS = A # VS \<and> a \<in> A \<and> vs \<in> listset VS)"
   by (induction AVS) (auto simp: set_Cons_def)
 
 lemma listset_Nil_mem_conv[simp]:
   "[] \<in> listset AVS \<longleftrightarrow> AVS = []"
   by (induction AVS) (auto simp: set_Cons_def)
 
 lemma listset_nthD: "vs \<in> listset VS \<Longrightarrow> i < length vs \<Longrightarrow> vs ! i \<in> VS ! i"
   by (induction vs arbitrary: VS i)
      (auto simp: nth_Cons listset_Cons_mem_conv split: nat.splits)
 
 lemma length_listsetD:
   "vs \<in> listset VS \<Longrightarrow> length vs = length VS"
   by (induction vs arbitrary: VS) (auto simp: listset_Cons_mem_conv)
 
 lemma length_aforms_errD:
   "vs \<in> aforms_err e VS \<Longrightarrow> length vs = length VS"
   by (auto simp: aforms_err_def length_listsetD)
 
 lemma nth_aforms_errI:
   "vs ! i \<in> aform_err e (VS ! i)"
   if "vs \<in> aforms_err e VS" "i < length vs"
   using that
   unfolding aforms_err_def
   apply -
   apply (frule listset_nthD, assumption)
   by (auto simp: aforms_err_def length_listsetD )
 
 lemma eucl_truncate_down_float[simp]: "eucl_truncate_down p x \<in> float"
   by (auto simp: eucl_truncate_down_def)
 
 lemma eucl_truncate_up_float[simp]: "eucl_truncate_up p x \<in> float"
   by (auto simp: eucl_truncate_up_def)
 
 lemma trunc_bound_eucl_float[simp]: "fst (trunc_bound_eucl p x) \<in> float"
   "snd (trunc_bound_eucl p x) \<in> float"
   by (auto simp: trunc_bound_eucl_def Let_def)
 
 lemma add_aform'_float:
   "add_aform' p x y = ((a, b), ba) \<Longrightarrow> a \<in> float"
   "add_aform' p x y = ((a, b), ba) \<Longrightarrow> ba \<in> float"
   by (auto simp: add_aform'_def Let_def)
 
 lemma uminus_aform_float: "uminus_aform (aa, bb) = (a, b) \<Longrightarrow> aa \<in> float \<Longrightarrow> a \<in> float"
   by (auto simp: uminus_aform_def)
 
 lemma mult_aform'_float: "mult_aform' p x y = ((a, b), ba) \<Longrightarrow> a \<in> float"
    "mult_aform' p x y = ((a, b), ba) \<Longrightarrow> ba \<in> float"
   by (auto simp: mult_aform'_def Let_def split_beta')
 
 lemma inverse_aform'_float: "inverse_aform' p x = ((a, bb), baa) \<Longrightarrow> a \<in> float"
   using [[linarith_split_limit=256]]
   by (auto simp: inverse_aform'_def Let_def)
 
 lemma inverse_aform_float:
   "inverse_aform p x = Some ((a, bb), baa) \<Longrightarrow> a \<in> float"
   by (auto simp: inverse_aform_def Let_def apfst_def map_prod_def uminus_aform_def
       inverse_aform'_float
       split: if_splits prod.splits)
 
 lemma inverse_aform_err_float: "inverse_aform_err p x = Some ((a, b), ba) \<Longrightarrow> a \<in> float"
    "inverse_aform_err p x = Some ((a, b), ba) \<Longrightarrow> ba \<in> float"
   by (auto simp: inverse_aform_err_def map_aform_err_def acc_err_def bind_eq_Some_conv
       aform_err_to_aform_def aform_to_aform_err_def inverse_aform_float)
 
 lemma affine_unop_float:
   "affine_unop p asdf aaa bba h = ((a, b), ba) \<Longrightarrow> a \<in> float"
   "affine_unop p asdf aaa bba h = ((a, b), ba) \<Longrightarrow> ba \<in> float"
   by (auto simp: affine_unop_def trunc_bound_eucl_def Let_def split: prod.splits)
 
 lemma min_range_antimono_float:
   "min_range_antimono p f f' i g h = Some ((a, b), ba) \<Longrightarrow> a \<in> float"
   "min_range_antimono p f f' i g h = Some ((a, b), ba) \<Longrightarrow> ba \<in> float"
   by (auto simp: min_range_antimono_def Let_def bind_eq_Some_conv mid_err_def
       affine_unop_float split: prod.splits)
-  
+
 lemma min_range_mono_float:
   "min_range_mono p f f' i g h = Some ((a, b), ba) \<Longrightarrow> a \<in> float"
   "min_range_mono p f f' i g h = Some ((a, b), ba) \<Longrightarrow> ba \<in> float"
   by (auto simp: min_range_mono_def Let_def bind_eq_Some_conv mid_err_def
       affine_unop_float split: prod.splits)
 
-lemma ivl_err_float:
-  assumes "ivl_err x y = ((a, b), ba)" "x \<in> float" "y \<in> float" 
-  shows "a \<in> float" "ba \<in> float"
-proof -
-  from assms(1) have "a = (x + y) / 2" "ba = (y - x) / 2"
-    by (auto simp: ivl_err_def)
-  moreover have "(x + y) / 2 \<in> float" "(y - x) / 2 \<in> float"
-    using assms
-    by (auto intro!: )
-  ultimately show "a \<in> float" "ba \<in> float" by blast+
-qed
-
 lemma in_float_timesI: "a \<in> float" if "b = a * 2" "b \<in> float"
 proof -
   from that have "a = b / 2" by simp
   also have "\<dots> \<in> float" using that(2) by auto
   finally show ?thesis .
 qed
 
+lemma interval_extension_floor: "interval_extension1 (\<lambda>ivl. Some (floor_float_interval ivl)) floor"
+  by (auto simp: interval_extension1_def floor_float_intervalI)
+
 lemma approx_floatarith_Elem:
   assumes "approx_floatarith p ra VS = Some X"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes "vs \<in> aforms_err e VS"
   shows "interpret_floatarith ra vs \<in> aform_err e X"
   using assms(1)
 proof (induction ra arbitrary: X)
   case (Add ra1 ra2)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: add_aform'[OF e])
 next
   case (Minus ra)
   then show ?case
     by (auto intro!: aform_err_uminus_aform[OF e])
 next
   case (Mult ra1 ra2)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: mult_aform'E[OF e])
 next
   case (Inverse ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: inverse_aform_err[OF e])
 next
   case (Cos ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: cos_aform_err[OF _ _ e])
 next
   case (Arctan ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: arctan_aform_err[OF _ _ e])
 next
   case (Abs fa)
   from Abs.prems
   obtain a where a: "approx_floatarith p fa VS = Some a"
     by (auto simp add: Let_def bind_eq_Some_conv)
   from Abs.IH[OF a]
   have mem: "interpret_floatarith fa vs \<in> aform_err e a"
     by auto
-  let ?i = "Inf_aform_err p a"
-  let ?s = "Sup_aform_err p a"
+  then have mem': "-interpret_floatarith fa vs \<in> aform_err e (apfst uminus_aform a)"
+    by (auto simp: aform_err_def)
+
+  let ?i = "lower (ivl_of_aform_err p a)"
+  let ?s = "upper (ivl_of_aform_err p a)"
   consider "?i > 0" | "?i \<le> 0" "?s < 0" | "?i \<le> 0" "?s \<ge> 0"
     by arith
   then show ?case
   proof cases
     case hyps: 1
     then show ?thesis
-      using Abs.prems mem Inf_Sup_aform_err[OF e, of a p]
-      by (auto simp: a)
+      using Abs.prems mem ivl_of_aform_err[OF e mem, of p]
+      by (auto simp: a set_of_eq)
   next
     case hyps: 2
     then show ?thesis
-      using Abs.prems mem Inf_Sup_aform_err[OF e, of "apfst uminus_aform a" p]
-          Inf_Sup_aform_err[OF e, of "a" p]
-      by (cases a) (auto simp: a abs_real_def intro!: aform_err_uminus_aform[OF e])
+      using Abs.prems mem ivl_of_aform_err[OF e mem, of p]
+          ivl_of_aform_err[OF e mem', of p]
+      by (cases a) (auto simp: a abs_real_def set_of_eq intro!: aform_err_uminus_aform[OF e])
   next
     case hyps: 3
     then show ?thesis
-      using Abs.prems mem Inf_Sup_aform_err[OF e, of a p]
-      by (auto simp: a abs_real_def max_def Let_def)
+      using Abs.prems mem ivl_of_aform_err[OF e mem, of p]
+      by (auto simp: a abs_real_def max_def Let_def set_of_eq)
   qed
 next
   case (Max ra1 ra2)
   from Max.prems
   obtain a b where a: "approx_floatarith p ra1 VS = Some a"
     and b: "approx_floatarith p ra2 VS = Some b"
     by (auto simp add: Let_def bind_eq_Some_conv)
   from Max.IH(1)[OF a] Max.IH(2)[OF b]
   have mem: "interpret_floatarith ra1 vs \<in> aform_err e a"
     "interpret_floatarith ra2 vs \<in> aform_err e b"
     by auto
-  let ?ia = "Inf_aform_err p a"
-  let ?sa = "Sup_aform_err p a"
-  let ?ib = "Inf_aform_err p b"
-  let ?sb = "Sup_aform_err p b"
+  let ?ia = "lower (ivl_of_aform_err p a)"
+  let ?sa = "upper (ivl_of_aform_err p a)"
+  let ?ib = "lower (ivl_of_aform_err p b)"
+  let ?sb = "upper (ivl_of_aform_err p b)"
   consider "?sa < ?ib" | "?sa \<ge> ?ib" "?sb < ?ia" | "?sa \<ge> ?ib" "?sb \<ge> ?ia"
     by arith
   then show ?case
-  proof cases
-    case hyps: 1
-    then show ?thesis
-      using Max.prems mem Inf_Sup_aform_err[OF e, of a p] Inf_Sup_aform_err[OF e, of b p]
-      by (force simp: a b max_def max_aform_err_def)
-  next
-    case hyps: 2
-    then show ?thesis
-      using Max.prems mem Inf_Sup_aform_err[OF e, of a p] Inf_Sup_aform_err[OF e, of b p]
-          Inf_Sup_aform_err[OF e, of "a" p]
-      by (force simp: a b max_def max_aform_err_def)
-  next
-    case hyps: 3
-    then show ?thesis
-      using Max.prems mem
-      apply (simp add: a b max_aform_err_def)
-      apply auto
-      using Inf_Sup_aform_err[OF e, of a p] Inf_Sup_aform_err[OF e, of b p]
-      by (auto simp: max_def)
-  qed
+    using Max.prems mem ivl_of_aform_err[OF e mem(1), of p] ivl_of_aform_err[OF e mem(2), of p]
+    by cases (auto simp: a b max_def max_aform_err_def set_of_eq)
 next
   case (Min ra1 ra2)
   from Min.prems
   obtain a b where a: "approx_floatarith p ra1 VS = Some a"
     and b: "approx_floatarith p ra2 VS = Some b"
     by (auto simp add: Let_def bind_eq_Some_conv)
   from Min.IH(1)[OF a] Min.IH(2)[OF b]
   have mem: "interpret_floatarith ra1 vs \<in> aform_err e a"
     "interpret_floatarith ra2 vs \<in> aform_err e b"
     by auto
-  let ?ia = "Inf_aform_err p a"
-  let ?sa = "Sup_aform_err p a"
-  let ?ib = "Inf_aform_err p b"
-  let ?sb = "Sup_aform_err p b"
+  let ?ia = "lower (ivl_of_aform_err p a)"
+  let ?sa = "upper (ivl_of_aform_err p a)"
+  let ?ib = "lower (ivl_of_aform_err p b)"
+  let ?sb = "upper (ivl_of_aform_err p b)"
   consider "?sa < ?ib" | "?sa \<ge> ?ib" "?sb < ?ia" | "?sa \<ge> ?ib" "?sb \<ge> ?ia"
     by arith
   then show ?case
-  proof cases
-    case hyps: 1
-    then show ?thesis
-      using Min.prems mem Inf_Sup_aform_err[OF e, of a p] Inf_Sup_aform_err[OF e, of b p]
-      by (force simp: a b min_def min_aform_err_def)
-  next
-    case hyps: 2
-    then show ?thesis
-      using Min.prems mem Inf_Sup_aform_err[OF e, of a p] Inf_Sup_aform_err[OF e, of b p]
-        Inf_Sup_aform_err[OF e, of "a" p]
-      by (force simp: a b min_def min_aform_err_def)
-  next
-    case hyps: 3
-    then show ?thesis
-      using Min.prems mem
-      apply (simp add: a b min_aform_err_def)
-      apply auto
-      using Inf_Sup_aform_err[OF e, of a p] Inf_Sup_aform_err[OF e, of b p]
-      by (auto simp: min_def)
-  qed
+    using Min.prems mem ivl_of_aform_err[OF e mem(1), of p] ivl_of_aform_err[OF e mem(2), of p]
+    by cases (auto simp: a b min_def min_aform_err_def set_of_eq)
 next
   case Pi
-  then show ?case using pi_boundaries
+  then show ?case using pi_float_interval
     by (auto simp: )
 next
   case (Sqrt ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: sqrt_aform_err[OF _ _ e])
 next
   case (Exp ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: exp_aform_err[OF _ _ e])
 next
   case (Powr ra1 ra2)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: powr_aform_err[OF _ _ e])
 next
   case (Ln ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: ln_aform_err[OF _ _ e])
 next
   case (Power ra x2a)
   then show ?case
     by (auto simp: bind_eq_Some_conv is_float_def
         intro!: power_aform_err[OF _ _ _ e] split: if_splits)
 next
   case (Floor ra)
   then show ?case
     by (auto simp: bind_eq_Some_conv intro!: approx_unE[OF interval_extension_floor e]
         split: option.splits)
 next
   case (Var x)
   then show ?case
     using assms(3)
     apply -
     apply (frule length_aforms_errD)
     by (auto split: if_splits simp: aform_err_def dest!: nth_aforms_errI[where i=x])
 next
   case (Num x)
   then show ?case
     by (auto split: if_splits simp: aform_err_def num_aform_def aform_val_def)
 qed
 
 primrec approx_floatariths_aformerr ::
   "nat \<Rightarrow> floatarith list \<Rightarrow> aform_err list \<Rightarrow> aform_err list option"
   where
     "approx_floatariths_aformerr _ [] _ = Some []"
   | "approx_floatariths_aformerr p (a#bs) vs =
       do {
         a \<leftarrow> approx_floatarith p a vs;
         r \<leftarrow> approx_floatariths_aformerr p bs vs;
         Some (a#r)
       }"
 
 
 lemma approx_floatariths_Elem:
   assumes "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes "approx_floatariths_aformerr p ra VS = Some X"
   assumes "vs \<in> aforms_err e VS"
   shows "interpret_floatariths ra vs \<in> aforms_err e X"
   using assms(2)
 proof (induction ra arbitrary: X)
   case Nil then show ?case by simp
 next
   case (Cons ra ras)
   from Cons.prems
   obtain a r where a: "approx_floatarith p ra VS = Some a"
     and r: "approx_floatariths_aformerr p ras VS = Some r"
     and X: "X = a # r"
     by (auto simp: bind_eq_Some_conv)
   then show ?case
     using assms(1)
     by (auto simp: X Cons.IH intro!: approx_floatarith_Elem assms)
 qed
 
 lemma fold_max_mono:
   fixes x::"'a::linorder"
   shows "x \<le> y \<Longrightarrow> fold max zs x \<le> fold max zs y"
   by (induct zs arbitrary: x y) (auto intro!: Cons simp: max_def)
 
 lemma fold_max_le_self:
   fixes y::"'a::linorder"
   shows "y \<le> fold max ys y"
   by (induct ys) (auto intro: order_trans[OF _ fold_max_mono])
 
 lemma fold_max_le:
   fixes x::"'a::linorder"
   shows "x \<in> set xs \<Longrightarrow> x \<le> fold max xs z"
   by (induct xs arbitrary: x z) (auto intro: order_trans[OF _ fold_max_le_self])
 
 abbreviation "degree_aforms_err \<equiv> degrees o map (snd o fst)"
 
 definition "aforms_err_to_aforms d xs =
   (map (\<lambda>(d, x). aform_err_to_aform x d) (zip [d..<d + length xs] xs))"
 
 lemma aform_vals_empty[simp]: "aform_vals e' [] = []"
   by (auto simp: aform_vals_def)
 lemma aforms_err_to_aforms_Nil[simp]: "(aforms_err_to_aforms n []) = []"
   by (auto simp: aforms_err_to_aforms_def)
 
 lemma aforms_err_to_aforms_Cons[simp]:
   "aforms_err_to_aforms n (X # XS) = aform_err_to_aform X n # aforms_err_to_aforms (Suc n) XS"
   by (auto simp: aforms_err_to_aforms_def not_le nth_append nth_Cons 
       intro!: nth_equalityI split: nat.splits)
 
 lemma degree_aform_err_to_aform_le:
   "degree_aform (aform_err_to_aform X n) \<le> max (degree_aform_err X) (Suc n)"
   by (auto simp: aform_err_to_aform_def intro!: degree_le)
 
 lemma less_degree_aform_aform_err_to_aformD: "i < degree_aform (aform_err_to_aform X n) \<Longrightarrow> i < max (Suc n) (degree_aform_err X)"
   using degree_aform_err_to_aform_le[of X n] by auto
 
 lemma pdevs_domain_aform_err_to_aform:
   "pdevs_domain (snd (aform_err_to_aform X n)) = pdevs_domain (snd (fst X)) \<union> (if snd X = 0 then {} else {n})"
   if "n \<ge> degree_aform_err X"
   using that
   by (auto simp: aform_err_to_aform_def split: if_splits)
 
 lemma length_aforms_err_to_aforms[simp]: "length (aforms_err_to_aforms i XS) = length XS"
   by (auto simp: aforms_err_to_aforms_def)
 
 lemma aforms_err_to_aforms_ex:
   assumes X: "x \<in> aforms_err e X"
   assumes deg: "degree_aforms_err X \<le> n"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   shows "\<exists>e'\<in> UNIV \<rightarrow> {-1 .. 1}. x = aform_vals e' (aforms_err_to_aforms n X) \<and>
     (\<forall>i < n. e' i = e i)"
   using X deg
 proof (induction X arbitrary: x n)
   case Nil then show ?case using e
     by (auto simp: o_def degrees_def intro!: bexI[where x="\<lambda>i. e i"])
 next
   case (Cons X XS)
   from Cons.prems obtain y ys where ys:
     "degree_aform_err X \<le> n"
     "degree_aforms_err XS \<le> n"
     "x = y # ys" "y \<in> aform_err e X" "ys \<in> aforms_err e XS"
     by (auto simp: mem_aforms_err_Cons_iff_Ex_conv degrees_def)
   then have "degree_aforms_err XS \<le> Suc n" by auto
   from Cons.IH[OF ys(5) this]
   obtain e' where e': "e'\<in>UNIV \<rightarrow> {- 1..1}" "ys = aform_vals e' (aforms_err_to_aforms (Suc n) XS)"
     "(\<forall>i<n. e' i = e i)"
     by auto
   from aform_err_to_aformE[OF ys(4,1)] obtain err where err:
     "y = aform_val (e(n := err)) (aform_err_to_aform X n)" "- 1 \<le> err" "err \<le> 1"
     by auto
   show ?case
   proof (safe intro!: bexI[where x="e'(n:=err)"], goal_cases)
     case 1
     then show ?case
       unfolding ys e' err
       apply (auto simp: aform_vals_def  aform_val_def simp del:  pdevs_val_upd)
        apply (rule pdevs_val_degree_cong)
         apply simp
       subgoal
         using ys e'
         by (auto dest!: less_degree_aform_aform_err_to_aformD simp: max_def split: if_splits)
       subgoal premises prems for a b
       proof -
         have "pdevs_val (\<lambda>a. if a = n then err else e' a) b = pdevs_val (e'(n:=err)) b"
           unfolding fun_upd_def by simp
         also have "\<dots> = pdevs_val e' b - e' n * pdevs_apply b n + err * pdevs_apply b n"
           by simp
         also
         from prems
         obtain i where i: "aforms_err_to_aforms (Suc n) XS ! i = (a, b)"
           "i < length (aforms_err_to_aforms (Suc n) XS)"
           by (auto simp: in_set_conv_nth )
         { note i(1)[symmetric]
           also have "aforms_err_to_aforms (Suc n) XS ! i = aform_err_to_aform (XS ! i) (Suc n + i) "
             unfolding aforms_err_to_aforms_def
             using i
             by (simp del: upt_Suc)
           finally have "b = snd (aform_err_to_aform (XS ! i) (Suc n + i))" by (auto simp: prod_eq_iff)
         } note b = this
         have "degree_aform_err (XS ! i) \<le> n"
           using ys(2) i by (auto simp:  degrees_def)
         then have "n \<notin> pdevs_domain b" unfolding b
           apply (subst pdevs_domain_aform_err_to_aform)
           by (auto intro!: degree)
         then have "pdevs_apply b n = 0" by simp
         finally
         show ?thesis by simp
       qed
       done
   next
     case (2 i)
     then show ?case
       using e' by auto
   next
     case (3 i)
     then show ?case
       using e' err
       by auto
   qed
 qed
 
 lemma aforms_err_to_aformsE:
   assumes X: "x \<in> aforms_err e X"
   assumes deg: "degree_aforms_err X \<le> n"
     assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   obtains e' where "x = aform_vals e' (aforms_err_to_aforms n X)" "e' \<in> UNIV \<rightarrow> {-1 .. 1}"
     "\<And>i. i < n \<Longrightarrow> e' i = e i"
   using aforms_err_to_aforms_ex[OF X deg e]
   by blast
 
 definition "approx_floatariths p ea as =
   do {
     let da = (degree_aforms as);
     let aes = (map (\<lambda>x. (x, 0)) as);
     rs \<leftarrow> approx_floatariths_aformerr p ea aes;
     let d = max da (degree_aforms_err (rs));
     Some (aforms_err_to_aforms d rs)
   }"
 
 lemma listset_sings[simp]:
   "listset (map (\<lambda>x. {f x}) as) = {map f as}"
   by (induction as) (auto simp: set_Cons_def)
 
 lemma approx_floatariths_outer:
   assumes "approx_floatariths p ea as = Some XS"
   assumes "vs \<in> Joints as"
   shows "(interpret_floatariths ea vs @ vs) \<in> Joints (XS @ as)"
 proof -
   from assms obtain da aes rs d where
      da: "da = degree_aforms as"
     and aes: "aes = (map (\<lambda>x. (x, 0)) as)"
     and rs: "approx_floatariths_aformerr p ea aes = Some rs"
     and d: "d = max da (degree_aforms_err (rs))"
     and XS: "aforms_err_to_aforms d rs = XS"
     by (auto simp: approx_floatariths_def Let_def bind_eq_Some_conv)
   have abbd: "(a, b) \<in> set as \<Longrightarrow> degree b \<le> degree_aforms as" for a b
     apply (rule degrees_leD[OF order_refl]) by force
   from da d have i_less: "(a, b) \<in> set as \<Longrightarrow> i < degree b \<Longrightarrow> i < min d da" for i a b
     by (auto dest!: abbd)
 
   have abbd: "(a, b) \<in> set as \<Longrightarrow> degree b \<le> degree_aforms as" for a b
     apply (rule degrees_leD[OF order_refl]) by force
   from assms obtain e' where vs: "vs = (map (aform_val e') as)" and e': "e' \<in> UNIV \<rightarrow> {-1 .. 1}"
     by (auto simp: Joints_def valuate_def)
   note vs
   also
   have vs_aes: "vs \<in> aforms_err e' aes"
     unfolding aes
     by (auto simp: vs aforms_err_def o_def aform_err_def)
   from approx_floatariths_Elem[OF e' rs this]
   have iars: "interpret_floatariths ea (map (aform_val e') as) \<in> aforms_err e' rs"
     by (auto simp: vs)
   have "degree_aforms_err rs \<le> d"
     by (auto simp: d da)
   from aforms_err_to_aformsE[OF iars this e'] obtain e where
     "interpret_floatariths ea (map (aform_val e') as) = aform_vals e XS"
     and e: "e \<in> UNIV \<rightarrow> {- 1..1}" "\<And>i. i < d \<Longrightarrow> e i = e' i"
     by (auto simp: XS)
   note this (1)
   finally have "interpret_floatariths ea vs = aform_vals e XS" .
 
   moreover
 
   from e have e'_eq: "e' i = e i" if "i < min d da" for i
     using that
     by (auto simp: min_def split: if_splits)
   then have "vs = aform_vals e as"
     by (auto simp: vs aform_vals_def aform_val_def intro!: pdevs_val_degree_cong e'_eq i_less)
 
   ultimately show ?thesis
     using e(1)
     by (auto simp: Joints_def valuate_def aform_vals_def intro!: image_eqI[where x=e])
 qed
 
 lemma length_eq_NilI: "length [] = length []"
   and length_eq_ConsI: "length xs = length ys \<Longrightarrow> length (x#xs) = length (y#ys)"
   by auto
 
 
 subsection \<open>Generic operations on Affine Forms in Euclidean Space\<close>
 
 lemma pdevs_val_domain_cong:
   assumes "b = d"
   assumes "\<And>i. i \<in> pdevs_domain b \<Longrightarrow> a i = c i"
   shows "pdevs_val a b = pdevs_val c d"
   using assms
   by (auto simp: pdevs_val_pdevs_domain)
 
 lemma fresh_JointsI:
   assumes "xs \<in> Joints XS"
   assumes "list_all (\<lambda>Y. pdevs_domain (snd X) \<inter> pdevs_domain (snd Y) = {}) XS"
   assumes "x \<in> Affine X"
   shows "x#xs \<in> Joints (X#XS)"
   using assms
   unfolding Joints_def Affine_def valuate_def
 proof safe
   fix e e'::"nat \<Rightarrow> real"
   assume H: "list_all (\<lambda>Y. pdevs_domain (snd X) \<inter> pdevs_domain (snd Y) = {}) XS"
     "e \<in> UNIV \<rightarrow> {- 1..1}"
     "e' \<in> UNIV \<rightarrow> {- 1..1}"
   have "\<And>a b i. \<forall>Y\<in>set XS. pdevs_domain (snd X) \<inter> pdevs_domain (snd Y) = {} \<Longrightarrow>
        pdevs_apply b i \<noteq> 0 \<Longrightarrow>
        pdevs_apply (snd X) i \<noteq> 0 \<Longrightarrow>
        (a, b) \<notin> set XS"
     by (metis (poly_guards_query) IntI all_not_in_conv in_pdevs_domain snd_eqD)
   with H show
     "aform_val e' X # map (aform_val e) XS \<in> (\<lambda>e. map (aform_val e) (X # XS)) ` (UNIV \<rightarrow> {- 1..1})"
     by (intro image_eqI[where x = "\<lambda>i. if i \<in> pdevs_domain (snd X) then e' i else e i"])
       (auto simp: aform_val_def list_all_iff Pi_iff intro!: pdevs_val_domain_cong)
 qed
 
 
 primrec approx_slp::"nat \<Rightarrow> slp \<Rightarrow> aform_err list \<Rightarrow> aform_err list option"
 where
   "approx_slp p [] xs = Some xs"
 | "approx_slp p (ea # eas) xs =
     do {
       r \<leftarrow> approx_floatarith p ea xs;
       approx_slp p eas (r#xs)
     }"
 
 lemma Nil_mem_Joints[intro, simp]: "[] \<in> Joints []"
   by (force simp: Joints_def valuate_def)
 
 lemma map_nth_Joints: "xs \<in> Joints XS \<Longrightarrow> (\<And>i. i \<in> set is \<Longrightarrow> i < length XS) \<Longrightarrow> map (nth xs) is @ xs \<in> Joints (map (nth XS) is @ XS)"
   by (auto simp: Joints_def valuate_def)
 
 lemma map_nth_Joints': "xs \<in> Joints XS \<Longrightarrow> (\<And>i. i \<in> set is \<Longrightarrow> i < length XS) \<Longrightarrow> map (nth xs) is \<in> Joints (map (nth XS) is)"
   by (rule Joints_appendD2[OF map_nth_Joints]) auto
 
 lemma approx_slp_Elem:
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes "vs \<in> aforms_err e VS"
   assumes "approx_slp p ra VS = Some X"
   shows "interpret_slp ra vs \<in> aforms_err e X"
   using assms(2-)
 proof (induction ra arbitrary: X vs VS)
   case (Cons ra ras)
   from Cons.prems
   obtain a where a: "approx_floatarith p ra VS = Some a"
     and r: "approx_slp p ras (a # VS) = Some X"
     by (auto simp: bind_eq_Some_conv)
   from approx_floatarith_Elem[OF a e Cons.prems(1)]
   have "interpret_floatarith ra vs \<in> aform_err e a"
     by auto
   then have 1: "interpret_floatarith ra vs#vs \<in> aforms_err e (a#VS)"
     unfolding mem_aforms_err_Cons_iff
     using Cons.prems(1)
     by auto
   show ?case
     by (auto intro!: Cons.IH 1 r)
 qed auto
 
 definition "approx_slp_outer p n slp XS =
   do {
     let d = degree_aforms XS;
     let XSe = (map (\<lambda>x. (x, 0)) XS);
     rs \<leftarrow> approx_slp p slp XSe;
     let rs' = take n rs;
     let d' = max d (degree_aforms_err rs');
     Some (aforms_err_to_aforms d' rs')
   }"
 
 lemma take_in_listsetI: "xs \<in> listset XS \<Longrightarrow> take n xs \<in> listset (take n XS)"
   by (induction XS arbitrary: xs n) (auto simp: take_Cons listset_Cons_mem_conv set_Cons_def split: nat.splits)
 
 lemma take_in_aforms_errI: "take n xs \<in> aforms_err e (take n XS)"
   if "xs \<in> aforms_err e XS"
   using that
   by (auto simp: aforms_err_def take_map[symmetric] intro!: take_in_listsetI)
 
 theorem approx_slp_outer:
   assumes "approx_slp_outer p n slp XS = Some RS"
   assumes slp: "slp = slp_of_fas fas" "n = length fas"
   assumes "xs \<in> Joints XS"
   shows "interpret_floatariths fas xs @ xs \<in> Joints (RS @ XS)"
 proof -
   from assms obtain d XSe rs rs' d' where
     d: "d = degree_aforms XS"
     and XSe: "XSe = (map (\<lambda>x. (x, 0)) XS)"
     and rs: "approx_slp p (slp_of_fas fas) XSe = Some rs"
     and rs': "rs' = take (length fas) rs"
     and d': "d' = max d (degree_aforms_err rs')"
     and RS: "aforms_err_to_aforms d' rs' = RS"
     by (auto simp: approx_slp_outer_def Let_def bind_eq_Some_conv)
   have abbd: "(a, b) \<in> set XS \<Longrightarrow> degree b \<le> degree_aforms XS" for a b
     apply (rule degrees_leD[OF order_refl]) by force
   from d' d have i_less: "(a, b) \<in> set XS \<Longrightarrow> i < degree b \<Longrightarrow> i < min d d'" for i a b
     by (auto dest!: abbd)
   from assms obtain e' where vs: "xs = (map (aform_val e') XS)" and e': "e' \<in> UNIV \<rightarrow> {-1 .. 1}"
     by (auto simp: Joints_def valuate_def)
   from d have d: "V \<in> set XS \<Longrightarrow> degree_aform V \<le> d" for V
     by (auto intro!: degrees_leD)
   have xs_XSe: "xs \<in> aforms_err e' XSe"
     by (auto simp: vs aforms_err_def XSe o_def aform_err_def)
   from approx_slp_Elem[OF e' xs_XSe rs]
   have aforms_err: "interpret_slp (slp_of_fas fas) xs \<in> aforms_err e' rs" .
   have "interpret_floatariths fas xs = take (length fas) (interpret_slp (slp_of_fas fas) xs)"
     using assms by (simp add: slp_of_fas)
   also
   from aforms_err
   have "take (length fas) (interpret_slp (slp_of_fas fas) xs) \<in> aforms_err e' rs'"
     unfolding rs'
     by (auto simp: take_map intro!: take_in_aforms_errI)
   finally have ier: "interpret_floatariths fas xs \<in> aforms_err e' rs'" .
   have "degree_aforms_err rs' \<le> d'" using d' by auto
   from aforms_err_to_aformsE[OF ier this e'] obtain e where
     "interpret_floatariths fas xs = aform_vals e RS"
     and e: "e \<in> UNIV \<rightarrow> {- 1..1}" "\<And>i. i < d' \<Longrightarrow> e i = e' i"
     unfolding RS
     by (auto simp: )
   moreover
 
   from e have e'_eq: "e' i = e i" if "i < min d d'" for i
     using that
     by (auto simp: min_def split: if_splits)
   then have "xs = aform_vals e XS"
     by (auto simp: vs aform_vals_def aform_val_def intro!: pdevs_val_degree_cong e'_eq i_less)
 
   ultimately show ?thesis
     using e(1)
     by (auto simp: Joints_def valuate_def aform_vals_def intro!: image_eqI[where x=e])
 
 qed
 
 theorem approx_slp_outer_plain:
   assumes "approx_slp_outer p n slp XS = Some RS"
   assumes slp: "slp = slp_of_fas fas" "n = length fas"
   assumes "xs \<in> Joints XS"
   shows "interpret_floatariths fas xs \<in> Joints RS"
 proof -
   have "length fas = length RS"
   proof -
     have f1: "length xs = length XS"
       using Joints_imp_length_eq assms(4) by blast
     have "interpret_floatariths fas xs @ xs \<in> Joints (RS @ XS)"
       using approx_slp_outer assms(1) assms(2) assms(3) assms(4) by blast
     then show ?thesis
       using f1 Joints_imp_length_eq by fastforce
   qed
   with Joints_appendD2[OF approx_slp_outer[OF assms]] show ?thesis by simp
 qed
 
 end
 
 end
diff --git a/thys/Affine_Arithmetic/Print.thy b/thys/Affine_Arithmetic/Print.thy
--- a/thys/Affine_Arithmetic/Print.thy
+++ b/thys/Affine_Arithmetic/Print.thy
@@ -1,232 +1,234 @@
 section \<open>Target Language debug messages\<close>
 theory Print
 imports
   "HOL-Decision_Procs.Approximation"
   Affine_Code
   Show.Show_Instances
   "HOL-Library.Monad_Syntax"
   Optimize_Float
 begin
 
 hide_const (open) floatarith.Max
 
 subsection \<open>Printing\<close>
 
 text \<open>Just for debugging purposes\<close>
 
 definition print::"String.literal \<Rightarrow> unit" where "print x = ()"
 
 context includes integer.lifting begin
 
 end
 
 code_printing constant print \<rightharpoonup> (SML) "TextIO.print"
 
 
 subsection \<open>Write to File\<close>
 
 definition file_output::"String.literal \<Rightarrow> ((String.literal \<Rightarrow> unit) \<Rightarrow> 'a) \<Rightarrow> 'a" where
   "file_output _ f = f (\<lambda>_. ())"
 code_printing constant file_output \<rightharpoonup> (SML) "(fn s => fn f => File.open'_output (fn os => f (File.output os)) (Path.explode s))"
 
 
 subsection \<open>Show for Floats\<close>
 
 definition showsp_float :: "float showsp"
 where
   "showsp_float p x = (
     let m = mantissa x; e = exponent x in
       if e = 0 then showsp_int p m else showsp_int p m o shows_string ''*2^'' o showsp_int p e)"
 
 lemma show_law_float [show_law_intros]:
   "show_law showsp_float r"
   by (auto simp: showsp_float_def Let_def show_law_simps intro!: show_lawI)
 
 lemma showsp_float_append [show_law_simps]:
   "showsp_float p r (x @ y) = showsp_float p r x @ y"
   by (intro show_lawD show_law_intros)
 
 local_setup \<open>Show_Generator.register_foreign_showsp @{typ float} @{term "showsp_float"} @{thm show_law_float}\<close>
 
 derive "show" float
 
 
 subsection \<open>Convert Float to Decimal number\<close>
 
 text \<open>type for decimal floating point numbers
   (currently just for printing, TODO? generalize theory Float for arbitrary base)\<close>
 
 datatype float10 = Float10 (mantissa10: int) (exponent10: int)
 notation Float10 (infix "\<e>" 999)
 
 partial_function (tailrec) normalize_float10
   where [code]: "normalize_float10 f =
     (if mantissa10 f mod 10 \<noteq> 0 \<or> mantissa10 f = 0 then f
     else normalize_float10 (Float10 (mantissa10 f div 20) (exponent10 f + 1)))"
 
 subsubsection \<open>Version that should be easy to prove correct, but slow!\<close>
 
 context includes floatarith_notation begin
 
 definition "float_to_float10_approximation f = the
   (do {
     let (x, y) = (mantissa f * 1024, exponent f - 10);
     let p = nat (bitlen (abs x) + bitlen (abs y) + 80); \<comment> \<open>FIXME: are there guarantees?\<close>
     y_log \<leftarrow> approx p (Mult (Num (of_int y))
       ((Mult (Ln (Num 2))
         (Inverse (Ln (Num 10)))))) [];
-    let e_fl = floor_fl (fst y_log);
+    let e_fl = floor_fl (lower y_log);
     let e = int_floor_fl e_fl;
-    (ml, mu) \<leftarrow> approx p (Mult (Num (of_int x)) (Powr (Num 10) (Add(Var 0) (Minus (Num e_fl))))) [Some y_log];
+    m \<leftarrow> approx p (Mult (Num (of_int x)) (Powr (Num 10) (Add(Var 0) (Minus (Num e_fl))))) [Some y_log];
+    let ml = lower m;
+    let mu = upper m;
     Some (normalize_float10 (Float10 (int_floor_fl ml) e), normalize_float10 (Float10 (- int_floor_fl (- mu)) e))
   })"
 
 end
 
 lemma compute_float_of[code]: "float_of (real_of_float f) = f" by simp
 
 
 subsection \<open>Trusted, but faster version\<close>
 
 text \<open>TODO: this is the HOL version of the SML-code in Approximation.thy\<close>
 
 lemma prod_case_call_mono[partial_function_mono]:
   "mono_tailrec (\<lambda>f. (let (d, e) = a in (\<lambda>y. f (c d e y))) b)"
   by (simp add: split_beta' call_mono)
 
 definition divmod_int::"int \<Rightarrow> int \<Rightarrow> int * int"
 where "divmod_int a b = (a div b, a mod b)"
 
 partial_function (tailrec) f2f10_frac where
  "f2f10_frac c p r digits cnt e =
     (if r = 0 then (digits, cnt, 0)
     else if p = 0 then (digits, cnt, r)
     else (let
       (d, r) = divmod_int (r * 10) (power_int 2 (-e))
     in f2f10_frac (c \<or> d \<noteq> 0) (if d \<noteq> 0 \<or> c then p - 1 else p) r
       (digits * 10 + d) (cnt + 1)) e)"
 declare f2f10_frac.simps[code]
 
 definition float2_float10::"int \<Rightarrow> bool \<Rightarrow> int \<Rightarrow> int \<Rightarrow> (int * int)" where
   "float2_float10 prec rd m e = (
   let
     (m, e) = (if e < 0 then (m,e) else (m * power_int 2 e, 0));
     sgn = sgn m;
     m = abs m;
 
     round_down = (sgn = 1 \<and> rd) \<or> (sgn = -1 \<and> \<not> rd);
 
     (x, r) = divmod_int m ((power_int 2 (-e)));
 
     p = ((if x = 0 then prec else prec - (log2 x + 1)) * 3) div 10 + 1;
 
     (digits, e10, r) = if p > 0 then f2f10_frac (x \<noteq> 0) p r 0 0 e else (0,0,0);
 
     digits = if round_down \<or> r = 0 then digits else digits + 1
 
   in (sgn * (digits + x * (power_int 10 e10)), -e10))"
 
 definition "lfloat10 r = (let f = float_of r in case_prod Float10 (float2_float10 20 True (mantissa f) (exponent f)))"
 definition "ufloat10 r = (let f = float_of r in case_prod Float10 (float2_float10 20 False (mantissa f) (exponent f)))"
 
 partial_function (tailrec) digits
   where [code]: "digits m ds = (if m = 0 then ds else digits (m div 10) (m mod 10 # ds))"
 
 primrec showsp_float10 :: "float10 showsp"
 where
   "showsp_float10 p (Float10 m e) = (
     let
       ds = digits (nat (abs m)) [];
       d = int (length ds);
       e = e + d - 1;
       mp = take 1 ds;
       ms = drop 1 ds;
       ms = rev (dropWhile ((=) 0) (rev ms));
       show_digits = shows_list_gen (showsp_nat p) ''0'' '''' '''' ''''
     in (if m < 0 then shows_string ''-'' else (\<lambda>x. x)) o
         show_digits mp o
         (if ms = [] then (\<lambda>x. x) else shows_string ''.'' o show_digits ms) o
         (if e = 0 then (\<lambda>x. x) else shows_string ''e'' o showsp_int p e))"
 
 lemma show_law_float10_aux:
   fixes m e
   shows "show_law showsp_float10 (Float10 m e)"
   apply (rule show_lawI)
   unfolding showsp_float10.simps Let_def
   apply (simp add: show_law_simps )
   done
 
 lemma show_law_float10 [show_law_intros]: "show_law showsp_float10 r"
   by (cases r) (auto simp: show_law_float10_aux)
 
 lemma showsp_float10_append [show_law_simps]:
   "showsp_float10 p r (x @ y) = showsp_float10 p r x @ y"
   by (intro show_lawD show_law_intros)
 
 local_setup \<open>Show_Generator.register_foreign_showsp @{typ float10} @{term "showsp_float10"} @{thm show_law_float10}\<close>
 
 derive "show" float10
 
 definition "showsp_real p x = showsp_float10 p (lfloat10 x)"
 
 lemma show_law_real[show_law_intros]: "show_law showsp_real x"
   using show_law_float10[of "lfloat10 x"]
   by (auto simp: showsp_real_def[abs_def] Let_def show_law_def
       simp del: showsp_float10.simps intro!: show_law_intros)
 
 local_setup \<open>Show_Generator.register_foreign_showsp @{typ real} @{term "showsp_real"} @{thm show_law_real}\<close>
 derive "show" real
 
 subsection \<open>gnuplot output\<close>
 
 subsubsection \<open>vector output of 2D zonotope\<close>
 
 fun polychain_of_segments::"((real \<times> real) \<times> (real \<times> real)) list \<Rightarrow> (real \<times> real) list"
   where
     "polychain_of_segments [] = []"
   | "polychain_of_segments (((x0, y0), z)#segs) = (x0, y0)#z#map snd segs"
 
 definition shows_segments_of_aform
   where "shows_segments_of_aform a b xs color =
   shows_list_gen id '''' '''' ''\<newline>'' ''\<newline>'' (map (\<lambda>(x0, y0).
       shows_words (map lfloat10 [x0, y0]) o shows_space o shows_string color)
     (polychain_of_segments (segments_of_aform (prod_of_aforms (xs ! a) (xs ! b)))))"
 abbreviation "show_segments_of_aform a b x c \<equiv> shows_segments_of_aform a b x c ''''"
 
 definition shows_box_of_aforms\<comment> \<open>box and some further information\<close>
 where "shows_box_of_aforms (XS::real aform list) = (let
     RS = map (Radius' 20) XS;
     l = map (Inf_aform' 20) XS;
     u = map (Sup_aform' 20) XS
     in shows_words
       (l @ u @ RS) o shows_space o
       shows (card (\<Union>((\<lambda>x. pdevs_domain (snd x)) ` (set XS))))
     )"
 abbreviation "show_box_of_aforms x \<equiv> shows_box_of_aforms x ''''"
 
 definition "pdevs_domains ((XS::real aform list)) = (\<Union>((\<lambda>x. pdevs_domain (snd x)) ` (set XS)))"
 
 definition "generators XS =
     (let
       is = sorted_list_of_set (pdevs_domains XS);
       rs = map (\<lambda>i. (i, map (\<lambda>x. pdevs_apply (snd x) i) XS)) is
     in
       (map fst XS, rs))"
 
 definition shows_box_of_aforms_hr\<comment> \<open>human readable\<close>
 where "shows_box_of_aforms_hr XS = (let
     RS = map (Radius' 20) XS;
     l = map (Inf_aform' 20) XS;
     u = map (Sup_aform' 20) XS
     in shows_paren (shows_words l) o shows_string '' .. '' o shows_paren (shows_words u) o
       shows_string ''; devs: '' o shows (card (pdevs_domains XS)) o
       shows_string ''; tdev: '' o shows_paren (shows_words RS)
     )"
 abbreviation "show_box_of_aforms_hr x \<equiv> shows_box_of_aforms_hr x ''''"
 
 definition shows_aforms_hr\<comment> \<open>human readable\<close>
 where "shows_aforms_hr XS = shows (generators XS)"
 
 abbreviation "show_aform_hr x \<equiv> shows_aforms_hr x ''''"
 
 end
diff --git a/thys/Differential_Dynamic_Logic/Differential_Axioms.thy b/thys/Differential_Dynamic_Logic/Differential_Axioms.thy
--- a/thys/Differential_Dynamic_Logic/Differential_Axioms.thy
+++ b/thys/Differential_Dynamic_Logic/Differential_Axioms.thy
@@ -1,2650 +1,2648 @@
 theory "Differential_Axioms" 
 imports
   Ordinary_Differential_Equations.ODE_Analysis
   "Ids"
   "Lib"
   "Syntax"     
   "Denotational_Semantics"
   "Frechet_Correctness"
   "Axioms"
   "Coincidence"
 begin context ids begin
 section \<open>Differential Axioms\<close>
 text \<open>Differential axioms fall into two categories:
 Axioms for computing the derivatives of terms and axioms for proving properties of ODEs.
 The derivative axioms are all corollaries of the frechet correctness theorem. The ODE
 axioms are more involved, often requiring extensive use of the ODE libraries.\<close> 
 
 subsection \<open>Derivative Axioms\<close>
 definition diff_const_axiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"diff_const_axiom \<equiv> Equals (Differential ($f fid1 empty)) (Const 0)"
 
 definition diff_var_axiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"diff_var_axiom \<equiv> Equals (Differential (Var vid1)) (DiffVar vid1)"
   
 definition state_fun ::"'sf \<Rightarrow> ('sf, 'sz) trm"
 where [axiom_defs]:"state_fun f = ($f f (\<lambda>i. Var i))"
   
 definition diff_plus_axiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"diff_plus_axiom \<equiv> Equals (Differential (Plus (state_fun fid1) (state_fun fid2))) 
     (Plus (Differential (state_fun fid1)) (Differential (state_fun fid2)))"
 
 definition diff_times_axiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"diff_times_axiom \<equiv> Equals (Differential (Times (state_fun fid1) (state_fun fid2))) 
     (Plus (Times (Differential (state_fun fid1)) (state_fun fid2)) 
           (Times (state_fun fid1) (Differential (state_fun fid2))))"
 
 \<comment> \<open>\<open>[y=g(x)][y'=1](f(g(x))' = f(y)')\<close>\<close>
 definition diff_chain_axiom::"('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"diff_chain_axiom \<equiv> [[Assign vid2 (f1 fid2 vid1)]]([[DiffAssign vid2 (Const 1)]] 
   (Equals (Differential ($f fid1 (singleton (f1 fid2 vid1)))) (Times (Differential (f1 fid1 vid2)) (Differential (f1 fid2 vid1)))))"
 
 subsection \<open>ODE Axioms\<close>
 definition DWaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DWaxiom = ([[EvolveODE (OVar vid1) (Predicational pid1)]](Predicational pid1))"
 
 definition DWaxiom' :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DWaxiom' = ([[EvolveODE (OSing vid1 (Function fid1 (singleton (Var vid1)))) (Prop vid2 (singleton (Var vid1)))]](Prop vid2 (singleton (Var vid1))))"
   
 definition DCaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DCaxiom = (
 ([[EvolveODE (OVar vid1) (Predicational pid1)]]Predicational pid3) \<rightarrow>
 (([[EvolveODE (OVar vid1) (Predicational pid1)]](Predicational pid2)) 
   \<leftrightarrow>  
    ([[EvolveODE (OVar vid1) (And (Predicational pid1) (Predicational pid3))]]Predicational pid2)))"
 
 definition DEaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DEaxiom = 
 (([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid2 vid1)]] (P pid1))
 \<leftrightarrow>
  ([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid2 vid1)]]
     [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
   
 definition DSaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DSaxiom = 
 (([[EvolveODE (OSing vid1 (f0 fid1)) (p1 vid2 vid1)]]p1 vid3 vid1)
 \<leftrightarrow> 
 (Forall vid2 
  (Implies (Geq (Var vid2) (Const 0)) 
  (Implies 
    (Forall vid3 
      (Implies (And (Geq (Var vid3) (Const 0)) (Geq (Var vid2) (Var vid3)))
         (Prop vid2 (singleton (Plus (Var vid1) (Times (f0 fid1) (Var vid3)))))))
    ([[Assign vid1 (Plus (Var vid1) (Times (f0 fid1) (Var vid2)))]]p1 vid3 vid1)))))"
 
 \<comment> \<open>\<open>(Q \<rightarrow> [c&Q](f(x)' \<ge> g(x)'))\<close>\<close> 
 \<comment> \<open>\<open>\<rightarrow>\<close>\<close>
 \<comment> \<open>\<open>([c&Q](f(x) \<ge> g(x))) --> (Q \<rightarrow> (f(x) \<ge> g(x))\<close>\<close> 
 definition DIGeqaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DIGeqaxiom = 
 Implies 
   (Implies (Prop vid1 empty) ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (Differential (f1 fid1 vid1)) (Differential (f1 fid2 vid1)))))
   (Implies
      (Implies(Prop vid1 empty) (Geq (f1 fid1 vid1) (f1 fid2 vid1)))
      ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (f1 fid1 vid1) (f1 fid2 vid1))))"
 
 
 \<comment> \<open>\<open>g(x) > h(x) \<rightarrow> [x'=f(x), c & p(x)](g(x)' \<ge> h(x)') \<rightarrow> [x'=f(x), c & p(x)]g(x) > h(x)\<close>\<close> 
 
 \<comment> \<open>\<open>(Q \<rightarrow> [c&Q](f(x)' \<ge> g(x)'))\<close>\<close> 
 \<comment> \<open>\<open>\<rightarrow>\<close>\<close>
 \<comment> \<open>\<open>([c&Q](f(x) > g(x))) <-> (Q \<rightarrow> (f(x) > g(x))\<close>\<close>
 definition DIGraxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DIGraxiom = 
 Implies 
   (Implies (Prop vid1 empty) ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (Differential (f1 fid1 vid1)) (Differential (f1 fid2 vid1)))))
   (Implies
      (Implies(Prop vid1 empty) (Greater (f1 fid1 vid1) (f1 fid2 vid1)))
      ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Greater (f1 fid1 vid1) (f1 fid2 vid1))))"
 
 \<comment> \<open>\<open>[{1' = 1(1) & 1(1)}]2(1) <->\<close>\<close>
 \<comment> \<open>\<open>\<exists>2. [{1'=1(1), 2' = 2(1)*2 + 3(1) & 1(1)}]2(1)*)\<close>\<close>
 definition DGaxiom :: "('sf, 'sc, 'sz) formula"
 where [axiom_defs]:"DGaxiom = (([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid1 vid1)]]p1 vid2 vid1) \<leftrightarrow> 
   (Exists vid2 
     ([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) (OSing vid2 (Plus (Times (f1 fid2 vid1) (Var vid2)) (f1 fid3 vid1)))) (p1 vid1 vid1)]]
        p1 vid2 vid1)))"
 
 subsection \<open>Proofs for Derivative Axioms\<close>
 lemma constant_deriv_inner:
  assumes interp:"\<forall>x i. (Functions I i has_derivative FunctionFrechet I i x) (at x)"
  shows "FunctionFrechet I id1 (vec_lambda (\<lambda>i. sterm_sem I (empty i) (fst \<nu>))) (vec_lambda(\<lambda>i. frechet I (empty i) (fst \<nu>) (snd \<nu>)))= 0"
 proof -
   have empty_zero:"(vec_lambda(\<lambda>i. frechet I (empty i) (fst \<nu>) (snd \<nu>))) = 0"
     using local.empty_def Cart_lambda_cong frechet.simps(5) zero_vec_def
     apply auto
     apply(rule vec_extensionality)
     using local.empty_def Cart_lambda_cong frechet.simps(5) zero_vec_def
     by (simp add: local.empty_def)
   let ?x = "(vec_lambda (\<lambda>i. sterm_sem I (empty i) (fst \<nu>)))"
   from interp
   have has_deriv:"(Functions I id1 has_derivative FunctionFrechet I id1 ?x) (at ?x)"
     by auto
   then have f_linear:"linear (FunctionFrechet I id1 ?x)"
     using Deriv.has_derivative_linear by auto
   then show ?thesis using empty_zero f_linear linear_0 by (auto)
 qed
 
 lemma constant_deriv_zero:"is_interp I \<Longrightarrow> directional_derivative I ($f id1 empty) \<nu> = 0"
   apply(simp only: is_interp_def directional_derivative_def frechet.simps frechet_correctness)
   apply(rule constant_deriv_inner)
   apply(auto)
 done
 
 theorem diff_const_axiom_valid: "valid diff_const_axiom"
   apply(simp only: valid_def diff_const_axiom_def equals_sem)
   apply(rule allI | rule impI)+
   apply(simp only: dterm_sem.simps constant_deriv_zero sterm_sem.simps)
 done
 
 theorem diff_var_axiom_valid: "valid diff_var_axiom"
   apply(auto simp add: diff_var_axiom_def valid_def directional_derivative_def)
   by (metis inner_prod_eq)
   
 theorem diff_plus_axiom_valid: "valid diff_plus_axiom"
   apply(auto simp add: diff_plus_axiom_def valid_def)
   subgoal for I a b
     using frechet_correctness[of I "(Plus (state_fun fid1) (state_fun fid2))" b] 
     unfolding state_fun_def apply (auto intro: dfree.intros)
     unfolding directional_derivative_def by auto
  done
   
 theorem diff_times_axiom_valid: "valid diff_times_axiom"
   apply(auto simp add: diff_times_axiom_def valid_def)
   subgoal for I a b
     using frechet_correctness[of I "(Times (state_fun fid1) (state_fun fid2))" b] 
     unfolding state_fun_def apply (auto intro: dfree.intros)
     unfolding directional_derivative_def by auto
   done
   
 subsection \<open>Proofs for ODE Axioms\<close>
  
 lemma DW_valid:"valid DWaxiom"
   apply(unfold DWaxiom_def valid_def Let_def impl_sem )
   apply(safe)
   apply(auto simp only: fml_sem.simps prog_sem.simps box_sem)
   subgoal for I aa ba ab bb sol t using mk_v_agree[of I "(OVar vid1)" "(ab,bb)" "sol t"]
     Vagree_univ[of "aa" "ba" "sol t" "ODEs I vid1 (sol t)"] solves_ode_domainD
     by (fastforce)
   done
 
 lemma DE_lemma:
   fixes ab bb::"'sz simple_state"
   and sol::"real \<Rightarrow> 'sz simple_state"
   and I::"('sf, 'sc, 'sz) interp"
   shows
   "repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
    = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
 proof
   have set_eq:" {Inl vid1, Inr vid1} = {Inr vid1, Inl vid1}" by auto
   have agree:"Vagree (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) (mk_xode I (OSing vid1 (f1 fid1 vid1)) (sol t))
       {Inl vid1, Inr vid1}" 
     using mk_v_agree[of I "(OSing vid1 (f1 fid1 vid1))" "(ab, bb)" "(sol t)"] 
     unfolding semBV.simps using set_eq by auto
   have fact:"dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))
           = snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ vid1"
     using agree unfolding Vagree_def dterm_sem.simps f1_def mk_xode.simps
   proof -
     assume alls:"(\<forall>i. Inl i \<in> {Inl vid1, Inr vid1} \<longrightarrow>
         fst (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ i =
         fst (sol t, ODE_sem I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (sol t)) $ i) \<and>
       (\<forall>i. Inr i \<in> {Inl vid1, Inr vid1} \<longrightarrow>
         snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ i =
         snd (sol t, ODE_sem I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (sol t)) $ i)"
     hence atVid'':"snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ vid1 = sterm_sem I ($f fid1 (singleton (trm.Var vid1))) (sol t)" 
       by auto
     have argsEq:"(\<chi> i. dterm_sem I (singleton (trm.Var vid1) i)
           (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)))
           = (\<chi> i.  sterm_sem I (singleton (trm.Var vid1) i) (sol t))"
       using alls f1_def by auto
     thus "Functions I fid1 (\<chi> i. dterm_sem I (singleton (trm.Var vid1) i)
           (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t))) 
         = snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ vid1"
       by (simp only: atVid'' ODE_sem.simps sterm_sem.simps dterm_sem.simps)
   qed
   have eqSnd:"(\<chi> y. if vid1 = y then snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ vid1
         else snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ y) = snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))"
     by (simp add: vec_extensionality)
   have truth:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
         (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
       = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
     using fact by (auto simp only: eqSnd repd.simps fact prod.collapse split: if_split)
   thus "fst (repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
           (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))) =
     fst (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))"
 
     "snd (repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
       (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))) =
     snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) " 
     by auto
 qed
 
 lemma DE_valid:"valid DEaxiom"
 proof -
   have dsafe:"dsafe ($f fid1 (singleton (trm.Var vid1)))" unfolding singleton_def by(auto intro: dsafe.intros)
   have osafe:"osafe(OSing vid1 (f1 fid1 vid1))" unfolding f1_def empty_def singleton_def using dsafe osafe.intros dsafe.intros
     by (simp add: osafe_Sing dfree_Const) 
   have fsafe:"fsafe (p1 vid2 vid1)" unfolding p1_def singleton_def using hpsafe_fsafe.intros(10)
     using dsafe dsafe_Fun_simps image_iff
     by (simp add: dfree_Const)
   show "valid DEaxiom"
     apply(auto simp only: DEaxiom_def valid_def Let_def iff_sem impl_sem)
      apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq box_sem)
    proof -
      fix I::"('sf,'sc,'sz) interp"
        and aa ba ab bb sol 
        and t::real
        and ac bc
      assume "is_interp I"
      assume allw:"\<forall>\<omega>. (\<exists>\<nu> sol t.
                   ((ab, bb), \<omega>) = (\<nu>, mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> (sol t)) \<and>
                   0 \<le> t \<and>
                   (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
                    {x. mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> x \<in> fml_sem I (p1 vid2 vid1)} \<and>
                   (sol 0) = (fst \<nu>) ) \<longrightarrow>
               \<omega> \<in> fml_sem I (P pid1)"
      assume t:"0 \<le> t"
      assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
      assume solve:" (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
          {x. mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"
      assume sol0:" (sol 0) = (fst (ab, bb)) "
      assume rep:"   (ac, bc) =
         repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
          (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))"
      have aaba_sem:"(aa,ba) \<in> fml_sem I (P pid1)" using allw t aaba solve sol0 rep by blast
      have truth:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
           (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
      = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
        using DE_lemma by auto
      show "
         repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
          (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
         \<in> fml_sem I (P pid1)" using aaba aaba_sem truth by (auto)
    next
      fix I::"('sf,'sc,'sz) interp" and  aa ba ab bb sol and t::real
        assume "is_interp I"
        assume all:"\<forall>\<omega>. (\<exists>\<nu> sol t.
                 ((ab, bb), \<omega>) = (\<nu>, mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> (sol t)) \<and>
                 0 \<le> t \<and>
                 (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
                  {x. mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> x \<in> fml_sem I (p1 vid2 vid1)} \<and>
                  (sol 0) = (fst \<nu>) ) \<longrightarrow>
             (\<forall>\<omega>'. \<omega>' = repd \<omega> vid1 (dterm_sem I (f1 fid1 vid1) \<omega>) \<longrightarrow> \<omega>' \<in> fml_sem I (P pid1))"
        hence justW:"(\<exists>\<nu> sol t.
                 ((ab, bb), (aa, ba)) = (\<nu>, mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> (sol t)) \<and>
                 0 \<le> t \<and>
                 (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
                  {x. mk_v I (OSing vid1 (f1 fid1 vid1)) \<nu> x \<in> fml_sem I (p1 vid2 vid1)} \<and>
                 (sol 0) = (fst \<nu>)) \<longrightarrow>
             (\<forall>\<omega>'. \<omega>' = repd (aa, ba) vid1 (dterm_sem I (f1 fid1 vid1) (aa, ba)) \<longrightarrow> \<omega>' \<in> fml_sem I (P pid1))"
          by (rule allE)
        assume t:"0 \<le> t"
        assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
        assume sol:"(sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
         {x. mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"
        assume sol0:" (sol 0) = (fst (ab, bb))"
        have "repd (aa, ba) vid1 (dterm_sem I (f1 fid1 vid1) (aa, ba)) \<in> fml_sem I (P pid1)"
          using justW t aaba sol sol0 by auto
        hence foo:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))) \<in> fml_sem I (P pid1)"
          using aaba by auto
        hence "repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
              = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)" using DE_lemma by auto
        thus "mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t) \<in> fml_sem I (P pid1)" using foo by auto
   qed
 qed
 
 lemma ODE_zero:"\<And>i. Inl i \<notin> BVO ODE \<Longrightarrow> Inr i \<notin> BVO ODE \<Longrightarrow> ODE_sem I ODE \<nu> $ i= 0"
   by(induction ODE, auto)
 
 lemma DE_sys_valid:
   assumes disj:"{Inl vid1, Inr vid1} \<inter> BVO ODE = {}"
   shows "valid (([[EvolveODE (OProd  (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) \<leftrightarrow>
  ([[EvolveODE ((OProd  (OSing vid1 (f1 fid1 vid1))ODE)) (p1 vid2 vid1)]]
     [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
 proof -
   have dsafe:"dsafe ($f fid1 (singleton (trm.Var vid1)))" unfolding singleton_def by(auto intro: dsafe.intros)
   have osafe:"osafe(OSing vid1 (f1 fid1 vid1))" unfolding f1_def empty_def singleton_def using dsafe osafe.intros dsafe.intros
     by (simp add: osafe_Sing dfree_Const) 
   have fsafe:"fsafe (p1 vid2 vid1)" unfolding p1_def singleton_def using hpsafe_fsafe.intros(10)
     using dsafe dsafe_Fun_simps image_iff
     by (simp add: dfree_Const)
   show "valid (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) \<leftrightarrow>
  ([[EvolveODE ((OProd (OSing vid1 (f1 fid1 vid1)) ODE)) (p1 vid2 vid1)]]
     [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
     apply(auto simp only: DEaxiom_def valid_def Let_def iff_sem impl_sem)
     apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq box_sem f1_def p1_def P_def expand_singleton)
    proof -
      fix I ::"('sf,'sc,'sz) interp"
        and aa ba ab bb sol 
        and t::real
        and ac bc
      assume good:"is_interp I"
      assume bigAll:"
      \<forall>\<omega>. (\<exists>\<nu> sol t. ((ab, bb), \<omega>) = (\<nu>, mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) ODE) \<nu> (sol t)) \<and>
                     0 \<le> t \<and>
                     (sol solves_ode (\<lambda>_. ODE_sem I (OProd(OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) ODE ))) {0..t}
                      {x. Predicates I vid2
                           (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                  (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> x))} \<and>
                     sol 0 = fst \<nu>) \<longrightarrow>
           \<omega> \<in> fml_sem I (Pc pid1)"
      let ?my\<omega> = "mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab,bb) (sol t)"
      assume t:"0 \<le> t"
      assume aaba:"(aa, ba) = mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)"
      assume sol:"(sol solves_ode (\<lambda>_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
       {x. Predicates I vid2
            (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                   (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) x))}"
      assume sol0:"sol 0 = fst (ab, bb)"
      assume acbc:"(ac, bc) =
      repd (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
       (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))
         (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))"
      have bigEx:"(\<exists>\<nu> sol t. ((ab, bb), ?my\<omega>) = (\<nu>, mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> (sol t)) \<and>
                     0 \<le> t \<and>
                     (sol solves_ode (\<lambda>_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
                      {x. Predicates I vid2
                           (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                  (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> x))} \<and>
                     sol 0 = fst \<nu>)"
        apply(rule exI[where x="(ab, bb)"])
        apply(rule exI[where x="sol"])
        apply(rule exI[where x="t"])
        apply(rule conjI) 
         apply(rule refl)
        apply(rule conjI)
         apply(rule t)
        apply(rule conjI)
         using sol apply blast
        by (rule sol0)
      have bigRes:"?my\<omega> \<in> fml_sem I (Pc pid1)" using bigAll bigEx by blast
      have notin1:"Inl vid1 \<notin> BVO ODE" using disj by auto
      have notin2:"Inr vid1 \<notin> BVO ODE" using disj by auto
      have ODE_sem:"ODE_sem I ODE (sol t) $ vid1 = 0"
        using ODE_zero notin1 notin2 
        by blast 
      have vec_eq:"(\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol t)) =
            (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))"
        apply(rule vec_extensionality)
        apply simp
        using mk_v_agree[of I "(OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
        by(simp add: Vagree_def)
      have sem_eq:"(?my\<omega> \<in> fml_sem I (Pc pid1)) = ((repd (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
      (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))
        (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))) \<in> fml_sem I (Pc pid1))"
        apply(rule coincidence_formula)
          subgoal by simp
         subgoal by (rule Iagree_refl)
        using mk_v_agree[of "I" "(OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
        unfolding Vagree_def 
        apply simp
        apply(erule conjE)+
        apply(erule allE[where x="vid1"])+
        apply(simp add: ODE_sem)
        using vec_eq by simp
      show  "repd (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
       (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))
         (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))
      \<in> fml_sem I (Pc pid1)"
        using bigRes sem_eq by blast
    next
      fix I::"('sf,'sc,'sz)interp" 
      and aa ba ab bb sol 
      and t::real
      assume good_interp:"is_interp I"
      assume all:"\<forall>\<omega>. (\<exists>\<nu> sol t. ((ab, bb), \<omega>) = (\<nu>, mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> (sol t)) \<and>
                        0 \<le> t \<and>
                        (sol solves_ode (\<lambda>_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
                         {x. Predicates I vid2
                              (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                     (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> x))} \<and>
                        sol 0 = fst \<nu>) \<longrightarrow>
              (\<forall>\<omega>'. \<omega>' = repd \<omega> vid1 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) \<omega>) \<longrightarrow> \<omega>' \<in> fml_sem I (Pc pid1))"
       let ?my\<omega> = "mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)" 
       assume t:"0 \<le> t"
       assume aaba:"(aa, ba) = mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)"
       assume sol:"
         (sol solves_ode (\<lambda>_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
          {x. Predicates I vid2
               (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                     (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) x))}"
       assume sol0:"sol 0 = fst (ab, bb)"
       have bigEx:"(\<exists>\<nu> sol t. ((ab, bb), ?my\<omega>) = (\<nu>, mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> (sol t)) \<and>
                       0 \<le> t \<and>
                       (sol solves_ode (\<lambda>_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
                        {x. Predicates I vid2
                             (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                    (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) \<nu> x))} \<and>
                       sol 0 = fst \<nu>)"
         apply(rule exI[where x="(ab, bb)"])
         apply(rule exI[where x=sol])
         apply(rule exI[where x=t])
         apply(rule conjI)
          apply(rule refl)
         apply(rule conjI)
          apply(rule t)
         apply(rule conjI)
          using sol sol0 by(blast)+
       have rep_sem_eq:"repd (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
                  (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))
                    (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))  \<in> fml_sem I (Pc pid1)
          = (repd ?my\<omega> vid1 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) ?my\<omega>) \<in> fml_sem I (Pc pid1))"
         apply(rule coincidence_formula)
           subgoal by simp
          subgoal by (rule Iagree_refl)
         by(simp add: Vagree_def)
       have notin1:"Inl vid1 \<notin> BVO ODE" using disj by auto
       have notin2:"Inr vid1 \<notin> BVO ODE" using disj by auto
       have ODE_sem:"ODE_sem I ODE (sol t) $ vid1 = 0"
         using ODE_zero notin1 notin2 
         by blast 
       have vec_eq:"
       (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
              (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t))) =
       (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol t))"
         apply(rule vec_extensionality)
         using mk_v_agree[of I "(OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
         by (simp add: Vagree_def)
       have sem_eq:
         "(repd ?my\<omega> vid1 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) ?my\<omega>) \<in> fml_sem I (Pc pid1)) 
      = (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t) \<in> fml_sem I (Pc pid1)) "
         apply(rule coincidence_formula)
           subgoal by simp
          subgoal by (rule Iagree_refl)
         using mk_v_agree[of I "(OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
         unfolding Vagree_def apply simp
         apply(erule conjE)+
         apply(erule allE[where x=vid1])+
         by (simp add: ODE_sem vec_eq)
       have some_sem:"repd (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
                 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))
                   (mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t))) \<in> fml_sem I (Pc pid1)"
         using rep_sem_eq 
         using all bigEx by blast
       have bigImp:"(\<forall>\<omega>'. \<omega>' = repd ?my\<omega> vid1 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) ?my\<omega>) \<longrightarrow> \<omega>' \<in> fml_sem I (Pc pid1))"
         apply(rule allI)
         apply(rule impI)
         apply auto
         using some_sem by auto
       have fml_sem:"repd ?my\<omega> vid1 (dterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) ?my\<omega>) \<in> fml_sem I (Pc pid1)"
         using sem_eq bigImp by blast
      show "mk_v I (OProd  (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t) \<in> fml_sem I (Pc pid1)"
        using fml_sem sem_eq by blast
    qed
 qed
 
 lemma DC_valid:"valid DCaxiom" 
 proof (auto simp only: fml_sem.simps prog_sem.simps DCaxiom_def valid_def iff_sem impl_sem box_sem, auto)
   fix I::"('sf,'sc,'sz) interp" and aa ba bb sol t
   assume "is_interp I"
     and all3:"\<forall>a b. (\<exists>sola. sol 0 = sola 0 \<and>
                   (\<exists>t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                         0 \<le> t \<and> (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV})) \<longrightarrow>
            (a, b) \<in> Contexts I pid3 UNIV"
     and all2:"\<forall>a b. (\<exists>sola. sol 0 = sola 0 \<and>
                    (\<exists>t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                         0 \<le> t \<and> (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV})) \<longrightarrow>
            (a, b) \<in> Contexts I pid2 UNIV"
     and t:"0 \<le> t"
     and aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, bb) (sol t)"
     and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
        {x. mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid1 UNIV \<and> mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid3 UNIV}"
     from sol have
           sol1:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid1 UNIV}"
       by (metis (mono_tags, lifting) Collect_mono solves_ode_supset_range)
     from all2 have all2':"\<And>v. (\<exists>sola. sol 0 = sola 0 \<and>
                    (\<exists>t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                         0 \<le> t \<and> (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV})) \<Longrightarrow>
            v \<in> Contexts I pid2 UNIV" by auto
     show "mk_v I (OVar vid1) (sol 0, bb) (sol t) \<in> Contexts I pid2 UNIV" 
       apply(rule all2'[of "mk_v I (OVar vid1) (sol 0, bb) (sol t)"])
       apply(rule exI[where x=sol])
       apply(rule conjI)
        subgoal by (rule refl)
       subgoal using t sol1 by auto
      done
 next
   fix I::"('sf,'sc,'sz) interp" and  aa ba bb sol t
   assume "is_interp I"
   and all3:"\<forall>a b. (\<exists>sola. sol 0 = sola 0 \<and>
                 (\<exists>t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                      0 \<le> t \<and> (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV})) \<longrightarrow>
         (a, b) \<in> Contexts I pid3 UNIV"
   and all2:"\<forall>a b. (\<exists>sola. sol 0 = sola 0 \<and>
                 (\<exists>t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                      0 \<le> t \<and>
                      (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
                        {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV \<and>
                           mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid3 UNIV})) \<longrightarrow>
         (a, b) \<in> Contexts I pid2 UNIV"
   and t:"0 \<le> t"
   and aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, bb) (sol t)"
   and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid1 UNIV}"
   from all2 
   have all2':"\<And>v. (\<exists>sola. sol 0 = sola 0 \<and>
                 (\<exists>t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                      0 \<le> t \<and>
                      (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
                       {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV \<and>
                           mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid3 UNIV})) \<Longrightarrow>
         v \<in> Contexts I pid2 UNIV"
     by auto
   from all3
   have all3':"\<And>v. (\<exists>sola. sol 0 = sola 0 \<and>
                 (\<exists>t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) \<and>
                      0 \<le> t \<and> (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x \<in> Contexts I pid1 UNIV})) \<Longrightarrow>
         v \<in> Contexts I pid3 UNIV"
     by auto
   have inp1:"\<And>s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> mk_v I (OVar vid1) (sol 0, bb) (sol s) \<in> Contexts I pid1 UNIV"
     using sol solves_odeD atLeastAtMost_iff by blast
   have inp3:"\<And>s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> mk_v I (OVar vid1) (sol 0, bb) (sol s) \<in> Contexts I pid3 UNIV"
     apply(rule all3')
     subgoal for s 
       apply(rule exI [where x=sol])
       apply(rule conjI)
        subgoal by (rule refl)
       apply(rule exI [where x=s])
       apply(rule conjI)
        subgoal by (rule refl)
       apply(rule conjI)
        subgoal by assumption
       subgoal using sol by (meson atLeastatMost_subset_iff order_refl solves_ode_subset)
       done
    done
    have inp13:"\<And>s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> mk_v I (OVar vid1) (sol 0, bb) (sol s) \<in> Contexts I pid1 UNIV \<and> mk_v I (OVar vid1) (sol 0, bb) (sol s) \<in> Contexts I pid3 UNIV"
      using inp1 inp3 by auto
    have sol13:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
      {x. mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid1 UNIV \<and> mk_v I (OVar vid1) (sol 0, bb) x \<in> Contexts I pid3 UNIV}"
      apply(rule solves_odeI)
       subgoal using sol by (rule solves_odeD)
      subgoal for s using inp13[of s] by auto
      done
   show "mk_v I (OVar vid1) (sol 0, bb) (sol t) \<in> Contexts I pid2 UNIV"
     using t sol13 all2'[of "mk_v I (OVar vid1) (sol 0, bb) (sol t)"] by auto
 qed
 
 lemma DS_valid:"valid DSaxiom"
 proof -
   have dsafe:"dsafe($f fid1 (\<lambda>i. Const 0))"
     using dsafe_Const by auto
   have osafe:"osafe(OSing vid1 (f0 fid1))"
     unfolding f0_def empty_def
     using dsafe osafe.intros
     by (simp add: osafe_Sing dfree_Const)
   have fsafe:"fsafe(p1 vid2 vid1)"
     unfolding p1_def
     apply(rule fsafe_Prop)
     using singleton.simps dsafe_Const by (auto intro: dfree.intros)
   show "valid DSaxiom"
     apply(auto simp only: DSaxiom_def valid_def Let_def iff_sem impl_sem box_sem)
      apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq  iff_sem impl_sem box_sem forall_sem)
   proof -
     fix I::"('sf,'sc,'sz) interp" 
       and a b r aa ba
     assume good_interp:"is_interp I"
     assume allW:"\<forall>\<omega>. (\<exists>\<nu> sol t.
              ((a, b), \<omega>) = (\<nu>, mk_v I (OSing vid1 (f0 fid1)) \<nu> (sol t)) \<and>
              0 \<le> t \<and>
              (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
               {x. mk_v I (OSing vid1 (f0 fid1)) \<nu> x \<in> fml_sem I (p1 vid2 vid1)} \<and>
               (sol 0) = (fst \<nu>)) \<longrightarrow>
          \<omega> \<in> fml_sem I (p1 vid3 vid1)"
     assume "dterm_sem I (Const 0) (repv (a, b) vid2 r) \<le> dterm_sem I (trm.Var vid2) (repv (a, b) vid2 r)"
     hence leq:"0 \<le> r" by (auto)
     assume "\<forall>ra. repv (repv (a, b) vid2 r) vid3 ra
          \<in> {v. dterm_sem I (Const 0) v \<le> dterm_sem I (trm.Var vid3) v} \<inter>
             {v. dterm_sem I (trm.Var vid3) v \<le> dterm_sem I (trm.Var vid2) v} \<longrightarrow>
          Predicates I vid2
           (\<chi> i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                  (repv (repv (a, b) vid2 r) vid3 ra))"
     hence constraint:"\<forall>ra. (0 \<le> ra \<and> ra \<le> r) \<longrightarrow> 
          (repv (repv (a, b) vid2 r) vid3 ra) 
        \<in> fml_sem I (Prop vid2 (singleton (Plus (Var vid1) (Times (f0 fid1) (Var vid3)))))"
       using leq by auto
     assume aaba:" (aa, ba) =
      repv (repv (a, b) vid2 r) vid1
       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))"
     let ?abba = "repv (repd (a, b) vid1 (Functions I fid1 (\<chi> i. 0))) vid1
       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))"
     from allW have thisW:"(\<exists>\<nu> sol t.
             ((a, b), ?abba) = (\<nu>, mk_v I (OSing vid1 (f0 fid1)) \<nu> (sol t)) \<and>
             0 \<le> t \<and>
             (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
              {x. mk_v I (OSing vid1 (f0 fid1)) \<nu> x \<in> fml_sem I (p1 vid2 vid1)} \<and>
              (sol 0) = (fst \<nu>)) \<longrightarrow>
         ?abba \<in> fml_sem I (p1 vid3 vid1)" by blast
     let ?c = "Functions I fid1 (\<chi> _. 0)"
     let ?sol = "(\<lambda>t. \<chi> i. if i = vid1 then (a $ i) + ?c * t else (a $ i))"
     have agrees:"Vagree (mk_v I (OSing vid1 (f0 fid1)) (a, b) (?sol r)) (a, b) (- semBV I (OSing vid1 (f0 fid1))) 
   \<and> Vagree (mk_v I (OSing vid1 (f0 fid1)) (a, b) (?sol r))
    (mk_xode I (OSing vid1 (f0 fid1)) (?sol r)) (semBV I (OSing vid1 (f0 fid1)))" 
        using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(a,b)" "(?sol r)"] by auto
     have prereq1a:"fst ?abba
      = fst (mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))"
       using  agrees aaba 
       apply (auto simp add: aaba Vagree_def)
        apply (rule vec_extensionality)
        subgoal for i
          apply (cases "i = vid1")
           using vne12 agrees Vagree_def apply (auto simp add: aaba f0_def empty_def)
          done
       apply (rule vec_extensionality)
       subgoal for i
         apply (cases "i = vid1")
          apply(auto  simp add: f0_def empty_def)
       done
     done
   have prereq1b:"snd (?abba) = snd (mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))"
     using agrees aaba 
     apply (auto simp add: aaba Vagree_def)
     apply (rule vec_extensionality)
     subgoal for i
       apply (cases "i = vid1")
        using vne12 agrees Vagree_def apply (auto simp add: aaba f0_def empty_def )
       done
     done  
   have "?abba = mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r)"
     using prod_eq_iff prereq1a prereq1b by blast
   hence req1:"((a, b), ?abba) = ((a, b), mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))" by auto
   have "sterm_sem I ($f fid1 (\<lambda>i. Const 0)) b = Functions I fid1 (\<chi> i. 0)" by auto
   hence vec_simp:"(\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I ($f fid1 (\<lambda>i. Const 0)) b else 0) 
       = (\<lambda>a b. \<chi> i. if i = vid1 then Functions I fid1 (\<chi> i. 0) else 0)"
     by (auto simp add: vec_eq_iff cong: if_cong)
   have sub: "{0..r} \<subseteq> UNIV" by auto
   have sub2:"{x. mk_v I (OSing vid1 (f0 fid1)) (a,b) x \<in> fml_sem I (p1 vid2 vid1)} \<subseteq> UNIV" by auto
   have req3:"(?sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..r}
             {x. mk_v I (OSing vid1 (f0 fid1)) (a,b) x \<in> fml_sem I (p1 vid2 vid1)}" 
     apply(auto simp add: f0_def empty_def vec_simp) 
     apply(rule solves_odeI)
      apply(auto simp only: has_vderiv_on_def has_vector_derivative_def box_sem)
      apply (rule has_derivative_vec[THEN has_derivative_eq_rhs])
       defer
       apply (rule ext)
       apply (subst scaleR_vec_def)
       apply (rule refl)
      apply (auto intro!: derivative_eq_intros)
     \<comment> \<open>Domain constraint satisfied\<close>
     using constraint apply (auto)
     subgoal for t
       apply(erule allE[where x="t"])
       apply(auto simp add: p1_def)
     proof -
       have eq:"(\<chi> i. dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
             (\<chi> y. if vid3 = y then t else fst (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) $ y, b)) =
             (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
               (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (a, b)
                 (\<chi> i. if i = vid1 then a $ i + Functions I fid1 (\<chi> _. 0) * t else a $ i)))"
         using vne12 vne13 mk_v_agree[of "I" "(OSing vid1 ($f fid1 (\<lambda>i. Const 0)))" "(a, b)" "(\<chi> i. if i = vid1 then a $ i + Functions I fid1 (\<chi> _. 0) * t else a $ i)"]
         by (auto simp add: vec_eq_iff f0_def empty_def Vagree_def)
       show "0 \<le> t \<Longrightarrow>
     t \<le> r \<Longrightarrow>
     Predicates I vid2
      (\<chi> i. dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
             (\<chi> y. if vid3 = y then t else fst (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) $ y, b)) \<Longrightarrow>
     Predicates I vid2
      (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (a, b)
               (\<chi> i. if i = vid1 then a $ i + Functions I fid1 (\<chi> _. 0) * t else a $ i)))" 
         using eq by auto
     qed
     done
   have req4':"?sol 0 = fst (a,b)" by (auto simp: vec_eq_iff)
   then have req4: " (?sol 0) = (fst (a,b))"
     using VSagree_refl[of a] req4' unfolding VSagree_def by auto
   have inPred:"?abba \<in> fml_sem I (p1 vid3 vid1)"  
     using req1 leq req3 req4 thisW by fastforce
   have sem_eq:"?abba \<in> fml_sem I (p1 vid3 vid1) \<longleftrightarrow> (aa,ba) \<in> fml_sem I (p1 vid3 vid1)"
     apply (rule coincidence_formula)
       apply (auto simp add: aaba Vagree_def p1_def f0_def empty_def)
     subgoal using Iagree_refl by auto
     done
   from inPred sem_eq have  inPred':"(aa,ba) \<in> fml_sem I (p1 vid3 vid1)"
     by auto
   \<comment> \<open>thus by lemma 6 consequence for formulas\<close>
   show "repv (repv (a, b) vid2 r) vid1
        (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))
        \<in> fml_sem I (p1 vid3 vid1)" 
     using aaba inPred' by (auto)
 next
   fix I::"('sf,'sc,'sz) interp"
   and aa ba ab bb sol 
   and t:: real
   assume good_interp:"is_interp I"
   assume all:"
        \<forall>r. dterm_sem I (Const 0) (repv (ab, bb) vid2 r) \<le> dterm_sem I (trm.Var vid2) (repv (ab, bb) vid2 r) \<longrightarrow>
            (\<forall>ra. repv (repv (ab, bb) vid2 r) vid3 ra
                  \<in> {v. dterm_sem I (Const 0) v \<le> dterm_sem I (trm.Var vid3) v} \<inter>
                     {v. dterm_sem I (trm.Var vid3) v \<le> dterm_sem I (trm.Var vid2) v} \<longrightarrow>
                  Predicates I vid2
                   (\<chi> i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                          (repv (repv (ab, bb) vid2 r) vid3 ra))) \<longrightarrow>
                          
            (\<forall>\<omega>. \<omega> = repv (repv (ab, bb) vid2 r) vid1
                       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 r)) \<longrightarrow>
                  \<omega> \<in> fml_sem I (p1 vid3 vid1))"
   assume t:"0 \<le> t"
   assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol t)"
   assume sol:"(sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
         {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"
   hence constraint:"\<And>s. s \<in> {0 .. t} \<Longrightarrow> sol s \<in> {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"
     using solves_ode_domainD by fastforce
   \<comment> \<open>\<open>sol 0 = fst (ab, bb)\<close>\<close>
   assume sol0:"  (sol 0) = (fst (ab, bb)) "
   have impl:"dterm_sem I (Const 0) (repv (ab, bb) vid2 t) \<le> dterm_sem I (trm.Var vid2) (repv (ab, bb) vid2 t) \<longrightarrow>
            (\<forall>ra. repv (repv (ab, bb) vid2 t) vid3 ra
                  \<in> {v. dterm_sem I (Const 0) v \<le> dterm_sem I (trm.Var vid3) v} \<inter>
                     {v. dterm_sem I (trm.Var vid3) v \<le> dterm_sem I (trm.Var vid2) v} \<longrightarrow>
                  Predicates I vid2
                   (\<chi> i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                          (repv (repv (ab, bb) vid2 t) vid3 ra))) \<longrightarrow>
            (\<forall>\<omega>. \<omega> = repv (repv (ab, bb) vid2 t) vid1
                       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 t)) \<longrightarrow>
                  \<omega> \<in> fml_sem I (p1 vid3 vid1))" using all by auto
   interpret ll:ll_on_open_it UNIV "(\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))" "UNIV" 0
     apply(standard)
         apply(auto)
      unfolding local_lipschitz_def f0_def empty_def sterm_sem.simps 
      using gt_ex lipschitz_on_constant by blast
   have eq_UNIV:"ll.existence_ivl 0 (sol 0) = UNIV"
     apply(rule ll.existence_ivl_eq_domain)
         apply(auto)
     subgoal for tm tM t
       apply(unfold f0_def empty_def sterm_sem.simps)
       by(metis add.right_neutral mult_zero_left order_refl)
     done
   \<comment> \<open>Combine with \<open>flow_usolves_ode\<close> and \<open>equals_flowI\<close> to get uniqueness of solution\<close>
   let ?f = "(\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))"
   have sol_UNIV: "\<And>t x. (ll.flow 0 x usolves_ode ?f from 0) (ll.existence_ivl 0 x) UNIV"
     using ll.flow_usolves_ode by auto    
   from sol have sol':
     "(sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t} UNIV"
     apply (rule solves_ode_supset_range)
     by auto
   from sol' have sol'':"\<And>s. s \<ge> 0 \<Longrightarrow> s \<le> t \<Longrightarrow> (sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..s} UNIV"
     by (simp add: solves_ode_subset)
   have sol0_eq:"sol 0 = ll.flow  0 (sol 0) 0"
     using ll.general.flow_initial_time_if by auto
   have isFlow:"\<And>s. s \<ge> 0 \<Longrightarrow> s \<le> t \<Longrightarrow> sol s = ll.flow 0 (sol 0) s"
     apply(rule ll.equals_flowI)
          apply(auto)
       subgoal using eq_UNIV by auto
      subgoal using sol'' closed_segment_eq_real_ivl t by (auto simp add: solves_ode_singleton)
     subgoal using eq_UNIV sol sol0_eq by auto
     done
   let ?c = "Functions I fid1 (\<chi> _. 0)"
   let ?sol = "(\<lambda>t. \<chi> i. if i = vid1 then (ab $ i) + ?c * t else (ab $ i))"
   have vec_simp:"(\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I ($f fid1 (\<lambda>i. Const 0)) b else 0) 
       = (\<lambda>a b. \<chi> i. if i = vid1 then Functions I fid1 (\<chi> i. 0) else 0)"
     by (auto simp add: vec_eq_iff cong: if_cong)
   have exp_sol:"(?sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
     UNIV"
     apply(auto simp add: f0_def empty_def vec_simp) 
     apply(rule solves_odeI)
      apply(auto simp only: has_vderiv_on_def has_vector_derivative_def box_sem)
     apply (rule has_derivative_vec[THEN has_derivative_eq_rhs])
      defer
      apply (rule ext)
      apply (subst scaleR_vec_def)
      apply (rule refl)
     apply (auto intro!: derivative_eq_intros)
     done
   from exp_sol have exp_sol':"\<And>s. s \<ge> 0 \<Longrightarrow> s \<le> t \<Longrightarrow> (?sol solves_ode (\<lambda>_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..s} UNIV"
     by (simp add: solves_ode_subset)
   have exp_sol0_eq:"?sol 0 = ll.flow  0 (?sol 0) 0"
     using ll.general.flow_initial_time_if by auto
   have more_eq:"(\<chi> i. if i = vid1 then ab $ i + Functions I fid1 (\<chi> _. 0) * 0 else ab $ i) = sol 0"
     using sol0 
     apply auto 
     apply(rule vec_extensionality)
     by(auto)
   have exp_isFlow:"\<And>s. s \<ge> 0 \<Longrightarrow> s \<le> t \<Longrightarrow> ?sol s = ll.flow 0 (sol 0) s"
     apply(rule ll.equals_flowI)
          apply(auto)
       subgoal using eq_UNIV by auto
      defer
      subgoal for s 
        using eq_UNIV apply auto
        subgoal using exp_sol exp_sol0_eq more_eq 
          apply(auto)
          done
        done
     using exp_sol' closed_segment_eq_real_ivl t apply(auto)
     by (simp add: solves_ode_singleton)
   have sol_eq_exp:"\<And>s. s \<ge> 0 \<Longrightarrow> s \<le> t \<Longrightarrow> ?sol s = sol s"
     unfolding exp_isFlow isFlow by auto
   then have sol_eq_exp_t:"?sol t = sol t"
     using t by auto
   then have sol_eq_exp_t':"sol t $ vid1 = ?sol t $ vid1" by auto
   then have useful:"?sol t $ vid1 = ab $ vid1 + Functions I fid1 (\<chi> i. 0) * t"
     by auto
   from sol_eq_exp_t' useful have useful':"sol t $ vid1 = ab $ vid1 + Functions I fid1 (\<chi> i. 0) * t"
     by auto
   have sol_int:"((ll.flow 0 (sol 0)) usolves_ode ?f from 0) {0..t} {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"
     apply (rule usolves_ode_subset_range[of "(ll.flow 0 (sol 0))" "?f" "0" "{0..t}" "UNIV" "{x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x \<in> fml_sem I (p1 vid2 vid1)}"]) 
       subgoal using eq_UNIV sol_UNIV[of "(sol 0)"] apply (auto)
         apply (rule usolves_ode_subset)
            using t by(auto)
     apply(auto)
     using sol apply(auto  dest!: solves_ode_domainD)
     subgoal for xa using isFlow[of xa] by(auto)
     done
   have thing:"\<And>s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> fst (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (ab, bb) (?sol s)) $ vid1 = ab $ vid1 + Functions I fid1 (\<chi> i. 0) * s"
     subgoal for s
       using mk_v_agree[of I "(OSing vid1 ($f fid1 (\<lambda>i. Const 0)))" "(ab, bb)" "(?sol s)"] apply auto
       unfolding Vagree_def by auto
     done
   have thing':"\<And>s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow>  fst (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (ab, bb) (sol s)) $ vid1 = ab $ vid1 + Functions I fid1 (\<chi> i. 0) * s"
     subgoal for s using thing[of s] sol_eq_exp[of s] by auto done
   have another_eq:"\<And>i s. 0 \<le> s \<Longrightarrow> s \<le> t \<Longrightarrow> dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                 (mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol s))
 
         =  dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
                 (\<chi> y. if vid3 = y then s else fst (\<chi> y. if vid2 = y then s else fst (ab, bb) $ y, bb) $ y, bb)"
     using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol s)"]  vne12 vne23 vne13
     apply(auto simp add: f0_def p1_def empty_def)
     unfolding Vagree_def apply(simp add: f0_def empty_def)
     subgoal for s using thing' by auto
     done
   have allRa':"(\<forall>ra. repv (repv (ab, bb) vid2 t) vid3 ra
                \<in> {v. dterm_sem I (Const 0) v \<le> dterm_sem I (trm.Var vid3) v} \<inter>
                   {v. dterm_sem I (trm.Var vid3) v \<le> dterm_sem I (trm.Var vid2) v} \<longrightarrow>
                Predicates I vid2
                 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                 (mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol ra))))"
     apply(rule allI)
     subgoal for ra
       using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol ra)"]
          vne23 constraint[of ra] apply(auto simp add: Vagree_def p1_def)
     done
   done
   have anotherFact:"\<And>ra. 0 \<le> ra \<Longrightarrow> ra \<le> t \<Longrightarrow> (\<chi> i. if i = vid1 then ab $ i + Functions I fid1 (\<chi> _. 0) * ra else ab $ i) $ vid1 =
      ab $ vid1 + dterm_sem I (f0 fid1) (\<chi> y. if vid3 = y then ra else fst (\<chi> y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y, bb) * ra "
     subgoal for ra
       apply simp
       apply(rule disjI2)
       by (auto simp add: f0_def empty_def)
     done
   have thing':"\<And>ra i. 0 \<le> ra \<Longrightarrow> ra \<le> t \<Longrightarrow> dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (ab, bb) (sol ra))
       =  dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
             (\<chi> y. if vid3 = y then ra else fst (\<chi> y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y, bb) "
     subgoal for ra i
       using vne12 vne13 mk_v_agree[of I "OSing vid1 ($f fid1 (\<lambda>i. Const 0))" "(ab,bb)" "(sol ra)"] 
       apply (auto)
       unfolding Vagree_def apply(safe)
       apply(erule allE[where x="vid1"])+
       using sol_eq_exp[of ra] anotherFact[of ra] by auto
     done
   have allRa:"(\<forall>ra. repv (repv (ab, bb) vid2 t) vid3 ra
                \<in> {v. dterm_sem I (Const 0) v \<le> dterm_sem I (trm.Var vid3) v} \<inter>
                   {v. dterm_sem I (trm.Var vid3) v \<le> dterm_sem I (trm.Var vid2) v} \<longrightarrow>
                Predicates I vid2
                 (\<chi> i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                        (repv (repv (ab, bb) vid2 t) vid3 ra)))"
     apply(rule allI)
     subgoal for ra
       using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol ra)"]
          vne23 constraint[of ra] apply(auto simp add: Vagree_def p1_def)
       using sol_eq_exp[of ra]  apply (auto simp add: f0_def empty_def Vagree_def vec_eq_iff)
       using thing' by auto
     done
   have fml3:"\<And>ra. 0 \<le> ra \<Longrightarrow> ra \<le> t \<Longrightarrow>
            (\<forall>\<omega>. \<omega> = repv (repv (ab, bb) vid2 t) vid1
                       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 t)) \<longrightarrow>
                  \<omega> \<in> fml_sem I (p1 vid3 vid1))"
     using impl allRa by auto       
   have someEq:"(\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (\<chi> y. if vid1 = y then (if vid2 = vid1 then t else fst (ab, bb) $ vid1) + Functions I fid1 (\<chi> i. 0) * t
                   else fst (\<chi> y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y,
              bb)) 
              = (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. Const 0))) (ab, bb) (sol t)))"
     apply(rule vec_extensionality)
     using vne12 sol_eq_exp t thing by auto
   show "mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol t) \<in> fml_sem I (p1 vid3 vid1)"
     using mk_v_agree[of I "OSing vid1 (f0 fid1)" "(ab, bb)" "sol t"] fml3[of t]
     unfolding f0_def p1_def empty_def Vagree_def 
     using someEq by(auto simp add:  sol_eq_exp_t' t vec_extensionality  vne12)
 qed qed
 
 lemma MVT0_within:
   fixes f ::"real \<Rightarrow> real"
     and f'::"real \<Rightarrow> real \<Rightarrow> real"
     and s t :: real
   assumes f':"\<And>x. x \<in> {0..t} \<Longrightarrow> (f has_derivative (f' x)) (at x  within {0..t})"
   assumes geq':"\<And>x. x \<in> {0..t} \<Longrightarrow> f' x s \<ge> 0"
   assumes int_s:"s > 0 \<and> s \<le> t"
   assumes t: "0 < t"
   shows "f s \<ge> f 0"
 proof -
   have "f 0 + 0 \<le> f s"   
     apply (rule Lib.MVT_ivl'[OF f', of 0 s 0])
       subgoal for x by assumption
      subgoal for x using geq' by auto 
     using t int_s t apply auto
     subgoal for x
       by (metis int_s mult.commute mult.right_neutral order.trans real_mult_le_cancel_iff2)
     done
   then show "?thesis" by auto 
 qed
 
 lemma MVT':
   fixes f g ::"real \<Rightarrow> real"
   fixes f' g'::"real \<Rightarrow> real \<Rightarrow> real"
   fixes s t ::real
   assumes f':"\<And>s. s \<in> {0..t} \<Longrightarrow> (f has_derivative (f' s)) (at s within {0..t})"
   assumes g':"\<And>s. s \<in> {0..t} \<Longrightarrow> (g has_derivative (g' s)) (at s within {0..t})"
   assumes geq':"\<And>x. x \<in> {0..t} \<Longrightarrow> f' x s \<ge> g' x s"
   assumes geq0:"f 0 \<ge> g 0"
   assumes int_s:"s > 0 \<and> s \<le> t"
   assumes t:"t > 0"
   shows "f s \<ge> g s"
 proof -
   let ?h = "(\<lambda>x. f x - g x)"
   let ?h' = "(\<lambda>s x. f' s x - g' s x)"
   have "?h s \<ge> ?h 0"
     apply(rule MVT0_within[of t ?h "?h'" s])
        subgoal for s using f'[of s] g'[of s] by auto
       subgoal for sa using geq'[of sa] by auto
      subgoal using int_s by auto
     subgoal using t by auto
     done
   then show "?thesis" using geq0 by auto
 qed
 
 lemma MVT'_gr:
   fixes f g ::"real \<Rightarrow> real"
   fixes f' g'::"real \<Rightarrow> real \<Rightarrow> real"
   fixes s t ::real
   assumes f':"\<And>s. s \<in> {0..t} \<Longrightarrow> (f has_derivative (f' s)) (at s within {0..t})"
   assumes g':"\<And>s. s \<in> {0..t} \<Longrightarrow> (g has_derivative (g' s)) (at s within {0..t})"
   assumes geq':"\<And>x. x \<in> {0..t} \<Longrightarrow> f' x s \<ge> g' x s"
   assumes geq0:"f 0 > g 0"
   assumes int_s:"s > 0 \<and> s \<le> t"
   assumes t:"t > 0"
   shows "f s > g s"
 proof -
   let ?h = "(\<lambda>x. f x - g x)"
   let ?h' = "(\<lambda>s x. f' s x - g' s x)"
   have "?h s \<ge> ?h 0"
     apply(rule MVT0_within[of t ?h "?h'" s])
        subgoal for s using f'[of s] g'[of s] by auto
       subgoal for sa using geq'[of sa] by auto
      subgoal using int_s by auto
     subgoal using t by auto
     done
   then show "?thesis" using geq0 by auto
 qed
 
 lemma frech_linear:
   fixes x \<theta> \<nu> \<nu>' I
   assumes good_interp:"is_interp I"
   assumes free:"dfree \<theta>"
   shows "x * frechet I \<theta> \<nu> \<nu>' = frechet I \<theta> \<nu> (x *\<^sub>R \<nu>')"
   using frechet_linear[OF good_interp free]
   by (simp add: linear_simps)
     
 lemma rift_in_space_time:
   fixes sol I ODE \<psi> \<theta> t s b
   assumes good_interp:"is_interp I"
   assumes free:"dfree \<theta>"
   assumes osafe:"osafe ODE"
   assumes sol:"(sol solves_ode (\<lambda>_ \<nu>'. ODE_sem I ODE \<nu>')) {0..t} 
           {x. mk_v I ODE (sol 0, b) x \<in> fml_sem I \<psi>}"
   assumes FVT:"FVT \<theta> \<subseteq> semBV I ODE"  
   assumes ivl:"s \<in> {0..t}"
   shows "((\<lambda>t. sterm_sem I \<theta> (fst (mk_v I ODE (sol 0, b) (sol t))))
     \<comment> \<open>This is Frechet derivative, so equivalent to:\<close>
     \<comment> \<open>\<open>has_real_derivative frechet I \<theta> (fst((mk_v I ODE (sol 0, b) (sol s)))) (snd (mk_v I ODE (sol 0, b) (sol s))))) (at s within {0..t})\<close>\<close>
     has_derivative (\<lambda>t'. t' * frechet I \<theta> (fst((mk_v I ODE (sol 0, b) (sol s)))) (snd (mk_v I ODE (sol 0, b) (sol s))))) (at s within {0..t})"
 proof -
   let ?\<phi> = "(\<lambda>t. (mk_v I ODE (sol 0, b) (sol t)))"
   let ?\<phi>s = "(\<lambda>t. fst (?\<phi> t))"
   have sol_deriv:"\<And>s. s \<in> {0..t} \<Longrightarrow> (sol has_derivative (\<lambda>xa. xa *\<^sub>R ODE_sem I ODE (sol s))) (at s within {0..t})"
     using sol apply simp 
     apply (drule solves_odeD(1))
     unfolding has_vderiv_on_def has_vector_derivative_def
     by auto
   have sol_dom:"\<And>s. s\<in> {0..t} \<Longrightarrow> ?\<phi> s \<in> fml_sem I \<psi>"
     using sol apply simp
     apply (drule solves_odeD(2))
      by auto
   let ?h = "(\<lambda>t. sterm_sem I \<theta> (?\<phi>s t))"
   let ?g = "(\<lambda>\<nu>. sterm_sem I \<theta> \<nu>)"
   let ?f = "?\<phi>s"
   let ?f' = "(\<lambda>t'. t' *\<^sub>R (\<chi> i. if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0))"
   let ?g' = "(frechet I \<theta> (?\<phi>s s))"
   have heq:"?h = ?g \<circ> ?f" by (auto)
   have fact1:"\<And>i. i \<in> ODE_vars I ODE \<Longrightarrow> (\<lambda>t. ?\<phi>s(t) $ i) = (\<lambda>t. sol t $ i)"
     subgoal for i
       apply(rule ext)
       subgoal for t
         using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
         unfolding Vagree_def by auto
       done done
   have fact2:"\<And>i. i \<in> ODE_vars I ODE \<Longrightarrow> (\<lambda>t. if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol t) $ i else 0) = (\<lambda>t. ODE_sem I ODE (sol t) $ i)"
     subgoal for i
       apply(rule ext)
       subgoal for t
         using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
         unfolding Vagree_def by auto
       done done
   have fact3:"\<And>i. i \<in> (-ODE_vars I ODE) \<Longrightarrow> (\<lambda>t. ?\<phi>s(t) $ i) = (\<lambda>t. sol 0 $ i)"
     subgoal for i
       apply(rule ext)
       subgoal for t
         using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
         unfolding Vagree_def by auto
       done done
   have fact4:"\<And>i. i \<in> (-ODE_vars I ODE) \<Longrightarrow> (\<lambda>t. if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol t) $ i else 0) = (\<lambda>t. 0)"
     subgoal for i
       apply(rule ext)
       subgoal for t
         using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
         unfolding Vagree_def by auto
       done done
   have some_eq:"(\<lambda>v'. \<chi> i. v' *\<^sub>R ODE_sem I ODE (sol s) $ i) = (\<lambda>v'. v' *\<^sub>R ODE_sem I ODE (sol s))"
     apply(rule ext)
     apply(rule vec_extensionality)
     by auto
   have some_sol:"(sol has_derivative (\<lambda>v'. v' *\<^sub>R ODE_sem I ODE (sol s))) (at s within {0..t})"
     using sol ivl unfolding solves_ode_def has_vderiv_on_def has_vector_derivative_def by auto
   have some_eta:"(\<lambda>t. \<chi> i. sol t $ i) = sol" by (rule ext, rule vec_extensionality, auto)
   have ode_deriv:"\<And>i. i \<in> ODE_vars I ODE \<Longrightarrow> 
     ((\<lambda>t. sol t $ i) has_derivative (\<lambda> v'. v' *\<^sub>R ODE_sem I ODE (sol s) $ i)) (at s within {0..t})"
     subgoal for i
       apply(rule has_derivative_proj)
       using some_eq some_sol some_eta by auto
     done
   have eta:"(\<lambda>t. (\<chi> i. ?f t $ i)) = ?f" by(rule ext, rule vec_extensionality, auto)
   have eta_esque:"(\<lambda>t'. \<chi> i. t' * (if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0)) =  
                   (\<lambda>t'. t' *\<^sub>R (\<chi> i. if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0))"
     apply(rule ext | rule vec_extensionality)+
     subgoal for t' i by auto done
   have "((\<lambda>t. (\<chi> i. ?f t $ i)) has_derivative (\<lambda>t'. (\<chi> i. ?f' t' $ i))) (at s within {0..t})"
     apply (rule has_derivative_vec)
     subgoal for i       
       apply(cases "i \<in> ODE_vars I ODE")
        subgoal using fact1[of i] fact2[of i] ode_deriv[of i] by auto 
       subgoal using fact3[of i] fact4[of i] by auto 
     done
   done
   then have fderiv:"(?f has_derivative ?f') (at s within {0..t})" using eta eta_esque by auto
   have gderiv:"(?g has_derivative ?g') (at (?f s) within ?f ` {0..t})"
      using has_derivative_at_withinI 
      using frechet_correctness free good_interp 
      by blast
   have chain:"((?g \<circ> ?f) has_derivative (?g' \<circ> ?f')) (at s within {0..t})"
     using fderiv gderiv diff_chain_within by blast
   let ?co\<nu>1 = "(fst (mk_v I ODE (sol 0, b) (sol s)), ODE_sem I ODE (fst (mk_v I ODE (sol 0, b) (sol s))))"
   let ?co\<nu>2 = "(fst (mk_v I ODE (sol 0, b) (sol s)), snd (mk_v I ODE (sol 0, b) (sol s)))"
   have sub_cont:"\<And>a .a \<notin> ODE_vars I ODE \<Longrightarrow> Inl a \<in> FVT \<theta> \<Longrightarrow> False"
     using FVT by auto
   have sub_cont2:"\<And>a .a \<notin> ODE_vars I ODE \<Longrightarrow> Inr a \<in> FVT \<theta> \<Longrightarrow> False"
     using FVT by auto
   have "Vagree (mk_v I ODE (sol 0, b) (sol s)) (sol s, b) (Inl ` ODE_vars I ODE)"
     using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
     unfolding Vagree_def by auto
   let ?co'\<nu>1 = "(\<lambda>x. (fst (mk_v I ODE (sol 0, b) (sol s)), x *\<^sub>R (\<chi> i. if i \<in> ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0)))"
   let ?co'\<nu>2 = "(\<lambda>x. (fst (mk_v I ODE (sol 0, b) (sol s)), x *\<^sub>R snd (mk_v I ODE (sol 0, b) (sol s))))"
   have co_agree_sem:"\<And>s. Vagree (?co'\<nu>1 s) (?co'\<nu>2 s) (semBV I ODE)"
     subgoal for sa
       using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
       unfolding Vagree_def by auto
     done
   have co_agree_help:"\<And>s. Vagree (?co'\<nu>1 s) (?co'\<nu>2 s) (FVT \<theta>)"
     using agree_sub[OF FVT co_agree_sem] by auto
   have co_agree':"\<And>s. Vagree (?co'\<nu>1 s) (?co'\<nu>2 s) (FVDiff \<theta>)"
     subgoal for s
       using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
       unfolding Vagree_def apply auto
       subgoal for i x
         apply(cases x)
         subgoal for a
           apply(cases "a \<in> ODE_vars I ODE")
            by (simp | metis (no_types, lifting) FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv)+
         subgoal for a
           apply(cases "a \<in> ODE_vars I ODE")
            by (simp | metis (no_types, lifting) FVT Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv)+
         done
       subgoal for i x
         apply(cases x)
         subgoal for a
           apply(cases "a \<in> ODE_vars I ODE")
            using FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv
            by auto
         subgoal for a
           apply(cases "a \<in> ODE_vars I ODE")
            apply(erule allE[where x=i])+
            using FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv
            by auto
         done
       done
     done 
   have heq'':"(?g' \<circ> ?f') = (\<lambda>t'. t' *\<^sub>R frechet I \<theta> (?\<phi>s s) (snd (?\<phi> s)))"
     using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
     unfolding comp_def
     apply auto
     apply(rule ext | rule vec_extensionality)+
     subgoal for x
       using frech_linear[of I \<theta> x "(fst (mk_v I ODE (sol 0, b) (sol s)))" "(snd (mk_v I ODE (sol 0, b) (sol s)))", OF good_interp free]
       using coincidence_frechet[OF free, of "(?co'\<nu>1 x)" "(?co'\<nu>2 x)", OF co_agree'[of x], of I]
       by auto
     done
   have "((?g \<circ> ?f) has_derivative (?g' \<circ> ?f')) (at s within {0..t})"
     using chain by auto
   then have "((?g \<circ> ?f) has_derivative (\<lambda>t'. t' * frechet I \<theta> (?\<phi>s s) (snd (?\<phi> s)))) (at s within {0..t})"
     using heq'' by auto
   then have result:"((\<lambda>t. sterm_sem I \<theta> (?\<phi>s t))  has_derivative (\<lambda>t. t * frechet I \<theta> (?\<phi>s s) (snd (?\<phi> s)))) (at s within {0..t})"
     using heq by auto
   then show "?thesis" by auto
 qed
 
 lemma dterm_sterm_dfree:
    "dfree \<theta> \<Longrightarrow> (\<And>\<nu> \<nu>'. sterm_sem I \<theta> \<nu> = dterm_sem I \<theta> (\<nu>, \<nu>'))"
   by(induction rule: dfree.induct, auto)
 
 \<comment> \<open>\<open>g(x)\<ge> h(x) \<rightarrow>  [x'=f(x), c & p(x)](g(x)' \<ge> h(x)') \<rightarrow> [x'=f(x), c]g(x) \<ge> h(x)\<close>\<close>  
 lemma DIGeq_valid:"valid DIGeqaxiom"
   unfolding DIGeqaxiom_def
   apply(unfold DIGeqaxiom_def valid_def impl_sem iff_sem)
   apply(auto) (* 4 goals*)
   proof -
     fix I::"('sf,'sc,'sz) interp" and  b aa ba 
       and sol::"real \<Rightarrow> 'sz simple_state" 
       and t::real
     let ?ODE = "OVar vid1"
     let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
     assume t:"0 \<le> t"
       and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
       {x. Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
       and notin:" \<not>(Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (sol 0, b)))"
     have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
     from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
       using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
     then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
       using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
       unfolding Vagree_def by (auto simp add: empty_def)
     show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) \<le> dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
       using notin incon by auto
   next
     fix I::"('sf,'sc,'sz) interp" and  b aa ba 
       and sol::"real \<Rightarrow> 'sz simple_state" 
       and t::real
     let ?ODE = "OVar vid1"
     let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
     assume t:"0 \<le> t"
       and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
       {x. Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
       and notin:" \<not>(Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (sol 0, b)))"
     have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
     from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
       using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
     then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
       using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
       unfolding Vagree_def by (auto simp add: empty_def)
     show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) \<le> dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
       using notin incon by auto
   next
     fix I::"('sf,'sc,'sz) interp" and  b aa ba 
       and sol::"real \<Rightarrow> 'sz simple_state" 
       and t::real
     let ?ODE = "OVar vid1"
     let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
     assume t:"0 \<le> t"
     assume sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
         {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
     assume notin:"\<not> Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (sol 0, b))"
     have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
     from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
       using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
     then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
       using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
       unfolding Vagree_def by (auto simp add: empty_def)
     show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
        \<le> dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
       using incon notin by auto
 next
     fix I::"('sf,'sc,'sz) interp" and  b aa ba 
       and sol::"real \<Rightarrow> 'sz simple_state" 
       and t::real
     let ?ODE = "OVar vid1"
     let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
     assume good_interp:"is_interp I"
     assume aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, b) (sol t)"
     assume t:"0 \<le> t"
     assume sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
         {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
     assume box:"\<forall>a ba. (\<exists>sola. sol 0 = sola 0 \<and>
                       (\<exists>t. (a, ba) = mk_v I (OVar vid1) (sola 0, b) (sola t) \<and>
                            0 \<le> t \<and>
                            (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
                             {x. Predicates I vid1
                                  (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sola 0, b) x))})) \<longrightarrow>
               directional_derivative I (f1 fid2 vid1) (a, ba) \<le> directional_derivative I (f1 fid1 vid1) (a, ba)"
     assume geq0:"dterm_sem I (f1 fid2 vid1) (sol 0, b) \<le> dterm_sem I (f1 fid1 vid1) (sol 0, b)"
     have free1:"dfree ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
       by (auto intro: dfree.intros)
     have free2:"dfree ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
       by (auto intro: dfree.intros)
     from geq0 
     have geq0':"sterm_sem I (f1 fid2 vid1) (sol 0) \<le> sterm_sem I (f1 fid1 vid1) (sol 0)"
       unfolding f1_def using dterm_sterm_dfree[OF free1, of I "sol 0" b] dterm_sterm_dfree[OF free2, of I "sol 0" b] 
       by auto  
     let ?\<phi>s = "\<lambda>x. fst (?\<phi> x)"
     let ?\<phi>t = "\<lambda>x. snd (?\<phi> x)"
     let ?df1 = "(\<lambda>t. dterm_sem I (f1 fid2 vid1) (?\<phi> t))"
     let ?f1 = "(\<lambda>t. sterm_sem I (f1 fid2 vid1) (?\<phi>s t))"
     let ?f1' = "(\<lambda> s t'. t' * frechet I (f1 fid2 vid1) (?\<phi>s s) (?\<phi>t s))"
     have dfeq:"?df1 = ?f1" 
       apply(rule ext)
       subgoal for t
         using dterm_sterm_dfree[OF free1, of I "?\<phi>s t" "snd (?\<phi> t)"] unfolding f1_def expand_singleton by auto
       done
     have free3:"dfree (f1 fid2 vid1)" unfolding f1_def by (auto intro: dfree.intros)
     let ?df2 = "(\<lambda>t. dterm_sem I (f1 fid1 vid1) (?\<phi> t))"
     let ?f2 = "(\<lambda>t. sterm_sem I (f1 fid1 vid1) (?\<phi>s t))"
     let ?f2' = "(\<lambda>s t' . t' * frechet I (f1 fid1 vid1) (?\<phi>s s) (?\<phi>t s))"
     let ?int = "{0..t}"
     have bluh:"\<And>x i. (Functions I i has_derivative (THE f'. \<forall>x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
       using good_interp unfolding is_interp_def by auto
     have blah:"(Functions I fid2 has_derivative (THE f'. \<forall>x. (Functions I fid2 has_derivative f' x) (at x)) (\<chi> i. if i = vid1 then sol t $ vid1 else 0)) (at (\<chi> i. if i = vid1 then sol t $ vid1 else 0))"
       using bluh by auto
     have bigEx:"\<And>s. s \<in> {0..t} \<Longrightarrow>(\<exists>sola. sol 0 = sola 0 \<and>
          (\<exists>ta. (fst (?\<phi> s),
                 snd (?\<phi> s)) =
                mk_v I (OVar vid1) (sola 0, b) (sola ta) \<and>
                0 \<le> ta \<and>
                (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..ta}
                 {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}))"
       subgoal for s
         apply(rule exI[where x=sol])
         apply(rule conjI)
          subgoal by (rule refl)
         apply(rule exI[where x=s])
         apply(rule conjI)
          subgoal by auto 
         apply(rule conjI)
          subgoal by auto
         using sol
         using atLeastAtMost_iff atLeastatMost_subset_iff order_refl solves_ode_on_subset
         by (metis (no_types, lifting) subsetI)
       done
     have box':"\<And>s. s \<in> {0..t} \<Longrightarrow> directional_derivative I (f1 fid2 vid1) (?\<phi>s s, ?\<phi>t s) 
                                 \<le> directional_derivative I (f1 fid1 vid1) (?\<phi>s s, ?\<phi>t s)"
       subgoal for s
       using box 
       apply simp
       apply (erule allE[where x="?\<phi>s s"])
       apply (erule allE[where x="?\<phi>t s"])
       using bigEx[of s] by auto 
     done
     have dsafe1:"dsafe (f1 fid2 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
     have dsafe2:"dsafe (f1 fid1 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
     have agree1:"Vagree (sol 0, b) (?\<phi> 0) (FVT (f1 fid2 vid1))"
       using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?\<phi> 0)"]
       unfolding f1_def Vagree_def expand_singleton 
       apply auto
       by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
     have agree2:"Vagree (sol 0, b) (?\<phi> 0) (FVT (f1 fid1 vid1))"
       using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?\<phi> 0)"]
       unfolding f1_def Vagree_def expand_singleton 
       apply auto
       by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
     have sem_eq1:"dterm_sem I (f1 fid2 vid1) (sol 0, b) = dterm_sem I (f1 fid2 vid1) (?\<phi> 0)"
       using coincidence_dterm[OF dsafe1 agree1] by auto
     then have sem_eq1':"sterm_sem I (f1 fid2 vid1) (sol 0) = sterm_sem I (f1 fid2 vid1) (?\<phi>s 0)"
       using dterm_sterm_dfree[OF free1, of I "sol 0" "b"] 
             dterm_sterm_dfree[OF free1, of I "(?\<phi>s 0)" "snd (?\<phi> 0)"]
       unfolding f1_def expand_singleton by auto
     have sem_eq2:"dterm_sem I (f1 fid1 vid1) (sol 0, b) = dterm_sem I (f1 fid1 vid1) (?\<phi> 0)"
       using coincidence_dterm[OF dsafe2 agree2] by auto
     then have sem_eq2':"sterm_sem I (f1 fid1 vid1) (sol 0) = sterm_sem I (f1 fid1 vid1) (?\<phi>s 0)" 
       using dterm_sterm_dfree[OF free2, of I "sol 0" "b"] dterm_sterm_dfree[OF free2, of I "(?\<phi>s 0)" "snd (?\<phi> 0)"]
       unfolding f1_def expand_singleton by auto
     have good_interp':"\<And>i x. (Functions I i has_derivative (THE f'. \<forall>x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
       using good_interp unfolding is_interp_def by auto
     have chain :  
       "\<And>f f' g g' x s.
         (f has_derivative f') (at x within s) \<Longrightarrow>
         (g has_derivative g') (at (f x) within f ` s) \<Longrightarrow> (g \<circ> f has_derivative g' \<circ> f') (at x within s)"
       by(auto intro: derivative_intros)
     have sol1:"(sol solves_ode (\<lambda>_. ODE_sem I (OVar vid1))) {0..t} {x. mk_v I (OVar vid1) (sol 0, b) x \<in> fml_sem I (Prop vid1 empty)}"
       using sol unfolding p1_def singleton_def empty_def by auto
     have FVTsub1:"vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> FVT ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) \<subseteq> semBV I ((OVar vid1))"
       apply auto
       subgoal for x xa
         apply(cases "xa = vid1")
          by auto
       done
     have FVTsub2:"vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> FVT ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) \<subseteq> semBV I ((OVar vid1))"
       apply auto
       subgoal for x xa
         apply(cases "xa = vid1")
          by auto
       done
     have osafe:"osafe (OVar vid1)"
       by auto
     have deriv1:"\<And>s. vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> s \<in> ?int \<Longrightarrow> (?f1 has_derivative (?f1' s)) (at s within {0..t})"
       subgoal for s
         using  rift_in_space_time[OF good_interp free1 osafe sol1 FVTsub1, of s]
         unfolding f1_def expand_singleton directional_derivative_def
         by blast
       done
     have deriv2:"\<And>s. vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> s \<in> ?int \<Longrightarrow> (?f2 has_derivative (?f2' s)) (at s within {0..t})"
       subgoal for s
         using rift_in_space_time[OF good_interp free2 osafe sol1 FVTsub2, of s] 
         unfolding f1_def expand_singleton directional_derivative_def
         by blast
       done
     have leq:"\<And>s . s \<in> ?int \<Longrightarrow> ?f1' s 1 \<le> ?f2' s 1"
       subgoal for s using box'[of s] 
         by (simp add: directional_derivative_def)
       done
     have preserve_agree1:"vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> VSagree (sol 0) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t))) {vid1}"
       using mk_v_agree[of I "OVar vid1" "(sol 0, b)" "sol t"]
       unfolding Vagree_def VSagree_def
       by auto
     have preserve_coincide1:
       "vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> 
       sterm_sem I (f1 fid2 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
      = sterm_sem I (f1 fid2 vid1) (sol 0)" 
       using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid2 vid1" I]
       preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
     have preserve_coincide2:
       "vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> 
       sterm_sem I (f1 fid1 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
      = sterm_sem I (f1 fid1 vid1) (sol 0)" 
       using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid1 vid1" I]
       preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
     have "?f1 t \<le> ?f2 t"
       apply(cases "t = 0")
        subgoal using geq0' sem_eq1' sem_eq2' by auto  
       subgoal
         apply(cases "vid1 \<in> ODE_vars I (OVar vid1)")
         subgoal
           apply (rule MVT'[OF deriv2 deriv1, of t]) (* 8 subgoals *)
                  subgoal by auto
                 subgoal by auto
                subgoal for s using deriv2[of s] using leq by auto
               using t leq geq0' sem_eq1' sem_eq2' by auto
         subgoal
           using geq0 
           using dterm_sterm_dfree[OF free1, of I "sol 0" "b"]
           using dterm_sterm_dfree[OF free2, of I "sol 0" "b"]
           using preserve_coincide1 preserve_coincide2
           by(simp add: f1_def)
         done
       done
     then 
     show "       dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
        \<le> dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
 "
       using t 
       dterm_sterm_dfree[OF free2, of I "?\<phi>s t" "snd (?\<phi> t)"]
       dterm_sterm_dfree[OF free1, of I "?\<phi>s t" "snd (?\<phi> t)"]
       by (simp add: f1_def)
 qed 
   
   
 lemma DIGr_valid:"valid DIGraxiom"
   unfolding DIGraxiom_def
   apply(unfold DIGraxiom_def valid_def impl_sem iff_sem)
   apply(auto) (* 4 subgoals*)
 proof -
   fix I::"('sf,'sc,'sz) interp" and  b aa ba 
     and sol::"real \<Rightarrow> 'sz simple_state" 
     and t::real
   let ?ODE = "OVar vid1"
   let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
   assume t:"0 \<le> t"
     and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
     {x. Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
     and notin:" \<not>(Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (sol 0, b)))"
   have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
   from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
     using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
   then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
     using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
     unfolding Vagree_def by (auto simp add: empty_def)
   show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
     using notin incon by auto
 next
   fix I::"('sf,'sc,'sz) interp" and  b aa ba 
     and sol::"real \<Rightarrow> 'sz simple_state" 
     and t::real
   let ?ODE = "OVar vid1"
   let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
   assume t:"0 \<le> t"
     and sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
     {x. Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
     and notin:" \<not>(Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (sol 0, b)))"
   have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
   from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
     using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
   then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
     using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
     unfolding Vagree_def by (auto simp add: empty_def)
   show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
     using notin incon by auto
 next
   fix I::"('sf,'sc,'sz) interp" and  b aa ba 
     and sol::"real \<Rightarrow> 'sz simple_state" 
     and t::real
   let ?ODE = "OVar vid1"
   let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
   assume t:"0 \<le> t"
   assume sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
       {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
   assume notin:"\<not> Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (sol 0, b))"
   have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
   from sol have "Predicates I vid1 (\<chi> i. dterm_sem I (empty i) (?\<phi> 0))"
     using t solves_ode_domainD[of sol "(\<lambda>a. ODEs I vid1)" "{0..t}"]  by auto
   then have incon:"Predicates I vid1 (\<chi> i. dterm_sem I (empty i) ((sol 0, b)))"
     using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?\<phi> 0"]
     unfolding Vagree_def by (auto simp add: empty_def) 
   show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
      < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
     using incon notin by auto
 next
   fix I::"('sf,'sc,'sz) interp" and  b aa ba 
   and sol::"real \<Rightarrow> 'sz simple_state" 
   and t::real
   let ?ODE = "OVar vid1"
   let ?\<phi> = "(\<lambda>t. mk_v I (?ODE) (sol 0, b) (sol t))"
   assume good_interp:"is_interp I"
   assume aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, b) (sol t)"
   assume t:"0 \<le> t"
   assume sol:"(sol solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
       {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
   assume box:"\<forall>a ba. (\<exists>sola. sol 0 = sola 0 \<and>
                     (\<exists>t. (a, ba) = mk_v I (OVar vid1) (sola 0, b) (sola t) \<and>
                          0 \<le> t \<and>
                          (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..t}
                           {x. Predicates I vid1
                                (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sola 0, b) x))})) \<longrightarrow>
             directional_derivative I (f1 fid2 vid1) (a, ba) \<le> directional_derivative I (f1 fid1 vid1) (a, ba)"
   assume geq0:"dterm_sem I (f1 fid2 vid1) (sol 0, b) < dterm_sem I (f1 fid1 vid1) (sol 0, b)"
   have free1:"dfree ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
     by (auto intro: dfree.intros)
   have free2:"dfree ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
     by (auto intro: dfree.intros)
   from geq0 
   have geq0':"sterm_sem I (f1 fid2 vid1) (sol 0) < sterm_sem I (f1 fid1 vid1) (sol 0)"
     unfolding f1_def using dterm_sterm_dfree[OF free1, of I "sol 0" b] dterm_sterm_dfree[OF free2, of I "sol 0" b] 
     by auto  
   let ?\<phi>s = "\<lambda>x. fst (?\<phi> x)"
   let ?\<phi>t = "\<lambda>x. snd (?\<phi> x)"
   let ?df1 = "(\<lambda>t. dterm_sem I (f1 fid2 vid1) (?\<phi> t))"
   let ?f1 = "(\<lambda>t. sterm_sem I (f1 fid2 vid1) (?\<phi>s t))"
   let ?f1' = "(\<lambda> s t'. t' * frechet I (f1 fid2 vid1) (?\<phi>s s) (?\<phi>t s))"
   have dfeq:"?df1 = ?f1" 
     apply(rule ext)
     subgoal for t
       using dterm_sterm_dfree[OF free1, of I "?\<phi>s t" "snd (?\<phi> t)"] unfolding f1_def expand_singleton by auto
     done
   have free3:"dfree (f1 fid2 vid1)" unfolding f1_def by (auto intro: dfree.intros)
   let ?df2 = "(\<lambda>t. dterm_sem I (f1 fid1 vid1) (?\<phi> t))"
   let ?f2 = "(\<lambda>t. sterm_sem I (f1 fid1 vid1) (?\<phi>s t))"
   let ?f2' = "(\<lambda>s t' . t' * frechet I (f1 fid1 vid1) (?\<phi>s s) (?\<phi>t s))"
   let ?int = "{0..t}"
   have bluh:"\<And>x i. (Functions I i has_derivative (THE f'. \<forall>x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
     using good_interp unfolding is_interp_def by auto
   have blah:"(Functions I fid2 has_derivative (THE f'. \<forall>x. (Functions I fid2 has_derivative f' x) (at x)) (\<chi> i. if i = vid1 then sol t $ vid1 else 0)) (at (\<chi> i. if i = vid1 then sol t $ vid1 else 0))"
     using bluh by auto
   have bigEx:"\<And>s. s \<in> {0..t} \<Longrightarrow>(\<exists>sola. sol 0 = sola 0 \<and>
        (\<exists>ta. (fst (?\<phi> s),
               snd (?\<phi> s)) =
              mk_v I (OVar vid1) (sola 0, b) (sola ta) \<and>
              0 \<le> ta \<and>
              (sola solves_ode (\<lambda>a. ODEs I vid1)) {0..ta}
               {x. Predicates I vid1 (\<chi> i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}))"
     subgoal for s
       apply(rule exI[where x=sol])
       apply(rule conjI)
        subgoal by (rule refl)
       apply(rule exI[where x=s])
       apply(rule conjI)
        subgoal by auto 
       apply(rule conjI)
        subgoal by auto
       using sol
       using atLeastAtMost_iff atLeastatMost_subset_iff order_refl solves_ode_on_subset
       by (metis (no_types, lifting) subsetI)
     done
   have box':"\<And>s. s \<in> {0..t} \<Longrightarrow> directional_derivative I (f1 fid2 vid1) (?\<phi>s s, ?\<phi>t s) 
                               \<le> directional_derivative I (f1 fid1 vid1) (?\<phi>s s, ?\<phi>t s)"
     subgoal for s
     using box 
     apply simp
     apply (erule allE[where x="?\<phi>s s"])
     apply (erule allE[where x="?\<phi>t s"])
     using bigEx[of s] by auto 
   done
   have dsafe1:"dsafe (f1 fid2 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
   have dsafe2:"dsafe (f1 fid1 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
   have agree1:"Vagree (sol 0, b) (?\<phi> 0) (FVT (f1 fid2 vid1))"
     using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?\<phi> 0)"]
     unfolding f1_def Vagree_def expand_singleton 
     apply auto
     by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
   have agree2:"Vagree (sol 0, b) (?\<phi> 0) (FVT (f1 fid1 vid1))"
     using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?\<phi> 0)"]
     unfolding f1_def Vagree_def expand_singleton 
     apply auto
     by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
   have sem_eq1:"dterm_sem I (f1 fid2 vid1) (sol 0, b) = dterm_sem I (f1 fid2 vid1) (?\<phi> 0)"
     using coincidence_dterm[OF dsafe1 agree1] by auto
   then have sem_eq1':"sterm_sem I (f1 fid2 vid1) (sol 0) = sterm_sem I (f1 fid2 vid1) (?\<phi>s 0)"
     using dterm_sterm_dfree[OF free1, of I "sol 0" "b"] 
           dterm_sterm_dfree[OF free1, of I "(?\<phi>s 0)" "snd (?\<phi> 0)"]
     unfolding f1_def expand_singleton by auto
   have sem_eq2:"dterm_sem I (f1 fid1 vid1) (sol 0, b) = dterm_sem I (f1 fid1 vid1) (?\<phi> 0)"
     using coincidence_dterm[OF dsafe2 agree2] by auto
   then have sem_eq2':"sterm_sem I (f1 fid1 vid1) (sol 0) = sterm_sem I (f1 fid1 vid1) (?\<phi>s 0)" 
     using dterm_sterm_dfree[OF free2, of I "sol 0" "b"] dterm_sterm_dfree[OF free2, of I "(?\<phi>s 0)" "snd (?\<phi> 0)"]
     unfolding f1_def expand_singleton by auto
   have good_interp':"\<And>i x. (Functions I i has_derivative (THE f'. \<forall>x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
     using good_interp unfolding is_interp_def by auto
   have chain :  
     "\<And>f f' g g' x s.
       (f has_derivative f') (at x within s) \<Longrightarrow>
       (g has_derivative g') (at (f x) within f ` s) \<Longrightarrow> (g \<circ> f has_derivative g' \<circ> f') (at x within s)"
     by(auto intro: derivative_intros)
   have sol1:"(sol solves_ode (\<lambda>_. ODE_sem I (OVar vid1))) {0..t} {x. mk_v I (OVar vid1) (sol 0, b) x \<in> fml_sem I (Prop vid1 empty)}"
     using sol unfolding p1_def singleton_def empty_def by auto
   have FVTsub1:"vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> FVT ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) \<subseteq> semBV I ((OVar vid1))"
     apply auto
     subgoal for x xa
       apply(cases "xa = vid1")
        by auto
     done
   have FVTsub2:"vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> FVT ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) \<subseteq> semBV I ((OVar vid1))"
     apply auto
     subgoal for x xa
       apply(cases "xa = vid1")
        by auto
     done
   have osafe:"osafe (OVar vid1)"
     by auto
   have deriv1:"\<And>s. vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> s \<in> ?int \<Longrightarrow> (?f1 has_derivative (?f1' s)) (at s within {0..t})"
     subgoal for s
       using  rift_in_space_time[OF good_interp free1 osafe sol1 FVTsub1, of s]
       unfolding f1_def expand_singleton directional_derivative_def
       by blast
     done
   have deriv2:"\<And>s. vid1 \<in> ODE_vars I (OVar vid1) \<Longrightarrow> s \<in> ?int \<Longrightarrow> (?f2 has_derivative (?f2' s)) (at s within {0..t})"
     subgoal for s
       using rift_in_space_time[OF good_interp free2 osafe sol1 FVTsub2, of s] 
       unfolding f1_def expand_singleton directional_derivative_def
       by blast
     done
   have leq:"\<And>s . s \<in> ?int \<Longrightarrow> ?f1' s 1 \<le> ?f2' s 1"
     subgoal for s using box'[of s] 
       by (simp add: directional_derivative_def)
     done
   have preserve_agree1:"vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> VSagree (sol 0) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t))) {vid1}"
     using mk_v_agree[of I "OVar vid1" "(sol 0, b)" "sol t"]
     unfolding Vagree_def VSagree_def
     by auto
   have preserve_coincide1:
     "vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> 
     sterm_sem I (f1 fid2 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
    = sterm_sem I (f1 fid2 vid1) (sol 0)" 
     using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid2 vid1" I]
     preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
   have preserve_coincide2:
     "vid1 \<notin> ODE_vars I (OVar vid1) \<Longrightarrow> 
     sterm_sem I (f1 fid1 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
    = sterm_sem I (f1 fid1 vid1) (sol 0)" 
     using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid1 vid1" I]
     preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
   have "?f1 t < ?f2 t"
     apply(cases "t = 0")
      subgoal using geq0' sem_eq1' sem_eq2' by auto  
     subgoal
       apply(cases "vid1 \<in> ODE_vars I (OVar vid1)")
       subgoal
         apply (rule MVT'_gr[OF deriv2 deriv1, of t])
                subgoal by auto
               subgoal by auto
              subgoal for s using deriv2[of s] using leq by auto
             using t leq geq0' sem_eq1' sem_eq2' by auto
       subgoal
         using geq0 
         using dterm_sterm_dfree[OF free1, of I "sol 0" "b"]
         using dterm_sterm_dfree[OF free2, of I "sol 0" "b"]
         using preserve_coincide1 preserve_coincide2
         by(simp add: f1_def)
       done
     done
   then 
   show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
      < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
     using t 
     dterm_sterm_dfree[OF free2, of I "?\<phi>s t" "snd (?\<phi> t)"]
     dterm_sterm_dfree[OF free1, of I "?\<phi>s t" "snd (?\<phi> t)"]
     using geq0 f1_def
     by (simp add: f1_def)
 qed 
 
 lemma DG_valid:"valid DGaxiom"
 proof -
   have osafe:"osafe (OSing vid1 (f1 fid1 vid1))" 
     by(auto simp add: osafe_Sing dfree_Fun dfree_Const f1_def expand_singleton)
   have fsafe:"fsafe (p1 vid1 vid1)" 
     by(auto simp add: p1_def dfree_Const)
   have osafe2:"osafe (OProd (OSing vid1 (f1 fid1 vid1)) (OSing vid2 (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))))"
     by(auto simp add: f1_def expand_singleton osafe.intros dfree.intros vne12)
   note sem = ode_alt_sem[OF osafe fsafe]
   note sem2 = ode_alt_sem[OF osafe2 fsafe]
   have p2safe:"fsafe (p1 vid2 vid1)" by(auto simp add: p1_def dfree_Const)
   show "valid DGaxiom"
     apply(auto simp  del: prog_sem.simps(8) simp add: DGaxiom_def valid_def sem sem2)
      apply(rule exI[where x=0], auto simp add: f1_def p1_def expand_singleton)
      subgoal for I a b aa ba sol t
      proof -
        assume good_interp:"is_interp I"
        assume "
 \<forall>aa ba. (\<exists>sol t. (aa, ba) = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) \<and>
                       0 \<le> t \<and>
                       (sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                        {x. Predicates I vid1
                             (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                    (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} \<and>
                       VSagree (sol 0) a {uu. uu = vid1 \<or>
                             Inl uu \<in> Inl ` {x. \<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0)} \<or>
                             (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}) \<longrightarrow>
              Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
        then have 
          bigAll:"
 \<And>aa ba. (\<exists>sol t. (aa, ba) = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) \<and>
                       0 \<le> t \<and>
                       (sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                        {x. Predicates I vid1
                             (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                    (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} \<and>
                       VSagree (sol 0) a {uu. uu = vid1 \<or> (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}) \<longrightarrow>
              Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
          by (auto)
        assume aaba:"(aa, ba) =
   mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
            (OSing vid2
              (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
    (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t)"
        assume t:"0 \<le> t"
        assume sol:"
      (sol solves_ode
    (\<lambda>a b. (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
           (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
    {0..t} {x. Predicates I vid1
                (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                       (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                                 (OSing vid2
                                   (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                     ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                         (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) x))}"
      assume VSag:"VSagree (sol 0) (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y)
      {x. x = vid2 \<or> x = vid1 \<or> x = vid2 \<or> x = vid1 \<or> Inl x \<in> Inl ` {x. x = vid2 \<or> x = vid1} \<or> x = vid1}"
        let ?sol = "(\<lambda>t. \<chi> i. if i = vid1 then sol t $ vid1 else 0)"
        let ?aaba' = "mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)"
      from bigAll[of "fst ?aaba'" "snd ?aaba'"] 
      have bigEx:"(\<exists>sol t. ?aaba' = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) \<and>
                         0 \<le> t \<and>
                         (sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                          {x. Predicates I vid1
                               (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                      (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} \<and>
                         VSagree (sol 0) a {uu. uu = vid1 \<or> (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}) \<longrightarrow>
                Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?aaba'))" 
        by simp
      have pre1:"?aaba' = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)" 
        by (rule refl)
      have agreeL:"\<And>s. fst (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                    (OSing vid2
                      (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                        ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
            (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol s)) $ vid1 = sol s $ vid1"
        subgoal for s
          using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                    (OSing vid2
                       (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))" "(\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b)" "(sol s)"]
          unfolding Vagree_def by auto done
        have agreeR:"\<And>s. fst (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (\<chi> i. if i = vid1 then sol s $ vid1 else 0)) $ vid1 = sol s $ vid1" 
          subgoal for s
            using mk_v_agree[of "I" "(OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(\<chi> i. if i = vid1 then sol s $ vid1 else 0)"]
            unfolding Vagree_def by auto
          done
        have FV:"(FVF (p1 vid1 vid1)) = {Inl vid1}" unfolding p1_def expand_singleton
          apply auto subgoal for x xa apply(cases "xa = vid1") by auto done
        have agree:"\<And>s. Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                      (OSing vid2
                        (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                          ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
              (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol s)) (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (\<chi> i. if i = vid1 then sol s $ vid1 else 0)) (FVF (p1 vid1 vid1))"
          using agreeR agreeL unfolding Vagree_def FV by auto
        note con_sem_eq = coincidence_formula[OF fsafe Iagree_refl agree]
        have constraint:"\<And>s. 0 \<le> s \<and> s \<le> t \<Longrightarrow>
          Predicates I vid1
          (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (\<chi> i. if i = vid1 then sol s $ vid1 else 0)))"
          using sol apply simp
          apply(drule solves_odeD(2))
           apply auto[1]
          subgoal for s using con_sem_eq by (auto simp add: p1_def expand_singleton)
          done
        have eta:"sol = (\<lambda>t. \<chi> i. sol t $ i)" by (rule ext, rule vec_extensionality, simp)
        have yet_another_eq:"\<And>x. (\<lambda>xa. xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                           (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0)))
  = (\<lambda>xa. (\<chi> i. (xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                           (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))) $ i))"
          subgoal for x by (rule ext, rule vec_extensionality, simp) done
        have sol_deriv:"\<And>x. x \<in>{0..t} \<Longrightarrow>
            (sol has_derivative
             (\<lambda>xa. xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                           (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))))
             (at x within {0..t})"
          using sol apply simp
          apply(drule solves_odeD(1))
          unfolding has_vderiv_on_def has_vector_derivative_def by auto
        then have sol_deriv:"\<And>x. x \<in> {0..t} \<Longrightarrow>
            ((\<lambda>t. \<chi> i. sol t $ i) has_derivative
             (\<lambda>xa. (\<chi> i. (xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                           (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))) $ i)))
             (at x within {0..t})" using yet_another_eq eta by auto
        have sol_deriv1: "\<And>x. x \<in> {0..t} \<Longrightarrow>
           ((\<lambda>t. sol t $ vid1) has_derivative
            (\<lambda>xa. (xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                          (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0)) $ vid1)))
            (at x within {0..t})"
          subgoal for s
            (* I heard higher-order unification is hard.*)
          apply(rule has_derivative_proj[of "(\<lambda> i t. sol t $ i)" "(\<lambda>j xa. (xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0) +
                          (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol s) else 0)) $ j))" "at s within {0..t}""vid1"])
          using sol_deriv[of s] by auto done
       have hmm:"\<And>s. (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol s)) = (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (\<chi> i. if i = vid1 then sol s $ vid1 else 0))"
         by(rule vec_extensionality, auto)
       have aha:"\<And>s. (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (sol s)) = (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0))"
         subgoal for s
           apply(rule ext)
           subgoal for xa using hmm by (auto simp add: f1_def) done done 
       let ?sol' = "(\<lambda>s. (\<lambda>xa. \<chi> i. if i = vid1 then xa * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0) else 0))"
       let ?project_me_plz = "(\<lambda>t. (\<chi> i. if i = vid1 then ?sol t $ vid1 else 0))"
       have sol_deriv_eq:"\<And>s. s \<in>{0..t} \<Longrightarrow>
      ((\<lambda>t. (\<chi> i. if i = vid1 then ?sol t $ vid1 else 0)) has_derivative ?sol' s) (at s within {0..t})"
         subgoal for s
           apply(rule has_derivative_vec)
           subgoal for i
             apply (cases "i = vid1", cases "i = vid2", auto)
              using vne12 apply simp
             using sol_deriv1[of s] using aha by auto
           done done
       have yup:"(\<lambda>t. (\<chi> i. if i = vid1 then ?sol t $ vid1 else 0) $ vid1) = (\<lambda>t. sol t $ vid1)"
         by(rule ext, auto)
       have maybe:"\<And>s. (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0)) = (\<lambda>xa. (\<chi> i. if i = vid1 then xa * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0) else 0) $ vid1) "
         by(rule ext, auto)
       have almost:"(\<lambda>x. if vid1 = vid1 then (\<chi> i. if i = vid1 then sol x $ vid1 else 0) $ vid1 else 0) =
 (\<lambda>x.  (\<chi> i. if i = vid1 then sol x $ vid1 else 0) $ vid1)" by(rule ext, auto)
       have almost':"\<And>s. (\<lambda>h. if vid1 = vid1 then h * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0) else 0) = (\<lambda>h. h * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0))"
         by(rule ext, auto)
       have deriv':" \<And>x. x \<in> {0..t} \<Longrightarrow>
      ((\<lambda>t. \<chi> i. if i = vid1 then sol t $ vid1 else 0) has_derivative
       (\<lambda>xa. (\<chi> i. xa *\<^sub>R (if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol x $ vid1 else 0) else 0))))
       (at x within {0..t})"
         subgoal for s
           apply(rule has_derivative_vec)
           subgoal for i
             apply(cases "i = vid1")
              prefer 2 subgoal by auto
             apply auto              
             using has_derivative_proj[OF sol_deriv_eq[of s], of vid1] using  yup maybe[of s] almost almost'[of s] 
             by fastforce
           done 
         done
       have derEq:"\<And>s. (\<lambda>xa. (\<chi> i. xa *\<^sub>R (if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0) else 0)))
  = (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol s $ vid1 else 0) else 0))"
         subgoal for s apply (rule ext, rule vec_extensionality) by auto done
       have "\<And>x. x \<in> {0..t} \<Longrightarrow>
      ((\<lambda>t. \<chi> i. if i = vid1 then sol t $ vid1 else 0) has_derivative
       (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol x $ vid1 else 0) else 0)))
       (at x within {0..t})" subgoal for s using deriv'[of s] derEq[of s] by auto done
       then have deriv:"((\<lambda>t. \<chi> i. if i = vid1 then sol t $ vid1 else 0) has_vderiv_on
         (\<lambda>t. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid1 then sol t $ vid1 else 0) else 0))
         {0..t}"
         unfolding has_vderiv_on_def has_vector_derivative_def
         by auto 
       have pre2:"(?sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
      {x. Predicates I vid1
           (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                  (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))}"
         apply(rule solves_odeI)
          subgoal by (rule deriv)
         subgoal for s using constraint by auto
         done
       have pre3:"VSagree (?sol 0) a {u. u = vid1 \<or> (\<exists>x. Inl u \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}"
         using vne12 VSag unfolding VSagree_def by simp 
       have bigPre:"(\<exists>sol t. ?aaba' = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then Var vid1 else Const 0))) (a, b) (sol t) \<and>
                       0 \<le> t \<and>
                       (sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                        {x. Predicates I vid1
                             (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                    (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then Var vid1 else Const 0))) (a, b) x))} \<and>
                       VSagree (sol 0) a {u. u = vid1 \<or> (\<exists>x. Inl u \<in> FVT (if x = vid1 then Var vid1 else Const 0))})"
         apply(rule exI[where x="?sol"])
         apply(rule exI[where x=t])
         apply(rule conjI)
          apply(rule pre1)
         apply(rule conjI)
          apply(rule t)
         apply(rule conjI)
          apply(rule pre2)
         by(rule pre3)
       have pred2:"Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')"
         using bigEx bigPre by auto
       then have pred2':"?aaba' \<in> fml_sem I (p1 vid2 vid1)" unfolding p1_def expand_singleton by auto
       let ?res_state = "(mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                     (OSing vid2
                       (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
             (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))"
       have aabaX:"(fst ?aaba') $ vid1 = sol t $ vid1" 
         using aaba mk_v_agree[of "I" "(OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))"
  "(a, b)" "(?sol t)"] 
       proof -
         assume " Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (\<chi> i. if i = vid1 then sol t $ vid1 else 0))
      (a, b) (- semBV I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))) \<and>
    Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (\<chi> i. if i = vid1 then sol t $ vid1 else 0))
      (mk_xode I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (\<chi> i. if i = vid1 then sol t $ vid1 else 0))
      (semBV I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))))"
         then have ag:" Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t))
    (mk_xode I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t))
    (semBV I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))))"
           by auto
         have sembv:"(semBV I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))) = {Inl vid1, Inr vid1}"
           by auto
         have sub:"{Inl vid1} \<subseteq> {Inl vid1, Inr vid1}" by auto
         have ag':"Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t))
           (mk_xode I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t)) {Inl vid1}" 
           using ag agree_sub[OF sub] sembv by auto
         then have eq1:"fst (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)) $ vid1 
           = fst (mk_xode I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t)) $ vid1" unfolding Vagree_def by auto
         moreover have "... = sol t $ vid1" by auto
         ultimately show ?thesis by auto
       qed
       have res_stateX:"(fst ?res_state) $ vid1 = sol t $ vid1" 
         using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                     (OSing vid2
                       (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))"
             "(\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b)" "(sol t)"]
       proof -
         assume "Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                      (OSing vid2
                        (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                          ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
              (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
      (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b)
      (- semBV I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))) \<and>
     Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                      (OSing vid2
                        (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                          ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
              (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
      (mk_xode I
        (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
          (OSing vid2
            (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
              ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
        (sol t))
      (semBV I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                 (OSing vid2
                   (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                     ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))))))"
         then have ag:" Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
          (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
  (mk_xode I
    (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
      (OSing vid2
        (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
          ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
    (sol t))
  (semBV I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
             (OSing vid2
               (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                 ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))))))" by auto
         have sembv:"(semBV I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
             (OSing vid2
               (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                 ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))) = {Inl vid1, Inr vid1, Inl vid2, Inr vid2}" by auto
         have sub:"{Inl vid1} \<subseteq> {Inl vid1, Inr vid1, Inl vid2, Inr vid2}" by auto
         have ag':"Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
          (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
    (mk_xode I
      (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
        (OSing vid2
          (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
            ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
      (sol t)) {Inl vid1}" using ag sembv agree_sub[OF sub] by auto
         then have "fst ?res_state $ vid1 = fst ((mk_xode I
      (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
        (OSing vid2
          (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
            ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
      (sol t))) $ vid1" unfolding Vagree_def by blast
         moreover have "... = sol t $ vid1" by auto
         ultimately show "?thesis" by linarith
       qed
      have agree:"Vagree ?aaba' (?res_state) (FVF (p1 vid2 vid1))"
        unfolding p1_def Vagree_def using aabaX res_stateX by auto
      have fml_sem_eq:"(?res_state \<in> fml_sem I (p1 vid2 vid1)) = (?aaba' \<in> fml_sem I (p1 vid2 vid1))"
        using coincidence_formula[OF p2safe Iagree_refl agree, of I] by auto
      then show "Predicates I vid2
      (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                       (OSing vid2
                         (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                           ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
               (\<chi> y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t)))"
      using pred2 unfolding p1_def expand_singleton by auto
   qed
 subgoal for I a b r aa ba sol t
 proof -
   assume good_interp:"is_interp I"
   assume bigAll:"    \<forall>aa ba. (\<exists>sol t. (aa, ba) =
                      mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                               (OSing vid2
                                 (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                   ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                       (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (sol t) \<and>
                      0 \<le> t \<and>
                      (sol solves_ode
                       (\<lambda>a b. (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
                              (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
                       {0..t} {x. Predicates I vid1
                                   (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                          (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                                                    (OSing vid2
                                                      (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                                        ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                                            (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) x))} \<and>
                      VSagree (sol 0) (\<chi> y. if vid2 = y then r else fst (a, b) $ y)
                       {uu. uu = vid2 \<or>
                             uu = vid1 \<or>
                             uu = vid2 \<or>
                             uu = vid1 \<or>
                             Inl uu
                             \<in> Inl ` ({x. \<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0)} \<union>
                                       {x. x = vid2 \<or> (\<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0))}) \<or>
                             (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}) \<longrightarrow>
             Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
     assume aaba:"(aa, ba) = mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t)"
     assume t:"0 \<le> t"
     assume sol:"(sol solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
      {x. Predicates I vid1
           (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                  (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))}"
     assume VSA:"VSagree (sol 0) a
      {uu. uu = vid1 \<or>
            Inl uu \<in> Inl ` {x. \<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0)} \<or>
            (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))}"
     let ?xode = "(\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)"
     let ?xconstraint = UNIV
     let ?ivl = "ll_on_open.existence_ivl {0 .. t} ?xode ?xconstraint 0 (sol 0)"
     have freef1:"dfree ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
       by(auto simp add: dfree_Fun dfree_Const)
     have simple_term_inverse':"\<And>\<theta>. dfree \<theta> \<Longrightarrow> raw_term (simple_term \<theta>) = \<theta>"
       using simple_term_inverse by auto
     have old_lipschitz:"local_lipschitz (UNIV::real set) UNIV (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)"
       apply(rule c1_implies_local_lipschitz[where f'="(\<lambda> (t,b). blinfun_vec(\<lambda> i. if i = vid1 then blin_frechet (good_interp I) (simple_term (Function fid1 (\<lambda> i. if i = vid1 then Var vid1 else Const 0))) b else Blinfun(\<lambda> _. 0)))"])
          apply auto
        subgoal for x
          apply(rule has_derivative_vec)
          subgoal for i
            apply(auto simp add:  bounded_linear_Blinfun_apply good_interp_inverse good_interp)
            apply(auto simp add: simple_term_inverse'[OF freef1])
            apply(cases "i = vid1")
             apply(auto simp add: f1_def expand_singleton)
          proof -
            let ?h = "(\<lambda>b. Functions I fid1 (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b))"
            let ?h' = "(\<lambda>b'. FunctionFrechet I fid1 (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) x) (\<chi> i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x b'))" 
            let ?f = "(\<lambda> b. (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b))"
            let ?f' = "(\<lambda> b'. (\<chi> i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x b'))"
            let ?g = "Functions I fid1"
            let ?g'= "FunctionFrechet I fid1 (?f x)"
            have heq:"?h = ?g \<circ> ?f" by(rule ext, auto)
            have heq':"?h' = ?g' \<circ> ?f'" by(rule ext, auto)
            have fderiv:"(?f has_derivative ?f') (at x)"
              apply(rule has_derivative_vec)
              by (auto simp add: svar_deriv axis_def)
            have gderiv:"(?g has_derivative ?g') (at (?f x))"
              using good_interp unfolding is_interp_def by blast
            have gfderiv: "((?g \<circ> ?f) has_derivative(?g' \<circ> ?f')) (at x)"
              using fderiv gderiv diff_chain_at by blast
            have boring_eq:"(\<lambda>b. Functions I fid1 (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b)) =
              sterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))"
              by(rule ext, auto)
            have "(?h has_derivative ?h') (at x)" using gfderiv heq heq' by auto
            then show "(sterm_sem I ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) has_derivative
  (\<lambda>v'. (THE f'. \<forall>x. (Functions I fid1 has_derivative f' x) (at x)) (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) x)
         (\<chi> i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x v')))
  (at x)"
              using boring_eq by auto
          qed
          done
     proof -
       have the_thing:"continuous_on (UNIV::('sz Rvec set)) 
         (\<lambda>b.
           blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) b
                 else Blinfun (\<lambda>_. 0)))"
          apply(rule continuous_blinfun_vec')
          subgoal for i
            apply(cases "i = vid1")
             apply(auto)
             using frechet_continuous[OF good_interp freef1] by (auto simp add: continuous_on_const)           
          done
        have another_cont:"continuous_on (UNIV) 
         (\<lambda>x.
           blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (snd x)
                 else Blinfun (\<lambda>_. 0)))"
          apply(rule continuous_on_compose2[of UNIV "(\<lambda>b. blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) b
                 else Blinfun (\<lambda>_. 0)))"])
            apply(rule the_thing)
           by (auto intro!: continuous_intros)
        have ext:"(\<lambda>x. case x of
         (t, b) \<Rightarrow>
           blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) b
                 else Blinfun (\<lambda>_. 0))) =(\<lambda>x.
           blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (snd x)
            else Blinfun (\<lambda>_. 0))) " apply(rule ext, auto) 
          by (metis snd_conv)
        then show  "continuous_on (UNIV) 
         (\<lambda>x. case x of
         (t, b) \<Rightarrow>
           blinfun_vec
            (\<lambda>i. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) b
                 else Blinfun (\<lambda>_. 0)))"
          using another_cont
          by (simp add: another_cont local.ext)
     qed
     have old_continuous:" \<And>x. x \<in> UNIV \<Longrightarrow> continuous_on UNIV (\<lambda>t. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) x else 0)"
       by(rule continuous_on_const)
     interpret ll_old: ll_on_open_it "UNIV" ?xode ?xconstraint 0 
       apply(standard)
           subgoal by auto
          prefer 3 subgoal by auto
         prefer 3 subgoal by auto
        apply(rule old_lipschitz)
       by (rule old_continuous)
     let ?ivl = "(ll_old.existence_ivl 0 (sol 0))"
     let ?flow = "ll_old.flow 0 (sol 0)"
     have tclosed:"{0..t} = {0--t}" using t real_Icc_closed_segment by auto
     have "(sol  solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t} UNIV"
       apply(rule solves_ode_supset_range)
        apply(rule sol)
       by auto
     then have sol':"(sol  solves_ode (\<lambda>a b. \<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0--t} UNIV"
       using tclosed by auto
     have sub:"{0--t} \<subseteq> ll_old.existence_ivl 0 (sol 0)"
       apply(rule ll_old.closed_segment_subset_existence_ivl)
       apply(rule ll_old.existence_ivl_maximal_segment)
         apply(rule sol')
        apply(rule refl)
       by auto
     have usol_old:"(?flow  usolves_ode ?xode from 0) ?ivl UNIV"
       by(rule ll_old.flow_usolves_ode, auto)
     have sol_old:"(ll_old.flow 0 (sol 0) solves_ode ?xode) ?ivl UNIV"
       by(rule ll_old.flow_solves_ode, auto)
     have another_sub:"\<And>s. s \<in> {0..t} \<Longrightarrow> {s--0} \<subseteq> {0..t}"
       unfolding closed_segment_def
       apply auto
       by (metis diff_0_right diff_left_mono mult.commute mult_left_le order.trans)
     have sol_eq_flow:"\<And>s. s \<in> {0..t} \<Longrightarrow> sol s = ?flow s"
       using usol_old apply simp
       apply(drule usolves_odeD(4)) (* 7 subgoals*)
             apply auto
        subgoal for s x
        proof -
          assume xs0:"x \<in> {s--0}"
          assume s0:"0 \<le> s" and st: "s \<le> t"
          have "{s--0} \<subseteq> {0..t}" using another_sub[of s] s0 st by auto
          then have "x \<in> {0..t}" using xs0 by auto
          then have "x \<in> {0--t}" using tclosed by auto
          then show "x \<in> ll_old.existence_ivl 0 (sol 0)"
            using sub by auto
        qed
        apply(rule solves_ode_subset)
         using sol' apply auto[1]
        subgoal for s
        proof - 
          assume s0:"0 \<le> s" and st:"s \<le> t"
          show "{s--0} \<subseteq> {0--t}"
            using tclosed unfolding closed_segment using s0 st
            using another_sub intervalE by blast
        qed
       done
     have sol_deriv_orig:"\<And>s. s\<in>?ivl \<Longrightarrow>  (?flow has_derivative (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))) (at s within ?ivl)"
       using sol_old apply simp
       apply(drule solves_odeD(1))
       by (auto simp add: has_vderiv_on_def has_vector_derivative_def)
     have sol_eta:"(\<lambda>t. \<chi> i. ?flow t $ i) = ?flow" by(rule ext, rule vec_extensionality, auto)
     have sol_deriv_eq1:"\<And>s i. (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) = (\<lambda>xa. \<chi> i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))"
       by(rule ext, rule vec_extensionality, auto)
     have sol_deriv_proj:"\<And>s i. s\<in>?ivl \<Longrightarrow>  ((\<lambda>t. ?flow t $ i) has_derivative (\<lambda>xa. (xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)) (at s within ?ivl)"         
       subgoal for s i
         apply(rule has_derivative_proj[of "(\<lambda> i t. ?flow t $ i)" "(\<lambda> i t'. (t' *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)" "(at s within ?ivl)" "i"])
         using sol_deriv_orig[of s] sol_eta sol_deriv_eq1 by auto
       done
     have sol_deriv_eq2:"\<And>s i. (\<lambda>xa. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) = (\<lambda>xa. (xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)"
       by(rule ext, auto)
     have sol_deriv_proj':"\<And>s i. s\<in>?ivl \<Longrightarrow>  ((\<lambda>t. ?flow t $ i) has_derivative (\<lambda>xa. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))) (at s within ?ivl)"
       subgoal for s i using sol_deriv_proj[of s i] sol_deriv_eq2[of i s] by metis done  
     have sol_deriv_proj_vid1:"\<And>s. s\<in>?ivl \<Longrightarrow>  ((\<lambda>t. ?flow t $ vid1) has_derivative (\<lambda>xa. xa * (sterm_sem I (f1 fid1 vid1) (?flow s)))) (at s within ?ivl)"
       subgoal for s
         using sol_deriv_proj'[of s vid1] by auto done
     have deriv1_args:"\<And>s. s \<in> ?ivl \<Longrightarrow> ((\<lambda> t. (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow t))) has_derivative ((\<lambda> t'. \<chi> i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)))) (at s within ?ivl)"
       apply(rule has_derivative_vec)
       by (auto simp add: sol_deriv_proj_vid1)          
     have con_fid:"\<And>fid. continuous_on ?ivl (\<lambda>x. sterm_sem I (f1 fid vid1) (?flow x))"
       subgoal for fid
       apply(rule has_derivative_continuous_on[of "?ivl" "(\<lambda>x. sterm_sem I (f1 fid vid1) (?flow x))"
           "(\<lambda>t t'.  FunctionFrechet I fid (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow t)) (\<chi> i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow t) else 0)))"])
     proof -
       fix s
       assume ivl:"s \<in> ?ivl"
       let ?h = "(\<lambda>x. sterm_sem I (f1 fid vid1) (?flow x))"
       let ?g = "Functions I fid"
       let ?f = "(\<lambda>x. (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow x)))"
       let ?h' = "(\<lambda>t'. FunctionFrechet I fid (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow s))
               (\<chi> i. t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)))"
       let ?g' = "FunctionFrechet I fid (?f s)"
       let ?f' = "(\<lambda> t'. \<chi> i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))"
       have heq:"?h = ?g \<circ> ?f" unfolding comp_def f1_def expand_singleton by auto
       have heq':"?h' = ?g' \<circ> ?f'" unfolding comp_def by auto
       have fderiv:"(?f has_derivative ?f') (at s within ?ivl)"
         using deriv1_args[OF ivl] by auto
       have gderiv:"(?g has_derivative ?g') (at (?f s) within (?f ` ?ivl))"
         using good_interp unfolding is_interp_def 
         using  has_derivative_within_subset by blast
       have gfderiv:"((?g \<circ> ?f) has_derivative (?g' \<circ> ?f')) (at s within ?ivl)"
         using fderiv gderiv diff_chain_within by blast
       show "((\<lambda>x. sterm_sem I (f1 fid vid1) (?flow x)) has_derivative
        (\<lambda>t'. FunctionFrechet I fid (\<chi> i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow s))
               (\<chi> i. t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))))
        (at s within ?ivl)"
         using heq heq' gfderiv by auto
     qed
     done
     have con:"\<And>x. continuous_on (?ivl) (\<lambda>t. x * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
       apply(rule continuous_on_add)
        apply(rule continuous_on_mult_left)
        apply(rule con_fid[of fid2])
       by(rule con_fid[of fid3])
     let ?axis = "(\<lambda> i. Blinfun(axis i))"
     have bounded_linear_deriv:"\<And>t. bounded_linear (\<lambda>y' . y' *\<^sub>R  sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))" 
       using bounded_linear_scaleR_left by blast
     have ll:"local_lipschitz (ll_old.existence_ivl 0 (sol 0)) UNIV (\<lambda>t y. y * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
       apply(rule c1_implies_local_lipschitz[where f'="(\<lambda> (t,y). Blinfun(\<lambda>y' . y' *\<^sub>R  sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)))"])
          apply auto
        subgoal for t x
          apply(rule has_derivative_add_const)
          proof -
            have deriv:"((\<lambda>x. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) has_derivative (\<lambda>x. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))) (at x)"
              by(auto intro: derivative_eq_intros)
            have eq:"(\<lambda>x. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) = blinfun_apply (Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)))"
              apply(rule ext)
              using bounded_linear_deriv[of t]  by (auto simp add:  bounded_linear_Blinfun_apply)
            show "((\<lambda>x. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) has_derivative
               blinfun_apply (Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))))
               (at x)" using deriv eq by auto
          qed
       apply(auto intro: continuous_intros simp add: split_beta')
     proof -
       have bounded_linear:"\<And>x. bounded_linear (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) x)" 
         by (simp add: bounded_linear_mult_left)
       have eq:"(\<lambda>x. Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) x)) = (\<lambda>x. (sterm_sem I (f1 fid2 vid1) x) *\<^sub>R id_blinfun)"
         apply(rule ext, rule blinfun_eqI)
         subgoal for x i
           using bounded_linear[of x] apply(auto simp add: bounded_linear_Blinfun_apply)
           by (simp add: blinfun.scaleR_left)
         done
       have conFlow:"continuous_on (ll_old.existence_ivl 0 (sol 0)) (ll_old.flow 0 (sol 0))"
         using ll_old.general.flow_continuous_on by blast
       have conF':"continuous_on (ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0)) 
             (\<lambda>x. (sterm_sem I (f1 fid2 vid1) x) *\<^sub>R id_blinfun)"
         apply(rule continuous_on_scaleR)
          apply(auto intro: continuous_intros)
         apply(rule sterm_continuous')
          apply(rule good_interp)
         by(auto simp add: f1_def intro: dfree.intros) 
       have conF:"continuous_on (ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0)) 
             (\<lambda>x. Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) x))"
         apply(rule continuous_on_compose2[of "UNIV" "(\<lambda>x. Blinfun (\<lambda>y'. y' * x))" "(ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0))" "sterm_sem I (f1 fid2 vid1)"]) 
           subgoal by (metis blinfun_mult_left.abs_eq bounded_linear_blinfun_mult_left continuous_on_eq linear_continuous_on)
          apply(rule sterm_continuous')
           apply(rule good_interp)
         by(auto simp add: f1_def intro: dfree.intros) 
       show "continuous_on (ll_old.existence_ivl 0 (sol 0) \<times> UNIV) (\<lambda>x. Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) (fst x))))"
         apply(rule continuous_on_compose2[of "ll_old.existence_ivl 0 (sol 0)" "(\<lambda>x. Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) x)))" "(ll_old.existence_ivl 0 (sol 0) \<times> UNIV)" "fst"])
           apply(rule continuous_on_compose2[of "(ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0))" "(\<lambda>x. Blinfun (\<lambda>y'. y' * sterm_sem I (f1 fid2 vid1) x))" 
                 "(ll_old.existence_ivl 0 (sol 0))" "(ll_old.flow 0 (sol 0))"])
             using conF conFlow by (auto intro!: continuous_intros)
       qed
     let ?ivl = "ll_old.existence_ivl 0 (sol 0)"
     \<comment> \<open>Construct solution to ODE for \<open>y'\<close> here:\<close>
     let ?yode = "(\<lambda>t y. y * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
     let ?ysol0 = r
     interpret ll_new: ll_on_open_it "?ivl" "?yode" "UNIV" 0
       apply(standard)
           apply(auto)
        apply(rule ll)
       by(rule con)
     have sol_new:"(ll_new.flow 0 r solves_ode ?yode) (ll_new.existence_ivl 0 r) UNIV"
       by(rule ll_new.flow_solves_ode, auto)
     have more_lipschitz:"\<And>tm tM. tm \<in> ll_old.existence_ivl 0 (sol 0) \<Longrightarrow>
          tM \<in> ll_old.existence_ivl 0 (sol 0) \<Longrightarrow>
          \<exists>M L. \<forall>t\<in>{tm..tM}. \<forall>x. \<bar>x * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t)\<bar> \<le> M + L * \<bar>x\<bar>"
     proof -
       fix tm tM
       assume tm:"tm \<in> ll_old.existence_ivl 0 (sol 0)"
       assume tM:"tM \<in> ll_old.existence_ivl 0 (sol 0)"
       let ?f2 = "(\<lambda>t. sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))"
       let ?f3 = "(\<lambda>t. sterm_sem I (f1 fid3 vid1) (ll_old.flow 0 (sol 0) t))"
       let ?boundLP = "(\<lambda>L t . (tm \<le> t \<and> t \<le> tM \<longrightarrow> \<bar>?f2 t\<bar> \<le> L))"
       let ?boundL = "(SOME L. (\<forall>t. ?boundLP L t))"
       have compactT:"compact {tm..tM}" by auto
       have sub:"{tm..tM} \<subseteq> ll_old.existence_ivl 0 (sol 0)"
         by (metis atLeastatMost_empty_iff empty_subsetI ll_old.general.segment_subset_existence_ivl real_Icc_closed_segment tM tm)
       let ?f2abs = "(\<lambda>x. abs(?f2 x))"
       have neg_compact:"\<And>S::real set. compact S \<Longrightarrow> compact ((\<lambda>x. -x) ` S)"
         by(rule compact_continuous_image, auto intro: continuous_intros)
       have compactf2:"compact (?f2 ` {tm..tM})"
         apply(rule compact_continuous_image)
          apply(rule continuous_on_compose2[of UNIV "sterm_sem I (f1 fid2 vid1)" "{tm..tM}" "ll_old.flow 0 (sol 0)"])
            apply(rule sterm_continuous)
             apply(rule good_interp)
            subgoal by (auto intro: dfree.intros simp add: f1_def)
           apply(rule continuous_on_subset)
            prefer 2 apply (rule sub)
           subgoal using ll_old.general.flow_continuous_on by blast
          by auto
       then have boundedf2:"bounded (?f2 ` {tm..tM})" using compact_imp_bounded by auto
       then have boundedf2neg:"bounded ((\<lambda>x. -x) ` ?f2 ` {tm..tM})" using compact_imp_bounded neg_compact by auto
       then have bdd_above_f2neg:"bdd_above ((\<lambda>x. -x) ` ?f2 ` {tm..tM})" by (rule bounded_imp_bdd_above)
       then have bdd_above_f2:"bdd_above ( ?f2 ` {tm..tM})" using bounded_imp_bdd_above boundedf2 by auto
       have bdd_above_f2_abs:"bdd_above (abs ` ?f2 ` {tm..tM})" 
         using bdd_above_f2neg bdd_above_f2 unfolding bdd_above_def
         apply auto
         subgoal for M1 M2
           apply(rule exI[where x="max M1 M2"])
           by fastforce
         done
       then have theBound:"\<exists>L. (\<forall>t. ?boundLP L t)" 
         unfolding bdd_above_def norm_conv_dist 
-        apply (auto simp add: norm_conv_dist real_norm_def norm_bcontfun_def dist_0_norm dist_blinfun_def)
-        by fastforce
+        by (auto simp add: Ball_def Bex_def norm_conv_dist image_iff norm_bcontfun_def dist_blinfun_def)
       then have boundLP:"\<forall>t. ?boundLP (?boundL) t" using someI[of "(\<lambda> L. \<forall>t. ?boundLP L t)"] by blast
       let ?boundMP = "(\<lambda>M t. (tm \<le> t \<and> t \<le> tM \<longrightarrow> \<bar>?f3 t\<bar> \<le> M))"
       let ?boundM = "(SOME M. (\<forall>t. ?boundMP M t))"
       have compactf3:"compact (?f3 ` {tm..tM})"
         apply(rule compact_continuous_image)
          apply(rule continuous_on_compose2[of UNIV "sterm_sem I (f1 fid3 vid1)" "{tm..tM}" "ll_old.flow 0 (sol 0)"])
            apply(rule sterm_continuous)
             apply(rule good_interp)
            subgoal by (auto intro: dfree.intros simp add: f1_def)
           apply(rule continuous_on_subset)
            prefer 2 apply (rule sub)
           subgoal using ll_old.general.flow_continuous_on by blast
          by auto
       then have boundedf3:"bounded (?f3 ` {tm..tM})" using compact_imp_bounded by auto
       then have boundedf3neg:"bounded ((\<lambda>x. -x) ` ?f3 ` {tm..tM})" using compact_imp_bounded neg_compact by auto
       then have bdd_above_f3neg:"bdd_above ((\<lambda>x. -x) ` ?f3 ` {tm..tM})" by (rule bounded_imp_bdd_above)
       then have bdd_above_f3:"bdd_above ( ?f3 ` {tm..tM})" using bounded_imp_bdd_above boundedf3 by auto
       have bdd_above_f3_abs:"bdd_above (abs ` ?f3 ` {tm..tM})" 
         using bdd_above_f3neg bdd_above_f3 unfolding bdd_above_def
         apply auto
         subgoal for M1 M2
           apply(rule exI[where x="max M1 M2"])
           by fastforce
         done
-      then have theBound:"\<exists>L. (\<forall>t. ?boundMP L t)" 
-        unfolding bdd_above_def norm_conv_dist 
-        apply (auto simp add: norm_conv_dist real_norm_def norm_bcontfun_def dist_0_norm dist_blinfun_def)
-        by fastforce
+      then have theBound:"\<exists>L. (\<forall>t. ?boundMP L t)"
+        unfolding bdd_above_def norm_conv_dist
+        by (auto simp add: Ball_def Bex_def norm_conv_dist image_iff norm_bcontfun_def dist_blinfun_def)
       then have boundMP:"\<forall>t. ?boundMP (?boundM) t" using someI[of "(\<lambda> M. \<forall>t. ?boundMP M t)"] by blast
       show "\<exists>M L. \<forall>t\<in>{tm..tM}. \<forall>x. \<bar>x * ?f2 t + ?f3 t\<bar> \<le> M + L * \<bar>x\<bar>"
         apply(rule exI[where x="?boundM"])
         apply(rule exI[where x="?boundL"])
         apply auto
       proof -
         fix t and x :: real
         assume ttm:"tm \<le> t"
         assume ttM:"t \<le> tM"
         from ttm ttM have ttmM:"tm \<le> t \<and> t \<le> tM" by auto 
         have leqf3:"\<bar>?f3 t\<bar> \<le> ?boundM" using boundMP ttmM by auto
         have leqf2:"\<bar>?f2 t\<bar> \<le> ?boundL" using boundLP ttmM by auto
         have gr0:" \<bar>x\<bar> \<ge> 0" by auto
         have leqf2x:"\<bar>?f2 t\<bar> * \<bar>x\<bar> \<le> ?boundL * \<bar>x\<bar>" using gr0 leqf2
           by (metis (no_types, lifting) real_scaleR_def scaleR_right_mono)
-        have "\<bar>x * ?f2 t + ?f3 t\<bar> \<le> \<bar>x\<bar> * \<bar>?f2 t\<bar> + \<bar>?f3 t\<bar>"                    
+        have "\<bar>x * ?f2 t + ?f3 t\<bar> \<le> \<bar>x\<bar> * \<bar>?f2 t\<bar> + \<bar>?f3 t\<bar>"
           proof -
             have f1: "\<And>r ra. \<bar>r::real\<bar> * \<bar>ra\<bar> = \<bar>r * ra\<bar>"
               by (metis norm_scaleR real_norm_def real_scaleR_def)
             have "\<And>r ra. \<bar>(r::real) + ra\<bar> \<le> \<bar>r\<bar> + \<bar>ra\<bar>"
               by (metis norm_triangle_ineq real_norm_def)
               then show ?thesis
               using f1 by presburger
           qed
         moreover have "... = \<bar>?f3 t\<bar> + \<bar>?f2 t\<bar> * \<bar>x\<bar>"
           by auto
         moreover have "... \<le> ?boundM + \<bar>?f2 t\<bar> * \<bar>x\<bar>"
           using leqf3 by linarith
         moreover have "... \<le> ?boundM + ?boundL * \<bar>x\<bar>"
           using leqf2x  by linarith
         ultimately show "\<bar>x * ?f2 t + ?f3 t\<bar> \<le> ?boundM + ?boundL * \<bar>x\<bar>"
           by linarith
       qed
     qed
     have ivls_eq:"(ll_new.existence_ivl 0 r) = (ll_old.existence_ivl 0 (sol 0))"
       apply(rule ll_new.existence_ivl_eq_domain)
           apply auto
       apply (rule more_lipschitz)
       by auto
     have sub':"{0--t} \<subseteq> ll_new.existence_ivl 0 r"
       using sub ivls_eq by auto
     have sol_new':"(ll_new.flow 0 r solves_ode ?yode) {0--t} UNIV"
       by(rule solves_ode_subset, rule sol_new, rule sub')
     let ?soly = "ll_new.flow 0 r"
-    let ?sol' = "(\<lambda>t. \<chi> i. if i = vid2 then ?soly t else sol t $ i)" 
+    let ?sol' = "(\<lambda>t. \<chi> i. if i = vid2 then ?soly t else sol t $ i)"
     let ?aaba' = "mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                              (OSing vid2
                                (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
-                                 ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))))) 
-                         (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) 
+                                 ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
+                         (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b)
                          (?sol' t)"
     have duh:"(fst ?aaba', snd ?aaba') = ?aaba'" by auto
     note bigEx = spec[OF spec[OF bigAll, where x="fst ?aaba'"], where x="snd ?aaba'"]
     have sol_deriv:"\<And>s. s \<in> {0..t} \<Longrightarrow> (sol has_derivative (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0))) (at s within {0..t})"
        using sol apply simp
        by(drule solves_odeD(1), auto simp add: has_vderiv_on_def has_vector_derivative_def)
      have silly_eq1:"(\<lambda>t. \<chi> i. sol t $ i) = sol"
        by(rule ext, rule vec_extensionality, auto)
      have silly_eq2:"\<And>s. (\<lambda>xa. \<chi> i. (xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0)) $ i) = (\<lambda>xa. xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0))"
        by(rule ext, rule vec_extensionality, auto)
      have sol_proj_deriv:"\<And>s i. s \<in> {0..t} \<Longrightarrow> ((\<lambda> t. sol t $ i) has_derivative (\<lambda>xa. (xa *\<^sub>R (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0)) $ i)) (at s within {0..t})"
        subgoal for s i
          apply(rule has_derivative_proj)
          using sol_deriv[of s] silly_eq1 silly_eq2[of s] by auto
        done
      have sol_proj_deriv_vid1:"\<And>s. s \<in> {0..t} \<Longrightarrow> ((\<lambda> t. sol t $ vid1) has_derivative (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (sol s))) (at s within {0..t})"
        subgoal for s using sol_proj_deriv[of s vid1] by auto done
      have sol_proj_deriv_other:"\<And>s i. s \<in> {0..t} \<Longrightarrow> i \<noteq> vid1 \<Longrightarrow> ((\<lambda> t. sol t $ i) has_derivative (\<lambda>xa. 0)) (at s within {0..t})"
        subgoal for s i using sol_proj_deriv[of s i] by auto done
      have fact:"\<And>x. x \<in>{0..t} \<Longrightarrow>
    (ll_new.flow 0 r has_derivative
     (\<lambda>xa. xa *\<^sub>R (ll_new.flow 0 r x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) x) +
                   sterm_sem I (f1 fid3 vid1) (ll_old.flow 0 (sol 0) x))))
     (at x within {0 .. t})"
        using sol_new' apply simp
        apply(drule solves_odeD(1))
        using tclosed unfolding has_vderiv_on_def has_vector_derivative_def by auto
      have new_sol_deriv:"\<And>s. s \<in> {0..t} \<Longrightarrow> (ll_new.flow 0 r has_derivative
       (\<lambda>xa. xa *\<^sub>R (ll_new.flow 0 r s * sterm_sem I (f1 fid2 vid1) (sol s) + sterm_sem I (f1 fid3 vid1) (sol s))))
       (at s within {0.. t})"
        subgoal for s
          using fact[of s] tclosed sol_eq_flow[of s] by auto
        done
      have sterm_agree:"\<And>s. Vagree (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) {Inl vid1}"
        subgoal for s unfolding Vagree_def using vne12 by auto done
      have FVF:"(FVT (f1 fid2 vid1)) = {Inl vid1}" unfolding f1_def expand_singleton apply auto subgoal for x xa by (cases "xa = vid1", auto) done
      have FVF2:"(FVT (f1 fid3 vid1)) = {Inl vid1}" unfolding f1_def expand_singleton apply auto subgoal for x xa by (cases "xa = vid1", auto) done
      have sterm_agree_FVF:"\<And>s. Vagree (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) (FVT (f1 fid2 vid1))"
        using sterm_agree FVF by auto
      have sterm_agree_FVF2:"\<And>s. Vagree (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) (FVT (f1 fid3 vid1))"
        using sterm_agree FVF2 by auto
      have y_component_sem_eq2:"\<And>s. sterm_sem I (f1 fid2 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
         = sterm_sem I (f1 fid2 vid1) (sol s)"
        using coincidence_sterm[OF sterm_agree_FVF, of I] by auto
      have y_component_sem_eq3:"\<And>s. sterm_sem I (f1 fid3 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
         = sterm_sem I (f1 fid3 vid1) (sol s)"
        using coincidence_sterm[OF sterm_agree_FVF2, of I] by auto
      have y_component_ode_eq:"\<And>s. s \<in> {0..t} \<Longrightarrow> 
        (\<lambda>xa. xa * (ll_new.flow 0 r s * sterm_sem I (f1 fid2 vid1) (sol s) + sterm_sem I (f1 fid3 vid1) (sol s)))
      = (\<lambda>xa. xa * (sterm_sem I (f1 fid2 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) * ll_new.flow 0 r s +
              sterm_sem I (f1 fid3 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
        subgoal for s
          apply(rule ext)
          subgoal for xa
            using y_component_sem_eq2 y_component_sem_eq3 by auto
          done
        done
      have agree_vid1:"\<And>s. Vagree (sol s, undefined) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) {Inl vid1}"
        unfolding Vagree_def using vne12 by auto
      have FVT_vid1:"FVT(f1 fid1 vid1) = {Inl vid1}" apply(auto simp add: f1_def) subgoal for x xa apply(cases "xa = vid1") by auto done
      have agree_vid1_FVT:"\<And>s. Vagree (sol s, undefined) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (FVT (f1 fid1 vid1))"
        using FVT_vid1 agree_vid1 by auto
      have sterm_eq_vid1:"\<And>s. sterm_sem I (f1 fid1 vid1) (sol s) = sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)"
        subgoal for  s
          using coincidence_sterm[OF agree_vid1_FVT[of s], of I] by auto
        done
      have vid1_deriv_eq:"\<And>s. (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (sol s)) =
        (\<lambda>xa. xa * sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i))"
        subgoal for s
          apply(rule ext)
          subgoal for x'
            using sterm_eq_vid1[of s] by auto
          done done
      have inner_deriv:"\<And>s. s \<in> {0..t} \<Longrightarrow>
    ((\<lambda>t. \<chi> i. if i = vid2 then ll_new.flow 0 r t else sol t $ i) has_derivative (\<lambda>xa. (\<chi> i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else
                                          if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0))))
                                          (at s within {0..t})"
        subgoal for s
          apply(rule has_derivative_vec)
          subgoal for i
            apply(cases "i = vid2")
            subgoal
              using vne12
              using new_sol_deriv[of s]
              using y_component_ode_eq by auto
            subgoal 
              apply(cases "i = vid1")
              using sol_proj_deriv_vid1[of s] vid1_deriv_eq[of s] sol_proj_deriv_other[of s i] by auto
            done
          done
        done
      have deriv_eta:"\<And>s. (\<lambda>xa. xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0) +
                (\<chi> i. if i = vid2
                      then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))
                            (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
                      else 0)))
                      = (\<lambda>xa. (\<chi> i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else
                                          if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0))) "
        subgoal for s
          apply(rule ext)
          apply(rule vec_extensionality)
          using vne12 by auto
        done
      have sol'_deriv:"\<And>s. s \<in> {0..t} \<Longrightarrow>
    ((\<lambda>t. \<chi> i. if i = vid2 then ll_new.flow 0 r t else sol t $ i) has_derivative
     (\<lambda>xa. xa *\<^sub>R ((\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0) +
                   (\<chi> i. if i = vid2
                         then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))
                               (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
                         else 0))))
     (at s within {0..t})"
        subgoal for s
          using inner_deriv[of s] deriv_eta[of s] by auto done
      have FVT:"\<And>i. FVT (if i = vid1 then trm.Var vid1 else Const 0) \<subseteq> {Inl vid1}" by auto
      have agree:"\<And>s. Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
           (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)) {Inl vid1}"
        subgoal for s
          using mk_v_agree [of "I" "(OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(sol s)"]
          using mk_v_agree [of I "(OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))" "(\<chi> y. if vid2 = y then r else fst (a, b) $ y, b)" "(\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)"]
          unfolding Vagree_def using vne12 by simp
        done
      have agree':"\<And>s i. Vagree (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
           (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)) (FVT (if i = vid1 then trm.Var vid1 else Const 0))"
        subgoal for s i using agree_sub[OF FVT[of i] agree[of s]] by auto done
      have safe:"\<And>i. dsafe (if i = vid1 then trm.Var vid1 else Const 0)" subgoal for i apply(cases "i = vid1", auto) done done           
      have dterm_sem_eq:"\<And>s i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) 
        = dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
        (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
           (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i))"
        subgoal for s i using coincidence_dterm[OF safe[of i] agree'[of s i], of I] by auto done
      have dterm_vec_eq:"\<And>s. (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)))
        = (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
        (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
           (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
        subgoal for s
          apply(rule vec_extensionality)
          subgoal for i using dterm_sem_eq[of i s] by auto
          done done
      have pred_same:"\<And>s. s \<in> {0..t} \<Longrightarrow> Predicates I vid1
         (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s))) \<Longrightarrow>
 Predicates I vid1
  (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
         (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
           (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
        subgoal for s using dterm_vec_eq[of s] by auto done
    have sol'_domain:"\<And>s. 0 \<le> s \<Longrightarrow>
   s \<le> t \<Longrightarrow>
   Predicates I vid1
    (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
           (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                     (OSing vid2
                       (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                         (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) (\<chi> i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
        subgoal for s
          using sol apply simp
          apply(drule solves_odeD(2))
          using pred_same[of s] by auto
        done
      have sol':"(?sol' solves_ode
  (\<lambda>a b. (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
         (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
  {0..t} {x. Predicates I vid1
              (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                     (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                               (OSing vid2
                                 (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                   ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                       (\<chi> y. if vid2 = y then r else fst (a, b) $ y, b) x))}"
        apply(rule solves_odeI)
        subgoal
          unfolding has_vderiv_on_def has_vector_derivative_def
          using sol'_deriv by auto
        by(auto, rule sol'_domain, auto)
      have set_eq:"{y. y = vid2 \<or> y = vid1 \<or> y = vid2 \<or> y = vid1 \<or> (\<exists>x. Inl y \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))} = {vid1, vid2}"
        by auto
      have "VSagree (?sol' 0) (\<chi> y. if vid2 = y then r else fst (a, b) $ y) {vid1, vid2}"
        using VSA unfolding VSagree_def by simp 
      then have VSA':" VSagree (?sol' 0) (\<chi> y. if vid2 = y then r else fst (a, b) $ y)
        
  {y. y = vid2 \<or> y = vid1 \<or> y = vid2 \<or> y = vid1 \<or> (\<exists>x. Inl y \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))} "
        by (auto simp add: set_eq)
      have bigPre:"(\<exists>sol t. (fst ?aaba', snd ?aaba') =
                     mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                              (OSing vid2
                                (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                  ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                      ((\<chi> y. if vid2 = y then r else fst (a,b) $ y), b) (sol t) \<and>
                     0 \<le> t \<and>
                     (sol solves_ode
                      (\<lambda>a b. (\<chi> i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
                             (\<chi> i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
                      {0..t} {x. Predicates I vid1
                                  (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                         (mk_v I (OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                                                   (OSing vid2
                                                     (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                                       ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))
                                           ((\<chi> y. if vid2 = y then r else (fst (a,b)) $ y), b) x))} \<and>
                     VSagree (sol 0) (\<chi> y. if vid2 = y then r else fst (a,b) $ y)
                      {uu. uu = vid2 \<or>
                     uu = vid1 \<or>
                     uu = vid2 \<or>
                     uu = vid1 \<or>
                     Inl uu \<in> Inl ` ({x. \<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0)} \<union>
                                      {x. x = vid2 \<or> (\<exists>xa. Inl x \<in> FVT (if xa = vid1 then trm.Var vid1 else Const 0))}) \<or>
                     (\<exists>x. Inl uu \<in> FVT (if x = vid1 then trm.Var vid1 else Const 0))})"
        apply(rule exI[where x="?sol'"])
        apply(rule exI[where x=t])
        apply(rule conjI)
         subgoal by simp
        apply(rule conjI)
         subgoal by (rule t)
        apply(rule conjI)
         apply(rule sol')
         using VSA' unfolding VSagree_def by auto
      have pred_sem:"Predicates I vid2 (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')"
        using mp[OF bigEx bigPre] by auto
      let ?other_state = "(mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t))"
      have agree:"Vagree (?aaba') (?other_state) {Inl vid1} "
        using mk_v_agree [of "I" "(OProd (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))))"
          "(\<chi> y. if vid2 = y then r else fst (a, b) $ y, b)" "(?sol' t)"]
        using mk_v_agree [of "I" "(OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(sol t)"]
        unfolding Vagree_def using vne12 by simp
      have sub:"\<And>i. FVT (if i = vid1 then trm.Var vid1 else Const 0) \<subseteq> {Inl vid1}"
        by auto
      have agree':"\<And>i. Vagree (?aaba') (?other_state) (FVT (if i = vid1 then trm.Var vid1 else Const 0)) "
        subgoal for i using agree_sub[OF sub[of i] agree] by auto done
      have silly_safe:"\<And>i. dsafe (if i = vid1 then trm.Var vid1 else Const 0)"
        subgoal for i
          apply(cases "i = vid1")
           by (auto simp add: dsafe_Var dsafe_Const)
        done
      have dsem_eq:"(\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')  = 
         (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?other_state)"
        apply(rule vec_extensionality)
        subgoal for i
          using coincidence_dterm[OF silly_safe[of i] agree'[of i], of I] by auto
        done
      show
     "Predicates I vid2
      (\<chi> i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (mk_v I (OSing vid1 ($f fid1 (\<lambda>i. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t)))"
      using pred_sem dsem_eq by auto
  qed
 
 
 done
 qed
 end end
 
diff --git a/thys/Ordinary_Differential_Equations/Ex/Lorenz/Lorenz_Approximation.thy b/thys/Ordinary_Differential_Equations/Ex/Lorenz/Lorenz_Approximation.thy
--- a/thys/Ordinary_Differential_Equations/Ex/Lorenz/Lorenz_Approximation.thy
+++ b/thys/Ordinary_Differential_Equations/Ex/Lorenz/Lorenz_Approximation.thy
@@ -1,3044 +1,3044 @@
 section"Example: Lorenz attractor"
 theory Lorenz_Approximation
 imports
   "HOL-ODE-Numerics.ODE_Numerics"
   Result_File_Coarse
 begin
 text \<open>\label{sec:lorenz}\<close>
 
 text \<open>TODO: move to isabelle? \<close>
 lifting_update blinfun.lifting
 lifting_forget blinfun.lifting
 
 
 lemma eventually_uniformly_on:
   "(\<forall>\<^sub>F x in uniformly_on T l. P x) = (\<exists>e>0. \<forall>f. (\<forall>x\<in>T. dist (f x) (l x) < e) \<longrightarrow> P f)"
   unfolding uniformly_on_def
   apply (subst eventually_INF)
   apply safe
   subgoal for E
     apply (cases "E = {}")
     subgoal by (auto intro!: exI[where x=1])
     subgoal
       apply (auto simp: INF_principal_finite eventually_principal elim!: )
     proof goal_cases
       case (1 x)
       from 1 have "0 < Min E"
         apply (subst Min_gr_iff)
           apply force apply force apply force done
       have *: "(\<Inter>e\<in>E. {f. \<forall>t\<in>T. dist (f t) (l t) < e}) = {f. \<forall>t\<in>T. dist (f t) (l t) < Min E}"
         using 1 apply (auto simp: )
          apply (subst Min_gr_iff)
            apply force apply force apply force
         apply (drule bspec, assumption)
         apply (rule less_le_trans, assumption)
         apply auto
         done
       from 1 have "\<forall>f. (\<forall>x\<in>T. dist (f x) (l x) < Min E) \<longrightarrow> P f" unfolding * by simp
       then show ?case
         using 1(4)[rule_format, OF \<open>0 < Min E\<close>] by auto
     qed
     done
   subgoal for e
     apply (rule exI[where x="{e}"])
     by (auto simp: eventually_principal)
   done
 
 
 lemma op_cast_image_impl[autoref_rules]:
   "(\<lambda>x. x, op_cast_image::'a::executable_euclidean_space set \<Rightarrow>
                           'b::executable_euclidean_space set)
     \<in> aform.appr_rel \<rightarrow> aform.appr_rel"
   if "DIM('a) = DIM('b)"
   using that
   apply (auto simp: aform.appr_rel_def intro!: relcompI)
   unfolding lv_rel_def set_rel_br
   by (force simp: intro!: brI dest!: brD)
 
 lemma cast_bl_blinfun_of_list[simp]:
   "cast_bl (blinfun_of_list xs::'a \<Rightarrow>\<^sub>L 'a) =
     (blinfun_of_list xs::'b\<Rightarrow>\<^sub>L'b)"
   if "DIM('a::executable_euclidean_space) = DIM('b::executable_euclidean_space)"
   using that
   apply (auto simp: cast_bl_rep intro!: blinfun_eqI)
   by (auto simp: blinfun_of_list_def blinfun_of_matrix_apply
       linear_sum linear.scaleR sum_Basis_sum_nth_Basis_list
       linear_cast)
 
 lemma cast_idem[simp]: "cast x = x"
   by (auto simp: cast_def)
 
 lemma cast_bl_idem[simp]: "cast_bl x = x"
   by (auto simp: cast_bl_rep intro!: blinfun_eqI)
 
 lemma op_cast_eucl1_image_impl[autoref_rules]:
   "(\<lambda>x. x, op_cast_eucl1_image::'a::executable_euclidean_space c1_info set \<Rightarrow>
                           'b::executable_euclidean_space c1_info set)
     \<in> aform.appr1_rel \<rightarrow> aform.appr1_rel"
   if "DIM_precond TYPE('a) D"
     "DIM_precond TYPE('b) D"
   using that
 proof (auto, goal_cases)
   case (1 a b a')
   then show ?case
     apply (auto simp: aform.appr1_rel_br set_rel_br br_def)
     subgoal for w x y z
       apply (auto simp: aform.c1_info_of_appr_def cast_eucl1_def aform.c1_info_invar_def
           split: option.splits)
        apply (rule image_eqI)
         apply (rule cast_eucl_of_list, force, force simp: Joints_imp_length_eq, force)
       subgoal for s t
         apply (rule image_eqI[where x="t"])
          supply [simp del] = eucl_of_list_take_DIM
         apply (auto simp: flow1_of_list_def)
         apply (subst cast_eucl_of_list)
         subgoal by simp
         subgoal
           by (auto dest!: Joints_imp_length_eq
               simp: power2_eq_square flow1_of_list_def[abs_def])
         subgoal by simp
         done
       done
     subgoal for w x
       apply (rule image_eqI[where x="cast_eucl1 (w, x)"])
        apply (auto simp: aform.c1_info_of_appr_def cast_eucl1_def
           aform.c1_info_invar_def
           split: option.splits)
        apply (rule image_eqI)
         apply (rule cast_eucl_of_list, force, force simp: Joints_imp_length_eq, force)
       subgoal for s t
         apply (rule image_eqI[where x="t"])
          supply [simp del] = eucl_of_list_take_DIM
         apply (auto simp: flow1_of_list_def)
         apply (subst cast_eucl_of_list)
         subgoal by simp
         subgoal
           by (auto dest!: Joints_imp_length_eq
               simp: power2_eq_square flow1_of_list_def[abs_def])
         subgoal by simp
         done
       done
     done
 qed
 
 lemma less_3_iff: "i < (3::nat) \<longleftrightarrow> i = 0 \<or> i = 1 \<or> i = 2"
   by arith
 
 definition mat3_of_vec::"R3 \<Rightarrow> real^3^3" where
   "mat3_of_vec x = (let xs = list_of_eucl x in eucl_of_list [xs!0,0,0,  xs!1,0,0,  xs!2,0,0])"
 
 lemma ll3: "{..<3} = {0,1,2::nat}"
   by (auto simp: less_3_iff)
 
 lemma mat3_of_vec: "cast (mat3_of_vec x *v eucl_of_list [1, 0, 0]) = x"
   by (auto simp: mat3_of_vec_def eucl_of_list_matrix_vector_mult_eq_sum_nth_Basis_list
       linear_sum linear_cast linear.scaleR ll3 linear_add Basis_list_R3 inner_prod_def
       prod_eq_iff)
 
 primrec bisect_form where
   "bisect_form p f xs l u 0 = (l, u)"
 | "bisect_form p f xs l u (Suc n) =
     (let m = (l + u)/2 in
     if approx_form_aform p (f m) xs
     then bisect_form p f xs l m n
     else bisect_form p f xs m u n)"
 
 text \<open>This should prove that the expansion estimates are sufficient.\<close>
 
 lemma expansion_main: "expansion_main (coarse_results) = Some True"
   by eval
 
 context includes floatarith_notation begin
 
 definition "matrix_of_degrees2\<^sub>e =
   (let
     e = Var 2;
     ur = Rad_of (Var 0);
     vr = Rad_of (Var 1);
     x1 = Cos ur;
     x2 = Cos vr;
     y1 = Sin ur;
     y2 = Sin vr
    in
     [x1 + (e * (x2 - x1)), 0, 0,
     y1 + (e * (y2 - y1)), 0, 0,
     0, 0, 0])"
 
 definition "matrix_of_degrees2 u v =
   approx_floatariths 30 matrix_of_degrees2\<^sub>e (aforms_of_ivls [u, v, 0] [u, v, 1])"
 
 text \<open>following \<open>vector_field.h\<close> / \<open>vector_field.cc\<close>\<close>
 
 abbreviation "S \<equiv> 10::real"
 abbreviation "B \<equiv> 8/3::real"
 abbreviation "TEMP \<equiv> sqrt((S + 1) * (S + 1) + 4 * S * (28 - 1))"
 abbreviation "K1 \<equiv> S / TEMP"
 abbreviation "K2 \<equiv> (S - 1 + TEMP) / (2 * S)"
 abbreviation "K3 \<equiv> (S - 1 - TEMP) / (2 * S)"
 abbreviation "E1 \<equiv> (- (S + 1) + TEMP) / 2"
 abbreviation "E2 \<equiv> (- (S + 1) - TEMP) / 2"
 abbreviation "E3 \<equiv> - B"
 abbreviation "C1 \<equiv> \<lambda>X. X ! 0 + X ! 1"
 abbreviation "C2 \<equiv> \<lambda>X. K1 * C1 X * X ! 2"
 
 schematic_goal
   lorenz_fas:
   "[E1 * X!0 - C2 X,
     E2 * X!1 + C2 X,
     E3 * X!2 + C1 X * (K2 * X!0 + K3 * X!1)] =
   interpret_floatariths ?fas X"
   by (reify_floatariths)
 concrete_definition lorenz_fas uses lorenz_fas
 end
 
 interpretation lorenz: ode_interpretation true_form UNIV lorenz_fas "\<lambda>(X0, X1, X2).
  (E1 * X0 -        K1 * (X0 + X1) * X2,
   E2 * X1 +        K1 * (X0 + X1) * X2,
   E3 * X2 + (X0 + X1) * (K2 * X0 + K3 * X1))::real*real*real"
   "d::3" for d
   by standard
     (auto simp: lorenz_fas_def less_Suc_eq_0_disj nth_Basis_list_prod Basis_list_real_def
       mk_ode_ops_def eucl_of_list_prod power2_eq_square inverse_eq_divide intro!: isFDERIV_I)
 
 value [code] "length (slp_of_fas lorenz_fas)"
 
 definition "mig_aform p x = mig_componentwise (Inf_aform' p x) (Sup_aform' p x)"
 
 context includes floatarith_notation begin
 
-definition "mig_aforms p x = real_of_float ((fst o the) ((approx p (Norm (map (Num o float_of o (mig_aform p)) x))) []))"
+definition "mig_aforms p x = real_of_float ((lower o the) ((approx p (Norm (map (Num o float_of o (mig_aform p)) x))) []))"
 
 definition
   "column_of_c1_info x N j = (map (\<lambda>i. the (snd x) ! i) (map (\<lambda>i. i * N + j) [0..<N]))"
 
 definition "rotate_x_fa a =
   [1, 0, 0,
   0, Cos a, - Sin a,
   0, Sin a, Cos a]"
 
 definition "rotate_y_fa a =
   [Cos a, 0, Sin a,
   0, 1, 0,
   - Sin a, 0, Cos a]"
 
 definition "rotate_z_fa a =
   [Cos a, - Sin a, 0,
   Sin a, Cos a, 0,
   0, 0, 1]"
 
 definition "rotate_zx_slp a b xs =
   slp_of_fas (mvmult_fa 3 3 (mmult_fa 3 3 3 (rotate_x_fa (Rad_of (R\<^sub>e b))) (rotate_z_fa (Rad_of (R\<^sub>e a)))) xs)"
 
 definition "perspective_projection_aforms xs =
   the (approx_slp_outer 30 3 (rotate_zx_slp (-30) (-60) (map Var [0..<3])) xs)"
 
 definition "print_lorenz_aform print_fun cx cy cz ci
     cd1 cd2
   = (\<lambda>a b.
         let (s1, n) = ((-6), False);
             _ = print_fun (String.implode (''# gen(''@ show a@''): ''@ shows_aforms_hr (b) '''' @ ''\<newline>''));
             _ = print_fun (String.implode (''# box(''@ show a@''): ''@ shows_box_of_aforms_hr (b) '''' @ ''\<newline>''));
             ((x0, y0, z0), (x1, y1, z1)) = case (map (Inf_aform' 30) (take 3 b), map (Sup_aform' 30) (take 3 b)) of
               ([x0, y0, z0], [x1, y1, z1]) \<Rightarrow> ((x0, y0, z0), (x1, y1, z1));
             _ = print_fun (String.implode (shows_segments_of_aform 0 1 b ((shows cx o shows_space o shows z0 o shows_space o shows z1)'''') ''\<newline>''));
             _ = print_fun (String.implode (shows_segments_of_aform 0 2 b ((shows cy o shows_space o shows y0 o shows_space o shows y1)'''') ''\<newline>''));
             _ = print_fun (String.implode (shows_segments_of_aform 1 2 b ((shows cz o shows_space o shows x0 o shows_space o shows x1)'''') ''\<newline>''));
             PS = perspective_projection_aforms b;
             _ = print_fun (String.implode (shows_segments_of_aform 0 1 PS
                   ((shows ci o shows_space o shows (fst (PS ! 2)) o shows_space o shows (fst (b ! 2))) '''') ''\<newline>''))
         in if \<not> a \<and> length b > 10 then
           print_fun (String.implode (shows_aforms_vareq 3 [(0, 1), (0, 2), (1, 2)] [0..<3]
               cd1
               cd2
           (FloatR 1 s1 * (if n then
               real_divl 30 1 (max (mig_aforms 30 (map (\<lambda>i. b ! i) [3,6,9]))
                          (mig_aforms 30 (map (\<lambda>i. b ! i) [4,7,10])))
             else 1)) \<comment> \<open>always length \<open>2^s!\<close>\<close>
           ''# no C1 info'' b ''''))
         else ())"
 
 definition "print_lorenz_aform_std print_fun =
   print_lorenz_aform print_fun ''0x000001'' ''0x000002'' ''0x000012'' ''0x000003''
     [''0xa66f00'', ''0x06266f'', ''0xc60000'']
     [''0xffaa00'', ''0x1240ab'', ''0xc60000'']"
 
 definition "lorenz_optns print_funo =
   (let
     pf = the_default (\<lambda>_ _. ()) (map_option print_lorenz_aform_std print_funo);
     tf = the_default (\<lambda>_ _. ()) (map_option (\<lambda>print_fun a b.
           let
             _ = print_fun (String.implode (''# '' @ a @ ''\<newline>''))
           in case b of Some b \<Rightarrow>
             (print_fun (String.implode (''# '' @ shows_box_of_aforms_hr (b) '''' @ ''\<newline>'')))
             | None \<Rightarrow> ()) print_funo)
   in
     \<lparr>
     precision = 30,
     adaptive_atol = FloatR 1 (-30),
     adaptive_rtol = FloatR 1 (-30),
     method_id = 2,
     start_stepsize  = FloatR 1 (- 8),
     iterations = 40,
     halve_stepsizes = 10,
     widening_mod = 40,
     rk2_param = FloatR 1 0,
     default_reduce = correct_girard 30 50 25,
     printing_fun = pf,
     tracing_fun = tf
   \<rparr>)"
 
 definition lorenz_optns'
   where "lorenz_optns' pf m N rk2p a = lorenz_optns pf \<lparr>
       default_reduce := correct_girard 30 m N,
       rk2_param := rk2p,
       adaptive_atol := a,
       adaptive_rtol := a
     \<rparr>"
 
 definition mirror_irects
   where "mirror_irects =
     map (\<lambda>irect. case irect of [i, j, k] \<Rightarrow> [if j < 0 then - i else i , abs j, k] | irect \<Rightarrow> irect)"
 
 definition "print_irects irects =
   (let _ = map (\<lambda>is.
     let _ = map (\<lambda>j.
       let _ = print (String.implode (show j)) in print (STR '' '')) is in print (STR ''\<newline>'')) irects
   in ())"
 
 abbreviation "aforms_of_ivl \<equiv> \<lambda>x. aforms_of_ivls (fst x) (snd x)"
 
 definition "conefield_propagation\<^sub>e =
   ([Deg_of (Arctan (Var (6) / Var (3))),
    Deg_of (Arctan (Var (7) / Var (4))),
    Min (Norm [Var(3), Var (6), Var (9)]) (Norm [Var(4), Var (7), Var (10)])])"
 
 definition "conefield_propagation DX = approx_floatariths 30 conefield_propagation\<^sub>e DX"
 
 definition "conefield_propagation_slp = slp_of_fas conefield_propagation\<^sub>e"
 lemma [simp]: "length conefield_propagation_slp = 51"
   by eval
 
 definition op_with_unit_matrix :: "'a::real_normed_vector \<Rightarrow> 'a \<times> 'a \<Rightarrow>\<^sub>L 'a" where
   "op_with_unit_matrix X = (X, 1\<^sub>L)"
 
 context includes blinfun.lifting begin
 lemma matrix_vector_mult_blinfun_works[simp]: "matrix e *v g = e g" for e::"(real^'n) \<Rightarrow>\<^sub>L (real^'m)"
   by transfer (simp add: bounded_linear_def matrix_works)
 end
 
 lemma length_conefield_propagation\<^sub>e[simp]: "length conefield_propagation\<^sub>e = 3"
   by (simp add: conefield_propagation\<^sub>e_def)
 
 lemma interpret_floatariths_conefield_propagation:
   "interpret_floatariths conefield_propagation\<^sub>e
     (list_of_eucl (vec1_of_flow1 (xDX::(real^3) \<times> ((real^3)\<Rightarrow>\<^sub>L(real^3)))))
    =
   (let
     DX = snd xDX;
     DXu = DX (eucl_of_list [1, 0, 0]);
     DXv = DX (eucl_of_list [0, 1, 0])
   in
   [deg_of (arctan (vec_nth DXu 1 / vec_nth DXu 0)),
    deg_of (arctan (vec_nth DXv 1 / vec_nth DXv 0)),
    min (norm DXu) (norm DXv)]
   )"
   apply (auto simp: conefield_propagation\<^sub>e_def Let_def interpret_mvmult_nth[where 'n=3 and 'm=3]
       inverse_eq_divide vec1_of_flow1_def nth_append)
     apply (auto simp: matrix_inner_Basis_list )
     apply (auto simp: interpret_floatarith_norm[where 'a="real ^ 3"]
       einterpret_mvmult_fa[where 'n=3 and 'm=3] matrix_inner_Basis_list nth_append)
   by (auto simp: matrix_def axis_eq_eucl_of_list eucl_of_list_012)
 
 definition "conefield_bounds_form l u =
   (fold Conj [
     Less (-90) (N\<^sub>r l),
     LessEqual (N\<^sub>r l) (N\<^sub>r u),
     LessEqual (Var 9) (0),
     LessEqual 0 (Var 9),
     Less (N\<^sub>r u) (90),
     Less 0 (Var 3),
     AtLeastAtMost (Var 6) (Tan (Rad_of (N\<^sub>r l)) * Var 3) (Tan (Rad_of (N\<^sub>r u)) * Var 3)] true_form)"
 
 definition "contract_angles X i = (snd (bisect_form 30 (\<lambda>x. conefield_bounds_form x (89)) X 89 (-89) i),
                                    snd (bisect_form 30 (conefield_bounds_form (-89)) X (-89) 89 i))"
 
 definition "approx_conefield_bounds (DX::(R3 \<times> (R3 \<Rightarrow>\<^sub>L R3)) set) l u =
   do {
     let DX = (cast_eucl1 ` DX::3 eucl1 set);
     DXo \<leftarrow> aform.vec1rep DX;
     DX \<leftarrow> (case DXo of None \<Rightarrow> do {
         let _ = aform.print_msg (''# approx_conefield_bounds failed DXo...'');
         SUCCEED
       }
     | Some DX \<Rightarrow> RETURN DX);
     let _ = aform.trace_set (''# approx_conefield_bounds DX: '') (Some DX);
     approx_form_spec (conefield_bounds_form l u) (list_of_eucl ` DX)
   }"
 
 lemma [autoref_rules]:
   includes autoref_syntax
   shows "(conefield_bounds_form, conefield_bounds_form) \<in> Id \<rightarrow> Id \<rightarrow> Id "
   by auto
 
 lemma [autoref_rules_raw]:
   "DIM_precond TYPE((real, 3) vec \<times> ((real, 3) vec, 3) vec) 12"
   "DIM_precond TYPE(R3) 3"
   "DIM_precond TYPE((real, 3) vec) 3"
   by auto
 
 schematic_goal approx_conefield_bounds_impl:
   includes autoref_syntax
   fixes optns::"real aform numeric_options"
   assumes [autoref_rules]: "(DXi, DX) \<in> aform.appr1_rel"
   assumes [autoref_rules]: "(li, l) \<in> Id"
   assumes [autoref_rules]: "(ui, u) \<in> Id"
   notes [autoref_rules] =
       aform.print_msg_impl[where optns = optns]
       aform.ivl_rep_of_set_autoref[where optns = optns]
       aform.transfer_operations(12)[where optns = optns]
       aform.approx_euclarithform[where optns=optns]
       aform.trace_set_impl[of optns]
   shows "(nres_of ?r, approx_conefield_bounds $ DX $ l $ u) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding approx_conefield_bounds_def
   including art
   by autoref_monadic
 concrete_definition approx_conefield_bounds_impl for optns li ui DXi uses
   approx_conefield_bounds_impl
 lemmas [autoref_rules] = approx_conefield_bounds_impl.refine
 
 context includes autoref_syntax begin
 lemma [autoref_rules]:
   "(real_of_ereal, real_of_ereal) \<in> ereal_rel \<rightarrow> rnv_rel"
   "(\<infinity>, \<infinity>) \<in> ereal_rel"
   by auto
 end
 
 lemma interpret_form_true_form[simp]: "interpret_form true_form \<equiv> \<lambda>_. True"
   by (force simp: true_form_def intro!: eq_reflection)
 
 lemma interpret_form_conefield_bounds_form_list:
   "interpret_form (conefield_bounds_form L U)
     [x, y, z, ux, vx, wx,
               uy, vy, wy,
               uz, vz, wz]
    \<longleftrightarrow>
     (0 < ux \<and> -90 < L \<and> L \<le> U \<and> U < 90 \<and> uz = 0 \<and>
     uy \<le> tan (rad_of U) * ux \<and>
     tan (rad_of L) * ux  \<le> uy)"
   if "U \<in> float" "L \<in> float" "e \<in> float" "em \<in> float"
   using that
   by (auto simp: conefield_bounds_form_def L2_set_def)
 
 lemma list_of_eucl_eucl1_3:
   includes vec_syntax
   shows "(list_of_eucl (vec1_of_flow1 (xDX::(real^3) \<times> ((real^3)\<Rightarrow>\<^sub>L(real^3))))) =
   (let
     (x, DX) = xDX;
     DXu = DX (eucl_of_list [1, 0, 0]);
     DXv = DX (eucl_of_list [0, 1, 0]);
     DXw = DX (eucl_of_list [0, 0, 1])
   in [x $ 0, x $ 1, x $ 2, vec_nth DXu 0, vec_nth DXv 0, vec_nth DXw 0,
                            vec_nth DXu 1, vec_nth DXv 1, vec_nth DXw 1,
                            vec_nth DXu 2, vec_nth DXv 2, vec_nth DXw 2])"
   apply (auto simp: matrix_inner_Basis_list Let_def vec1_of_flow1_def
       concat_map_map_index less_Suc_eq_0_disj
       list_of_eucl_matrix eval_nat_numeral aform.inner_Basis_eq_vec_nth
       intro!: nth_equalityI
       split: prod.splits)
   by (auto simp: matrix_def axis_eq_eucl_of_list eucl_of_list_012)
 
 lemma interpret_form_conefield_bounds_form:
   "interpret_form (conefield_bounds_form L U)
     (list_of_eucl (vec1_of_flow1 (xDX::(real^3) \<times> ((real^3)\<Rightarrow>\<^sub>L(real^3)))))
    =
   (let
     DX = snd xDX;
     DXu = DX (eucl_of_list [1, 0, 0]);
     DXv = DX (eucl_of_list [0, 1, 0]);
     uz = vec_nth DXu 2;
     uy = vec_nth DXu 1;
     ux = vec_nth DXu 0;
     vy = vec_nth DXv 1;
     vx = vec_nth DXv 0
   in
     ux > 0 \<and> -90 < L \<and> L \<le> U \<and> U < 90 \<and> uz = 0 \<and>
     (uy / ux) \<in> {tan (rad_of L) .. tan (rad_of U)}
   )"
   if "L \<in> float" "U \<in> float"
   using that
   unfolding list_of_eucl_eucl1_3 Let_def
   by (auto  split: prod.splits simp: interpret_form_conefield_bounds_form_list divide_simps)
 
 lemma approx_conefield_bounds_cast:
   "approx_conefield_bounds DX L U \<le> SPEC (\<lambda>b. b \<longrightarrow>
     (\<forall>(x, dx) \<in> cast_eucl1 ` DX::3 eucl1 set.
       let
         u' = dx (eucl_of_list [1, 0, 0])
       in
         vec_nth u' 1 / vec_nth u' 0 \<in> {tan (rad_of L) .. tan (rad_of U)}
         \<and> vec_nth u' 2 = 0 \<and> vec_nth u' 0 > 0 \<and> -90 < L \<and> L \<le> U \<and> U < 90)
   )"
   if "L \<in> float" "U \<in> float"
   unfolding approx_conefield_bounds_def
   apply refine_vcg
    apply (auto simp: env_len_def )
   subgoal for a b c
     apply (drule bspec, assumption)
     unfolding interpret_form_conefield_bounds_form[OF that]
     by (auto simp: Let_def divide_simps)
   done
 
 
 lemma approx_conefield_bounds[le, refine_vcg]:
   "approx_conefield_bounds DX l u \<le> SPEC (\<lambda>b. b \<longrightarrow>
     (\<forall>(x, dx) \<in> DX::R3 c1_info set.
       let
         (u'1, u'2, u'3) = dx ((1, 0, 0))
       in u'2 / u'1 \<in> {tan (rad_of l) .. tan (rad_of u)} \<and> u'3 = 0 \<and> u'1 > 0 \<and> -90 < l \<and> l \<le> u \<and> u < 90)
   )"
   if "l \<in> float" "u \<in> float"
   apply (rule approx_conefield_bounds_cast[le, OF that])
   apply (auto dest!: bspec simp: Let_def split: prod.splits)
   by (auto simp: cast_eucl1_def cast_def)
 
 schematic_goal MU\<^sub>e: "-E2 / E1 = interpret_floatarith ?fas []"
   by (reify_floatariths)
 concrete_definition MU\<^sub>e uses MU\<^sub>e
 schematic_goal NU\<^sub>e: "-E3 / E1 = interpret_floatarith ?fas []"
   by (reify_floatariths)
 concrete_definition NU\<^sub>e uses NU\<^sub>e
 
 definition "approx_ivls p fas xs = do {
   let xs = ivls_of_aforms p xs;
   res \<leftarrow> those (map (\<lambda>f. approx p f xs) fas);
-  Some (map (real_of_float o fst) res, map (real_of_float o snd) res)
+  Some (map (real_of_float o lower) res, map (real_of_float o upper) res)
 }"
 definition
   "deform p t exit XDX = (case XDX of (lu, (X, DX)) \<Rightarrow>
     let
       d = ldec 0.1;
       d = if exit then (1 - real_of_float (lb_sqrt 30 (1 - 2 * float_of (d)))) else d;
       sd = real_of_float ((float_of (d*d)));
       C0Deform = aforms_of_ivls [-sd,-sd,-sd] [sd, sd, sd];
       result = msum_aforms' X C0Deform
     in (lu,
       case DX of None \<Rightarrow> (result, None)
       | Some DX \<Rightarrow> let
         C1_norm = 2 * d;
         C1_norm = if exit then real_divr 30 C1_norm (1 - C1_norm) else C1_norm;
         l = -C1_norm;
         u = C1_norm;
         D_M = aforms_of_ivls [1 + l,0,0, 0,1 + l,0, 0,0,1 + l] [1 + u,0,0, 0,1 + u,0, 0,0,1 + u];
         (ri, ru) = the (approx_ivls p
           (mmult_fa 3 3 3 (map Var [0..<9]) (map Var [9..<18])) (D_M @ DX));
         Dresult = aforms_of_ivls ri ru;
         resultDresult = product_aforms result Dresult
       in (take 3 resultDresult, Some (drop 3 resultDresult))))"
 
 definition "ivls_of_aforms' p r = (map (Inf_aform' p) r, map (Sup_aform' p) r)"
 
 definition "compute_half_exit p t XDX = (case XDX of ((l, u::ereal), (X, DX)) \<Rightarrow>
    let
     \<comment> \<open>ASSERTING that \<open>Y\<close> straddles zero\<close>
     (x0, y0, _) = case map (Inf_aform' p) X of [x,y,z] \<Rightarrow> (x, y, z);
     (x1, y1, _) = case map (Sup_aform' p) X of [x,y,z] \<Rightarrow> (x, y, z);
     splitting = x0 = 0 \<or> x1 = 0;
     sign_x = if (x0 + x1) / 2 > 0 then 1 else -1;
     mag_x = max (abs x0) (abs x1);
     sign_x\<^sub>e = N\<^sub>r sign_x;
     exit_rad\<^sub>e = N\<^sub>r (ldec 0.1);
     X\<^sub>e = Var (0);
     Y\<^sub>e = Var (1);
     Z\<^sub>e = Var (2);
     max_x_over_r\<^sub>e = N\<^sub>r mag_x / exit_rad\<^sub>e;
     abs_x_over_r\<^sub>e = (Abs X\<^sub>e) / exit_rad\<^sub>e;
     result = (if splitting
       then let result = (the (approx_floatariths p [sign_x\<^sub>e * exit_rad\<^sub>e,
           Y\<^sub>e * Powr (max_x_over_r\<^sub>e) MU\<^sub>e,
           Z\<^sub>e * Powr (max_x_over_r\<^sub>e) NU\<^sub>e] X));
       (ir, sr) = ivls_of_aforms' p result
       in aforms_of_ivls (ir[1:=min 0 (ir!1), 2:=min 0 (ir!2)])
                               (sr[1:=max 0 (sr!1), 2:=max 0 (sr!2)])
       else the (approx_floatariths p [sign_x\<^sub>e * exit_rad\<^sub>e,
           Y\<^sub>e * Powr (abs_x_over_r\<^sub>e) MU\<^sub>e,
           Z\<^sub>e * Powr (abs_x_over_r\<^sub>e) NU\<^sub>e] X));
     _ = ()
     in ((l::ereal, \<infinity>::ereal), (case DX of None \<Rightarrow> (result, None)
     | Some DX \<Rightarrow>
       let
         ux\<^sub>e = Var (3);
         uy\<^sub>e = Var (6);
         P21\<^sub>e = if splitting
           then (MU\<^sub>e / exit_rad\<^sub>e) * Y\<^sub>e * sign_x\<^sub>e * Powr (max_x_over_r\<^sub>e) (MU\<^sub>e - 1) \<comment> \<open>No need for \<open>Hull(0)\<close> because \<open>y\<close> straddles zero\<close>
           else (MU\<^sub>e / exit_rad\<^sub>e) * Y\<^sub>e * sign_x\<^sub>e * Powr (abs_x_over_r\<^sub>e) (MU\<^sub>e - 1);
         P22\<^sub>e = if splitting
           then Powr (max_x_over_r\<^sub>e) MU\<^sub>e
           else Powr (abs_x_over_r\<^sub>e) MU\<^sub>e;
         P31\<^sub>e = if splitting
           then sign_x\<^sub>e * (NU\<^sub>e / exit_rad\<^sub>e) * Z\<^sub>e * Powr (max_x_over_r\<^sub>e) (NU\<^sub>e - 1) \<comment> \<open>No need for \<open>Hull(\<infinity>)\<close> because scaling afterwards\<close>
           else sign_x\<^sub>e * (NU\<^sub>e / exit_rad\<^sub>e) * Z\<^sub>e * Powr (abs_x_over_r\<^sub>e) (NU\<^sub>e - 1);
         ry = (P21\<^sub>e * ux\<^sub>e) + (P22\<^sub>e * uy\<^sub>e);
         rz = P31\<^sub>e * ux\<^sub>e;
         (iDr, sDr) = the (approx_ivls p ([0, 0, 0,
              ry,   0, 0,
              rz,   0, 0]) (X @ DX));
         Dresult = aforms_of_ivls (iDr[3:=min 0 (iDr!3)])
                               (sDr[3:=max 0 (sDr!3)]);
         resultDresult = product_aforms result Dresult
       in (take 3 resultDresult, Some (drop 3 resultDresult))
     )))"
 
 fun list3 where "list3 [a,b,c] = (a, b, c)"
 
 definition
   "split_x n x0 y0 z0 x1 y1 z1 =
     (let
       elem = (\<lambda>(x0, x1). aforms_of_ivls [x0, y0, z0] [x1, y1, z1]);
       coord = (\<lambda>x0 n i. i * x0 * FloatR 1 (-int n));
       us = map (coord x0 n) (rev [0..<(2^n)]) @ map (coord x1 n) [Suc 0..<Suc (2^n)];
       ls = map (coord x0 n) (rev [Suc 0..<Suc (2^n)]) @ map (coord x1 n) [0..<(2^n)]
     in map elem (zip ls us))"
 
 definition "compute_cube_exit p t XDX =
   (let
     ((l, u), (X', DX')) = deform p t False XDX;
     ((x0, y0, z0), (x1, y1, z1)) = pairself list3 (ivls_of_aforms' p X');
     X's = [aforms_of_ivls [x0, y0, z0] [0, y1, z1], aforms_of_ivls [0, y0, z0] [x1, y1, z1]];
     XDX's = map (\<lambda>X'. ((l, u), (X', DX'))) X's;
     Xes = map (compute_half_exit p t) XDX's;
     Xlumpies = map (deform p t True) Xes
   in
     Xlumpies)"
 
 
 definition "cube_enteri = (map ldec [-0.1, -0.00015, 0.1,   0.8,0,0,       0.0005,0,0,   0,0,0],
                              map udec [ 0.1,  0.00015,   0.1,   1.7,0,0,      0.002,0,0,   0,0,0])"
 definition "cube_enter = set_of_ivl (pairself eucl_of_list cube_enteri)"
 
 value [code] "println ((show) (map (ivls_of_aforms' 100 o list_of_appr1e_aform)
   (compute_cube_exit 30 (FloatR 1 (-10)) ((ereal 1, ereal 1),
     (aforms_of_ivls (take 3 (fst cube_enteri))
                     (take 3 (snd cube_enteri)),
       Some (aforms_of_ivls (drop 3 (fst cube_enteri))
                        (drop 3 (snd cube_enteri))))))))"
 
 definition "cube_exiti =
   [(aforms_of_ivls (map ldec [-0.12,  -0.024, -0.012])
                    (map udec [-0.088,  0.024,  0.13]),
      Some (aforms_of_ivls (map ldec [0,0,0,  -0.56,0,0,  -0.6,0,0])
                           (map udec [0,0,0,   0.56,0,0,  -0.08,0,0]))),
   (aforms_of_ivls (map ldec [ 0.088,  -0.024, -0.012])
                   (map udec [ 0.12,   0.024,  0.13]),
      Some (aforms_of_ivls (map ldec [0,0,0,  -0.53,0,0,   0.08,0,0])
                           (map udec [0,0,0,   0.56,0,0,   0.6,0,0])))]"
 definition "cube_exitv = aform.c1_info_of_apprs cube_exiti"
 
 lemma cube_enteri[autoref_rules]: "(cube_enteri, cube_enter::'a set) \<in> lvivl_rel"
   if "DIM_precond TYPE('a::executable_euclidean_space) 12"
   using that
   by (auto simp: cube_enteri_def cube_enter_def set_of_ivl_def
       intro!: brI lv_relivl_relI)
 
 lemma cube_exiti[autoref_rules]: "(cube_exiti, cube_exitv::'n eucl1 set) \<in> clw_rel aform.appr1_rel"
   if "DIM_precond TYPE('n::enum rvec) 3"
   unfolding cube_exitv_def cube_exiti_def
   apply (rule aform.clw_rel_appr1_relI)
   using that
   by (auto simp: aform.c1_info_invar_def power2_eq_square)
 
 definition "lorenz_interrupt (optns::real aform numeric_options) b (eX::3 eucl1 set) =
   do {
     ((el, eu), X) \<leftarrow> scaleR2_rep eX;
     let fX = fst ` X;
     fentry \<leftarrow> op_image_fst_ivl (cube_enter::3 vec1 set);
     interrupt \<leftarrow> aform.op_subset (fX:::aform.appr_rel) fentry;
     (ol, ou) \<leftarrow> ivl_rep fentry;
     aform.CHECKs (ST ''asdf'') (0 < el \<and> ol \<le> ou);
     let _ = (if b then aform.trace_set (ST ''Potential Interrupt: '') (Some fX) else ());
     let _ = (if b then aform.trace_set (ST ''With: '') (Some ({ol .. ou::3 rvec}:::aform.appr_rel)) else ());
     if \<not>b \<or> \<not>interrupt then RETURN (op_empty_coll, mk_coll eX)
     else do {
       vX \<leftarrow> aform.vec1rep X;
       let _ = (if b then aform.trace_set1e (ST ''Actual Interrupt: '') (Some eX) else ());
       let l = (eucl_of_list [-1/2/2,-1/2/2,-1/2/2]::3 rvec);
       let u = eucl_of_list [1/2/2, 1/2/2, 1/2/2];
       ASSERT (l \<le> u);
       let CX = mk_coll ({l .. u}:::aform.appr_rel);
       (C0::3 eucl1 set) \<leftarrow> scaleRe_ivl_coll_spec el eu (fst ` cube_exitv \<times> UNIV);
       (C1::3 eucl1 set) \<leftarrow> scaleRe_ivl_coll_spec el eu (cube_exitv);
       case vX of None \<Rightarrow> RETURN (CX, C0)
       | Some vX \<Rightarrow> do {
         b \<leftarrow> aform.op_subset vX cube_enter;
         aform.CHECKs (ST ''FAILED: TANGENT VECTORs are not contained'') b;
         RETURN (CX, C1)
       }
     }
   }"
 lemma [autoref_rules]:
   includes autoref_syntax
   shows
     "(real_of_int, real_of_int) \<in> int_rel \<rightarrow> rnv_rel"
     "(ldec, ldec) \<in> Id \<rightarrow> rnv_rel"
     "(udec, udec) \<in> Id \<rightarrow> rnv_rel"
   by auto
 
 schematic_goal lorenz_interrupti:
   includes autoref_syntax
   assumes[autoref_rules]: "(bi, b) \<in> bool_rel" "(Xi, X::3 eucl1 set) \<in> aform.appr1e_rel"
     "(optnsi, optns) \<in> Id"
   shows
     "(nres_of ?r, lorenz_interrupt optns b X) \<in> \<langle>clw_rel aform.appr_rel \<times>\<^sub>r clw_rel aform.appr1e_rel\<rangle>nres_rel"
   unfolding lorenz_interrupt_def
   including art
   by autoref_monadic
 concrete_definition lorenz_interrupti for optnsi1 bi Xi uses
   lorenz_interrupti[where optnsi = "optnsi"
        and optnsa = "\<lambda>_ _ _ _ _ _ _ _. optnsi"
          and optnsb = "\<lambda>_ _ _ _ _ _ _ _ _. optnsi"
        and optnsc = "\<lambda>_ _ _ _ _ _ _ _ _ _ _. optnsi"
        and optnsd = "\<lambda>_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _. optnsi"
        and optnse = "\<lambda>_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _. optnsi"
        and optnsf = "\<lambda>_ _ _ _ _ _ _ _ _. optnsi"
          and optns = "\<lambda>_ _ _ _ _. optnsi"
        for optnsi]
 lemma lorenz_interrupti_refine[autoref_rules]:
   includes autoref_syntax
   shows
   "(\<lambda>optnsi bi Xi. (lorenz_interrupti optnsi bi Xi),
     lorenz_interrupt)
     \<in> num_optns_rel \<rightarrow> bool_rel \<rightarrow> aform.appr1e_rel \<rightarrow> \<langle>clw_rel aform.appr_rel \<times>\<^sub>r clw_rel aform.appr1e_rel\<rangle>dres_nres_rel"
   using lorenz_interrupti.refine
   by (auto simp: nres_rel_def dres_nres_rel_def)
 
 definition "(large_cube::R3 set) = {-1/4 .. 1/4} \<times> {-1/4 .. 1/4} \<times> {-1/4 .. 1/4}"
 
 definition "cube_entry = (cast_eucl1 ` (flow1_of_vec1 ` cube_enter::3 eucl1 set)::R3 c1_info set)"
 definition "cube_exit = (cast_eucl1 ` (cube_exitv::3 eucl1 set)::R3 c1_info set)"
 
 text \<open>protect locale parameters\<close>
 lemma flow0_cong[cong]: "auto_ll_on_open.flow0 ode X = auto_ll_on_open.flow0 ode X"
   by (auto simp:)
 lemma existence_ivl0_cong[cong]:
   "auto_ll_on_open.existence_ivl0 ode X = auto_ll_on_open.existence_ivl0 ode X"
   by (auto simp:)
 lemma Dflow_cong[cong]: "c1_on_open_euclidean.Dflow ode ode_d X = c1_on_open_euclidean.Dflow ode ode_d X"
   by (auto simp:)
 lemma flowsto_cong[cong]:
   "c1_on_open_euclidean.flowsto ode ode_d D = c1_on_open_euclidean.flowsto ode ode_d D"
   by (auto simp:)
 lemma poincare_mapsto_cong[cong]:
   "c1_on_open_euclidean.poincare_mapsto ode X = c1_on_open_euclidean.poincare_mapsto ode X"
   by (auto simp:)
 lemma returns_to_cong[cong]:
   "auto_ll_on_open.returns_to ode X = auto_ll_on_open.returns_to ode X"
   by (auto simp:)
 lemma return_time_cong[cong]:
   "auto_ll_on_open.return_time ode X = auto_ll_on_open.return_time ode X"
   by (auto simp: )
 lemma poincare_map_cong[cong]:
   "auto_ll_on_open.poincare_map ode X = auto_ll_on_open.poincare_map ode X"
   by (auto simp: )
 
 lemma eq_nth_iff_index:
   "distinct xs \<Longrightarrow> n < length xs \<Longrightarrow> i = xs ! n  \<longleftrightarrow> index xs i = n"
   using index_nth_id by fastforce
 
 lemma cast_in_BasisI: "(cast i::'a) \<in> Basis"
   if "(i::'c) \<in> Basis""DIM('c::executable_euclidean_space) = DIM('a::executable_euclidean_space)"
   using that
   by (auto simp: cast_def eucl_of_list_nth inner_Basis if_distrib if_distribR
       eq_nth_iff_index
       cong: if_cong)
 
 lemma cast_le_iff: "(cast (x::'a)::'c) \<le> y \<longleftrightarrow> x \<le> cast y"
   if "DIM('c::executable_euclidean_space) = DIM('a::executable_euclidean_space)"
   apply (auto simp: eucl_le[where 'a='a] eucl_le[where 'a='c]
       dest!: bspec intro!: )
      apply (rule cast_in_BasisI, assumption)
      apply (auto simp: that)
     apply (metis cast_eqI2 cast_inner that)
      apply (rule cast_in_BasisI, assumption)
      apply (auto simp: that)
   apply (metis cast_eqI2 cast_inner that)
   done
 
 lemma cast_le_cast_iff: "(cast (x::'a)::'c) \<le> cast y \<longleftrightarrow> x \<le> y"
   if "DIM('c::executable_euclidean_space) = DIM('a::executable_euclidean_space)"
   apply (auto simp: eucl_le[where 'a='a] eucl_le[where 'a='c]
       dest!: bspec intro!: )
      apply (rule cast_in_BasisI, assumption)
      apply (auto simp: that)
      apply (rule cast_in_BasisI, assumption)
      apply (auto simp: that)
   by (metis cast_eqI2 cast_inner that)
 
 lemma cast_image_Icc[simp]: "cast ` {a .. b::'c} = {cast a .. cast b::'a}"
   if "DIM('c::executable_euclidean_space) = DIM('a::executable_euclidean_space)"
   using that
   apply (auto simp:  cast_le_iff dest!:)
   subgoal for x
     apply (rule image_eqI[where x="cast x"])
     by (auto simp: cast_le_iff)
   done
 
 lemma cast_eucl1_image_scaleR2:
   "cast_eucl1 ` scaleR2 l u X = scaleR2 l u (cast_eucl1 ` (X::'b c1_info set)::'a c1_info set)"
   if "DIM('a::executable_euclidean_space) = DIM('b::executable_euclidean_space)"
   using that
   apply (auto simp: scaleR2_def image_def vimage_def cast_eucl1_def
       linear.scaleR linear_cast_bl)
    apply force+
   apply (rule exI conjI)+
     apply assumption
   apply (rule exI conjI)+
     apply assumption
    apply (rule bexI) prefer 2 apply assumption
    apply force
   by (auto simp: linear.scaleR linear_cast_bl)
 
 lemma scaleR2_diff_prod2: "scaleR2 d e (X) - Y \<times> UNIV = scaleR2 d e (X - Y \<times> UNIV)"
   by (force simp: scaleR2_def vimage_def image_def)
 
 end
 
 lemma (in c1_on_open_euclidean) flowsto_scaleR2I:
   "flowsto (scaleR2 d e X0) T (CX \<times> UNIV) (scaleR2 d e Y)"
   if "flowsto (X0) T (CX \<times> UNIV) (Y)"
   using that
   apply (auto simp: flowsto_def scaleR2_def)
   apply (drule bspec, assumption)
   apply auto
   apply (rule bexI) prefer 2 apply assumption
   apply auto
   subgoal for x a b h
     by (auto intro!: image_eqI[where x="(x, (flow0 a h, Dflow a h o\<^sub>L b))"] blinfun_eqI
         simp: blinfun.bilinear_simps)
   done
 
 definition "aforms_of_resultrect x0 x1 y0 y1 = aforms_of_ivl (ivl_of_resultrect x0 x1 y0 y1)"
 
 definition "flatten_varveq x = fst x @ the_default [] (snd x)"
 
 (*
 LessEqual (N\<^sub>r e) (N\<^sub>r em *\<^sub>e floatarith.Min (norm\<^sub>e [(3)\<^sub>e, (6)\<^sub>e, (9)\<^sub>e])
   (norm\<^sub>e [(4)\<^sub>e, (7)\<^sub>e, (10)\<^sub>e]))
 *)
 
 derive "show" ereal
 
 definition \<Sigma>::"(real*real*real) set" where
   "\<Sigma> = {(-6, -6, 27) .. (6, 6, 27)}"
 definition \<Sigma>\<^sub>l\<^sub>e::"(real*real*real) set" where
   "\<Sigma>\<^sub>l\<^sub>e = {(x, y, z). z \<le> 27}"
 
 definition "results = symmetrize coarse_results"
 definition "results_at x = {res \<in> set results.  x \<in> source_of_res res}"
 
 text \<open>a part of the stable manifold (up to the (backward) first intersection with \<open>\<Sigma>\<close>)\<close>
 definition \<Gamma>::"(real*real*real) set" where
   "\<Gamma> = {x.
     {0..} \<subseteq> lorenz.existence_ivl0 x \<and>
     (\<forall>t>0. lorenz.flow0 x t \<notin> \<Sigma>) \<and>
     (lorenz.flow0 x \<longlongrightarrow> 0) at_top}"
 
 definition "\<Gamma>\<^sub>i intr = (if intr then \<Gamma> else {})"
 definition "\<Gamma>\<^sub>i\<^sub>v intr = cast ` (\<Gamma>\<^sub>i intr)"
 
 definition "sourcei_of_res res = source_of_res res - (\<Gamma>\<^sub>i (invoke_nf res))"
 definition "resultsi_at x = {res \<in> set results.  x \<in> sourcei_of_res res}"
 
 definition "N = \<Union>(source_of_res ` (set results))"
 definition "\<CC> x = \<Union>(conefield_of_res ` (results_at x))"
 definition "R = lorenz.poincare_map \<Sigma>"
 definition "DR x = frechet_derivative (lorenz.poincare_map \<Sigma>) (at x within \<Sigma>\<^sub>l\<^sub>e)"
 definition "\<E> x = Min (expansion ` results_at x)"
 definition "\<E>\<^sub>p x = Min (preexpansion ` results_at x)"
 
 abbreviation returns_to (infixl "returns'_to" 50) where
   "(x returns_to P) \<equiv> lorenz.returns_to P x"
 
 lemma closed_\<Sigma>[intro, simp]: "closed \<Sigma>"
   by (auto simp: \<Sigma>_def)
 
 lemma \<Gamma>_stable: "lorenz.stable_on (- \<Sigma>) \<Gamma>"
   unfolding lorenz.stable_on_def
 proof (intro allI impI)
   fix t x0
   assume outside: "\<forall>s\<in>{0<..t}. lorenz.flow0 x0 s \<in> - \<Sigma>"
   assume assms: "lorenz.flow0 x0 t \<in> \<Gamma>" "t \<in> lorenz.existence_ivl0 x0" "0 < t"
   from assms have *: "{0..} \<subseteq> lorenz.existence_ivl0 (lorenz.flow0 x0 t)"
     "(lorenz.flow0 (lorenz.flow0 x0 t) \<longlongrightarrow> 0) at_top"
     by (auto simp: \<Gamma>_def)
   have nonneg_exivl: "s \<in> lorenz.existence_ivl0 x0" if "s \<ge> 0" for s
   proof (cases "s \<le> t")
     case True
     then show ?thesis
       using \<open>0 \<le> s\<close> assms(2) lorenz.ivl_subset_existence_ivl[of t x0] by auto
   next
     case False
     define u where "u = s - t"
     with False have "u > 0" "s = t + u" by auto
     note this(2)
     also have "t + u \<in> lorenz.existence_ivl0 x0"
       apply (rule lorenz.existence_ivl_trans)
        apply fact
       using * \<open>u > 0\<close> by auto
     finally show ?thesis .
   qed
   show "x0 \<in> \<Gamma>"
     unfolding \<Gamma>_def
   proof (safe intro!: nonneg_exivl)
     have "\<forall>\<^sub>F s in at_top. (s::real) \<ge> 0"
       using eventually_ge_at_top by blast
     then have "\<forall>\<^sub>F s in at_top. lorenz.flow0 (lorenz.flow0 x0 t) s = lorenz.flow0 x0 (s + t)"
     proof eventually_elim
       case (elim s)
       then have "s \<in> lorenz.existence_ivl0 x0"
         using nonneg_exivl[OF \<open>0 \<le> s\<close>] by simp
       then have "lorenz.flow0 (lorenz.flow0 x0 t) s = lorenz.flow0 x0 (t + s)"
         apply (subst lorenz.flow_trans)
         using assms * elim by auto
       then show ?case by (simp add: ac_simps)
     qed
     then have "((\<lambda>s. (lorenz.flow0 x0 (s + t))) \<longlongrightarrow> 0) at_top"
       by (blast intro: * Lim_transform_eventually)
     then show "(lorenz.flow0 x0 \<longlongrightarrow> 0) at_top"
       unfolding aform.tendsto_at_top_translate_iff .
   next
     fix s::real assume s: "0 < s" "lorenz.flow0 x0 s \<in> \<Sigma>"
     show False
     proof (cases "s \<le> t")
       case True
       then show ?thesis
         using outside s
         by (auto simp: \<Gamma>_def)
     next
       case False
       then obtain u where u: "u = s - t" "u > 0"
         by auto
       then have "lorenz.flow0 x0 (s) = lorenz.flow0 x0 (t + u)" by (simp add: algebra_simps)
       also have "\<dots> = lorenz.flow0 (lorenz.flow0 x0 t) u"
         apply (subst lorenz.flow_trans)
         subgoal by fact
         subgoal unfolding u
           apply (rule lorenz.diff_existence_ivl_trans) apply fact+
           apply (rule nonneg_exivl) using \<open>0 < s\<close> by simp
         subgoal by simp
         done
       also from assms(1) \<open>u > 0\<close> have "\<dots> \<notin> \<Sigma>"
         by (auto simp: \<Gamma>_def)
       finally show ?thesis using s
         by auto
     qed
   qed
 qed
 
 lemma (in auto_ll_on_open) stable_on_empty[intro, simp]: "stable_on asdf {}"
   by (auto simp: stable_on_def)
 
 lemma \<Gamma>\<^sub>i_stable: "lorenz.stable_on (- \<Sigma>) (\<Gamma>\<^sub>i b)"
   using \<Gamma>_stable
   unfolding \<Gamma>\<^sub>i_def
   apply (cases b)
   subgoal by auto
   subgoal using lorenz.stable_on_empty
     by (auto simp: \<Gamma>\<^sub>i_def)
   done
 
 definition "\<Gamma>\<^sub>v = (cast ` \<Gamma>)"
 
 definition "NF = lorenz.flowsto (cube_entry - \<Gamma> \<times> UNIV) {0..} (large_cube \<times> UNIV) cube_exit"
 
 lemma NF0: "lorenz.flowsto ((fst ` cube_entry - \<Gamma>) \<times> UNIV) {0..} (large_cube \<times> UNIV)
   (fst ` cube_exit \<times> UNIV)"
   if NF
   using that
   unfolding NF_def lorenz.flowsto_def
   apply (auto simp: NF_def)
   apply (drule bspec, force)
   by auto
 
 lemma [autoref_rules]: includes autoref_syntax shows "(\<lambda>_. (), \<Gamma>\<^sub>i\<^sub>v) \<in> bool_rel \<rightarrow> ghost_rel"
   by (auto simp: ghost_rel_def)
 
 lemma lorenz_interrupt[le, refine_vcg]:
   "lorenz_interrupt optns b X \<le> SPEC (\<lambda>(CX, R).
     lorenz.flowsto ((cast_eucl1 ` X::R3 c1_info set) - (\<Gamma>\<^sub>i b \<times> UNIV)) {0..} (cast ` CX \<times> UNIV) (cast_eucl1 ` R))"
   if NF
   unfolding lorenz_interrupt_def
   apply refine_vcg
   subgoal
     by (rule lorenz.flowsto_self) auto
   subgoal
     by (auto simp: eucl_le[where 'a="3 rvec"] eucl_of_list_inner Basis_list_vec_def Basis_list_real_def)
   subgoal for a b c d e f g h i j k l m n p
     apply (auto)
     apply (simp add: cast_eucl1_image_scaleR2 scaleR2_diff_prod2)
     apply (erule make_neg_goal)
     apply (rule lorenz.flowsto_scaleR2I)
     using NF0[OF that]
     apply (rule lorenz.flowsto_subset)
     subgoal for q
       apply (auto simp: scaleR2_def cast_eucl1_def)
       apply (auto simp: linear_cast_bl linear.scaleR cube_entry_def cast_eucl1_def image_image)
       subgoal premises prems for r s t u v
       proof -
         from prems have "fst ` c \<subseteq> fst ` (cube_enter::3 vec1 set)"
           by auto
         with \<open>(u, v) \<in> c\<close> obtain w where "((u, w)::3 vec1) \<in> cube_enter"
           by auto
         from _ this have "cast u \<in> (\<lambda>x. cast (fst (x::3 vec1))) ` cube_enter"
           by (rule image_eqI)  auto
         then show ?thesis using prems
           by blast
       qed
       subgoal by (auto simp: \<Gamma>\<^sub>i_def)
       done
     subgoal by simp
     subgoal premises _
       by (auto simp: eucl_le[where 'a="3 rvec"] eucl_of_list_inner Basis_list_vec_def Basis_list_real_def
           eucl_of_list_def
           large_cube_def)
     subgoal premises prems for x
       apply (auto simp:)
       subgoal for A B C D E
         apply (rule image_eqI[where x="cast_eucl1 (((B, C, D), A))"])
          apply (auto simp: cast_eucl1_def)
         subgoal premises prems
           using prems(1)
           apply (auto simp: cube_exit_def aform.c1_info_of_apprs_def cube_exiti_def
               cast_eucl1_def aform.c1_info_of_appr_def)
           done
         done
       done
     done
   subgoal for a b c d e f g h i j k l m n p
     apply (auto)
     apply (erule make_neg_goal, thin_tac "\<not> _")
     apply (simp add: cast_eucl1_image_scaleR2 scaleR2_diff_prod2)
     apply (rule lorenz.flowsto_scaleR2I)
     using that[unfolded NF_def]
     apply (rule lorenz.flowsto_subset)
     subgoal for q
       apply (auto simp: scaleR2_def cast_eucl1_def )
       apply (auto simp: linear_cast_bl linear.scaleR cube_entry_def cast_eucl1_def image_image)
       subgoal premises prems for r s t u v
       proof -
         from prems have \<open>vec1_of_flow1 (u, v) \<in> cube_enter\<close>
           by auto
         from _ this have "(cast u, cast_bl v) \<in> (\<lambda>x. (cast (fst (x::3 vec1)), cast_bl (snd (flow1_of_vec1 x)))) ` cube_enter"
           by (rule image_eqI) (auto simp: )
         then show ?thesis
           using prems by blast
       qed
       subgoal by (auto simp: \<Gamma>\<^sub>i_def)
       done
     subgoal by simp
     subgoal premises _
       by (auto simp: eucl_le[where 'a="3 rvec"] eucl_of_list_inner Basis_list_vec_def Basis_list_real_def
           eucl_of_list_def
           large_cube_def)
     subgoal by (simp add: cube_exit_def)
     done
   done
 
 
 definition "lorenz_S X = (case X of (x, y, z) \<Rightarrow> (-x, -y, z))"
 
 lemma lorenz_symI: "((\<lambda>t. lorenz_S (f t)) has_vderiv_on lf') T"
   if "(f has_vderiv_on f') T" "\<And>t. t \<in> T \<Longrightarrow> lf' t = lorenz_S (f' t)"
   using that
   by (auto simp: has_vderiv_on_def lorenz_S_def  split_beta' has_vector_derivative_def
       intro!: derivative_eq_intros)
 
 lemma lorenz_S:
   "t \<in> lorenz.existence_ivl0 (lorenz_S X)" (is ?th1)
   "lorenz.flow0 (lorenz_S X) t = lorenz_S (lorenz.flow0 X t)" (is ?th2)
   if "t \<in> lorenz.existence_ivl0 X"
 proof -
   have 1: "((\<lambda>t. lorenz_S (lorenz.flow0 X t)) solves_ode
      (\<lambda>_ (X0, X1, X2).
          (E1 * X0 - K1 * (X0 + X1) * X2,
           E2 * X1 + K1 * (X0 + X1) * X2,
           E3 * X2 + (X0 + X1) * (K2 * X0 + K3 * X1))))
      {0--t} UNIV"
     apply (rule solves_odeI)
      apply (rule lorenz_symI)
       apply (rule lorenz.flow_has_vderiv_on_compose)
           apply simp
          apply simp
         apply (rule derivative_intros)
         apply (rule refl)
     using that
        apply (rule lorenz.in_existence_between_zeroI)
        apply assumption
       apply (rule refl)
     unfolding lorenz_S_def
      apply (split prod.splits)+
      apply (simp add: field_simps)
     apply simp
     done
   have "lorenz.flow0 X 0 = X"
     unfolding lorenz.flow_initial_time_if
     by simp
   then have 2:
     "lorenz_S (lorenz.flow0 X 0) = lorenz_S X"
     "is_interval {0--t}"
     "0 \<in> {0--t}"
     "{0--t} \<subseteq> UNIV"
     by auto
   from lorenz.maximal_existence_flow[OF 1 2]
   show ?th1 ?th2 by fast+
 qed
 
 lemma \<Sigma>\<^sub>l\<^sub>e_impl[autoref_rules]: "(Sctn [0, 0, 1] 27, \<Sigma>\<^sub>l\<^sub>e) \<in> \<langle>lv_rel\<rangle>below_rel"
   apply (auto simp: below_rel_def \<Sigma>\<^sub>l\<^sub>e_def below_halfspace_def sctn_rel_def
       intro!: relcompI[where b="Sctn (0, 0, 1) 27"] brI lv_relI)
   subgoal
     unfolding lv_rel_def
     by (auto intro!: brI)
   unfolding le_halfspace_def
   by (auto intro!: brI)
 
 lemma [autoref_rules]: "((), \<Gamma>\<^sub>v) \<in> ghost_rel"
   by (auto intro!: ghost_relI)
 
 no_notation vec_nth (infixl "$" 90) and vec_lambda (binder "\<chi>" 10)
 
 abbreviation "guards_rel \<equiv> \<langle>clw_rel (\<langle>\<langle>lv_rel\<rangle>ivl_rel, \<langle>lv_rel\<rangle>plane_rel\<rangle>inter_rel) \<times>\<^sub>r aform.reach_optns_rel\<rangle>list_rel"
 
 
 definition "aform_poincare_onto_from optns = aform.poincare_onto_from"
 
 lemma aform_poincare_onto_from[autoref_rules]:
   includes autoref_syntax
   shows
 "DIM_precond TYPE('b rvec) E \<Longrightarrow>
     (XSi, XS::'b::enum eucl1 set) \<in> clw_rel aform.appr1e_rel \<Longrightarrow>
     (sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel \<Longrightarrow>
     (ivli, ivl) \<in> \<langle>lv_rel\<rangle>ivl_rel \<Longrightarrow>
     (Si, Sa) \<in> \<langle>lv_rel\<rangle>halfspaces_rel \<Longrightarrow>
     (guardsi, guards) \<in> guards_rel \<Longrightarrow>
     (symstartd, symstart) \<in> aform.appr1e_rel \<rightarrow> \<langle>clw_rel aform.appr_rel \<times>\<^sub>r clw_rel aform.appr1e_rel\<rangle>dres_nres_rel \<Longrightarrow>
     ((), trap) \<in> ghost_rel \<Longrightarrow>
     (roi, roptn) \<in> aform.reach_optns_rel \<Longrightarrow>
     (odoi, odo) \<in> ode_ops_rel \<Longrightarrow>
     (optnsi, optns) \<in> num_optns_rel \<Longrightarrow>
     (nres_of
       (solve_poincare_map_aform optnsi E odoi symstartd Si guardsi ivli
         sctni roi XSi),
      aform_poincare_onto_from $ optns $ odo $ symstart $ trap $ Sa $ guards $
      ivl $
      sctn $
      roptn $
      XS)
     \<in> \<langle>clw_rel aform.appr1e_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs aform_poincare_onto_from_def
   using aform.poincare_onto_from_impl.refine[OF _ aform_ncc aform_ncc,
       where 'a='b, of E odoi odo XSi XS Si Sa guardsi guards ivli ivl sctni sctn roi roptn
         "(\<lambda>x. nres_of (symstartd x))" symstart symstartd trap optnsi,
         unfolded autoref_tag_defs, OF _ _ _ _ _ _ _ _ _ order_refl]
   by (auto simp: dest!: aform.dres_nres_rel_nres_relD)
 
 definition "lorenz_odo_impl = init_ode_ops True True lorenz.odo"
 interpretation autoref_op_pat_def lorenz.odo .
 lemma lorenz_odo_impl[autoref_rules]: "(lorenz_odo_impl, lorenz.odo) \<in> ode_ops_rel"
   by (auto simp: ode_ops_rel_def lorenz_odo_impl_def)
 
 definition lorenz_poincare where
  "lorenz_poincare optns interrupt guards roptn XS0 =
     aform_poincare_onto_from optns lorenz.odo
       (lorenz_interrupt optns interrupt)
       (\<Gamma>\<^sub>i\<^sub>v interrupt:::ghost_rel)
       ((below_halfspaces {Sctn (eucl_of_list [0, 0, 1]) 27}::(real^3) set):::\<langle>lv_rel\<rangle>halfspaces_rel)
       guards
       (op_atLeastAtMost_ivl (eucl_of_list [-6, -6, 27]:::lv_rel) (eucl_of_list [6, 6, 27]:::lv_rel):::lvivl_rel::(real^3) set)
        (Sctn (eucl_of_list [0, 0, -1]) (- 27)::(real^3) sctn)
       roptn
       XS0"
 
 lemma [autoref_rules_raw]:
   includes autoref_syntax
   shows "((),
      (OP \<Gamma>\<^sub>i\<^sub>v ::: bool_rel \<rightarrow> ghost_rel) $
      (OP intr ::: bool_rel))
     \<in> ghost_rel" by (auto simp: ghost_rel_def)
 
 schematic_goal lorenz_poincare_impl[autoref_rules]:
   includes autoref_syntax
   assumes [autoref_rules]: "(XSi, XS) \<in> clw_rel aform.appr1e_rel"
     "(intri, intr) \<in> bool_rel"
     "(guardsi, guards) \<in> guards_rel"
     "(roi, roptn) \<in> aform.reach_optns_rel"
     "(optnsi, optns) \<in> num_optns_rel"
   shows "(nres_of ?r, lorenz_poincare $ optns $ intr $ guards $ roptn $ XS) \<in>
     \<langle>clw_rel aform.appr1e_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding lorenz_poincare_def
   including art
   supply [autoref_rules_raw] = ghost_relI
   by autoref_monadic
 
 lemma cast_image_eqI: "cast ` X = Y"
   if "DIM('a) = DIM('b)"
     "(X::'a::executable_euclidean_space set) = cast ` (Y::'b::executable_euclidean_space set)"
   using that
   by (auto simp: image_image)
 
 lemma transfer_\<Gamma>[transfer_rule]: "(rel_set lorenz.rel_ve) \<Gamma>\<^sub>v \<Gamma>"
   unfolding \<Gamma>\<^sub>v_def
   by (auto simp: lorenz.rel_ve_cast' intro!: rel_setI)
 
 lemma transfer_\<Sigma>\<^sub>l\<^sub>e[transfer_rule]: "(rel_set lorenz.rel_ve) (cast ` \<Sigma>\<^sub>l\<^sub>e) \<Sigma>\<^sub>l\<^sub>e"
   by (auto simp: lorenz.rel_ve_cast' intro!: rel_setI)
 
 lemma transfer_\<Gamma>\<^sub>i[transfer_rule]: "(rel_fun (=) (rel_set lorenz.rel_ve)) \<Gamma>\<^sub>i\<^sub>v \<Gamma>\<^sub>i"
   unfolding \<Gamma>\<^sub>i\<^sub>v_def
   by (auto simp: lorenz.rel_ve_cast' intro!: rel_setI)
 
 lemma transfer_\<Sigma>[transfer_rule]: "(rel_set lorenz.rel_ve) (cast ` \<Sigma>) \<Sigma>"
   by (auto simp: lorenz.rel_ve_cast' intro!: rel_setI)
 
 lemma len_fas: "length lorenz_fas = 3"
   by (auto simp: lorenz_fas_def)
 
 lemma lorenz_poincare[le, refine_vcg]:
   "lorenz_poincare optns intr guards roptn XS \<le> SPEC (\<lambda>R.
     aform.poincare_mapsto lorenz.odo (cast ` \<Sigma>) (XS - (\<Gamma>\<^sub>i\<^sub>v intr \<times> UNIV)) (cast ` \<Sigma>\<^sub>l\<^sub>e)
    UNIV R)"
   if [refine_vcg]: NF
   unfolding lorenz_poincare_def aform_poincare_onto_from_def
   apply (refine_vcg)
   subgoal  by (simp add: aform.wd_def aform.ode_e_def len_fas)
   subgoal for a b c d
     apply (auto simp: lorenz.flowsto_eq[symmetric])
   proof goal_cases
     case 1
     from 1(2)[unfolded lorenz.flowsto_eq[symmetric]]
     show ?case
       by transfer (simp add: lorenz.avflowsto_eq)
   qed
   subgoal
     unfolding aform.stable_on_def unfolding autoref_tag_defs
   proof (intro allI impI, goal_cases)
     case (1 t x0)
     from 1 have t: "t \<in> lorenz.v.existence_ivl0 x0"
       using lorenz.vex_ivl_eq by simp
     from 1 have f: "lorenz.v.flow0 x0 t \<in> \<Gamma>\<^sub>i\<^sub>v intr"
       using lorenz.vflow_eq[OF t] by simp
     from 1 have "lorenz.v.flow0 x0 s \<in> - cast ` \<Sigma>"
       if "s\<in>{0<..t}" for s
     proof -
       from that t have s: "s \<in> lorenz.v.existence_ivl0 x0"
         by (auto dest!: lorenz.a.v.closed_segment_subset_existence_ivl
             simp: closed_segment_eq_real_ivl)
       have "lorenz.v.flow0 x0 s
         \<in> aform.Csafe lorenz.odo -
            op_atLeastAtMost_ivl (eucl_of_list [- 6, - 6, 27]) (eucl_of_list [6, 6, 27]) \<inter>
            plane_of (Sctn (eucl_of_list [0, 0, - 1]) (- 27))"
         using 1(4)[rule_format, OF that]
         unfolding lorenz.vflow_eq[OF s] 
         by auto
       also have "\<dots> \<subseteq> - cast ` \<Sigma>"
         by (auto simp: eucl_le[where 'a="real^3"] eucl_of_list_inner axis_eq_axis
                cast_def Basis_list_real_def Basis_list_vec3 \<Sigma>_def plane_of_def
                eucl_of_list_inner_eq inner_lv_rel_def)
       finally show "lorenz.v.flow0 x0 s \<in> - cast ` \<Sigma>" .
     qed
     show "x0 \<in> \<Gamma>\<^sub>i\<^sub>v intr"
       by (rule \<Gamma>\<^sub>i_stable[Transfer.untransferred, unfolded lorenz.v.stable_on_def, rule_format])
         fact+
   qed
   subgoal for R
   proof (clarsimp, goal_cases)
     case 1
     note 1(2)
     also have "({eucl_of_list [- 6, - 6, 27]..eucl_of_list [6, 6, 27]::3 rvec} \<inter>
       plane_of (Sctn (eucl_of_list [0, 0, - 1]) (- 27))) = cast ` \<Sigma>"
       apply auto
       apply (auto simp: \<Sigma>_def  o_def plane_of_def 
           eucl_of_list_def Basis_list_R3 Basis_list_vec3)
       subgoal
         by (auto simp: cast_def eucl_of_list_def Basis_list_R3 Basis_list_vec3)
       subgoal
         by (auto simp: cast_def eucl_of_list_def Basis_list_R3 Basis_list_vec3)
       subgoal
         apply (auto simp: cast_le_iff[symmetric])
         by (auto simp: cast_def eucl_of_list_def Basis_list_R3 Basis_list_vec3 less_eq_prod_def
             list_of_eucl_def inner_simps inner_axis_axis)
       subgoal
         apply (auto simp: cast_le_iff)
         by (auto simp: cast_def eucl_of_list_def Basis_list_R3 Basis_list_vec3 less_eq_prod_def
             list_of_eucl_def inner_simps inner_axis_axis)
       subgoal
         by (auto simp: cast_def eucl_of_list_def Basis_list_R3 Basis_list_vec3 less_eq_prod_def
             list_of_eucl_def inner_simps inner_axis_axis)
       done
     also have "(below_halfspaces {Sctn (eucl_of_list [0, 0, 1]::3 rvec) 27}) = (cast ` \<Sigma>\<^sub>l\<^sub>e)"
       apply (auto simp: \<Sigma>\<^sub>l\<^sub>e_def below_halfspaces_def below_halfspace_def le_halfspace_def
                     eucl_of_list_def Basis_list_R3 Basis_list_vec3)
        apply (rule image_eqI)
         apply (rule cast_cast[symmetric])
       by (auto simp:  cast_def list_of_eucl_def o_def plane_of_def inner_simps inner_axis_axis
           eucl_of_list_def Basis_list_R3 Basis_list_vec3)
     finally
     show ?case
       by (rule aform.poincare_mapsto_subset) (force simp: lorenz.vX_def intro: cast_cast[symmetric])+
   qed
   done
 
 context includes floatarith_notation begin
 
 definition "mat1\<^sub>e =
   [Var 0, Var 1, Var 2,   Var 3, 0, 0,
                           Var 4, 0, 0,
                           Var 5, 0, 0]"
 
 definition mat1_nres::"3 rvec set \<Rightarrow> 3 rvec set \<Rightarrow> 3 eucl1 set nres"
   where
 "mat1_nres X v = do {
   Xv \<leftarrow> aform.approx_slp_appr mat1\<^sub>e (slp_of_fas mat1\<^sub>e) (concat ` listset [list_of_eucl ` X, list_of_eucl ` v]);
   RETURN (flow1_of_vec1 ` Xv)
 }"
 lemma [simp]: "(x, x') \<in> aform.appr_rel \<Longrightarrow> aform.ncc x'"
   using aform_ncc[where 'a='a]
   by (auto simp: aform.ncc_precond_def)
 lemma mat1e_autoref[autoref_rules]: "(mat1\<^sub>e, mat1\<^sub>e) \<in> \<langle>Id\<rangle>list_rel"
   by auto
 schematic_goal mat1_impl:
   includes autoref_syntax
   assumes [autoref_rules]: "(Xi, X) \<in> aform.appr_rel" "(vi, v) \<in> aform.appr_rel"
   shows "(nres_of ?r, mat1_nres $ X $ v) \<in> \<langle>aform.appr1_rel\<rangle>nres_rel"
   unfolding mat1_nres_def
   including art
   by autoref_monadic
 concrete_definition mat1_impl for Xi vi uses mat1_impl
 lemmas [autoref_rules] = mat1_impl.refine
 
 lemma mat_nres[le, refine_vcg]:
   "mat1_nres X v \<le> SPEC (\<lambda>M. X \<times> v \<subseteq> (\<lambda>x. (fst x, blinfun_apply (snd x) (eucl_of_list [1, 0, 0]))) ` M)"
   unfolding mat1_nres_def
   apply refine_vcg
   apply (auto simp: dest!: bspec)
   apply (auto simp: mat1\<^sub>e_def image_image )
   subgoal for x a b
     apply (rule image_eqI[where x="eucl_of_list
      [(list_of_eucl a @ list_of_eucl b) ! 0, (list_of_eucl a @ list_of_eucl b) ! Suc 0,
       (list_of_eucl a @ list_of_eucl b) ! 2, (list_of_eucl a @ list_of_eucl b) ! 3, 0, 0,
       (list_of_eucl a @ list_of_eucl b) ! 4, 0, 0, (list_of_eucl a @ list_of_eucl b) ! 5, 0, 0]"])
      apply (auto simp: eucl_of_list_prod eucl_of_list_inner nth_append Basis_list_vec3
         intro!: euclidean_eqI[where 'a="3 rvec"])
     unfolding Basis_list[symmetric] Basis_list_vec3
     by (auto simp: flow1_of_vec1_def blinfun_of_vmatrix.rep_eq Basis_list_vec3 inner_simps
         matrix_vector_mult_eq_list_of_eucl_nth ll3 inner_axis_axis)
   done
 
 definition [simp]: "op_image_cast_eucl1e = (`) cast_eucl1"
 definition [simp]: "op_image_cast_eucl1e_coll = (`) cast_eucl1"
 
 lemma prod_relI'': "\<lbrakk>(fst ab, a')\<in>R1; (snd ab, b')\<in>R2\<rbrakk> \<Longrightarrow> (ab,(a', b'))\<in>\<langle>R1,R2\<rangle>prod_rel"
   by  (auto simp: prod_rel_def)
 
 lemma strange_aux_lemma:
   "(b, b') \<in> A \<Longrightarrow> (b, snd (a'a, b')) \<in> A"
   by auto
 
 lemma [autoref_rules]:
   includes autoref_syntax
   assumes
     "DIM_precond TYPE('a::executable_euclidean_space) D"
     "DIM_precond TYPE('b::executable_euclidean_space) D"
   shows
     "(\<lambda>x. x, (op_image_cast_eucl1e::('a::executable_euclidean_space c1_info set \<Rightarrow> 'b::executable_euclidean_space c1_info set))) \<in> aform.appr1e_rel \<rightarrow> aform.appr1e_rel"
     (is ?th1)
     and "(\<lambda>x. x, op_image_cast_eucl1e_coll::'a::executable_euclidean_space c1_info set \<Rightarrow> 'b::executable_euclidean_space c1_info set) \<in> clw_rel aform.appr1e_rel \<rightarrow> clw_rel aform.appr1e_rel"
     (is ?th2)
 proof -
   show 1: ?th1
     unfolding scaleR2_rel_def
     apply (rule subsetD)
      apply (rule fun_rel_comp_dist)
     apply (rule relcompI)
      apply (rule fun_relI)
      apply (erule prod_relE)
      apply simp
      apply (rule prod_relI)
       apply simp
       apply (rule fst_conv[symmetric])
      apply (rule op_cast_eucl1_image_impl[OF assms, param_fo])
      apply (rule strange_aux_lemma)
      apply (auto simp: br_def scaleR2_def image_def vimage_def
         cast_eucl1_def)
     subgoal for a b c d e f g
       apply (rule exI[where x=e] conjI)+
        apply assumption
       apply (rule exI conjI)+
        apply assumption
       apply (rule exI conjI)+
        apply (rule bexI) prefer 2 apply assumption
        apply (rule conjI) apply force
        apply (rule refl)
       using assms
       by (auto simp: blinfun.bilinear_simps linear_cast linear.scaleR
           intro!: blinfun_eqI)
     subgoal for a b c d e f g
       apply (rule exI[where x=e] exI conjI)+
         apply assumption
        apply (rule exI conjI)+
         apply assumption
        apply (rule bexI) prefer 2 apply assumption
        apply force
       using assms
       by (auto simp: blinfun.bilinear_simps linear_cast linear.scaleR
           intro!: blinfun_eqI)
     done
   have id_map: "(\<lambda>x. x) = (map (\<lambda>x. x))" by simp
   show ?th2
     apply (subst id_map)
     apply (rule lift_clw_rel_map)
        apply (rule relator_props)+
     subgoal using 1 by auto
     subgoal by auto
     done
 qed
 
 definition "lorenz_poincare_tangents optns interrupt guards roptn c1 (X0::R3 set) (tangents::R3 set) =
   do {
     X0tanmat \<leftarrow> (if c1 then
       do {
         R \<leftarrow> mat1_nres (cast ` X0) (cast ` tangents);
         RETURN (R::3 eucl1 set)
       } else RETURN (cast ` X0 \<times> UNIV));
     XDX0 \<leftarrow> scaleRe_ivl_spec 1 1 (X0tanmat);
     let _ = aform.trace_set1e ''START'' (Some XDX0);
     let _ = aform.print_set1e False (XDX0);
     P \<leftarrow> lorenz_poincare optns interrupt guards roptn ((mk_coll XDX0:::clw_rel aform.appr1e_rel));
     RETURN (op_image_cast_eucl1e_coll P::R3 c1_info set)
   }"
 lemma [autoref_rules_raw]: "DIM(real \<times> real \<times> real) = DIM((real, 3) vec)"
   by auto
 
 schematic_goal lorenz_poincare_tangents_impl:
   includes autoref_syntax
   assumes [autoref_rules]:
     "(optnsi, optns) \<in> Id"
     "(intrri, intr) \<in> bool_rel"
     "(guardsi, guards) \<in> guards_rel"
     "(roi, roptn) \<in> aform.reach_optns_rel"
     "(c1i, c1) \<in> bool_rel"
     "(X0i, X0) \<in> aform.appr_rel"
     "(tangentsi, tangents) \<in> aform.appr_rel"
   shows
   "(nres_of ?r, lorenz_poincare_tangents $ optns $ intr $ guards $ roptn $ c1 $ (X0::R3 set) $ tangents) \<in>
     \<langle>clw_rel aform.appr1e_rel\<rangle>nres_rel"
   unfolding lorenz_poincare_tangents_def
   including art
   by (autoref_monadic)
 
 concrete_definition lorenz_poincare_tangents_impl uses
   lorenz_poincare_tangents_impl[where
      optnsa = "\<lambda>_ _ _ _ _ _ _ _. optns"
     and optnsb = "\<lambda>_ _ _ _ _ _ _ _ _. optns"
     and optnsi = "optns"
     and optnsc = "optns"
     and optns = "\<lambda>_ _ _ _ _ _ _. optns"
   for optns optnsc]
 lemma lorenz_poincare_tangents_impl_refine[autoref_rules]:
   includes autoref_syntax
   shows
   "(\<lambda>optnsi intrri guardsi roi c1i X0i tangentsi. nres_of
     (lorenz_poincare_tangents_impl optnsi intrri guardsi roi c1i X0i tangentsi),
    lorenz_poincare_tangents)
   \<in> num_optns_rel \<rightarrow> bool_rel \<rightarrow> guards_rel \<rightarrow> aform.reach_optns_rel \<rightarrow> bool_rel \<rightarrow> aform.appr_rel \<rightarrow>
     aform.appr_rel \<rightarrow>
     \<langle>clw_rel aform.appr1e_rel\<rangle>nres_rel"
   using lorenz_poincare_tangents_impl.refine by force
 
 lemma transfer_UNIV_rel_blinfun[transfer_rule]:
   "(rel_set (rel_blinfun lorenz.rel_ve lorenz.rel_ve)) UNIV UNIV"
   apply (auto intro!: rel_setI simp: rel_blinfun_def)
   subgoal for x
     apply (rule exI[where x="cast_bl x"])
     by (auto intro!: rel_funI simp: lorenz.rel_ve_cast)
   subgoal for x
     apply (rule exI[where x="cast_bl x"])
     by (auto intro!: rel_funI simp: lorenz.rel_ve_cast)
   done
 
 lemma lorenz_vX[simp]: "lorenz.vX = (UNIV::3 rvec set)"
   by (force simp: lorenz.vX_def intro!: cast_cast[symmetric])
 
 lemma closed_cast_\<Sigma>[intro, simp]: "closed (cast ` \<Sigma>::3 rvec set)"
   by (auto simp: \<Sigma>_def )
 lemma blinfun_apply_transfer[transfer_rule]:
   "(rel_fun (rel_blinfun lorenz.rel_ve lorenz.rel_ve)
        (rel_fun (rel_prod (=) (rel_prod (=) (=))) lorenz.rel_ve))
      (blinfun_apply o cast_bl) blinfun_apply"
   by (auto intro!: rel_funI simp: rel_blinfun_def lorenz.rel_ve_cast
       dest!: rel_funD)
 
 lemma lorenz_poincare_tangents[le, refine_vcg]:
   "lorenz_poincare_tangents optns intr guards roptn c1 (X0::R3 set) tangents \<le>
     SPEC (\<lambda>x.
       (if c1 then \<exists>tans. X0 \<times> tangents \<subseteq> (\<lambda>(x, y). (x, blinfun_apply y (1, 0, 0))) ` tans \<and> lorenz.poincare_mapsto \<Sigma> (tans - \<Gamma>\<^sub>i intr \<times> UNIV) (\<Sigma>\<^sub>l\<^sub>e) UNIV x
        else lorenz.poincare_mapsto \<Sigma> ((X0 - \<Gamma>\<^sub>i intr) \<times> UNIV) (\<Sigma>\<^sub>l\<^sub>e) UNIV x))"
   if [refine_vcg]: NF
   unfolding lorenz_poincare_tangents_def
   apply refine_vcg
    apply auto
    apply (subst lorenz.poincare_mapsto_eq[symmetric])
     apply simp
 proof goal_cases
   case (2 R)
   then show ?case
     apply transfer
     apply (subst lorenz.vpoincare_mapsto_eq[symmetric])
      apply (auto simp: )
     apply (rule aform.poincare_mapsto_subset, assumption)
     by (force simp: scaleR2_def )+
 next
   case (1 tans R)
   show ?case
     apply (rule exI[where x="cast_eucl1 ` tans"])
     apply (rule conjI)
     subgoal including lifting_syntax
       using 1(2)
       by transfer (force simp: cast_def o_def)
     subgoal
       using 1(3) apply transfer
       apply (subst lorenz.avpoincare_mapsto_eq[symmetric])
       by (auto simp: )
     done
 qed
 
 definition of_mat1_image::"R3 c1_info set \<Rightarrow> R3 set nres"
   where [refine_vcg_def]: "of_mat1_image X = SPEC (\<lambda>R. R = (\<lambda>x. blinfun_apply (snd x) (1, 0, 0)) ` X)"
 
 lemma of_mat1_image_impl[autoref_rules]:
   "(\<lambda>x. (case x of (_, Some xs) \<Rightarrow> RETURN [xs ! 0, xs ! 3, xs ! 6]
           | (_, None) \<Rightarrow> SUCCEED), of_mat1_image) \<in> aform.appr1_rel \<rightarrow> \<langle>aform.appr_rel\<rangle>nres_rel"
   apply (auto simp: of_mat1_image_def RETURN_RES_refine_iff nres_rel_def
       aform.appr1_rel_internal aform.appr_rel_def
       intro!: relcompI
       split: option.splits)
   unfolding aforms_rel_def
    apply (rule brI)
     apply (auto simp: )
   unfolding lv_rel_def set_rel_br
   apply (rule brI)
    prefer 2 apply (force simp: Joints_imp_length_eq)
   apply (auto elim!: mem_Joints_appendE simp: flow1_of_list_def Joints_imp_length_eq)
   subgoal for a b c d e f g h i j
     apply (rule image_eqI[where x="[j ! 0, j ! 3, j! 6]"])
      apply (auto simp: blinfun_of_list_def blinfun_of_matrix_apply
         Basis_prod_def Basis_list_R3 Basis_list_vec3 eval_nat_numeral zero_prod_def)
     apply (rule map_nth_Joints'[of _ _ "[0, Suc (Suc (Suc 0)), Suc (Suc (Suc (Suc (Suc (Suc 0)))))]",
           simplified])
     apply auto
     done
   subgoal for a b c d e f
     unfolding image_image
     apply (auto simp: Joints_def valuate_def)
     subgoal for g
       apply (rule image_eqI)
       prefer 2
       apply (rule image_eqI[where x=g])
       apply (rule refl)
       apply (auto simp: )
       apply (auto simp: blinfun_of_list_def blinfun_of_matrix_apply flow1_of_list_def
           Basis_prod_def Basis_list_R3 Basis_list_vec3 eval_nat_numeral zero_prod_def)
       done
     done
   done
 
 definition [refine_vcg_def]: "floatdegs res = SPEC (\<lambda>_::unit. min_deg res \<in> float \<and> max_deg res \<in> float)"
 definition [simp]: "isinfloat x \<longleftrightarrow> x \<in> float"
 lemma [code]: "isinfloat (real_of_float x) = True"
   by (auto)
 
 lemma floatdegs_impl[autoref_rules]:
   includes autoref_syntax
   shows
   "(\<lambda>res. (if isinfloat (min_deg res) \<and> isinfloat (max_deg res) then RETURN () else SUCCEED), floatdegs)
     \<in> Id \<rightarrow> \<langle>unit_rel\<rangle>nres_rel"
   by (auto simp: nres_rel_def floatdegs_def)
 
 definition "check_c1_entry optns em P (res0::result) (res::result) = do {
     uv_ret \<leftarrow> of_mat1_image P;
     nuv \<leftarrow> aform.mig_set 3 uv_ret;
     floatdegs res0;
     floatdegs res;
     let e' = em * ereal nuv;
     b1 \<leftarrow> approx_conefield_bounds P (min_deg res) (max_deg res);
     let b2 = e' \<ge> preexpansion res;
     let b3 = e' \<ge> expansion res0;
     let _ = aform.print_msg ((shows ''# check_c1_entry: '' o shows_list [b1, b2, b3] o shows_space o
       shows_list [e', preexpansion res, expansion res0]) '''');
     RETURN (em \<ge> 0 \<and> b1 \<and> b2 \<and> b3)
   }"
 
 lemma [autoref_itype]:
   "shows_prec ::\<^sub>i i_nat \<rightarrow>\<^sub>i A \<rightarrow>\<^sub>i i_string \<rightarrow>\<^sub>i i_string"
   by auto
 
 lemma [autoref_rules]:
   includes autoref_syntax
   shows
     "PREFER_id A \<Longrightarrow> (shows_list, shows_list) \<in> \<langle>A\<rangle>list_rel \<rightarrow> string_rel \<rightarrow> string_rel"
     "(shows_prec, shows_prec) \<in> nat_rel \<rightarrow> string_rel \<rightarrow> string_rel \<rightarrow> string_rel"
     "(shows_prec, shows_prec) \<in> nat_rel \<rightarrow> ereal_rel \<rightarrow> string_rel \<rightarrow> string_rel"
     "(shows_prec, shows_prec::_\<Rightarrow>result \<Rightarrow>_) \<in> nat_rel \<rightarrow> Id \<rightarrow> string_rel \<rightarrow> string_rel"
     "(shows_space, shows_space) \<in> string_rel \<rightarrow> string_rel"
   by (auto simp: string_rel_def)
 lemma [autoref_rules]:
   includes autoref_syntax
   shows
     "(expansion, expansion) \<in> Id \<rightarrow> rnv_rel"
     "(preexpansion, preexpansion) \<in> Id \<rightarrow> rnv_rel"
     "(min_deg, min_deg) \<in> Id \<rightarrow> rnv_rel"
     "(max_deg, max_deg) \<in> Id \<rightarrow> rnv_rel"
   by auto
 interpretation autoref_op_pat_def aform.mig_set .
 lemma [autoref_rules_raw]: "DIM_precond TYPE(real \<times> real \<times> real) (OP 3 ::: nat_rel)"
   by simp
 schematic_goal check_c1_entry_impl:
   includes autoref_syntax
   assumes [autoref_rules]:
     "(optnsi, optns) \<in> Id"
     "(res0i, res0) \<in> Id"
     "(resi, res) \<in> Id"
     "(emi, em) \<in> ereal_rel"
     "(Pei, P) \<in> aform.appr1_rel"
   shows
     "(nres_of ?r, check_c1_entry optns em P res0 res) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding check_c1_entry_def
   including art
   by autoref_monadic
 
 concrete_definition check_c1_entry_impl uses check_c1_entry_impl[
     where optns = "\<lambda>_ . optnsi"
     and optnsi="optnsi"
     and optnsc=optns
     and optnsa="\<lambda>_ _ _ _ _. optnsi"
     and optnsb="\<lambda>_ _ _ _  _ _ _ _ . optnsi"
     and optns="\<lambda>_. optnsi"
     for optns optnsi]
 lemmas check_c1_entry_impl_refine[autoref_rules] = check_c1_entry_impl.refine[autoref_higher_order_rule]
 
 definition "c1_entry_correct (em::ereal) (P::R3 c1_info set) res0 res = (\<forall>(_, d)\<in>P. case (d (1, 0, 0)) of (dx, dy, dz) \<Rightarrow>
       dz = 0 \<and> dx > 0 \<and> -90 < min_deg res \<and> min_deg res \<le> max_deg res \<and> max_deg res < 90 \<and>
       ereal (preexpansion res) \<le> em * (norm (dx, dy, dz)) \<and>
       ereal (expansion res0) \<le> em * (norm (dx, dy, dz)) \<and>
       dy / dx \<in> {tan (rad_of (min_deg res)) .. tan (rad_of (max_deg res))})"
 
 lemma check_c1_entry[le, refine_vcg]:
   "check_c1_entry optns em P res0 res \<le> SPEC (\<lambda>b. b \<longrightarrow> c1_entry_correct em P res0 res)"
   unfolding check_c1_entry_def c1_entry_correct_def
   apply refine_vcg
   apply (auto dest!: bspec simp:)
     apply (rule order_trans, assumption, rule ereal_mult_left_mono, force, force)
   apply (rule order_trans, assumption, rule ereal_mult_left_mono, force, force)
   done
 
 
 subsection \<open>options for the lorenz system\<close>
 
 definition aform_numeric_optns::"_ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow>
     real aform numeric_options" where
   "aform_numeric_optns = numeric_options.fields"
 
 fun zbucket::"real \<Rightarrow>  real \<times> real \<Rightarrow> real \<times> real \<Rightarrow> real \<times> real \<Rightarrow> ((real list \<times> real list) \<times> real list sctn) list"
   where "zbucket d (x0,x1) (y0, y1) (z0, z1) =
     [zsec' (x0 - d, x0 + d) (y0 - d, y1 + d) z0, \<comment> \<open>bottom\<close>
      xsec' x0 (y0 - d, y1 + d) (z0 - d, z1),     \<comment> \<open>left\<close>
      xsec x1 (y0 - d, y1 + d) (z0 - d, z1),      \<comment> \<open>right\<close>
      ysec' (x0 - d, x1 + d) y0 (z0 - d, z1),     \<comment> \<open>backno\<close>
      ysec (x0 - d, x1 + d) y1  (z0 - d, z1)]     \<comment> \<open>front\<close>"
 
 subsubsection \<open>Hybridizations\<close>
 
 definition "reduce_weak_params c1 = (if c1 then (12::nat, 0::nat) else (3, 0))"
 definition "reduce_hard_params c1 = (if c1 then (0::nat, 100::nat) else (0, 100))"
 definition "ro_split_weak   c1 w     = (case reduce_weak_params c1 of (m, n) \<Rightarrow> ro (w + 1) m n w w (-5))"
 definition "ro_split_weak'  c1 w     = (case reduce_weak_params c1 of (m, n) \<Rightarrow> ro w m n w w (-5))"
 definition "ro_split_weak'' c1 w     = (case reduce_weak_params c1 of (m, n) \<Rightarrow> ro (w + 2) m n w w (-5))"
 definition "ro_split_weak4' c1 w     = (case reduce_weak_params c1 of (m, n) \<Rightarrow> ro (w + 4) m n w w (-5))"
 definition "ro_split_weak2  c1 w w2  = (case reduce_weak_params c1 of (m, n) \<Rightarrow> ro (w + 1) m n w w2 (-5))"
 definition "ro_split_weak2' c1 w w2  = (case reduce_weak_params c1 of (m, n) \<Rightarrow> ro (w) m n w w2 (-5))"
 definition "ro_split_hard   c1 w0 w1 = (case reduce_hard_params c1 of (m, n) \<Rightarrow> ro (w0 + 1) m n w0 w1 (-5))"
 definition "ro_split_hard'' c1 w0 w1 = (case reduce_hard_params c1 of (m, n) \<Rightarrow> ro (w0 + 2) m n w0 w1 (-5))"
 definition "ro_split_not    c1 w     = (case reduce_weak_params c1 of (m, n) \<Rightarrow> ro       0 m n w w (-5))"
 definition "ro_split_not2   c1 w w2  = (case reduce_weak_params c1 of (m, n) \<Rightarrow> ro       0 m n w w2 (-5))"
 
 definition "xsecs x y z = [xsec' (-x) (-y, y) (0, z), xsec x (-y, y) (0, z)]"
 
 type_synonym run_options = "(nat \<times> nat) \<times> int \<times>
   (((real list \<times> real list) \<times> real list sctn) list \<times> real aform reach_options) list \<times> real aform reach_options"
 
 abbreviation "p1 \<equiv> ldec 0.1"
 
 definition mode_middle::"_ \<Rightarrow> run_options" where "mode_middle c1 = (reduce_weak_params c1, -14,
   [([zsec' (-2, 2) (-1, 1) 10], ro_split_weak' c1 (-3)),
   (xsecs (5 * p1)  10    10 @
    xsecs p1      10  (6) @
    [zsec' (-p1, p1) (-p1, p1) p1],
       ro_split_hard c1 (-5) (-2)),
   (xsecs (3/2/2) 10 (10), ro_split_not2 c1 0 (-2)), \<comment> \<open>To collect after interrupt\<close>
     ([zsec (-30, -6) (-10, 10) 30, zsec (6, 30) (-10, 10) 30], ro_split_not2 c1 (-1) (-3))
   ], ro_split_weak4' c1 (-5))"
 
 definition mode_inner3::"bool\<Rightarrow>bool\<Rightarrow>run_options" where "mode_inner3 c1 very_inner =
    (reduce_weak_params c1, -15,
     (if very_inner then [([zsec' (-2, 2) (-1, 1) 10], ro_split_weak' c1 (-2))] else [])@
     [(xsecs (3/2) 15 27@xsecs 1 (10) (11/2), ro_split_weak2 c1 (-2) (-1)),
      ([ zsec (-30, -6) (-10, 10) 30, zsec (6, 30) (-10, 10) 30], ro_split_not2 c1 (-1) (-3))
     ],
      if very_inner then ro_split_weak4' c1 (-5) else ro_split_weak'' c1 (-5))"
 
 definition mode_inner2::"bool \<Rightarrow> real \<Rightarrow> run_options" where "mode_inner2 c1 x =
   (reduce_weak_params c1, -14,
     [(xsecs x 10 27, ro_split_weak2' c1 (-2) (-1)),
      ([zsec ( -30, -6) (-10, 10) 30, zsec (6, 30) (-10, 10) 30], ro_split_not2 c1 (-3) (-3))],
   ro_split_not c1 (-6))"
 
 definition "ro_outer c1 w = (case reduce_weak_params c1 of (m, n) \<Rightarrow> ro w m n (-6) (-6) (-5))"
 definition mode_outer::"bool\<Rightarrow>_\<Rightarrow>_\<Rightarrow>run_options" where
   "mode_outer c1 w i = (reduce_weak_params c1, (-i),
     [([zsec (-30, -6) (-10, 10) 27, zsec (6, 30) (-10, 10) 27], ro_split_not2 c1 (-3) (-4))], ro_outer c1 w)"
 
 definition lookup_mode::"bool \<Rightarrow> result \<Rightarrow> _" where
 "lookup_mode c1 i =
   (if     gridx0 i \<le> - 1024 then mode_outer  c1 (-3) 16
   else if gridx0 i \<le> - 120  then mode_outer  c1 (-3) 14
   else if gridx0 i \<le> 107    then mode_inner2 c1 (4)
   else if gridx0 i \<le> 169    then mode_inner3 c1 False
   else if gridx0 i \<le> 196    then mode_inner3 c1 True
   else if gridx0 i \<le> 201    then mode_middle c1
   else if gridx0 i \<le> 235    then mode_inner3 c1 True
   else if gridx0 i \<le> 290    then mode_inner3 c1 False
   else if gridx0 i \<le> 450    then mode_inner2 c1 4
   else                           mode_outer  c1 (-3) 14)"
 
 definition mode_ro_spec::"bool \<Rightarrow> result \<Rightarrow> ((nat \<times> nat) \<times>
           int \<times> ((real, 3) vec set \<times> unit) list \<times>
           unit) nres"
 where [refine_vcg_def]: "mode_ro_spec c1 res = SPEC (\<lambda>_. True)"
 
 lemma reach_options_rel_br: "reach_options_rel TYPE('ty) = br (\<lambda>_. ()) (\<lambda>_. True)"
   by (auto simp: reach_options_rel_def br_def)
 
 lemma mode_ro_spec_impl[autoref_rules]:
   includes autoref_syntax
   shows "(\<lambda>b x. RETURN (lookup_mode b x), mode_ro_spec) \<in> bool_rel \<rightarrow> Id \<rightarrow>
     \<langle>(nat_rel \<times>\<^sub>r nat_rel) \<times>\<^sub>r int_rel \<times>\<^sub>r guards_rel \<times>\<^sub>r aform.reach_optns_rel\<rangle>nres_rel"
   supply [simp del] = prod_rel_id_simp
   apply (rule fun_relI)
   apply (rule fun_relI)
   apply (rule nres_relI)
   unfolding mode_ro_spec_def
   apply (rule RETURN_SPEC_refine)
   apply (auto simp: mode_ro_spec_def nres_rel_def RETURN_RES_refine_iff)
   apply (rule exI)+
   apply (rule prod_relI'' IdI)+
   unfolding lv_rel_def ivl_rel_def br_rel_prod br_chain plane_rel_br inter_rel_br
     clw_rel_br br_list_rel Id_br prod_eq_iff reach_options_rel_br
    apply (rule brI refl)+
    defer apply (rule brI) apply (rule refl) apply auto
   apply (auto simp: lookup_mode_def mode_outer_def mode_inner2_def mode_inner3_def xsecs_def
       mode_middle_def)
   done
 
 lemma [autoref_rules]: includes autoref_syntax shows
   "(ivl_of_res, ivl_of_res) \<in> Id \<rightarrow> \<langle>rnv_rel\<rangle>list_rel \<times>\<^sub>r \<langle>rnv_rel\<rangle>list_rel"
   by auto
 
 
 lemma [autoref_rules]: includes autoref_syntax shows
   "(Polygon.pairself, Polygon.pairself) \<in> (A \<rightarrow> C) \<rightarrow> (A \<times>\<^sub>r A) \<rightarrow> (C \<times>\<^sub>r C)"
   by (auto dest: fun_relD)
 
 lemma set_of_ivl_impl[autoref_rules]: includes autoref_syntax shows
   "(\<lambda>x. x, set_of_ivl) \<in> (A \<times>\<^sub>r A) \<rightarrow> \<langle>A\<rangle>ivl_rel"
   by (auto simp: ivl_rel_def br_def)
 lemma eucl_of_list_pad: includes autoref_syntax shows
   "DIM_precond TYPE('a::executable_euclidean_space) D \<Longrightarrow>
     (\<lambda>xs. take D xs @ replicate (D - length xs) 0, eucl_of_list::_\<Rightarrow>'a) \<in> rl_rel \<rightarrow> lv_rel"
   unfolding lv_rel_def
   by (auto simp: intro!: brI)
 concrete_definition eucl_of_list_pad uses eucl_of_list_pad
 lemmas [autoref_rules] = eucl_of_list_pad.refine
 
 lemma source_of_res_impl[autoref_rules]: includes autoref_syntax shows
   "(ivl_of_res, source_of_res) \<in> Id \<rightarrow> \<langle>lv_rel\<rangle>ivl_rel"
   unfolding source_of_res_def
   apply (auto simp: ivl_rel_def intro!: relcompI brI)
   subgoal for a
     apply (auto simp: ivl_of_res_def ivl_of_resultrect_def
         intro!: lv_relI)
     unfolding lv_rel_def
      apply (auto intro!: brI)
     done
   done
 
 definition tangent_seg_of_res :: "real aform numeric_options \<Rightarrow> result \<Rightarrow> R3 set nres" where
 "tangent_seg_of_res optns res0 = do {
   let fas = map (OP (nth matrix_of_degrees2\<^sub>e)) [0, 3, 6];
   let u = min_deg res0;
   let v = max_deg res0;
   aform.approx_slp_appr fas (slp_of_fas fas) (lv_ivl [u, v, 0] [u, v, 1])
 }"
 lemmas [refine_vcg_def] = tangent_seg_of_res_spec_def
 lemma tangent_seg_of_res[le, refine_vcg]:
   "tangent_seg_of_res optns res \<le> tangent_seg_of_res_spec res"
   unfolding tangent_seg_of_res_def tangent_seg_of_res_spec_def
   apply refine_vcg
   apply (auto simp: matrix_of_degrees2\<^sub>e_def Let_def in_segment)
   subgoal for x a b c u
     by (drule bspec[where x="[min_deg res, max_deg res, u]"])
        (auto simp: tangent_of_deg_def lv_ivl_def algebra_simps intro!:)
   done
 lemma [autoref_rules]: includes autoref_syntax shows
   "(nth matrix_of_degrees2\<^sub>e, nth matrix_of_degrees2\<^sub>e) \<in> nat_rel \<rightarrow> Id"
   by auto
 schematic_goal tangent_seg_of_res_impl:
   includes autoref_syntax
   assumes [autoref_rules]: "(resi, res) \<in> Id"
     "(optnsi, optns) \<in> num_optns_rel"
   shows
   "(nres_of ?r, tangent_seg_of_res optns res) \<in> \<langle>aform.appr_rel\<rangle>nres_rel"
   unfolding tangent_seg_of_res_def
   including art
   by autoref_monadic
 concrete_definition tangent_seg_of_res_impl uses tangent_seg_of_res_impl
 lemmas [autoref_rules] = tangent_seg_of_res_impl.refine[where
     optnsi = optnsi and optnsa=optns and optns="\<lambda>_ _ _. optnsi" for optns optnsi, autoref_higher_order_rule]
 
 lemma return_of_res_impl:
  includes autoref_syntax shows
   "(\<lambda>results res. (get_results (inf_retx res) (inf_rety res) (sup_retx res) (sup_rety res) results),
     return_of_res) \<in> \<langle>Id\<rangle>list_rel \<rightarrow> Id \<rightarrow> \<langle>Id\<rangle>list_wset_rel"
   by (auto simp: return_of_res_def list_wset_rel_def intro!: brI)
 concrete_definition return_of_res_impl uses return_of_res_impl
 lemmas [autoref_rules] = return_of_res_impl.refine
 
 lemma lorenz_optns'_impl[autoref_rules]: includes autoref_syntax shows
   "(lorenz_optns', lorenz_optns') \<in>
     \<langle>Id \<rightarrow> unit_rel\<rangle>option_rel \<rightarrow> nat_rel \<rightarrow> nat_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel \<rightarrow> num_optns_rel"
   by auto
 lemma [autoref_rules]:
   includes autoref_syntax shows
     "(results, results) \<in> \<langle>Id\<rangle>list_rel"
     "(invoke_nf, invoke_nf) \<in> Id \<rightarrow> bool_rel"
   by auto
 
 definition "check_line_nres print_fun m0 n0 c1 res0 = do {
     let X0 = source_of_res res0;
     (X0l, X0u) \<leftarrow> ivl_rep X0;
     ((m::nat, n::nat), a::int, modes, ro) \<leftarrow> mode_ro_spec c1 res0;
     let interrupt = invoke_nf res0;
     let optns = lorenz_optns' print_fun (the_default m m0) (the_default n n0) 1 (FloatR 1 a);
     tangents \<leftarrow> tangent_seg_of_res optns res0;
     aform.CHECKs (ST ''check_line_nres le'') (X0l \<le> X0u);
     sp \<leftarrow> aform.subset_spec_plane X0 (Sctn (eucl_of_list [0, 0, 1]) 27);
     aform.CHECKs (ST ''check_line_nres le'') sp;
     ASSERT (X0l \<le> X0u);
     Pe \<leftarrow> lorenz_poincare_tangents optns interrupt modes ro c1 ({X0l .. X0u}) tangents;
     PeS \<leftarrow> sets_of_coll Pe;
     let RETs = (return_of_res results res0);
     let RET = \<Union>((mk_coll ` (source_of_res ` RETs:::\<langle>lvivl_rel\<rangle>list_wset_rel):::\<langle>clw_rel lvivl_rel\<rangle>list_wset_rel));
     every \<leftarrow> WEAK_ALL\<^bsup>\<lambda>Pe. \<exists>P em eM Rivls. em > 0 \<and> Pe = scaleR2 em eM P \<and> fst ` P \<subseteq> \<Union>Rivls \<and> (\<forall>Rivl \<in> Rivls. (\<exists>res\<in>RETs. Rivl \<subseteq> source_of_res res \<and> (c1 \<longrightarrow> c1_entry_correct em P res0 res)))\<^esup>
     PeS (\<lambda>Pe. do {
       let _ = aform.trace_set1e (ST ''# Return Element: '') (Some Pe);
       ((em, eM), P) \<leftarrow> scaleR2_rep Pe;
       aform.CHECKs (ST ''check_line_nres pos'') (0 < em);
       let R = (fst ` P:::aform.appr_rel);
       (Ri, Rs) \<leftarrow> op_ivl_rep_of_set R;
       let Rivl = (op_atLeastAtMost_ivl Ri Rs);
       Rivls \<leftarrow> aform.split_along_ivls2 3 (mk_coll Rivl) RET;
       Rivlss \<leftarrow> sets_of_coll Rivls;
       WEAK_ALL\<^bsup>\<lambda>Rivl. \<exists>res\<in>RETs. Rivl \<subseteq> source_of_res res \<and> (c1 \<longrightarrow> c1_entry_correct em P res0 res)\<^esup> Rivlss
       (\<lambda>Rivl. do {
         b \<leftarrow>
           WEAK_EX\<^bsup>\<lambda>res. Rivl \<subseteq> source_of_res res \<and> (c1 \<longrightarrow> c1_entry_correct em P res0 res)\<^esup> RETs
           (\<lambda>res. do {
             let src = (source_of_res res:::lvivl_rel);
             let subs = Rivl \<subseteq> src;
             cones \<leftarrow> if \<not>(c1 \<and> subs) then RETURN True else check_c1_entry optns em P res0 res;
             RETURN (subs \<and> cones)
           });
         let _ = aform.print_msg ((shows (ST ''# return of '') o shows res0 o
           shows (if b then ST '' OK'' else ST '' FAILED''))'''');
         RETURN b
       })
     });
     RETURN (every, Pe, RET)
   }"
 
 
 definition "aform_subset_spec_plane optns = aform.subset_spec_plane"
 
 lemma aform_subset_spec_plane_impl[autoref_rules]:  includes autoref_syntax shows
   "DIM_precond TYPE('a::executable_euclidean_space) D \<Longrightarrow>
   (Xi, X::'a set) \<in> \<langle>lv_rel\<rangle>ivl_rel \<Longrightarrow>
   (sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel \<Longrightarrow>
   (optnsi, optns) \<in> num_optns_rel \<Longrightarrow>
   (nres_of (subset_spec_plane_impl_aform optnsi D Xi sctni),
    aform_subset_spec_plane $ optns $ X $ sctn)
   \<in> \<langle>bool_rel\<rangle>nres_rel"
   using aform.subset_spec_plane_impl.refine[where 'a='a, of D Xi X sctni sctn optnsi]
   by (force simp: aform_subset_spec_plane_def)
 
 schematic_goal check_line_impl:
   includes autoref_syntax
   assumes [autoref_rules]: "(pfi, pf) \<in> \<langle>Id \<rightarrow> unit_rel\<rangle>option_rel"
     "(c1i, c1) \<in> bool_rel" "(res0i, res0) \<in> Id"
     "(m0i, m0) \<in> \<langle>nat_rel\<rangle>option_rel" "(n0i, n0) \<in> \<langle>nat_rel\<rangle>option_rel"
   shows
   "(nres_of ?r, check_line_nres $ pf $ m0 $ n0 $ c1 $ res0) \<in>
     \<langle>bool_rel \<times>\<^sub>r clw_rel aform.appr1e_rel \<times>\<^sub>r clw_rel lvivl_rel\<rangle>nres_rel"
   unfolding check_line_nres_def
   including art
   by autoref_monadic
 
 concrete_definition check_line_impl uses check_line_impl[where
      optns = "\<lambda>_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ . lorenz_optns pfi"
     and optnsa = "\<lambda>_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _. lorenz_optns pfi"
     and optnsb = "\<lambda>_ _ _ _ _ _ _ _ _ _  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _. lorenz_optns pfi"
     and optnsc = "\<lambda>_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _. lorenz_optns pfi"
     and optnsd = "\<lambda>_ _ _ _ _ _ _ _ _ _  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _. lorenz_optns pfi"
     and optnse = "\<lambda>_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _. lorenz_optns pfi"
     and optnsf = "\<lambda> _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _. lorenz_optns pfi"
     and pfi = pfi
     for pfi]
 lemmas [autoref_rules] = check_line_impl.refine
 
 
 lemma check_line_nres:
   "check_line_nres pf m0 n0 c1 res0 \<le> SPEC (\<lambda>(every, Pe, RET). \<exists>P. Pe = \<Union>P \<and>
     (if c1
     then \<exists>tans. source_of_res res0 \<times> {tangent_of_deg (min_deg res0)--tangent_of_deg (max_deg res0)} \<subseteq> (\<lambda>(x, y). (x, blinfun_apply y (1, 0,  0))) ` tans \<and>
                 lorenz.poincare_mapsto \<Sigma> (tans - \<Gamma>\<^sub>i (invoke_nf res0) \<times> UNIV) \<Sigma>\<^sub>l\<^sub>e UNIV (Pe)
     else lorenz.poincare_mapsto \<Sigma> ((sourcei_of_res res0) \<times> UNIV) \<Sigma>\<^sub>l\<^sub>e UNIV (\<Union>P)) \<and>
     source_of_res res0 \<subseteq> plane_of (Sctn (0, 0, 1) 27) \<and>
     (every \<longrightarrow>
     (\<forall>x\<in>P. \<exists>P em. em > 0 \<and> (\<exists>eM. x = scaleR2 em eM P) \<and>
                    (\<exists>Rivls. fst ` P \<subseteq> \<Union>Rivls \<and>
                             (\<forall>Rivl\<in>Rivls.
                                 \<exists>res\<in>return_of_res results res0.
                                    Rivl \<subseteq> source_of_res res \<and> (c1 \<longrightarrow> c1_entry_correct em P res0 res))))))"
   if [refine_vcg]: NF
   unfolding check_line_nres_def sourcei_of_res_def
   apply (refine_vcg, clarsimp_all)
   using [[goals_limit=1]]
   subgoal for a0 a b c d e f g h i j k l m n p q r s t
     apply (rule exI[where x=i])
     apply (rule exI[where x=j])
     apply (rule conjI)
      apply force
     apply (rule conjI)
     apply (rule exI[where x=k])
      apply force
     apply (rule exI[where x=s])
     apply (rule conjI) defer apply force
     apply blast
     done
   subgoal for x0 y0 z0 x1 y1 z1 tangents s R every
     apply (rule exI[where x=R])
     apply auto
     subgoal for tans
       apply (rule exI[where x=tans])
       by auto
     subgoal for tans
       apply (rule exI[where x=tans])
       by auto
     done
   done
 
 definition "print_sets_color (print_fun::String.literal \<Rightarrow> unit) (c::string) (X::'a::executable_euclidean_space set) = ()"
 
 definition "print_lorenz_color print_fun cx cy cz ci cd1 cd2 P = ()"
 
 definition "print_aforms print_fun c aforms =
   fold (\<lambda>a _.  print_fun (String.implode (shows_segments_of_aform 0 1 a c ''\<newline>''))) aforms ()"
 
 lemma print_sets_color_impl[autoref_rules]: includes autoref_syntax shows
   "(\<lambda>print_fun c X. print_aforms print_fun c X, print_sets_color) \<in>
     (Id \<rightarrow> unit_rel) \<rightarrow> string_rel \<rightarrow> clw_rel aform.appr_rel \<rightarrow> unit_rel"
   by auto
 
 lemma print_lorenz_color_impl[autoref_rules]: includes autoref_syntax shows
   "(\<lambda>print_fun cx cy cz ci cd1 cd2 P.
     fold (\<lambda>(_, x) b.
         print_lorenz_aform print_fun
           cx cy cz ci cd1 cd2
           False
           (fst x @ the_default [] (snd x))
         ) P (), print_lorenz_color) \<in>
     (Id \<rightarrow> unit_rel) \<rightarrow> string_rel \<rightarrow> string_rel \<rightarrow> string_rel \<rightarrow> string_rel \<rightarrow>
     \<langle>\<langle>string_rel\<rangle>list_rel, \<langle>\<langle>string_rel\<rangle>list_rel, (\<langle>clw_rel aform.appr1e_rel, unit_rel\<rangle>fun_rel)\<rangle>fun_rel\<rangle>fun_rel"
   by auto
 
 definition check_line_core where
  "check_line_core print_funo m0 n0 c1 i =
   do {
       let print_fun = the_default (\<lambda>_. ()) print_funo;
       CHECK (\<lambda>_. print_fun (STR ''Hey, out of bounds!'')) (i < length results);
       let res = ((results:::\<langle>Id\<rangle>list_rel) ! (i:::nat_rel));
       (r, P, B) \<leftarrow> check_line_nres print_funo m0 n0 c1 res;
       let _ = print_sets_color print_fun (ST ''0x007f00'') (aform.sets_of_ivls B);
       (_, Pu) \<leftarrow> scaleR2_rep_coll P;
       let _ = print_sets_color print_fun (ST ''0x7f0000'')
           (aform.op_image_fst_coll (Pu:::clw_rel aform.appr1_rel):::clw_rel aform.appr_rel);
       let _ = print_lorenz_color print_fun
           (ST ''0x7f0000'') (ST ''0x7f0001'') (ST ''0x7f0002'') (ST ''0x7f0003'')
           [(ST ''0xc60000''), (ST ''0xc60000''), (ST ''0xc60000'')]
           [(ST ''0xf60000''), (ST ''0xf60000''), (ST ''0xf60000'')]
           P;
       let _ = (if r
         then print_fun
           (String.implode ((show (ST ''# VERIFIED '') @ show i @ show (ST ''\<newline>''))))
         else print_fun (String.implode ((show (ST ''# Failed to verify '') @ show i @ show (ST ''\<newline>'')) )));
       RETURN r
     }"
 lemma [autoref_rules]: includes autoref_syntax shows
   "(shows_prec, shows_prec) \<in> nat_rel \<rightarrow> nat_rel \<rightarrow> string_rel \<rightarrow> string_rel"
   "(shows_prec, shows_prec) \<in> nat_rel \<rightarrow> string_rel \<rightarrow> string_rel \<rightarrow> string_rel"
   "(String.implode, String.implode) \<in> string_rel \<rightarrow> Id"
   by (auto simp: string_rel_def)
 schematic_goal check_line_core_impl:
   includes autoref_syntax
   assumes [autoref_rules]: "(pfi, pf) \<in> \<langle>Id \<rightarrow> unit_rel\<rangle>option_rel"
     "(c1i, c1) \<in> bool_rel" "(ii, i) \<in> nat_rel"
     "(m0i, m0) \<in> \<langle>nat_rel\<rangle>option_rel" "(n0i, n0) \<in> \<langle>nat_rel\<rangle>option_rel"
   shows "(nres_of ?f, check_line_core $ pf $ m0 $ n0 $ c1 $ i) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding check_line_core_def
   including art
   by autoref_monadic
 concrete_definition check_line_core_impl for pfi m0i n0i c1i ii uses check_line_core_impl
 lemmas [autoref_rules] = check_line_core_impl.refine
 
 definition "c1i_of_res res = sourcei_of_res res \<times> conefield_of_res res"
 
 definition "correct_res res =
   ((\<forall>(x, dx) \<in> c1i_of_res res.
     x \<in> plane_of (Sctn (0, 0, 1) 27) \<and>
     dx \<in> plane_of (Sctn (0, 0, 1) 0) \<and>
     ((lorenz.returns_to \<Sigma> x \<and>
       lorenz.return_time \<Sigma> differentiable at x within \<Sigma>\<^sub>l\<^sub>e \<and>
       (\<exists>D. (lorenz.poincare_map \<Sigma> has_derivative D) (at x within \<Sigma>\<^sub>l\<^sub>e) \<and>
            norm (D dx) \<ge> expansion res * norm dx \<and>
            (\<exists>res2 \<in> return_of_res results res.
               (lorenz.poincare_map \<Sigma> x, D dx) \<in> c1_of_res res2 \<and>
               norm (D dx) \<ge> preexpansion res2 * norm dx))))))"
 
 lemma check_line_nres_c0_correct:
   "check_line_nres pf m0 n0 c1 res \<le> SPEC (\<lambda>(every, Pe, RET). every \<longrightarrow>
     (\<forall>x \<in> sourcei_of_res res. lorenz.poincare_map \<Sigma> x \<in> \<Union>(source_of_res ` return_of_res results res)))"
   if NF
   apply (rule check_line_nres[OF \<open>NF\<close>, le])
   apply (auto simp: c1i_of_res_def lorenz.poincare_mapsto_def)
   subgoal
     apply (drule bspec, force)
     apply (auto dest!: spec[where x="1\<^sub>L"])
     apply (drule bspec, force)
     apply (force simp: scaleR2_def image_def vimage_def)
     done
   subgoal premises prems for a b c d e tans
   proof -
     obtain t where
       "((c, d, e), t) \<in> tans  - \<Gamma>\<^sub>i (invoke_nf res) \<times> UNIV"
       "((c, d, e), tangent_of_deg (min_deg res)) = (\<lambda>(x, y). (x, blinfun_apply y (1, 0, 0))) ((c, d, e), t)"
       using prems
       by (auto simp: sourcei_of_res_def)
     with prems(6)[rule_format, of "((c, d, e), t)"] prems(3)
     obtain D x where "tangent_of_deg (min_deg res) = blinfun_apply t (1, 0, 0)"
       "(c, d, e) returns_to \<Sigma>"
       "fst ` (tans - \<Gamma>\<^sub>i (invoke_nf res) \<times> UNIV) \<subseteq> \<Sigma>\<^sub>l\<^sub>e"
       "lorenz.return_time \<Sigma> differentiable at (c, d, e) within \<Sigma>\<^sub>l\<^sub>e"
       "(lorenz.poincare_map \<Sigma> has_derivative blinfun_apply D) (at (c, d, e) within \<Sigma>\<^sub>l\<^sub>e)"
       "x \<in> b" "(lorenz.poincare_map \<Sigma> (c, d, e), D o\<^sub>L t) \<in> x"
       by auto
     with prems
     show ?thesis
       subgoal
         apply (auto dest!: bspec[OF _ \<open>x \<in> b\<close>])
         apply (auto simp: scaleR2_def image_def vimage_def)
         apply (auto simp: subset_iff)
         by fastforce \<comment>\<open>slow\<close>
       done
   qed
   subgoal for a b c d e f
     apply (drule bspec[where A="sourcei_of_res res"]) apply force
     apply (auto dest!: spec[where x="1\<^sub>L"])
     apply (drule bspec, force)
     apply auto
     apply (auto simp: scaleR2_def image_def vimage_def)
     apply (auto simp: subset_iff)
     by fastforce\<comment> \<open>slow\<close>
   done
 
 lemma cone_conefield[intro, simp]: "cone (conefield a b)"
   unfolding conefield_alt_def
   by (rule cone_cone_hull)
 
 lemma in_segment_norm_bound: "c \<in> {a -- b} \<Longrightarrow> norm c \<le> max (norm a) (norm b)"
   apply (auto simp: in_segment max_def intro!: norm_triangle_le)
    apply (auto simp: algebra_simps intro: add_mono mult_left_mono
       mult_right_mono)
   using affine_ineq by blast
 
 lemma norm_tangent_of_deg[simp]: "norm (tangent_of_deg d) = 1"
   by (auto simp: tangent_of_deg_def norm_prod_def)
 
 lemma check_line_nres_c1_correct:
   "check_line_nres pf m0 n0 True res \<le> SPEC (\<lambda>(correct, Pe, RET). correct \<longrightarrow> correct_res res)"
   if NF
 proof (rule check_line_nres[OF \<open>NF\<close>, le], clarsimp, goal_cases)
   case P: (1 a P tans)
   let ?tans = "{tangent_of_deg (min_deg res)--tangent_of_deg (max_deg res)}"
   have tans_plane: "?tans \<subseteq> UNIV \<times> UNIV \<times> {0}"
     by (auto simp: in_segment tangent_of_deg_def)
   from P have *: "x \<in> plane_of (Sctn (0, 0, 1) 27)" if "x \<in> sourcei_of_res res" for x
     using that
     by (auto simp: that sourcei_of_res_def)
   from tans_plane P have **: "dx \<in> plane_of (Sctn (0, 0, 1) 0)"
     if "x \<in> sourcei_of_res res" "dx \<in> conefield_of_res res" for x dx
   proof -
     from tans_plane that obtain c dx' dy' where
       c: "dx = c *\<^sub>R (dx', dy', 0)" "(dx', dy', 0) \<in> ?tans" "c \<ge> 0"
       unfolding conefield_of_res_def conefield_alt_def cone_hull_expl
       by auto
     then show ?thesis by (auto simp: plane_of_def)
   qed
   show ?case
     unfolding correct_res_def
   proof (intro ballI conjI, clarsimp_all simp add:
       * ** c1i_of_res_def c1_of_res_def sourcei_of_res_def, goal_cases)
     case source: (1 x y z dx dy dz)
     from tans_plane source obtain c dx' dy' where
       c: "(dx, dy, dz) = c *\<^sub>R (dx', dy', 0)" "(dx', dy', 0) \<in> ?tans" "c \<ge> 0"
       unfolding conefield_of_res_def conefield_alt_def cone_hull_expl
       by auto
     from c source P
     obtain t where tans: "((x, y, z), t) \<in> tans" "blinfun_apply t (1, 0, 0) = (dx', dy', 0)"
       by auto 
     from P(3) tans(1) source(3) obtain Re D where Re:
       "(x, y, z) returns_to \<Sigma>" "fst ` (tans - \<Gamma>\<^sub>i (invoke_nf res) \<times> UNIV) \<subseteq> \<Sigma>\<^sub>l\<^sub>e"
       "lorenz.return_time \<Sigma> differentiable at (x, y, z) within \<Sigma>\<^sub>l\<^sub>e"
       "(lorenz.poincare_map \<Sigma> has_derivative blinfun_apply D) (at (x, y, z) within \<Sigma>\<^sub>l\<^sub>e)"
       "Re \<in> P" "(lorenz.poincare_map \<Sigma> (x, y, z), D o\<^sub>L t) \<in> Re"
       by (auto simp: lorenz.poincare_mapsto_def dest!: bspec)
     from P(5)[rule_format, OF \<open>Re \<in> P\<close>]
     obtain R em eM Rivls
       where R: "Re = scaleR2 em eM R"
         "em > 0"
         "fst ` R \<subseteq> \<Union>Rivls"
         "\<And>Rivl. Rivl\<in>Rivls \<Longrightarrow>
           \<exists>resa\<in>return_of_res results res. Rivl \<subseteq> source_of_res resa \<and> c1_entry_correct em R res resa"
       by auto
     have "lorenz.poincare_map \<Sigma> (x, y, z) \<in> fst ` R"
       and s2: "(lorenz.poincare_map \<Sigma> (x, y, z), D o\<^sub>L t) \<in> scaleR2 em eM R"
       using Re R by (auto simp: scaleR2_def)
     then obtain Rivl res' where Rivl:
       "lorenz.poincare_map \<Sigma> (x, y, z) \<in> Rivl" "Rivl \<in> Rivls"
       "res' \<in> return_of_res results res" "Rivl \<subseteq> source_of_res res'"
       and c1: "c1_entry_correct em R res res'"
       using R
       by force
     from s2 obtain ed Dt where Dt:
       "em \<le> ereal ed" "ereal ed \<le> eM" "D o\<^sub>L t = ed *\<^sub>R Dt"
       "(lorenz.poincare_map \<Sigma> (x, y, z), Dt) \<in> R"
       by (force simp: scaleR2_def)
     then have Dt_simp[simp]: "Dt = inverse ed *\<^sub>R (D o\<^sub>L t)"
       using \<open>0 < em\<close>
       by (cases em) (auto simp: intro!:  simp: blinfun.bilinear_simps inverse_eq_divide)
     from c1[unfolded c1_entry_correct_def, rule_format, OF Dt(4)]
     obtain dxr dyr where dxrdyr: "blinfun_apply D (dx', dy', 0) /\<^sub>R ed = (dxr, dyr, 0)"
       "ereal (preexpansion res') \<le> em * ereal (norm (dxr, dyr, 0::real))"
       "ereal (expansion res) \<le> em * ereal (norm (dxr, dyr, 0::real))"
       "-90 < min_deg res'" "min_deg res' \<le> max_deg res'"
       "tan (rad_of (min_deg res')) \<le> (dyr / dxr)"
       "(dyr / dxr) \<le> tan (rad_of (max_deg res'))"
       "max_deg res' < 90"
       "0 < dxr"
       by (auto simp: blinfun.bilinear_simps tans)
 
     then obtain emr where emr: "em = ereal emr" "0 < emr" "emr \<le> ed"
       "(preexpansion res') \<le> emr * (norm (dxr, dyr, 0::real))"
       "(expansion res) \<le> emr * (norm (dxr, dyr, 0::real))"
       using \<open>0 < em\<close> Dt
       by (cases em) (auto simp: simp: blinfun.bilinear_simps divide_simps prod_eq_iff)
     from dxrdyr have Ddx'dy': "D (dx', dy', 0) = ed *\<^sub>R (dxr, dyr, 0)"
       using \<open>0 < em\<close> Dt
       by (cases em) (auto simp: simp: blinfun.bilinear_simps divide_simps prod_eq_iff)
 
     note \<open>(x, y, z) returns_to \<Sigma>\<close>
     moreover note \<open>lorenz.return_time \<Sigma> differentiable at (x, y, z) within \<Sigma>\<^sub>l\<^sub>e\<close>
     moreover note \<open>(lorenz.poincare_map \<Sigma> has_derivative D) (at (x, y, z) within \<Sigma>\<^sub>l\<^sub>e)\<close>
     moreover note \<open>res' \<in> return_of_res results res\<close>
     moreover have "lorenz.poincare_map \<Sigma> (x, y, z) \<in> source_of_res res'"
       using Rivl by force
     moreover
     have \<open>0 \<le> ed\<close> using Dt \<open>0 < em\<close> by (cases em) auto
     have \<open>D (dx, dy, dz) \<in> conefield_of_res res'\<close>
       unfolding c blinfun.bilinear_simps conefield_of_res_def Ddx'dy'
       apply (intro mem_cone, simp_all add: \<open>0 \<le> ed\<close> \<open>0 \<le> c\<close> tangent_of_deg_def)
       apply (rule conefield_prod3I)
       unfolding fun_cong[OF tan_def, symmetric]
       subgoal by fact
       subgoal using dxrdyr
         apply (intro cos_gt_zero_pi)
         unfolding rad_of_lt_iff rad_of_gt_iff
         by (auto simp: deg_of_def)
       subgoal using dxrdyr
         apply (intro cos_gt_zero_pi)
         unfolding rad_of_lt_iff rad_of_gt_iff
         by (auto simp: deg_of_def)
       subgoal by fact
       subgoal by fact
       done
     moreover
     have norms_le: "emr * norm (dx', dy', 0::real) * (\<bar>c\<bar> * norm (dxr, dyr, 0::real)) \<le> \<bar>ed\<bar> * (\<bar>c\<bar> * norm (dxr, dyr, 0::real))"
     proof -
       from c(2)[THEN in_segment_norm_bound] have "norm (dx', dy', 0::real) \<le> 1"
         by auto
       also have "\<dots> \<le> ed / emr"
         using dxrdyr emr
         unfolding Ddx'dy'
         by auto
       finally show ?thesis
         using emr
         by (intro mult_right_mono) (auto simp: divide_simps ac_simps)
     qed
     then have "expansion res * norm (dx, dy, dz) \<le> norm (D (dx, dy, dz))"
       unfolding c blinfun.bilinear_simps conefield_of_res_def Ddx'dy' norm_scaleR
       apply -
       apply (rule order_trans)
        apply (rule mult_right_mono)
         apply (rule emr)
       by (auto simp: ac_simps)
     moreover have "preexpansion res' * norm (dx, dy, dz) \<le> norm (D (dx, dy, dz))"
       using norms_le
       unfolding c blinfun.bilinear_simps conefield_of_res_def Ddx'dy' norm_scaleR
       apply -
       apply (rule order_trans)
        apply (rule mult_right_mono)
         apply (rule emr)
       by (auto simp: ac_simps)
     ultimately
     show ?case
       by blast
   qed
 qed
 
 lemma conefield_ne_empyt[simp]: "conefield a b \<noteq> {}"
   by (auto simp: conefield_def conesegment_def cone_hull_empty_iff[symmetric])
 
 lemma in_return_of_resD: "res' \<in> return_of_res results res \<Longrightarrow> res' \<in> set results"
   by (auto simp: return_of_res_def get_results_def)
 lemma finite_results_at[intro, simp]: "finite (results_at x)"
   by (auto simp: results_at_def)
 
 
 lemma lorenz_bounds_lemma:
   "x returns_to \<Sigma>"
   "R x \<in> N"
   "(R has_derivative DR x) (at x within \<Sigma>\<^sub>l\<^sub>e)"
   "\<And>c. c \<in> \<CC> x \<Longrightarrow> DR x c \<in> \<CC> (R x)"
   "\<And>c. c \<in> \<CC> x \<Longrightarrow> norm (DR x c) \<ge> \<E> x      * norm c"
   "\<And>c. c \<in> \<CC> x \<Longrightarrow> norm (DR x c) \<ge> \<E>\<^sub>p (R x) * norm c"
   if "x \<in> N - \<Gamma>" NF "\<And>res. res \<in> set results \<Longrightarrow> correct_res res"
 proof -
   from \<open>x \<in> N - \<Gamma>\<close> obtain res where res: "res \<in> set results" "x \<in> sourcei_of_res res"
     by (auto simp: N_def sourcei_of_res_def \<Gamma>\<^sub>i_def)
   then have ne: "c1i_of_res res \<noteq> {}"
     by (auto simp: c1i_of_res_def conefield_of_res_def)
   from res this obtain dx where dx: "(x, dx) \<in> c1i_of_res res"
     by (auto simp: c1i_of_res_def)
   from that(3)[OF \<open>res \<in> set _\<close>] have "correct_res res" by simp
   from this[unfolded correct_res_def, rule_format, OF dx] res
   obtain res' D where res': "x returns_to \<Sigma>"
     "lorenz.return_time \<Sigma> differentiable at x within \<Sigma>\<^sub>l\<^sub>e"
     "(lorenz.poincare_map \<Sigma> has_derivative D) (at x within \<Sigma>\<^sub>l\<^sub>e)"
     "expansion res * norm dx \<le> norm (D dx)"
     "res' \<in> return_of_res results res"
     "(lorenz.poincare_map \<Sigma> x, D dx) \<in> c1_of_res res'"
     "preexpansion res' * norm dx \<le> norm (D dx)"
     by auto
   show "x returns_to \<Sigma>" by fact
   show "R x \<in> N" using res'
     by (auto simp: R_def N_def N_def c1i_of_res_def c1_of_res_def in_return_of_resD
         sourcei_of_res_def)
   show "(R has_derivative DR x) (at x within \<Sigma>\<^sub>l\<^sub>e)"
     apply (auto simp: R_def DR_def N_def c1_of_res_def in_return_of_resD)
     apply (subst frechet_derivative_works[symmetric])
     apply (rule differentiableI)
     by fact
 next
   fix dx assume "dx \<in> \<CC> x"
   then obtain res where res: "res \<in> set results" and dx: "(x, dx) \<in> c1_of_res res"
     by (auto simp: \<CC>_def results_at_def c1_of_res_def )
   then have dx: "(x, dx) \<in> c1i_of_res res"
     using \<open>x \<in> N - _\<close>
     by (auto simp: c1i_of_res_def sourcei_of_res_def c1_of_res_def \<Gamma>\<^sub>i_def)
   from res dx have ne: "c1i_of_res res \<noteq> {}"
     by (auto simp: c1_of_res_def conefield_of_res_def)
   from that(3)[OF \<open>res \<in> set _\<close>] have "correct_res res" by simp
   from that this[unfolded correct_res_def, rule_format, OF dx] res
   obtain res' D where res': "x returns_to \<Sigma>" "x \<in> plane_of (Sctn (0, 0, 1) 27)"
     "lorenz.return_time \<Sigma> differentiable at x within \<Sigma>\<^sub>l\<^sub>e"
     "(lorenz.poincare_map \<Sigma> has_derivative D) (at x within \<Sigma>\<^sub>l\<^sub>e)"
     "expansion res * norm dx \<le> norm (D dx)"
     "res' \<in> return_of_res results res"
     "(lorenz.poincare_map \<Sigma> x, D dx) \<in> c1_of_res res'"
     "preexpansion res' * norm dx \<le> norm (D dx)"
     by auto
   have DRD: "DR x = D"
     unfolding DR_def
     apply (rule frechet_derivative_unique_within)
       apply (subst frechet_derivative_works[symmetric])
       apply (rule differentiableI)
       apply fact
      apply fact using \<open>x \<in> plane_of _\<close>
     apply safe
     subgoal for _ _ _ e
       by (auto simp: \<Sigma>\<^sub>l\<^sub>e_def Basis_prod_def prod_eq_iff plane_of_def prod_eq_iff
           inner_prod_def intro!: exI[where x="-e/2"])
     done
   have [intro, simp]: "res' \<in> results_at (lorenz.poincare_map \<Sigma> x)"
     using res'
     by (auto simp: c1_of_res_def results_at_def in_return_of_resD R_def
         intro!: exI[where x=res'])
   have [intro, simp]: "res \<in> results_at x"
     using res dx
     by (auto simp: c1i_of_res_def results_at_def sourcei_of_res_def)
   show "DR x dx \<in> \<CC> (R x)"
     unfolding DRD \<CC>_def
     using res'
     by (auto simp: c1_of_res_def R_def)
   have "\<E> x * norm dx \<le> expansion res * norm dx"
     by (rule mult_right_mono) (auto simp: \<E>_def)
   also have "\<dots> \<le> norm (DR x dx)" unfolding DRD by fact
   finally show "\<E> x * norm dx \<le> norm (DR x dx)" .
 
   have "\<E>\<^sub>p (R x) * norm dx \<le> preexpansion res' * norm dx"
     by (rule mult_right_mono) (auto simp: \<E>\<^sub>p_def R_def)
   also have "\<dots> \<le> norm (DR x dx)" unfolding DRD by fact
   finally show "\<E>\<^sub>p (R x) * norm dx \<le> norm (DR x dx)" .
 qed
 
 
 lemma check_line_core_correct:
   "check_line_core pf m0 n0 True i \<le> SPEC (\<lambda>correct. correct \<longrightarrow> correct_res (results ! i))"
   if [refine_vcg]: NF
   unfolding check_line_core_def
   supply [refine_vcg] = check_line_nres_c1_correct[le]
   by refine_vcg
 
 
 text \<open>The symmetric reduction\<close>
 
 lemma source_of_res_mirror: "(x, y, z) \<in> source_of_res (mirror_result res) \<longleftrightarrow>
     (-x, -y, z) \<in> source_of_res res"
   by (cases res)
      (auto simp: source_of_res_def ivl_of_res_def ivl_of_resultrect_def set_of_ivl_def)
 
 lemma conefield_of_res_mirror[simp]: "(x, y, z) \<in> conefield_of_res (mirror_result res) \<longleftrightarrow>
     (x, y, z) \<in> conefield_of_res res"
   by (cases res) (auto simp: conefield_of_res_def ivl_of_res_def)
 
 lemma c1_of_res_mirror: "((x, y, z), dx, dy, dz) \<in> c1_of_res (mirror_result res) \<longleftrightarrow>
   ((-x, -y, z), dx, dy, dz) \<in> c1_of_res res"
   by (auto simp: c1_of_res_def source_of_res_mirror)
 
 lemmas [simp] = lorenz_S(2)
 lemma lorenz_S_idem[simp]: "lorenz_S (lorenz_S x) = (x::R3)"
   by (auto simp: lorenz_S_def split_beta')
 lemma lorenz_S_exivl[simp]:
   "lorenz.existence_ivl0 (lorenz_S X) = lorenz.existence_ivl0 X"
   using lorenz_S(1)[of _ X]
   using lorenz_S(1)[of _ "lorenz_S X"]
   by auto
 lemma lorenz_S_zero[simp]: "lorenz_S x = 0 \<longleftrightarrow> (x::R3) = 0"
   by (auto simp: lorenz_S_def split_beta' prod_eq_iff)
 lemma lorenz_S_returns_toI[simp]:
   "x returns_to (lorenz_S ` P) \<Longrightarrow> lorenz_S x returns_to P"
   apply (auto simp: lorenz.returns_to_def)
   subgoal premises prems for t
   proof -
     have " \<forall>\<^sub>F s in at_right 0. s < t"
       using tendsto_ident_at \<open>0 < t\<close>
       by (rule order_tendstoD)
     then have " \<forall>\<^sub>F s in at_right 0. s \<in> lorenz.existence_ivl0 x"
       unfolding eventually_at_filter
       apply eventually_elim
       using \<open>0 < t\<close> lorenz.closed_segment_subset_existence_ivl[OF prems(3)]
       by (auto simp: closed_segment_eq_real_ivl subset_iff)
     then show ?thesis using prems(1)
       by eventually_elim force
   qed
   done
 
 lemma lorenz_S_returns_to[simp]:
   "lorenz_S x returns_to P \<longleftrightarrow> x returns_to (lorenz_S ` P)"
   using lorenz_S_returns_toI[of P x] lorenz_S_returns_toI[of "lorenz_S ` P" "lorenz_S x"]
   by (auto simp: image_image)
 lemma lorenz_S_image_Sigma[simp]: "lorenz_S ` \<Sigma> = \<Sigma>"
   apply (auto simp: \<Sigma>_def lorenz_S_def)
   apply (rule image_eqI)
    apply (rule lorenz_S_idem[symmetric])
   apply (auto simp: \<Sigma>_def lorenz_S_def)
   done
 
 lemma linear_lorenz_S: "linear lorenz_S"
   by unfold_locales (auto simp: lorenz_S_def)
 lemma inj_lorenz_S: "inj_on (lorenz_S::R3 \<Rightarrow> _) G"
   by (rule inj_onI) (auto simp: lorenz_S_def prod_eq_iff)
 
 lemma lorenz_S_return_time:
   "lorenz.return_time P (lorenz_S x) = lorenz.return_time (lorenz_S ` P) x"
   if "x returns_to (lorenz_S ` P)" "closed P"
 proof -
   from lorenz.returns_toE[OF that(1)] obtain t0 t1
     where f: "0 < t0" "t0 \<le> t1" " t1 \<in> lorenz.existence_ivl0 x"
       "lorenz.flow0 x t1 \<in> lorenz_S ` P"
       "\<And>t. 0 < t \<Longrightarrow> t < t0 \<Longrightarrow> lorenz.flow0 x t \<notin> lorenz_S ` P"
     by auto
   have [simp]: "lorenz.return_time (lorenz_S ` P) x \<in> lorenz.existence_ivl0 x"
     by (auto intro!: that closed_injective_linear_image linear_lorenz_S
         lorenz.return_time_exivl
         inj_lorenz_S)
   have c': "closed (lorenz_S ` P)"
     by (auto intro!: that closed_injective_linear_image linear_lorenz_S
         lorenz.return_time_exivl lorenz.return_time_pos
         inj_lorenz_S)
   show ?thesis
     using f(1-4)
     using lorenz.return_time_returns[OF that(1) c']
     apply (intro lorenz.return_time_eqI)
        apply (auto intro!: that closed_injective_linear_image linear_lorenz_S
         lorenz.return_time_exivl lorenz.return_time_pos c'
         inj_lorenz_S)
     subgoal premises prems for a b c d e f g
     proof -
       have [simp]: "a \<in> lorenz.existence_ivl0 x"
         using _ that(1)
         apply (rule lorenz.less_return_time_imp_exivl)
         using prems that(2) c'
         by auto
       have "lorenz.return_time (lorenz_S ` P) x \<le> a"
         apply (rule lorenz.return_time_le)
         using prems
            apply (auto intro!: that closed_injective_linear_image linear_lorenz_S
             lorenz.return_time_exivl lorenz.return_time_pos c'
             inj_lorenz_S)
         apply (rule image_eqI)
          apply (rule lorenz_S_idem[symmetric])
         by auto
       then show ?thesis using prems
         by simp
     qed
     done
 qed
 
 lemma lorenz_S_poincare_map:
   "lorenz.poincare_map P (lorenz_S x) = lorenz_S (lorenz.poincare_map (lorenz_S ` P) x)"
   if "x returns_to (lorenz_S ` P)" "closed P"
   using that
   unfolding lorenz.poincare_map_def
   apply (auto simp: lorenz_S_return_time)
   apply (subst lorenz_S)
    by (auto intro!: lorenz.return_time_exivl that
       closed_injective_linear_image linear_lorenz_S inj_lorenz_S)
 
 lemma [continuous_intros]: "isCont (lorenz_S::_\<Rightarrow>R3) x"
   "continuous_on (G::R3 set) lorenz_S"
   by (auto simp:lorenz_S_def[abs_def] split_beta' continuous_intros)
 
 lemma filtermap_lorenz_S_le: "filtermap lorenz_S (at x within lorenz_S ` P) \<le>(at (lorenz_S x::R3) within P)"\<comment> \<open>TODO: generalize!\<close>
   unfolding at_within_def
   apply (auto simp: intro!: antisym filtermap_inf[le] filtermap_inf[ge])
     apply (rule inf.coboundedI1)
     apply (subst filtermap_nhds_open_map)
     apply (auto simp: intro!: invariance_of_domain inj_lorenz_S continuous_intros)
    apply (rule inf.coboundedI2)
    apply (auto simp: image_image )
   apply (auto simp: lorenz_S_def split_beta')[]
   done
 
 lemma filtermap_lorenz_S_eq: "filtermap lorenz_S (at (x::R3) within lorenz_S ` P) = (at (lorenz_S x::R3) within P)"
   apply (rule antisym)
   using filtermap_lorenz_S_le[of "x" P]
    apply simp
   subgoal
   proof -
     have "filtermap lorenz_S (at (lorenz_S x) within P) \<le>
     filtermap lorenz_S (filtermap lorenz_S  (at x within lorenz_S ` P))"
       using filtermap_lorenz_S_le[of "lorenz_S x" "lorenz_S ` P"]
       by (auto simp: image_image filtermap_filtermap)
     then show ?thesis
       apply (subst (asm) filtermap_mono_strong)
       by (auto simp: inj_lorenz_S)
   qed
   done
 
 lemma norm_lorenz_S[simp]: "norm (lorenz_S x) = norm x"
   by (auto simp: lorenz_S_def norm_prod_def split_beta')
 
 lemma bl_lorenz_S: "bounded_linear (lorenz_S)"
   by unfold_locales (auto simp: lorenz_S_def norm_prod_def intro!: exI[where x=1])
 
 lemma filtermap_lorenz_S_eq_bot[simp]:
   "filtermap (lorenz_S::R3\<Rightarrow>_) F = bot \<longleftrightarrow> F = bot"
   apply (auto simp: )
   apply (subst (asm) filtermap_bot[symmetric])
   apply (subst (asm) filtermap_eq_strong)
   by (auto simp: inj_lorenz_S)
 
 lemma netlimit_filtermap[simp]:
   "at x within X \<noteq> bot \<Longrightarrow> netlimit (filtermap lorenz_S (at x within X)) = lorenz_S (x::R3)"
   apply (rule tendsto_Lim)
   unfolding filterlim_filtermap
    apply simp
   by (auto intro!: tendsto_eq_intros simp: split_beta' lorenz_S_def[abs_def])
 
 lemma lorenz_S_halfspace [simp]: "lorenz_S ` \<Sigma>\<^sub>l\<^sub>e = \<Sigma>\<^sub>l\<^sub>e"
   apply (auto simp: \<Sigma>\<^sub>l\<^sub>e_def lorenz_S_def[abs_def])
   apply (rule image_eqI)
    apply auto
    apply (rule sym)
    apply (rule minus_minus)
   apply (rule minus_minus[symmetric])
   done
 
 lemma closure_Sigma_le_eq: "closure \<Sigma>\<^sub>l\<^sub>e = \<Sigma>\<^sub>l\<^sub>e"
 proof (rule closure_closed)
   have "\<Sigma>\<^sub>l\<^sub>e = {x. x \<bullet> (0, 0, 1) \<le> 27}"
     by (auto simp: \<Sigma>\<^sub>l\<^sub>e_def )
   also have "closed \<dots>"
     by (rule closed_halfspace_component_le)
   finally show "closed \<Sigma>\<^sub>l\<^sub>e" .
 qed
 
 lemma closure_Sigma_le[simp]: "closure (\<Sigma>\<^sub>l\<^sub>e - {x}) = \<Sigma>\<^sub>l\<^sub>e"
 proof (cases "x \<in> \<Sigma>\<^sub>l\<^sub>e")
   case that: True
   have "closure \<Sigma>\<^sub>l\<^sub>e \<subseteq> closure (insert x (\<Sigma>\<^sub>l\<^sub>e - {x}))" by (rule closure_mono) auto
   also have "\<dots> = insert x (closure (\<Sigma>\<^sub>l\<^sub>e - {x}))"
     apply (subst closure_insert) by simp
   also
   have "x \<in> closure (\<Sigma>\<^sub>l\<^sub>e - {x})"
     apply (rule closed_sequentially[where f="\<lambda>n. x - (0, 0, inverse (Suc n))"])
       apply (rule closed_closure)
     subgoal
       apply (auto simp: ) apply (rule subsetD) apply (rule closure_subset)
       using that
       apply (auto simp: \<Sigma>\<^sub>l\<^sub>e_def prod_eq_iff)
       apply (rule order_trans)
        apply (rule diff_right_mono)
        apply (assumption)
       apply simp
       done
     subgoal
       apply (rule tendsto_eq_intros)
         apply (rule tendsto_intros)
         apply (rule tendsto_intros)
         apply (rule tendsto_intros)
         apply (rule tendsto_intros)
         apply (rule tendsto_intros)
       apply (rule LIMSEQ_inverse_real_of_nat)
       by (auto simp: prod_eq_iff)
     done
   then have "insert x (closure (\<Sigma>\<^sub>l\<^sub>e - {x})) \<subseteq> closure (\<Sigma>\<^sub>l\<^sub>e - {x})"
     by auto
   finally have "closure \<Sigma>\<^sub>l\<^sub>e \<subseteq> closure (\<Sigma>\<^sub>l\<^sub>e - {x})" .
   moreover
   have "closure (\<Sigma>\<^sub>l\<^sub>e - {x}) \<subseteq> closure (\<Sigma>\<^sub>l\<^sub>e)"
     by (rule closure_mono) auto
   ultimately have "closure (\<Sigma>\<^sub>l\<^sub>e - {x}) = closure (\<Sigma>\<^sub>l\<^sub>e)"
     by simp
   also have "\<dots> = \<Sigma>\<^sub>l\<^sub>e"
     by (rule closure_Sigma_le_eq)
   finally show ?thesis .
 next
   case False
   then show ?thesis
     apply simp
     apply (rule closure_Sigma_le_eq)
     done
 qed
 
 lemma lorenz_S_return_time_has_derivative:
   assumes "(lorenz.return_time \<Sigma> has_derivative D) (at x within \<Sigma>\<^sub>l\<^sub>e)"
         and "lorenz.returns_to \<Sigma> x" and "x \<in> \<Sigma>\<^sub>l\<^sub>e"
   shows "(lorenz.return_time \<Sigma> has_derivative D o lorenz_S) (at (lorenz_S x) within \<Sigma>\<^sub>l\<^sub>e)"
 proof -
   have [simp]: "\<not>trivial_limit (at x within \<Sigma>\<^sub>l\<^sub>e)"
     unfolding at_within_eq_bot_iff
     using assms
     by simp
   interpret bounded_linear "lorenz_S::R3\<Rightarrow>_" by (rule bl_lorenz_S)
   have "\<forall>\<^sub>F x in at x within \<Sigma>\<^sub>l\<^sub>e. (x::R3) returns_to \<Sigma>"
     by (blast intro: lorenz.eventually_returns_to_continuousI has_derivative_continuous assms)
   then have "\<forall>\<^sub>F y in at x within \<Sigma>\<^sub>l\<^sub>e.
                inverse (norm (y - x)) * (lorenz.return_time \<Sigma> y - lorenz.return_time \<Sigma> x - D (y - x))
              = inverse (norm (lorenz_S y - lorenz_S x)) *
                (lorenz.return_time \<Sigma> (lorenz_S y) - lorenz.return_time \<Sigma> (lorenz_S x) - D (y - x))"
       by eventually_elim (auto simp: lorenz_S_return_time assms diff[symmetric])
   then show ?thesis
     using assms
     apply (subst filtermap_lorenz_S_eq[symmetric])
     apply (auto simp: has_derivative_def filterlim_filtermap)
     unfolding o_def
      apply (rule bounded_linear_compose, assumption, rule bl_lorenz_S)
     unfolding diff lorenz_S_idem
      apply (auto simp: Lim_ident_at)
     apply (blast intro: Lim_transform_eventually)
     done
 qed
 
 lemma lorenz_S_return_time_differentiable:
   "lorenz.return_time \<Sigma> differentiable at (lorenz_S x) within \<Sigma>\<^sub>l\<^sub>e"
   if "lorenz.return_time \<Sigma> differentiable at x within \<Sigma>\<^sub>l\<^sub>e"
     "lorenz.returns_to \<Sigma> x" "x \<in> \<Sigma>\<^sub>l\<^sub>e"
 proof -
   from that obtain D where "(lorenz.return_time \<Sigma> has_derivative D) (at x within \<Sigma>\<^sub>l\<^sub>e)"
     by (auto simp: differentiable_def)
   then have "(lorenz.return_time \<Sigma> has_derivative D o lorenz_S) (at (lorenz_S x) within \<Sigma>\<^sub>l\<^sub>e)"
     by (rule lorenz_S_return_time_has_derivative) fact+
   then show ?thesis
     by (auto simp: differentiable_def)
 qed
 
 lemma lorenz_S_has_derivative:
   "(lorenz_S has_derivative lorenz_S) (at (x::R3) within X)"
   by (auto simp: lorenz_S_def[abs_def] split_beta' intro!: derivative_eq_intros)
 
 lemma lorenz_S_poincare_map_has_derivative:
   assumes "(lorenz.poincare_map \<Sigma> has_derivative D) (at x within \<Sigma>\<^sub>l\<^sub>e)"
     "(lorenz.return_time \<Sigma> has_derivative Dr) (at x within \<Sigma>\<^sub>l\<^sub>e)"
     "lorenz.returns_to \<Sigma> x" "x \<in> \<Sigma>\<^sub>l\<^sub>e"
   shows "(lorenz.poincare_map \<Sigma> has_derivative lorenz_S o D o lorenz_S) (at (lorenz_S x) within \<Sigma>\<^sub>l\<^sub>e)"
 proof -
   have [simp]: "\<not>trivial_limit (at x within \<Sigma>\<^sub>l\<^sub>e)"
     unfolding at_within_eq_bot_iff
     using assms
     by simp
   interpret bounded_linear "lorenz_S::R3\<Rightarrow>_" by (rule bl_lorenz_S)
   have "\<forall>\<^sub>F x in at x within \<Sigma>\<^sub>l\<^sub>e. (x::R3) returns_to \<Sigma>"
     by (blast intro: lorenz.eventually_returns_to_continuousI has_derivative_continuous assms)
   then have "\<forall>\<^sub>F y in at x within \<Sigma>\<^sub>l\<^sub>e.
                  (lorenz_S (lorenz.poincare_map \<Sigma> y) - lorenz_S (lorenz.poincare_map \<Sigma> x) - lorenz_S (D (y - x))) /\<^sub>R
                  norm (y - x) 
                = (lorenz.poincare_map \<Sigma> (lorenz_S y) - lorenz.poincare_map \<Sigma> (lorenz_S x) - lorenz_S (D (y - x))) /\<^sub>R
                  norm (lorenz_S y - lorenz_S x)"
     by eventually_elim (auto simp: lorenz_S_return_time lorenz_S_poincare_map assms diff[symmetric])
   then show ?thesis
     using has_derivative_compose[OF assms(1) lorenz_S_has_derivative] assms
     apply (subst filtermap_lorenz_S_eq[symmetric])
     apply (auto simp: has_derivative_def filterlim_filtermap)
     unfolding o_def
      apply (rule bounded_linear_compose, rule bl_lorenz_S)
      apply (rule bounded_linear_compose, assumption, rule bl_lorenz_S)
     unfolding diff lorenz_S_idem
      apply (auto simp: Lim_ident_at)
     apply (blast intro: Lim_transform_eventually)
     done
 qed
 
 lemma [simp]: "expansion (mirror_result res) = expansion res"
   by (cases res) auto
 
 lemma lorenz_S_on_plane: "lorenz_S (dx, dy, 0::real) = - (dx, dy, 0)"
   by (auto simp: lorenz_S_def )
 
 lemma mirror_result_idem[simp]: "mirror_result (mirror_result x) = x"
   by (cases x) (auto simp: mirror_result_def)
 
 lemma mirror_in_set: "x \<in> set results \<Longrightarrow> mirror_result x \<in> set results"
   by (auto simp: results_def symmetrize_def)
 
 lemma mirror_result_in:
   "mirror_result res2 \<in> return_of_res results (mirror_result res)"
   if "res2 \<in> return_of_res results res"
 proof -
   from that have "res2 \<in> set results" by (rule in_return_of_resD)
   from mirror_in_set[OF this] have "mirror_result res2 \<in> set results" .
   then show ?thesis
     apply (cases res2; cases res)
     using that
     by (auto simp: return_of_res_def get_results_def)
 qed
 
 lemma in_source_of_res_mirrorI:
   "(x::R3) \<in> source_of_res (mirror_result (r))" if "lorenz_S x \<in> source_of_res r"
   using that
   apply (cases r; cases x)
   by (auto simp: source_of_res_def set_of_ivl_def ivl_of_res_def lorenz_S_def
       less_eq_prod_def ivl_of_resultrect_def)
 
 lemma conefield_of_res_mirror_simp[simp]: "conefield_of_res (mirror_result res2) = conefield_of_res res2"
   by (cases res2) (auto simp: conefield_of_res_def)
 
 lemma lorenz_minus_planeI: "lorenz_S (- x) = x" if "snd (snd (x::R3)) = 0"
   using that
   by (auto simp: lorenz_S_def split_beta' prod_eq_iff)
 
 lemma preexpansion_mirror_result[simp]: "preexpansion (mirror_result res2) = preexpansion res2"
   by (cases res2) (auto simp: )
 
 lemma lorenz_S_tendsto_0I: "(lorenz.flow0 (lorenz_S x) \<longlongrightarrow> 0) at_top"
   if "{0..} \<subseteq> lorenz.existence_ivl0 x" "(lorenz.flow0 x \<longlongrightarrow> 0) at_top"
 proof (rule Lim_transform_eventually)
   have "\<forall>\<^sub>F s in at_top. (s::real) \<ge> 0"
     using eventually_ge_at_top by blast
   then show "\<forall>\<^sub>F s in at_top. lorenz_S (lorenz.flow0 x s) = lorenz.flow0 (lorenz_S x) s"
     by eventually_elim (use that in auto)
   show "((\<lambda>s. lorenz_S (lorenz.flow0 x s)) \<longlongrightarrow> 0) at_top"
     unfolding Zfun_def[symmetric] by (rule bounded_linear.tendsto_zero[OF bl_lorenz_S that(2)])
 qed
 
 lemma lorenz_S_tendsto_0_iff:
   "(lorenz.flow0 (lorenz_S x) \<longlongrightarrow> 0) at_top \<longleftrightarrow> (lorenz.flow0 x \<longlongrightarrow> 0) at_top"
   if "{0..} \<subseteq> lorenz.existence_ivl0 x"
   using lorenz_S_tendsto_0I[of x, OF that] lorenz_S_tendsto_0I[of "lorenz_S x"] that
   by auto
 
 lemma lorenz_S_eq_iff[simp]: "lorenz_S y = lorenz_S x \<longleftrightarrow> y = x" for x y::"real*real*real"
   by (auto simp: lorenz_S_def split: prod.splits)
 
 lemma lorenz_S_\<Gamma>: "lorenz_S x \<in> \<Gamma> \<longleftrightarrow> x \<in> \<Gamma>"
   apply (auto simp: \<Gamma>_def lorenz_S_tendsto_0_iff )
   subgoal for t
     apply (auto simp: dest!: spec[where x=t])
     apply (subst (asm) lorenz_S) apply auto
     apply (subst (asm) (2) lorenz_S_image_Sigma[symmetric])
     by (simp del: lorenz_S_image_Sigma)
   subgoal for t
     apply (auto simp: dest!: spec[where x=t])
     apply (subst (asm) lorenz_S) apply auto
     apply (subst (asm) lorenz_S_image_Sigma[symmetric])
     apply (auto simp del: lorenz_S_image_Sigma)
     done
   done
 
 lemma sourcei_of_res_mirror: "(x, y, z) \<in> sourcei_of_res (mirror_result res) \<longleftrightarrow>
     (-x, -y, z) \<in> sourcei_of_res res"
   using lorenz_S_\<Gamma>[of "(x, y, z)"]
   by (cases res)
      (auto simp: source_of_res_def sourcei_of_res_def ivl_of_res_def ivl_of_resultrect_def
        set_of_ivl_def \<Gamma>\<^sub>i_def lorenz_S_def)
 
 lemma c1i_of_res_mirror: "((x, y, z), dx, dy, dz) \<in> c1i_of_res (mirror_result res) \<longleftrightarrow>
   ((-x, -y, z), dx, dy, dz) \<in> c1i_of_res res"
   by (auto simp: c1i_of_res_def sourcei_of_res_mirror)
 
 lemma correct_res_mirror_result:
   "correct_res (mirror_result res)" if "correct_res res"
   unfolding correct_res_def
 proof (clarsimp simp add: c1i_of_res_mirror, goal_cases)
   case (1 x y z dx dy dz)
   then have 1: "(lorenz_S (x, y, z), dx, dy, dz) \<in> c1i_of_res res"
     by (auto simp: lorenz_S_def)
   from that[unfolded correct_res_def, rule_format, OF 1, simplified]
   have "(lorenz_S (x, y, z)) \<in> plane_of (Sctn (0, 0, 1) 27)"
     "(dx, dy, dz) \<in> plane_of (Sctn (0, 0, 1) 0)"
     by auto
   then have plane: "(x, y, z) \<in> plane_of (Sctn (0, 0, 1) 27)"
     "(dx, dy, dz) \<in> plane_of (Sctn (0, 0, 1) 0)"
     by (auto simp: plane_of_def lorenz_S_def)
   then show ?case
   proof (clarsimp, goal_cases)
     case mem: 1
     with that[unfolded correct_res_def, rule_format, OF 1, simplified]
     obtain D res2 where D:
       "lorenz_S (x, y, z) returns_to \<Sigma>"
       "lorenz.return_time \<Sigma> differentiable at (lorenz_S (x, y, z)) within \<Sigma>\<^sub>l\<^sub>e"
       "(lorenz.poincare_map \<Sigma> has_derivative D) (at (lorenz_S (x, y, z)) within \<Sigma>\<^sub>l\<^sub>e)"
       "expansion res * norm (dx, dy, dz) \<le> norm (D (dx, dy, dz))"
       "res2 \<in> return_of_res results res"
       "(lorenz.poincare_map \<Sigma> (lorenz_S (x, y, z)), D (dx, dy, dz)) \<in> c1_of_res res2"
       "preexpansion res2 * norm (dx, dy, dz) \<le> norm (D (dx, dy, dz))"
       by auto
     from plane have S_le: "lorenz_S (x, y, z) \<in> \<Sigma>\<^sub>l\<^sub>e"
       by (auto simp: \<Sigma>\<^sub>l\<^sub>e_def plane_of_def lorenz_S_def)
     interpret linear D by (rule has_derivative_linear; fact)
 
     have ret: "(x, y, z) returns_to \<Sigma>" using D(1) lorenz_S_returns_to by simp
     moreover have "lorenz.return_time \<Sigma> differentiable at (x, y, z) within \<Sigma>\<^sub>l\<^sub>e"
       using lorenz_S_return_time_differentiable[OF D(2) D(1) S_le] by auto
     moreover from D obtain Dr where Dr: "(lorenz.return_time \<Sigma> has_derivative Dr) (at (lorenz_S (x, y, z)) within \<Sigma>\<^sub>l\<^sub>e)"
       by (auto simp: differentiable_def)
     let ?D = "lorenz_S \<circ> D \<circ> lorenz_S"
     have "(lorenz.poincare_map \<Sigma> has_derivative ?D) (at (x, y, z) within \<Sigma>\<^sub>l\<^sub>e)"
       using lorenz_S_poincare_map_has_derivative[OF D(3) Dr D(1) S_le]
       by auto
     moreover
     from plane have [simp]: "dz = 0" by (auto simp: plane_of_def)
     have "expansion (mirror_result res) * norm (dx, dy, dz) \<le> norm (?D (dx, dy, dz))"
       using D(4) apply (auto simp: )
       unfolding lorenz_S_on_plane neg
       by simp
     moreover have \<open>mirror_result res2 \<in> return_of_res results (mirror_result res)\<close>
       using D(5) by (rule mirror_result_in)
     moreover have "(lorenz.poincare_map \<Sigma> (x, y, z), ?D (dx, dy, dz)) \<in> c1_of_res (mirror_result res2)"
       using D(6) apply (subst (asm) lorenz_S_poincare_map)
         apply auto apply fact
       apply (auto simp: c1_of_res_def in_source_of_res_mirrorI)
       unfolding lorenz_S_on_plane neg
       apply (subst lorenz_minus_planeI)
        apply (auto simp: conefield_of_res_def conefield_alt_def cone_hull_expl
           in_segment tangent_of_deg_def)
       done
     moreover have "preexpansion (mirror_result res2) * norm (dx, dy, dz) \<le> norm (?D (dx, dy, dz))"
       using D(7) apply (auto simp: )
       unfolding lorenz_S_on_plane neg
       by simp
     ultimately show ?case
       by (force intro!: exI[where x = ?D] bexI[where x="mirror_result res2"])
   qed
 qed
 
 lemma reduce_lorenz_symmetry: "Ball (set results) correct_res"
   if "Ball (set coarse_results) correct_res"
   using that
   by (auto simp: results_def symmetrize_def intro!: correct_res_mirror_result)
 
 end
 
 subsection \<open>Code Generation\<close>
 
 definition [code_abbrev]: "my_divide_integer (i::integer) (j::integer) = i div j"
 code_printing constant my_divide_integer \<rightharpoonup> (SML) "IntInf.div/ (_,/ _)"
 
 subsection \<open>Tuning code equations\<close>
 
 definition mult_twopow_int::"int \<Rightarrow> int \<Rightarrow> int" where "mult_twopow_int x n = x * (power_int 2 n)"
 definition div_twopow_int :: "int \<Rightarrow> int \<Rightarrow> int" where "div_twopow_int x n = x div (power_int 2 n)"
 
 context includes integer.lifting begin
 
 lift_definition mult_twopow_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" is mult_twopow_int .
 lift_definition div_twopow_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" is div_twopow_int .
 
 end
 
 lemma compute_float_round_down[code]:
   "float_round_down prec (Float m e) =
     (let d = bitlen \<bar>m\<bar> - int prec - 1 in
       if 0 < d then Float (div_twopow_int m d) (e + d)
       else Float m e)"
   including float.lifting
   using Float.compute_float_down[of "Suc prec - bitlen \<bar>m\<bar> - e" m e, symmetric]
   by transfer
      (auto simp add: field_simps abs_mult log_mult bitlen_alt_def truncate_down_def
       div_twopow_int_def power_int_def
       cong del: if_weak_cong)
 
 lemma compute_float_plus_down[code]:
   fixes p::nat and m1 e1 m2 e2::int
   shows "float_plus_down p (Float m1 e1) (Float m2 e2) =
     (if m1 = 0 then float_round_down p (Float m2 e2)
     else if m2 = 0 then float_round_down p (Float m1 e1)
     else
       (if e1 \<ge> e2 then
         (let k1 = Suc p - nat (bitlen \<bar>m1\<bar>) in
           if bitlen \<bar>m2\<bar> > e1 - e2 - k1 - 2
           then float_round_down p ((Float m1 e1) + (Float m2 e2))
           else float_round_down p (Float (mult_twopow_int m1 (int k1 + 2) + sgn m2) (e1 - int k1 - 2)))
     else float_plus_down p (Float m2 e2) (Float m1 e1)))"
   using Float.compute_float_plus_down[of p m1 e1 m2 e2]
   by (auto simp: mult_twopow_int_def Let_def power_int_def nat_add_distrib)
 
 subsection \<open>Codegen\<close>
 
 definition "is_dRETURN_True x = (case x of dRETURN b \<Rightarrow> b | _ \<Rightarrow> False)"
 definition "file_output_option s f =
   (case s of None \<Rightarrow> f None
   | Some s \<Rightarrow> file_output (String.implode s) (\<lambda>pf. f (Some pf)))"
 
 definition "check_line_lookup_out s m0 n0 c1 i =
   is_dRETURN_True (file_output_option s (\<lambda>pf. check_line_core_impl pf m0 n0 c1 i))"
 
 fun alternating where "alternating [] xs = xs"
   | "alternating xs [] = xs"
   | "alternating (x#xs) (y#ys) = x#y#alternating xs ys"
 
 definition "ordered_lines = alternating (rev [0..<222]) ([222..<400])"
   \<comment> \<open>the hard ones ``first'', potentially useless due to nondeterministic \<open>Parallel.map\<close>\<close>
 
 definition "parallel_check filenameo m n c1 ns =
   Parallel.forall (\<lambda>i.
     let
       _ = print (String.implode (''# Starting '' @ show i @ ''\<newline>''));
       b =
       check_line_lookup_out (map_option (\<lambda>f. f @ show i) filenameo)
         (Some m) (Some n) c1 i;
       _ = if b
         then print (String.implode (''# Success: '' @ show i @ ''\<newline>''))
         else print (String.implode (''# Failed:  '' @ show i @ ''\<newline>''))
     in b
     ) ns"
 
 ML \<open>val check_line = @{computation_check
   terms:
     Trueprop
     parallel_check
     ordered_lines
     check_line_core_impl
     check_line_lookup_out
 
     (* bool *)
     True False
 
     (* num *)
     Num.One Num.Bit0 Num.Bit1
 
     (* nat *)
     Suc "0::nat" "1::nat" "numeral::num\<Rightarrow>nat"
 
     (* int / integer*)
     "numeral::num\<Rightarrow>int"
     "numeral::num\<Rightarrow>integer"
     "uminus::_\<Rightarrow>int"
     "uminus::_\<Rightarrow>integer"
     int_of_integer integer_of_int
     "0::int"
     "1::int"
 
     (* Pairs *)
     "Pair::_ \<Rightarrow> _\<Rightarrow> (real list \<times> real list)"
     "Pair::_\<Rightarrow>_\<Rightarrow>(real list \<times> real list) \<times> real list sctn"
     "Pair::_\<Rightarrow>_\<Rightarrow>((real list \<times> real list) \<times> real list sctn) list \<times> real aform reach_options"
 
     (* Option *)
     "None::nat option"
     "Some::_\<Rightarrow>nat option"
     "None::string option"
     "Some::_\<Rightarrow>string option"
 
     (* Lists *)
     "Nil::real list"
     "Cons::_\<Rightarrow>_\<Rightarrow>real list"
     "Nil::nat list"
     "Cons::_\<Rightarrow>_\<Rightarrow>nat list"
     "Nil::real aform list"
     "Cons::_\<Rightarrow>_\<Rightarrow>real aform list"
     "Nil::((real list \<times> real list) \<times> real list sctn) list"
     "Cons::_\<Rightarrow>_\<Rightarrow>((real list \<times> real list) \<times> real list sctn) list"
     "Nil::(((real list \<times> real list) \<times> real list sctn) list \<times> real aform reach_options)list"
     "Cons::_\<Rightarrow>_\<Rightarrow>(((real list \<times> real list) \<times> real list sctn) list \<times> real aform  reach_options)list"
 
     (* String *)
     String.Char
     String.implode "Cons::char \<Rightarrow> char list \<Rightarrow> char list" "Nil::char list"
 
     (* float *)
     Float float_of_int float_of_nat
 
     (* real *)
     "numeral::num\<Rightarrow>real" "real_of_float" "(/)::real\<Rightarrow>real\<Rightarrow>real" "uminus::real\<Rightarrow>_"
     real_divl real_divr
     real_of_int
 
     (* section *)
     "Sctn::_\<Rightarrow>_\<Rightarrow>real list sctn"
 
     (* aform *)
     "aforms_of_ivls::_\<Rightarrow>_\<Rightarrow>real aform list"
 
     (* input *)
     coarse_results
 
     (* modes *)
     xsec xsec' ysec ysec' zsec zsec' zbucket
     lookup_mode
     ro
     ro_outer
     mode_outer
 
     (* unit *)
     "()"
 
   }\<close>
 
 
 lemma is_dRETURN_True_iff[simp]: "is_dRETURN_True x \<longleftrightarrow> (x = dRETURN True)"
   by (auto simp: is_dRETURN_True_def split: dres.splits)
 
 lemma check_line_core_impl_True:
   "check_line_core_impl pfo m n True i = dRETURN True \<Longrightarrow> NF \<Longrightarrow> correct_res (results ! i)"
   apply (cases "check_line_core_impl pfo m n True i")
   using check_line_core_correct[of pfo m n i]
     check_line_core_impl.refine[of pfo pfo True True i i m m n n]
     apply (auto simp: nres_rel_def)
   apply (drule order_trans[where y="check_line_core pfo m n True i"])
    apply assumption
   by auto
 
 lemma check_line_lookup_out: "correct_res (results ! i)"
   if "\<exists>s m n. check_line_lookup_out s m n True i" NF
   using that
   by (auto simp: check_line_lookup_out_def file_output_iff check_line_core_impl_True
       file_output_option_def split: dres.splits option.splits)
 
 definition "check_lines c1 ns = list_all (\<lambda>i. \<exists>s m n. check_line_lookup_out s m n c1 i) ns"
 
 lemma check_linesI:
   "check_lines c1 ns"
   if "parallel_check s m n c1 ns"
   using that
   by (auto simp: parallel_check_def check_lines_def list_all_iff)
 
 subsection \<open>Automate generation of lemmas\<close>
 
 lemma length_coarse_results[simp]: "length coarse_results = 400"
   by (simp add: coarse_results_def)
 
 lemma correct_res_coarse_resultsI:
   "correct_res (results ! i) \<Longrightarrow> i < 400 \<Longrightarrow> correct_res (coarse_results ! i)"
   by (auto simp: results_def symmetrize_def nth_append)
 
 lemma Ball_coarseI: "Ball (set coarse_results) correct_res"
   if NF "check_lines True xs" "set xs = {..<400}"
   using that
   by (force simp: check_lines_def list_all_iff in_set_conv_nth
       intro!: correct_res_coarse_resultsI check_line_lookup_out)
 
 ML \<open>map_option (using_master_directory_term @{context}) (SOME "a")\<close>
 ML \<open>
 fun mk_optionT ty = Type (@{type_name "option"}, [ty])
 fun mk_None ty = Const (@{const_name "None"}, mk_optionT ty)
 fun mk_Some ty x = Const (@{const_name "Some"}, ty --> mk_optionT ty) $ x
 fun mk_option ty _ NONE = mk_None ty
   | mk_option ty f (SOME x) = mk_Some ty (f x)
 fun check_lines_tac' s m n ctxt =
   resolve_tac ctxt
     [Thm.instantiate ([],
       [("s", @{typ "string option"}, mk_option @{typ string} (using_master_directory_term ctxt) s),
        ("m", @{typ nat}, HOLogic.mk_nat m),
        ("n", @{typ nat}, HOLogic.mk_nat n)]
         |> map (fn (s, ty, t) => (((s, 0), ty), Thm.cterm_of ctxt t)))
       @{thm check_linesI}]
   THEN' CONVERSION (check_line ctxt)
   THEN' resolve_tac ctxt @{thms TrueI}
 \<close>
 
 method_setup parallel_check = \<open>
   Scan.lift (Parse.maybe Parse.string) -- Scan.lift Parse.nat -- Scan.lift Parse.nat
   >> (fn ((s, m), n) => fn ctxt => SIMPLE_METHOD' (check_lines_tac' s m n ctxt))
 \<close>
 
 lemma lorenz_bounds_lemma_asym:
   "\<forall>x \<in> N - \<Gamma>. x returns_to \<Sigma>"
   "R ` (N - \<Gamma>) \<subseteq> N"
   "\<forall>x \<in> N - \<Gamma>. (R has_derivative DR x) (at x within \<Sigma>\<^sub>l\<^sub>e)"
   "\<forall>x \<in> N - \<Gamma>. DR x ` \<CC> x \<subseteq> \<CC> (R x)"
   "\<forall>x \<in> N - \<Gamma>. \<forall>c \<in> \<CC> x. norm (DR x c) \<ge> \<E> x      * norm c"
   "\<forall>x \<in> N - \<Gamma>. \<forall>c \<in> \<CC> x. norm (DR x c) \<ge> \<E>\<^sub>p (R x) * norm c"
   if NF "Ball (set results) correct_res"
   using that
   by (auto intro!: lorenz_bounds_lemma)
 
 end
diff --git a/thys/Ordinary_Differential_Equations/Ex/Lorenz/Result_Elements.thy b/thys/Ordinary_Differential_Equations/Ex/Lorenz/Result_Elements.thy
--- a/thys/Ordinary_Differential_Equations/Ex/Lorenz/Result_Elements.thy
+++ b/thys/Ordinary_Differential_Equations/Ex/Lorenz/Result_Elements.thy
@@ -1,154 +1,154 @@
 theory Result_Elements
   imports
     "HOL-Analysis.Analysis"
     "HOL-ODE-Numerics.ODE_Numerics"
     "HOL-Library.Float"
 begin
 
 datatype result = Result
   (invoke_nf : bool)
   (min_deg : real)
   (max_deg : real)
   (expansion : real)
   (preexpansion : real)
   (gridx0 : int)
   (gridx1 : int)
   (gridy0 : int)
   (gridy1 : int)
   (inf_retx : int)
   (inf_rety : int)
   (sup_retx : int)
   (sup_rety : int)
 derive "show" result
 
 definition "get_results LX LY UX UY fgs =
   [fg \<leftarrow> fgs. LX \<le> gridx1 fg \<and> gridx0 fg \<le> UX \<and> LY \<le> gridy1 fg \<and> gridy0 fg \<le> UY]"
 
 primrec mirror_result where
   "mirror_result (Result nf u v e ep x0 x1 y0 y1 rx0 ry0 rx1 ry1) =
     Result nf u v e ep (-x1) (-x0) (-y1) (-y0) (-rx1) (-ry1) (-rx0) (-ry0)"
 definition "upper_result fg \<longleftrightarrow> 5 * gridy1 fg \<ge> 2 * gridx0 fg"
 definition "symmetrize upper_list = upper_list @ map mirror_result upper_list"
 definition "mirror_upper fg = (if upper_result fg then fg else mirror_result fg)"
 
 definition "tangent_of_deg deg = (cos (rad_of (deg)), sin (rad_of (deg)), 0::real)"
 
 definition "tangent_seg_of_res_spec res = SPEC (\<lambda>r.
   closed_segment (tangent_of_deg (min_deg res)) (tangent_of_deg (max_deg res)) \<subseteq> r)"
 
 definition "conefield_of_res res =
   conefield (tangent_of_deg (min_deg res)) (tangent_of_deg (max_deg res))"
 
 definition "ivl_of_resultrect x0 x1 y0 y1 =
   (let scale = FloatR 1 (-8) in ([scale * real_of_int (x0 - 1), scale * real_of_int (y0 - 1), 27],
                          [scale * real_of_int (x1 + 1), scale * real_of_int (y1 + 1), 27]))"
 
 definition "ivl_of_res res = ivl_of_resultrect (gridx0 res) (gridx1 res) (gridy0 res) (gridy1 res)"
 
 definition
   "source_of_res res =
     (set_of_ivl (pairself eucl_of_list (ivl_of_res res))::(real*real*real) set)"
 
 definition "c1_of_res res = source_of_res res \<times> conefield_of_res res"
 
 definition "return_of_res results res =
   set (get_results (inf_retx res) (inf_rety res) (sup_retx res) (sup_rety res) results)"
 
 
 subsection \<open>Validate (in a non-verified way) the expansion estimates (following expansion.cc)\<close>
 
 subsubsection \<open>\<open>Generate_F_0_List\<close>\<close>
 
 definition "assert_option s x = (if x then Some () else (let _ = print (String.implode s) in None))"
 
-definition "get_return_grids tlist upper fg =
+definition "get_return_grids tlist uppr fg =
   (let ret = get_results (inf_retx fg) (inf_rety fg) (sup_retx fg) (sup_rety fg) tlist
-  in if upper then map mirror_upper ret else ret)"
+  in if uppr then map mirror_upper ret else ret)"
 
 definition "generate_f0_list total_list upper_list u_min u_max =
   (do {
     let f0_list = [fg\<leftarrow>upper_list. u_min \<le> gridx0 fg \<and> gridx1 fg \<le> u_max];
     let mme = Min (expansion ` set f0_list);
     assert_option ''ERROR: mme > 1\<newline>'' (mme > 1);
     let rgs = get_return_grids total_list True (last f0_list);
     let fd = set rgs \<subseteq> set f0_list;
     assert_option ''ERROR: fundamental domain\<newline>'' fd;
     Some (f0_list, mme)
   })"
 
 subsubsection \<open>\<open>Find_F_0_Inv_Sets\<close>\<close>
 
 definition "find_f0_inv_sets f0_list =
   (let
     space_list = symmetrize f0_list;
     factors = map (\<lambda>it.
       if it \<in> set (get_return_grids space_list True it) then ereal (max (expansion it) (preexpansion it))
       else \<infinity>) f0_list
   in real_of_ereal (Min (set factors)))"
 
 subsubsection \<open>\<open>Generate_F_1_List\<close>\<close>
 
 abbreviation "println s \<equiv> print (String.implode (s @ ''\<newline>''))"
 
 definition "compute_image total_list source_list =
   (let
     r = (fold (\<lambda>it res. (get_return_grids total_list False it @ res)) source_list []);
     rd = remdups r
   in rd)"
 
 definition "generate_f1_list total_list f0_list =
   (let
     f1_list = remdups (map mirror_upper (compute_image total_list f0_list))
   in
     fold (\<lambda>f0 f1_list. List.remove1 f0 f1_list) f0_list f1_list)"
 
 subsection \<open>\<open>Flow_Along\<close>\<close>
 
 definition "flow_along i f1_it f0_list total_list =
   (let
   (_, _, all_good, its, min_acc_exp) = while (\<lambda>(iterate_list, acc_exp, all_good, its, min_min_exp).
       iterate_list \<noteq> [] \<and> all_good)
     (\<lambda>(iterate_list, acc_exp, _, its, min_acc_exp).
       let
         min_exp = Min (expansion ` set iterate_list);
         acc_exp = truncate_down 30 (acc_exp * min_exp);
         image_list = compute_image total_list iterate_list;
         _ = println (''flow_along: '' @ show i @ '' -- '' @ show (gridx0 f1_it, gridx1 f1_it));
         _ = println (''|image_list|: '' @ show (length image_list));
         (mem_f0_list, iterate_list) = List.partition (\<lambda>it. it \<in> set f0_list) image_list;
         _ = println (''|mem_f0_list|: '' @ show (length mem_f0_list));
         _ = println (''acc_exp = '' @ show (acc_exp));
         min_acc_exp = (if mem_f0_list \<noteq> [] then min min_acc_exp (ereal acc_exp) else min_acc_exp);
         res = (iterate_list, acc_exp, mem_f0_list \<noteq> [] \<longrightarrow> acc_exp \<ge> 2,
            Suc its, min_acc_exp)
       in
       res)
     ([f1_it], preexpansion f1_it, True, 0, \<infinity>)
   in (all_good, its, min_acc_exp))"
 
 subsubsection \<open>\<open>Iteration\<close>\<close>
 
 definition "expansion_main upper_list =
   do {
     let total_list = symmetrize upper_list;
     (f0_list, exp_f0) \<leftarrow> generate_f0_list total_list upper_list (-128) (512);
     let exp_f0_inv = find_f0_inv_sets f0_list;
     assert_option ''ERROR: find_f0_inv_sets: '' (exp_f0_inv > ub_sqrt 30 2);
     let f1_list = generate_f1_list total_list f0_list;
     let f0_list = symmetrize f0_list;
     (_, max_its, min_acc_exp) \<leftarrow> fold (\<lambda>f1_it i. do {
         (i, max_its, min_min_acc_exp) \<leftarrow> i;
         let _ = println ((shows ''Grid # '' o shows i o shows ''/'' o shows (length f1_list)) '''');
         let (all_good, its, min_acc_exp) = flow_along i f1_it f0_list total_list;
         assert_option ''flow_along failed'' all_good;
         Some (Suc i, max max_its its, min min_min_acc_exp min_acc_exp)
       }) f1_list (Some (0, 0, \<infinity>));
     let _ = println (show ''EXPANSION_MAIN finished'');
     let _ = println ((shows ''smallest accumulated expansion for orbits returning to F: '' o shows (real_of_ereal min_acc_exp)) '''');
     let _ = println ((shows ''the smallest expansion factor for orbits confined to F: '' o shows exp_f0_inv) '''');
     let _ = println ((shows ''minimal expansion in F: '' o shows exp_f0) '''');
     let _ = println ((shows ''longest number of iterates: '' o shows max_its) '''');
     Some True
   }"
 
 end
diff --git a/thys/Ordinary_Differential_Equations/Numerics/Abstract_Reachability_Analysis.thy b/thys/Ordinary_Differential_Equations/Numerics/Abstract_Reachability_Analysis.thy
--- a/thys/Ordinary_Differential_Equations/Numerics/Abstract_Reachability_Analysis.thy
+++ b/thys/Ordinary_Differential_Equations/Numerics/Abstract_Reachability_Analysis.thy
@@ -1,1158 +1,1159 @@
 theory Abstract_Reachability_Analysis
   imports
   Abstract_Rigorous_Numerics
   Affine_Arithmetic.Affine_Arithmetic
   "../Refinement/Refine_String"
   "../Refinement/Refine_Folds"
   Ordinary_Differential_Equations.Flow
   Runge_Kutta
 begin
 
 
 subsection \<open>Misc\<close>
 
 lemma nth_concat_exists:
   "\<exists>k j. concat xs ! i = xs ! k ! j \<and> k < length xs \<and> j < length (xs ! k)"
   if "i < length (concat xs)"
   using that
 proof (induction xs arbitrary: i)
   case Nil
   then show ?case by auto
 next
   case (Cons xs xss)
   from Cons.prems consider "i < length xs"
     | "i \<ge> length xs" "i < length xs + length (concat xss)"
     by (cases "i < length xs") auto
   then show ?case
   proof cases
     case 1
     then show ?thesis
       by (force simp: nth_append intro: exI[where x=i] exI[where x=0])
   next
     case 2
     then have "i - length xs < length (concat xss)" by arith
     with Cons.IH[of "i - length xs"]
     obtain k j where
       "concat xss ! (i - length xs) = xss ! k ! j" "k < length xss" "j < length (xss ! k)"
       by auto
     then show ?thesis
       using 2
       by (fastforce simp: nth_append nth_Cons split: nat.splits
           intro: exI[where x=j] exI[where x="k + 1"])
   qed
 qed
 
 lemma nth_concatE:
   assumes "i < length (concat xs)"
   obtains k j where "concat xs ! i = xs ! k ! j" "k < length xs" "j < length (xs ! k)"
   apply atomize_elim
   using assms nth_concat_exists by blast
 
 lemma max_Var_floatariths_concat:
   "max_Var_floatariths (concat xs) \<le> k"
   if "\<And>x. x \<in> set xs \<Longrightarrow> max_Var_floatariths x \<le> k"
   using that max_Var_floatarith_le_max_Var_floatariths_nthI
   by (fastforce simp: in_set_conv_nth intro!: max_Var_floatariths_leI
       elim!: nth_concatE)
 
 lemma max_Var_floatariths_list_update:
   "max_Var_floatariths (xs[xa := y]) \<le> k"
   if "max_Var_floatariths (xs) \<le> k"
   and "max_Var_floatarith y \<le> k"
   by (metis neq_le_trans linorder_le_cases list_update_beyond
       max_Var_floatariths_list_updateI that)
 
 lemma max_Var_floatarith_0[simp]: "max_Var_floatarith 0 = 0"
   and max_Var_floatarith_1[simp]: "max_Var_floatarith 1 = 0"
   by (auto simp: zero_floatarith_def one_floatarith_def)
 
 lemma list_set_rel_br: "\<langle>Id\<rangle>list_set_rel = br set distinct"
   by (auto simp: list_set_rel_def)
 
 lemma
   br_list_relD:
   shows "(x, y) \<in> \<langle>br a i\<rangle>list_set_rel \<Longrightarrow> y = a ` set x \<and> list_all i x"
   apply (auto simp: list_set_rel_def br_def list_rel_def)
   subgoal premises prems for s t
     using prems
     by (induction arbitrary: y rule: list.rel_induct) auto
   subgoal premises prems for s t
     using prems
     by (induction arbitrary: y rule: list.rel_induct) auto
   subgoal premises prems for s
     using prems
     by (induction arbitrary: y rule: list.rel_induct) auto
   done
 
 lemma sctn_rel_br: "\<langle>br a I\<rangle>sctn_rel = br (\<lambda>x. case x of Sctn n p \<Rightarrow> Sctn (a n) p) (\<lambda>x. I (normal x))"
   apply (auto simp: sctn_rel_def br_def in_rel_def[abs_def] split: sctn.splits)
   subgoal for b x1 x2 by (cases b) auto
   subgoal for a b by (cases a; cases b) auto
   done
 
 lemma br_list_rel: "\<langle>br a I\<rangle>list_rel = br (map a) (list_all I)"
   by (fastforce simp: list_rel_def br_def list_all2_iff Ball_def in_set_zip list_all_length
       intro!: nth_equalityI)
 
 lemma list_set_rel_brp: "\<langle>br a I\<rangle>list_set_rel = br (\<lambda>xs. a ` set xs) (\<lambda>xs. list_all I xs \<and> distinct (map a xs))"
   unfolding list_set_rel_def br_list_rel br_chain o_def o_def
   by (auto)
 
 
 declare INF_cong_simp [cong] SUP_cong_simp [cong] image_cong_simp [cong del]
 
 context auto_ll_on_open begin
 
 definition "stable_on CX trap \<longleftrightarrow>
   (\<forall>t x0. flow0 x0 t \<in> trap \<longrightarrow> t \<in> existence_ivl0 x0 \<longrightarrow> t > 0 \<longrightarrow>
     (\<forall>s\<in>{0<..t}. flow0 x0 s \<in> CX) \<longrightarrow> x0 \<in> trap)"
 
 lemma stable_onD:
   "\<And>t x0. flow0 x0 t \<in> trap \<Longrightarrow> t \<in> existence_ivl0 x0 \<Longrightarrow> t > 0 \<Longrightarrow>
       (\<And>s. 0 < s \<Longrightarrow> s \<le> t \<Longrightarrow> flow0 x0 s \<in> CX) \<Longrightarrow>
       x0 \<in> trap"
   if "stable_on CX trap"
   using that by (auto simp: stable_on_def)
 
 lemma nonneg_interval_mem_existence_ivlI[intro]:\<comment> \<open>TODO: move!\<close>
   "0 \<le> t1 \<Longrightarrow> t1 \<le> t2 \<Longrightarrow> t2 \<in> existence_ivl0 x0 \<Longrightarrow> {t1..t2} \<subseteq> existence_ivl0 x0"
   "t1 \<le> t2 \<Longrightarrow> t2 \<le> 0 \<Longrightarrow> t1 \<in> existence_ivl0 x0 \<Longrightarrow> {t1..t2} \<subseteq> existence_ivl0 x0"
   "t1 \<le> 0 \<Longrightarrow> 0 \<le> t2 \<Longrightarrow> t1 \<in> existence_ivl0 x0 \<Longrightarrow> t2 \<in> existence_ivl0 x0 \<Longrightarrow> {t1..t2} \<subseteq> existence_ivl0 x0"
     apply auto
   apply (drule ivl_subset_existence_ivl) apply auto
   apply (drule ivl_subset_existence_ivl') apply auto
   apply (drule segment_subset_existence_ivl, assumption)
   apply (auto simp: closed_segment_eq_real_ivl)
   done
 
 lemma interval_subset_existence_ivl:
   "t \<in> existence_ivl0 x0 \<Longrightarrow> s \<in> existence_ivl0 x0 \<Longrightarrow> t \<le> s \<Longrightarrow> {t .. s} \<subseteq> existence_ivl0 x0"
   using segment_subset_existence_ivl[of s x0 t]
   by (auto simp: closed_segment_eq_real_ivl)
 
 end
 
 lemma(in c1_on_open_euclidean) diff_existence_ivl_iff[simp]:\<comment> \<open>TODO: move!, also to @{term auto_ll_on_open}\<close>
   "t2 - t1 \<in> existence_ivl0 (flow0 x0 t1) \<longleftrightarrow> t2 \<in> existence_ivl0 x0"
   if "t1 \<le> t2" "t1 \<in> existence_ivl0 x0"
   apply auto
    apply (drule existence_ivl_trans[OF that(2)])
    apply (auto intro!: diff_existence_ivl_trans that)
   done
 
 lemma (in auto_ll_on_open) flow_trans':
   "flow0 (flow0 x0 t1) t2 = flow0 x0 (t1 + t2)"
   if "t1 \<in> existence_ivl0 x0" "t1 + t2 \<in> existence_ivl0 x0"
   apply (subst flow_trans)
   using that
   by (auto intro!: existence_ivl_trans')
 
 context auto_ll_on_open begin
 
 definition "flowpipe0 X0 hl hu CX X1 \<longleftrightarrow> 0 \<le> hl \<and> hl \<le> hu \<and> X0 \<subseteq> X \<and> CX \<subseteq> X \<and> X1 \<subseteq> X \<and>
   (\<forall>(x0) \<in> X0. \<forall>h \<in> {hl .. hu}. h \<in> existence_ivl0 x0 \<and> (flow0 x0 h) \<in> X1 \<and> (\<forall>h' \<in> {0 .. h}. (flow0 x0 h') \<in> CX))"
 
 lemma flowpipe0D:
   assumes "flowpipe0 X0 hl hu CX X1"
   shows flowpipe0_safeD: "X0 \<union> CX \<union> X1 \<subseteq> X"
     and flowpipe0_nonneg: "0 \<le> hl" "hl \<le> hu"
     and flowpipe0_exivl: "hl \<le> h \<Longrightarrow> h \<le> hu \<Longrightarrow> (x0) \<in> X0 \<Longrightarrow> h \<in> existence_ivl0 x0"
     and flowpipe0_discrete: "hl \<le> h \<Longrightarrow> h \<le> hu \<Longrightarrow> (x0) \<in> X0 \<Longrightarrow> (flow0 x0 h) \<in> X1"
     and flowpipe0_cont: "hl \<le> h \<Longrightarrow> h \<le> hu \<Longrightarrow> (x0) \<in> X0 \<Longrightarrow> 0 \<le> h' \<Longrightarrow> h' \<le> h \<Longrightarrow> (flow0 x0 h') \<in> CX"
   using assms
   by (auto simp: flowpipe0_def)
 
 lemma flowpipe0_source_subset: "flowpipe0 X0 hl hu CX X1 \<Longrightarrow> X0 \<subseteq> CX"
   apply (auto dest: bspec[where x=hl] bspec[where x=0] simp: flowpipe0_def)
   apply (drule bspec)
    apply (assumption)
   apply (drule bspec[where x=hl])
    apply auto
   apply (drule bspec[where x=0])
   by (auto simp: flow_initial_time_if)
 
 end
 
 subsection \<open>Options\<close>
 
 definition [refine_vcg_def]: "precision_spec = SPEC (\<lambda>prec::nat. True)"
 definition [refine_vcg_def]: "adaptive_atol_spec = SPEC (\<lambda>x::real. True)"
 definition [refine_vcg_def]: "adaptive_rtol_spec = SPEC (\<lambda>x::real. True)"
 definition [refine_vcg_def]: "method_spec = SPEC (\<lambda>m::nat. True)"
 definition [refine_vcg_def]: "start_stepsize_spec = SPEC (\<lambda>x::real. x > 0)"
 definition [refine_vcg_def]: "iterations_spec = SPEC (\<lambda>n::nat. True)"
 definition [refine_vcg_def]: "halve_stepsizes_spec = SPEC (\<lambda>n::nat. True)"
 definition [refine_vcg_def]: "widening_mod_spec = SPEC (\<lambda>n::nat. True)"
 definition [refine_vcg_def]: "rk2_param_spec = SPEC (\<lambda>r::real. 0 < r \<and> r \<le> 1)"
 
 typedef ode_ops = "{(ode_e::floatarith list, safe_form::form).
   open_form safe_form \<and>
   max_Var_floatariths ode_e \<le> length ode_e \<and>
   max_Var_form safe_form \<le> length ode_e}" \<comment> \<open>ode on open domain, welldefined\<close>
   by (auto intro!: exI[where x="[floatarith.Num 0]"]
       exI[where x="Less (floatarith.Num 0) (floatarith.Num 1)"])
 setup_lifting type_definition_ode_ops
 
 lift_definition ode_expression::"ode_ops \<Rightarrow> floatarith list" is fst .
 lift_definition safe_form_expr::"ode_ops \<Rightarrow> form" is snd .
     \<comment> \<open>TODO: should better called it domain of definition of ODE,
                 its main use is to exclude e.g. division by zero on the rhs.\<close>
 
 lemma open_form_ode_op[intro, simp]: "open_form (safe_form_expr odo)"
   and max_Var_ode_expression: "max_Var_floatariths (ode_expression odo) \<le> length (ode_expression odo)"
   and max_Var_form_safe_form_expr: "max_Var_form (safe_form_expr odo) \<le> length (ode_expression odo)"
   by (transfer, auto)+
 
 lift_definition (code_dt) mk_ode_ops::"floatarith list \<Rightarrow> form \<Rightarrow> ode_ops option" is
   "\<lambda>ode_e safe_form.
     if (open_form safe_form \<and> max_Var_floatariths ode_e \<le> length ode_e \<and> max_Var_form safe_form \<le> length ode_e)
     then Some (ode_e, safe_form) else None"
   by (auto simp:)
 
 lemma
   assumes "mk_ode_ops e s = Some odo"
   shows ode_expression_mk_ode_ops: "ode_expression odo = e"
     and safe_form_expr_mk_ode_ops: "safe_form_expr odo = s"
   using assms
   by (transfer, simp split: if_splits prod.splits)+
 
 locale ode_operations = fixes ode_ops::ode_ops begin
 
 definition "ode_e = ode_expression ode_ops"
 definition "safe_form = safe_form_expr ode_ops"
 
 definition ode::"'a \<Rightarrow> 'a::executable_euclidean_space"
   where "ode x = eucl_of_list (interpret_floatariths ode_e (list_of_eucl x))"
 
 definition "ode_d_expr_nth N n i =
     FDERIV_floatarith
      (FDERIV_n_floatarith (ode_e  ! i) [0..<N] (map floatarith.Var [N..<2 * N]) n) [0..<N]
          (map floatarith.Var [2 * N..<3 * N])"
 
 definition "ode_d_expr N n =
     (FDERIV_floatariths
       (FDERIV_n_floatariths ode_e [0..<N] (map floatarith.Var [N..<2 * N]) n)
       [0..<N]
       (map floatarith.Var [2 * N..< 3 * N]))"
 
 definition ode_d_raw::"nat \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a::executable_euclidean_space"
   where "ode_d_raw n x dn d =
     eucl_of_list (interpret_floatariths (ode_d_expr DIM('a) n) (list_of_eucl x @ list_of_eucl dn @ list_of_eucl d))"
 
 definition "ode_fa_nth xs i = subst_floatarith (\<lambda>i. xs ! i) (ode_e ! i)"
 
 definition "ode_fa xs = map (subst_floatarith (\<lambda>i. xs ! i)) ode_e"
 
 definition "ode_d_fa_nth n xs ds i = subst_floatarith (\<lambda>i. (xs@ds@ds) ! i) (ode_d_expr_nth (length xs) n i)"
 
 definition "ode_d_fa n xs ds = map (subst_floatarith (\<lambda>i. (xs@ds@ds) ! i)) (ode_d_expr (length xs) n)"
 
 definition safe::"'a::executable_euclidean_space \<Rightarrow> bool"
   where "safe x \<longleftrightarrow>
     length ode_e = DIM('a) \<and>
     max_Var_floatariths ode_e \<le> DIM('a) \<and>
     open_form safe_form \<and>
     max_Var_form safe_form \<le> DIM('a) \<and>
     interpret_form safe_form (list_of_eucl x) \<and>
     isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl x)"
 
 definition "Csafe = Collect safe"
 
 definition "euler_incr_fas_nth X0 h CX i = X0 ! i + h * (ode_fa_nth CX i)"
 
 definition "euler_incr_fas X0 h CX = map (euler_incr_fas_nth X0 h CX) [0..<length X0]"
 
 definition "euler_err_fas_nth X0 h CX i = ((h ^\<^sub>e 2) / floatarith.Num 2) * ode_d_fa_nth 0 CX (ode_fa CX) i"
 
 definition "euler_err_fas X0 h CX = map (euler_err_fas_nth X0 h CX) [0..<length X0]"
 
 definition "euler_fas X0 h CX =
   map (\<lambda>i. (euler_incr_fas_nth X0 h X0 i + euler_err_fas_nth X0 h CX i)) [0..<length X0] @
   euler_err_fas X0 h CX"
 
 definition "rk2_fas_err_nth rkp x0 h cx s2 i =
   ((((h ^\<^sub>e 3 / 6) *
         (ode_d_fa_nth 1 cx (ode_fa cx) i +
          ode_d_fa_nth 0 cx (ode_d_fa 0 cx (ode_fa cx)) i)))
       - ((h ^\<^sub>e 3 * rkp / 4) *
           ode_d_fa_nth 1 (euler_incr_fas x0 (s2 * h * rkp) x0) (ode_fa x0) i))"
 
 definition "rk2_fas_err rkp x0 h cx s2 = map (rk2_fas_err_nth rkp x0 h cx s2) [0..<length x0]"
 
 definition "rk2_fas rkp x0 h cx s2 =
   (map (\<lambda>i.
       ((x0 ! i +
         h * ((1 - (1 / (rkp * 2))) * ode_fa_nth x0 i +
           (1 / (rkp * 2)) * ode_fa_nth (euler_incr_fas x0 (h * rkp) x0) i))
       + rk2_fas_err_nth rkp x0 h cx s2 i)) [0..<length x0]) @ rk2_fas_err rkp x0 h cx s2"
 
 
 lemma ode_d_expr_nth: "i < length ode_e \<Longrightarrow> ode_d_expr_nth N n i = ode_d_expr N n ! i "
   by (auto simp: ode_d_expr_nth_def ode_d_expr_def
       FDERIV_n_floatariths_nth)
 
 lemma length_ode_d_expr[simp]: "length (ode_d_expr f n) = length ode_e"
   by (induction n) (auto simp: ode_d_expr_def FDERIV_n_floatariths_def)
 
 lemma ode_fa_nth: "i < length ode_e \<Longrightarrow> ode_fa xs ! i = ode_fa_nth xs i"
   by (auto simp: ode_fa_nth_def ode_fa_def)
 
 lemma ode_d_fa_nth: "i < length ode_e \<Longrightarrow> ode_d_fa_nth n xs ds i = ode_d_fa n xs ds ! i"
   by (auto simp: ode_d_fa_def ode_d_fa_nth_def ode_d_expr_nth)
 
 lemma length_ode_d_fa[simp]: "length (ode_d_fa n xs ds) = length ode_e"
   by (auto simp: ode_d_fa_def FDERIV_n_floatariths_def)
 
 lemma length_rk2_fas_err[simp]: "length (rk2_fas_err rkp x0 h cx s2) = length x0"
   by (simp add: rk2_fas_err_def)
 
 lemma length_euler_incr_fas[simp]: "length (euler_incr_fas X0 h CX) = length X0"
   by (auto simp: euler_incr_fas_def)
 
 lemma length_euler_err_fas[simp]: "length (euler_err_fas X0 h CX) = length X0"
   by (auto simp: euler_err_fas_def)
 
 lemma length_euler_floatarith[simp]: "length (euler_fas X0 h CX) = 2 * length X0"
   by (auto simp: euler_fas_def)
 
 lemma length_rk2_fas[simp]: "length (rk2_fas rkp x0 h cx s2) = 2 * length x0"
   by (simp add: rk2_fas_def)
 
 lemma open_safe: "open Csafe"
 proof -
   have leq: "list_updates [0..<DIM('a)] (list_of_eucl x) (replicate DIM('a) 0) = list_of_eucl x" for x::'a
     by (auto intro!: nth_equalityI simp: list_updates_nth)
   have "(Csafe::'a set) =
     (if length ode_e = DIM('a) \<and> max_Var_floatariths ode_e \<le> DIM('a) \<and> max_Var_form safe_form \<le> DIM('a) \<and> open_form safe_form then
       {x. interpret_form safe_form (list_of_eucl x)} \<inter>
       {x. isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl x)}
     else {})"
     by (auto simp: Csafe_def safe_def)
   also have "open \<dots>"
     apply (auto intro!: open_Int)
     subgoal premises prems using open_form[OF prems(4), where 'a='a, of "[0..<DIM('a)]" "replicate (DIM('a)) 0"]
       by (auto simp: leq)
     subgoal
       apply (rule isFDERIV_open)
       apply (rule order_trans)
       apply assumption
       apply arith
       done
     done
   finally show ?thesis .
 qed
 
 lemma safeD:
   fixes x::"'a::executable_euclidean_space"
   assumes "x \<in> Csafe"
   shows "interpret_form safe_form (list_of_eucl x)"
     and safe_isFDERIV: "isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl x)"
   using assms
   by (auto simp: Csafe_def safe_def)
 
 lemma
   fixes x::"'a::executable_euclidean_space"
   shows safe_max_Var: "x \<in> Csafe \<Longrightarrow> max_Var_floatariths ode_e \<le> DIM('a)"
     and safe_length: "x \<in> Csafe \<Longrightarrow> length ode_e = DIM('a)"
     and safe_max_Var_form: "x \<in> Csafe \<Longrightarrow> max_Var_form safe_form \<le> DIM('a)"
   by (auto simp: safe_def Csafe_def)
 
 lemma safe_isFDERIV_append:
   fixes x::"'a::executable_euclidean_space"
   shows "x \<in> Csafe \<Longrightarrow> isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl x @ xs)"
   apply (rule isFDERIV_max_Var_congI)
    apply (rule safe_isFDERIV)
    apply assumption
   using safe_max_Var[of x]
   by (auto simp: nth_append)
 
 lemma ode_d_raw_0:
   assumes "x \<in> Csafe"
   shows "(ode has_derivative ode_d_raw 0 x d) (at x)"
   using assms safe_max_Var[OF assms] safe_length[OF assms]
   unfolding ode_def ode_d_raw_def ode_d_expr_def
   apply (intro interpret_floatarith_FDERIV_floatariths[THEN has_derivative_eq_rhs])
      apply (auto simp: isFDERIV_def FDERIV_n_floatariths_def safe_max_Var nth_append
       max_Var_floatariths_Max Csafe_def safe_def
       intro!: arg_cong[where f=eucl_of_list] ext interpret_floatariths_FDERIV_floatariths_cong
         freshs_floatariths_max_Var_floatarithsI 
         max_Var_floatarith_le_max_Var_floatariths[le])
   apply (rule interpret_floatariths_max_Var_cong)
   apply (auto simp: max_Var_floatariths_Max Max_gr_iff nth_append
       dest!: less_le_trans[OF _ max_Var_floatarith_DERIV_floatarith])
    apply (drule max_Var_floatariths_lessI) apply simp
   apply (auto dest!: less_le_trans[OF _ safe_max_Var[OF assms]])
    apply (drule max_Var_floatariths_lessI) apply simp
   apply (auto dest!: less_le_trans[OF _ safe_max_Var[OF assms]])
   done
 
 lemma not_fresh_odeD: "x \<in> Csafe \<Longrightarrow> \<not>fresh_floatariths ode_e i \<Longrightarrow> i < DIM('a)" for x::"'a::executable_euclidean_space"
   using fresh_floatariths_max_Var[of ode_e i] safe_max_Var[of x] by arith
 
 lemma safe_isnFDERIV:
   fixes x::"'a::executable_euclidean_space"
   assumes "x \<in> Csafe"
   shows "isnFDERIV DIM('a) ode_e [0..<DIM('a)] [DIM('a)..<2 * DIM('a)] (list_of_eucl x @ ys) n"
   apply (rule isFDERIV_imp_isnFDERIV)
      apply (rule isFDERIV_max_Var_congI)
       apply (rule safe_isFDERIV[OF assms])
   using safe_max_Var[OF assms] safe_length[OF assms]
   by (auto simp: nth_append)
 
 lemma safe_isnFDERIVI:
   assumes "(eucl_of_list xs::'a::executable_euclidean_space) \<in> Csafe"
   assumes [simp]: "length xs = DIM('a)" "length ds = DIM('a)"
   shows "isnFDERIV DIM('a) ode_e [0..<DIM('a)] [DIM('a)..<2 * DIM('a)] (xs@ds) n"
 proof -
   have "isnFDERIV DIM('a) ode_e [0..<DIM('a)] [DIM('a)..<2 * DIM('a)] (list_of_eucl (eucl_of_list xs::'a)@ds) n"
     by (rule safe_isnFDERIV; fact)
   also
   have "list_of_eucl (eucl_of_list xs::'a) = xs"
     by (auto intro!: nth_equalityI)
   finally show ?thesis .
 qed
 
 lemma dest_Num_eq_Some_iff[simp]: "dest_Num_fa fa = (Some x) \<longleftrightarrow> fa = floatarith.Num x"
   by (cases fa) auto
 
 lemma ode_d_raw_Suc:
   includes floatarith_notation
   assumes "x \<in> Csafe"
   shows "((\<lambda>x. ode_d_raw n x d d) has_derivative ode_d_raw (Suc n) x d) (at x)"
 proof -
   let ?shift = "\<lambda>x. floatarith.Var (if 2 * DIM('a) \<le> x \<and> x < 3 * DIM('a) then x - DIM('a) else x)"
   have subst_ode_e[simp]: "map (subst_floatarith ?shift) ode_e = ode_e"
     apply (auto intro!: nth_equalityI)
     apply (rule subst_floatarith_Var_max_Var_floatarith)
     by (auto dest!: max_Var_floatariths_lessI
         less_le_trans[OF _ safe_max_Var[OF assms]])
   have map_shift[simp]:
     "(map ?shift [DIM('a)..<2 * DIM('a)]) = (map floatarith.Var [DIM('a)..<2 * DIM('a)])"
     "(map ?shift [2 * DIM('a)..<3 * DIM('a)]) =
         (map floatarith.Var [DIM('a)..<2 * DIM('a)])"
     by (auto intro!: nth_equalityI)
 
   show ?thesis
     unfolding ode_def ode_d_raw_def ode_d_expr_def
     apply (rule interpret_floatarith_FDERIV_floatariths_append[THEN has_derivative_eq_rhs])
     subgoal
     proof -
       let ?shift = "\<lambda>x. if 2 * DIM('a) \<le> x \<and> x < 3 * DIM('a) then x - DIM('a) else x"
       have mv: "max_Var_floatariths
           (FDERIV_floatariths (FDERIV_n_floatariths ode_e [0..<DIM('a)] (map floatarith.Var [DIM('a)..<2 * DIM('a)]) n)
           [0..<DIM('a)] (map floatarith.Var [2 * DIM('a)..<3 * DIM('a)])) \<le> 3 * DIM('a)"
         and mv2: "max_Var_floatariths
               (FDERIV_floatariths (FDERIV_n_floatariths ode_e [0..<DIM('a)] (map floatarith.Var [DIM('a)..<2 * DIM('a)]) n)
                 [0..<DIM('a)] (map floatarith.Var [DIM('a)..<2 * DIM('a)])) \<le> 2 * DIM('a)"
         by (auto intro!:
             max_Var_floatarith_FDERIV_floatariths[le]
             max_Var_floatarith_FDERIV_n_floatariths[le]
             safe_max_Var[OF assms, le])
       have eq: "(map (subst_floatarith (\<lambda>i. floatarith.Var (if 2 * DIM('a) \<le> i \<and> i < 3 * DIM('a) then i - DIM('a) else i)))
        ((FDERIV_floatariths (FDERIV_n_floatariths ode_e [0..<DIM('a)] (map floatarith.Var [DIM('a)..<2 * DIM('a)]) n)
          [0..<DIM('a)] (map floatarith.Var [2 * DIM('a)..<3 * DIM('a)])))) =
       (FDERIV_floatariths (FDERIV_n_floatariths ode_e [0..<DIM('a)] (map floatarith.Var [DIM('a)..<2 * DIM('a)]) n)
           [0..<DIM('a)] (map floatarith.Var [DIM('a)..<2 * DIM('a)]))"
         apply (rule nth_equalityI)
          apply auto defer
         apply (subst subst_floatarith_Var_FDERIV_floatarith[where 'a='a], force, force, force)
         apply (subst subst_floatarith_Var_FDERIV_n_nth[where 'a='a], force, force, force, force)
         by (simp add: o_def)
       show ?thesis
         apply (subst isFDERIV_subst_Var_floatarith[symmetric, where s="?shift"])
         subgoal by (auto intro!: mv[le] max_Var_floatariths_fold_const_fa[le])
         subgoal by (auto simp: nth_append)
         subgoal by (auto intro!: mv[le])
         subgoal
         proof -
           have "isnFDERIV DIM('a) ode_e [0..<DIM('a)] [DIM('a)..<2*DIM('a)] (list_of_eucl x @ list_of_eucl d) (Suc (Suc n))"
             apply (rule safe_isnFDERIVI)
             using assms
             by auto
           from this[simplified, THEN conjunct1]
           show ?thesis
             unfolding eq isnFDERIV.simps
             apply (rule isFDERIV_max_Var_congI)
             apply (frule less_le_trans[OF _ mv2])
             apply (auto simp: nth_append)
             done
         qed
         done
     qed
     subgoal
       by (auto intro!: safe_max_Var[OF assms, le]
           max_Var_floatarith_FDERIV_floatariths[le]
           max_Var_floatarith_FDERIV_n_floatariths[le])
     subgoal using safe_length assms by simp
     subgoal
       apply (auto simp add: nth_append
           intro!: ext arg_cong[where f=eucl_of_list] interpret_floatariths_FDERIV_floatariths_cong
           freshs_floatariths_max_Var_floatarithsI
           safe_max_Var[OF assms, le]
           max_Var_floatarith_FDERIV_floatariths[le]
           max_Var_floatarith_FDERIV_n_floatariths[le])
       apply (rule nth_equalityI)
        apply auto
       subgoal premises prems for h i j
       proof -
         have *: "(list_of_eucl x @ list_of_eucl d @ list_of_eucl d @ list_of_eucl h) =
         (map (\<lambda>i. interpret_floatarith (?shift i)
              (list_of_eucl x @ list_of_eucl d @ list_of_eucl d @ list_of_eucl h)) [0..<4 * DIM('a)])"
           by (auto intro!: nth_equalityI simp: nth_append)
         have mv_le: "max_Var_floatarith
                 (DERIV_floatarith j
                   (FDERIV_floatarith
                     (FDERIV_n_floatariths ode_e [0..<DIM('a)] (map floatarith.Var [DIM('a)..<2 * DIM('a)]) n ! i)
                     [0..<DIM('a)] (map floatarith.Var [DIM('a)..<2 * DIM('a)]))) \<le>
                 2 * DIM('a)"
           "max_Var_floatarith
      (DERIV_floatarith j
        (FDERIV_floatarith (FDERIV_n_floatariths ode_e [0..<DIM('a)] (map floatarith.Var [DIM('a)..<2 * DIM('a)]) n ! i)
          [0..<DIM('a)] (map floatarith.Var [2 * DIM('a)..<3 * DIM('a)])))
       \<le> 3 * DIM('a)"
           by (auto intro!: prems
               safe_max_Var[OF assms, le]
               max_Var_floatarith_le_max_Var_floatariths_nth[le]
               max_Var_floatarith_DERIV_floatarith[le]
               max_Var_floatarith_FDERIV_floatarith[le]
               max_Var_floatarith_FDERIV_n_floatariths[le])
         show ?thesis
           apply (subst *)
           apply (subst interpret_floatarith_subst_floatarith[symmetric])
            apply (auto intro!: prems mv_le[le])
           apply (subst subst_floatarith_Var_DERIV_floatarith, use prems in force)
           apply (subst subst_floatarith_Var_FDERIV_floatarith[where 'a='a], force, force, force)
           apply (subst subst_floatarith_Var_FDERIV_n_nth[where 'a='a], force, force, force, use prems in force)
           apply (auto simp: o_def prems nth_append intro!: interpret_floatarith_max_Var_cong
               dest!: less_le_trans[OF _ mv_le(1)])
           done
       qed
       done
     done
 qed
 
 lift_definition ode_d::"nat \<Rightarrow> 'a::executable_euclidean_space \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'a" is
   "\<lambda>n x dn d. if x \<in> Csafe
     then ode_d_raw n x dn d
     else 0"
   subgoal for n x dn
     apply (cases n)
     subgoal
       by (cases "x \<in> Csafe")
        (auto intro: has_derivative_bounded_linear[OF ode_d_raw_0])
     subgoal for n'
       apply (cases "x \<in> Csafe")
       subgoal
         apply (simp del: isnFDERIV.simps)
         apply (rule has_derivative_bounded_linear)
         apply (rule ode_d_raw_Suc)
         apply assumption
         done
       subgoal by (simp del: isnFDERIV.simps)
       done
     done
   done
 
 definition "ode_d1 x = ode_d 0 x 0"
 
 lemma ode_has_derivative:
   assumes "isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl x)"
   assumes "(x::'a::executable_euclidean_space) \<in> Csafe"
   shows "(ode has_derivative ode_d1 x) (at x)"
 proof -
   from assms(1) have *: "x \<in> Csafe \<Longrightarrow> isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl x @ list_of_eucl (0::'a))"
     apply (rule isFDERIV_max_Var_congI)
     using safe_max_Var[of x]
     by (auto simp: nth_append)
   show ?thesis
     unfolding ode_d1_def
     apply (transfer fixing: x)
     apply (rule ode_d_raw_0[THEN has_derivative_eq_rhs])
     by (auto intro!: * assms)
 qed
 
 lemma ode_has_derivative_safeI:
   assumes "x \<in> Csafe"
   shows "(ode has_derivative ode_d1 x) (at x)"
   using assms
   by (auto simp: safe_def Csafe_def intro!: ode_has_derivative)
 
 lemma ode_d1_eq: "ode_d1 x = ode_d 0 x j"
   unfolding ode_d1_def
 proof (transfer fixing: x j, rule ext, cases "x \<in> Csafe", clarsimp_all, goal_cases)
   case (1 d)
   have "isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl x @ list_of_eucl (0::'a)) =
     isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl x @ list_of_eucl j)"
     by (rule isFDERIV_max_Var_cong)
        (auto dest!: less_le_trans[OF _ safe_max_Var[OF 1]] simp: nth_append)
   moreover
   have "interpret_floatariths (FDERIV_floatariths ode_e [0..<DIM('a)] (map floatarith.Var [2 * DIM('a)..<3 * DIM('a)]))
      (list_of_eucl x @ list_of_eucl (0::'a) @ list_of_eucl d) =
     interpret_floatariths (FDERIV_floatariths ode_e [0..<DIM('a)] (map floatarith.Var [2 * DIM('a)..<3 * DIM('a)]))
      (list_of_eucl x @ list_of_eucl j @ list_of_eucl d)"
     using 1
     by (intro interpret_floatariths_fresh_cong)
       (auto dest!: not_fresh_FDERIV_floatariths not_fresh_odeD
         simp: nth_append)
   ultimately show ?case
     by (auto simp: ode_d_raw_def ode_d_expr_def)
 qed
 
 lemma eventually_Collect_open:
   assumes "P x" "open (Collect P)"
   shows "eventually P (at x)"
   using assms(1) assms(2) eventually_at_topological by blast
 
 lemma ode_d_has_derivative:
   assumes "x \<in> Csafe"
   shows "((\<lambda>x. ode_d n x d d) has_derivative ode_d (Suc n) x d) (at x)"
   apply (transfer fixing: n d x)
   using assms
   apply (simp del: isnFDERIV.simps)
   apply (rule if_eventually_has_derivative)
   subgoal by (rule ode_d_raw_Suc)
   subgoal
     by (rule eventually_Collect_open)
       (auto simp: safe_max_Var[OF assms] open_safe intro!: safe_max_Var[OF assms, le])
   subgoal by (simp add: isnFDERIV.simps)
   subgoal by simp
   done
 
 lemma ode_d1_has_derivative:
   assumes "x \<in> Csafe"
   shows "(ode_d1 has_derivative ode_d (Suc 0) x) (at x)"
 proof (rule blinfun_has_derivative_componentwiseI[THEN has_derivative_eq_rhs])
   fix i::'a assume "i \<in> Basis"
   show "((\<lambda>x. blinfun_apply (ode_d1 x) i) has_derivative ode_d (Suc 0) x i) (at x)"
     unfolding ode_d1_eq[of _ i]
     apply (rule ode_d_has_derivative)
     apply fact
     done
 next
   show "(\<lambda>xa. \<Sum>i\<in>Basis. blinfun_scaleR (blinfun_inner_left i) (blinfun_apply (ode_d (Suc 0) x i) xa)) = ode_d (Suc 0) x"
     apply (rule ext)
     apply (auto intro!: ext euclidean_eqI[where 'a='a] blinfun_euclidean_eqI
         simp: blinfun.bilinear_simps inner_sum_left inner_Basis if_distrib if_distribR
         sum.delta' cong: if_cong)
     apply (rule arg_cong[where f="\<lambda>x. x \<bullet> b" for b])
   proof goal_cases
     case (1 j i b)
     from eventually_isFDERIV[where params=Nil, simplified, OF safe_isFDERIV[OF assms] order_trans[OF safe_max_Var[of x]]]
     have "\<forall>\<^sub>F x in at x. isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl x)"
       by (auto simp: assms)
     then obtain S where S: "x \<in> S" "open S" "S \<subseteq> Csafe"
       and "\<And>xa. xa \<in> S \<Longrightarrow> xa \<noteq> x \<Longrightarrow> isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl xa)"
       using assms open_safe safe_isFDERIV by auto
     then have S_FDERIV: "\<And>s. s \<in> S \<Longrightarrow>
       isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl s)"
       using safe_isFDERIV[OF assms]
       by auto
     interpret second_derivative_on_open "ode" ode_d1 "ode_d (Suc 0) x" x S
     proof standard
       fix a assume "a \<in> S"
       with S have "a \<in> Csafe" by auto
       from S_FDERIV[OF \<open>a \<in> S\<close>]
       have "isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl a)" by simp
       then have "isFDERIV DIM('a) [0..<DIM('a)] ode_e (list_of_eucl a)"
         apply (rule isFDERIV_max_Var_congI)
         using safe_max_Var[of x]
         by (auto simp: nth_append)
       then show "(ode has_derivative blinfun_apply (ode_d1 a)) (at a)"
         using \<open>a \<in> Csafe\<close>
         by (rule ode_has_derivative)
     next
       fix i
       interpret linear "ode_d (Suc 0) x"
       proof
         fix y z
         have 1: "((\<lambda>x. ode_d 0 x (y + z) (y + z)) has_derivative ode_d (Suc 0) x (y + z)) (at x)"
           apply (rule ode_d_has_derivative)
           apply (rule assms)
           done
         have *: "ode_d 0 x (y + z) (y + z) = ode_d 0 x y y + ode_d 0 x z z" for x
           by (auto simp: blinfun.bilinear_simps ode_d1_eq[symmetric])
         have 2: "((\<lambda>x. ode_d 0 x (y + z) (y + z)) has_derivative
             ode_d (Suc 0) x y + ode_d (Suc 0) x z) (at x)"
           apply (subst *)
           apply (rule derivative_eq_intros)
             apply (rule ode_d_has_derivative)
             apply fact
            apply (rule ode_d_has_derivative)
            apply fact
           apply (auto simp: blinfun.bilinear_simps)
           done
         from has_derivative_unique[OF 1 2]
         show "ode_d (Suc 0) x (y + z) = ode_d (Suc 0) x y + ode_d (Suc 0) x z"
           by (auto intro!: blinfun_eqI)
       next
         fix r y
         have 1: "((\<lambda>x. ode_d 0 x (r *\<^sub>R y) (r *\<^sub>R y)) has_derivative ode_d (Suc 0) x (r *\<^sub>R y)) (at x)"
           by (rule ode_d_has_derivative; fact)
         have *: "ode_d 0 x (r *\<^sub>R y) (r *\<^sub>R y) = r *\<^sub>R ode_d 0 x y y" for x
           by (auto simp: blinfun.bilinear_simps ode_d1_eq[symmetric])
         have 2: "((\<lambda>x. ode_d 0 x (r *\<^sub>R y) (r *\<^sub>R y)) has_derivative
             r *\<^sub>R ode_d (Suc 0) x y) (at x)"
           apply (subst *)
           apply (rule derivative_eq_intros)
           apply (rule ode_d_has_derivative; fact)
           apply (auto simp: blinfun.bilinear_simps)
           done
         from has_derivative_unique[OF 1 2]
         show "(ode_d (Suc 0) x (r *\<^sub>R y)) = (r *\<^sub>R ode_d (Suc 0) x y)"
           by (auto intro!: blinfun_eqI)
       qed
       show "((\<lambda>x. blinfun_apply (ode_d1 x) i) has_derivative blinfun_apply (ode_d (Suc 0) x i))
           (at x)"
         apply (subst euclidean_representation[of i, symmetric])
         apply (subst (2) euclidean_representation[of i, symmetric])
         apply (auto simp: blinfun.bilinear_simps)
         apply (rule derivative_eq_intros)
          apply (rule derivative_eq_intros)
           apply (subst_tac j = i in ode_d1_eq)
           apply (rule ode_d_has_derivative)
           apply (rule assms)
         apply force
         apply (auto simp: blinfun.bilinear_simps[symmetric]
             intro!: ext euclidean_eqI[where 'a='a] blinfun_euclidean_eqI)
         apply (rule arg_cong[where f="\<lambda>x. x \<bullet> b" for b])
         by (auto simp: sum scaleR)
     next
       show "x \<in> S" "open S" by fact+
     qed
     show ?case
       by (rule symmetric_second_derivative) fact
   qed
 qed
 
 lemma ode_d1_has_derivative_safeI:
   assumes "x \<in> Csafe"
   shows "(ode_d1 has_derivative ode_d (Suc 0) x) (at x)"
   apply (rule ode_d1_has_derivative)
   using assms by (auto simp: safe_def)
 
 sublocale c1_on_open_euclidean ode ode_d1 Csafe
   by unfold_locales
     (auto simp: continuous_on_eq_continuous_within at_within_open[OF _ open_safe]
       intro!: derivative_eq_intros  continuous_at_imp_continuous_on open_safe
         ode_has_derivative_safeI continuous_blinfun_componentwiseI
         has_derivative_continuous ode_d1_has_derivative_safeI)
 
 definition ivlflows ::
     "'a::executable_euclidean_space sctn set
      \<Rightarrow> (('a \<times> 'a \<Rightarrow>\<^sub>L 'a) set
          \<Rightarrow> ('a \<times> 'a \<Rightarrow>\<^sub>L 'a) set \<times> ('a \<times> 'a \<Rightarrow>\<^sub>L 'a) set)
         \<Rightarrow> ('a \<times> 'a \<Rightarrow>\<^sub>L 'a) set \<Rightarrow> 'a sctn \<Rightarrow> bool"
 where "ivlflows stops stopcont trap rsctn =
   (\<forall>ivl. ivl \<subseteq> \<Union>(plane_of ` stops) \<times> UNIV \<longrightarrow>
       ivl \<subseteq> (snd (stopcont ivl)) \<and>
       fst (stopcont ivl) \<subseteq> snd (stopcont ivl) \<and>
       (fst (stopcont ivl)) \<subseteq> sbelow_halfspace rsctn \<times> UNIV \<and>
       (snd (stopcont ivl)) \<subseteq> sbelow_halfspace rsctn \<times> UNIV \<and>
       flowsto (ivl) {0..} ((snd (stopcont ivl))) ((fst (stopcont ivl)) \<union> trap))"
 
 lift_definition ode_d2::"'a::executable_euclidean_space \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'a \<Rightarrow>\<^sub>L 'a" is "\<lambda>x.
   if x \<in> Csafe then ode_d 1 x else (\<lambda>_. 0)"
   by (auto intro!: has_derivative_bounded_linear ode_d1_has_derivative)
 
 definition ode_na::"real \<times> _ \<Rightarrow> _" where "ode_na = (\<lambda>a. ode (snd a))"
 
 definition ode_d_na::"real \<times> _ \<Rightarrow> (real \<times> _) \<Rightarrow>\<^sub>L _" where "ode_d_na = (\<lambda>tx. ode_d1 (snd tx) o\<^sub>L snd_blinfun)"
 definition ode_d2_na::"real \<times> _ \<Rightarrow> (real \<times> _) \<Rightarrow>\<^sub>L (real \<times> _) \<Rightarrow>\<^sub>L _" where
   "ode_d2_na = (\<lambda>tx. flip_blinfun (flip_blinfun (ode_d2 (snd tx) o\<^sub>L snd_blinfun) o\<^sub>L snd_blinfun))"
 
 definition "euler_incr_fas' D = (map fold_const_fa (euler_incr_fas (map floatarith.Var [0..<D]) (floatarith.Var (D))
       (map floatarith.Var [Suc D..<Suc (2*D)])))"
 definition "euler_fas' D = (map fold_const_fa (euler_fas  (map floatarith.Var [0..<D])
     (floatarith.Var (2*D)) (map floatarith.Var [D..<2*D])))"
 definition "rk2_fas' D = (map fold_const_fa (rk2_fas
     (floatarith.Var (2*D))
     (map floatarith.Var [0..<D])
     (floatarith.Var (2*D+1))
     (map floatarith.Var [D..<2*D])
     (floatarith.Var (2*D+2))))"
 lemma [autoref_rules]: "(euler_incr_fas', euler_incr_fas') \<in> nat_rel \<rightarrow> fas_rel"
   "(euler_fas', euler_fas') \<in> nat_rel \<rightarrow> fas_rel"
   "(rk2_fas', rk2_fas') \<in> nat_rel \<rightarrow> fas_rel"
   by auto
 
 definition "solve_poincare_fas n =
   (let D = length ode_e in
   map floatarith.Var [0..<D] @ concat (map (\<lambda>i \<comment> \<open>(row)\<close>. map (\<lambda>j \<comment> \<open>(column)\<close>.
     (if i \<noteq> n then floatarith.Var (D + i * D + j) - (floatarith.Var(D + n * D + j) * (ode_e ! i) / (ode_e ! n))
     else 0)
   ) [0..<D]) [0..<D]))"
 
 end
 
 definition "nonempty X \<longleftrightarrow> X \<noteq> {}"
 
 definition pad_zeroes :: "nat \<Rightarrow> real list set \<Rightarrow> real list set"
   where [simp]: "pad_zeroes n X = (\<lambda>xs. xs @ replicate n (0::real)) ` X"
 
 locale approximate_sets_ode = approximate_sets where ops = ops + ode_operations
   where ode_ops = ode_ops
   for ops:: "'b approximate_set_ops"
     and ode_ops::"ode_ops"
 begin
 
 definition "D = (length ode_e)"
 definition "ode_slp = slp_of_fas ode_e"
 definition "euler_slp = slp_of_fas (euler_fas' D)"
 definition "euler_incr_slp = slp_of_fas (euler_incr_fas' D)"
 definition "rk2_slp = slp_of_fas (rk2_fas' D)"
 definition "solve_poincare_slp = map (\<lambda>i. slp_of_fas (map fold_const_fa (solve_poincare_fas i))) [0..<D]"
 
 definition safe_set
   where "safe_set (X::'a::executable_euclidean_space set) = do {
     b1 \<leftarrow> approx_form_spec safe_form (list_of_eucl ` X);
     b2 \<leftarrow> isFDERIV_spec D [0..<D] ode_e (list_of_eucl ` X);
     RETURN (b1 \<and> b2)
   }"
 
 definition "wd TYPE('a::executable_euclidean_space) \<longleftrightarrow> length ode_e = DIM('a)"
   \<comment> \<open>TODO: should be renamed\<close>
 
 lemma open_safe_form[intro, simp]: "open_form safe_form"
   by (auto simp: safe_form_def)
 
 lemma max_Var_floatariths_ode_e_le: "max_Var_floatariths ode_e \<le> D"
   and max_Var_form_safe_form_le: "max_Var_form safe_form \<le> D"
   using max_Var_ode_expression[of ode_ops] max_Var_form_safe_form_expr[of ode_ops]
   by (auto simp: ode_e_def safe_form_def D_def)
 
 lemma wdD:
   assumes "wd TYPE('a::executable_euclidean_space)"
   shows "length ode_e = DIM('a)" "max_Var_floatariths ode_e \<le> DIM('a)"
     "max_Var_form safe_form \<le> DIM('a)"
     "ode_e \<noteq> []" "D = DIM('a)"
   using assms max_Var_floatariths_ode_e_le max_Var_form_safe_form_le
   by (auto simp: wd_def D_def safe_form_def ode_e_def)
 
 definition "mk_safe (X::'a::executable_euclidean_space set) = do {
     ASSERT (wd TYPE('a));
     s \<leftarrow> safe_set (X:::appr_rel::'a set);
     if s then RETURN (X:::appr_rel) else SUCCEED
   }"
 
 definition
   "mk_safe_coll X = do {
       XS \<leftarrow> (sets_of_coll X);
       FORWEAK XS (RETURN op_empty_coll)
         (\<lambda>x. do {
           s \<leftarrow> mk_safe (x);
           RETURN (mk_coll s)
         })
         (\<lambda>b c. RETURN (b \<union> c))
     }"
 
 definition ode_set::"'a::executable_euclidean_space set \<Rightarrow> 'a set nres" where "ode_set X = do {
   _ \<leftarrow> mk_safe X;
   approx_slp_appr ode_e ode_slp (list_of_eucl ` (X))
   }"
 
 definition
   "Picard_step X0 t0 h X = SPEC (\<lambda>R.
     case R of
       Some R \<Rightarrow>
         nonempty R \<and> compact R \<and> (R \<subseteq> Csafe) \<and>
         (\<forall>x0 \<in> X0. \<forall>h'\<in>{t0 .. t0 + h}. \<forall>phi\<in>cfuncset t0 h' X.
           x0 + integral {t0 .. h'} (\<lambda>t. ode (phi t)) \<in> R)
       | None \<Rightarrow> True)"
 
 lemmas [refine_vcg_def] = approx_form_spec_def isFDERIV_spec_def
 
 lemma safe_set_spec[THEN order.trans, refine_vcg]:
   assumes "wd TYPE('a::executable_euclidean_space)"
   shows "safe_set X \<le> SPEC (\<lambda>r. r \<longrightarrow> (X::'a set) \<subseteq> Csafe)"
   unfolding safe_set_def
   by (refine_vcg) (auto simp del: isnFDERIV.simps simp add: Csafe_def safe_def replicate_eq_list_of_eucl_zero wdD[OF \<open>wd _\<close>])
 
 
 definition Picard_step_ivl :: "'a::executable_euclidean_space set \<Rightarrow> real \<Rightarrow> real \<Rightarrow> 'a set \<Rightarrow> 'a set option nres" where
   "Picard_step_ivl X0 t0 h X = do {
     ASSERT (0 \<le> h);
     ASSERT (wd TYPE('a));
     let H = lv_ivl [0] [h];
     let D = DIM('a);
     let env = concat ` listset [list_of_eucl ` X0, H, list_of_eucl ` X];
     env \<leftarrow> approx_slp_spec (euler_incr_fas' D) D euler_incr_slp env;
     (case env of
       Some env \<Rightarrow>
         do {
           (l, u) \<leftarrow> op_ivl_rep_of_set ((eucl_of_list ` env::'a set));
           ASSERT (l \<le> u);
           r \<leftarrow> mk_safe ({l .. u}:::appr_rel);
           RETURN (Some (r:::appr_rel))
         }
     | None \<Rightarrow> RETURN None)
   }"
 
 definition "do_widening_spec (i::nat) = SPEC (\<lambda>b::bool. True)"
 
 primrec P_iter::"'a::executable_euclidean_space set \<Rightarrow> real \<Rightarrow> nat \<Rightarrow> ('a) set \<Rightarrow> ('a) set option nres" where
   "P_iter X0 h 0 X = do {
     let _ = trace_set (ST ''P_iter failed (0)'') (Some (X));
     RETURN None
   }"
 | "P_iter X0 h (Suc i) X = do {
     ASSERT (0 \<le> h);
     (l, u) \<leftarrow> op_ivl_rep_of_set (X);
     ASSERT (l \<le> u);
     ivl \<leftarrow> mk_safe ({l .. u}:::appr_rel);
     X' \<leftarrow> Picard_step_ivl X0 0 h ivl;
     (case X' of
       Some X' \<Rightarrow> do {
         (l', u') \<leftarrow> op_ivl_rep_of_set (X');
         do_widening \<leftarrow> do_widening_spec i;
         let l' = inf l' l - (if do_widening then abs (l' - l) else 0);
         let u' = sup u' u + (if do_widening then abs (u' - u) else 0);
         ASSERT (l' \<le> u');
         ivl' \<leftarrow> mk_safe {l' .. u'};
         if (l \<le> l' \<and> u' \<le> u) then RETURN (Some ivl)
         else P_iter X0 h i ivl'
       }
     | None \<Rightarrow> do {
         let _ = trace_set (ST ''P_iter failed (Picard_step)'') (Some (X));
         RETURN None
       }
     )
   }"
 
 
 context fixes m::"('a::executable_euclidean_space set \<Rightarrow> real \<Rightarrow> real \<Rightarrow> 'a set \<Rightarrow> ('a set \<times> 'c) option nres)"
 begin
 
 primrec cert_stepsize::
   "'a set \<Rightarrow> real \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (real \<times> 'a set \<times> 'a set \<times> 'c) nres"
 where
   "cert_stepsize X0 h n 0 = do { let _ = trace_set (ST ''cert_stepsize failed'') (Some (X0)); SUCCEED}"
 | "cert_stepsize X0 h n (Suc i) = do {
     (l, u) \<leftarrow> op_ivl_rep_of_set (X0);
     ASSERT (0 \<le> h);
     ASSERT (l \<le> u);
     ivl \<leftarrow> mk_safe {l .. u};
     ASSERT (ivl \<noteq> {});
     X' \<leftarrow> P_iter X0 h n ivl;
     case X' of Some X' \<Rightarrow>
       do {
         r1 \<leftarrow> m X0 h h X';
         r2 \<leftarrow> m X0 0 h X';
         (case (r1, r2) of
           (Some (res, err), Some (res_ivl, _)) \<Rightarrow>
             do {
               _ \<leftarrow> mk_safe res;
               _ \<leftarrow> mk_safe res_ivl;
               RETURN (h, res, res_ivl, err)
             }
         | _ \<Rightarrow>
             do {
               let _ = trace_set (ST ''cert_stepsize method failed'') (Some (X'));
               cert_stepsize X0 (h / 2) n i
             }
        )
       }
     | None \<Rightarrow> cert_stepsize X0 (h / 2) n i
     }"
 end
 
 definition "one_step_method m \<longleftrightarrow> (\<forall>X0 CX hl hu. m X0 hl hu CX \<le>
     SPEC (\<lambda>r. case r of None \<Rightarrow> True | Some (res, err) \<Rightarrow> nonempty res \<and>
       (\<forall>x0 \<in> X0. \<forall>h \<in> {hl .. hu}. x0 \<in> Csafe \<longrightarrow> h \<ge> 0 \<longrightarrow> h \<in> existence_ivl0 x0 \<longrightarrow>
       (\<forall>h' \<in> {0 .. h}. flow0 x0 h' \<in> CX) \<longrightarrow> x0 + h *\<^sub>R ode x0 \<in> CX \<longrightarrow> flow0 x0 h \<in> res)))"
 
 definition "one_step X0 h m = do {
   CHECKs ''one_step nonneg'' (0 < h);
   its \<leftarrow> iterations_spec;
   halvs \<leftarrow> halve_stepsizes_spec;
   (h, res, res_ivl, err) \<leftarrow> cert_stepsize m X0 h its halvs;
   ASSERT (0 < h);
   RETURN (h, err, res_ivl, res)
   }"
 
 definition [refine_vcg_def]: "default_reduce_argument_spec = SPEC (\<lambda>x::unit. True)"
 
 definition "euler_step X0 h = one_step X0 h (\<lambda>X0 hl hu CX.
    do {
     let H = lv_ivl [min hl hu] [max hl hu];
     _ \<leftarrow> mk_safe CX;
     let env = concat ` listset [list_of_eucl ` X0, list_of_eucl ` CX, H];
     env \<leftarrow> approx_slp_spec (euler_fas' DIM('a)) (2 * DIM('a)) euler_slp env;
     case env of None \<Rightarrow> RETURN None
     | Some env \<Rightarrow> do {
       let res' = take DIM('a) ` env;
       ASSERT (env_len res' DIM('a));
       let res = (eucl_of_list ` res');
       ASSUME (ncc res);
       let err' = drop DIM('a) ` take (DIM('a) * 2) ` env;
       ASSERT (env_len err' DIM('a));
       let err = (eucl_of_list ` err'::'a::executable_euclidean_space set);
       ra \<leftarrow> default_reduce_argument_spec;
       res \<leftarrow> reduce_spec ra res;
       ASSUME (ncc res);
       s \<leftarrow> safe_set res;
       if s then
       do {
         res \<leftarrow> mk_safe res;
         RETURN (Some (res::'a set, err))
       } else RETURN None
     }
   })"
 
 definition "rk2_step X0 h = one_step X0 h (\<lambda>X0 hl hu CX.
   do {
     let H = lv_ivl [min hl hu] [max hl hu];
     rps \<leftarrow> rk2_param_spec;
     let rkp = lv_ivl [rps] [rps];
     let s2 = lv_ivl [0] [1];
     _ \<leftarrow> mk_safe CX;
     ASSUME (ncc CX);
     let env = concat ` listset [list_of_eucl ` X0, list_of_eucl ` CX, rkp, H, s2];
     env \<leftarrow> approx_slp_spec (rk2_fas' DIM('a)) (2 * DIM('a)) rk2_slp env;
     case env of None \<Rightarrow> RETURN None
     | Some env \<Rightarrow> do {
       let res' = take DIM('a) ` env;
       ASSERT (env_len res' DIM('a));
       let res = (eucl_of_list ` res'::'a::executable_euclidean_space set);
       ASSUME (ncc res);
       let err' = drop DIM('a) ` take (DIM('a) * 2) ` env;
       ASSERT (env_len err' DIM('a));
       let err = (eucl_of_list ` err'::'a set);
       ra \<leftarrow> default_reduce_argument_spec;
       res \<leftarrow> reduce_spec ra res;
       ASSUME (ncc res);
       s \<leftarrow> safe_set res;
       if s then
       do {
         res \<leftarrow> mk_safe res;
         RETURN (Some (res, err))
       } else RETURN None
     }
   })"
 
 definition "choose_step X0 h = do {
   mid \<leftarrow> method_spec;
   (if mid = 2 then rk2_step X0 h else euler_step X0 h)
 }"
 
 definition "ode_e' = (ode_e @
   mmult_fa D D D (concat (map (\<lambda>j. map (\<lambda>i.
       (FDERIV_floatarith (ode_e ! j) [0..<D] ((replicate D 0)[i := 1]))) [0..<D]) [0..<D]))
     (map floatarith.Var [D..<D + D*D]))"
 
 definition "transversal_directions f =
   do {
     (I, S) \<leftarrow> op_ivl_rep_of_set f;
     RETURN (sum_list (map (\<lambda>b. (if I \<bullet> b \<le> 0 then if S \<bullet> b \<le> 0 then S \<bullet> b else 0 else if S \<bullet> b \<ge> 0 then I \<bullet> b else 0) *\<^sub>R b)
       (Basis_list::'a::executable_euclidean_space list)))
   }"
 
 definition "intersects_sctns X' sctns = do {
     ASSUME (finite sctns);
     FOREACH\<^bsup>\<lambda>sctns' b. \<not>b \<longrightarrow> X' \<inter> \<Union>(plane_of ` (sctns - sctns')) = {}\<^esup> sctns
           (\<lambda>sctn b. do {b' \<leftarrow> op_intersects ( X') sctn; RETURN (b \<or> b')}) False
    }"
 
 definition "trace_sets s X = do {
     XS \<leftarrow> sets_of_coll (X:::clw_rel (appr_rel)); FORWEAK XS (RETURN ()) (\<lambda>X. RETURN (trace_set s (Some X))) (\<lambda>_ _. RETURN ())
   }"
 
 definition "print_sets s X = do {
     XS \<leftarrow> sets_of_coll (X:::clw_rel (appr_rel)); FORWEAK XS (RETURN ()) (\<lambda>X. RETURN (print_set s (X))) (\<lambda>_ _. RETURN ())
   }"
 
 definition "intersects_sctns_spec_clw R sctns = do {
     Rs \<leftarrow> sets_of_coll ((R:::clw_rel appr_rel):::clw_rel(appr_rel));
     FORWEAK Rs (RETURN False) (\<lambda>R. intersects_sctns R sctns) (\<lambda>a b. RETURN (a \<or> b))
   }"
 
 definition [simp]: "nonneg_reals = ({0..}::real set)"
 definition [simp]: "pos_reals = ({0<..}::real set)"
 
 definition "nonzero_component s X n = do {
     I \<leftarrow> Inf_inner X n;
     S \<leftarrow> Sup_inner X n;
     CHECKs s (I > 0 \<or> S < 0)
   }"
 
 definition "disjoints_spec X Y = do {
     Xi \<leftarrow> ivls_of_sets X;
     IS \<leftarrow> inter_overappr (Xi:::clw_rel lvivl_rel) (Y:::clw_rel lvivl_rel);
     RETURN (is_empty IS)
   }"
 
 definition subset_spec_plane :: "'a::executable_euclidean_space set \<Rightarrow> 'a sctn \<Rightarrow> bool nres" where
 "subset_spec_plane X sctn = do {
     CHECKs ''subset_spec_plane: not in Basis'' (abs (normal sctn) \<in> set Basis_list);
     (i, s) \<leftarrow> ivl_rep X;
     RETURN (i \<bullet> normal sctn = pstn sctn \<and> s \<bullet> normal sctn = pstn sctn)
   }"
 
 definition "op_eventually_within_sctn X sctn S = do {
     (l, u) \<leftarrow> ivl_rep S;
     (xl, xu) \<leftarrow> op_ivl_rep_of_set X;
     CHECKs (ST ''op_eventually_within_sctn: empty ivl'') (l \<le> u);
     CHECKs (ST ''op_eventually_within_sctn: not in Basis'') (abs (normal sctn) \<in> set Basis_list);
     b \<leftarrow> subset_spec_plane S sctn;
     CHECKs (ST ''op_eventually_within_sctn: subset_spec_plane 1'') b;
     b \<leftarrow> subset_spec_plane ({xl .. xu}:::lvivl_rel) sctn;
     CHECKs (ST ''op_eventually_within_sctn: subset_spec_plane 2'') b;
     RETURN (b \<and> (\<forall>i \<in> set Basis_list - {abs (normal sctn)}. l \<bullet> i < xl \<bullet> i \<and> xu \<bullet> i < u \<bullet> i))
   }"
 
 definition [simp]: "uninfo X = X"
 
 definition [simp]: "op_subset_ivl a b \<longleftrightarrow> a \<subseteq> b"
 
 definition [simp]: "op_eq_ivl a b \<longleftrightarrow> a = b"
 
 abbreviation "iplane_rel \<equiv> \<lambda>A. \<langle>A, \<langle>lv_rel\<rangle>plane_rel\<rangle>inter_rel"
 abbreviation "isbelow_rel \<equiv> \<lambda>A. \<langle>A, \<langle>lv_rel\<rangle>sbelow_rel\<rangle>inter_rel"
 abbreviation "isbelows_rel \<equiv> \<lambda>A. \<langle>A, \<langle>lv_rel\<rangle>sbelows_rel\<rangle>inter_rel"
 
 definition [refine_vcg_def]: "get_plane X = SPEC (\<lambda>sctn. X = plane_of sctn)"
 
 definition "tolerate_error Y E =
   do {
     (ei, es) \<leftarrow> op_ivl_rep_of_set (E);
     (yi, ys) \<leftarrow> op_ivl_rep_of_set (Y);
     let ea = sup (abs ei) (abs es);
     let ya = sup (abs yi) (abs ys);
     rtol \<leftarrow> adaptive_rtol_spec;
     atol \<leftarrow> adaptive_atol_spec;
     let errtol = sup (rtol *\<^sub>R ya) (atol *\<^sub>R sum_list Basis_list);
     RETURN (ea \<le> errtol, infnorm ea)
   }"
 
-definition "adapt_stepsize_fa rtol mid e h' =
-  floatarith.Num (float_of h') * floatarith.Powr (floatarith.Num (float_of (rtol)) / floatarith.Num (float_of e))
-                                (inverse (floatarith.Num (float_of (real_of_nat mid) + 1)))"
+definition "adapt_stepsize_fa rtol m e h' =
+  floatarith.Num (float_of h') *
+  floatarith.Powr (floatarith.Num (float_of (rtol)) / floatarith.Num (float_of e))
+    (inverse (floatarith.Num (float_of (real_of_nat m) + 1)))"
 
 end
 
 
 text \<open>With ODE operations for variational equation\<close>
 
 locale approximate_sets_ode' = approximate_sets_ode\<comment> \<open>TODO: this prevents infinite chain of interpretations (?!)\<close>
   where ops = ops
     and ode_ops = ode_ops
   for ops :: "'b approximate_set_ops"
     and ode_ops
 begin
 
 lift_definition var_ode_ops::ode_ops is "(ode_e', safe_form)"
   using max_Var_floatariths_ode_e_le max_Var_form_safe_form_le
   by (auto simp: ode_e'_def D_def length_concat o_def sum_list_triv
       intro!: max_Var_floatariths_mmult_fa[le] max_Var_floatariths_concat max_Var_floatariths_mapI
       max_Var_floatarith_FDERIV_floatarith[le] max_Var_floatariths_list_update
       max_Var_floatariths_replicateI
       max_Var_floatarith_le_max_Var_floatariths_nth[le])
 
 sublocale var: approximate_sets_ode where ode_ops = var_ode_ops
   by unfold_locales
 
 end
 
 lifting_update ode_ops.lifting
 lifting_forget ode_ops.lifting
 
 end
\ No newline at end of file
diff --git a/thys/Ordinary_Differential_Equations/Numerics/Abstract_Reachability_Analysis_C1.thy b/thys/Ordinary_Differential_Equations/Numerics/Abstract_Reachability_Analysis_C1.thy
--- a/thys/Ordinary_Differential_Equations/Numerics/Abstract_Reachability_Analysis_C1.thy
+++ b/thys/Ordinary_Differential_Equations/Numerics/Abstract_Reachability_Analysis_C1.thy
@@ -1,1108 +1,1109 @@
 theory Abstract_Reachability_Analysis_C1
   imports
     Abstract_Reachability_Analysis
   "../Refinement/Weak_Set"
   "../Refinement/Refine_Parallel"
   "../Refinement/Refine_Default"
   "../Refinement/Refine_Phantom"
   "../Refinement/Refine_ScaleR2"
 begin
 
 definition blinfun_of_list :: "real list \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'a::executable_euclidean_space"
   where "blinfun_of_list xs = blinfun_of_matrix (\<lambda>i j. xs ! ((index Basis_list i) * DIM('a) + (index Basis_list j)))"
 
 definition vec1_of_list :: "real list \<Rightarrow> 'n::{finite, one, plus} vec1"
   where "vec1_of_list xs =
     (vector (take CARD('n) xs), vector (map (\<lambda>i. vector (nths xs {CARD('n)*i..CARD('n)*Suc i})) [1..<Suc (CARD('n))]))"
 
 definition flow1_of_vec1 :: "'n vec1 \<Rightarrow> ('n rvec * ('n rvec \<Rightarrow>\<^sub>L 'n::finite rvec))"
   where "flow1_of_vec1 xs = (fst xs, blinfun_of_vmatrix (snd xs))"
 
 definition vec1_of_flow1 :: "('n::finite eucl1) \<Rightarrow> 'n vec1"
   where "vec1_of_flow1 xs = (fst xs, matrix (snd xs))"
 
 lemma vec1_of_flow1_flow1_of_vec1[simp]:
   "vec1_of_flow1 (flow1_of_vec1 X) = X"
   unfolding vec1_of_flow1_def flow1_of_vec1_def
   by (transfer) (auto simp: matrix_of_matrix_vector_mul)
 
 definition "flow1_of_list xs =
   (eucl_of_list (take DIM('a::executable_euclidean_space) xs)::'a,
     blinfun_of_list (take (DIM('a)*DIM('a)) (drop DIM('a) xs @
     replicate (DIM('a)*DIM('a) - (length xs - DIM('a))) 0))::'a\<Rightarrow>\<^sub>L'a)"
 
 
 lemma blinfun_of_list_eq_blinfun_of_vmatrix:
   assumes "length xs = CARD('n)*CARD('n::enum)"
   shows "blinfun_of_list xs = blinfun_of_vmatrix (eucl_of_list xs::((real, 'n) vec, 'n) vec)"
   using assms
   apply (auto simp: blinfun_of_list_def)
   apply (auto intro!: simp: blinfun_ext blinfun_of_vmatrix.rep_eq blinfun_of_matrix.rep_eq)
   subgoal for i
     apply (subst (2) eucl_of_list_list_of_eucl[symmetric, of i])
     apply (subst eucl_of_list_matrix_vector_mult_eq_sum_nth_Basis_list)
     by (auto simp: sum_Basis_sum_nth_Basis_list scaleR_sum_left intro!: sum.cong)
   done
 
 
 definition "ghost_rel = Pair () ` UNIV"
 consts i_ghost::interface
 lemmas [autoref_rel_intf] = REL_INTFI[of ghost_rel i_ghost]
 lemma ghost_relI: "((), x) \<in> ghost_rel" by (auto simp: ghost_rel_def)
 
 definition [refine_vcg_def]: "GSPEC x = SPEC x"
 lemma [autoref_op_pat_def]: "GSPEC x \<equiv> Autoref_Tagging.OP (GSPEC x)" by auto
 
 lemma GSPEC_impl[autoref_rules]:
   assumes "SIDE_PRECOND (Ex P)"
   shows "(RETURN (), GSPEC P) \<in> \<langle>ghost_rel\<rangle>nres_rel"
   using assms by (auto simp: nres_rel_def ghost_rel_def GSPEC_def intro!: RETURN_SPEC_refine)
 
 context approximate_sets_ode' begin
 
 definition "c1_info_of_appr XD =
   (case snd XD of None \<Rightarrow> eucl_of_list ` set_of_appr (fst XD) \<times> UNIV
    | Some DD \<Rightarrow> flow1_of_list ` set_of_appr (fst XD @ DD))"
 definition "c1_info_of_apprs x = \<Union>(set (map c1_info_of_appr x))"
 definition "c1_info_of_appr' x = Affine_Code.the_default UNIV (map_option c1_info_of_apprs x)"
 definition "c1_info_of_appre X = scaleR2 (fst (fst X)) (snd (fst X)) (c1_info_of_appr (snd X))"
 definition "c1_info_of_apprse x = \<Union>(set (map c1_info_of_appre x))"
 
 
 definition [simp]: "op_image_flow1_of_vec1 = (`) flow1_of_vec1"
 
 definition [simp]: "op_image_flow1_of_vec1_coll = (`) flow1_of_vec1"
 
 definition [simp]: "op_image_fst = (`) fst"
 
 definition [refine_vcg_def]:
   "vec1rep CX = SPEC (\<lambda>R. case R of None \<Rightarrow> True | Some X \<Rightarrow> X = vec1_of_flow1 ` CX)"
 
 definition [simp]: "op_times_UNIV X = X \<times> UNIV"
 
 definition appr1_rel::"(('b list \<times> 'b list option) \<times>
   ('a::executable_euclidean_space c1_info set)) set"
   where appr1_rel_internal: "appr1_rel = {((xs, None), X \<times> UNIV) |xs X. (xs, X) \<in> appr_rel} \<union>
 {((xs, Some ys), X::('a c1_info) set) |xs ys X. X = flow1_of_list ` set_of_appr (xs @ ys) \<and>
   length xs = DIM('a::executable_euclidean_space) \<and>
   length ys = DIM('a) * DIM('a)}"
 
 abbreviation "appr1e_rel \<equiv> \<langle>appr1_rel\<rangle>scaleR2_rel"
 
 text \<open>TODO: remove \<open>...:::relation\<close> from this file\<close>
 definition "solve_poincare_plane (n::'n::enum rvec) (CX::'n eucl1 set) = do {
     X \<leftarrow> mk_safe (((`) fst CX::'n rvec set));
     F \<leftarrow> ode_set (X);
     nonzero_component (ST ''solve_poincare_map: not nonzero!'') F n;
     let i = index Basis_list n;
     ASSERT (i < length solve_poincare_slp);
     vCX \<leftarrow> vec1rep CX;
     case vCX of None \<Rightarrow>
       do {
         RETURN (op_times_UNIV (X))
       }
     | Some vCX \<Rightarrow>
       do {
         (R::'n vec1 set) \<leftarrow> approx_slp_appr (map fold_const_fa (solve_poincare_fas i)) (solve_poincare_slp ! i) (list_of_eucl ` vCX);
         let R = (op_image_flow1_of_vec1 (R:::appr_rel):::appr1_rel);
         X \<leftarrow> mk_safe (op_image_fst R);
         F \<leftarrow> ode_set (X);
         nonzero_component (ST ''solve_poincare_map: not nonzero!'') (F) n;
         RETURN (R::'n eucl1 set)
       }
   }"
 
 definition embed1::"'n::enum rvec \<Rightarrow> ('n rvec * (real^'n::enum^'n::enum))" where [simp]: "embed1 x = (x, 0)"
 
 definition "choose_step1 (X::'n::enum eucl1 set) h = do {
     lX \<leftarrow> vec1rep X;
     case lX of None \<Rightarrow>
       do {
         sX \<leftarrow> mk_safe (fst ` X);
         (h, err, CX', X') \<leftarrow> choose_step sX h;
         \<^cancel>\<open>err \<leftarrow> width_spec (err:::appr_rel);\<close>
         RETURN (h, err \<times> UNIV, (CX') \<times> UNIV, (X') \<times> UNIV)
       }
     | Some vX \<Rightarrow>
       do {
         sX \<leftarrow> var.mk_safe vX;
         (h, err, CX', X') \<leftarrow> var.choose_step sX h;
         let CX' = flow1_of_vec1 ` ((CX':::appr_rel):::appr_rel);
         let X' = flow1_of_vec1 ` ((X':::appr_rel):::appr_rel);
         let err' = flow1_of_vec1 ` (err:::appr_rel);
         \<^cancel>\<open>err \<leftarrow> width_spec (fst ` (flow1_of_vec1 ` (err:::appr_rel)):::appr_rel);\<close>
         RETURN (h, err', CX', X'::'n eucl1 set)
       }
   }"
 
 definition "plane1_of x = plane_of x \<times> UNIV"
 definition "below1_halfspaces x = below_halfspaces x \<times> UNIV"
 definition "sbelow1_halfspaces x = sbelow_halfspaces x \<times> UNIV"
 abbreviation "plane1_invar_rel \<equiv> \<lambda>A. \<langle>(\<langle>lv_rel\<rangle>sctn_rel), A\<rangle>invar_rel plane1_of "
 
 definition "c1_info_invar N XD \<longleftrightarrow> length (fst XD) = N \<and> (case snd XD of Some DD \<Rightarrow> length DD = (length (fst XD))\<^sup>2 | None \<Rightarrow> True)"
 
 definition op_image_zerofst :: "('a \<times> 'c) set \<Rightarrow> ('a::zero \<times> 'c) set"
   where [simp]: "op_image_zerofst \<equiv> \<lambda>X. (\<lambda>x. (0, snd x)) ` X"
 
 definition op_image_zerofst_vec :: "('n::enum vec1) set \<Rightarrow> ('n::enum vec1) set"
   where [simp]: "op_image_zerofst_vec \<equiv> \<lambda>X. (\<lambda>x. (0, snd x)) ` X"
 
 definition [simp]: "op_image_embed1 X = embed1 ` X"
 
 definition "inter_sctn1_spec (X::'n::enum eucl1 set) (sctn::'n rvec sctn) = do {
     R \<leftarrow> inter_sctn_spec (fst ` X) sctn;
     vX \<leftarrow> vec1rep X;
     case vX of None \<Rightarrow>
       do {
         let R1 = R \<times> UNIV;
         RETURN (R1, R1)
       }
     | Some X \<Rightarrow>
       do {
         let sctn = ((Sctn (embed1 (normal sctn)) (pstn sctn)::'n vec1 sctn));
         R1 \<leftarrow> inter_sctn_spec X sctn;
         let R2 = op_image_zerofst_vec X + op_image_embed1 R;
         RETURN ((flow1_of_vec1 ` R1), (flow1_of_vec1 ` R2))
       }
   }"
 
 definition "op_image_fst_coll_nres XS = do {
     XSs \<leftarrow> sets_of_coll XS;
     FORWEAK XSs (RETURN op_empty_coll) (\<lambda>X.
       RETURN (mk_coll (op_image_fst X:::appr_rel))) (\<lambda>A B. RETURN (B \<union> A))
   }"
 
 lemma op_image_fst_coll_nres_spec[le, refine_vcg]: "op_image_fst_coll_nres X \<le> SPEC (\<lambda>R. R = fst ` X)"
   unfolding op_image_fst_coll_nres_def
   by (refine_vcg FORWEAK_mono_rule[where I="\<lambda>it s. fst ` \<Union>it \<subseteq> s \<and> s \<subseteq> fst ` X"])
     (auto, force+)
 
 definition [simp]: "op_image_fst_coll = (`) fst"
 
 definition "fst_safe_coll XS = do {
     C \<leftarrow> op_image_fst_coll_nres XS;
     mk_safe_coll (C:::clw_rel appr_rel)
   }"
 
 definition [refine_vcg_def]:
   "vec1reps X = do {
     XS \<leftarrow> sets_of_coll X;
     FORWEAK XS (RETURN (Some op_empty_coll))
       (\<lambda>x. do {
         x \<leftarrow> vec1rep x;
         RETURN (map_option mk_coll x:::\<langle>clw_rel appr_rel\<rangle>option_rel)
       })
       (\<lambda>a b.
         case (a, b) of (Some a, Some b) \<Rightarrow> RETURN (Some (b \<union> a))
         | _ \<Rightarrow> RETURN None)
   }"
 
 definition "do_intersection_spec S guards ivl sctn X0 = (\<lambda>(PS, CXS).
     poincare_mapsto {x \<in> ivl. x \<in> plane_of sctn} X0 S CXS PS \<and>
       CXS \<inter> guards = {} \<and>
       CXS \<inter> ivl \<inter> plane_of sctn = {} \<and>
       fst ` PS \<inter> guards = {} \<and>
       fst ` PS \<subseteq> {x \<in> ivl. x \<in> plane_of sctn} \<and>
       fst ` PS \<union> CXS \<subseteq> Csafe \<and>
       0 \<notin> (\<lambda>x. ode x \<bullet> normal sctn) ` fst ` PS \<and>
       (\<forall>x\<in>PS. (\<forall>\<^sub>F x in at (fst x) within plane_of sctn. x \<in> ivl)))"
 
 abbreviation "inter_sbelows X sctns \<equiv> mk_inter X (sbelow_halfspaces sctns)"
 
 definition "list_of_appr1 X = fst X @ the_default [] (snd X)"
 
 definition print_set1::"bool \<Rightarrow> 'a set \<Rightarrow> unit" where "print_set1 _ _ = ()"
 
 definition "nonzero_component_within ivl sctn PDP = do {
   fPDP \<leftarrow> mk_safe (fst ` PDP);
   F \<leftarrow> ode_set (fPDP);
   nonzero_component (ST ''solve_poincare_map: not nonzero!'') F (normal sctn);
   op_eventually_within_sctn (op_image_fst PDP:::appr_rel) sctn ivl
 }"
 
 definition "do_intersection_invar guards GUARDS ivl sctn X \<equiv> \<lambda>(X', T, PS, PS2, CXS, intersects, inside).
   (inside \<longrightarrow>
           (fst ` X \<inter> GUARDS = {} \<and>
           fst ` X \<subseteq> sbelow_halfspace sctn \<and>
           ivl \<subseteq> plane_of sctn \<and>
           fst ` X \<subseteq> CXS \<and>
           fst ` PS \<union> fst ` PS2 \<union> CXS \<union> fst ` X' \<subseteq> Csafe \<and>
           T \<subseteq> nonneg_reals \<and>
           (\<not>intersects \<longrightarrow> (fst ` X' \<inter> plane_of sctn = {} \<and> T = pos_reals)) \<and>
           CXS \<subseteq> (sbelow_halfspace sctn - guards) \<and>
           X' \<subseteq> (- guards) \<times> UNIV \<and>
           fst ` (PS \<union> PS2) \<inter> guards = {} \<and>
           (0 \<notin> (\<lambda>x. ode x \<bullet> normal sctn) ` fst ` (PS \<union> PS2)) \<and>
           ((\<forall>x\<in>PS \<union> PS2. (\<forall>\<^sub>F x in at (fst x) within plane_of sctn. x \<in> ivl))) \<and>
           (\<exists>A B. X = A \<union> B \<and>
             flowsto A T (CXS \<times> UNIV) (X' \<inter> (sbelow_halfspace sctn) \<times> UNIV) \<and>
             poincare_mapsto {x \<in> ivl. x \<bullet> normal sctn = pstn sctn} B UNIV CXS PS \<and>
             poincare_mapsto {x \<in> ivl. x \<bullet> normal sctn = pstn sctn} B UNIV CXS PS2)))"
 
 definition "list_of_appr1e X = fst (snd X) @ the_default [] (snd (snd X)) @
   (let (l, u) = fst X;
     roer = (\<lambda>x. if x = - \<infinity> then FloatR 1 (-88) else if x = \<infinity> then FloatR 1 88 else real_of_ereal x)
   in
     appr_of_ivl ops [roer l] [roer u]
     )"
 
 definition print_set1e::"bool \<Rightarrow> 'a set \<Rightarrow> unit" where "print_set1e _ _ = ()"
 
 definition trace_set1e::"string\<Rightarrow>'a set option\<Rightarrow>unit" where "trace_set1e _ _ = ()"
 definition trace_set1::"string\<Rightarrow>'a set option\<Rightarrow>unit" where "trace_set1 _ _ = ()"
 
 definition "split_spec_param1 X = do {
     (vX) \<leftarrow> vec1rep X;
     let D = CARD('n);
     case vX of None \<Rightarrow> do {
       (a, b) \<leftarrow> split_spec_param D (fst ` X::'n::finite rvec set);
       RETURN (a \<times> UNIV, b \<times> UNIV)
     }
     | Some X \<Rightarrow> do {
       (a, b) \<leftarrow> split_spec_param D X;
       RETURN (op_image_flow1_of_vec1 a, op_image_flow1_of_vec1 b)
     }
   }"
 
 abbreviation iinfo_rel :: "('c \<times> 'a set) set \<Rightarrow> ((real \<times> 'c) \<times> 'a::real_normed_vector set) set"
 where "iinfo_rel \<equiv> \<lambda>s. \<langle>rnv_rel, s\<rangle>info_rel"
 
 definition "split_spec_param1e X = do {
     ((l, u), Y) \<leftarrow> scaleR2_rep X;
     (a, b) \<leftarrow> split_spec_param1 Y;
     a \<leftarrow> scaleRe_ivl_spec l u a;
     b \<leftarrow> scaleRe_ivl_spec l u b;
     RETURN (a, b)
   }"
 
 definition "reduce_spec1 C X = do {
   vX \<leftarrow> vec1rep X;
   case vX of None \<Rightarrow> do {
     X \<leftarrow> reduce_spec C (fst ` X);
     RETURN (X \<times> UNIV)
   }
   | Some vX \<Rightarrow> do {
     vX \<leftarrow> reduce_spec C vX;
     RETURN (flow1_of_vec1 ` vX)
   }
 }"
 definition "reduce_spec1e C X = do {
   ((l, u), X) \<leftarrow> scaleR2_rep X;
   X \<leftarrow> reduce_spec1 C X;
   scaleRe_ivl_spec l u X
 }"
 
 definition [refine_vcg_def]: "pre_split_reduce_spec (ro::unit) = SPEC (\<lambda>x::unit. True)"
 
 definition split_under_threshold::"_ \<Rightarrow> real \<Rightarrow> 'n::enum eucl1 set \<Rightarrow> 'n eucl1 set nres" where
   "split_under_threshold ro th X = do {
     (_, Ys) \<leftarrow> WHILE\<^bsup>\<lambda>(Xs, Ys). X \<subseteq> Xs \<union> Ys\<^esup> (\<lambda>(Xs, Ys). \<not> op_coll_is_empty Xs) (\<lambda>(Xs, Ys). do {
       (X, Xs') \<leftarrow> (split_spec_coll (Xs:::clw_rel (\<langle>appr1_rel\<rangle>scaleR2_rel)):::\<langle>\<langle>appr1_rel\<rangle>scaleR2_rel \<times>\<^sub>r clw_rel (\<langle>appr1_rel\<rangle>scaleR2_rel)\<rangle>nres_rel);
       w \<leftarrow> width_spec (op_image_fste X:::appr_rel);
       if w \<le> th then RETURN (Xs', mk_coll X \<union> Ys)
       else do {
         ra \<leftarrow> pre_split_reduce_spec ro;
         X \<leftarrow> reduce_spec1e ra X;
         (a, b) \<leftarrow> split_spec_param1e (X:::\<langle>appr1_rel\<rangle>scaleR2_rel);
         RETURN (mk_coll (a:::\<langle>appr1_rel\<rangle>scaleR2_rel) \<union> mk_coll (b:::\<langle>appr1_rel\<rangle>scaleR2_rel) \<union> Xs', Ys)
       }
     }) (X:::clw_rel (\<langle>appr1_rel\<rangle>scaleR2_rel), op_empty_coll:::clw_rel (\<langle>appr1_rel\<rangle>scaleR2_rel));
     RETURN Ys
   }"
 
 definition "choose_step1e X h = do {
     ((l, u), X) \<leftarrow> scaleR2_rep X;
     (h', error, CY, Y) \<leftarrow> choose_step1 X h;
     Y \<leftarrow> scaleRe_ivl_spec l u Y;
     RETURN (h', error, fst ` CY, Y)
   }"
 
 definition "step_split ro (X::'n::enum eucl1 set) =
   do {
     ra \<leftarrow> pre_split_reduce_spec ro;
     X \<leftarrow> reduce_spec1e ra X;
     (a, b) \<leftarrow> split_spec_param1e (X:::appr1e_rel);
     _ \<leftarrow> mk_safe (op_image_fste a);
     _ \<leftarrow> mk_safe (op_image_fste b);
     width_X \<leftarrow> width_spec (op_image_fste X:::appr_rel);
     wa \<leftarrow> width_spec (op_image_fste a:::appr_rel);
     wb \<leftarrow> width_spec (op_image_fste b:::appr_rel);
     let _ = trace_set (ST ''splitting: '' @ show (lfloat10 width_X) @ ST ''-->'' @ show (lfloat10 wa) @
       ST '', ''  @ show (lfloat10 wb)) (None::'n::enum eucl1 set option);
     RETURN (mk_coll a \<union> mk_coll b)
   }"
 
 definition "width_spec_appr1 X = do {
     vX \<leftarrow> vec1rep X;
     case vX of None \<Rightarrow> width_spec (fst ` X:::appr_rel)
     | Some vX \<Rightarrow> width_spec (vX:::appr_rel)
   }"
 
 definition "tolerate_error1 Y E = tolerate_error (fst ` Y) (fst ` E)"
 
 definition "step_adapt_time (X::'n::enum eucl1 set) h =
   do {
     let X0 = fst ` X;
     _ \<leftarrow> mk_safe (X0:::appr_rel);
     (h', error, CY, Y) \<leftarrow> choose_step1e X h;
     (te, e) \<leftarrow> tolerate_error1 Y error;
     let _ = trace_set1 (ST ''discrete time step: stepsize = '' @ show (lfloat10 h)) (None::'n eucl1 set option);
     let _ = trace_set1 (ST ''discrete time step: stepsize' = '' @ show (lfloat10 h')) (None::'n eucl1 set option);
     let _ = trace_set1 (ST ''error estimation: '' @ show (lfloat10 e)) (None::'n eucl1 set option);
     if \<not> te
     then do {
       let _ = trace_set (ST ''revoking step'') (None::'n eucl1 set option);
       RETURN (0, fst ` X, X, 3 * h' / 2 / 2)
     } else do {
       let _ = trace_set1 (ST ''error OK, step_adapt_time stepped '') (None::'n eucl1 set option);
       let _ = trace_set (ST ''interpolated step:'') (Some (CY));
       let _ = print_set True CY;
       let _ = trace_set1e (ST ''discrete step:'') (Some (Y));
       let _ = print_set1e False Y;
       rtol \<leftarrow> adaptive_rtol_spec;
       method_id \<leftarrow> method_spec;
       prec \<leftarrow> precision_spec;
       case approx prec (adapt_stepsize_fa rtol method_id e h') []
-      of Some (h'', _) \<Rightarrow>
-        let _ = trace_set1 (ST ''increase step: stepsize = '' @ show (lfloat10 h'')) (None::'n eucl1 set option)
+      of Some ivl_h'' \<Rightarrow>
+        let h'' = lower ivl_h'';
+            _ = trace_set1 (ST ''increase step: stepsize = '' @ show (lfloat10 h'')) (None::'n eucl1 set option)
         in RETURN (h', CY, Y, 15/2/2/2/2 * h'')
       | None \<Rightarrow>
         let _ = trace_set1 (ST ''increase time step (failure): stepsize = '' @ show (lfloat10 h')) (None::'n eucl1 set option)
         in RETURN (h', CY, Y, h' * 5 / 2 / 2)
     }
   }"
 
 definition [simp]: "eq_spec x y = SPEC (\<lambda>r. r \<longrightarrow> x = y)"
 lemma [autoref_itype]: "eq_spec ::\<^sub>i A \<rightarrow>\<^sub>i A \<rightarrow>\<^sub>i \<langle>i_bool\<rangle>\<^sub>ii_nres" by simp
 
 definition "select_with_inter ci a = do {
     CIs \<leftarrow> (sets_of_coll ci);
     As \<leftarrow> sets_of_coll a;
     FORWEAK CIs (RETURN op_empty_coll)
       (\<lambda>ci. do {
         (c, I) \<leftarrow> (get_inter ci);
         FORWEAK As (RETURN op_empty_coll)
         (\<lambda>a. do {
           b \<leftarrow> eq_spec a c;
           if b then RETURN (mk_coll ci)
           else RETURN (op_empty_coll)
         })
         (\<lambda>CIS CIS'. RETURN (CIS' \<union> CIS))
       })
       (\<lambda>CIS CIS'. RETURN (CIS' \<union> CIS))
   }"
 
 abbreviation "fst_safe_colle XS \<equiv> (mk_safe_coll (op_image_fst_colle XS:::clw_rel appr_rel):::\<langle>clw_rel appr_rel\<rangle>nres_rel)"
 
 definition "do_intersection_body GUARDS ivl sctn h \<equiv> \<lambda>(X, T, PDPS, PDPS2, CXS, _, _).
   do {
     (_, _, CX', X') \<leftarrow> choose_step1 (X:::appr1_rel) (h:::rnv_rel);
     let _ = trace_set1 (ST ''interpolated step during intersection:'') (Some (CX'));
     let _ = print_set1 True (CX');
     let _ = trace_set1 (ST ''step during intersection:'') (Some (X'));
     let _ = print_set1 False (X');
     CHECKs (ST ''unnormal intersection'') (abs (normal sctn) \<in> set Basis_list);
     CPDP \<leftarrow> solve_poincare_plane (abs (normal sctn)) CX';
     let _ = trace_set1 (ST ''CPDP: '') (Some CPDP);
     let _ = print_set1 False (CPDP);
     (PDP, PDP2) \<leftarrow> inter_sctn1_spec CPDP sctn;
     b1 \<leftarrow> disjoints_spec (mk_coll (op_image_fst X')) (GUARDS);
     b2 \<leftarrow> disjoints_spec (mk_coll (op_image_fst CX')) (GUARDS);
     b3 \<leftarrow> disjoints_spec (mk_coll (op_image_fst PDP)) (GUARDS);
     b4 \<leftarrow> disjoints_spec (mk_coll (op_image_fst PDP2)) (GUARDS);
     CHECKs (ST ''do_intersection: hitting several planes :('') (b1 \<and> b2 \<and> b3 \<and> b4);
     intersects \<leftarrow> op_intersects (op_image_fst X') sctn;
     CX's \<leftarrow> mk_safe (op_image_fst CX');
     c1 \<leftarrow> nonzero_component_within ivl sctn PDP;
     c2 \<leftarrow> nonzero_component_within ivl sctn PDP2;
     RETURN (X', pos_reals:::\<langle>Id\<rangle>phantom_rel, mk_coll PDP \<union> PDPS,
       mk_coll PDP2 \<union> PDPS2,
       mk_coll (inter_sbelows (CX's:::appr_rel) {sctn}) \<union> CXS, intersects, c1 \<and> c2)
   }"
 
 definition "do_intersection guards ivl sctn (X::'n::enum eucl1 set) (h::real) =
   do {
     ASSUME (closed ivl);
     sp \<leftarrow> subset_spec_plane ivl sctn;
     sX \<leftarrow> mk_safe (op_image_fst (X:::appr1_rel));
     GUARDS \<leftarrow> unintersect_coll guards;
     a \<leftarrow> sbelow_sctn (op_image_fst X) sctn;
     b \<leftarrow> disjoints_spec (mk_coll (op_image_fst X)) GUARDS;
     let inside = sp \<and> a \<and> b; \<comment> \<open>this is a bit of a hack: if the \<open>ivl\<close> is not subset of the plane,\<close>
       \<comment> \<open>then do not do intersections\<close>
     (X, T, PDPS, PDPS2, CXS, intersects, inside) \<leftarrow>
       WHILE\<^bsup>do_intersection_invar guards GUARDS ivl sctn X\<^esup>
       (\<lambda>(X, T, PDPS, PDPS2, CXS, intersects, inside). intersects \<and> inside)
       (do_intersection_body GUARDS ivl sctn h)
       (X, nonneg_reals:::\<langle>Id\<rangle>phantom_rel, op_empty_coll:::clw_rel appr1_rel::'n eucl1 set,
         op_empty_coll:::clw_rel appr1_rel::'n eucl1 set,
         mk_coll (inter_sbelows (sX:::appr_rel) {sctn}), True, inside);
     a \<leftarrow> above_sctn (op_image_fst X) sctn;
     b \<leftarrow> subset_spec_coll (op_image_fst_coll PDPS) ivl;
     b2 \<leftarrow> subset_spec_coll (op_image_fst_coll PDPS2) ivl;
     RETURN (inside \<and> b \<and> b2 \<and> a, PDPS, PDPS2, CXS)
   }"
 
 definition "resolve_step roptns X h = do {
     width_X \<leftarrow> width_spec (op_image_fste X:::appr_rel);
     mtdt \<leftarrow> max_tdev_thres_spec roptns;
     if \<not> width_X \<le> mtdt
     then do {
       Y \<leftarrow> step_split roptns X;
       RETURN (h, fst ` Y, Y, h)
     }
     else do {
       (h0, CY, Y, h') \<leftarrow> step_adapt_time (X::'n::enum eucl1 set) h;
       RETURN (h0, mk_coll (fst ` Y) \<union> mk_coll CY, mk_coll Y, h')
     }
   }"
 
 definition "pre_intersection_step ro X h = do {
     mis \<leftarrow> max_intersection_step_spec ro;
     if h > mis
     then RETURN (with_infos (h/2) (mk_coll X), mk_coll (fst ` X), op_empty_coll:::clw_rel (iinfo_rel appr1e_rel))
     else do {
       width_X \<leftarrow> width_spec (op_image_fste X:::appr_rel);
       pig \<leftarrow> pre_inter_granularity_spec ro;
       if width_X \<le> pig then
         RETURN (with_infos h (op_empty_coll:::clw_rel appr1e_rel), mk_coll (fst ` X),
                 with_infos (5 * h / 2 / 2) (mk_coll X))
       else do {
         X' \<leftarrow> step_split ro X;
         RETURN (with_infos h X', fst ` X', op_empty_coll:::clw_rel (iinfo_rel appr1e_rel))
       }
     }
   }"
 
 definition "reach_cont ro (guardsi::'n::enum rvec set) XS0 =
   do {
     startstep \<leftarrow> start_stepsize_spec;
     (_, XS0') \<leftarrow> scaleR2_rep_coll XS0;
     sXS0 \<leftarrow> fst_safe_coll XS0';
     let fX0 = op_image_fst_colle XS0;
     guards \<leftarrow> (unintersect_coll (guardsi:::clw_rel (iplane_rel lvivl_rel)):::\<langle>clw_rel lvivl_rel\<rangle>nres_rel);
     d \<leftarrow> disjoints_spec fX0 (guards);
     CHECKs (ST ''reach_cont: starting from guarded set'') d;
     (_, CXS, GS) \<leftarrow>
       WHILE\<^bsup>(\<lambda>(XS, CXS, GS).
         flowsto XS0 {0..} (CXS \<times> UNIV) (XS \<union> GS) \<and>
         (XS \<union> GS \<union> CXS \<times> UNIV) \<subseteq> (Csafe - guards) \<times> UNIV \<and>
         XS0 \<union> GS \<subseteq> CXS \<times> UNIV)\<^esup>
           (\<lambda>(XS, CXS, GS). \<not> op_coll_is_empty XS) (\<lambda>(XS, CXS, GS).
       do {
         (hX, XS') \<leftarrow> (split_spec_exact XS:::\<langle>iinfo_rel (appr1e_rel) \<times>\<^sub>r clw_rel (iinfo_rel (appr1e_rel))\<rangle>nres_rel);
         (h::real, X) \<leftarrow> get_info hX;
         let _ = trace_set1e (ST ''next step in resolve_sctns using'') (Some X);
         cXS::nat \<leftarrow> card_info XS;
         cGS::nat \<leftarrow> card_info GS;
         let _ = trace_set1 (ST ''XS: '' @ show cXS) (None::'n eucl1 set option);
         let _ = trace_set1 (ST ''GS: '' @ show cGS) (None::'n eucl1 set option);
         (h0, fCX', X', h') \<leftarrow> resolve_step ro X h;
         sfCX' \<leftarrow> (mk_safe_coll (fCX':::clw_rel appr_rel):::\<langle>clw_rel appr_rel\<rangle>nres_rel);
         let fX' = (fst ` X');
         fXS \<leftarrow> ivls_of_sets (fCX' \<union> fX');
         IS \<leftarrow> inter_overappr guards fXS;
         let d = op_coll_is_empty IS;
         if d then RETURN (with_infos h' X' \<union> XS':::clw_rel (iinfo_rel appr1e_rel), sfCX' \<union> CXS, GS)
         else do {
           (hX', fCX', hG') \<leftarrow> pre_intersection_step ro X h0;
           sfCX' \<leftarrow> (mk_safe_coll (fCX':::clw_rel appr_rel):::\<langle>clw_rel appr_rel\<rangle>nres_rel);
           _ \<leftarrow> fst_safe_colle (uninfo hX');
           _ \<leftarrow> fst_safe_colle (uninfo hG');
           fGs \<leftarrow> ivls_of_sets (op_image_fst_colle (uninfo hG') \<union> fCX' \<union> op_image_fst_colle (uninfo hX'));
           d \<leftarrow> disjoints_spec (sets_of_ivls guards) fGs;
           CHECKs (ST ''reach_cont: pre_intersection_step should not change disjointness condition!'') d;
           iguards \<leftarrow> select_with_inter guardsi IS;
           iG' \<leftarrow> with_coll_infos iguards hG';
           RETURN (hX' \<union> XS', sfCX' \<union> CXS, iG' \<union> GS)
         }
       })
       (with_infos startstep (XS0:::clw_rel appr1e_rel):::clw_rel (iinfo_rel appr1e_rel),
         sXS0:::clw_rel appr_rel, op_empty_coll:::clw_rel (\<langle>iplane_rel (lvivl_rel::(_\<times>'n rvec set)set), iinfo_rel appr1e_rel\<rangle>info_rel));
     RETURN (CXS, GS)
   }"
 
 definition "reach_cont_par roptns guards XS = do {
   XS \<leftarrow> sets_of_coll XS;
   PARS \<leftarrow> PAR_IMAGE (\<lambda>X (CX, G).
       G \<union> (CX \<times> UNIV) \<subseteq> (Csafe - guards) \<times> UNIV \<and>
       X \<union> G \<subseteq> CX \<times> UNIV \<and> flowsto X {0..} (CX \<times> UNIV) G)
     (\<lambda>X. reach_cont roptns guards (mk_coll X)) XS;
   RETURN (\<Union>(fst ` snd ` PARS), \<Union>(snd ` snd ` PARS))
 }"
 
 
 definition "subset_iplane_coll x ics = do {
     X \<leftarrow> unintersect x;
     ics \<leftarrow> sets_of_coll ics;
     FORWEAK ics (RETURN False) (\<lambda>ic. do {
       (i, c) \<leftarrow> get_inter ic;
       sctn \<leftarrow> get_plane c;
       b1 \<leftarrow> subset_spec_plane X sctn;
       RETURN (b1 \<and> op_subset_ivl X i)
     }) (\<lambda>b c. RETURN (b \<or> c))
   }"
 
 definition "subsets_iplane_coll xs ics = FORWEAK xs (RETURN True) (\<lambda>x. subset_iplane_coll x ics) (\<lambda>a b. RETURN (a \<and> b))"
 
 
 definition "stable_set p = {x. {0..} \<subseteq> existence_ivl0 x \<and> (flow0 x \<longlongrightarrow> p) at_top}"
 
 definition symstart_coll::"('n::enum eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set)nres) \<Rightarrow>
   'n eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set)nres"
   where
 "symstart_coll symstart X0 = do {
     _ \<leftarrow> (fst_safe_colle (X0:::clw_rel appr1e_rel):::\<langle>clw_rel appr_rel\<rangle>nres_rel);
     X0s \<leftarrow> sets_of_coll X0;
     (CX1, X1) \<leftarrow> FORWEAK X0s (RETURN (op_empty_coll, op_empty_coll)) (symstart)
       (\<lambda>(CX, X) (CX', X'). RETURN (CX' \<union> CX, X' \<union> X));
     RETURN (CX1, X1)
   }"
 
 definition reach_cont_symstart ::
   "_ \<Rightarrow> _ \<Rightarrow> 'n::enum rvec set
       \<Rightarrow> 'n eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set) nres"
   where "reach_cont_symstart ro symstart (guards::'n rvec set) X0 = do {
     let fX0 = op_image_fst_colle X0;
     GUARDS \<leftarrow> unintersect_coll guards;
     d \<leftarrow> disjoints_spec fX0 GUARDS;
     CHECKs (ST ''reach_cont_symstart: starting from guarded set'') d;
     (CY, Y0) \<leftarrow> symstart_coll symstart X0;
     sCY \<leftarrow> (mk_safe_coll (op_image_fst_colle X0 \<union> CY:::clw_rel appr_rel):::\<langle>clw_rel appr_rel\<rangle>nres_rel);
     b \<leftarrow> disjoints_spec (op_image_fst_colle Y0 \<union> CY) GUARDS;
     CHECKs ''reach_cont_symstart with a stupid guard'' b;
     (CX, GS) \<leftarrow> (reach_cont_par ro guards Y0:::\<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel (\<langle>iplane_rel lvivl_rel::(_ \<times> 'n rvec set) set, iinfo_rel appr1e_rel\<rangle>info_rel)\<rangle>nres_rel);
     let CZ = sCY \<union> CX;
     RETURN (CZ, GS)
   }"
 
 context includes autoref_syntax begin\<comment> \<open>TODO: should not be annotating relations here\<close>
 definition reach_conts ::
   "_ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> 'n::enum rvec set
       \<Rightarrow> 'n eucl1 set \<Rightarrow> ('n rvec set \<times> ('n rvec set \<times> 'n eucl1 set) set \<times> ('n eucl1 set \<Rightarrow> 'n eucl1 set)) nres"
   where "reach_conts ro symstart trap (guardsi::'n rvec set) X0 = do {
     (CX, GS) \<leftarrow> (reach_cont_symstart ro (symstart:::appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel) guardsi X0:::
       \<langle>clw_rel appr_rel \<times>\<^sub>r
        clw_rel (\<langle>iplane_rel lvivl_rel::(_\<times>'n rvec set) set, iinfo_rel appr1e_rel\<rangle>info_rel)\<rangle>nres_rel);
     (IGSs:: ('n rvec set \<times> 'n eucl1 set) set) \<leftarrow> explicit_info_set GS;
     let GSs = snd ` IGSs;
     ASSUME (finite GSs);
     CHECKs '''' (GSs \<noteq> {});
     ASSERT       (\<exists>f. X0 = \<Union>(f ` GSs) \<and> (\<forall>G \<in> GSs. flowsto (f G - trap \<times> UNIV) {0..} (CX \<times> UNIV) (G)));
     X0f \<leftarrow> GSPEC (\<lambda>f. X0 = \<Union>(f ` GSs) \<and> (\<forall>G \<in> GSs. flowsto (f G - trap \<times> UNIV) {0..} (CX \<times> UNIV) (G)));
     let K = (fst ` IGSs);
     b \<leftarrow> subsets_iplane_coll K guardsi;
     CHECKs (ST ''reach_conts: subsets_iplane_coll'') b;
     RETURN (CX, IGSs:::\<langle>iplane_rel lvivl_rel \<times>\<^sub>r clw_rel (iinfo_rel appr1e_rel)\<rangle>list_wset_rel, X0f)
   }"
 end
 
 definition [refine_vcg_def]: "get_sctns X = SPEC (\<lambda>R. X = below_halfspaces R)"
 
 definition "leaves_halfspace S X = do {
     sctns \<leftarrow> get_sctns S;
     sctnss \<leftarrow> op_set_to_list sctns;
     (case sctnss of
       [] \<Rightarrow> RETURN None
     | [sctn] \<Rightarrow>
       do {
         (Xi, Xs) \<leftarrow> ivl_rep_of_set_coll X;
         ASSERT (Xi \<le> Xs);
         b \<leftarrow> subset_spec_plane ({Xi .. Xs}:::lvivl_rel) sctn;
         CHECKs (ST ''leaves_halfspace: not subset of plane'') b;
         F \<leftarrow> ode_set ({Xi .. Xs}:::appr_rel);
         sF \<leftarrow> Sup_inner F (normal sctn);
         CHECKs (ST ''leaves_halfspace: not down from plane'') (sF < 0);
         RETURN (Some sctn)
       }
     | _ \<Rightarrow> do {CHECKs (ST ''leaves_halfspace: not a good halfspace'') False; SUCCEED})
   }"
 
 definition "poincare_start_on guards sctn X0S =
   do {
     X0SS \<leftarrow> sets_of_coll X0S;
     (FORWEAK X0SS (RETURN (op_empty_coll:::clw_rel appr1e_rel, op_empty_coll:::clw_rel appr_rel)) (\<lambda>X0. do {
       mk_safe (fst ` X0);
       startstep \<leftarrow> start_stepsize_spec;
       (h, err, CX1, X1) \<leftarrow> choose_step1e X0 (startstep);
       let _ = trace_set (ST ''interpolated start step:'') (Some CX1);
       let _ = print_set True CX1;
       let _ = trace_set1e (ST ''discrete start step:'') (Some X1);
       let _ = print_set1e False X1;
       let fX1 = op_image_fste X1;
       c0 \<leftarrow> below_sctn (op_image_fste X0) (sctn);
       c1 \<leftarrow> sbelow_sctn (fX1) (sctn);
       c2 \<leftarrow> disjoints_spec (mk_coll (fX1)) guards;
       c3 \<leftarrow> disjoints_spec (mk_coll (CX1)) guards;
       mk_safe (fX1);
       mk_safe (CX1);
       D \<leftarrow> (ode_set (CX1):::\<langle>appr_rel\<rangle>nres_rel);
       d \<leftarrow> Sup_inner D (normal sctn);
       let _ = trace_set (ST ''poincare_start_on: D '') (Some D);
       CHECKs (ST ''poincare_start_on: is away and really moves away'') (c0 \<and> c1 \<and> c2 \<and> c3 \<and> d < 0);
       RETURN (mk_coll X1:::clw_rel appr1e_rel, (mk_coll CX1):::clw_rel appr_rel)
     })
     (\<lambda>(X1, CX1) (X1S, CX1S). RETURN (op_union_coll X1 X1S:::clw_rel appr1e_rel, op_union_coll CX1 CX1S:::clw_rel appr_rel)))
   }"
 
 definition [simp]: "isets_of_iivls x = x"
 
 abbreviation "inter_plane A B \<equiv> mk_inter A (plane_of B)"
 
 definition "do_intersection_core guards ivl sctn hX =
   do {
     (h, eX) \<leftarrow> get_info hX;
     ((l, u), X) \<leftarrow> scaleR2_rep eX;
     (b, PS1, PS2, CXS) \<leftarrow> do_intersection (guards:::clw_rel (iplane_rel lvivl_rel)) ivl sctn X h;
     if b then do {
       PS1e \<leftarrow> scaleRe_ivl_coll_spec l u PS1;
       PS2e \<leftarrow> scaleRe_ivl_coll_spec l u PS2;
       RETURN (PS1e, PS2e, CXS, op_empty_coll)
     }
     else RETURN (op_empty_coll, op_empty_coll, op_empty_coll, mk_coll eX)
   }"
 
 definition "do_intersection_coll guards ivl sctn X =
   do {
     Xs \<leftarrow> sets_of_coll X;
     CHECKs ''nonempty inter nonfinite: '' (Xs \<noteq> {});
     RS \<leftarrow> PAR_IMAGE (\<lambda>X. \<lambda>(P1, P2, CX, X0s).
       do_intersection_spec UNIV guards ivl sctn (X - X0s) (P1, CX) \<and>
       do_intersection_spec UNIV guards ivl sctn (X - X0s) (P2, CX)
       \<and> fst ` (X - X0s) \<subseteq> CX
       \<and> X0s \<subseteq> X) (do_intersection_core guards ivl sctn) Xs;
     ASSUME (finite RS);
     RETURN ((\<Union>(X, (P1, P2, CX, X0s))\<in>RS. P1),
             (\<Union>(X, (P1, P2, CX, X0s))\<in>RS. P2),
             (\<Union>(X, (P1, P2, CX, X0s))\<in>RS. CX),
             (\<Union>(X, (P1, P2, CX, X0s))\<in>RS. X0s))
   }"
 
 definition "op_enlarge_ivl_sctn ivl sctn d = do {
     (l, u) \<leftarrow> ivl_rep ivl;
     CHECKs ''op_enlarge_ivl_sctn: trying to shrink'' (d \<ge> 0);
     CHECKs ''op_enlarge_ivl_sctn: empty ivl'' (l \<le> u);
     CHECKs ''op_enlarge_ivl_sctn: not in Basis'' (abs (normal sctn) \<in> set Basis_list);
     let dOne = sum_list (map (\<lambda>i. d *\<^sub>R i) Basis_list) - d *\<^sub>R abs (normal sctn);
     ASSERT (l - dOne \<le> u + dOne);
     RETURN (op_atLeastAtMost_ivl (l - dOne) (u + dOne))
   }"
 
 definition "guardset guards = Union (case_prod (\<inter>) ` (\<lambda>(x, y). (x, plane_of y)) ` guards)"
 
 definition "resolve_ivlplanes (guards::'n::enum rvec set)
                           (ivlplanes::'n::enum rvec set)
                           XS
                            =
   FORWEAK XS (RETURN ({}))
      (\<lambda>(ivlplane, X).
       do {
         (ivl, plane) \<leftarrow> (get_inter (ivlplane));
         ASSUME (closed ivl);
         sctn \<leftarrow> (get_plane plane);
         b \<leftarrow> subset_iplane_coll ivlplane ivlplanes;
         CHECKs ''reach_conts: subsets_iplane_coll'' b;
         (PS1, PS2, CXS, RS) \<leftarrow> (do_intersection_coll guards ivl sctn X);
         RETURN {(uninfo X, PS1, PS2, RS, ivl, sctn, CXS)}
       })
       (\<lambda>(PS) (PS'). RETURN (PS' \<union> PS))"
 
 context includes autoref_syntax begin
 definition "poincare_onto ro \<comment> \<open>options\<close>
                           symstart trap \<comment> \<open>symbolic start and trap\<close>
                           (guards::'n::enum rvec set) \<comment> \<open>avoiding guards\<close>
                           (ivlplanes::'n::enum rvec set) \<comment> \<open>target sections\<close>
                           (XS0::'n eucl1 set)
                           (CXS0::'n rvec set)
      =
   do {
     (CXS, XS, X0s) \<leftarrow> (reach_conts ro (symstart:::appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel) trap (ivlplanes \<union> guards) XS0:::
       \<langle>clw_rel appr_rel \<times>\<^sub>r \<langle>iplane_rel lvivl_rel \<times>\<^sub>r clw_rel (iinfo_rel appr1e_rel)\<rangle>list_wset_rel \<times>\<^sub>r
      ghost_rel\<rangle>nres_rel);
     PS \<leftarrow> resolve_ivlplanes guards ivlplanes XS;
     _ \<leftarrow> mk_safe_coll CXS0;
     RETURN ((\<lambda>(X, P1, P2, R, ivl, sctn, CX). (X, P1, P2, R, ivl, sctn, CX, CXS \<union> CXS0)) ` PS)
   }"
 
 definition "empty_remainders PS =
   FORWEAK PS (RETURN True) (\<lambda>(X, P1, P2, R, ivl, sctn, CX, CXS). do { e \<leftarrow> isEmpty_spec R; RETURN e})
     (\<lambda>a b. RETURN (a \<and> b))"
 
 definition [simp]: "empty_trap = {}"
 
 definition empty_symstart::"((real, 'a) vec \<times> (real, 'a) vec \<Rightarrow>\<^sub>L (real, 'a) vec) set
    \<Rightarrow> ((real, 'a) vec set \<times> ((real, 'a) vec \<times> (real, 'a) vec \<Rightarrow>\<^sub>L (real, 'a) vec) set) nres"
   where [simp]: "empty_symstart \<equiv> \<lambda>X. RETURN (op_empty_coll, mk_coll X)"
 
 definition "poincare_onto_empty ro \<comment> \<open>options\<close>
                           (guards::'n::enum rvec set) \<comment> \<open>avoiding guards\<close>
                           (ivlplanes::'n::enum rvec set) \<comment> \<open>target sections\<close>
                           (XS0::'n eucl1 set) =
   poincare_onto ro (OP empty_symstart:::appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel)
     empty_trap guards ivlplanes XS0"
 
 
 definition "poincare_onto2 ro \<comment> \<open>options\<close>
                           symstart trap \<comment> \<open>symbolic start and trap\<close>
                           (guards::'n::enum rvec set) \<comment> \<open>avoiding guards\<close>
                           (ivlplanes::'n::enum rvec set) \<comment> \<open>target sections\<close>
                           (XS0::'n eucl1 set) =
   do {
     (PS) \<leftarrow> (poincare_onto ro (symstart:::appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel)
       trap guards ivlplanes XS0 op_empty_coll:::
       \<langle>\<langle>clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel \<times>\<^sub>r
         clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel\<rangle>nres_rel);
     (PS2) \<leftarrow> FORWEAK PS (RETURN ({})) (\<lambda>(X, P1, P2, R, ivl, sctn, CX, CXS).
       if op_coll_is_empty R then RETURN ({})
       else do {
         ivlplaness \<leftarrow> (sets_of_coll ivlplanes:::\<langle>\<langle>iplane_rel lvivl_rel\<rangle>list_wset_rel\<rangle>nres_rel);
         ivlplaness' \<leftarrow> op_set_ndelete (mk_inter ivl (plane_of sctn)) ivlplaness;
         let ivlplanes' = (\<Union>(mk_coll ` ivlplaness':::\<langle>clw_rel (iplane_rel lvivl_rel)\<rangle>list_wset_rel));
         PS' \<leftarrow> (poincare_onto_empty ro (guards) ivlplanes' R CXS:::
             \<langle>\<langle>clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel
             \<times>\<^sub>r clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel\<rangle>nres_rel);
         b \<leftarrow> empty_remainders PS';
         CHECKs (ST ''poincare_onto2: empty remainders!'') b;
         ASSUME (finite PS');
         RETURN PS'
         }) (\<lambda>PS PS'. RETURN (PS' \<union> PS));
       RETURN (Pair True ` PS2 \<union> Pair False ` PS)
     }"
 
 definition "width_spec_ivl M x = do {
     (i, s) \<leftarrow> ivl_rep x;
     RETURN (\<Sum>(i, s)\<leftarrow>zip (take M (list_of_eucl i)) (take M (list_of_eucl s)). abs (s - i))
   }"
 
 definition partition_ivl::"_ \<Rightarrow> 'a::executable_euclidean_space set \<Rightarrow> 'a::executable_euclidean_space set nres"
   where
  "partition_ivl roptns xs = (if op_coll_is_empty xs then RETURN (op_empty_coll:::clw_rel lvivl_rel) else do {
     (i, s) \<leftarrow> ivl_rep_of_set_coll (sets_of_ivls (xs:::clw_rel lvivl_rel):::clw_rel appr_rel);
     ASSERT (i \<le> s);
     let r = (op_atLeastAtMost_ivl i s);
     (rs, ps) \<leftarrow>
       WHILE\<^bsup>(\<lambda>(rs, ps). (xs) \<subseteq> rs \<union> ps)\<^esup> (\<lambda>(rs, ps). \<not> op_coll_is_empty (rs:::clw_rel lvivl_rel))
       (\<lambda>(rs, ps).
       do {
         (r, rs') \<leftarrow> (split_spec_exact rs:::\<langle>lvivl_rel \<times>\<^sub>r clw_rel lvivl_rel\<rangle>nres_rel);
         (ri, rs) \<leftarrow> ivl_rep r;
         CHECKs (ST ''partition_ivl with strange ivl'') (ri \<le> rs);
         width \<leftarrow> width_spec ({ri .. rs}:::appr_rel);
         pig \<leftarrow> post_inter_granularity_spec roptns;
         if width \<le> pig then
           RETURN (rs', mk_coll r \<union> ps)
         else do {
           (a, b) \<leftarrow> split_spec_ivl (DIM('a)) r;
           let isa = (op_inter_ivl_coll (xs:::clw_rel lvivl_rel) (a:::lvivl_rel));
           let isb = (op_inter_ivl_coll(xs:::clw_rel lvivl_rel) (b:::lvivl_rel));
           ra' \<leftarrow> (if op_coll_is_empty isa then RETURN op_empty_coll else do {
             (i', s') \<leftarrow> ivl_rep_of_set_coll (sets_of_ivls isa);
             RETURN (mk_coll (({i' .. s'}:::lvivl_rel) \<inter> a))
           });
           rb' \<leftarrow> (if op_coll_is_empty isb then RETURN op_empty_coll else do {
             (i', s') \<leftarrow> ivl_rep_of_set_coll (sets_of_ivls isb);
             RETURN (mk_coll (({i' .. s'}:::lvivl_rel) \<inter> b))
           });
           RETURN (ra' \<union> rb' \<union> rs', ps)
         }
       }) (mk_coll r:::clw_rel lvivl_rel, op_empty_coll :::clw_rel lvivl_rel);
     RETURN ps
   })"
 
 definition
   "vec1repse X = do {
     XS \<leftarrow> sets_of_coll X;
     FORWEAK XS (RETURN (Some op_empty_coll))
       (\<lambda>x. do {
         ((l, u), x) \<leftarrow> scaleR2_rep x;
         xo \<leftarrow> vec1rep x;
         case xo of None \<Rightarrow> RETURN None
         | Some x \<Rightarrow> do {
             xe \<leftarrow> scaleRe_ivl_spec l u x;
             RETURN (Some (mk_coll xe))
           }
       })
       (\<lambda>a b.
         case (a, b) of (Some a, Some b) \<Rightarrow> RETURN (Some (b \<union> a))
         | _ \<Rightarrow> RETURN None)
   }"
 
 abbreviation "appre_rel \<equiv> \<langle>appr_rel\<rangle>scaleR2_rel"
 
 definition "scaleR2_rep1 (Y::('a::executable_euclidean_space\<times>_) set) = do {
     let D = DIM('a);
     ((l, u), X) \<leftarrow> scaleR2_rep Y;
     (i, s) \<leftarrow> op_ivl_rep_of_set X;
     let mig = inf (abs i) (abs s);
     CHECKs (ST ''scaleR2_rep1: strange'') (i \<le> s);
     (N::real set) \<leftarrow> approx_slp_appr [floatarith.Inverse (norm2\<^sub>e D)] (norm2_slp D) (list_of_eucl ` ({mig .. mig}:::appr_rel));
     (sl, su) \<leftarrow> op_ivl_rep_of_set (N:::appr_rel);
     let scale = (rnv_of_lv sl + rnv_of_lv su)/2;
     CHECKs (ST ''scaleR2_rep1: scale 0'') (scale > 0);
     CHECKs (ST ''scaleR2_rep1: l 0'') (l > 0);
     CHECKs (ST ''scaleR2_rep1: u 0'') (u > 0);
     precision \<leftarrow> precision_spec;
     let scalel = real_divl (precision) 1 scale;
     let scaleu = real_divr (precision) 1 scale;
     CHECKs (ST ''scaleR2_rep1: scalel 0'') (scalel > 0);
     CHECKs (ST ''scaleR2_rep1: scaleu 0'') (scaleu > 0);
     (i, s) \<leftarrow> op_ivl_rep_of_set X;
     let (i0, i1) = split_lv_rel i;
     let (s0, s1) = split_lv_rel s;
     scaleRe_ivl_spec (scalel * l) (scaleu * u)
       (op_atLeastAtMost_ivl (Pair_lv_rel i0 (scale *\<^sub>R i1)) (Pair_lv_rel s0 (scale *\<^sub>R s1)))
   }"
 
 definition "ivlse_of_setse X = do {
   Xs \<leftarrow> sets_of_coll X;
   FORWEAK Xs (RETURN op_empty_coll) (\<lambda>X. do {
     I \<leftarrow> scaleR2_rep1 X;
     I \<leftarrow> reduces_ivle I;
     RETURN (mk_coll I)
   }) (\<lambda>X' X. RETURN (X' \<union> X))
   }"
 
 definition [simp]: "op_image_flow1_of_vec1_colle \<equiv> op_image_flow1_of_vec1_coll"
 
 definition "okay_granularity ro r = do {
     (ri, rs) \<leftarrow> ivl_rep r;
     CHECKs (ST ''partition_ivle with strange ivl'') (ri \<le> rs);
     width \<leftarrow> width_spec ({ri .. rs}:::appr_rel);
     pig \<leftarrow> post_inter_granularity_spec ro;
     RETURN (width\<le>pig)
   }"
 
 definition partition_set::"unit \<Rightarrow> 'n::enum eucl1 set \<Rightarrow> 'n eucl1 set nres"
   where
     "partition_set ro xs =
     (if op_coll_is_empty xs then RETURN (op_empty_coll:::clw_rel appr1e_rel) else do {
     ASSERT (xs \<noteq> {});
     pcg \<leftarrow> pre_collect_granularity_spec ro;
     xs \<leftarrow> split_under_threshold ro pcg
             (xs:::clw_rel appr1e_rel);
     vxs \<leftarrow> vec1repse xs;
     case vxs of None \<Rightarrow> do {
       xs \<leftarrow> ivls_of_sets (op_image_fst_colle xs);
       ps \<leftarrow> partition_ivl ro xs;
       scaleRe_ivl_coll_spec 1 1 (sets_of_ivls ps \<times> UNIV:::clw_rel appr1_rel)
     }
     | Some xs \<Rightarrow> do {
       xs \<leftarrow> ivlse_of_setse xs;
       ps \<leftarrow> (OP partition_ivle) $ ro $ xs;
       ps \<leftarrow> setse_of_ivlse ps;
       RETURN (op_image_flow1_of_vec1_colle ps)
     }
   })"
 
 definition partition_sets::"unit \<Rightarrow>
   (bool \<times> 'a::enum eucl1 set \<times> 'a::enum eucl1 set \<times> 'a::enum eucl1 set \<times> 'a::enum eucl1 set \<times> 'a rvec set \<times> 'a rvec sctn \<times> 'a rvec set \<times> 'a rvec set) set \<Rightarrow>
   'a eucl1 set nres"
   where
  "partition_sets ro xs =
     FORWEAK xs (RETURN op_empty_coll) (\<lambda>(b, X, PS1, PS2, R, ivl', sctn', CX, CXS). do {
       PS \<leftarrow> partition_set ro PS1;
       RETURN PS
     })
     (\<lambda>a b. RETURN (b \<union> a))"
 
 definition "ivlsctn_to_set xs = (\<Union>(ivl, sctn)\<in>set xs. ivl \<inter> plane_of sctn)"
 
 definition [refine_vcg_def]: "singleton_spec X = SPEC (\<lambda>x. X = {x})"
 
 primrec poincare_onto_series where
   "poincare_onto_series interrupt trap [] XS0 ivl sctn ro = do {
     let guard0 = mk_coll (mk_inter ivl (plane_of sctn));
     ASSUME (closed guard0);
     XS1 \<leftarrow> (poincare_onto2 (ro:::Id)
        (interrupt:::appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel) trap
         (op_empty_coll:::clw_rel (iplane_rel lvivl_rel)) guard0 XS0:::
       \<langle>\<langle>bool_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel \<times>\<^sub>r
       clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel\<rangle>nres_rel);
     (b, X, PS1, PS2, R, ivl', sctn', CX, CXS) \<leftarrow> singleton_spec XS1;
     CHECKs (ST ''poincare_onto_series: last return!'') (ivl' = ivl \<and> sctn' = sctn);
     RETURN PS2
   }"
 | "poincare_onto_series interrupt trap ((guardro)#guards) XS0 ivl sctn ro0 = (case guardro of (guard, ro) \<Rightarrow>
     do {
       ASSUME (closed ivl);
       let guard0 = mk_coll (mk_inter ivl (plane_of sctn));
       ASSUME (closed guard0);
       ASSUME (\<forall>(guard, ro) \<in> set (guardro#guards). closed guard);
       let guardset = (\<Union>(guard, ro)\<in>set ((guard0, ro0)#guards). guard);
       XS1 \<leftarrow> (poincare_onto2 ro (interrupt:::appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel) trap (guardset:::clw_rel (iplane_rel lvivl_rel)) guard XS0 :::
         \<langle>\<langle>bool_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel \<times>\<^sub>r
       clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel\<rangle>nres_rel);
       ASSUME (\<forall>(b, X, PS1, PS1, R, ivl, sctn, CX, CXS) \<in> XS1. closed ivl);
       XS2 \<leftarrow> partition_sets ro XS1;
       _ \<leftarrow> fst_safe_colle XS2;
       XS3 \<leftarrow> poincare_onto_series interrupt trap guards XS2 ivl sctn (ro0:::Id);
       RETURN XS3
     })"
 
 definition "poincare_onto_from interrupt trap
                                S                      \<comment> \<open>leaving this (half)space in the beginning\<close>
                           (guards)                    \<comment> \<open>avoiding guards\<close>
                           (ivl::'n rvec set)          \<comment> \<open>onto \<open>ivl\<close>\<close>
                           sctn                        \<comment> \<open>which is part of \<open>sctn\<close>\<close>
                           ro
                           (XS0::'n::enum eucl1 set) =
   do {
     ASSUME (closed ivl);
     let guardset = (\<Union>(ivlsctn, ro)\<in>set (guards). ivlsctn:::clw_rel (iplane_rel lvivl_rel));
     lsctn \<leftarrow> leaves_halfspace S (op_image_fst_colle XS0);
     XS0 \<leftarrow> (case lsctn of
         None \<Rightarrow> RETURN XS0
       | Some lsctn =>
         do {
             CHECKs (ST ''poincare_onto_from: section only makes sense if start section = end section'')
               (lsctn = sctn \<or> normal lsctn = - normal sctn \<and> pstn lsctn = - pstn sctn);
             guards \<leftarrow> unintersect_coll guardset;
             b \<leftarrow> subset_spec_coll (op_image_fst_colle XS0) ivl;
             CHECKs (ST ''poincare_onto_from: section only makes sense if we start from there'') b;
             (XS0, _) \<leftarrow> poincare_start_on guards lsctn (XS0);
             RETURN XS0
         }
       );
     PS \<leftarrow> poincare_onto_series interrupt trap guards XS0 ivl sctn ro;
     RETURN PS
   }"
 
 definition "subset_spec1 R P dP = do {
     R1 \<leftarrow> vec1rep R;
     dP \<leftarrow> default_rep UNIV dP;
     case (R1, dP) of (_, None) \<Rightarrow>
       op_subset (fst ` R) P
     | (Some RdR, Some dP) \<Rightarrow>
       op_subset RdR (P \<times> dP)
     | (None, Some _) \<Rightarrow> RETURN False
   }"
 
 definition "subset_spec1_coll R P dP = do {
     XS \<leftarrow> sets_of_coll R;
     WEAK_ALL (\<lambda>x. x \<subseteq> flow1_of_vec1 ` (P \<times> dP)) XS (\<lambda>X. subset_spec1 X P dP)
   }"
 
 definition "one_step_until_time X0 (ph::bool) (t1::real) =
   do {
     CHECKs ''one_step_until_time optns'' (0 \<le> t1);
     startstep \<leftarrow> start_stepsize_spec;
     rk2param \<leftarrow> rk2_param_spec;
     let fX0 = fst ` X0;
     mk_safe (fX0);
     (t, _, X, CX) \<leftarrow> WHILE (\<lambda>(t, _, _, _). t < t1) (\<lambda>(t, h, X, CXs). do {
         let _ = trace_set1e (ST ''choose step from:'') (Some X);
         (h0, CX, X, h') \<leftarrow> step_adapt_time X (min h (t1 - t));
         CHECKs (ST ''one_step negative step'') (h0 \<ge> 0 \<and> h' > 0 \<and> h0 \<le> min h (t1 - t));
         let _ = trace_set (ST ''interpolated step:'') (Some CX);
         let _ = print_set True CX;
         let _ = trace_set1e (ST ''step:'') (Some X);
         let _ = print_set1e False X;
         let fCX = CX;
         mk_safe fCX;
         let fX = fst ` X;
         mk_safe fX;
         RETURN (t + h0, h', X, mk_phantom (mk_coll CX) \<union> CXs)
     }) (0::real, startstep, X0, op_union_phantom (mk_phantom (mk_coll fX0)) (op_empty_phantom ph));
     RETURN (X, CX)
   }"
 
 definition "ivl_of_eucl_coll CY =
   do {
     (i, s) \<leftarrow> ivl_rep_of_set_coll CY;
     ASSERT (i \<le> s);
     RETURN (({i .. s}\<times>UNIV):::appr1_rel)
   }"
 
 definition "one_step_until_time_ivl X0 (ph::bool) (t1::real) (t2::real) =
   do {
     (X, CX) \<leftarrow>  one_step_until_time X0 ph t1;
     CHECKs (ST ''one_step_until_time_ivl empty time interval'') (0 \<le> t1 \<and> t1 \<le> t2);
     (if t2 = t1 then RETURN (X, CX)
     else do {
       (Y, CYp) \<leftarrow> one_step_until_time X False (t2 - t1);
       CY \<leftarrow> get_phantom CYp;
       R \<leftarrow> ivl_of_eucl_coll CY;
       mk_safe (fst ` R);
       R \<leftarrow> scaleRe_ivl_spec 1 1 R;
       RETURN (R, CYp \<union> CX)
     })
   }"
 
 definition "c1_info_invare n X = (let l = (fst (fst X)); u = (snd (fst X))
   in (c1_info_invar n (snd X)) \<and> (l < u \<or> -\<infinity> < l \<and> l \<le> u \<and> u < \<infinity>))"
 
 definition "c0_info_of_appr X = eucl_of_list ` set_of_appr X"
 definition "c0_info_of_apprs X = (\<Union>x\<in>set X. c0_info_of_appr x)"
 
 definition "c0_info_of_appr' X = the_default UNIV (map_option c0_info_of_apprs X)"
 
 lemma the_default_eq: "the_default a x = (case x of None \<Rightarrow> a | Some b \<Rightarrow> b)"
   by (auto split: option.splits)
 
 definition "poincare_onto_from_in_ivl interrupt trap
                                S                      \<comment> \<open>leaving this (half)space in the beginning\<close>
                           (guards)                    \<comment> \<open>avoiding guards\<close>
                           (ivl::'n rvec set)          \<comment> \<open>onto \<open>ivl\<close>\<close>
                           sctn                        \<comment> \<open>which is part of \<open>sctn\<close>\<close>
                           ro
                           (XS0::'n::enum eucl1 set)
                           P dP =
   do {
     RS \<leftarrow> poincare_onto_from interrupt trap S guards ivl sctn ro XS0;
     ((l, u), R) \<leftarrow> scaleR2_rep_coll RS;
     CHECKs (ST ''poincare_onto_from_in: there should not be scaleR2'') (l = 1 \<and> u = 1);
     (l, u) \<leftarrow> ivl_rep P;
     CHECKs (ST ''poincare_onto_from_in: strange interval'') (l \<le> u);
     _ \<leftarrow> mk_safe {l .. u};
     subset_spec1_coll R P dP
   }"
 
 definition "set_of_lvivl' x = (case x of None \<Rightarrow> UNIV | Some x \<Rightarrow> set_of_lvivl x)"
 
 definition "lvivl'_invar n x =
   (case x of None \<Rightarrow> True | Some (l, u) \<Rightarrow> length l = length u \<and> length u = n)"
 
 definition "one_step_until_time_ivl_in_ivl X0 (t1::real) (t2::real) R dR =
   do {
     (X, CX) \<leftarrow> one_step_until_time_ivl X0 True t1 t2;
     ((l, u), X) \<leftarrow> scaleR2_rep X;
     CHECKs (ST ''one_step_until_time_ivl_in_ivl: there should not be scaleR2'') (l = 1 \<and> u = 1);
     (l, u) \<leftarrow> ivl_rep R;
     CHECKs (ST ''one_step_until_time_ivl_in_ivl: strange interval'') (l \<le> u);
     _ \<leftarrow> mk_safe {l .. u};
     let _ = trace_set1 (ST ''final step to:'') (Some X);
     let _ = trace_set (ST ''contained in?'') (Some {l .. u});
     let _ = print_set1 False X;
     let _ = print_set False {l .. u};
     subset_spec1 X R dR
 }"
 
 definition "poincare_onto_in_ivl
                           (guards)                    \<comment> \<open>avoiding guards\<close>
                           (ivl::'n rvec set)          \<comment> \<open>onto \<open>ivl\<close>\<close>
                           sctn                        \<comment> \<open>which is part of \<open>sctn\<close>\<close>
                           ro
                           (XS0::'n::enum eucl1 set)
                           P dP =
   do {
     RS \<leftarrow> poincare_onto_series empty_symstart empty_trap guards XS0 ivl sctn ro;
     ((l, u), R) \<leftarrow> scaleR2_rep_coll RS;
     CHECKs (ST ''poincare_onto_in_ivl: there should not be scaleR2'') (l = 1 \<and> u = 1);
     (l, u) \<leftarrow> ivl_rep P;
     CHECKs (ST ''poincare_onto_in_ivl: strange interval'') (l \<le> u);
     (lR, uR) \<leftarrow> ivl_rep_of_set_coll (op_image_fst_coll R);
     CHECKs (ST ''poincare_onto_in_ivl: strange interval2'') (lR \<le> uR);
     let _ = trace_set (ST ''final step to:'') (Some {lR .. uR});
     let _ = trace_set (ST ''contained in?'') (Some {l .. u});
     _ \<leftarrow> mk_safe {l .. u};
     subset_spec1_coll R P dP
   }"
 
 definition "poincare_maps_onto \<Sigma> X0 X1 \<longleftrightarrow> poincare_mapsto \<Sigma> X0 UNIV (Csafe - \<Sigma>) X1"
 
 end
 
 end
 
 end
\ No newline at end of file
diff --git a/thys/Ordinary_Differential_Equations/Numerics/Concrete_Reachability_Analysis.thy b/thys/Ordinary_Differential_Equations/Numerics/Concrete_Reachability_Analysis.thy
--- a/thys/Ordinary_Differential_Equations/Numerics/Concrete_Reachability_Analysis.thy
+++ b/thys/Ordinary_Differential_Equations/Numerics/Concrete_Reachability_Analysis.thy
@@ -1,594 +1,594 @@
 theory Concrete_Reachability_Analysis
 imports
   Concrete_Rigorous_Numerics
   Abstract_Reachability_Analysis
 begin
 
 abbreviation "num_optns_rel \<equiv> (Id::'b numeric_options rel)"
 
 consts i_flow1::interface
 consts i_appr1::interface
 
 abbreviation "float10_rel \<equiv> Id::(float10 \<times> float10) set"
 
 lemma inj_on_nat_add_square: "inj_on (\<lambda>a::nat. a + a * a) S"
   by (rule strict_mono_imp_inj_on) (auto intro!: strict_monoI add_strict_mono mult_strict_mono)
 
 lemma add_sq_eq[simp]: "a + a * a = b + b * b \<longleftrightarrow> a = b" for a b::nat
   using inj_on_nat_add_square[of UNIV, unfolded inj_on_def, rule_format, of a b]
   by auto
 
 context includes autoref_syntax begin
 lemma [autoref_rules]:
   "(precision, precision)\<in>num_optns_rel \<rightarrow> nat_rel"
   "(start_stepsize, start_stepsize)\<in>num_optns_rel \<rightarrow> rnv_rel"
   "(iterations, iterations)\<in> num_optns_rel\<rightarrow> nat_rel"
   "(halve_stepsizes, halve_stepsizes)\<in> (num_optns_rel) \<rightarrow> nat_rel"
   "(widening_mod, widening_mod)\<in> (num_optns_rel) \<rightarrow>nat_rel"
   "(rk2_param, rk2_param)\<in> (num_optns_rel) \<rightarrow> rnv_rel"
   "(method_id, method_id)\<in> (num_optns_rel) \<rightarrow> nat_rel"
   "(adaptive_atol, adaptive_atol)\<in> (num_optns_rel) \<rightarrow> rnv_rel"
   "(adaptive_rtol, adaptive_rtol)\<in> (num_optns_rel) \<rightarrow> rnv_rel"
   "(printing_fun, printing_fun)\<in> (num_optns_rel) \<rightarrow> bool_rel \<rightarrow> I \<rightarrow> unit_rel"
   "(tracing_fun, tracing_fun)\<in> (num_optns_rel) \<rightarrow> string_rel \<rightarrow> \<langle>I\<rangle>option_rel \<rightarrow> unit_rel"
   by auto
 
 end
 
 lemma [autoref_op_pat_def]:
   includes autoref_syntax
   shows
     "(\<lambda>xs. xs @ replicate D 0) ` X \<equiv> OP (pad_zeroes D) $ X"
     "pad_zeroes D X \<equiv> OP (pad_zeroes D) $ X"
   by simp_all
 
 subsection \<open>Relation Implementing \<open>ode_ops\<close>: Caching \<open>slp_of\<close>-Programs.\<close>
 
 definition "ode_slps_of ode_ops =
   (approximate_sets_ode.ode_slp ode_ops,
     approximate_sets_ode.euler_incr_slp ode_ops,
     approximate_sets_ode.euler_slp ode_ops,
     approximate_sets_ode.rk2_slp ode_ops,
     approximate_sets_ode.D ode_ops)"
 
 definition "init_ode_ops poincare c1 ode_ops =
   (ode_ops, ode_slps_of ode_ops,
     (if poincare then Some(approximate_sets_ode.solve_poincare_slp ode_ops) else None),
     (if c1 then Some(ode_slps_of (approximate_sets_ode'.var_ode_ops ode_ops)) else None))"
 
 definition "ode_ops_rel =
   {(init, ode_ops). init = init_ode_ops True True ode_ops
     \<or> init = init_ode_ops True False ode_ops
     \<or> init = init_ode_ops False False ode_ops }"
 
 consts i_ode_ops::interface
 lemmas [autoref_rel_intf] = REL_INTFI[of ode_ops_rel i_ode_ops]
 lemmas [autoref_tyrel] = TYRELI[of ode_ops_rel]
 
 
 context approximate_sets begin
 
 unbundle autoref_syntax
 
 lemma print_set_impl[autoref_rules]:
   shows "(printing_fun optns, print_set) \<in> bool_rel \<rightarrow> A \<rightarrow> Id"
   by auto
 
 lemma trace_set_impl[autoref_rules]:
   shows "(tracing_fun optns, trace_set) \<in> string_rel \<rightarrow> \<langle>A\<rangle>option_rel \<rightarrow> Id"
   by auto
 
 definition "print_msg_impl s = tracing_fun optns s None"
 
 lemma print_msg_impl[autoref_rules]:
   shows "(print_msg_impl, print_msg) \<in> string_rel \<rightarrow> unit_rel"
   unfolding print_msg_def
   by auto
 
 definition "start_stepsize_impl = (if start_stepsize optns > 0 then start_stepsize optns else 1)"
 definition "rk2_param_impl = (let rk = rk2_param optns in if rk > 0 \<and> rk \<le> 1 then rk else 1)"
 
 lemma options_impl[autoref_rules]:
   "(RETURN (precision optns), precision_spec) \<in> \<langle>nat_rel\<rangle>nres_rel"
   "(RETURN (adaptive_atol optns), adaptive_atol_spec) \<in> \<langle>rnv_rel\<rangle>nres_rel"
   "(RETURN (adaptive_rtol optns), adaptive_rtol_spec) \<in> \<langle>rnv_rel\<rangle>nres_rel"
   "(RETURN (method_id optns), method_spec) \<in> \<langle>nat_rel\<rangle>nres_rel"
   "(RETURN start_stepsize_impl, start_stepsize_spec) \<in> \<langle>rnv_rel\<rangle>nres_rel"
   "(RETURN (iterations optns), iterations_spec) \<in> \<langle>nat_rel\<rangle>nres_rel"
   "(RETURN (widening_mod optns), widening_mod_spec) \<in> \<langle>nat_rel\<rangle>nres_rel"
   "(RETURN (halve_stepsizes optns), halve_stepsizes_spec) \<in> \<langle>nat_rel\<rangle>nres_rel"
   "(RETURN (rk2_param_impl), rk2_param_spec) \<in> \<langle>rnv_rel\<rangle>nres_rel"
   by (auto simp: nres_rel_def
       precision_spec_def
       adaptive_atol_spec_def
       adaptive_rtol_spec_def
       method_spec_def
       start_stepsize_spec_def start_stepsize_impl_def
       iterations_spec_def
       widening_mod_spec_def
       halve_stepsizes_spec_def
       rk2_param_spec_def rk2_param_impl_def Let_def)
 
 sublocale approximate_sets_ode where ode_ops = ode_ops for ode_ops :: ode_ops ..
 
 schematic_goal trace_sets_impl:
   assumes [autoref_rules]: "(si, s) \<in> string_rel" "(Xi, X) \<in> clw_rel appr_rel"
   shows "(RETURN ?f, trace_sets s X) \<in> \<langle>unit_rel\<rangle>nres_rel"
   unfolding trace_sets_def
   by (subst rel_ANNOT_eq[of X "clw_rel appr_rel"]) (autoref_monadic (plain))
 concrete_definition trace_sets_impl for si Xi uses trace_sets_impl
 lemmas [autoref_rules] = trace_sets_impl.refine[autoref_higher_order_rule]
 
 schematic_goal print_sets_impl:
   assumes [autoref_rules]: "(si, s) \<in> bool_rel" "(Xi, X) \<in> clw_rel appr_rel"
   shows "(RETURN ?f, print_sets s X) \<in> \<langle>unit_rel\<rangle>nres_rel"
   unfolding print_sets_def
   by (subst rel_ANNOT_eq[of X "clw_rel appr_rel"]) (autoref_monadic (plain))
 concrete_definition print_sets_impl for si Xi uses print_sets_impl
 lemmas [autoref_rules] = print_sets_impl.refine[autoref_higher_order_rule]
 
 definition "ode_slp_impl ode_ops =        (case ode_ops of (_, (x, _, _, _, _), _, _) \<Rightarrow> x)"
 definition "euler_incr_slp_impl ode_ops = (case ode_ops of (_, (_, x, _, _, _), _, _) \<Rightarrow> x)"
 definition "euler_slp_impl ode_ops =      (case ode_ops of (_, (_, _, x, _, _), _, _) \<Rightarrow> x)"
 definition "rk2_slp_impl ode_ops =        (case ode_ops of (_, (_, _, _, x, _), _, _) \<Rightarrow> x)"
 definition "D_impl ode_ops =              (case ode_ops of (_, (_, _, _, _, x), _, _) \<Rightarrow> x)"
 definition "poincare_slp_impl ode_ops =   (case ode_ops of (ode_ops, (_, _, _, _, _), x, _) \<Rightarrow>
   (case x of
     None \<Rightarrow> let _ = print_msg_impl (''ODE solver not initialized: pslp missing'') in solve_poincare_slp ode_ops
   | Some pslp \<Rightarrow> pslp))"
 
 lemma autoref_parameters[autoref_rules]:
   "(ode_slp_impl, ode_slp) \<in> ode_ops_rel \<rightarrow> slp_rel"
   "(euler_incr_slp_impl, euler_incr_slp) \<in> ode_ops_rel \<rightarrow> slp_rel"
   "(euler_slp_impl, euler_slp) \<in> ode_ops_rel \<rightarrow> slp_rel"
   "(rk2_slp_impl, rk2_slp) \<in> ode_ops_rel \<rightarrow> slp_rel"
   "(poincare_slp_impl, solve_poincare_slp) \<in> ode_ops_rel \<rightarrow> \<langle>slp_rel\<rangle>list_rel"
   "(D_impl, D) \<in> ode_ops_rel \<rightarrow> nat_rel"
   by (auto simp: ode_ops_rel_def ode_slp_impl_def euler_incr_slp_def D_impl_def init_ode_ops_def
       euler_incr_slp_impl_def euler_slp_impl_def rk2_slp_impl_def poincare_slp_impl_def
       ode_slps_of_def
       split: option.splits prod.splits)
 
 definition "ode_e_impl = (\<lambda>(ode_ops, _). ode_expression ode_ops)"
 lemma ode_e_impl[autoref_rules]: "(ode_e_impl, ode_e) \<in> ode_ops_rel \<rightarrow> fas_rel"
   by (auto simp: ode_e_impl_def ode_e_def ode_ops_rel_def init_ode_ops_def)
 
 definition "safe_form_impl = (\<lambda>(ode_ops, _). safe_form ode_ops)"
 lemma safe_form_impl[autoref_rules]: "(safe_form_impl, safe_form) \<in> ode_ops_rel \<rightarrow> Id"
   by (auto simp: safe_form_impl_def ode_ops_rel_def init_ode_ops_def)
 
 schematic_goal safe_set_appr:
   assumes [autoref_rules]: "(Xi, X::'a::executable_euclidean_space set) \<in> appr_rel"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   notes [autoref_rules] = autoref_parameters
   shows "(nres_of ?f, safe_set odo X) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding safe_set_def
   including art
   by autoref_monadic
 concrete_definition safe_set_appr for odoi Xi uses safe_set_appr
 lemmas safe_set_appr_refine[autoref_rules] = safe_set_appr.refine[autoref_higher_order_rule]
 
 schematic_goal mk_safe_impl:
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(Ri, R) \<in> appr_rel"
   shows "(nres_of ?f, mk_safe odo (R::'a::executable_euclidean_space set)) \<in> \<langle>appr_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding mk_safe_def
   including art
   by autoref_monadic
 concrete_definition mk_safe_impl for odoi Ri uses mk_safe_impl
 lemmas mk_safe_impl_refine[autoref_rules] = mk_safe_impl.refine[autoref_higher_order_rule]
 sublocale autoref_op_pat_def mk_safe .
 
 schematic_goal mk_safe_coll_impl:
   assumes [autoref_rules]: "(ISi, IS) \<in> clw_rel appr_rel"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   shows "(nres_of (?f), mk_safe_coll odo (IS::'a::executable_euclidean_space set)) \<in> \<langle>clw_rel appr_rel\<rangle>nres_rel"
   unfolding mk_safe_coll_def
   by autoref_monadic
 concrete_definition mk_safe_coll_impl for ISi uses mk_safe_coll_impl
 lemmas mk_safe_coll_impl_refine[autoref_rules] = mk_safe_coll_impl.refine[autoref_higher_order_rule]
 sublocale autoref_op_pat_def mk_safe_coll .
 
 schematic_goal ode_set_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules]: "(Xi, X) \<in> appr_rel"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   notes [autoref_rules] = autoref_parameters
   shows "(nres_of ?f, ode_set odo X::'a set nres) \<in> \<langle>appr_rel\<rangle>nres_rel"
   unfolding ode_set_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition ode_set_impl for E odoi Xi uses ode_set_impl
 lemmas ode_set_impl_refine[autoref_rules] = ode_set_impl.refine[autoref_higher_order_rule (1)]
 sublocale autoref_op_pat_def ode_set .
 
 schematic_goal Picard_step_ivl_impl:
   fixes h::real
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(X0i,X0)\<in>appr_rel" "(hi, h) \<in> rnv_rel" "(t0i, t0) \<in> rnv_rel" "(PHIi,PHI)\<in>appr_rel"
   notes [autoref_rules] = autoref_parameters
   shows "(nres_of ?f, Picard_step_ivl odo X0 t0 h PHI::'a set option nres) \<in> \<langle>\<langle>appr_rel\<rangle>option_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding Picard_step_ivl_def
   including art
   by autoref_monadic
 concrete_definition Picard_step_ivl_impl for X0i t0i hi PHIi uses Picard_step_ivl_impl
 lemmas Picard_step_ivl_impl_refine[autoref_rules] =
   Picard_step_ivl_impl.refine[autoref_higher_order_rule (1)]
 sublocale autoref_op_pat_def Picard_step_ivl .
 
 lemma [autoref_rules]:
   "(abs, abs:: 'a \<Rightarrow> 'a::executable_euclidean_space) \<in> rnv_rel \<rightarrow> rnv_rel"
   by simp_all
 
 lemma widening_spec[autoref_rules]:
   "(\<lambda>i. RETURN (widening_mod optns mod i = 0), do_widening_spec) \<in> nat_rel \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"
   by (auto simp: do_widening_spec_def nres_rel_def)
 
 schematic_goal P_iter_impl:
   fixes h::real and i::nat
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(X0i,X0)\<in>appr_rel" "(PHIi,PHI)\<in>appr_rel"
     "(hi, h) \<in> Id" "(i_i, i) \<in> Id"
   notes [autoref_rules] = autoref_parameters
   shows "(nres_of (?f::?'r dres), P_iter odo X0 h i PHI::'a set option nres) \<in> ?R"
   unfolding P_iter_def uncurry_rec_nat APP_def
   including art
   by autoref_monadic
 
 concrete_definition P_iter_impl for E odoi X0i hi i_i PHIi uses P_iter_impl
 lemmas [autoref_rules] = P_iter_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def P_iter .
 
 schematic_goal cert_stepsize_impl_nres:
   fixes h::real and i n::nat
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules]:
     "(mi, m)\<in>(appr_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel \<rightarrow> appr_rel \<rightarrow> \<langle>\<langle>appr_rel \<times>\<^sub>r R\<rangle> option_rel\<rangle>nres_rel)"
     "(X0i,X0)\<in>appr_rel" "(hi, h) \<in> rnv_rel" "(ni, n) \<in> nat_rel" "(i_i, i) \<in> nat_rel"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   shows "(?f::?'r nres, cert_stepsize odo m (X0::'a set) h n i) \<in> ?R"
   unfolding cert_stepsize_def uncurry_rec_nat autoref_tag_defs
   by autoref
 concrete_definition cert_stepsize_impl_nres for mi X0i hi ni i_i uses cert_stepsize_impl_nres
 lemmas [autoref_rules] = cert_stepsize_impl_nres.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def cert_stepsize .
 
 schematic_goal cert_stepsize_impl_dres[refine_transfer]:
   assumes [refine_transfer]: "\<And>a b c d. nres_of (m a b c d) \<le> m' a b c d"
   shows "nres_of ?f \<le> cert_stepsize_impl_nres E odo m' x h n i"
   unfolding cert_stepsize_impl_nres_def
   by (refine_transfer)
 
 concrete_definition cert_stepsize_impl_dres for E m x h n i uses cert_stepsize_impl_dres
 lemmas [refine_transfer] = cert_stepsize_impl_dres.refine
 
 lemma DIM_obvious[autoref_rules_raw]: "DIM_precond TYPE('a) DIM('a::executable_euclidean_space)"
   by (auto simp: )
 
 lemma default_reduce_argument_spec_impl[autoref_rules]:
   "(RETURN (default_reduce optns), default_reduce_argument_spec) \<in> \<langle>reduce_argument_rel TYPE('b)\<rangle>nres_rel"
   by (auto simp: nres_rel_def default_reduce_argument_spec_def reduce_argument_rel_def
       intro!: RETURN_RES_refine)
 
 schematic_goal euler_step_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes ncc: "ncc_precond TYPE('a::executable_euclidean_space)"
   notes [simp] = ncc_precondD[OF ncc]
   assumes [autoref_rules]: "(Xi, X) \<in> appr_rel" "(hi, h) \<in> Id"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   shows "(nres_of (?f::?'r dres), euler_step odo (X::'a set) h) \<in> ?R"
   unfolding one_step_def euler_step_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition euler_step_impl for odoi Xi hi uses euler_step_impl
 lemmas [autoref_rules] = euler_step_impl.refine[autoref_higher_order_rule(1 2)]
 sublocale autoref_op_pat_def euler_step .
 
 schematic_goal rk2_step_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes ncc: "ncc_precond TYPE('a::executable_euclidean_space)"
   assumes [autoref_rules]: "(Xi, X) \<in> appr_rel" "(hi, h) \<in> Id"
   notes [simp] = ncc_precondD[OF ncc]
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   shows "(nres_of (?f::?'r dres), rk2_step odo (X::'a set) h) \<in> ?R"
   unfolding one_step_def rk2_step_def[abs_def]
   by autoref_monadic
 
 concrete_definition rk2_step_impl for odoi Xi hi uses rk2_step_impl
 lemmas [autoref_rules] = rk2_step_impl.refine[autoref_higher_order_rule (1 2)]
 sublocale autoref_op_pat_def rk2_step .
 
 schematic_goal choose_step_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('a)"
   assumes [autoref_rules]: "(Xi, X) \<in> appr_rel" "(hi, h) \<in> rnv_rel"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   shows "(nres_of (?f), choose_step odo (X::'a set) h) \<in> \<langle>rnv_rel \<times>\<^sub>r appr_rel \<times>\<^sub>r appr_rel \<times>\<^sub>r appr_rel\<rangle>nres_rel"
   unfolding choose_step_def autoref_tag_defs if_distribR ncc_precond_def
   including art
   by autoref_monadic
 
 concrete_definition choose_step_impl for Xi hi uses choose_step_impl
 lemmas [autoref_rules] = choose_step_impl.refine[autoref_higher_order_rule (1 2)]
 sublocale autoref_op_pat_def choose_step .
 
 lemma [autoref_rules]: "(sgn, sgn) \<in> rnv_rel \<rightarrow> rnv_rel"
   by auto
 
 schematic_goal strongest_direction_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules]: "(xs, x) \<in> lv_rel"
   shows "(?f, strongest_direction (x::'a)) \<in> lv_rel \<times>\<^sub>r rnv_rel"
   unfolding strongest_direction_def
   including art
   by autoref
 concrete_definition strongest_direction_impl for xs uses strongest_direction_impl
 lemmas [autoref_rules] = strongest_direction_impl.refine[autoref_higher_order_rule (1)]
 sublocale autoref_op_pat_def strongest_direction .
 
 lemma [autoref_rules]:
   "(real_divl, real_divl) \<in> nat_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel"
   "(truncate_down, truncate_down) \<in> nat_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel"
   "(eucl_truncate_down, eucl_truncate_down) \<in> nat_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel"
   "(truncate_up, truncate_up) \<in> nat_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel"
   "(eucl_truncate_up, eucl_truncate_up) \<in> nat_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel"
   "(max, max) \<in> rnv_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel"
   "(min, min) \<in> rnv_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel"
   "((/), (/)) \<in> rnv_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel"
   "(lfloat10, lfloat10) \<in> rnv_rel \<rightarrow> float10_rel"
   "(ufloat10, ufloat10) \<in> rnv_rel \<rightarrow> float10_rel"
   "(shows_prec, shows_prec) \<in> nat_rel \<rightarrow> nat_rel \<rightarrow> string_rel \<rightarrow> string_rel"
   "(shows_prec, shows_prec) \<in> nat_rel \<rightarrow> int_rel \<rightarrow> string_rel \<rightarrow> string_rel"
   "(shows_prec, shows_prec) \<in> nat_rel \<rightarrow> float10_rel \<rightarrow> string_rel \<rightarrow> string_rel"
   "(int, int) \<in> nat_rel \<rightarrow> int_rel"
   by (auto simp: string_rel_def)
 
 schematic_goal intersects_sctns_spec_impl:
   assumes [autoref_rules]: "(ai, a) \<in> appr_rel"
   assumes sctns[autoref_rules]: "(sctnsi, sctns) \<in> sctns_rel"
   notes [simp] = list_set_rel_finiteD[OF sctns]
   shows "(nres_of (?x::_ dres), intersects_sctns (a::'a::executable_euclidean_space set) sctns) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding intersects_sctns_def
   by autoref_monadic
 concrete_definition intersects_sctns_spec_impl for ai sctnsi uses intersects_sctns_spec_impl
 lemmas intersects_sctns_refine[autoref_rules] = intersects_sctns_spec_impl.refine[autoref_higher_order_rule]
 sublocale autoref_op_pat_def intersects_sctns .
 
 lemma
   assumes "GEN_OP ws width_spec (A \<rightarrow> \<langle>rnv_rel\<rangle>nres_rel)"
   assumes "\<And>x. TRANSFER (RETURN (wsd x) \<le> ws x)"
   shows width_spec_invar_rel[autoref_rules]:
     "(\<lambda>(a, b). RETURN (wsd a), width_spec) \<in> \<langle>S, A\<rangle>invar_rel b \<rightarrow> \<langle>rnv_rel\<rangle>nres_rel"
     and width_spec_inter_rel[autoref_rules]:
     "(\<lambda>(a, b). RETURN (wsd a), width_spec) \<in> \<langle>S, A\<rangle>inter_rel \<rightarrow> \<langle>rnv_rel\<rangle>nres_rel"
   using assms
   by (auto simp: nres_rel_def width_spec_def invar_rel_def dest!: fun_relD)
 
 lemma width_spec_coll[autoref_rules]:
   assumes "GEN_OP ws width_spec (A \<rightarrow> \<langle>rnv_rel\<rangle>nres_rel)"
   assumes "\<And>x. TRANSFER (RETURN (wsd x) \<le> ws x)"
   shows "(\<lambda>xs. RETURN (sum_list (map wsd xs)), width_spec) \<in> clw_rel A \<rightarrow> \<langle>rnv_rel\<rangle>nres_rel"
   by (auto simp: nres_rel_def width_spec_def)
 
 schematic_goal intersects_sections_spec_clw[autoref_rules]:
   assumes [autoref_rules]: "(Ri, R) \<in> clw_rel appr_rel" "(sctnsi, sctns) \<in> sctns_rel"
   shows "(nres_of (?r::_ dres), intersects_sctns_spec_clw $ R $ sctns) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding intersects_sctns_spec_clw_def
   including art
   by autoref_monadic
 
 schematic_goal nonzero_component_impl:
   assumes [autoref_rules]: "(Xi, X) \<in> appr_rel" "(ni, n) \<in> lv_rel" "(si, s) \<in> string_rel"
   shows "(nres_of ?f, nonzero_component s X n) \<in> \<langle>unit_rel\<rangle>nres_rel"
   unfolding nonzero_component_def autoref_tag_defs
   by autoref_monadic
 concrete_definition nonzero_component_impl for si Xi ni uses nonzero_component_impl
 lemmas nonzero_component_impl_refine[autoref_rules] = nonzero_component_impl.refine[autoref_higher_order_rule]
 lemma
   take_set_of_apprI:
   assumes "xs \<in> set_of_appr XS" "tXS = take d XS" "d < length xs"
   shows "take d xs \<in> set_of_appr tXS"
   using set_of_appr_project[OF assms(1), of "[0..<d]"]
   apply (auto simp: assms take_eq_map_nth length_set_of_appr)
   using assms(1) assms(3) length_set_of_appr take_eq_map_nth by fastforce
 
 
 lemma sv_appr_rell[relator_props]: "single_valued appr_rell"
   by (auto simp: appr_rell_internal)
 
 lemma single_valued_union:
   shows "single_valued X \<Longrightarrow> single_valued Y \<Longrightarrow> Domain X \<inter> Domain Y = {} \<Longrightarrow> single_valued (X \<union> Y)"
   by (auto simp: single_valued_def)
 
 lemma is_empty_ivl_rel[autoref_rules]:
   assumes le[THEN GEN_OP_D, param_fo]: "GEN_OP le (\<le>) (A \<rightarrow> A \<rightarrow> bool_rel)"
   shows "(\<lambda>(x, y). \<not> le x y, is_empty) \<in> \<langle>A\<rangle>ivl_rel \<rightarrow> bool_rel"
   apply (auto simp: ivl_rel_def br_def set_of_ivl_def)
   subgoal premises prems for a b c d
     using le[OF prems(2, 3)] prems(1,4-) order_trans
     by auto
   subgoal premises prems for a b c d
     using le[OF prems(3,4)] prems(1,2) order_trans
     by auto
   done
 
 lemma real_autoref[autoref_rules]:
   "(real, real) \<in> nat_rel \<rightarrow> rnv_rel"
   by auto
 
 lemma map_option_autoref[autoref_rules]: "(map_option, map_option) \<in> (A \<rightarrow> B) \<rightarrow> \<langle>A\<rangle>option_rel \<rightarrow> \<langle>B\<rangle>option_rel"
   by (rule map_option_param)
 
 lemma sv_plane_rel[relator_props]: "single_valued A \<Longrightarrow> single_valued (\<langle>A\<rangle>plane_rel)"
   by (auto simp: plane_rel_def intro!: relator_props)
 lemma sv_below_rel[relator_props]: "single_valued A \<Longrightarrow> single_valued (\<langle>A\<rangle>below_rel)"
   by (auto simp: below_rel_def intro!: relator_props)
 lemma sv_sbelow_rel[relator_props]: "single_valued A \<Longrightarrow> single_valued (\<langle>A\<rangle>sbelow_rel)"
   by (auto simp: sbelow_rel_def intro!: relator_props)
 lemma sv_sbelows_rel[relator_props]: "single_valued A \<Longrightarrow> single_valued (\<langle>A\<rangle>sbelows_rel)"
   by (auto simp: sbelows_rel_def intro!: relator_props)
 
 lemma closed_ivl_rel[intro, simp]:  "(a, b) \<in> lvivl_rel \<Longrightarrow> closed b"
   by (auto simp: ivl_rel_def br_def set_of_ivl_def)
 
 lemma [autoref_rules]:
   "(float_of, float_of) \<in> rnv_rel \<rightarrow> Id"
-  "(approx, approx) \<in> nat_rel \<rightarrow> Id \<rightarrow> \<langle>\<langle>Id \<times>\<^sub>r Id\<rangle>option_rel\<rangle>list_rel \<rightarrow> \<langle>Id \<times>\<^sub>r Id\<rangle>option_rel"
+  "(approx, approx) \<in> nat_rel \<rightarrow> Id \<rightarrow> \<langle>\<langle>Id\<rangle>option_rel\<rangle>list_rel \<rightarrow> \<langle>Id\<rangle>option_rel"
   by auto
 
 lemma uninfo_autoref[autoref_rules]:
   assumes "PREFER single_valued X"
   assumes "PREFER single_valued R"
   shows "(map snd, uninfo) \<in> clw_rel (\<langle>R, X\<rangle>info_rel) \<rightarrow> clw_rel X"
   using assms
   apply (auto simp: lw_rel_def Union_rel_br info_rel_def br_chain br_rel_prod elim!: single_valued_as_brE
       dest!: brD
       intro!: brI)
   apply force
   apply force
   apply force
   done
 
 lemma [autoref_op_pat]: "(\<subseteq>) \<equiv> OP op_subset_ivl"
   by (force intro!: eq_reflection)
 
 lemma op_subset_ivl:
   assumes le[THEN GEN_OP_D, autoref_rules, param_fo]: "GEN_OP le (\<le>) (A \<rightarrow> A \<rightarrow> bool_rel)"
   shows "(\<lambda>(a, b) (c, d). le a b \<longrightarrow> le c a \<and> le b d, op_subset_ivl) \<in> \<langle>A\<rangle>ivl_rel \<rightarrow> \<langle>A\<rangle>ivl_rel \<rightarrow> bool_rel"
   apply (clarsimp dest!: brD simp: ivl_rel_def)
   subgoal for a b c d e f g h
     using le[of a c b d]
     using le[of e g a c]
     using le[of b d f h]
     by (auto simp: set_of_ivl_def)
   done
 concrete_definition op_subset_ivl_impl uses op_subset_ivl
 lemmas [autoref_rules] = op_subset_ivl_impl.refine
 
 lemma [autoref_op_pat]: "(=) \<equiv> OP op_eq_ivl"
   by (force intro!: eq_reflection)
 lemma eq_ivl_impl:
   assumes le[THEN GEN_OP_D, autoref_rules, param_fo]: "GEN_OP le (\<le>) (A \<rightarrow> A \<rightarrow> bool_rel)"
   shows "(\<lambda>(a, b) (c, d). (le a b \<longrightarrow> le c a \<and> le b d) \<and> (le c d \<longrightarrow> le a c \<and> le d b), op_eq_ivl) \<in> \<langle>A\<rangle>ivl_rel \<rightarrow> \<langle>A\<rangle>ivl_rel \<rightarrow> bool_rel"
   apply (clarsimp dest!: brD simp: )
   subgoal premises prems for a b c d e f
     using op_subset_ivl[param_fo, OF assms prems(1,2)]
       op_subset_ivl[param_fo, OF assms prems(2,1)]
     by (auto simp: )
   done
 concrete_definition eq_ivl_impl uses eq_ivl_impl
 lemmas [autoref_rules] = eq_ivl_impl.refine
 
 lemma [autoref_rules]: "(RETURN, get_plane) \<in> \<langle>A\<rangle>plane_rel \<rightarrow> \<langle>\<langle>A\<rangle>sctn_rel\<rangle>nres_rel"
   by (auto simp: plane_rel_def get_plane_def nres_rel_def dest!: brD intro!: RETURN_SPEC_refine)
 
 lemma [autoref_op_pat_def del]: "get_inter p \<equiv> OP (get_inter p)" by auto
 
 lemma inform_autoref[autoref_rules]:
   "(\<lambda>x. Max (abs ` set x), (infnorm::'a::executable_euclidean_space\<Rightarrow>real)) \<in> lv_rel \<rightarrow> rnv_rel"
   apply (auto simp: lv_rel_def br_def infnorm_def eucl_of_list_inner
       intro!: Max_eqI le_cSup_finite)
   subgoal for a y
     apply (rule exI[where x="Basis_list ! index a y"])
     by (auto simp: eucl_of_list_inner)
   subgoal
     apply (rule rev_subsetD)
      apply (rule closed_contains_Sup)
        apply (auto intro!: finite_imp_closed)
     apply (rule imageI)
     apply (auto simp: eucl_of_list_inner)
     done
   done
 
 schematic_goal tolerate_error_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) dd"
   assumes [autoref_rules]: "(Yi, Y::'a::executable_euclidean_space set) \<in> appr_rel"
   assumes [autoref_rules]: "(Ei, E) \<in> appr_rel"
   shows "(nres_of ?r, tolerate_error Y E) \<in> \<langle>bool_rel \<times>\<^sub>r rnv_rel\<rangle>nres_rel"
   unfolding tolerate_error_def
   including art
   by autoref_monadic
 concrete_definition tolerate_error_impl for dd Yi Ei uses tolerate_error_impl
 lemmas tolerate_error_refine[autoref_rules] = tolerate_error_impl.refine[autoref_higher_order_rule (1)]
 
 lemma adapt_stepsize_fa_autoref[autoref_rules]:
   "(adapt_stepsize_fa, adapt_stepsize_fa) \<in> rnv_rel \<rightarrow> nat_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel \<rightarrow> Id"
   by auto
 
 lemma
   list_wset_rel_finite:
   assumes "single_valued A"
   shows "(xs, X) \<in> \<langle>A\<rangle>list_wset_rel \<Longrightarrow> finite X"
   using assms
   by (auto simp: list_wset_rel_def set_rel_br dest!: brD elim!: single_valued_as_brE)
 
 lemma [autoref_rules_raw del]: "(norm2_slp, norm2_slp) \<in> nat_rel \<rightarrow> Id"
   and [autoref_itype del]: "norm2_slp ::\<^sub>i i_nat \<rightarrow>\<^sub>i i_of_rel (Id::(floatarith list \<times> floatarith list) set)"
   by auto
 
 lemma [autoref_rules]: "(norm2_slp, norm2_slp) \<in> nat_rel \<rightarrow> slp_rel"
   by auto
 
 lemma [autoref_rules_raw]: "DIM_precond TYPE(real) (Suc 0)"
   by auto
 lemma [autoref_rules]:
   "(real_divr, real_divr) \<in> nat_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel \<rightarrow> rnv_rel"
   by auto
 
 lemma length_norm2_slp_ge: "length (norm2_slp E) \<ge> 1"
   unfolding norm2_slp_def
   by (auto simp: slp_of_fas_def split: prod.splits)
 
 lemma blinfun_of_vmatrix_scaleR: "blinfun_of_vmatrix (c *\<^sub>R e) = c *\<^sub>R blinfun_of_vmatrix e"
   including blinfun.lifting
   by transfer (vector sum_distrib_left algebra_simps matrix_vector_mult_def fun_eq_iff)
 
 lemma closed_clw_rel_iplane_rel:
   "(xi, x) \<in> clw_rel (iplane_rel lvivl_rel) \<Longrightarrow> closed x"
   unfolding lvivl_rel_br
   by (force simp: lv_rel_def plane_rel_br inter_rel_br clw_rel_br set_of_ivl_def
       dest!: brD)
 
 lemma closed_ivl_prod3_list_rel:
   assumes "(y, x') \<in> clw_rel (iplane_rel lvivl_rel) \<times>\<^sub>r A"
   assumes "(xa, x'a) \<in> \<langle>clw_rel (iplane_rel lvivl_rel) \<times>\<^sub>r B\<rangle>list_rel"
   shows "\<forall>(guard, ro)\<in>set (x' # x'a). closed guard"
   using assms closed_clw_rel_iplane_rel
   apply (auto simp: list_rel_def prod_rel_def in_set_conv_nth list_all2_conv_all_nth)
   apply (drule spec)
   by auto
 
 lemma
   rec_list_fun_eq1:
   assumes "\<And>x xs a. snd (h x xs a) = snd a"
   shows "rec_list z (\<lambda>x xs r xa. f x xs xa (r (h x xs xa))) xs ab =
     rec_list (\<lambda>a. z (a, snd ab)) (\<lambda>x xs r a. f x xs (a, snd ab) (r (fst (h x xs (a, snd ab))))) xs (fst ab)"
   using assms
   unfolding split_beta'
   by (induction xs arbitrary: ab) (auto simp: split_beta')
 
 lemma
   rec_list_fun_eq2:
   assumes "\<And>x xs a. fst (h x xs a) = fst a"
   shows "rec_list z (\<lambda>x xs r xa. f x xs xa (r (h x xs xa))) xs ab =
     rec_list (\<lambda>b. z (fst ab, b)) (\<lambda>x xs r b. f x xs (fst ab, b) (r (snd (h x xs (fst ab, b))))) xs (snd ab)"
   using assms
   unfolding split_beta'
   by (induction xs arbitrary: ab) (auto simp: split_beta')
 
 lemma [autoref_itype]: "compact ::\<^sub>i A \<rightarrow>\<^sub>i i_bool"
   by auto
 
 lemma lvivl_rel_compact[autoref_rules]:
   "(\<lambda>_::_\<times>_. True, compact) \<in> lvivl_rel \<rightarrow> bool_rel"
   "(\<lambda>_::(_\<times>_)list. True, compact) \<in> clw_rel lvivl_rel \<rightarrow> bool_rel"
   by (auto simp: lvivl_rel_br set_of_ivl_def lw_rel_def Union_rel_br dest!: brD)
 
 end
 
 end
\ No newline at end of file
diff --git a/thys/Ordinary_Differential_Equations/Numerics/Concrete_Reachability_Analysis_C1.thy b/thys/Ordinary_Differential_Equations/Numerics/Concrete_Reachability_Analysis_C1.thy
--- a/thys/Ordinary_Differential_Equations/Numerics/Concrete_Reachability_Analysis_C1.thy
+++ b/thys/Ordinary_Differential_Equations/Numerics/Concrete_Reachability_Analysis_C1.thy
@@ -1,1712 +1,1716 @@
 theory Concrete_Reachability_Analysis_C1
 imports
   Concrete_Reachability_Analysis
   Abstract_Reachability_Analysis_C1
 begin
 
 definition "op_card_vec TYPE('a) = CARD('a)"
 lemma op_card_vec_pat_def[autoref_op_pat_def]: "CARD('a) \<equiv> OP (op_card_vec TYPE('a))"
   by (auto simp: op_card_vec_def)
 lemma op_card_vec_impl[autoref_rules]:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::enum rvec) E"
   shows "(E, op_card_vec TYPE('a)) \<in> nat_rel"
   using assms by (auto simp: op_card_vec_def)
 
 
 context approximate_sets
 begin
 
 sublocale approximate_sets_ode' where ode_ops = ode_ops for ode_ops ..\<comment> \<open>parametrized by \<open>ode_ops\<close>\<close>
 
 end
 
 context approximate_sets
 begin
 
 lemma nonneg_reals_autoref[autoref_rules]: "(None, nonneg_reals) \<in> \<langle>Id\<rangle>phantom_rel"
   and pos_reals_autoref[autoref_rules]: "(None, pos_reals) \<in> \<langle>Id\<rangle>phantom_rel"
   by (auto simp: phantom_rel_def)
 
 lemma appr1_relI:
   assumes "c1_info_invar DIM('n::executable_euclidean_space) X0i"
   shows "(X0i, (c1_info_of_appr X0i::'n c1_info set)) \<in> appr1_rel"
     using assms
   apply (cases "snd X0i")
   subgoal
     apply (simp add: c1_info_of_appr_def c1_info_invar_def)
     unfolding appr1_rel_internal
     apply (rule UnI1)
     apply auto
     apply (rule exI[where x="fst X0i"])
     apply safe
     subgoal by (auto simp: prod_eq_iff)
     subgoal
       apply (rule exI[where x="eucl_of_list ` set_of_appr (fst X0i)"])
       apply (auto simp: appr_rel_def)
       by (auto simp: appr_rell_internal lv_rel_def set_rel_br br_chain length_set_of_appr
           intro!: brI)
     done
   subgoal for D
     apply (simp add: c1_info_of_appr_def c1_info_invar_def)
     unfolding appr1_rel_internal
     apply (rule UnI2)
     apply (auto simp: set_rel_br)
     apply (rule exI[where x="fst X0i"])
     apply (rule exI[where x=D])
     apply safe
     subgoal by (auto simp: prod_eq_iff)
     subgoal
       by (auto simp: appr_rell_internal lv_rel_def set_rel_br br_chain length_set_of_appr
           intro!: brI) (auto simp:  power2_eq_square)
     done
   done
 
 lemma appr1_rel_br: "appr1_rel = br (c1_info_of_appr::_\<Rightarrow>('n c1_info)set) (c1_info_invar DIM('n::executable_euclidean_space))"
   apply (auto simp: dest!: brD intro!: appr1_relI)
   apply (rule brI)
   subgoal by (auto simp: appr1_rel_internal c1_info_of_appr_def appr_rel_br set_rel_br dest!: brD)
   subgoal by (auto simp: c1_info_invar_def appr1_rel_internal appr_rel_br power2_eq_square dest!: brD)
   done
 
 lemma appr1_rel_aux:
   "{((xs, Some ys), X) |xs ys X. (xs @ ys, X) \<in> appr_rel \<and> length ys = (length xs)\<^sup>2} O
     \<langle>br flow1_of_vec1 top\<rangle>set_rel =
   {((xs, Some ys), X::'n eucl1 set) |xs ys X.
      X = (\<lambda>xs. flow1_of_vec1 (eucl_of_list xs)) ` set_of_appr (xs @ ys) \<and>
      length xs = DIM((real, 'n::enum) vec) \<and> length ys = DIM((real, 'n) vec) * DIM((real, 'n) vec)}"
   apply (auto simp: set_rel_br appr_rel_br power2_eq_square dest!: brD)
   apply (rule relcompI)
    apply simp
    apply (rule brI) apply (rule refl) apply simp
   apply (rule brI) defer apply simp
   apply auto
   done
 
 lemma flow1_of_list_def':
   shows "flow1_of_list xs = flow1_of_vec1 (eucl_of_list xs)"
   by (auto simp: flow1_of_list_def flow1_of_vec1_def eucl_of_list_prod
       blinfun_of_list_eq_blinfun_of_vmatrix)
 
 lemma appr1_rel_def:
   "appr1_rel =
     {((xs, None   ), X \<times> UNIV)| xs X. (xs, X) \<in> appr_rel} \<union>
     {((xs, Some ys), X)| xs ys X. (xs @ ys, X) \<in> appr_rel \<and> length ys = (length xs)\<^sup>2} O \<langle>br flow1_of_vec1 top\<rangle>set_rel"
   unfolding appr1_rel_internal flow1_of_list_def'[abs_def] appr1_rel_aux ..
 
 lemmas [autoref_rel_intf] = REL_INTFI[of appr1_rel i_appr1]
 lemma [autoref_op_pat]: "(`) flow1_of_vec1 \<equiv> OP op_image_flow1_of_vec1"
   by auto
 
 lemma op_image_flow1_of_vec1[autoref_rules]:
   assumes "DIM_precond TYPE('a rvec) E"
   shows "(\<lambda>xs. (take E xs, Some (drop E xs)),
     op_image_flow1_of_vec1::('a::enum) vec1 set\<Rightarrow>_) \<in> appr_rel \<rightarrow> appr1_rel"
   using assms
   apply (auto simp: appr1_rel_def set_rel_br flow1_of_vec1_def[abs_def] intro!: brI elim!: notE
       split: option.splits list.splits)
   apply (rule relcompI[OF _ brI[OF refl]])
    apply (auto simp: power2_eq_square min_def appr_rel_br br_def)
   done
 
 lemma index_autoref[autoref_rules]:
   "(index, index) \<in> \<langle>lv_rel\<rangle>list_rel \<rightarrow> lv_rel \<rightarrow> nat_rel"
   unfolding index_def[abs_def] find_index_def
   apply parametricity
   apply (auto simp: lv_rel_def br_def list_rel_def)
   using list_of_eucl_eucl_of_list by force
 
 lemma [autoref_op_pat]: "(`) fst \<equiv> OP op_image_fst"
   by auto
 
 lemma op_image_fst_flow1[autoref_rules]:
   shows "(\<lambda>x. fst x, op_image_fst::_\<Rightarrow>'n::executable_euclidean_space set) \<in> appr1_rel \<rightarrow> appr_rel"
   apply (auto simp: appr1_rel_internal flow1_of_list_def set_rel_br image_image power2_eq_square dest!: brD)
   apply (auto simp: br_def appr_rel_br length_set_of_appr image_image eucl_of_list_prod
       dest!: set_of_appr_takeD)
   subgoal for xs ys a
     apply (rule image_eqI[where x="take DIM('n) a"])
     by (auto intro!: take_set_of_apprI dest: length_set_of_appr)
   subgoal for xs ys a
     apply (frule set_of_appr_ex_append2[where b=ys])
     apply auto
     subgoal for r
       apply (rule image_eqI[where x="a @ r"])
        apply (auto simp: length_set_of_appr )
       apply (rule eucl_of_list_eqI)
       by (auto dest!: length_set_of_appr)
     done
   done
 
 lemma op_image_fste_impl[autoref_rules]:
   "((\<lambda>(_, x, _). x), op_image_fste) \<in> appr1e_rel \<rightarrow> appr_rel"
   by (auto simp: image_image split_beta' scaleR2_rel_def
       dest!: op_image_fst_flow1[param_fo] brD)
 
 lemma DIM_precond_vec1I[autoref_rules_raw]:
   assumes "DIM_precond TYPE('n::enum rvec) E"
   shows "DIM_precond TYPE('n::enum vec1) (E + E*E)"
   using assms
   by (auto simp: )
 
 lemma vec1rep_impl[autoref_rules]:
   "(\<lambda>(a, bs). RETURN (map_option ((@) a) bs), vec1rep) \<in> appr1_rel \<rightarrow> \<langle>\<langle>appr_rel\<rangle>option_rel\<rangle>nres_rel"
   apply (auto simp: vec1rep_def appr1_rel_def set_rel_br appr_rel_def power2_eq_square nres_rel_def
       dest!: brD
       intro!: RETURN_SPEC_refine)
   subgoal for xs ys a b
     apply (rule exI[where x="Some (eucl_of_list ` set_of_appr (xs @ ys))"])
     apply (auto simp: appr_rell_internal image_image lv_rel_def set_rel_br length_set_of_appr
         intro!: brI dest!: brD)
     done
   done
 
 lemma [autoref_op_pat]: "X \<times> UNIV \<equiv> OP op_times_UNIV $ X" by simp
 
 lemma op_times_UNIV_impl[autoref_rules]: "(\<lambda>x. (x, None), op_times_UNIV) \<in> appr_rel \<rightarrow> appr1_rel"
   by (auto simp: appr1_rel_internal)
 
 schematic_goal solve_poincare_plane_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules]: "(ni, n) \<in> lv_rel" and CX[autoref_rules]: "(CXi, CX) \<in> appr1_rel"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   shows "(nres_of (?R), solve_poincare_plane odo n (CX::'n eucl1 set)) \<in> \<langle>appr1_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding solve_poincare_plane_def
   including art
   by autoref_monadic
 concrete_definition solve_poincare_plane_impl for ni CXi uses solve_poincare_plane_impl
 lemmas solve_poincare_plane_impl_refine[autoref_rules] = solve_poincare_plane_impl.refine[autoref_higher_order_rule (1)]
 sublocale autoref_op_pat_def solve_poincare_plane .
 
 lemma [autoref_rules_raw]:
   assumes "DIM_precond TYPE((real, 'n::enum) vec) K"
   shows "DIM_precond TYPE(((real, 'n) vec, 'n) vec) (K * K)"
   using assms by auto
 
 lemma embed1_impl[autoref_rules]:
   assumes "DIM_precond TYPE((real, 'n::enum) vec) E"
   shows "((\<lambda>x. x @ replicate (E * E) 0), embed1::'n rvec\<Rightarrow>_) \<in> lv_rel \<rightarrow> lv_rel"
   using assms
   by (auto simp: lv_rel_def br_def eucl_of_list_prod)
 
 definition "var_ode_ops_impl = (\<lambda>(ode_ops, _, _, vode_slps).
     (var_ode_ops ode_ops, (case vode_slps of None =>
       let _ = print_msg_impl ''ODE solver not properly initialized: vode_slps missing!'' in
       ode_slps_of (approximate_sets_ode'.var_ode_ops ode_ops)
     | Some (vode_slps) => vode_slps), None, None))"
 
 lemma var_ode_ops[autoref_rules]: "(var_ode_ops_impl, var_ode_ops) \<in> ode_ops_rel \<rightarrow> ode_ops_rel"
   by (auto simp: var_ode_ops_impl_def ode_ops_rel_def init_ode_ops_def split: option.splits)
 
 schematic_goal choose_step1_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE((real, 'n::enum) vec) E"
     "ncc_precond TYPE('n vec1)"
     "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules]: "(Xi, X::'n eucl1 set) \<in> appr1_rel" "(hi, h) \<in> rnv_rel"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   notes [autoref_post_simps] = fst_conv
   shows "(nres_of ?f, choose_step1 odo X h) \<in> \<langle>rnv_rel \<times>\<^sub>r appr1_rel \<times>\<^sub>r appr1_rel \<times>\<^sub>r appr1_rel\<rangle>nres_rel"
   unfolding choose_step1_def
   including art
   by autoref_monadic
 concrete_definition choose_step1_impl for Xi hi uses choose_step1_impl
 lemmas [autoref_rules] = choose_step1_impl.refine[autoref_higher_order_rule (1 2 3)]
 sublocale autoref_op_pat_def choose_step1 .
 
 lemma op_image_zerofst_impl[autoref_rules]:
   "(\<lambda>(_, x). (appr_of_ivl ops (replicate E 0) (replicate E 0), x), op_image_zerofst::'n c1_info set \<Rightarrow> _)
     \<in> appr1_rel \<rightarrow> appr1_rel"
   if "DIM_precond (TYPE('n::executable_euclidean_space)) E"
   using that
   apply (auto simp: appr1_rel_br dest!: brD intro!: brI)
   subgoal by (force simp: c1_info_of_appr_def image_image flow1_of_list_def
         set_of_appr_of_ivl_point_append eucl_of_list_prod c1_info_invar_def length_set_of_appr
         split: option.splits elim!: mem_set_of_appr_appendE cong del: image_cong_simp)
   subgoal for a b c d
     apply (auto simp: c1_info_of_appr_def
         split: option.splits)
     subgoal using set_of_appr_nonempty[of a]
       by (force  simp del: set_of_appr_nonempty)
     subgoal
       supply [simp del] = eucl_of_list_take_DIM
       apply (auto simp: image_image set_of_appr_of_ivl_point_append
           flow1_of_list_def)
       apply (frule set_of_appr_ex_append1[where b=a])
       apply auto
       apply (rule image_eqI) prefer 2 apply assumption
       by (auto simp: eucl_of_list_prod c1_info_invar_def
           dest!: length_set_of_appr)
     done
   subgoal
     by (auto simp: c1_info_of_appr_def flow1_of_vec1_def image_image
         set_of_appr_of_ivl_point_append eucl_of_list_prod c1_info_invar_def length_set_of_appr
         split: option.splits elim!: mem_set_of_appr_appendE)
   done
 sublocale autoref_op_pat_def op_image_zerofst .
 
 lemma op_image_zerofst_vec_impl[autoref_rules]:
   "(\<lambda>x. (appr_of_ivl ops (replicate E 0) (replicate E 0) @ drop E x), op_image_zerofst_vec::'n vec1 set \<Rightarrow> _)
     \<in> appr_rel \<rightarrow> appr_rel"
   if "DIM_precond (TYPE('n::enum rvec)) E"
   using that
   apply (auto simp: appr_rel_br set_of_appr_of_ivl_point_append image_image eucl_of_list_prod
       dest!: brD intro!: brI
       dest: drop_set_of_apprD[where n="CARD('n)"] cong del: image_cong_simp)
   subgoal for a b
     apply (drule set_of_appr_dropD)
     apply safe
     apply (rule image_eqI) defer apply assumption
     apply (auto simp: eucl_of_list_prod)
     apply (rule eucl_of_list_eq_takeI)
     apply simp
     done
   done
 sublocale autoref_op_pat_def op_image_zerofst_vec .
 
 lemma [autoref_op_pat_def]: "embed1 ` X \<equiv> OP op_image_embed1 $ X"
   by auto
 
 lemma op_image_embed1_impl[autoref_rules]:
   assumes "DIM_precond TYPE((real, 'n::enum) vec) E"
   shows "(\<lambda>x. x@appr_of_ivl ops (replicate (E*E) 0) (replicate (E*E) 0), op_image_embed1::'n rvec set \<Rightarrow> _)
     \<in> appr_rel \<rightarrow> appr_rel"
   using assms
   by (force simp: appr_rel_br br_def set_of_appr_of_ivl_point_append set_of_appr_of_ivl_append_point
       image_image eucl_of_list_prod length_set_of_appr)
 sublocale autoref_op_pat_def op_image_embed1 .
 
 lemma sv_appr1_rel[relator_props]: "single_valued appr1_rel"
   apply (auto simp:  appr1_rel_internal appr_rel_def intro!: relator_props single_valued_union)
    apply (auto simp: single_valued_def)
    apply (auto simp: lv_rel_def set_rel_br)
    apply (auto simp: br_def)
    apply (rule imageI)
   apply (metis single_valued_def sv_appr_rell)
   by (metis imageI single_valued_def sv_appr_rell)
 
 schematic_goal inter_sctn1_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE((real, 'n::enum) vec) E" "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(Xi, (X::'n eucl1 set)) \<in> appr1_rel" "(hi, h) \<in> \<langle>lv_rel\<rangle>sctn_rel"
   shows "(nres_of ?f, inter_sctn1_spec X h) \<in> \<langle>appr1_rel \<times>\<^sub>r appr1_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding inter_sctn1_spec_def
   including art
   by autoref_monadic
 concrete_definition inter_sctn1_impl for Xi hi uses inter_sctn1_impl
 lemmas [autoref_rules] = inter_sctn1_impl.refine[autoref_higher_order_rule (1 2)]
 sublocale autoref_op_pat_def inter_sctn1_spec .
 
 schematic_goal op_image_fst_coll_nres_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::executable_euclidean_space) E"
   assumes [autoref_rules]: "(XSi, (XS::'n c1_info set)) \<in> clw_rel appr1_rel"
   shows "(RETURN ?r, op_image_fst_coll_nres XS) \<in> \<langle>clw_rel appr_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding op_image_fst_coll_nres_def
   including art
   by (autoref_monadic (plain))
 concrete_definition op_image_fst_coll_nres_impl for XSi uses op_image_fst_coll_nres_impl
 lemmas [autoref_rules] = op_image_fst_coll_nres_impl.refine[autoref_higher_order_rule (1)]
 sublocale autoref_op_pat_def op_image_fst_coll_nres .
 
 lemma [autoref_op_pat]: "(`) fst \<equiv> OP op_image_fst_coll"
   by auto
 lemma op_image_fst_coll_impl[autoref_rules]:
   assumes "DIM_precond TYPE('n::executable_euclidean_space) E"
   shows "(op_image_fst_coll_nres_impl, op_image_fst_coll::_\<Rightarrow>'n set) \<in> clw_rel appr1_rel \<rightarrow> clw_rel appr_rel"
   apply rule
   subgoal premises prems for x
     using nres_rel_trans2[OF op_image_fst_coll_nres_spec[OF order_refl]
       op_image_fst_coll_nres_impl.refine[OF assms, simplified, OF prems]]
     by (auto simp: nres_rel_def RETURN_RES_refine_iff)
   done
 
 schematic_goal fst_safe_coll_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::executable_euclidean_space) E"
   assumes [autoref_rules]: "(XSi, (XS::'n c1_info set)) \<in> clw_rel appr1_rel"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   shows "(nres_of ?r, fst_safe_coll odo XS) \<in> \<langle>clw_rel appr_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding fst_safe_coll_def
   including art
   by autoref_monadic
 concrete_definition fst_safe_coll_impl for XSi uses fst_safe_coll_impl
 lemmas [autoref_rules] = fst_safe_coll_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def fst_safe_coll_impl .
 
 lemma [autoref_op_pat]: "(`) flow1_of_vec1 \<equiv> OP op_image_flow1_of_vec1_coll"
   by auto
 
 lemma op_image_flow1_of_vec1_coll[autoref_rules]:
   "(map (\<lambda>x. (take E x, Some (drop E x))), op_image_flow1_of_vec1_coll::_\<Rightarrow>'n eucl1 set) \<in> clw_rel appr_rel \<rightarrow> clw_rel appr1_rel"
   if "DIM_precond TYPE('n::enum rvec) E"
   apply (rule lift_clw_rel_map)
      apply (rule relator_props)
   apply (rule relator_props)
   unfolding op_image_flow1_of_vec1_coll_def op_image_flow1_of_vec1_def[symmetric]
   apply (rule op_image_flow1_of_vec1)
   using that
   by auto
 sublocale autoref_op_pat_def op_image_flow1_of_vec1_coll .
 
 schematic_goal vec1reps_impl:
   assumes [autoref_rules]: "(Xi, X) \<in> clw_rel appr1_rel"
   shows "(RETURN ?r, vec1reps X) \<in> \<langle>\<langle>clw_rel appr_rel\<rangle>option_rel\<rangle>nres_rel"
   unfolding vec1reps_def
   including art
   by (autoref_monadic (plain))
 concrete_definition vec1reps_impl for Xi uses vec1reps_impl
 lemma vec1reps_impl_refine[autoref_rules]:
   "(\<lambda>x. RETURN (vec1reps_impl x), vec1reps) \<in> clw_rel appr1_rel \<rightarrow> \<langle>\<langle>clw_rel appr_rel\<rangle>option_rel\<rangle>nres_rel"
   using vec1reps_impl.refine by force
 sublocale autoref_op_pat_def vec1reps .
 
 abbreviation "intersection_STATE_rel \<equiv>
   (appr1_rel \<times>\<^sub>r \<langle>Id\<rangle>phantom_rel \<times>\<^sub>r clw_rel appr1_rel \<times>\<^sub>r clw_rel appr1_rel \<times>\<^sub>r
     clw_rel (\<langle>appr_rel, \<langle>lv_rel\<rangle>sbelows_rel\<rangle>inter_rel) \<times>\<^sub>r bool_rel \<times>\<^sub>r bool_rel)"
 
 lemma print_set_impl1[autoref_rules]:
   shows "(\<lambda>a s. printing_fun optns a (list_of_appr1 s), print_set1) \<in> bool_rel \<rightarrow> A \<rightarrow> Id"
   by auto
 sublocale autoref_op_pat_def print_set1 .
 
 lemma trace_set1_impl1[autoref_rules]:
   shows "(\<lambda>s a. tracing_fun optns s (map_option list_of_appr1 a), trace_set1) \<in> string_rel \<rightarrow> \<langle>A\<rangle>option_rel \<rightarrow> Id"
   by auto
 sublocale autoref_op_pat_def trace_set1 .
 
 lemma print_set_impl1e[autoref_rules]:
   shows "(\<lambda>a s. printing_fun optns a (list_of_appr1e s), print_set1e) \<in> bool_rel \<rightarrow> A \<rightarrow> Id"
   by auto
 sublocale autoref_op_pat_def print_set1e .
 lemma trace_set1_impl1e[autoref_rules]:
   shows "(\<lambda>s a. tracing_fun optns s (map_option (list_of_appr1e) a), trace_set1e) \<in> string_rel \<rightarrow> \<langle>A\<rangle>option_rel \<rightarrow> Id"
   by auto
 sublocale autoref_op_pat_def trace_set1e .
 
 schematic_goal split_spec_param1_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::enum rvec) E"
   assumes [autoref_rules]: "(Xi, X) \<in> appr1_rel"
   notes [autoref_post_simps] = case_prod_eta
   shows "(nres_of (?f), split_spec_param1 (X::'a eucl1 set)) \<in> \<langle>appr1_rel \<times>\<^sub>r appr1_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding split_spec_param1_def
   including art
   by autoref_monadic
 concrete_definition split_spec_param1_impl for Xi uses split_spec_param1_impl
 lemmas split_spec_param1_refine[autoref_rules] =
   split_spec_param1_impl.refine[autoref_higher_order_rule (1)]
 sublocale autoref_op_pat_def split_spec_param1 .
 
 lemma [autoref_op_pat del]: "{} \<equiv> OP op_empty_default" "{} \<equiv> OP op_empty_coll"
   and [autoref_op_pat_def del]: "get_inter p \<equiv> OP (get_inter p)"
   by simp_all
 
 lemma fst_image_c1_info_of_appr:
   "c1_info_invar (DIM('a)) X \<Longrightarrow>
     (fst ` c1_info_of_appr X::'a::executable_euclidean_space set) = eucl_of_list ` (set_of_appr (fst X))"
   apply (auto simp: c1_info_invar_def power2_eq_square image_image flow1_of_list_def
       c1_info_of_appr_def flow1_of_vec1_def eucl_of_list_prod split: option.splits)
   subgoal for a b
     by (rule image_eqI[where x="take DIM('a) b"]) (auto intro!: take_set_of_apprI simp: length_set_of_appr)
   subgoal for a b
     apply (frule set_of_appr_ex_append2[where b=a])
     apply auto
     subgoal for r
       by (rule image_eqI[where x="b@r"])
          (auto intro!: eucl_of_list_eqI dest!: length_set_of_appr)
     done
   done
 
 lemma op_image_fst_colle_impl[autoref_rules]:
   "(map (\<lambda>(_, x, _). x), op_image_fst_colle) \<in> clw_rel appr1e_rel \<rightarrow> clw_rel appr_rel"
   apply (rule fun_relI)
   unfolding appr_rel_br
   apply (rule map_mem_clw_rel_br)
   unfolding appr1_rel_br
   unfolding scaleR2_rel_br
   unfolding clw_rel_br
    apply (auto dest!: brD simp: image_Union split_beta')
     apply (drule bspec, assumption)
     apply auto
     apply (drule bspec, assumption)
     apply (auto simp: fst_image_c1_info_of_appr)
    apply (rule bexI) prefer 2 apply assumption
    apply (auto simp: scaleR2_rel_br scaleR2_def image_def c1_info_of_appr_def
       split: option.splits)
   subgoal for a b c d e f g h i
     apply (rule bexI[where x="take DIM('a) i"])
     by (auto intro!: take_set_of_apprI simp: flow1_of_list_def eucl_of_list_prod c1_info_invar_def
         length_set_of_appr)
   subgoal
     by (auto intro!: take_set_of_apprI simp: flow1_of_vec1_def eucl_of_list_prod
         length_set_of_appr c1_info_invar_def)
   done
 sublocale autoref_op_pat_def op_image_fst_colle .
 
 lemma is_empty_appr1_rel[autoref_rules]:
   "(\<lambda>_. False, is_empty) \<in> appr1_rel \<rightarrow> bool_rel"
   by (auto simp: appr1_rel_internal set_rel_br) (auto simp: appr_rel_br br_def)
 sublocale autoref_op_pat_def is_empty .
 
 schematic_goal split_spec_param1e_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::enum rvec) E"
   assumes [autoref_rules]: "(Xi, X) \<in> \<langle>appr1_rel\<rangle>scaleR2_rel"
   notes [autoref_post_simps] = case_prod_eta
   shows "(nres_of (?f), split_spec_param1e (X::'a eucl1 set)) \<in>
     \<langle>\<langle>appr1_rel\<rangle>scaleR2_rel \<times>\<^sub>r \<langle>appr1_rel\<rangle>scaleR2_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding split_spec_param1e_def
   including art
   by autoref_monadic
 concrete_definition split_spec_param1e_impl for Xi uses split_spec_param1e_impl
 lemmas split_spec_param1e_refine[autoref_rules] =
   split_spec_param1e_impl.refine[autoref_higher_order_rule (1)]
 sublocale autoref_op_pat_def split_spec_param1e .
 
 schematic_goal reduce_spec1_impl:
   "(nres_of ?r, reduce_spec1 C X) \<in> \<langle>appr1_rel\<rangle>nres_rel"
   if [autoref_rules_raw]: "DIM_precond TYPE((real, 'n::enum) vec) E"
     and [autoref_rules]: "(Xi, X::'n eucl1 set) \<in> appr1_rel" "(Ci, C) \<in> reduce_argument_rel TYPE('b)"
   unfolding reduce_spec1_def
   including art
   by autoref_monadic
 concrete_definition reduce_spec1_impl for Ci Xi uses reduce_spec1_impl
 lemmas reduce_spec1_impl_refine[autoref_rules] = reduce_spec1_impl.refine[autoref_higher_order_rule (1)]
 sublocale autoref_op_pat_def reduce_spec1 .
 
 schematic_goal reduce_spec1e_impl:
   "(nres_of ?r, reduce_spec1e C X) \<in> \<langle>\<langle>appr1_rel\<rangle>scaleR2_rel\<rangle>nres_rel"
   if [autoref_rules_raw]: "DIM_precond TYPE((real, 'n::enum) vec) E"
   and [autoref_rules]: "(Xi, X::'n eucl1 set) \<in> \<langle>appr1_rel\<rangle>scaleR2_rel" "(Ci, C) \<in> reduce_argument_rel TYPE('b)"
   unfolding reduce_spec1e_def
   including art
   by autoref_monadic
 concrete_definition reduce_spec1e_impl for Ci Xi uses reduce_spec1e_impl
 lemmas reduce_spec1e_impl_refine[autoref_rules] =
   reduce_spec1e_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def reduce_spec1e .
 
 lemma eq_spec_impl[autoref_rules]:
   "(\<lambda>a b. RETURN (a = b), eq_spec) \<in> A \<rightarrow> A \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"
   if "PREFER single_valued A"
   using that by (auto simp: nres_rel_def single_valued_def)
 
 schematic_goal select_with_inter_impl:
   assumes [relator_props]: "single_valued A" "single_valued P"
   assumes [autoref_rules]: "(ci, c) \<in> clw_rel (\<langle>A, P\<rangle>inter_rel)" "(ai, a) \<in> clw_rel A"
   shows "(RETURN ?r, select_with_inter $ c $ a) \<in> \<langle>clw_rel (\<langle>A, P\<rangle>inter_rel)\<rangle>nres_rel"
   unfolding select_with_inter_def
   including art
   by (autoref_monadic (plain))
 concrete_definition select_with_inter_impl for ci ai uses select_with_inter_impl
 lemmas [autoref_rules] = select_with_inter_impl.refine[OF PREFER_sv_D PREFER_sv_D]
 sublocale autoref_op_pat_def select_with_inter .
 
 schematic_goal choose_step1e_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE((real, 'n::enum) vec) E"
     "ncc_precond TYPE('n vec1)"
     "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules]: "(Xi, X::'n eucl1 set) \<in> appr1e_rel" "(hi, h) \<in> rnv_rel"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   shows "(nres_of ?r, choose_step1e odo X h) \<in> \<langle>rnv_rel \<times>\<^sub>r appr1_rel \<times>\<^sub>r appr_rel \<times>\<^sub>r appr1e_rel\<rangle>nres_rel"
   unfolding choose_step1e_def
   including art
   by autoref_monadic
 concrete_definition choose_step1e_impl for Xi hi uses choose_step1e_impl
 lemmas [autoref_rules] = choose_step1e_impl.refine[autoref_higher_order_rule (1 2 3)]
 sublocale autoref_op_pat_def choose_step1e .
 
 lemma pre_split_reduce_impl[autoref_rules]:
   "(\<lambda>ro. RETURN (pre_split_reduce ro), pre_split_reduce_spec) \<in> reach_optns_rel \<rightarrow> \<langle>reduce_argument_rel TYPE('b)\<rangle>nres_rel"
   by (auto simp: pre_split_reduce_spec_def nres_rel_def reduce_argument_rel_def RETURN_RES_refine)
 
 schematic_goal step_split_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules]: "(Xi, X::'n eucl1 set) \<in> appr1e_rel"
     and [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
   shows "(nres_of (?f), step_split odo ro X)\<in>\<langle>clw_rel appr1e_rel\<rangle>nres_rel"
   using assms
   unfolding step_split_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition step_split_impl for odoi Xi uses step_split_impl
 lemmas [autoref_rules] = step_split_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def step_split .
 
 schematic_goal width_spec_appr1_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules]: "(Xi, X::'n eucl1 set) \<in> appr1_rel"
   shows "(?r, width_spec_appr1 X) \<in> \<langle>rnv_rel\<rangle>nres_rel"
   unfolding width_spec_appr1_def
   by autoref_monadic
 concrete_definition width_spec_appr1_impl for Xi uses width_spec_appr1_impl
 lemmas width_spec_appr1_impl_refine[autoref_rules] =
   width_spec_appr1_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def width_spec_appr1 .
 
 schematic_goal split_under_threshold_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE((real, 'n::enum) vec) E"
   assumes [autoref_rules]: "(thi, th) \<in> rnv_rel" "(Xi, X) \<in> clw_rel (\<langle>appr1_rel\<rangle>scaleR2_rel)"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
   shows "(nres_of ?x, split_under_threshold ro th (X::'n eucl1 set)) \<in> \<langle>clw_rel (\<langle>appr1_rel\<rangle>scaleR2_rel)\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding split_under_threshold_def
   by autoref_monadic
 concrete_definition split_under_threshold_impl for thi Xi uses split_under_threshold_impl
 lemmas [autoref_rules] = split_under_threshold_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def split_under_threshold .
 
 schematic_goal pre_intersection_step_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules]:
     "(Xi, X::'n eucl1 set) \<in> appr1e_rel"
     "(hi, (h::real)) \<in> rnv_rel"
     and [autoref_rules]: "(roptnsi, roptns) \<in> reach_optns_rel"
     "(odoi, odo) \<in> ode_ops_rel"
   shows "(nres_of ?r, pre_intersection_step odo roptns X h) \<in>
     \<langle>clw_rel (iinfo_rel appr1e_rel) \<times>\<^sub>r clw_rel appr_rel \<times>\<^sub>r clw_rel (iinfo_rel appr1e_rel)\<rangle>nres_rel"
   unfolding pre_intersection_step_def
   including art
   by autoref_monadic
 concrete_definition pre_intersection_step_impl for roptnsi Xi hi uses pre_intersection_step_impl
 lemmas [autoref_rules] = pre_intersection_step_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def pre_intersection_step .
 
 schematic_goal subset_spec_plane_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a) E"
   assumes [autoref_rules]: "(Xi, X::'a::executable_euclidean_space set) \<in> lvivl_rel" "(sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
   shows "(nres_of ?R, subset_spec_plane X sctn) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding subset_spec_plane_def
   by autoref_monadic
 concrete_definition subset_spec_plane_impl for Xi sctni uses subset_spec_plane_impl
 lemmas [autoref_rules] = subset_spec_plane_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def subset_spec_plane .
 
 schematic_goal op_eventually_within_sctn_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules]: "(Xi, X::'a set) \<in> appr_rel" "(sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel" "(Si, S) \<in> lvivl_rel"
   shows "(nres_of ?R, op_eventually_within_sctn X sctn S) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding op_eventually_within_sctn_def
   including art
   by autoref_monadic
 concrete_definition op_eventually_within_sctn_impl for Xi sctni Si uses op_eventually_within_sctn_impl
 lemmas [autoref_rules] = op_eventually_within_sctn_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def op_eventually_within_sctn .
 
 schematic_goal nonzero_component_within_impl:
   "(nres_of ?r, nonzero_component_within odo ivl sctn (PDP::'n eucl1 set)) \<in> \<langle>bool_rel\<rangle>nres_rel"
   if [autoref_rules_raw]: "DIM_precond TYPE((real, 'n::enum) vec) E"
   and [autoref_rules]:
     "(ivli, ivl) \<in> lvivl_rel"
     "(sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
     "(PDPi, PDP) \<in> appr1_rel"
     "(odoi, odo) \<in> ode_ops_rel"
   unfolding nonzero_component_within_def
   including art
   by autoref_monadic
 concrete_definition nonzero_component_within_impl uses nonzero_component_within_impl
 lemmas [autoref_rules] = nonzero_component_within_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def nonzero_component_within .
 
 schematic_goal disjoints_spec_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules]: "(Xi, (X::'n::enum rvec set)) \<in> clw_rel appr_rel" "(Yi, (Y::'n rvec set)) \<in> clw_rel lvivl_rel"
   shows "(nres_of ?f, disjoints_spec X Y) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding disjoints_spec_def op_coll_is_empty_def[symmetric]
   including art
   by autoref_monadic
 concrete_definition disjoints_spec_impl for Xi Yi uses disjoints_spec_impl
 lemmas [autoref_rules] = disjoints_spec_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def disjoints_spec .
 
 schematic_goal do_intersection_body_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(hi, h) \<in> rnv_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> clw_rel lvivl_rel"
     and civl[autoref_rules]: "(ivli, ivl::'n rvec set) \<in> lvivl_rel"
     and csctns[autoref_rules]: "(sctni, sctn::'n rvec sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
   and [autoref_rules]: "(STATEi, STATE) \<in> intersection_STATE_rel"
   notes [intro, simp] = list_set_rel_finiteD closed_ivl_rel[OF civl]
   shows "(nres_of ?f, do_intersection_body odo guards ivl sctn h STATE) \<in> \<langle>intersection_STATE_rel\<rangle>nres_rel"
   unfolding do_intersection_body_def
   by autoref_monadic
 concrete_definition do_intersection_body_impl for odoi guardsi ivli sctni hi STATEi uses do_intersection_body_impl
 lemmas do_intersection_body_impl_refine[autoref_rules] =
   do_intersection_body_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def do_intersection_body .
 
 schematic_goal do_intersection_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(Xi, X) \<in> appr1_rel" "(hi, h) \<in> rnv_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> clw_rel (\<langle>lvivl_rel, \<langle>lv_rel\<rangle>plane_rel\<rangle>inter_rel)"
     and civl[autoref_rules]: "(ivli, ivl::'n rvec set) \<in> lvivl_rel"
     and csctns[autoref_rules]: "(sctni, sctn::'n rvec sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
   notes [intro, simp] = list_set_rel_finiteD closed_ivl_rel[OF civl]
   shows "(nres_of ?f, do_intersection odo guards ivl sctn (X::'n eucl1 set) h)\<in>
     \<langle>bool_rel \<times>\<^sub>r clw_rel appr1_rel \<times>\<^sub>r clw_rel appr1_rel \<times>\<^sub>r
       clw_rel (\<langle>appr_rel, \<langle>lv_rel\<rangle>sbelows_rel\<rangle>inter_rel)\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding do_intersection_def
   including art
   by autoref_monadic
 concrete_definition do_intersection_impl for odoi guardsi ivli sctni Xi hi uses do_intersection_impl
 lemmas do_intersection_impl_refine[autoref_rules] =
   do_intersection_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def do_intersection .
 
 schematic_goal tolerate_error1_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) dd"
   assumes [autoref_rules]: "(Yi, Y::'n eucl1 set) \<in> appr1e_rel"
   assumes [autoref_rules]: "(Ei, E) \<in> appr1_rel"
   shows "(nres_of ?r, tolerate_error1 Y E) \<in> \<langle>bool_rel \<times>\<^sub>r rnv_rel\<rangle>nres_rel"
   unfolding tolerate_error1_def
   including art
   by autoref_monadic
 concrete_definition tolerate_error1_impl for dd Yi Ei uses tolerate_error1_impl
 lemmas tolerate_error1_refine[autoref_rules] = tolerate_error1_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def tolerate_error1 .
 
+lemma lower_impl[autoref_rules]: "(lower, lower) \<in> Id \<rightarrow> Id"
+  and upper_impl[autoref_rules]: "(lower, lower) \<in> Id \<rightarrow> Id"
+  by auto
+
 schematic_goal step_adapt_time_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]:
     "(hi, h) \<in> rnv_rel"
     "(Xi, X::'n eucl1 set) \<in> (appr1e_rel)"
   shows "(nres_of ?f, step_adapt_time odo X h)\<in>\<langle>rnv_rel \<times>\<^sub>r appr_rel \<times>\<^sub>r appr1e_rel \<times>\<^sub>r rnv_rel\<rangle>nres_rel"
   unfolding step_adapt_time_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition step_adapt_time_impl for Xi hi uses step_adapt_time_impl
 lemmas [autoref_rules] = step_adapt_time_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def step_adapt_time .
 
 
 schematic_goal resolve_step_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]:
     "(hi, h) \<in> rnv_rel"
     "(Xi, X::'n eucl1 set) \<in> (appr1e_rel)"
     "(roptnsi, roptns) \<in> reach_optns_rel"
   shows "(nres_of ?f, resolve_step odo roptns X h)\<in>\<langle>rnv_rel \<times>\<^sub>r clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r rnv_rel\<rangle>nres_rel"
   unfolding resolve_step_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition resolve_step_impl for roptnsi Xi hi uses resolve_step_impl
 lemmas [autoref_rules] = resolve_step_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def resolve_step .
 
 sublocale autoref_op_pat_def fst_safe_coll .
 
 schematic_goal reach_cont_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]:
     "(XSi, XS) \<in> clw_rel appr1e_rel"
     "(guardsi, guards::'n rvec set) \<in> clw_rel (iplane_rel lvivl_rel)"
     and [autoref_rules]: "(roptnsi, roptns) \<in> reach_optns_rel"
   notes [relator_props, autoref_rules_raw] = sv_appr1_rel
   shows "(nres_of (?f::?'f dres), reach_cont odo roptns guards XS)\<in>?R"
   unfolding autoref_tag_defs
   unfolding reach_cont_def
   including art
   by autoref_monadic
 concrete_definition reach_cont_impl for guardsi XSi uses reach_cont_impl
 lemmas reach_cont_ho[autoref_rules] = reach_cont_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def reach_cont .
 
 schematic_goal reach_cont_par_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]:
     "(XSi, XS) \<in> clw_rel appr1e_rel"
     "(guardsi, guards::'n rvec set) \<in> clw_rel (iplane_rel lvivl_rel)"
     and [autoref_rules]: "(roptnsi, roptns) \<in> reach_optns_rel"
   shows "(nres_of (?f::?'f dres), reach_cont_par odo roptns guards XS)\<in>?R"
   unfolding autoref_tag_defs
   unfolding reach_cont_par_def
   including art
   by autoref_monadic
 concrete_definition reach_cont_par_impl for roptnsi guardsi XSi uses reach_cont_par_impl
 lemmas reach_cont_par_impl_refine[autoref_rules] = reach_cont_par_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def reach_cont_par .
 
 schematic_goal subset_iplane_coll_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules]: "(xi, x::'a set) \<in> iplane_rel lvivl_rel"
   assumes [autoref_rules]: "(icsi, ics) \<in> clw_rel (iplane_rel lvivl_rel)"
   shows "(nres_of ?r, subset_iplane_coll x ics) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding subset_iplane_coll_def
   including art
   by autoref_monadic
 concrete_definition subset_iplane_coll_impl uses subset_iplane_coll_impl
 lemmas subset_iplane_coll_impl_refine[autoref_rules] = subset_iplane_coll_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def subset_iplane_coll .
 
 
 schematic_goal subsets_iplane_coll_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules]: "(xi, x::'a set set) \<in> \<langle>iplane_rel lvivl_rel\<rangle>list_wset_rel"
   assumes [autoref_rules]: "(icsi, ics) \<in> clw_rel (iplane_rel lvivl_rel)"
   shows "(nres_of ?r, subsets_iplane_coll x ics) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding subsets_iplane_coll_def
   including art
   by autoref_monadic
 concrete_definition subsets_iplane_coll_impl uses subsets_iplane_coll_impl
 lemmas [autoref_rules] = subsets_iplane_coll_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def subsets_iplane_coll .
 
 
 schematic_goal symstart_coll_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(XSi, XS::'n eucl1 set) \<in> clw_rel appr1e_rel"
   assumes [autoref_rules]: "(symstarti, symstart::'n eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set)nres)
     \<in> appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   assumes [unfolded autoref_tag_defs, refine_transfer]: "\<And>X. TRANSFER (nres_of (symstartd X) \<le> symstarti X)"
   shows "(nres_of ?r, symstart_coll $ odo $ symstart $ XS) \<in> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   unfolding symstart_coll_def
   including art
   by autoref_monadic
 concrete_definition symstart_coll_impl for symstartd XSi uses symstart_coll_impl
 lemmas [autoref_rules] = symstart_coll_impl.refine
 sublocale autoref_op_pat_def symstart_coll .
 
 schematic_goal reach_cont_symstart_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]:
     "(XSi, XS::'n eucl1 set) \<in> clw_rel appr1e_rel"
     "(guardsi, guards::'n rvec set) \<in> clw_rel (iplane_rel lvivl_rel)"
     "(roptnsi, roptns) \<in> reach_optns_rel"
   assumes [autoref_rules]: "(symstarti, symstart::'n eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set)nres)
     \<in> appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   assumes [unfolded autoref_tag_defs, refine_transfer]: "\<And>X. TRANSFER (nres_of (symstartd X) \<le> symstarti X)"
   shows "(nres_of (?r), reach_cont_symstart $ odo $ roptns $ symstart $ guards $ XS) \<in>
   \<langle>clw_rel appr_rel \<times>\<^sub>r
     clw_rel (\<langle>iplane_rel lvivl_rel::(_ \<times> 'n rvec set)set, iinfo_rel appr1e_rel\<rangle>info_rel)\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding reach_cont_symstart_def Let_def
   including art
   by autoref_monadic
 concrete_definition reach_cont_symstart_impl for roptnsi symstartd XSi uses reach_cont_symstart_impl
 lemmas [autoref_rules] = reach_cont_symstart_impl.refine
 sublocale autoref_op_pat_def reach_cont_symstart .
 
 lemma sv_reach_conts_impl_aux:
   "single_valued (clw_rel (iinfo_rel appr1e_rel))" by (auto intro!: relator_props)
 
 schematic_goal reach_conts_impl:
   assumes [autoref_rules]: "(symstarti, symstart::'n eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set)nres)
     \<in> appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]:
     "(XSi, XS) \<in> clw_rel appr1e_rel"
     "(guardsi, guards::'n rvec set) \<in> clw_rel (iplane_rel lvivl_rel)"
     and [autoref_rules]: "(roptnsi, roptns) \<in> reach_optns_rel"
   notes [simp] = list_wset_rel_finite[OF sv_reach_conts_impl_aux]
     assumes "(trapi, trap) \<in> ghost_rel"
   assumes [unfolded autoref_tag_defs, refine_transfer]: "\<And>X. TRANSFER (nres_of (symstartd X) \<le> symstarti X)"
   shows "(nres_of (?f::?'f dres), reach_conts $ odo $ roptns $ symstart $ trap $ guards $ XS)\<in>?R"
   unfolding autoref_tag_defs
   unfolding reach_conts_def
   including art
   by autoref_monadic
 concrete_definition reach_conts_impl for odoi guardsi XSi uses reach_conts_impl
 lemmas [autoref_rules] = reach_conts_impl.refine
 sublocale autoref_op_pat_def reach_conts .
 
 lemma get_sctns_autoref[autoref_rules]:
   "(\<lambda>x. RETURN x, get_sctns) \<in> \<langle>R\<rangle>halfspaces_rel \<rightarrow> \<langle>\<langle>\<langle>R\<rangle>sctn_rel\<rangle>list_set_rel\<rangle>nres_rel"
   by (auto simp: get_sctns_def nres_rel_def halfspaces_rel_def br_def intro!: RETURN_SPEC_refine)
 sublocale autoref_op_pat_def get_sctns .
 
 schematic_goal leaves_halfspace_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes nccp[autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   notes [simp] = ncc_precondD[OF nccp]
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(Si, S) \<in> \<langle>lv_rel\<rangle>halfspaces_rel"
   assumes [autoref_rules]: "(Xi, X::'n rvec set) \<in> clw_rel appr_rel"
   shows "(nres_of ?r, leaves_halfspace $ odo $ S $ X) \<in> \<langle>\<langle>\<langle>lv_rel\<rangle>sctn_rel\<rangle>option_rel\<rangle>nres_rel"
   unfolding leaves_halfspace_def
   including art
   by autoref_monadic
 concrete_definition leaves_halfspace_impl for Si Xi uses leaves_halfspace_impl
 lemmas [autoref_rules] = leaves_halfspace_impl.refine
 sublocale autoref_op_pat_def leaves_halfspace .
 
 schematic_goal poincare_start_on_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes ncc2[autoref_rules_raw]: "ncc_precond TYPE('n::enum rvec)"
   assumes ncc2[autoref_rules_raw]: "ncc_precond TYPE('n::enum vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]:
     "(sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
     "(guardsi, guards) \<in> clw_rel lvivl_rel"
     "(X0i, X0::'n eucl1 set) \<in> clw_rel (appr1e_rel)"
   shows "(nres_of (?f), poincare_start_on $ odo $ guards $ sctn $ X0) \<in>
       \<langle>clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding poincare_start_on_def
   including art
   by autoref_monadic
 concrete_definition poincare_start_on_impl for guardsi sctni X0i uses poincare_start_on_impl
 lemmas [autoref_rules] = poincare_start_on_impl.refine
 sublocale autoref_op_pat_def poincare_start_on .
 
 lemma isets_of_iivls[autoref_rules]:
   assumes "PREFER single_valued A"
   assumes le[THEN GEN_OP_D, param_fo]: "GEN_OP le (\<le>) ((lv_rel::(_ \<times> 'a::executable_euclidean_space)set) \<rightarrow> lv_rel \<rightarrow> bool_rel)"
   shows "(\<lambda>xs. map (\<lambda>((i, s), x). (appr_of_ivl ops i s, x)) [((i,s), x) \<leftarrow> xs. le i s], isets_of_iivls::_\<Rightarrow>'a set)
     \<in> clw_rel (\<langle>lvivl_rel, A\<rangle>inter_rel) \<rightarrow> clw_rel (\<langle>appr_rel, A\<rangle>inter_rel)"
   apply (rule fun_relI)
   using assms
   apply (auto elim!: single_valued_as_brE)
   unfolding appr_rel_br ivl_rel_br clw_rel_br lvivl_rel_br inter_rel_br
   apply (auto simp: br_def set_of_ivl_def)
   subgoal for a b c d e f g
     apply (rule exI[where x=e])
     apply (rule exI[where x=f])
     apply (rule exI[where x=g])
     apply (rule conjI)
     apply (assumption)
     apply (rule conjI)
     subgoal
       using transfer_operations1[where 'a='a, of "eucl_of_list e" "eucl_of_list f" e f]
         le[of e _ f _, OF lv_relI lv_relI]
       by (auto simp: appr_rel_br br_def lvivl_rel_br set_of_ivl_def lv_rel_def)
     subgoal
       apply (drule bspec, assumption)
       using transfer_operations1[where 'a='a, of "eucl_of_list e" "eucl_of_list f" e f]
         le[of e _ f _, OF lv_relI lv_relI]
       apply (auto simp: appr_rel_br br_def lvivl_rel_br set_of_ivl_def lv_rel_def)
       using atLeastAtMost_iff apply blast
       apply (drule order_trans)
        apply assumption apply simp
       done
     done
   subgoal for a b c d e f g
     apply (drule bspec, assumption)
     using transfer_operations1[where 'a='a, of "eucl_of_list d" "eucl_of_list e" d e]
       le[of d _ e _, OF lv_relI lv_relI]
     by (auto simp: appr_rel_br br_def lvivl_rel_br set_of_ivl_def lv_rel_def intro!: bexI)
   subgoal for a b c d e f
     apply (drule bspec, assumption)
     using transfer_operations1[where 'a='a, of "eucl_of_list d" "eucl_of_list e" d e]
       le[of d _ e _, OF lv_relI lv_relI]
     by (auto simp: appr_rel_br br_def lvivl_rel_br set_of_ivl_def lv_rel_def intro!: bexI)
   done
 sublocale autoref_op_pat_def isets_of_iivls .
 
 lemma [autoref_op_pat]: "X \<times> UNIV \<equiv> OP op_times_UNIV_coll $ X" by simp
 
 lemma op_times_UNIV_coll_impl[autoref_rules]: "(map (\<lambda>x. (x, None)), op_times_UNIV_coll) \<in> clw_rel appr_rel \<rightarrow> clw_rel appr1_rel"
   apply (rule lift_clw_rel_map)
      apply (rule relator_props)
     apply (rule relator_props)
   unfolding op_times_UNIV_coll_def op_times_UNIV_def[symmetric]
    apply (rule op_times_UNIV_impl)
   by auto
 sublocale autoref_op_pat_def op_times_UNIV_coll .
 
 schematic_goal do_intersection_core_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE((real, 'n::enum) vec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(Xi, X::'n eucl1 set) \<in> iinfo_rel appr1e_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> clw_rel (iplane_rel lvivl_rel)"
     and csctns[autoref_rules]: "(sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
     and csctns[autoref_rules]: "(ivli, ivl) \<in> lvivl_rel"
   notes [simp] = list_set_rel_finiteD
   shows "(nres_of ?f, do_intersection_core odo guards ivl sctn X) \<in>
       \<langle>clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   unfolding do_intersection_core_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition do_intersection_core_impl for guardsi ivli sctni Xi uses do_intersection_core_impl
 sublocale autoref_op_pat_def do_intersection_core .
 
 lemmas do_intersection_core_impl_refine[autoref_rules] =
   do_intersection_core_impl.refine[autoref_higher_order_rule(1 2 3)]
 
 lemma finite_ra1eicacacslsbicae1lw: "(xc, x'c) \<in> \<langle>\<langle>rnv_rel, appr1e_rel\<rangle>info_rel \<times>\<^sub>r
           clw_rel appr1e_rel \<times>\<^sub>r
           clw_rel appr1e_rel \<times>\<^sub>r
           clw_rel
            (\<langle>appr_rel,
             \<langle>lv_rel\<rangle>sbelows_rel\<rangle>inter_rel) \<times>\<^sub>r
           clw_rel appr1e_rel\<rangle>list_wset_rel \<Longrightarrow> finite x'c"
   for x'c::"('n::enum eucl1 set * 'n eucl1 set * 'n eucl1 set * 'n rvec set * 'n eucl1 set) set"
   apply (rule list_wset_rel_finite)
   by (auto intro!: relator_props)
 
 schematic_goal do_intersection_coll_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE((real, 'n::enum) vec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(Xi, X::'n eucl1 set) \<in> clw_rel (iinfo_rel appr1e_rel)"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> clw_rel (iplane_rel lvivl_rel)"
     and csctns[autoref_rules]: "(sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
     and csctns[autoref_rules]: "(ivli, ivl) \<in> lvivl_rel"
   notes [simp] = finite_ra1eicacacslsbicae1lw[where 'n='n]
   shows "(nres_of ?f, do_intersection_coll odo guards ivl sctn X) \<in>
       \<langle>clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   unfolding do_intersection_coll_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition do_intersection_coll_impl for guardsi ivli sctni Xi uses do_intersection_coll_impl
 lemmas [autoref_rules] = do_intersection_coll_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def do_intersection_coll .
 
 schematic_goal op_enlarge_ivl_sctn_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules]: "(ivli, ivl::'a set) \<in> lvivl_rel" "(sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel" "(di, d) \<in> rnv_rel"
   shows "(nres_of ?R, op_enlarge_ivl_sctn $ ivl $ sctn $ d) \<in> \<langle>lvivl_rel\<rangle>nres_rel"
   unfolding op_enlarge_ivl_sctn_def
   including art
   by autoref_monadic
 concrete_definition op_enlarge_ivl_sctn_impl for ivli sctni di uses op_enlarge_ivl_sctn_impl
 lemmas [autoref_rules] = op_enlarge_ivl_sctn_impl.refine
 sublocale autoref_op_pat_def op_enlarge_ivl_sctn .
 
 schematic_goal resolve_ivlplanes_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(XSi, XS::('n rvec set \<times> 'n eucl1 set) set) \<in> \<langle>iplane_rel lvivl_rel \<times>\<^sub>r clw_rel (iinfo_rel appr1e_rel)\<rangle>list_wset_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> clw_rel (iplane_rel lvivl_rel)"
     and osctns[autoref_rules]: "(ivlplanesi, ivlplanes) \<in> clw_rel (iplane_rel lvivl_rel)"
   notes [intro, simp] = list_set_rel_finiteD
   shows "(nres_of ?r, resolve_ivlplanes odo guards ivlplanes XS) \<in>
     \<langle>\<langle>clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel \<times>\<^sub>r clw_rel (isbelows_rel appr_rel)\<rangle>list_wset_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding resolve_ivlplanes_def
   including art
   by autoref_monadic
 concrete_definition resolve_ivlplanes_impl for guardsi ivlplanesi XSi uses resolve_ivlplanes_impl
 lemmas [autoref_rules] = resolve_ivlplanes_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def resolve_ivlplanes .
 
 schematic_goal poincare_onto_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(XSi, XS::'n eucl1 set) \<in> clw_rel appr1e_rel"
   assumes [autoref_rules]: "(CXSi, CXS::'n rvec set) \<in> clw_rel appr_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> clw_rel (iplane_rel lvivl_rel)"
     and osctns[autoref_rules]: "(ivlplanesi, ivlplanes) \<in> clw_rel (iplane_rel lvivl_rel)"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
   assumes [autoref_rules]: "((), trap) \<in> ghost_rel"
   assumes [autoref_rules]: "(symstarti, symstart::'n eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set)nres)
     \<in> appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   assumes [unfolded autoref_tag_defs, refine_transfer]: "\<And>X. TRANSFER (nres_of (symstartd X) \<le> symstarti X)"
   notes [intro, simp] = list_set_rel_finiteD
   shows "(nres_of ?r, poincare_onto $ odo $ ro $ symstart $ trap $ guards $ ivlplanes $ XS $ CXS) \<in>
     \<langle>\<langle>clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel
       \<times>\<^sub>r clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding poincare_onto_def
   including art
   by autoref_monadic
 concrete_definition poincare_onto_impl for odoi roi symstarti guardsi ivlplanesi XSi uses poincare_onto_impl
 lemmas [autoref_rules] = poincare_onto_impl.refine[autoref_higher_order_rule]
 sublocale autoref_op_pat_def poincare_onto .
 
 schematic_goal empty_remainders_impl:
   assumes [autoref_rules]:
     "(PSi, PS) \<in> \<langle>clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel
             \<times>\<^sub>r clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel"
   shows "(nres_of ?r, empty_remainders PS) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding empty_remainders_def
   including art
   by autoref_monadic
 concrete_definition empty_remainders_impl uses empty_remainders_impl
 
 lemmas empty_remainders_impl_refine[autoref_rules] = empty_remainders_impl.refine[autoref_higher_order_rule]
 sublocale autoref_op_pat_def empty_remainders .
 
 lemma empty_trap_impl[autoref_rules]: "((), empty_trap) \<in> ghost_rel"
   by (auto intro!: ghost_relI)
 sublocale autoref_op_pat_def empty_trap .
 
 lemma empty_symstart_impl:\<comment> \<open>why this? \<close>
   "((\<lambda>x. nres_of (dRETURN ([], [x]))), empty_symstart) \<in>
     appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   unfolding empty_symstart_def
   using mk_coll[unfolded autoref_tag_defs, OF sv_appr1e_rel[OF sv_appr1_rel], param_fo]
   by (auto intro!: nres_relI simp:)
 lemma empty_symstart_nres_rel[autoref_rules]:
   "((\<lambda>x. RETURN ([], [x])), empty_symstart::'n::enum eucl1 set\<Rightarrow>_) \<in>
     appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   using mk_coll[OF PREFER_I[of single_valued, OF sv_appr1e_rel[OF sv_appr1_rel]], param_fo, of x y for x and y::"'n eucl1 set"]
   by (auto simp: mk_coll_def[abs_def] nres_rel_def)
 sublocale autoref_op_pat_def empty_symstart .
 lemma empty_symstart_dres_nres_rel:
   "((\<lambda>x. dRETURN ([], [x])), empty_symstart::'n::enum eucl1 set\<Rightarrow>_) \<in>
     (appr1e_rel) \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>dres_nres_rel"
   using mk_coll[OF PREFER_I[of single_valued, OF sv_appr1e_rel[OF sv_appr1_rel]], param_fo, of x y for x and y::"'n eucl1 set"]
   by (auto simp: mk_coll_def[abs_def] dres_nres_rel_def)
 
 
 schematic_goal poincare_onto_empty_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(XSi, XS::'n eucl1 set) \<in> clw_rel appr1e_rel"
   assumes [autoref_rules]: "(CXSi, CXS::'n rvec set) \<in> clw_rel appr_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> clw_rel (iplane_rel lvivl_rel)"
     and osctns[autoref_rules]: "(ivlplanesi, ivlplanes) \<in> clw_rel (iplane_rel lvivl_rel)"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
   notes [intro, simp] = list_set_rel_finiteD
   shows "(nres_of (?r), poincare_onto_empty odo ro guards ivlplanes XS CXS) \<in>
     \<langle>\<langle>clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel
       \<times>\<^sub>r clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding poincare_onto_empty_def
   including art
   apply (rule autoref_monadicI)
    apply (autoref phases: id_op rel_inf fix_rel)\<comment> \<open>TODO: what is going wrong here?\<close>
   apply (simp only: autoref_tag_defs)
    apply (rule poincare_onto_impl.refine[unfolded autoref_tag_defs])
             apply fact+
      apply (rule ghost_relI)
     apply (rule empty_symstart_impl)
    apply refine_transfer
   apply refine_transfer
   done
 
 concrete_definition poincare_onto_empty_impl for guardsi XSi CXSi uses poincare_onto_empty_impl
 lemmas [autoref_rules] = poincare_onto_empty_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def poincare_onto_empty .
 
 lemma sv_thingy: "single_valued (clw_rel appr1e_rel \<times>\<^sub>r
           clw_rel appr1e_rel \<times>\<^sub>r
           clw_rel appr1e_rel \<times>\<^sub>r
           clw_rel appr1e_rel \<times>\<^sub>r
           \<langle>lv_rel\<rangle>ivl_rel \<times>\<^sub>r
           \<langle>lv_rel\<rangle>sctn_rel \<times>\<^sub>r
           clw_rel
            (\<langle>appr_rel,
             \<langle>lv_rel\<rangle>sbelows_rel\<rangle>inter_rel) \<times>\<^sub>r
           clw_rel appr_rel)"
   by (intro relator_props)
 
 schematic_goal poincare_onto2_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(symstarti, symstart::'n eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set)nres)
     \<in> appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   assumes [unfolded autoref_tag_defs, refine_transfer]: "\<And>X. TRANSFER (nres_of (symstartd X) \<le> symstarti X)"
   assumes [autoref_rules]: "(XSi, XS::'n eucl1 set) \<in> clw_rel appr1e_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> clw_rel (iplane_rel lvivl_rel)"
     and osctns[autoref_rules]: "(ivlplanesi, ivlplanes) \<in> clw_rel (iplane_rel lvivl_rel)"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
   assumes [autoref_rules]: "((), trap) \<in> ghost_rel"
   notes [intro, simp] = list_set_rel_finiteD list_wset_rel_finite[OF sv_thingy]
   shows "(nres_of (?r), poincare_onto2 $ odo $ ro $ symstart $ trap $ guards $ ivlplanes $ XS) \<in>
     \<langle>\<langle>bool_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel \<times>\<^sub>r
       clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding poincare_onto2_def
     including art
   by autoref_monadic
 concrete_definition poincare_onto2_impl for odoi guardsi XSi uses poincare_onto2_impl
 lemmas [autoref_rules] = poincare_onto2_impl.refine
 sublocale autoref_op_pat_def poincare_onto2 .
 
 schematic_goal width_spec_ivl_impl:
   assumes [autoref_rules]: "(Mi, M) \<in> nat_rel" "(xi, x) \<in> lvivl_rel"
   shows "(RETURN ?r, width_spec_ivl M x) \<in> \<langle>rnv_rel\<rangle>nres_rel"
   unfolding width_spec_ivl_def
   including art
   by (autoref_monadic (plain))
 concrete_definition width_spec_ivl_impl for Mi xi uses width_spec_ivl_impl
 
 lemmas width_spec_ivl_impl_refine[autoref_rules]
   = width_spec_ivl_impl.refine[autoref_higher_order_rule]
 sublocale autoref_op_pat_def width_spec_ivl .
 
 schematic_goal partition_ivl_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a::executable_euclidean_space) E"
   assumes [autoref_rules]: "(xsi, xs::'a set)\<in> clw_rel lvivl_rel" "(roi, ro) \<in> reach_optns_rel"
   shows "(nres_of (?f), partition_ivl ro xs)\<in>\<langle>clw_rel lvivl_rel\<rangle>nres_rel"
   unfolding partition_ivl_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition partition_ivl_impl for roi xsi uses partition_ivl_impl
 lemmas [autoref_rules] = partition_ivl_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def partition_ivl .
 
 schematic_goal vec1repse_impl:
   assumes [autoref_rules]: "(Xi, X) \<in> clw_rel appr1e_rel"
   shows "(nres_of ?r, vec1repse X) \<in> \<langle>\<langle>clw_rel appre_rel\<rangle>option_rel\<rangle>nres_rel"
   unfolding vec1repse_def
   including art
   by autoref_monadic
 concrete_definition vec1repse_impl for Xi uses vec1repse_impl
 lemmas vec1repse_impl_refine[autoref_rules] = vec1repse_impl.refine[autoref_higher_order_rule]
 sublocale autoref_op_pat_def vec1repse .
 
 schematic_goal scaleR2_rep1_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules]: "(Yi, Y::'n vec1 set) \<in> appre_rel"
   shows "(nres_of ?r, scaleR2_rep1 Y) \<in> \<langle>elvivl_rel\<rangle>nres_rel"
   unfolding scaleR2_rep1_def
   including art
   by autoref_monadic
 concrete_definition scaleR2_rep1_impl uses scaleR2_rep1_impl
 lemmas [autoref_rules] = scaleR2_rep1_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def scaleR2_rep1 .
 
 schematic_goal ivlse_of_setse_impl:
   "(nres_of ?r, ivlse_of_setse X) \<in> \<langle>clw_rel elvivl_rel\<rangle>nres_rel"
   if [autoref_rules_raw]:"DIM_precond TYPE('n::enum rvec) E"
     and [autoref_rules]: "(Xi, X::'n vec1 set) \<in> clw_rel (appre_rel)"
   unfolding ivlse_of_setse_def
   including art
   by autoref_monadic
 concrete_definition ivlse_of_setse_impl uses ivlse_of_setse_impl
 lemmas [autoref_rules] = ivlse_of_setse_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def ivlse_of_setse .
 
 schematic_goal setse_of_ivlse_impl:
   "(nres_of ?r, setse_of_ivlse X) \<in> \<langle>clw_rel (appre_rel)\<rangle>nres_rel"
   if [autoref_rules]: "(Xi, X) \<in> clw_rel elvivl_rel"
   unfolding setse_of_ivlse_def
   including art
   by autoref_monadic
 concrete_definition setse_of_ivlse_impl uses setse_of_ivlse_impl
 lemmas setse_of_ivlse_impl_refine[autoref_rules] =
   setse_of_ivlse_impl.refine[autoref_higher_order_rule]
 sublocale autoref_op_pat_def setse_of_ivlse .
 
 lemma op_image_flow1_of_vec1_colle[autoref_rules]:
   "(map (\<lambda>(lu, x). (lu, (take E x, Some (drop E x)))), op_image_flow1_of_vec1_colle::_\<Rightarrow>'n eucl1 set) \<in> clw_rel appre_rel \<rightarrow> clw_rel appr1e_rel"
   if "DIM_precond TYPE('n::enum rvec) E"
   apply (rule lift_clw_rel_map)
      apply (rule relator_props)
      apply (rule relator_props)
     apply (rule relator_props)
     apply (rule relator_props)
     apply (rule lift_scaleR2)
   unfolding op_image_flow1_of_vec1_colle_def op_image_flow1_of_vec1_coll_def op_image_flow1_of_vec1_def[symmetric]
     apply (rule op_image_flow1_of_vec1)
   using that
   subgoal by force
   subgoal for l u x
     unfolding op_image_flow1_of_vec1_def flow1_of_vec1_def scaleR2_def
     apply (auto simp: image_def vimage_def)
     subgoal for a b c d e
       apply (rule exI[where x="c *\<^sub>R e"])
       apply (auto simp: blinfun_of_vmatrix_scaleR)
       apply (rule exI[where x="c"])
       apply auto
       apply (rule bexI) prefer 2 apply assumption
       apply auto
       done
     subgoal for a b c d e
       apply (rule exI[where x="c"])
       apply (auto simp: blinfun_of_vmatrix_scaleR)
       apply (rule exI[where x="blinfun_of_vmatrix e"])
       apply auto
       apply (rule bexI) prefer 2 apply assumption
       apply auto
       done
     done
   subgoal by auto
   done
 sublocale autoref_op_pat_def op_image_flow1_of_vec1_colle .
 
 schematic_goal okay_granularity_impl:
   assumes [autoref_rules]: "(ivli,ivl::'n::enum vec1 set)\<in> lvivl_rel"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
   shows "(nres_of ?f, okay_granularity ro ivl) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding okay_granularity_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition okay_granularity_impl for roi ivli uses okay_granularity_impl
 lemmas [autoref_rules] = okay_granularity_impl.refine[autoref_higher_order_rule]
 sublocale autoref_op_pat_def okay_granularity .
 
 lemma le_post_inter_granularity_op[autoref_rules]:
   "(\<lambda>roi (ls, us). RETURN (width_appr ops optns (appr_of_ivl ops ls us) \<le> post_inter_granularity roi),
     (le_post_inter_granularity_op::_\<Rightarrow>'a::executable_euclidean_space set\<Rightarrow>_)) \<in>
     (reach_optns_rel \<rightarrow> lvivl_rel \<rightarrow> \<langle>bool_rel\<rangle>nres_rel)"
   by (auto simp: nres_rel_def le_post_inter_granularity_op_def)
 sublocale autoref_op_pat_def le_post_inter_granularity_op .
 
 schematic_goal partition_set_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules]: "(xsi,xs::'n eucl1 set)\<in> clw_rel appr1e_rel"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
   shows "(nres_of (?f), partition_set ro xs) \<in> \<langle>clw_rel appr1e_rel\<rangle>nres_rel"
   unfolding partition_set_def
   including art
   by autoref_monadic
 
 concrete_definition partition_set_impl for roi xsi uses partition_set_impl
 lemmas [autoref_rules] = partition_set_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def partition_set .
 
 schematic_goal partition_sets_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules]: "(xsi,xs::(bool \<times> 'n eucl1 set \<times> _)set)\<in>
     \<langle>bool_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel
               \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel \<times>\<^sub>r
       clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
   shows "(nres_of (?f), partition_sets ro xs)\<in>\<langle>clw_rel appr1e_rel\<rangle>nres_rel"
   unfolding partition_sets_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition partition_sets_impl for roi xsi uses partition_sets_impl
 lemmas [autoref_rules] = partition_sets_impl.refine[autoref_higher_order_rule(1)]
 sublocale autoref_op_pat_def partition_sets .
 
 lemma [autoref_rules]:
   assumes "PREFER single_valued A"
   shows "(\<lambda>xs. case xs of [x] \<Rightarrow> RETURN x | _ \<Rightarrow> SUCCEED, singleton_spec) \<in> \<langle>A\<rangle>list_wset_rel \<rightarrow> \<langle>A\<rangle>nres_rel"
   using assms
   by (auto simp: nres_rel_def singleton_spec_def list_wset_rel_def set_rel_br
       split: list.splits elim!: single_valued_as_brE dest!: brD
       intro!: RETURN_SPEC_refine brI)
 sublocale autoref_op_pat_def singleton_spec .
 
 lemma closed_ivl_prod8_list_rel:
   assumes "(xl, x'l)
        \<in> \<langle>bool_rel \<times>\<^sub>r
           clw_rel appr1e_rel \<times>\<^sub>r
           clw_rel appr1e_rel \<times>\<^sub>r
           clw_rel appr1e_rel \<times>\<^sub>r
           clw_rel appr1e_rel \<times>\<^sub>r
           \<langle>lv_rel\<rangle>ivl_rel \<times>\<^sub>r
           \<langle>lv_rel\<rangle>sctn_rel \<times>\<^sub>r clw_rel (\<langle>appr_rel, \<langle>lv_rel\<rangle>sbelows_rel\<rangle>inter_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel"
   shows "(\<forall>(b, X, PS1, PS2, R, ivl, sctn, CX, CXS)\<in>x'l. closed ivl)"
   using assms
   unfolding list_wset_rel_def set_rel_sv[OF single_valued_Id_arbitrary_interface]
   apply (subst (asm) set_rel_sv)
   subgoal
     by (auto simp: Id_arbitrary_interface_def intro!: relator_props intro: single_valuedI)
   by (auto simp: Id_arbitrary_interface_def)
 
 lemma
   poincare_onto_series_rec_list_eq:\<comment> \<open>TODO: here is a problem if interrupt gets uncurried, too\<close>
   "poincare_onto_series odo interrupt trap guards XS ivl sctn ro = rec_list
       (\<lambda>(((((trap), XS0), ivl), sctn), ro).
           let guard0 = mk_coll (mk_inter ivl (plane_of sctn))
           in ASSUME (closed guard0) \<bind>
              (\<lambda>_. (poincare_onto2 odo (ro ::: reach_optns_rel) (interrupt:::appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel) trap
                     (op_empty_coll ::: clw_rel (\<langle>\<langle>lv_rel\<rangle>ivl_rel, \<langle>lv_rel\<rangle>plane_rel\<rangle>inter_rel)) guard0 XS0 :::
                    \<langle>\<langle>bool_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel \<times>\<^sub>r
       clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel\<rangle>nres_rel) \<bind>
                   (\<lambda>(XS1).
                       singleton_spec XS1 \<bind>
                       (\<lambda>(b, X, PS1, PS2, R, ivl', sctn', CX, CXS). CHECKs ''poincare_onto_series: last return!'' (ivl' = ivl \<and> sctn' = sctn) \<bind> (\<lambda>_. RETURN PS2)))))
       (\<lambda>x xs rr (((((trap), XS0), ivl), sctn), ro0).
           case x of
           (guard, ro) \<Rightarrow>
             ASSUME (closed ivl) \<bind> 
             (\<lambda>_. let guard0 = mk_coll (mk_inter ivl (plane_of sctn))
                  in ASSUME (closed guard0) \<bind>
                  (\<lambda>_. ASSUME (\<forall>(guard, ro)\<in>set (x # xs). closed guard) \<bind>
                       (\<lambda>_. let guardset = \<Union>(guard, ro)\<in>set ((guard0, ro0) # xs). guard
                            in (poincare_onto2 odo ro (interrupt:::appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel) trap (guardset ::: clw_rel (\<langle>\<langle>lv_rel\<rangle>ivl_rel, \<langle>lv_rel\<rangle>plane_rel\<rangle>inter_rel))
                                 guard XS0 :::
                                \<langle>\<langle>bool_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r clw_rel appr1e_rel \<times>\<^sub>r lvivl_rel \<times>\<^sub>r \<langle>lv_rel\<rangle>sctn_rel \<times>\<^sub>r
       clw_rel (isbelows_rel appr_rel) \<times>\<^sub>r clw_rel appr_rel\<rangle>list_wset_rel\<rangle>nres_rel) \<bind>
                               (\<lambda>(XS1).
                                   ASSUME (\<forall>(b, X, PS, PS2, R, ivl, sctn, CX, CXS)\<in>XS1. closed ivl) \<bind>
                                   (\<lambda>_.
                                     partition_sets ro XS1 \<bind>
                                     (\<lambda>XS2. fst_safe_colle odo XS2 \<bind> (\<lambda>_. rr (((((trap), XS2), ivl), sctn), ro0 ::: reach_optns_rel) \<bind> RETURN))))))))
       guards (((((trap), XS), ivl), sctn), ro)"
   by (induction guards arbitrary: XS ivl sctn ro) (auto simp: split_beta' split: prod.splits)
 
 schematic_goal poincare_onto_series_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(XSi, XS::'n eucl1 set) \<in> clw_rel appr1e_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> \<langle>clw_rel (iplane_rel lvivl_rel)\<times>\<^sub>rreach_optns_rel\<rangle>list_rel"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel" "(ivli, ivl) \<in> lvivl_rel" "(sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
   assumes [autoref_rules]: "(symstarti, symstart::'n eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set)nres)
     \<in> appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   assumes [unfolded autoref_tag_defs, refine_transfer]: "\<And>X. TRANSFER (nres_of (symstartd X) \<le> symstarti X)"
     and [autoref_rules]: "((), trap) \<in> ghost_rel"
   notes [intro, simp] = list_set_rel_finiteD closed_ivl_prod3_list_rel closed_clw_rel_iplane_rel
     closed_ivl_prod8_list_rel
   notes [autoref_rules_raw] = ghost_relI[of x for x::"'n eucl1 set"]
   shows "(nres_of ?r, poincare_onto_series $ odo $ symstart $ trap $ guards $ XS $ ivl $ sctn $ ro) \<in> \<langle>clw_rel appr1e_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding poincare_onto_series_rec_list_eq
   including art
   apply autoref_monadic
   apply (rule ghost_relI)
   apply (autoref phases: trans)
   apply (autoref phases: trans)
   apply (rule ghost_relI)
   apply (autoref phases: trans)
   apply (autoref phases: trans)
   apply simp
   apply (autoref phases: trans)
     apply (autoref phases: trans)
    apply simp
   apply (refine_transfer)
   done
 
 concrete_definition poincare_onto_series_impl for symstartd guardsi XSi ivli sctni roi uses poincare_onto_series_impl
 lemmas [autoref_rules] = poincare_onto_series_impl.refine
 sublocale autoref_op_pat_def poincare_onto_series .
 
 schematic_goal poincare_onto_from_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(XSi, XS) \<in> clw_rel appr1e_rel"
     and [autoref_rules]: "(Si, S) \<in> \<langle>lv_rel\<rangle>halfspaces_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> \<langle>clw_rel (iplane_rel lvivl_rel)\<times>\<^sub>rreach_optns_rel\<rangle>list_rel"
     and civl[autoref_rules]: "(ivli, ivl::'n rvec set) \<in> lvivl_rel"
     and csctns[autoref_rules]: "(sctni, sctn::'n rvec sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
   assumes [autoref_rules]: "(symstarti, symstart::'n eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set)nres)
     \<in> appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   assumes [unfolded autoref_tag_defs, refine_transfer]: "\<And>X. TRANSFER (nres_of (symstartd X) \<le> symstarti X)"
     and [autoref_rules]: "((), trap) \<in> ghost_rel"
   notes [intro, simp] = list_set_rel_finiteD closed_ivl_rel[OF civl] closed_ivl_prod3_list_rel
   shows "(nres_of ?r, poincare_onto_from $ odo $ symstart $ trap $ S $ guards $ ivl $ sctn $ ro $ XS) \<in>
     \<langle>clw_rel appr1e_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding poincare_onto_from_def
   including art
   by autoref_monadic
 
 concrete_definition poincare_onto_from_impl for symstartd Si guardsi ivli sctni roi XSi uses poincare_onto_from_impl
 lemmas [autoref_rules] = poincare_onto_from_impl.refine
 sublocale autoref_op_pat_def poincare_onto_from .
 
 schematic_goal subset_spec1_impl:
   "(nres_of ?r, subset_spec1 R P dP) \<in> \<langle>bool_rel\<rangle>nres_rel"
   if [autoref_rules]:
     "(Ri, R) \<in> appr1_rel"
     "(Pimpl, P) \<in> lvivl_rel"
     "(dPi, dP) \<in> \<langle>lvivl_rel\<rangle>(default_rel UNIV)"
   unfolding subset_spec1_def
   including art
   by autoref_monadic
 lemmas [autoref_rules] = subset_spec1_impl[autoref_higher_order_rule]
 sublocale autoref_op_pat_def subset_spec1 .
 
 schematic_goal subset_spec1_collc:
   "(nres_of (?f), subset_spec1_coll R P dP) \<in> \<langle>bool_rel\<rangle>nres_rel"
   if [autoref_rules]:
     "(Ri, R) \<in> clw_rel appr1_rel"
     "(Pimpl, P) \<in> lvivl_rel"
     "(dPi, dP) \<in> \<langle>lvivl_rel\<rangle>(default_rel UNIV)"
   unfolding subset_spec1_coll_def
   including art
   by autoref_monadic
 concrete_definition subset_spec1_collc for Ri Pimpl dPi uses subset_spec1_collc
 lemmas subset_spec1_collc_refine[autoref_rules] = subset_spec1_collc.refine[autoref_higher_order_rule]
 sublocale autoref_op_pat_def subset_spec1_coll .
 
 schematic_goal one_step_until_time_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(X0i, X0::'n eucl1 set) \<in> appr1e_rel"
   assumes [autoref_rules]: "(phi, ph) \<in> bool_rel"
   assumes [autoref_rules]: "(t1i, t1) \<in> rnv_rel"
   notes [autoref_tyrel] = ty_REL[where 'a="real" and R="Id"]
   shows "(nres_of ?f, one_step_until_time odo X0 ph t1)\<in>\<langle>appr1e_rel \<times>\<^sub>r \<langle>clw_rel appr_rel\<rangle>phantom_rel\<rangle>nres_rel"
   unfolding one_step_until_time_def[abs_def]
   including art
   by autoref_monadic
 concrete_definition one_step_until_time_impl for odoi X0i phi t1i uses one_step_until_time_impl
 lemmas one_step_until_time_impl_refine[autoref_rules] = one_step_until_time_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def one_step_until_time .
 
 schematic_goal ivl_of_appr1_coll_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules]: "(Xi, X::'n::enum rvec set) \<in> clw_rel appr_rel"
   shows "(nres_of ?r, ivl_of_eucl_coll X) \<in> \<langle>appr1_rel\<rangle>nres_rel"
   unfolding ivl_of_eucl_coll_def
   by autoref_monadic
 concrete_definition ivl_of_appr1_coll_impl uses ivl_of_appr1_coll_impl
 sublocale autoref_op_pat_def ivl_of_eucl_coll .
 lemmas ivl_of_appr1_coll_impl_refine[autoref_rules] =
   ivl_of_appr1_coll_impl.refine[autoref_higher_order_rule(1)]
 
 schematic_goal one_step_until_time_ivl_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(X0i, X0::'n eucl1 set) \<in> appr1e_rel"
   assumes [autoref_rules]: "(phi, ph) \<in> bool_rel"
   assumes [autoref_rules]: "(t1i, t1) \<in> rnv_rel"
   assumes [autoref_rules]: "(t2i, t2) \<in> rnv_rel"
   shows "(nres_of ?r, one_step_until_time_ivl odo X0 ph t1 t2) \<in> \<langle>appr1e_rel \<times>\<^sub>r \<langle>clw_rel appr_rel\<rangle>phantom_rel\<rangle>nres_rel"
   unfolding one_step_until_time_ivl_def
   including art
   by autoref_monadic
 concrete_definition one_step_until_time_ivl_impl for X0i phi t1i t2i uses one_step_until_time_ivl_impl
 lemmas [autoref_rules] = one_step_until_time_ivl_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def one_step_until_time_ivl .
 
 
 schematic_goal poincare_onto_from_in_ivl_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(XSi, XS) \<in> clw_rel appr1e_rel"
     and [autoref_rules]: "(Si, S) \<in> \<langle>lv_rel\<rangle>halfspaces_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> \<langle>clw_rel (iplane_rel lvivl_rel)\<times>\<^sub>rreach_optns_rel\<rangle>list_rel"
     and civl[autoref_rules]: "(ivli, ivl::'n rvec set) \<in> lvivl_rel"
     and csctns[autoref_rules]: "(sctni, sctn::'n rvec sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
   assumes [autoref_rules]: "(symstarti, symstart::'n eucl1 set \<Rightarrow> ('n rvec set \<times> 'n eucl1 set)nres)
     \<in> appr1e_rel \<rightarrow> \<langle>clw_rel appr_rel \<times>\<^sub>r clw_rel appr1e_rel\<rangle>nres_rel"
   assumes [unfolded autoref_tag_defs, refine_transfer]: "\<And>X. TRANSFER (nres_of (symstartd X) \<le> symstarti X)"
     and [autoref_rules]: "((), trap) \<in> ghost_rel"
     "(Pimpl, P) \<in> lvivl_rel"
     "(dPi, dP) \<in> \<langle>lvivl_rel\<rangle>(default_rel UNIV)"
   notes [intro, simp] = list_set_rel_finiteD closed_ivl_rel[OF civl] closed_ivl_prod3_list_rel
   shows "(nres_of ?r, poincare_onto_from_in_ivl
       $ odo $ symstart $ trap $ S $ guards $ ivl $ sctn $ ro $ XS $ P $ dP) \<in>
     \<langle>bool_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding poincare_onto_from_in_ivl_def
   including art
   by autoref_monadic
 
 concrete_definition poincare_onto_from_in_ivl_impl for E odoi symstartd Si guardsi ivli sctni roi XSi Pimpl dPi uses poincare_onto_from_in_ivl_impl
 lemmas [autoref_rules] = poincare_onto_from_in_ivl_impl.refine
 sublocale autoref_op_pat_def poincare_onto_from_in_ivl .
 
 lemma TRANSFER_I: "x \<Longrightarrow> TRANSFER x"
   by simp
 
 lemma dres_nres_rel_nres_relD: "(symstartd, symstart) \<in> A \<rightarrow> \<langle>B\<rangle>dres_nres_rel \<Longrightarrow> (\<lambda>x. nres_of (symstartd x), symstart) \<in> A \<rightarrow> \<langle>B\<rangle>nres_rel"
   by (auto simp: dres_nres_rel_def nres_rel_def dest!: fun_relD)
 
 lemma c1_info_of_apprsI:
   assumes "(b, a) \<in> clw_rel appr1_rel"
   assumes "x \<in> a"
   shows "x \<in> c1_info_of_apprs b"
   using assms
   by (auto simp: appr1_rel_br clw_rel_br c1_info_of_apprs_def dest!: brD)
 
 lemma clw_rel_appr1_relI:
   assumes "\<And>X. X \<in> set XS \<Longrightarrow> c1_info_invar CARD('n::enum) X"
   shows "(XS, c1_info_of_apprs XS::('n rvec\<times>_)set) \<in> clw_rel appr1_rel"
   by (auto simp: appr1_rel_br clw_rel_br c1_info_of_apprs_def intro!: brI assms)
 
 lemma c1_info_of_appr'I:
   assumes "(b, a) \<in> \<langle>clw_rel appr1_rel\<rangle>phantom_rel"
   assumes "x \<in> a"
   shows "x \<in> c1_info_of_appr' b"
   using assms
   by (auto simp add: c1_info_of_appr'_def intro!: c1_info_of_apprsI split: option.splits)
 
 lemma appr1e_relI:
   assumes "c1_info_invare CARD('n::enum) X0i"
   shows "(X0i, c1_info_of_appre X0i::'n eucl1 set) \<in> appr1e_rel"
   using assms
   apply (cases X0i)
   apply (auto simp: scaleR2_rel_def c1_info_of_appre_def c1_info_invare_def)
   apply (rule relcompI)
    apply (rule prod_relI)
     apply (rule IdI)
    apply (rule appr1_relI)
     apply (auto simp: vimage_def intro!: brI)
    apply (metis ereal_dense2 less_imp_le)
     apply (rule relcompI)
    apply (rule prod_relI)
     apply (rule IdI)
    apply (rule appr1_relI)
    apply (auto simp: vimage_def intro!: brI)
   by (metis basic_trans_rules(23) ereal_cases ereal_less_eq(1) ereal_top order_eq_refl)
 
 lemma c1_info_of_apprI:
   assumes "(b, a) \<in> appr1_rel"
   assumes "x \<in> a"
   shows "x \<in> c1_info_of_appr b"
   using assms
   apply (auto simp add: c1_info_of_appr_def c1_info_invar_def appr1_rel_internal appr_rel_def lv_rel_def
       set_rel_br
       dest!: brD
       split: option.splits)
    apply (auto simp add:  appr_rell_internal dest!: brD)
   done
 
 lemma c1_info_of_appreI:
   assumes "(lub, a) \<in> appr1e_rel"
   assumes "x \<in> a"
   shows "x \<in> c1_info_of_appre lub"
   using assms
   apply (auto simp add: scaleR2_def c1_info_of_appre_def image_def vimage_def scaleR2_rel_def
       dest!: brD
       intro!: c1_info_of_apprsI split: option.splits)
   subgoal for a b c d e f g h i
     apply (rule exI[where x=g])
     apply (rule conjI, assumption)+
     apply (rule bexI)
      prefer 2
      apply (rule c1_info_of_apprI) apply assumption
      apply assumption apply simp
     done
   done
 
 lemma c1_info_of_apprseI:
   assumes "(b, a) \<in> clw_rel appr1e_rel"
   assumes "x \<in> a"
   shows "x \<in> c1_info_of_apprse b"
   using assms
   by (force simp: appr1_rel_br scaleR2_rel_br clw_rel_br c1_info_of_appre_def c1_info_of_apprse_def
       dest!: brD)
 
 lemma clw_rel_appr1e_relI:
   assumes "\<And>X. X \<in> set XS \<Longrightarrow> c1_info_invare CARD('n::enum) X"
   shows "(XS, c1_info_of_apprse XS::('n rvec\<times>_)set) \<in> clw_rel appr1e_rel"
   using assms
   apply (auto simp: c1_info_of_apprse_def c1_info_of_appre_def c1_info_invare_def)
   unfolding appr1_rel_br scaleR2_rel_br clw_rel_br
   apply (rule brI)
    apply (auto simp: c1_info_invar_def vimage_def)
   subgoal premises prems for a b c d
     using prems(1)[OF prems(2)]
     by (cases a; cases b) auto
   done
 
 schematic_goal one_step_until_time_ivl_in_ivl_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n::enum rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(X0i, X0::'n eucl1 set) \<in> appr1e_rel"
   assumes [autoref_rules]: "(t1i, t1) \<in> rnv_rel"
   assumes [autoref_rules]: "(t2i, t2) \<in> rnv_rel"
       "(Ri, R) \<in> lvivl_rel"
       "(dRi, dR) \<in> \<langle>lvivl_rel\<rangle>(default_rel UNIV)"
   shows "(nres_of ?r, one_step_until_time_ivl_in_ivl odo X0 t1 t2 R dR) \<in> \<langle>bool_rel\<rangle>nres_rel"
   unfolding one_step_until_time_ivl_in_ivl_def
   including art
   by autoref_monadic
 concrete_definition one_step_until_time_ivl_in_ivl_impl for odoi X0i t1i t2i Ri dRi
   uses one_step_until_time_ivl_in_ivl_impl
 lemmas one_step_until_time_ivl_in_ivl_impl_refine[autoref_rules] =
   one_step_until_time_ivl_in_ivl_impl.refine[autoref_higher_order_rule(1 2 3)]
 sublocale autoref_op_pat_def one_step_until_time_ivl_in_ivl .
 
 schematic_goal poincare_onto_in_ivl_impl:
   assumes [autoref_rules_raw]: "DIM_precond TYPE('n::enum rvec) E"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n::enum rvec)"
   assumes [autoref_rules_raw]: "ncc_precond TYPE('n vec1)"
   assumes [autoref_rules]: "(odoi, odo) \<in> ode_ops_rel"
   assumes [autoref_rules]: "(XSi, XS) \<in> clw_rel appr1e_rel"
     and osctns[autoref_rules]: "(guardsi, guards) \<in> \<langle>clw_rel (iplane_rel lvivl_rel)\<times>\<^sub>rreach_optns_rel\<rangle>list_rel"
     and civl[autoref_rules]: "(ivli, ivl::'n rvec set) \<in> lvivl_rel"
     and csctns[autoref_rules]: "(sctni, sctn::'n rvec sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
     and [autoref_rules]: "(roi, ro) \<in> reach_optns_rel"
       "(Pimpl, P::'n rvec set) \<in> lvivl_rel"
       "(dPi, dP:: ((real, 'n) vec, 'n) vec set) \<in> \<langle>lvivl_rel\<rangle>(default_rel UNIV)"
   notes [intro, simp] = list_set_rel_finiteD closed_ivl_rel[OF civl] closed_ivl_prod3_list_rel
   shows "(nres_of ?r,
     poincare_onto_in_ivl odo guards ivl sctn ro XS P dP) \<in>
     \<langle>bool_rel\<rangle>nres_rel"
   unfolding autoref_tag_defs
   unfolding poincare_onto_in_ivl_def
   including art
   apply (rule autoref_monadicI)
    apply (autoref phases: id_op rel_inf fix_rel)
    apply (autoref_trans_step)
     apply (autoref_trans_step)
      apply (autoref_trans_step)
     apply (simp only: autoref_tag_defs)
     apply (rule poincare_onto_series_impl.refine[unfolded autoref_tag_defs])\<comment> \<open>TODO: why?\<close>
                apply fact+
       apply (rule empty_symstart_impl)
      apply refine_transfer
     apply (rule ghost_relI)
    apply (autoref phases: trans)
   unfolding autoref_tag_defs
   by refine_transfer
 
 concrete_definition poincare_onto_in_ivl_impl for E odoi guardsi ivli sctni roi XSi Pimpl dPi
   uses poincare_onto_in_ivl_impl
 lemmas [autoref_rules] = poincare_onto_in_ivl_impl.refine[autoref_higher_order_rule(1 2 3)]
 
 
 subsection \<open>Main (executable) interfaces to the ODE solver, with initialization\<close>
 
 definition "carries_c1 = Not o Option.is_none o (snd o snd)"
 
 definition "solves_poincare_map odo symstart S guards ivli sctni roi XS P dP \<longleftrightarrow>
   poincare_onto_from_in_ivl_impl (D odo) (init_ode_ops True (carries_c1 (hd XS)) odo) symstart S guards ivli sctni
     roi XS P dP = dRETURN True"
 
 definition "solves_poincare_map' odo S = solves_poincare_map odo (\<lambda>x. dRETURN ([], [x])) [S]"
 
 definition "one_step_until_time_ivl_in_ivl_check odo X t0 t1 Ri dRi \<longleftrightarrow>
   one_step_until_time_ivl_in_ivl_impl (D odo) (init_ode_ops True (carries_c1 X) odo) X t0 t1 Ri dRi = dRETURN True"
 
 definition "solves_poincare_map_onto odo guards ivli sctni roi XS P dP \<longleftrightarrow>
   poincare_onto_in_ivl_impl (D odo) (init_ode_ops True (carries_c1 (hd XS)) odo) guards ivli sctni roi XS P dP = dRETURN True"
 
 end
 
 context approximate_sets begin
 
 lemma c1_info_of_appre_c0_I:
   "(x, d) \<in> c1_info_of_appre ((1, 1), X0, None)"
   if "list_of_eucl x \<in> set_of_appr X0"
   using that
   by (force simp: c1_info_of_appre_def c1_info_of_appr_def)
 
 lemma lvivl'_invar_None[simp]: "lvivl'_invar n None"
   by (auto simp: lvivl'_invar_def)
 
 lemma c1_info_invar_None: "c1_info_invar n (u, None) \<longleftrightarrow> length u = n"
   by (auto simp: c1_info_invar_def)
 
 lemma c1_info_invare_None: "c1_info_invare n ((l, u), x, None) \<longleftrightarrow>((l < u \<or> -\<infinity> < l \<and> l \<le> u \<and> u < \<infinity>) \<and> length x = n)"
   by (auto simp: c1_info_invare_def Let_def c1_info_invar_None)
 
 end
 
 end
\ No newline at end of file
diff --git a/thys/Ordinary_Differential_Equations/Numerics/Example_Utilities.thy b/thys/Ordinary_Differential_Equations/Numerics/Example_Utilities.thy
--- a/thys/Ordinary_Differential_Equations/Numerics/Example_Utilities.thy
+++ b/thys/Ordinary_Differential_Equations/Numerics/Example_Utilities.thy
@@ -1,2708 +1,2707 @@
 theory Example_Utilities
 imports
   Init_ODE_Solver
 begin
 
 definition "true_form = Less (floatarith.Num 0) (floatarith.Num 1)"
 
 lemma open_true_form[intro, simp]: "open_form true_form"
   by (auto simp: true_form_def)
 
 lemma max_Var_form_true_form[simp]: "max_Var_form true_form = 0"
   by (auto simp: true_form_def)
 
 lemma interpret_form_true_form[simp]: "interpret_form true_form = (\<lambda>_. True)"
   by (auto simp: true_form_def)
 
 lemmas [simp] = length_aforms_of_ivls
 
 declare INF_cong_simp [cong] SUP_cong_simp [cong] image_cong_simp [cong del]
 
 declare [[ cd_patterns "_ = interpret_floatariths ?fas _" "_ = interpret_floatarith ?fa _"]]
 
 concrete_definition reify_example for i j k uses reify_example
 
 hide_const (open) Print.file_output
 definition "file_output s f =
   (if s = STR ''''      then f (\<lambda>_. ())
   else if s = STR ''-'' then f print
   else                                  Print.file_output s f)"
 
 definition "aforms_of_point xs = aforms_of_ivls xs xs"
 
 definition "unit_matrix_list D = concat (map (\<lambda>i. map (\<lambda>j. if i = j then 1 else 0::real) [0..<D]) [0..<D])"
 
 definition "with_unit_matrix D X = (fst X @ unit_matrix_list D, snd X @ unit_matrix_list D)"
 
 definition "list_interval l u = {x. list_all2 (\<le>) l x \<and> list_all2 (\<le>) x u}"
 
 context includes lifting_syntax begin
 lemma list_interval_transfer[transfer_rule]:
   "((list_all2 A) ===> (list_all2 A) ===> rel_set (list_all2 A))
     list_interval list_interval"
   if [transfer_rule]: "(A ===> A ===> (=)) (\<le>) (\<le>)" "bi_total A"
   unfolding list_interval_def
   by transfer_prover
 end
 
 lemma in_list_interval_lengthD: "x \<in> list_interval a b \<Longrightarrow> length x = length a"
   by (auto simp: list_interval_def list_all2_lengthD)
 
 context includes floatarith_notation begin
 
 definition "varvec_fas' D C = ((map Var [0..<D]) @
       concat (map (\<lambda>b.
         (map (\<lambda>i. (Num (C i)) +
           Var (D + D * D) * (mvmult_fa D D (map Var [D..<D + D * D]) (map Num ((replicate D 0)[i:=1])) ! b)) [0..<D])) [0..<D]))"
 
 definition "varvec_fas D C = ((map Var [0..<D]) @
       concat (map (\<lambda>i. (map (\<lambda>j. (Num (C i)) + Var (D + D * D) * Var (D + D * i + j)) [0..<D])) [0..<D]))"
 
 lemma \<comment> \<open>for illustration\<close>
   assumes[simp]: "D=3" "rf = real_of_float"
   shows "interpret_floatariths (varvec_fas D (\<lambda>i. [a, b, c] ! i))
   [a, b, c, d11, d12, d13,
             d21, d22, d23,
             d31, d32, d33, 2] =
   [rf a, rf b, rf c,
   rf a + 2 * rf d11, rf a + 2 * rf d12, rf a + 2 * rf d13,
   rf b + 2 * rf d21, rf b + 2 * rf d22, rf b + 2 * rf d23,
   rf c + 2 * rf d31, rf c + 2 * rf d32, rf c + 2 * rf d33]"
   by (simp add: varvec_fas_def mvmult_fa_def eval_nat_numeral)
 
 definition "vareq_projections
     n  \<comment> \<open>dimension\<close>
     ps \<comment> \<open>pairs of coordinates to project onto\<close>
     ds \<comment> \<open>partial derivatives w.r.t. which variables\<close>
     cs \<comment> \<open>(color) coding for partial derivatives\<close>
   =
   [(i + n * (x + 1)::nat, i + n * (y + 1), c). (i, c) \<leftarrow> zip ds cs, (x, y) \<leftarrow> ps]"
 
 definition "varvec_aforms_line D X line =
   approx_floatariths
     30
     (varvec_fas D (\<lambda>i. float_of (fst (X ! i))))
     (take (D + D*D) X @ line)"
 
 definition "varvec_aforms_head D X s = varvec_aforms_line D X (aforms_of_point [s])"
 definition "varvec_aforms_vec D X s = varvec_aforms_line D (map (\<lambda>x. (fst x, zero_pdevs)) X) [aform_of_ivl 0 s]"
 
 definition
   "shows_aforms_vareq
       n                \<comment> \<open>dimension\<close>
       ps               \<comment> \<open>pairs of coordinates to project onto\<close>
       ds               \<comment> \<open>partial derivatives w.r.t. which variables\<close>
       csl              \<comment> \<open>color coding for partial derivatives ('arrow' heads)\<close>
       csh              \<comment> \<open>color coding for partial derivatives (lines)\<close>
       s                \<comment> \<open>scale vectors for partial derivatives\<close>
       (no_str::string) \<comment> \<open>default string if no C1 info is present\<close>
       X                \<comment> \<open>affine form with C1 info\<close>
    =
     (case (varvec_aforms_head n X s, varvec_aforms_vec n X s) of (Some X, Some Y) \<Rightarrow>
         shows_sep (\<lambda>(x, y, c). shows_segments_of_aform x y X c) shows_nl (vareq_projections n ps ds csl) o shows_nl
       o shows_sep (\<lambda>(x, y, c). shows_segments_of_aform x y Y c) shows_nl (vareq_projections n ps ds csh) o shows_nl
     | _ \<Rightarrow> shows_string no_str o shows_nl)"
 
 abbreviation "print_string s \<equiv> print (String.implode s)"
 abbreviation "print_show s \<equiv> print_string (s '''')"
 
 value [code] "print_show (shows_aforms_vareq 3 [(x, y). x \<leftarrow> [0..<3], y \<leftarrow> [0..<3], x < y]
   [0..<3] [''0x0000ff'', ''0x00ff00'', ''0xff0000''] [''0x0000ff'', ''0x00ff00'', ''0xff0000'']
   (FloatR 1 (-1)) ''# no C1 info''
     ((((\<lambda>(a, b). aforms_of_ivls a b) (with_unit_matrix 3 ([10, 20, 30], [12, 22, 32]))))))"
 
 method_setup guess_rhs = \<open>
 let
   fun compute ctxt var lhs =
     let
       val lhs' = Code_Evaluation.dynamic_value_strict ctxt lhs;
       val clhs' = Thm.cterm_of ctxt lhs';
       val inst = Thm.instantiate ([], [(var, clhs')]);
     in PRIMITIVE inst end;
   fun eval_schematic_rhs ctxt t = (case try (HOLogic.dest_eq o HOLogic.dest_Trueprop) t of
       SOME (lhs, Var var) => compute ctxt var lhs
     | _ => no_tac);
 in
   Scan.succeed (fn ctxt =>
     SIMPLE_METHOD (HEADGOAL (SUBGOAL (fn (t, _) => eval_schematic_rhs ctxt t))))
 end
 \<close>
 
 lemma length_aforms_of_point[simp]: "length (aforms_of_point xs) = length xs"
   by (auto simp: aforms_of_point_def)
 
 definition "aform2d_plot_segments x y a = shows_segments_of_aform x y a ''0x000000''"
 
 lemma list_of_eucl_prod[simp]: "list_of_eucl (x, y) = list_of_eucl x @ list_of_eucl y"
   by (auto simp: list_of_eucl_def Basis_list_prod_def intro!: nth_equalityI)
 
 lemma list_of_eucl_real[simp]: "list_of_eucl (x::real) = [x]"
   by (auto simp: list_of_eucl_def Basis_list_real_def)
 
 lemma Joints_aforms_of_ivls_self[simp]: "xs \<in> Joints (aforms_of_ivls xs xs)"
   by (auto intro!: aforms_of_ivls)
 
 lemma Joints_aforms_of_ivls_self_eq[simp]: "Joints (aforms_of_ivls xs xs) = {xs}"
   apply (auto )
   by (auto simp: aforms_of_ivls_def Joints_def valuate_def aform_val_def
       intro!: nth_equalityI)
 
 lemma local_lipschitz_c1_euclideanI:
   fixes T::"real set" and X::"'a::euclidean_space set"
     and f::"real \<Rightarrow> 'a \<Rightarrow> 'a"
   assumes f': "\<And>t x. t \<in> T \<Longrightarrow> x \<in> X \<Longrightarrow> (f t has_derivative f' t x) (at x)"
   assumes cont_f': "\<And>i. i \<in> Basis \<Longrightarrow> continuous_on (T \<times> X) (\<lambda>(t, x). f' t x i)"
   assumes "open T"
   assumes "open X"
   shows "local_lipschitz T X f"
   using assms
   apply (intro c1_implies_local_lipschitz[where f'="\<lambda>(t, x). Blinfun (f' t x)"])
      apply (auto simp: bounded_linear_Blinfun_apply has_derivative_bounded_linear split_beta'
       intro!: has_derivative_Blinfun continuous_on_blinfun_componentwise)
   apply (subst continuous_on_cong[OF refl]) defer apply assumption
   apply auto
   apply (subst bounded_linear_Blinfun_apply)
    apply (rule has_derivative_bounded_linear)
   by auto
 
 definition "list_aform_of_aform (x::real aform) = (fst x, list_of_pdevs (snd x))"
 primrec split_aforms_list:: "(real aform) list list
    \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (real aform) list list" where
   "split_aforms_list Xs i 0 = Xs"
 | "split_aforms_list Xs i (Suc n) = split_aforms_list (concat (map (\<lambda>x. (let (a, b) = split_aforms x i in [a, b])) Xs)) i n"
 
 definition "shows_aforms x y c X = shows_lines (map (\<lambda>b. (shows_segments_of_aform x y b c ''\<newline>'')) X)"
 
 end
 
 definition "the_odo ode_fas safe_form = the(mk_ode_ops ode_fas safe_form)"
 
 locale ode_interpretation =
   fixes safe_form::form and safe_set::"'a::executable_euclidean_space set"
     and ode_fas::"floatarith list"
     and ode::"'a \<Rightarrow> 'a"
     and finite::"'n::enum"
   assumes dims: "DIM('a) = CARD('n)"
   assumes len: "length ode_fas = CARD('n)"
   assumes safe_set_form: "safe_set = {x. interpret_form safe_form (list_of_eucl x)}"
   assumes interpret_fas: "\<And>x. x \<in> safe_set \<Longrightarrow> einterpret ode_fas (list_of_eucl x) = ode x"
   assumes odo: "mk_ode_ops ode_fas safe_form \<noteq> None"
   assumes isFDERIV: "\<And>xs. interpret_form safe_form xs \<Longrightarrow>
     isFDERIV (length ode_fas) [0..<length ode_fas] ode_fas xs"
 begin
 
 abbreviation "odo \<equiv> the_odo ode_fas safe_form"
 lemmas odo_def = the_odo_def
 
 lemma odo_simps[simp]: "ode_expression odo = ode_fas" "safe_form_expr odo = safe_form"
   using odo
   by (auto simp: odo_def ode_expression_mk_ode_ops safe_form_expr_mk_ode_ops)
 
 lemma safe_set: "safe_set = aform.Csafe odo"
   using odo dims safe_set_form isFDERIV
   unfolding aform.Csafe_def aform.safe_def aform.safe_form_def aform.ode_e_def
   by (auto simp: mk_ode_ops_def safe_set_form len split: if_splits)
 
 lemma ode: "\<And>x. x \<in> safe_set \<Longrightarrow> ode x = aform.ode odo x"
   by (auto simp: aform.ode_def aform.ode_e_def interpret_fas)
 
 sublocale auto_ll_on_open ode safe_set
   by (rule aform.auto_ll_on_open_congI[OF safe_set[symmetric] ode[symmetric]])
 
 lemma ode_has_derivative_ode_d1: "(ode has_derivative blinfun_apply (aform.ode_d1 odo x)) (at x)"
   if "x \<in> safe_set" for x
 proof -
   from aform.fderiv[OF that[unfolded safe_set]]
   have "(aform.ode odo has_derivative blinfun_apply (aform.ode_d1 odo x)) (at x)"
     by simp
   moreover
   from topological_tendstoD[OF tendsto_ident_at open_domain(2) that]
   have "\<forall>\<^sub>F x' in at x. x' \<in> safe_set" .
   then have "\<forall>\<^sub>F x' in at x. aform.ode odo x' = ode x'"
     by eventually_elim (auto simp: ode)
   ultimately show ?thesis
     by (rule has_derivative_transform_eventually) (auto simp: ode that)
 qed
 
 sublocale c1_on_open_euclidean ode "aform.ode_d1 odo" safe_set
   apply unfold_locales
   subgoal by simp
   subgoal by (simp add: ode_has_derivative_ode_d1)
   subgoal by (rule aform.cont_fderiv') (auto intro!: continuous_intros simp: safe_set)
   done
 
 sublocale transfer_eucl_vec for a::'a and n::'n
   by unfold_locales (simp add: dims)
 
 lemma flow_eq: "t \<in> existence_ivl0 x \<Longrightarrow> aform.flow0 odo x t = flow0 x t"
   and Dflow_eq: "t \<in> existence_ivl0 x \<Longrightarrow> aform.Dflow odo x t = Dflow x t"
   and ex_ivl_eq: "t \<in> aform.existence_ivl0 odo x \<Longrightarrow> aform.existence_ivl0 odo x = existence_ivl0 x"
   and poincare_mapsto_eq: "closed a \<Longrightarrow> aform.poincare_mapsto odo a b c d e = poincare_mapsto a b c d e"
   and flowsto_eq: "aform.flowsto odo = flowsto"
       apply -
   subgoal by (rule flow0_cong[symmetric]) (auto simp: safe_set ode)
   subgoal by (rule Dflow_cong[symmetric]) (auto simp: safe_set ode)
   subgoal by (rule existence_ivl0_cong[symmetric]) (auto simp: safe_set ode)
   subgoal
     apply (subst aform.poincare_mapsto_cong[OF safe_set[symmetric]])
     by (auto simp: ode)
   subgoal
     apply (intro ext)
     apply (subst flowsto_congI[OF safe_set ode])
     by (auto simp: safe_set)
   done
 
 definition "avf \<equiv> \<lambda>x::'n rvec. cast (aform.ode odo (cast x)::'a)::'n rvec"
 
 context includes lifting_syntax begin
 lemma aform_ode_transfer[transfer_rule]: "((=) ===> rel_ve ===> rel_ve) aform.ode aform.ode"
   unfolding aform.ode_def
   by transfer_prover
 lemma cast_aform_ode: "cast (aform.ode odo (cast (x::'n rvec))::'a) = aform.ode odo x"
   by transfer simp
 
 lemma aform_safe_transfer[transfer_rule]: "((=) ===> rel_ve ===> (=)) aform.safe aform.safe"
   unfolding aform.safe_def
   by transfer_prover
 
 lemma aform_Csafe_transfer[transfer_rule]: "((=) ===> rel_set rel_ve) aform.Csafe aform.Csafe"
   unfolding aform.Csafe_def
   by transfer_prover
 
 lemma cast_safe_set: "(cast ` safe_set::'n rvec set) = aform.Csafe odo"
   unfolding safe_set
   by transfer simp
 
 lemma aform_ode_d_raw_transfer[transfer_rule]:
   "((=) ===> (=) ===> rel_ve ===> rel_ve ===> rel_ve ===> rel_ve) aform.ode_d_raw aform.ode_d_raw"
   unfolding aform.ode_d_raw_def
   by transfer_prover
 
 lemma
   aform_ode_d_raw_aux_transfer:
   "((=) ===> rel_ve ===> rel_ve ===> rel_ve)
     (\<lambda>x xb xa. if xb \<in> aform.Csafe x then aform.ode_d_raw x 0 xb 0 xa else 0)
     (\<lambda>x xb xa. if xb \<in> aform.Csafe x then aform.ode_d_raw x 0 xb 0 xa else 0)"
   by transfer_prover
 
 lemma aform_ode_d1_transfer[transfer_rule]:
   "((=) ===> rel_ve ===> rel_blinfun rel_ve rel_ve) aform.ode_d1 aform.ode_d1"
   apply (auto simp: rel_blinfun_def aform.ode_d1_def intro!: rel_funI)
   unfolding aform.ode_d.rep_eq
   using aform_ode_d_raw_aux_transfer
   apply -
   apply (drule rel_funD, rule refl)
   apply (drule rel_funD, assumption)
   apply (drule rel_funD; assumption)
   done
 
 lemma cast_bl_transfer[transfer_rule]:
   "(rel_blinfun (=) (=) ===> rel_blinfun rel_ve rel_ve) id_blinfun cast_bl"
   by (auto simp: rel_ve_cast rel_blinfun_def intro!: rel_funI dest!: rel_funD)
 lemma cast_bl_transfer'[transfer_rule]:
   "(rel_blinfun rel_ve rel_ve ===> rel_blinfun (=) (=)) id_blinfun cast_bl"
   apply (auto simp: rel_ve_cast rel_blinfun_def cast_cast intro!: rel_funI dest!: rel_funD)
   by (subst cast_cast) auto
 
 lemma rel_blinfun_eq[relator_eq]: "rel_blinfun (=) (=) = (=)"
   by (auto simp: Rel_def rel_blinfun_def blinfun_ext rel_fun_eq intro!: rel_funI ext)
 
 lemma cast_aform_ode_D1:
   "cast_bl (aform.ode_d1 odo (cast (x::'n rvec))::'a\<Rightarrow>\<^sub>L'a) =
     (aform.ode_d1 odo x::'n rvec \<Rightarrow>\<^sub>L 'n rvec)"
   by transfer simp
 
 end
 
 definition "vf \<equiv> \<lambda>x. cast (ode (cast x))"
 definition "vf' \<equiv> \<lambda>x::'n rvec. cast_bl (aform.ode_d1 odo (cast x::'a))
   ::'n rvec \<Rightarrow>\<^sub>L 'n rvec"
 definition "vX \<equiv> cast ` safe_set"
 sublocale a?: transfer_c1_on_open_euclidean a n ode "aform.ode_d1 odo" safe_set vf vf' vX
   for a::'a and n::'n
   by unfold_locales
     (simp_all add: dims vf_def vf'_def vX_def)
 
 sublocale av: transfer_c1_on_open_euclidean a n "aform.ode odo" "aform.ode_d1 odo"
   "(aform.Csafe odo)" avf vf' vX
   for a::'a and n::'n
      apply unfold_locales
   unfolding vX_def
   by (simp_all add: dims avf_def  safe_set)
 
 lemma vflow_eq: "t \<in> v.existence_ivl0 x \<Longrightarrow> aform.flow0 odo x t = v.flow0 x t"
   thm flow_eq[of t "cast x"] flow_eq[of t "cast x", untransferred]
   apply (subst flow_eq[of t "cast x", untransferred, symmetric])
    apply simp
   unfolding avf_def vX_def cast_aform_ode cast_safe_set
   ..
 
 lemma vf'_eq: "vf' = aform.ode_d1 odo"
   unfolding vf'_def cast_aform_ode_D1 ..
 
 lemma vDflow_eq: "t \<in> v.existence_ivl0 x \<Longrightarrow> aform.Dflow odo x t = v.Dflow x t"
   apply (subst Dflow_eq[of t "cast x", untransferred, symmetric])
    apply simp
   unfolding avf_def vX_def cast_aform_ode cast_safe_set vf'_eq
   ..
 
 lemma vex_ivl_eq: "t \<in> aform.existence_ivl0 odo x \<Longrightarrow> aform.existence_ivl0 odo x = v.existence_ivl0 x"
   apply (subst ex_ivl_eq[of t "cast x", untransferred, symmetric])
   unfolding avf_def vX_def cast_aform_ode cast_safe_set vf'_eq
   by auto
 
 context includes lifting_syntax begin
 lemma id_cast_eucl1_transfer_eq: "(\<lambda>x. x) = (\<lambda>x. (fst x, 1\<^sub>L o\<^sub>L snd x o\<^sub>L 1\<^sub>L))"
   by auto
 lemma cast_eucl1_transfer[transfer_rule]:
   "(rel_prod (=) (rel_blinfun (=) (=)) ===> rel_prod rel_ve (rel_blinfun rel_ve rel_ve)) (\<lambda>x. x) cast_eucl1"
   unfolding cast_eucl1_def id_cast_eucl1_transfer_eq
   apply transfer_prover_start
        apply (transfer_step)
       apply (transfer_step)
      apply (transfer_step)
     apply (transfer_step)
    apply (transfer_step)
   apply simp
   done
 
 end
 
 lemma avpoincare_mapsto_eq:
   "aform.poincare_mapsto odo a (b::'n eucl1 set) c d e = av.v.poincare_mapsto a b c d e"
   if "closed a"
   unfolding avf_def vX_def cast_aform_ode cast_safe_set vf'_eq
   by auto
 
 lemma vpoincare_mapsto_eq:
   "aform.poincare_mapsto odo a (b::'n eucl1 set) c d e = v.poincare_mapsto a b c d e"
   if "closed a"
 proof -
   have "closed (cast ` a::'a set)" using that
     by transfer auto
   from poincare_mapsto_eq[of "cast ` a::'a set"
       "cast_eucl1 ` b::('a \<times> 'a \<Rightarrow>\<^sub>L 'a) set"
       "cast ` c::'a set" "cast ` d::'a set" "cast_eucl1 ` e::('a \<times> 'a \<Rightarrow>\<^sub>L 'a) set", OF this, untransferred]
   have "v.poincare_mapsto a b c d e = av.v.poincare_mapsto a b c d e"
     by auto
   also have "\<dots> = aform.poincare_mapsto odo a (b::'n eucl1 set) c d e"
     unfolding avf_def vX_def cast_aform_ode cast_safe_set vf'_eq
     by auto
   finally show ?thesis by simp
 qed
 
 lemma avflowsto_eq: "aform.flowsto odo = (av.v.flowsto::'n eucl1 set \<Rightarrow> _)"
 proof (intro ext, goal_cases)
   case (1 a b c d)
   have "av.v.flowsto a b c d = aform.flowsto odo a b c d"
     unfolding avf_def vX_def cast_aform_ode cast_safe_set vf'_eq
     by auto
   then show ?case by simp
 qed
 
 lemma vflowsto_eq: "aform.flowsto odo = (v.flowsto::'n eucl1 set \<Rightarrow> _)"
 proof (intro ext, goal_cases)
   case (1 a b c d)
   have "aform.flowsto odo (cast_eucl1 ` a::'a c1_info set) b
     (cast_eucl1 ` c)  (cast_eucl1 ` d) =
     flowsto (cast_eucl1 ` a::'a c1_info set) b (cast_eucl1 ` c)  (cast_eucl1 ` d)"
     by (subst flowsto_eq) auto
   from this[untransferred] have "v.flowsto a b c d = av.v.flowsto a b c d" by auto
   also have "\<dots> = aform.flowsto odo a b c d"
     unfolding avf_def vX_def cast_aform_ode cast_safe_set vf'_eq
     by auto
   finally show ?case by simp
 qed
 
 context includes lifting_syntax begin
 lemma flow1_of_list_transfer[transfer_rule]:
   "(list_all2 (=) ===> rel_prod rel_ve (rel_blinfun rel_ve rel_ve))
    flow1_of_list flow1_of_list"
   unfolding flow1_of_list_def blinfun_of_list_def o_def flow1_of_vec1_def
   by transfer_prover
 
 lemma c1_info_of_appr_transfer[transfer_rule]:
   "(rel_prod (list_all2 (=)) (rel_option (list_all2 (=))) ===> rel_set (rel_prod rel_ve (rel_blinfun rel_ve rel_ve)))
     aform.c1_info_of_appr
     aform.c1_info_of_appr"
   unfolding aform.c1_info_of_appr_def
   by transfer_prover
 
 lemma c0_info_of_appr_transfer[transfer_rule]:
   "((list_all2 (=)) ===> rel_set rel_ve) aform.c0_info_of_appr aform.c0_info_of_appr"
   unfolding aform.c0_info_of_appr_def
   by transfer_prover
 
 lemma aform_scaleR2_transfer[transfer_rule]:
   "((=) ===> (=) ===> rel_set (rel_prod A B) ===> rel_set (rel_prod A B))
     scaleR2 scaleR2"
   if [unfolded Rel_def, transfer_rule]: "((=) ===> B ===> B) (*\<^sub>R) (*\<^sub>R)"
   unfolding scaleR2_def
   by transfer_prover
 lemma scaleR_rel_blinfun_transfer[transfer_rule]: "((=) ===> rel_blinfun rel_ve rel_ve ===> rel_blinfun rel_ve rel_ve) (*\<^sub>R) (*\<^sub>R)"
   apply (auto intro!: rel_funI simp: rel_blinfun_def blinfun.bilinear_simps)
   apply (drule rel_funD)
    apply assumption
   apply (rule scaleR_transfer[THEN rel_funD, THEN rel_funD])
    apply auto
   done
 lemma c1_info_of_appre_transfer[transfer_rule]:
   "(rel_prod (rel_prod (=) (=)) (rel_prod (list_all2 (=)) (rel_option (list_all2 (=)))) ===>
       rel_set (rel_prod rel_ve (rel_blinfun rel_ve rel_ve)))
     aform.c1_info_of_appre
     aform.c1_info_of_appre"
   unfolding aform.c1_info_of_appre_def
   by transfer_prover
 
 lemma c1_info_of_apprs_transfer[transfer_rule]:
   "((=) ===> rel_set (rel_prod rel_ve (rel_blinfun rel_ve rel_ve)))
     aform.c1_info_of_apprs
     aform.c1_info_of_apprs"
   unfolding aform.c1_info_of_apprs_def
   by transfer_prover
 lemma c1_info_of_appr'_transfer[transfer_rule]:
   "(rel_option (list_all2 (=)) ===> rel_set (rel_prod rel_ve (rel_blinfun rel_ve rel_ve)))
     aform.c1_info_of_appr' aform.c1_info_of_appr'"
   unfolding aform.c1_info_of_appr'_def
   by transfer_prover
 
 lemma c0_info_of_apprs_transfer[transfer_rule]:
   "((=) ===> rel_set rel_ve)
     aform.c0_info_of_apprs
     aform.c0_info_of_apprs"
   unfolding aform.c0_info_of_apprs_def
   by transfer_prover
 lemma c0_info_of_appr'_transfer[transfer_rule]:
   "(rel_option (list_all2 (=)) ===> rel_set rel_ve)
     aform.c0_info_of_appr' aform.c0_info_of_appr'"
   unfolding aform.c0_info_of_appr'_def
   by transfer_prover
 
 lemma aform_Csafe_vX[simp]: "aform.Csafe odo = (vX::'n rvec set)"
   by (simp add: vX_def cast_safe_set)
 
 definition blinfuns_of_lvivl::"real list \<times> real list \<Rightarrow> ('b \<Rightarrow>\<^sub>L 'b::executable_euclidean_space) set"
   where "blinfuns_of_lvivl x = blinfun_of_list ` list_interval (fst x) (snd x)"
 
 lemma blinfun_of_list_transfer[transfer_rule]:
   "(list_all2 (=) ===> rel_blinfun rel_ve rel_ve) blinfun_of_list blinfun_of_list"
   unfolding blinfun_of_list_def
   by transfer_prover
 
 lemma blinfuns_of_lvivl_transfer[transfer_rule]:
   "(rel_prod (list_all2 (=)) (list_all2 (=)) ===> rel_set (rel_blinfun rel_ve rel_ve))
     blinfuns_of_lvivl
     blinfuns_of_lvivl"
   unfolding blinfuns_of_lvivl_def
   by transfer_prover
 
 definition "blinfuns_of_lvivl' x = (case x of None \<Rightarrow> UNIV | Some x \<Rightarrow> blinfuns_of_lvivl x)"
 
 lemma blinfuns_of_lvivl'_transfer[transfer_rule]:
   "(rel_option (rel_prod (list_all2 (=)) (list_all2 (=))) ===> rel_set (rel_blinfun rel_ve rel_ve))
     blinfuns_of_lvivl'
     blinfuns_of_lvivl'"
   unfolding blinfuns_of_lvivl'_def
   by transfer_prover
 
 
 lemma atLeastAtMost_transfer[transfer_rule]:
   "(A ===> A ===> rel_set A) atLeastAtMost atLeastAtMost"
   if [transfer_rule]: "(A ===> A ===> (=)) (\<le>) (\<le>)" "bi_total A" "bi_unique A"
   unfolding atLeastAtMost_def atLeast_def atMost_def
   by transfer_prover
 
 lemma set_of_ivl_transfer[transfer_rule]:
   "(rel_prod A A ===> rel_set A) set_of_ivl set_of_ivl"
   if [transfer_rule]: "(A ===> A ===> (=)) (\<le>) (\<le>)" "bi_total A" "bi_unique A"
   unfolding set_of_ivl_def
   by transfer_prover
 
 lemma set_of_lvivl_transfer[transfer_rule]:
   "(rel_prod (list_all2 (=)) (list_all2 (=)) ===> rel_set rel_ve) set_of_lvivl set_of_lvivl"
   unfolding set_of_lvivl_def
   by transfer_prover
 
 lemma set_of_lvivl_eq: "set_of_lvivl I =
     (eucl_of_list ` list_interval (fst I) (snd I)::'b::executable_euclidean_space set)"
   if [simp]: "length (fst I) = DIM('b)" "length (snd I) = DIM('b)"
 proof (auto simp: set_of_lvivl_def list_interval_def set_of_ivl_def, goal_cases)
   case (1 x)
   with lv_rel_le[where 'a='b, param_fo, OF lv_relI lv_relI, of  "fst I" "list_of_eucl x"]
     lv_rel_le[where 'a='b, param_fo, OF lv_relI lv_relI, of "list_of_eucl x" "snd I"]
   show ?case by force
 next
   case (2 x)
   with lv_rel_le[where 'a='b, param_fo, OF lv_relI lv_relI, of  "fst I" "x"]
   show ?case by (auto simp: list_all2_lengthD)
 next
   case (3 x)
   with lv_rel_le[where 'a='b, param_fo, OF lv_relI lv_relI, of "x" "snd I"]
   show ?case by (auto simp: list_all2_lengthD)
 qed
 
 lemma bounded_linear_matrix_vector_mul[THEN bounded_linear_compose, bounded_linear_intros]:
   "bounded_linear ((*v) x)" for x::"real^'x^'y"
   unfolding linear_linear
   by (rule matrix_vector_mul_linear)
 
 lemma blinfun_of_list_eq: "blinfun_of_list x = blinfun_of_vmatrix (eucl_of_list x::((real, 'b) vec, 'b) vec)"
   if "length x = CARD('b::enum)*CARD('b)"
   unfolding blinfun_of_list_def
   apply (transfer fixing: x)
   apply (rule linear_eq_stdbasis)
   unfolding linear_conv_bounded_linear
     apply (auto intro!: bounded_linear_intros)
 proof goal_cases
   case (1 b)
   have "(eucl_of_list x::((real, 'b) vec, 'b) vec) *v b = (eucl_of_list x::((real, 'b) vec, 'b) vec) *v eucl_of_list (list_of_eucl b)"
     by simp
   also have "\<dots> = (\<Sum>i<CARD('b).
         (\<Sum>j<CARD('b). x ! (i * CARD('b) + j) * (b \<bullet> Basis_list ! j)) *\<^sub>R Basis_list ! i)"
     by (subst eucl_of_list_matrix_vector_mult_eq_sum_nth_Basis_list)
       (auto simp: that)
   also have "\<dots> = (\<Sum>i\<in>Basis.
        \<Sum>j\<in>Basis. (b \<bullet> j * x ! (index Basis_list i * CARD('b) + index Basis_list j)) *\<^sub>R i)"
     apply (subst sum_list_Basis_list[symmetric])+
     apply (subst sum_list_sum_nth)+
     by (auto simp add: atLeast0LessThan scaleR_sum_left intro!: sum.cong)
   finally show ?case by simp
 qed
 
 lemma blinfuns_of_lvivl_eq: "blinfuns_of_lvivl x =
     (blinfun_of_vmatrix ` set_of_lvivl x::((real, 'b) vec \<Rightarrow>\<^sub>L (real, 'b) vec) set)"
   if "length (fst x) = CARD('b::enum)*CARD('b)" "length (snd x) = CARD('b)*CARD('b)"
   apply (subst set_of_lvivl_eq)
   subgoal by (simp add: that)
   subgoal by (simp add: that)
   unfolding blinfuns_of_lvivl_def image_image
   by (auto simp: that blinfun_of_list_eq[symmetric] in_list_interval_lengthD cong: image_cong)
 
 lemma range_blinfun_of_vmatrix[simp]: "range blinfun_of_vmatrix = UNIV"
   apply auto
   apply transfer
   subgoal for x by (rule image_eqI[where x="matrix x"]) auto
   done
 
 lemma blinfun_of_vmatrix_image:
   "blinfun_of_vmatrix ` aform.set_of_lvivl' x =
     (blinfuns_of_lvivl' x::((real, 'b) vec \<Rightarrow>\<^sub>L (real, 'b) vec) set)"
   if "aform.lvivl'_invar (CARD('b)*CARD('b::enum)) x"
   using that
   by (auto simp: aform.set_of_lvivl'_def blinfuns_of_lvivl'_def blinfuns_of_lvivl_eq 
     aform.lvivl'_invar_def
       split: option.splits)
 
 lemma one_step_result123:
   "solves_one_step_until_time_aform optns odo X0i t1 t2 E dE \<Longrightarrow>
     (x0, d0) \<in> aform.c1_info_of_appre X0i \<Longrightarrow>
     t \<in> {t1 .. t2} \<Longrightarrow>
     set_of_lvivl E \<subseteq> S \<Longrightarrow>
     blinfuns_of_lvivl' dE \<subseteq> dS \<Longrightarrow>
     length (fst E) = CARD('n) \<Longrightarrow> length (snd E) = CARD('n) \<Longrightarrow>
     aform.lvivl'_invar (CARD('n) * CARD('n)) dE \<Longrightarrow>
     aform.c1_info_invare DIM('a) X0i \<Longrightarrow>
     aform.D odo = DIM('a) \<Longrightarrow>
       (t \<in> existence_ivl0 (x0::'a) \<and> flow0 x0 t \<in> S) \<and> Dflow x0 t o\<^sub>L d0 \<in> dS"
   apply (transfer fixing: optns X0i t1 t2 t E dE)
   subgoal premises prems for x0 d0 S dS
   proof -
     have "t \<in> aform.existence_ivl0 odo x0 \<and> aform.flow0 odo x0 t \<in> S \<and> aform.Dflow odo x0 t o\<^sub>L d0 \<in> dS"
       apply (rule one_step_in_ivl[of t t1 t2 x0 d0 X0i "fst E" "snd E" S dE dS odo optns])
       using prems
       by (auto simp: eucl_of_list_prod set_of_lvivl_def set_of_ivl_def blinfun_of_vmatrix_image aform.D_def
           solves_one_step_until_time_aform_def)
     with vflow_eq[of t x0] vDflow_eq[of t x0] vex_ivl_eq[symmetric, of t x0] 
     show ?thesis
       by simp
   qed
   done
 
 lemmas one_step_result12 = one_step_result123[THEN conjunct1]
   and one_step_result3 = one_step_result123[THEN conjunct2]
 lemmas one_step_result1 = one_step_result12[THEN conjunct1]
   and one_step_result2 = one_step_result12[THEN conjunct2]
 
 lemma plane_of_transfer[transfer_rule]: "(rel_sctn A ===> rel_set A) plane_of plane_of"
   if [transfer_rule]: "(A ===> A ===> (=)) (\<bullet>) (\<bullet>)" "bi_total A"
   unfolding plane_of_def
   by transfer_prover
 
 lemma below_halfspace_transfer[transfer_rule]: "(rel_sctn A ===> rel_set A) below_halfspace below_halfspace"
   if [transfer_rule]: "(A ===> A ===> (=)) (\<bullet>) (\<bullet>)" "bi_total A"
   unfolding below_halfspace_def le_halfspace_def
   by transfer_prover
 
 definition "rel_nres A a b \<longleftrightarrow> (a, b) \<in> \<langle>{(a, b). A a b}\<rangle>nres_rel"
 
 lemma FAILi_transfer[transfer_rule]: "(rel_nres B) FAILi FAILi"
   by (auto simp: rel_nres_def nres_rel_def)
 
 lemma RES_transfer[transfer_rule]: "(rel_set B ===> rel_nres B) RES RES"
   by (auto simp: rel_nres_def nres_rel_def rel_set_def intro!: rel_funI RES_refine)
 
 context includes autoref_syntax begin
 lemma RETURN_dres_nres_relI:
   "(fi, f) \<in> A \<rightarrow> B \<Longrightarrow> (\<lambda>x. dRETURN (fi x), (\<lambda>x. RETURN (f x))) \<in> A \<rightarrow> \<langle>B\<rangle>dres_nres_rel"
   by (auto simp: dres_nres_rel_def dest: fun_relD)
 end
 
 lemma br_transfer[transfer_rule]:
   "((B ===> C) ===> (B ===> (=)) ===> rel_set (rel_prod B C)) br br"
   if [transfer_rule]: "bi_total B"  "bi_unique C" "bi_total C"
   unfolding br_def
   by transfer_prover
 
 lemma aform_appr_rel_transfer[transfer_rule]:
   "(rel_set (rel_prod (list_all2 (=)) (rel_set rel_ve))) aform.appr_rel aform.appr_rel"
   unfolding aform.appr_rel_br
   by (transfer_prover)
 
 lemma appr1_rel_transfer[transfer_rule]: "(rel_set (rel_prod
   (rel_prod (list_all2 (=)) (rel_option (list_all2 (=))))
   (rel_set (rel_prod rel_ve (rel_blinfun rel_ve rel_ve))))) aform.appr1_rel aform.appr1_rel"
   unfolding aform.appr1_rel_internal
   by transfer_prover
 
 lemma relAPP_transfer[transfer_rule]:
   "((rel_set (rel_prod B C) ===> D) ===> rel_set (rel_prod B C) ===> D) Relators.relAPP Relators.relAPP"
   unfolding relAPP_def
   by transfer_prover
 
 lemma prod_rel_transfer[transfer_rule]:
   "(rel_set (rel_prod B C) ===> rel_set (rel_prod D E) ===> rel_set (rel_prod (rel_prod B D) (rel_prod C E)))
     prod_rel prod_rel"
   if [transfer_rule]:
   "bi_total B" "bi_unique B"
   "bi_unique C" "bi_total C"
   "bi_unique D" "bi_total D"
   "bi_unique E" "bi_total E"
   unfolding prod_rel_def_internal
   by transfer_prover
 
 lemma Domain_transfer[transfer_rule]:
   "(rel_set (rel_prod A B) ===> rel_set A) Domain Domain"
   if [transfer_rule]:
   "bi_total A" "bi_unique A"
   "bi_total B" "bi_unique B"
   unfolding Domain_unfold
   by transfer_prover
 
 lemma set_rel_transfer[transfer_rule]:
   "(rel_set (rel_prod B C) ===> rel_set (rel_prod (rel_set B) (rel_set C))) set_rel set_rel"
   if [transfer_rule]:
   "bi_total B" "bi_unique B"
   "bi_unique C" "bi_total C"
   unfolding set_rel_def_internal
   by transfer_prover
 
 lemma relcomp_transfer[transfer_rule]:
   "(rel_set (rel_prod B C) ===> rel_set (rel_prod C D) ===> rel_set (rel_prod B D)) relcomp relcomp"
   if [transfer_rule]:
   "bi_total B" "bi_unique B"
   "bi_unique C" "bi_total C"
   "bi_unique D" "bi_total D"
   unfolding relcomp_unfold
   by transfer_prover
 
 lemma Union_rel_transfer[transfer_rule]:
   "(rel_set (rel_prod B (rel_set C)) ===> rel_set (rel_prod C (rel_set D)) ===> rel_set (rel_prod B (rel_set D)))
     Union_rel Union_rel"
   if [transfer_rule]:
   "bi_total B" "bi_unique B"
   "bi_unique C" "bi_total C"
   "bi_unique D" "bi_total D"
   unfolding Union_rel_internal top_fun_def top_bool_def
   by transfer_prover
 
 lemma fun_rel_transfer[transfer_rule]:
   "(rel_set (rel_prod B C) ===> rel_set (rel_prod D E) ===> rel_set (rel_prod (B ===> D) (C ===> E))) Relators.fun_rel Relators.fun_rel"
   if [transfer_rule]:
   "bi_unique B"
   "bi_unique C"
   "bi_unique D" "bi_total D"
   "bi_unique E" "bi_total E"
   unfolding fun_rel_def_internal
   by transfer_prover
 
 lemma c1_info_of_apprse_transfer[transfer_rule]:
   "(list_all2 (rel_prod (rel_prod (=) (=)) (rel_prod (list_all2 (=)) (rel_option (list_all2 (=)))))
     ===> rel_set (rel_prod rel_ve (rel_blinfun rel_ve rel_ve)))
     aform.c1_info_of_apprse
     aform.c1_info_of_apprse"
   unfolding aform.c1_info_of_apprse_def
   by transfer_prover
 
 term scaleR2_rel
 (*
 "scaleR2_rel"
   ::
   "('b \<times> ('c \<times> 'd) set) set
    \<Rightarrow> (((ereal \<times> ereal) \<times> 'b) \<times> ('c \<times> 'd) set) set"
 *)
 lemma scaleR2_rel_transfer[transfer_rule]:
   "(rel_set (rel_prod (=) (rel_set (rel_prod (=) (=)))) ===>
     rel_set (rel_prod (rel_prod (rel_prod (=) (=)) (=)) (rel_set (rel_prod (=) (=))))) scaleR2_rel scaleR2_rel"
   unfolding scaleR2_rel_internal
   by transfer_prover
 
 lemma appr1_rele_transfer[transfer_rule]:
   "(rel_set (rel_prod
     (rel_prod (rel_prod (=) (=)) (rel_prod (list_all2 (=)) (rel_option (list_all2 (=)))))
     (rel_set (rel_prod rel_ve (rel_blinfun rel_ve rel_ve))))) aform.appr1e_rel aform.appr1e_rel"
   unfolding scaleR2_rel_internal
   by transfer_prover
 
 lemma flow1_of_vec1_times: "flow1_of_vec1 ` (A \<times> B) = A \<times> blinfun_of_vmatrix ` B"
   by (auto simp: flow1_of_vec1_def vec1_of_flow1_def)
 
 lemma stable_on_transfer[transfer_rule]:
   "(rel_set rel_ve ===> rel_set rel_ve ===> (=)) v.stable_on stable_on"
   unfolding stable_on_def v.stable_on_def
   by transfer_prover
 
 theorem solves_poincare_map_aform:
   "solves_poincare_map_aform optns odo (\<lambda>x. dRETURN (symstart x)) [S] guards ivl sctn roi XS RET dRET \<Longrightarrow>
     (symstart, symstarta) \<in> fun_rel (aform.appr1e_rel) (clw_rel aform.appr_rel \<times>\<^sub>r clw_rel aform.appr1e_rel) \<Longrightarrow>
     (\<And>X0. (\<lambda>(CX, X). flowsto (X0 - trap \<times> UNIV) {0..} (CX \<times> UNIV) X) (symstarta X0)) \<Longrightarrow>
     stable_on (aform.Csafe odo - set_of_lvivl ivl \<inter> plane_of (map_sctn eucl_of_list sctn)) trap \<Longrightarrow>
     (\<And>X. X \<in> set XS \<Longrightarrow> aform.c1_info_invare DIM('a) X) \<Longrightarrow>
     aform.D odo = DIM('a) \<Longrightarrow>
     length (normal sctn) = DIM('a) \<Longrightarrow>
     length (fst ivl) = DIM('a) \<Longrightarrow>
     length (snd ivl) = DIM('a) \<Longrightarrow>
     length (normal S) = DIM('a) \<Longrightarrow>
     (\<And>a xs b ba ro.
         (xs, ro) \<in> set guards \<Longrightarrow>
         ((a, b), ba) \<in> set xs \<Longrightarrow>
         length a = DIM('a) \<and>
         length b = DIM('a) \<and> length (normal ba) = DIM('a)) \<Longrightarrow>
     length (fst RET) = CARD('n) \<Longrightarrow> length (snd RET) = CARD('n) \<Longrightarrow>
     aform.lvivl'_invar (CARD('n) * CARD('n)) dRET \<Longrightarrow>
     poincare_mapsto
      ((set_of_lvivl ivl::('a set)) \<inter> plane_of (map_sctn eucl_of_list sctn))
      (aform.c1_info_of_apprse XS - trap \<times> UNIV)
      (below_halfspace (map_sctn eucl_of_list S))
      (aform.Csafe odo -
       set_of_lvivl ivl \<inter> plane_of (map_sctn eucl_of_list sctn))
      (set_of_lvivl RET \<times> blinfuns_of_lvivl' dRET)"
   apply (transfer fixing: optns symstart S guards ivl sctn roi XS RET dRET)
   subgoal premises prems for symstarta trap
   proof -
     have "aform.poincare_mapsto odo (set_of_lvivl ivl \<inter> plane_of (map_sctn eucl_of_list sctn))
      (aform.c1_info_of_apprse XS - trap \<times> UNIV) (below_halfspace (map_sctn eucl_of_list S))
      (aform.Csafe odo - set_of_lvivl ivl \<inter> plane_of (map_sctn eucl_of_list sctn))
      (flow1_of_vec1 ` ({eucl_of_list (fst RET)..eucl_of_list (snd RET)} \<times> aform.set_of_lvivl' dRET))"
       apply (rule solves_poincare_map[OF _ RETURN_dres_nres_relI RETURN_rule,
         of optns odo symstart S guards ivl sctn roi XS "fst RET" "snd RET" dRET symstarta trap])
       subgoal using prems(1) by (simp add: solves_poincare_map_aform_def)
       subgoal using prems(2) by (auto simp: fun_rel_def_internal)
       subgoal for X0
         using prems(3)[of X0] vflowsto_eq
         by auto
       subgoal
         unfolding aform.stable_on_def
       proof (safe, goal_cases)
         case (1 t x0)
         from 1 have a: "t \<in> v.existence_ivl0 x0" using vex_ivl_eq by blast
         with 1 have b: "v.flow0 x0 t \<in> trap" using vflow_eq by simp
         have c: "v.flow0 x0 s \<in> vX - set_of_lvivl ivl \<inter> plane_of (map_sctn eucl_of_list sctn)"
           if s: "s \<in> {0<..t}"
           for s
           using 1(4)[rule_format, OF s]
           apply (subst (asm) vflow_eq)
           unfolding aform_Csafe_vX[symmetric]
           using s a
           by (auto dest!: a.v.ivl_subset_existence_ivl)
         from a b c show ?case 
           using prems(4)[unfolded v.stable_on_def, rule_format, OF b a 1(3) c]
           by simp
       qed
       subgoal using prems by auto
       subgoal using prems by (auto simp: aform.D_def)
       subgoal using prems by auto
       subgoal using prems by auto
       subgoal using prems by auto
       subgoal using prems by auto
       subgoal using prems by auto
       subgoal using prems by auto
       subgoal using prems by auto
       subgoal using prems by auto
       done
     then show ?thesis
       using vflow_eq vex_ivl_eq vflowsto_eq prems
       apply (subst vpoincare_mapsto_eq[symmetric])
       by (auto simp: set_of_lvivl_def set_of_ivl_def blinfun_of_vmatrix_image flow1_of_vec1_times)
   qed
   done
 
 theorem solves_poincare_map_aform':
   "solves_poincare_map_aform' optns odo S guards ivl sctn roi XS RET dRET\<Longrightarrow>
     (\<And>X. X \<in> set XS \<Longrightarrow> aform.c1_info_invare DIM('a) X) \<Longrightarrow>
     aform.D odo = DIM('a) \<Longrightarrow>
     length (normal sctn) = DIM('a) \<Longrightarrow>
     length (fst ivl) = DIM('a) \<Longrightarrow>
     length (snd ivl) = DIM('a) \<Longrightarrow>
     length (normal S) = DIM('a) \<Longrightarrow>
     (\<And>a xs b ba ro.
         (xs, ro) \<in> set guards \<Longrightarrow>
         ((a, b), ba) \<in> set xs \<Longrightarrow>
         length a = DIM('a) \<and>
         length b = DIM('a) \<and> length (normal ba) = DIM('a)) \<Longrightarrow>
     length (fst RET) = CARD('n) \<Longrightarrow> length (snd RET) = CARD('n) \<Longrightarrow>
     aform.lvivl'_invar (CARD('n) * CARD('n)) dRET \<Longrightarrow>
     poincare_mapsto
      ((set_of_lvivl ivl::('a set)) \<inter> plane_of (map_sctn eucl_of_list sctn))
      (aform.c1_info_of_apprse XS)
      (below_halfspace (map_sctn eucl_of_list S))
      (aform.Csafe odo -
       set_of_lvivl ivl \<inter> plane_of (map_sctn eucl_of_list sctn))
      (set_of_lvivl RET \<times> blinfuns_of_lvivl' dRET)"
   apply (transfer fixing: optns S guards ivl sctn roi XS RET dRET)
   subgoal
     using solves_poincare_map'[of optns odo S guards ivl sctn roi XS "fst RET" "snd RET" dRET]
     using vflow_eq vex_ivl_eq vflowsto_eq
     apply (subst vpoincare_mapsto_eq[symmetric])
     by (auto intro!: closed_Int simp: set_of_lvivl_def set_of_ivl_def blinfun_of_vmatrix_image
         flow1_of_vec1_times aform.D_def solves_poincare_map_aform'_def)
   done
 
 theorem solves_poincare_map_onto_aform:
   "solves_poincare_map_onto_aform optns odo guards ivl sctn roi XS RET dRET\<Longrightarrow>
     (\<And>X. X \<in> set XS \<Longrightarrow> aform.c1_info_invare DIM('a) X) \<Longrightarrow>
     aform.D odo = DIM('a) \<Longrightarrow>
     length (normal sctn) = DIM('a) \<Longrightarrow>
     length (fst ivl) = DIM('a) \<Longrightarrow>
     length (snd ivl) = DIM('a) \<Longrightarrow>
     (\<And>a xs b ba ro.
         (xs, ro) \<in> set guards \<Longrightarrow>
         ((a, b), ba) \<in> set xs \<Longrightarrow>
         length a = DIM('a) \<and>
         length b = DIM('a) \<and> length (normal ba) = DIM('a)) \<Longrightarrow>
     length (fst RET) = CARD('n) \<Longrightarrow> length (snd RET) = CARD('n) \<Longrightarrow>
     aform.lvivl'_invar (CARD('n) * CARD('n)) dRET \<Longrightarrow>
     poincare_mapsto
      ((set_of_lvivl ivl::('a set)) \<inter> plane_of (map_sctn eucl_of_list sctn))
      (aform.c1_info_of_apprse XS)
      UNIV
      (aform.Csafe odo -
       set_of_lvivl ivl \<inter> plane_of (map_sctn eucl_of_list sctn))
      (set_of_lvivl RET \<times> blinfuns_of_lvivl' dRET)"
   apply (transfer fixing: optns guards ivl sctn roi XS RET dRET)
   subgoal
     using solves_poincare_map_onto[of optns odo guards ivl sctn roi XS "fst RET" "snd RET" dRET, where 'n='n,
           unfolded aform.poincare_maps_onto_def]
     using vflow_eq vex_ivl_eq vflowsto_eq
     apply (subst vpoincare_mapsto_eq[symmetric])
     by (auto intro!: closed_Int simp: set_of_lvivl_def set_of_ivl_def blinfun_of_vmatrix_image
         flow1_of_vec1_times aform.D_def solves_poincare_map_onto_aform_def)
   done
 
 end
 
 end
 
 subsection \<open>Example Utilities!\<close>
 
 hide_const floatarith.Max floatarith.Min
 
 lemma degree_sum_pdevs_scaleR_Basis:
   "degree (sum_pdevs (\<lambda>i. pdevs_scaleR (a i) i) (Basis::'b::euclidean_space set)) = Max ((\<lambda>i. degree (a i)) ` Basis)"
   apply (rule antisym)
   subgoal apply (rule degree_le)
     by (auto )
   subgoal
     apply (rule Max.boundedI)
       apply simp
      apply simp
     apply (auto simp: intro!: degree_leI)
     by (auto simp: euclidean_eq_iff[where 'a='b])
   done
 
 lemma Inf_aform_eucl_of_list_aform:
   assumes "length a = DIM('b::executable_euclidean_space)"
   shows "Inf_aform (eucl_of_list_aform a::'b aform) = eucl_of_list (map Inf_aform a)"
   using assms
   apply (auto simp: eucl_of_list_aform_def Inf_aform_def[abs_def] algebra_simps
       eucl_of_list_inner inner_sum_left
       intro!: euclidean_eqI[where 'a='b])
   apply (auto simp: tdev_def inner_sum_left abs_inner inner_Basis if_distrib cong: if_cong)
   apply (rule sum.mono_neutral_cong_left)
      apply simp
   by (auto simp: degree_sum_pdevs_scaleR_Basis)
 
 lemma Sup_aform_eucl_of_list_aform:
   assumes "length a = DIM('b::executable_euclidean_space)"
   shows "Sup_aform (eucl_of_list_aform a::'b aform) = eucl_of_list (map Sup_aform a)"
   using assms
   apply (auto simp: eucl_of_list_aform_def Sup_aform_def[abs_def] algebra_simps
       eucl_of_list_inner inner_sum_left
       intro!: euclidean_eqI[where 'a='b])
   apply (auto simp: tdev_def inner_sum_left abs_inner inner_Basis if_distrib cong: if_cong)
   apply (rule sum.mono_neutral_cong_right)
      apply simp
   by (auto simp: degree_sum_pdevs_scaleR_Basis)
 
 lemma
   eucl_of_list_map_Inf_aform_leI:
   assumes "x \<in> Affine (eucl_of_list_aform a::'b::executable_euclidean_space aform)"
   assumes "length a = DIM('b)"
   shows "eucl_of_list (map Inf_aform a) \<le> x"
   using Inf_aform_le_Affine[OF assms(1)] assms(2)
   by (auto simp: Inf_aform_eucl_of_list_aform)
 
 lemma
   eucl_of_list_map_Sup_aform_geI:
   assumes "x \<in> Affine (eucl_of_list_aform a::'b::executable_euclidean_space aform)"
   assumes "length a = DIM('b)"
   shows "x \<le> eucl_of_list (map Sup_aform a)"
   using Sup_aform_ge_Affine[OF assms(1)] assms(2)
   by (auto simp: Sup_aform_eucl_of_list_aform)
 
 lemma
   mem_Joints_appendE:
   assumes "x \<in> Joints (xs @ ys)"
   obtains x1 x2 where "x = x1 @ x2" "x1 \<in> Joints xs" "x2 \<in> Joints ys"
   using assms
   by (auto simp: Joints_def valuate_def)
 
 lemma c1_info_of_appr_subsetI1:
   fixes X1::"'b::executable_euclidean_space set"
   assumes subset: "{eucl_of_list (map Inf_aform (fst R)) .. eucl_of_list (map Sup_aform (fst R))} \<subseteq> X1"
   assumes len: "length (fst R) = DIM('b)"
   shows "aform.c1_info_of_appr R \<subseteq> X1 \<times> UNIV"
   using len
   apply (auto simp: aform.c1_info_of_appr_def flow1_of_list_def
       split: option.splits
       intro!: subsetD[OF subset] elim!: mem_Joints_appendE)
   subgoal
     by (auto intro!: eucl_of_list_mem_eucl_of_list_aform eucl_of_list_map_Inf_aform_leI eucl_of_list_map_Sup_aform_geI)
   subgoal
     by (auto intro!: eucl_of_list_mem_eucl_of_list_aform eucl_of_list_map_Inf_aform_leI eucl_of_list_map_Sup_aform_geI)
   subgoal
     apply (subst (2) eucl_of_list_take_DIM[symmetric, OF refl])
       apply (auto simp: min_def)
     apply (simp add: Joints_imp_length_eq eucl_of_list_map_Inf_aform_leI eucl_of_list_mem_eucl_of_list_aform)
     apply (simp add: Joints_imp_length_eq eucl_of_list_map_Inf_aform_leI eucl_of_list_mem_eucl_of_list_aform)
       done
   subgoal
     apply (subst (2) eucl_of_list_take_DIM[symmetric, OF refl])
       apply (auto simp: min_def)
     by (simp add: Joints_imp_length_eq eucl_of_list_map_Sup_aform_geI eucl_of_list_mem_eucl_of_list_aform)
   done
 
 lemmas [simp] = compute_tdev
 
 syntax product_aforms::"(real aform) list \<Rightarrow> (real aform) list \<Rightarrow> (real aform) list"
   (infixr "\<times>\<^sub>a" 70)
 
 lemma matrix_inner_Basis_list:
   includes vec_syntax
   assumes "k < CARD('n) * CARD('m)"
   shows "(f::(('n::enum rvec, 'm::enum) vec)) \<bullet> Basis_list ! k =
     vec_nth (vec_nth f (enum_class.enum ! (k div CARD('n)))) (enum_class.enum ! (k mod CARD('n)))"
 proof -
   have "f \<bullet> Basis_list ! k =
     (\<Sum>x\<in>UNIV.
        \<Sum>xa\<in>UNIV.
          if enum_class.enum ! (k mod CARD('n)) = xa \<and> enum_class.enum ! (k div CARD('n)) = x then f $ x $ xa else 0)"
     using assms
     unfolding inner_vec_def
     apply (auto simp: Basis_list_vec_def concat_map_map_index)
     apply (subst (2) sum.cong[OF refl])
      apply (subst sum.cong[OF refl])
       apply (subst (2) vec_nth_Basis2)
        apply (force simp add: Basis_vec_def Basis_list_real_def)
       apply (rule refl)
      apply (rule refl)
     apply (auto simp: if_distribR if_distrib axis_eq_axis Basis_list_real_def cong: if_cong)
     done
   also have "\<dots> = f $ enum_class.enum ! (k div CARD('n)) $ enum_class.enum ! (k mod CARD('n))"
     apply (subst if_conn)
     apply (subst sum.delta')
      apply simp
     by (simp add: sum.delta')
   finally show ?thesis by simp
 qed
 
 lemma list_of_eucl_matrix:
   includes vec_syntax
   shows "(list_of_eucl (M::(('n::enum rvec, 'm::enum) vec))) =
     concat (map (\<lambda>i. map (\<lambda>j. M $ (enum_class.enum ! i)$ (enum_class.enum ! j) )
       [0..<CARD('n)]) [0..<CARD('m)])"
   by (auto intro!: nth_equalityI simp: length_concat o_def sum_list_distinct_conv_sum_set ac_simps
       concat_map_map_index matrix_inner_Basis_list)
 
 lemma axis_eq_eucl_of_list:
   "(axis i 1::'n::enum rvec) = eucl_of_list ((replicate CARD('n) 0)[index enum_class.enum i := 1])"
   apply (auto intro!: euclidean_eqI[where 'a="'n rvec"]
       simp: eucl_of_list_inner nth_list_update )
    apply (auto simp: index_Basis_list_axis1[symmetric])
   by (simp add: inner_axis inner_commute vec_nth_Basis)
 
 lemma eucl_of_list_012: "eucl_of_list [vec_nth A 0, vec_nth A 1, vec_nth A 2] = A" for A::"3 rvec"
   apply vector
   apply (auto simp: vec_nth_eucl_of_list_eq index_Basis_list_axis1)
   using exhaust_3 three_eq_zero by blast
 
 
 definition "ldec x = (case quotient_of x of (i, j) \<Rightarrow> real_of_float (lapprox_rat 20 i j))"
 definition "udec x = (case quotient_of x of (i, j) \<Rightarrow> real_of_float (rapprox_rat 20 i j))"
 
 lemma ldec: "ldec x \<le> real_of_rat x"
   and udec: "real_of_rat x \<le> udec x"
    apply (auto simp: ldec_def udec_def split: prod.splits
       intro!: lapprox_rat[le] rapprox_rat[ge])
    apply (metis Fract_of_int_quotient less_eq_real_def less_int_code(1) of_rat_rat
       quotient_of_denom_pos quotient_of_div)
   apply (metis Fract_of_int_quotient less_eq_real_def less_int_code(1) of_rat_rat
       quotient_of_denom_pos quotient_of_div)
   done
 
 context includes floatarith_notation begin
 
 definition "matrix_of_degrees\<^sub>e =
   (let
     ur = Rad_of (Var 0);
     vr = Rad_of (Var 1)
    in
     [Cos ur, Cos vr, 0,
      Sin ur, Sin vr, 0,
      0, 0, 0])"
 
 definition "matrix_of_degrees u v =
   approx_floatariths 30 matrix_of_degrees\<^sub>e (aforms_of_point ([u, v, 0]))"
 
 lemma interpret_floatariths_matrix_of_degrees:
   "interpret_floatariths matrix_of_degrees\<^sub>e
     (([u::real, v::real, 0]))
    =
   [cos (rad_of u), cos (rad_of v), 0,
    sin (rad_of u), sin (rad_of v), 0,
    0, 0, 0]"
   by (auto simp: matrix_of_degrees\<^sub>e_def Let_def inverse_eq_divide)
 
 definition "num_options p sstep m N a projs print_fun =
   \<lparr>
     precision = p,
     adaptive_atol = FloatR 1 (- a),
     adaptive_rtol = FloatR 1 (- a),
     method_id = 2,
     start_stepsize  = FloatR 1 (- sstep),
     iterations = 40,
     halve_stepsizes = 40,
     widening_mod = 10,
     rk2_param = FloatR 1 0,
     default_reduce = correct_girard (p) (m) (N),
     printing_fun = (\<lambda>a b.
         let
            _ = fold (\<lambda>(x, y, c) _.
                print_fun (String.implode (shows_segments_of_aform (x) (y) b c ''\<newline>''))) projs ();
            _ = print_fun (String.implode (''# '' @ shows_box_of_aforms_hr (b) '''' @ ''\<newline>''))
         in
          ()
     ),
     tracing_fun = (\<lambda>a b.
       let
         _ = print_fun (String.implode (''# '' @ a @ ''\<newline>''))
       in case b of Some b \<Rightarrow>
         (let
           _ = ()
         in print_fun (String.implode (''# '' @ shows_box_of_aforms_hr (b) '''' @ ''\<newline>'')))
         | None \<Rightarrow> ())
   \<rparr>"
 
 definition "num_options_c1 p sstep m N a projs dcolors print_fun =
   (let
     no = num_options p sstep m N a (map (\<lambda>(x, y, c, ds). (x, y, c)) projs) print_fun;
     D = length dcolors
   in no
     \<lparr>printing_fun:=
       (\<lambda>a b. let _ = printing_fun no a b
           in if a then ()
           else fold (\<lambda>(x, y, c, ds) _. print_fun
               (String.implode (shows_aforms_vareq D [(x, y)] ds
                 dcolors
                 dcolors
             (FloatR 1 (-1)) ''# no C1 info'' b ''''))) projs ()
       )
     \<rparr>)"
 
 definition "num_options_code p sstep m N a projs print_fun =
   num_options (nat_of_integer p) (int_of_integer sstep) (nat_of_integer m) (nat_of_integer N)
     (int_of_integer a) (map (\<lambda>(i, j, k). (nat_of_integer i, nat_of_integer j, k)) projs) print_fun"
 
 definition "ro s n M g0 g1 inter_step =
   \<lparr>max_tdev_thres = FloatR 1 s,
       pre_split_reduce = correct_girard 30 n M,
       pre_inter_granularity = FloatR 1 g0,
       post_inter_granularity = (FloatR 1 g1),
       pre_collect_granularity = FloatR 1 g0,
       max_intersection_step = FloatR 1 inter_step\<rparr>"
 
 definition "code_ro s n m g0 g1 inter_step =
   ro (int_of_integer s) (nat_of_integer n) (nat_of_integer m) (int_of_integer g0) (int_of_integer g1) (int_of_integer inter_step)"
 
 fun xsec:: "real \<Rightarrow> real \<times> real \<Rightarrow> real \<times> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "xsec x (y0, y1) (z0, z1) = (([x, y0, z0], [x, y1, z1]), Sctn [1,0,0] x)"
 fun xsec':: "real \<Rightarrow> real \<times> real \<Rightarrow> real \<times> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "xsec' x (y0, y1) (z0, z1) = (([x, y0, z0], [x, y1, z1]), Sctn [-1,0,0] (-x))"
 
 fun ysec:: "real \<times> real \<Rightarrow> real \<Rightarrow> real \<times> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "ysec (x0, x1) y (z0, z1) = (([x0, y, z0], [x1, y, z1]), Sctn [0, 1,0] y)"
 fun ysec':: "real \<times> real \<Rightarrow> real \<Rightarrow> real \<times> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "ysec' (x0, x1) y (z0, z1) = (([x0, y, z0], [x1, y, z1]), Sctn [0, -1,0] (-y))"
 
 fun zsec:: "real \<times> real \<Rightarrow> real \<times> real \<Rightarrow> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "zsec (x0, x1) (y0, y1) z = (([x0, y0, z], [x1, y1, z]), Sctn [0, 0, 1] z)"
 fun zsec':: "real \<times> real \<Rightarrow> real \<times> real \<Rightarrow> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "zsec' (x0, x1) (y0, y1) z = (([x0, y0, z], [x1, y1, z]), Sctn [0, 0, -1] (-z))"
 
 
 fun xsec2:: "real \<Rightarrow> real \<times> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "xsec2 x (y0, y1) = (([x, y0], [x, y1]), Sctn [1,0] x)"
 fun xsec2':: "real \<Rightarrow> real \<times> real \<Rightarrow>(real list \<times> real list) \<times> real list sctn"
   where "xsec2' x (y0, y1) = (([x, y0], [x, y1]), Sctn [-1,0] (-x))"
 
 fun ysec2:: "real \<times> real \<Rightarrow> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "ysec2 (x0, x1) y = (([x0, y], [x1, y]), Sctn [0, 1] y)"
 fun ysec2':: "real \<times> real \<Rightarrow> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "ysec2' (x0, x1) y = (([x0, y], [x1, y]), Sctn [0, -1] (-y))"
 
 fun ysec4:: "real \<times> real \<Rightarrow> real \<Rightarrow> real \<times> real \<Rightarrow> real \<times> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "ysec4 (x0, x1) y (z0, z1) (m0, m1) = (([x0, y, z0, m0], [x1, y, z1, m1]), Sctn [0, 1,0, 0] (y))"
 
 fun ysec4':: "real \<times> real \<Rightarrow> real \<Rightarrow> real \<times> real \<Rightarrow> real \<times> real \<Rightarrow> (real list \<times> real list) \<times> real list sctn"
   where "ysec4' (x0, x1) y (z0, z1) (m0, m1) = (([x0, y, z0, m0], [x1, y, z1, m1]), Sctn [0, -1,0, 0] (-y))"
 
 definition "code_sctn N n c = Sctn ((replicate (nat_of_integer N) (0::real))[nat_of_integer n := 1]) c"
 definition "code_sctn' N n c = Sctn ((replicate (nat_of_integer N) (0::real))[nat_of_integer n := -1]) (-c)"
 
 definition "lrat i j = real_of_float (lapprox_rat 30 (int_of_integer i) (int_of_integer j))"
 definition "urat i j = real_of_float (lapprox_rat 30 (int_of_integer i) (int_of_integer j))"
 
 definition [simp]: "TAG_optns (optns::string \<times> ((String.literal \<Rightarrow> unit) \<Rightarrow> (real aform) numeric_options)) = True"
 lemma TAG_optns: "P \<Longrightarrow> (TAG_optns optns \<Longrightarrow> P)"
   by (auto simp: )
 
 definition [simp]: "TAG_reach_optns (roi::real aform reach_options) = True"
 lemma TAG_reach_optns: "P \<Longrightarrow> (TAG_reach_optns optns \<Longrightarrow> P)"
   by (auto simp: )
 
 definition [simp]: "TAG_sctn (b::bool) = True"
 lemma TAG_sctn: "P \<Longrightarrow> (TAG_sctn optns \<Longrightarrow> P)"
   by (auto simp: )
 
 subsection \<open>Integrals and Computation\<close>
 
 lemma has_vderiv_on_PairD:
   assumes "((\<lambda>t. (f t, g t)) has_vderiv_on fg') T"
   shows "(f has_vderiv_on (\<lambda>t. fst (fg' t))) T" "(g has_vderiv_on (\<lambda>t. snd (fg' t))) T"
 proof -
   from assms have "((\<lambda>x. (f x, g x)) has_derivative (\<lambda>xa. xa *\<^sub>R fg' t)) (at t within T)"
      if "t \<in> T" for t
     by (auto simp: has_vderiv_on_def has_vector_derivative_def that
         intro!: derivative_eq_intros)
   from diff_chain_within[OF this has_derivative_fst[OF has_derivative_ident]]
     diff_chain_within[OF this has_derivative_snd[OF has_derivative_ident]]
   show "(f has_vderiv_on (\<lambda>t. fst (fg' t))) T" "(g has_vderiv_on (\<lambda>t. snd (fg' t))) T"
     by (auto simp: has_vderiv_on_def has_vector_derivative_def o_def)
 qed
 
 lemma solves_autonomous_odeI:
   assumes "((\<lambda>t. (t, phi t)) solves_ode (\<lambda>t x. (1, f (fst x) (snd x)))) S (T \<times> X)"
   shows "(phi solves_ode f) S X"
 proof (rule solves_odeI)
   from solves_odeD[OF assms]
   have
     "((\<lambda>t. (t, phi t)) has_vderiv_on (\<lambda>t. (1, f (fst (t, phi t)) (snd (t, phi t))))) S"
     "\<And>t. t \<in> S \<Longrightarrow> (phi t) \<in> X"
     by (auto simp: )
   from has_vderiv_on_PairD(2)[OF this(1)] this(2)
   show "(phi has_vderiv_on (\<lambda>t. f t (phi t))) S" "\<And>t. t \<in> S \<Longrightarrow> phi t \<in> X"
     by auto
 qed
 
 lemma integral_solves_autonomous_odeI:
   fixes f::"real \<Rightarrow> 'a::executable_euclidean_space"
   assumes "(phi solves_ode (\<lambda>t _. f t)) {a .. b} X" "phi a = 0"
   assumes "a \<le> b"
   shows "(f has_integral phi b) {a .. b}"
 proof -
   have "(f has_integral phi b - phi a) {a..b}"
     apply (rule fundamental_theorem_of_calculus[of a b phi f])
     unfolding has_vderiv_on_def[symmetric]
      apply fact
     using solves_odeD[OF assms(1)]
     by (simp add: has_vderiv_on_def)
   then show ?thesis by (simp add: assms)
 qed
 
 lemma zero_eq_eucl_of_list_rep_DIM: "(0::'a::executable_euclidean_space) = eucl_of_list (replicate (DIM('a)) 0)"
   by (auto intro!: euclidean_eqI[where 'a='a] simp: eucl_of_list_inner)
 
 lemma zero_eq_eucl_of_list_rep: "(0::'a::executable_euclidean_space) = eucl_of_list (replicate D 0)"
   if "D \<ge> DIM('a)"
 proof -
   from that have "replicate D (0::real) = replicate (DIM('a)) 0 @ replicate (D - DIM('a)) 0"
     by (auto simp: replicate_add[symmetric])
   also have "eucl_of_list \<dots> = (eucl_of_list (replicate DIM('a) 0)::'a)"
     by (rule eucl_of_list_append_zeroes)
   also have "\<dots> = 0"
     by (rule zero_eq_eucl_of_list_rep_DIM[symmetric])
   finally show ?thesis by simp
 qed
 
 lemma one_has_ivl_integral: "((\<lambda>x. 1::real) has_ivl_integral b - a) a b"
   using has_integral_const_real[of "1::real" a b] has_integral_const_real[of "1::real" b a]
   by (auto simp: has_ivl_integral_def split: if_splits)
 
 lemma Joints_aforms_of_point_self[simp]: "xs \<in> Joints (aforms_of_point xs)"
   by (simp add: aforms_of_point_def)
 
 lemma bind_eq_dRETURN_conv:
   "(f \<bind> g = dRETURN S) \<longleftrightarrow> (\<exists>R. f = dRETURN R \<and> g R = dRETURN S)"
   by (cases f) auto
 
 end
 
 lemma list_of_eucl_memI: "list_of_eucl (x::'x::executable_euclidean_space) \<in> S"
   if "x \<in> eucl_of_list ` S" "\<And>x. x \<in> S \<Longrightarrow> length x = DIM('x)"
   using that
   by auto
 
 lemma Joints_aforms_of_ivls_append_point:
   "Joints (xs @ aforms_of_ivls p p) = (\<lambda>x. x @ p) ` Joints xs"
   using aform.set_of_appr_of_ivl_append_point[unfolded aform_ops_def approximate_set_ops.simps] .
 
 
 context ode_interpretation begin
 
 theorem solves_one_step_ivl:
   assumes T: "T \<subseteq> {t1 .. t2}"
   assumes X: "X \<subseteq> {eucl_of_list lx .. eucl_of_list ux}" "length lx = DIM('a)" "length ux = DIM('a)"
   assumes S: "{eucl_of_list ls::'a .. eucl_of_list us} \<subseteq> S"
   assumes lens: "length ls = DIM('a)" "length us = DIM('a)" \<comment> \<open>TODO: this could be verified\<close>
   assumes [simp]: "aform.D odo = DIM('a)"
   assumes r: "solves_one_step_until_time_aform optns odo ((1,1), aforms_of_ivls lx ux, None) t1 t2 (ls, us) None"
   shows "t \<in> T \<longrightarrow> x0 \<in> X \<longrightarrow> t \<in> existence_ivl0 x0 \<and> flow0 x0 t \<in> S"
 proof (intro impI)
   assume t: "t \<in> T" and x0: "x0 \<in> X"
   from S have S: "set_of_lvivl (ls, us) \<subseteq> S"
     by (auto simp: set_of_lvivl_def set_of_ivl_def)
   have lens: "length (fst (ls, us)) = CARD('n)" "length (snd (ls, us)) = CARD('n)"
     by (auto simp: lens)
   have x0: "list_of_eucl x0 \<in> Joints (aforms_of_ivls lx ux)"
     apply (rule aforms_of_ivls)
     subgoal by (simp add: X)
     subgoal by (simp add: X)
     using subsetD[OF X(1) x0]
     apply (auto simp: eucl_le[where 'a='a] X)
     apply (metis assms(3) dim length_Basis_list list_of_eucl_eucl_of_list list_of_eucl_nth nth_Basis_list_in_Basis)
     apply (metis assms(4) dim length_Basis_list list_of_eucl_eucl_of_list list_of_eucl_nth nth_Basis_list_in_Basis)
     done
   from t T have t: "t \<in> {t1 .. t2}" by auto
   show "t \<in> existence_ivl0 x0 \<and> flow0 x0 t \<in> S"
     by (rule one_step_result12[OF r aform.c1_info_of_appre_c0_I[OF x0] t S subset_UNIV lens])
       (auto simp: aform.c1_info_invare_None lens X)
 qed
 
 theorem solves_one_step_ivl':
   assumes T: "T \<subseteq> {t1 .. t2}"
   assumes X: "X \<subseteq> {eucl_of_list lx .. eucl_of_list ux}"
     "length lx = DIM('a)" "length ux = DIM('a)"
   assumes DS: "list_interval lds uds \<subseteq> list_interval ld ud"
     and lends: "length lds = DIM('a)*DIM('a)" "length uds = DIM('a)*DIM('a)"
   assumes S: "{eucl_of_list ls::'a .. eucl_of_list us} \<subseteq> S"
   assumes lens0: "length ls = DIM('a)" "length us = DIM('a)" \<comment> \<open>TODO: this could be verified\<close>
     "length dx0s = DIM('a)*DIM('a)"
   assumes [simp]: "aform.D odo = DIM('a)"
   assumes r: "solves_one_step_until_time_aform optns odo
     ((1,1), aforms_of_ivls lx ux, Some (aforms_of_point dx0s)) t1 t2 (ls, us) (Some (lds, uds))"
   shows "t \<in> T \<longrightarrow> x0 \<in> X \<longrightarrow> t \<in> existence_ivl0 x0 \<and> flow0 x0 t \<in> S \<and>
     Dflow x0 t o\<^sub>L blinfun_of_list dx0s \<in> blinfuns_of_lvivl (ld, ud)"
 proof (intro impI)
   assume t: "t \<in> T" and x0: "x0 \<in> X"
   from S have S: "set_of_lvivl (ls, us) \<subseteq> S"
     by (auto simp: set_of_lvivl_def set_of_ivl_def)
   have lens: "length (fst (ls, us)) = CARD('n)" "length (snd (ls, us)) = CARD('n)"
     by (auto simp: lens0)
   have x0: "list_of_eucl x0 \<in> Joints (aforms_of_ivls lx ux)"
     apply (rule aforms_of_ivls)
     subgoal by (simp add: X)
     subgoal by (simp add: X)
     using subsetD[OF X(1) x0]
     apply (auto simp: eucl_le[where 'a='a] X)
     apply (metis assms(3) dim length_Basis_list list_of_eucl_eucl_of_list list_of_eucl_nth nth_Basis_list_in_Basis)
     apply (metis assms(4) dim length_Basis_list list_of_eucl_eucl_of_list list_of_eucl_nth nth_Basis_list_in_Basis)
     done
   have x0dx0: "(x0, blinfun_of_list dx0s) \<in>
       aform.c1_info_of_appre ((1, 1), aforms_of_ivls lx ux, Some (aforms_of_point dx0s))"
     apply (auto simp: aform.c1_info_of_appre_def aform.c1_info_of_appr_def)
     apply (rule image_eqI[where x="list_of_eucl x0@dx0s"])
     using lens0
      apply (auto simp: flow1_of_list_def aforms_of_point_def Joints_aforms_of_ivls_append_point)
     apply (rule imageI)
     apply (rule x0)
     done
   from t T have t: "t \<in> {t1 .. t2}" by auto
   have DS: "blinfuns_of_lvivl' (Some (lds, uds)) \<subseteq> blinfun_of_list ` list_interval ld ud"
     using DS
     by (auto simp: blinfuns_of_lvivl'_def blinfuns_of_lvivl_def)
   have inv: "aform.lvivl'_invar (CARD('n) * CARD('n)) (Some (lds, uds))"
     "aform.c1_info_invare DIM('a) ((1::ereal, 1), aforms_of_ivls lx ux, Some (aforms_of_point dx0s))"
     by (auto simp: aform.lvivl'_invar_def lends aform.c1_info_invare_def X lens0 power2_eq_square
         aform.c1_info_invar_def)
   from one_step_result123[OF r x0dx0 t S DS lens inv \<open>aform.D _ = _\<close>]
   show "t \<in> existence_ivl0 x0 \<and> flow0 x0 t \<in> S \<and> Dflow x0 t o\<^sub>L blinfun_of_list dx0s \<in> blinfuns_of_lvivl (ld, ud)"
     by (auto simp: blinfuns_of_lvivl_def)
 qed
 
 end
 
 definition "zero_aforms D = map (\<lambda>_. (0, zero_pdevs)) [0..<D]"
 
 definition "solves_one_step_until_time_aform_fo soptns a b c d e f =
   file_output (String.implode (fst soptns)) (\<lambda>pf. solves_one_step_until_time_aform (snd soptns pf) a b c d e f)"
 
 definition "solves_poincare_map_aform'_fo soptns a b c d e f g h i =
   file_output (String.implode (fst soptns)) (\<lambda>pf. solves_poincare_map_aform' (snd soptns pf) a b c d e f g h i)"
 
 definition "solves_poincare_map_onto_aform_fo soptns a b c d e f g h =
   file_output (String.implode (fst soptns)) (\<lambda>pf. solves_poincare_map_onto_aform (snd soptns pf) a b c d e f g h)"
 
 lemma solves_one_step_until_time_aform_foI:
   "solves_one_step_until_time_aform (snd optns (\<lambda>_. ())) a b c d e f"
   if "solves_one_step_until_time_aform_fo optns a b c d e f"
   using that
   by (auto simp: solves_one_step_until_time_aform_fo_def file_output_def Print.file_output_def
       print_def[abs_def]
       split: if_splits)
 
 lemma solves_poincare_map_aform'_foI:
   "solves_poincare_map_aform' (snd optns (\<lambda>_. ())) a b c d e f g h i"
   if "solves_poincare_map_aform'_fo optns a b c d e f g h i"
   using that
   by (auto simp: solves_poincare_map_aform'_fo_def file_output_def Print.file_output_def
       print_def[abs_def]
       split: if_splits)
 
 lemma solves_poincare_map_onto_aform_foI:
   "solves_poincare_map_onto_aform (snd optns (\<lambda>_. ())) a b c d e f g h"
   if "solves_poincare_map_onto_aform_fo optns a b c d e f g h"
   using that
   by (auto simp: solves_poincare_map_onto_aform_fo_def file_output_def Print.file_output_def
       print_def[abs_def]
       split: if_splits)
 
 definition "can_mk_ode_ops fas safe_form \<longleftrightarrow> mk_ode_ops fas safe_form \<noteq> None"
 
 theorem solve_one_step_until_time_aform_integral_bounds:
   fixes f::"real \<Rightarrow> 'a::executable_euclidean_space"
   assumes "a \<le> b"
   assumes ba: "b - a \<in> {t1 .. t2}"
   assumes a: "a \<in> {a1 .. a2}"
   assumes ls_us_subset: "{eucl_of_list ls .. eucl_of_list us} \<subseteq> {l .. u}"
   assumes fas: "\<And>xs::real list. length xs > 0 \<Longrightarrow> interpret_form safe_form xs \<Longrightarrow>
     (1::real, f (xs ! 0)) = einterpret fas xs"
   assumes D: "D = DIM('a) + 1" "D = CARD('i::enum)"
   assumes lenlu: "length ls + 1 = D" "length us + 1 = D"
   assumes lfas: "length fas = D"
   assumes mv: "can_mk_ode_ops fas safe_form"
   assumes FDERIV: "\<And>xs. interpret_form safe_form xs \<Longrightarrow> isFDERIV (length fas) [0..<length fas] fas xs"
   assumes sos[THEN solves_one_step_until_time_aform_foI]:
     "solves_one_step_until_time_aform_fo optns (the(mk_ode_ops fas safe_form))
       ((1,1), (aforms_of_ivls (a1#replicate (D - 1) 0) (a2#replicate (D - 1) 0)), None) t1 t2 (0#ls, t2#us) None"
   shows "integral {a .. b} f \<in> {l .. u}"
 proof -
   have lens0: "length ((x::real) # replicate (D - 1) 0) = DIM(real \<times> 'a)" for x
     using assms
     by auto
   have a0: "(a, 0) \<in> {eucl_of_list (a1 # replicate (D - 1) 0)..eucl_of_list (a2 # replicate (D - 1) 0)}"
     using assms
     by (auto simp: eucl_of_list_prod)
   let ?U = "{x::real\<times>'a. interpret_form safe_form (list_of_eucl x)}"
   interpret ode_interpretation safe_form ?U fas "\<lambda>x. (1::real, f (fst x))" "undefined::'i"
     apply unfold_locales
     subgoal using assms by simp
     subgoal using assms by simp
     subgoal using mv by (simp add: D lfas)
     subgoal for x
       apply (cases x)
       by (rule HOL.trans[OF fas[symmetric]]) (auto simp: fas)
     subgoal using mv by (simp add: can_mk_ode_ops_def)
     subgoal by (rule FDERIV)
     done
   have lens: "length (0 # ls) = DIM(real \<times> 'a)" "length (t2 # us) = DIM(real \<times> 'a)" "aform.D odo = DIM(real \<times> 'a)"
     using lenlu
     by (simp_all add: lfas aform.D_def D aform.ode_e_def )
   have D_odo: "aform.D odo = DIM(real \<times> 'a)"
     by (auto simp: aform.D_def aform.ode_e_def lfas D)
   from solves_one_step_ivl[rule_format, OF order_refl order_refl lens0 lens0 order_refl lens(1,2) D_odo,
     unfolded odo_def,
     OF sos ba a0]
   have lsus: "flow0 (a, 0) (b - a) \<in> {eucl_of_list (0#ls)..eucl_of_list (t2#us)}"
     and exivl: "b - a \<in> existence_ivl0 (a, 0)"
     by auto
   have flow: "flow0 (a, 0) (b - a) \<in> UNIV \<times> {l..u}"
     using lsus
     apply (rule rev_subsetD)
     using ls_us_subset
     by (auto simp: eucl_of_list_prod)
   from ivl_subset_existence_ivl[OF exivl] \<open>a \<le> b\<close> exivl
   have "0 \<in> existence_ivl0 (a, 0)"
     by (auto simp del: existence_ivl_initial_time_iff)
   from mem_existence_ivl_iv_defined(2)[OF this]
   have safe: "(a, 0::'a) \<in> ?U" by simp
   from flow_solves_ode[OF UNIV_I this]
   have fs: "((\<lambda>t. (fst (flow0 (a, 0) t), snd (flow0 (a, 0) t))) solves_ode (\<lambda>_ x. (1, f (fst x)))) (existence_ivl0 (a, 0)) ?U"
     by simp
   with solves_odeD[OF fs]
   have vdp: "((\<lambda>t. (fst (flow0 (a, 0) t), snd (flow0 (a, 0) t))) has_vderiv_on (\<lambda>t. (1, f (fst (flow0 (a, 0) t))))) (existence_ivl0 (a, 0))"
     by simp
   have "fst (flow0 (a, 0) t) = a + t" if "t \<in> existence_ivl0 (a, 0)" for t
   proof -
     have "fst (flow0 (a, 0) 0) = a" using safe
       by (auto simp: )
     have "((\<lambda>t. fst (flow0 (a, 0) t)) has_vderiv_on (\<lambda>x. 1)) (existence_ivl0 (a, 0))"
       using has_vderiv_on_PairD[OF vdp] by auto
     then have "((\<lambda>t. fst (flow0 (a, 0) t)) has_vderiv_on (\<lambda>x. 1)) {0--t}"
       apply (rule has_vderiv_on_subset)
       using closed_segment_subset_existence_ivl[OF that]
       by auto
     from fundamental_theorem_of_calculus_ivl_integral[OF this, THEN ivl_integral_unique]
       one_has_ivl_integral[of t 0, THEN ivl_integral_unique] safe
     show ?thesis
       by auto
   qed
   with vdp have "((\<lambda>t. (t, snd (flow0 (a, 0) t))) solves_ode (\<lambda>t x. (1, f (a + fst x))))
     (existence_ivl0 (a, 0)) ((existence_ivl0 (a, 0)) \<times> UNIV)"
     apply (intro solves_odeI)
      apply auto
     apply (auto simp: has_vderiv_on_def has_vector_derivative_def)
   proof goal_cases
     case (1 x)
     have r: "((\<lambda>(x, y). (x - a, y::'a)) has_derivative (\<lambda>x. x)) (at x within t)" for x t
       by (auto intro!: derivative_eq_intros)
     from 1 have "((\<lambda>x. (a + x, snd (flow0 (a, 0) x))) has_derivative (\<lambda>xa. (xa, xa *\<^sub>R f (a + x))))
         (at x within existence_ivl0 (a, 0))"
       by auto
     from has_derivative_in_compose2[OF r subset_UNIV _ this, simplified] 1
     have "((\<lambda>x. (x, snd (flow0 (a, 0) x))) has_derivative (\<lambda>y. (y, y *\<^sub>R f (a + x)))) (at x within existence_ivl0 (a, 0))"
       by auto
     then show ?case
       by simp
   qed
   from solves_autonomous_odeI[OF this]
   have "((\<lambda>t. snd (flow0 (a, 0) t)) solves_ode (\<lambda>b c. f (a + b))) (existence_ivl0 (a, 0)) UNIV"
     by simp \<comment> \<open>TODO: do non-autonomous -- autonomous conversion automatically!\<close>
   then have "((\<lambda>t. snd (flow0 (a, 0) t)) solves_ode (\<lambda>b c. f (a + b))) {0 .. b - a} UNIV"
     apply (rule solves_ode_on_subset)
     using exivl
     by (rule ivl_subset_existence_ivl) (rule order_refl)
   from integral_solves_autonomous_odeI[OF this]
   have "((\<lambda>b. f (a + b)) has_integral snd (flow0 (a, 0) (b - a))) (cbox 0 (b - a))"
     using \<open>a \<le> b\<close> safe
     by auto
   from has_integral_affinity[OF this, where m=1 and c="-a"]
   have "(f has_integral snd (flow0 (a, 0) (b - a))) {a..b}"
     by auto
   then have "integral {a..b} f = snd (flow0 (a, 0) (b - a))" by blast
   also have "\<dots> \<in> {l .. u}"
     using flow
     by auto
   finally show ?thesis by simp
 qed
 
 lemma [code_computation_unfold]:
   "numeral x = real_of_int (Code_Target_Int.positive x)"
   by simp
 lemma [code_computation_unfold]: "numeral x \<equiv> Float (Code_Target_Int.positive x) 0"
   by (simp add: Float_def float_of_numeral)
 
 definition no_print::"String.literal \<Rightarrow> unit" where "no_print x = ()"
 
 lemmas [approximation_preproc] = list_of_eucl_real list_of_eucl_prod append.simps
 
 named_theorems DIM_simps
 lemmas [DIM_simps] =
   DIM_real DIM_prod length_nth_simps
   add_numeral_special
   add_numeral_special card_sum card_prod card_bit0 card_bit1 card_num0 card_num1
   numeral_times_numeral numeral_mult mult_1_right mult_1
   aform.D_def
 
 lemma numeral_refl: "numeral x = numeral x" by simp
 
 lemma plain_floatarith_approx_eq_SomeD:
-  "approx prec fa [] = Some (fst (the (approx prec fa [])), snd (the (approx prec fa [])))"
+  "approx prec fa [] = Some (the (approx prec fa []))"
   if "plain_floatarith 0 fa"
   using that
   by (auto dest!: plain_floatarith_approx_not_None[where p=prec and XS=Nil])
 
-definition [simp]: "approx1 p f xs = real_of_float (fst (the (approx p f xs)))"
-definition [simp]: "approx2 p f xs = real_of_float (snd (the (approx p f xs)))"
+definition [simp]: "approx1 p f xs = real_of_float (lower (the (approx p f xs)))"
+definition [simp]: "approx2 p f xs = real_of_float (upper (the (approx p f xs)))"
 definition [simp]: "approx_defined p f xs \<longleftrightarrow> approx p f xs \<noteq> None"
 
 definition "approxs p fs xs = those (map (\<lambda>f. approx p f xs) fs)"
 definition [simp]: "approxs1 p f xs =
-  (case approxs p f xs of Some y \<Rightarrow> (map (real_of_float o fst) y) | None \<Rightarrow> replicate (length f) 0)"
+  (case approxs p f xs of Some y \<Rightarrow> (map (real_of_float o lower) y) | None \<Rightarrow> replicate (length f) 0)"
 definition [simp]: "approxs2 p f xs =
-  (case approxs p f xs of Some y \<Rightarrow> (map (real_of_float o snd) y) | None \<Rightarrow> replicate (length f) 0)"
+  (case approxs p f xs of Some y \<Rightarrow> (map (real_of_float o upper) y) | None \<Rightarrow> replicate (length f) 0)"
 definition "approxs_defined p fs xs \<longleftrightarrow> (those (map (\<lambda>f. approx p f xs) fs) \<noteq> None)"
 
 lemma length_approxs:
   "length (approxs1 p f xs) = length f"
   "length (approxs2 p f xs) = length f"
   by (auto simp: approxs_def dest!: those_eq_SomeD split: option.splits)
 
 lemma real_in_approxI:
   "x \<in> {(approx1 prec fa []) .. (approx2 prec fa [])}"
   if "x = interpret_floatarith fa []"
     "approx_defined prec fa []"
   using that
-  by (auto dest: approx_emptyD)
-
+  by (force dest: approx_emptyD simp: set_of_eq)
 
 lemma real_subset_approxI:
   "{a .. b} \<subseteq> {(approx1 prec fa []) .. (approx2 prec fb [])}"
   if "a = interpret_floatarith fa []"
     "b = interpret_floatarith fb []"
     "approx_defined prec fa []"
     "approx_defined prec fb []"
   using that
-  by (auto dest: approx_emptyD)
+  by (force dest: approx_emptyD simp: set_of_eq)
 
 
 lemma approxs_eq_Some_lengthD: "length ys = length fas" if "approxs prec fas XS = Some ys"
   using that
   by (auto simp: approxs_def dest!: those_eq_SomeD)
 
 lemma approxs_pointwise:
-  "interpret_floatarith (fas ! ia) xs \<in> {real_of_float (fst (ys ! ia)) .. (snd (ys ! ia))}"
+  "interpret_floatarith (fas ! ia) xs \<in> {real_of_float (lower (ys ! ia)) .. (upper (ys ! ia))}"
   if "approxs prec fas XS = Some ys" "bounded_by xs XS" "ia < length fas"
 proof -
   from those_eq_SomeD[OF that(1)[unfolded approxs_def]]
   have ys: "ys = map (the \<circ> (\<lambda>f. approx prec f XS)) fas"
     and ex: "\<exists>y. i < length fas \<longrightarrow> approx prec (fas ! i) XS = Some y" for i
     by auto
-  from ex[of ia] that obtain l u where lu: "Some (l, u) = approx prec (fas ! ia) XS" by auto
+  from ex[of ia] that obtain ivl where ivl: "approx prec (fas ! ia) XS = Some ivl" by auto
   from approx[OF that(2) this]
-  have "real_of_float l \<le> interpret_floatarith (fas ! ia) xs \<and> interpret_floatarith (fas ! ia) xs \<le> real_of_float u"
+  have "interpret_floatarith (fas ! ia) xs \<in>\<^sub>r ivl"
     by auto
   moreover
-  have "ys ! ia = (l, u)"
+  have "ys ! ia = ivl"
     unfolding ys
     apply (auto simp: o_def)
     apply (subst nth_map)
      apply (simp add: that)
-    using lu[symmetric] by simp
+    using ivl by simp
   ultimately show ?thesis
     using that
-    by (auto simp: approxs_eq_Some_lengthD split: prod.splits)
+    by (auto simp: approxs_eq_Some_lengthD set_of_eq split: prod.splits)
 qed
 
 lemmas approxs_pointwise_le = approxs_pointwise[simplified, THEN conjunct1]
   and approxs_pointwise_ge = approxs_pointwise[simplified, THEN conjunct2]
 
 lemma approxs_eucl:
   "eucl_of_list (interpret_floatariths fas xs) \<in>
-    {eucl_of_list (map fst ys) .. eucl_of_list (map snd ys)::'a::executable_euclidean_space}"
+    {eucl_of_list (map lower ys) .. eucl_of_list (map upper ys)::'a::executable_euclidean_space}"
   if "approxs prec fas XS = Some ys"
     "length fas = DIM('a)"
     "bounded_by xs XS"
   using that
   by (auto simp: eucl_le[where 'a='a] eucl_of_list_inner o_def approxs_eq_Some_lengthD
       intro!: approxs_pointwise_le approxs_pointwise_ge)
 
 lemma plain_floatariths_approx_eq_SomeD:
   "approxs prec fas [] = Some (the (approxs prec fas []))"
   if "list_all (plain_floatarith 0) fas"
   using that
   apply (induction fas)
    apply (auto simp: approxs_def split: option.splits dest!: plain_floatarith_approx_eq_SomeD)
-  subgoal for a fas aa b
+  subgoal for a fas aa
     apply (cases "those (map (\<lambda>f. approx prec f []) fas)")
     by auto
   done
 
 lemma approxs_definedD:
   "approxs prec fas xs = Some (the (approxs prec fas xs))"
   if "approxs_defined prec fas xs"
   using that
   by (auto simp: approxs_defined_def approxs_def)
 
 lemma approxs_defined_ne_None[simp]:
   "approxs prec fas xs \<noteq> None"
   if "approxs_defined prec fas xs"
   using that
   by (auto simp: approxs_defined_def approxs_def)
 
 lemma approx_subset_euclI:
   "{eucl_of_list (approxs2 prec fals [])::'a .. eucl_of_list (approxs1 prec faus [])} \<subseteq> {l .. u}"
   if "list_of_eucl l = interpret_floatariths fals []"
     and "list_of_eucl u = interpret_floatariths faus []"
     and "length fals = DIM('a::executable_euclidean_space)"
     and "length faus = DIM('a::executable_euclidean_space)"
     and "approxs_defined prec fals []"
     and "approxs_defined prec faus []"
   using that
   by (auto intro!: bounded_by_Nil
       dest!: approxs_eucl[where 'a='a] list_of_eucl_eqD plain_floatariths_approx_eq_SomeD[where prec=prec]
         split: option.splits)
 
 lemma eucl_subset_approxI:
   "{l .. u} \<subseteq> {eucl_of_list (approxs1 prec fals [])::'a .. eucl_of_list (approxs2 prec faus [])}"
   if "list_of_eucl l = interpret_floatariths fals []"
     and "list_of_eucl u = interpret_floatariths faus []"
     and "length fals = DIM('a::executable_euclidean_space)"
     and "length faus = DIM('a::executable_euclidean_space)"
     and "approxs_defined prec fals []"
     and "approxs_defined prec faus []"
   using that
   by (auto intro!: bounded_by_Nil
       dest!: approxs_eucl[where 'a='a] list_of_eucl_eqD plain_floatariths_approx_eq_SomeD[where prec=prec]
         split: option.splits)
 
 lemma approx_subset_listI:
   "list_interval (approxs2 prec fals []) (approxs1 prec faus []) \<subseteq> list_interval l u"
   if "l = interpret_floatariths fals []"
     and "u = interpret_floatariths faus []"
     and "length fals = length l"
     and "length faus = length u"
     and "approxs_defined prec fals []"
     and "approxs_defined prec faus []"
   using that
   apply (auto
       simp: list_interval_def list_all2_conv_all_nth
       dest: approxs_eq_Some_lengthD
       intro!: bounded_by_Nil
       dest!: plain_floatariths_approx_eq_SomeD[where prec=prec]
       split: option.splits)
    apply (rule order_trans)
     apply (rule approxs_pointwise_ge)
       apply assumption
      apply (rule bounded_by_Nil)
     apply (auto dest: approxs_eq_Some_lengthD)
   apply (subst interpret_floatariths_nth)
    apply (auto dest: approxs_eq_Some_lengthD)
     apply (rule approxs_pointwise_le[ge])
       apply assumption
      apply (rule bounded_by_Nil)
   apply (auto dest: approxs_eq_Some_lengthD)
   done
 
 
 definition "unit_list D n = (replicate D 0)[n:=1]"
 
 definition "mirror_sctn (sctn::real list sctn) = Sctn (map uminus (normal sctn)) (- pstn sctn)"
 definition "mirrored_sctn b (sctn::real list sctn) = (if b then mirror_sctn sctn else sctn)"
 
 lemma mirror_sctn_simps[simp]: "pstn (mirror_sctn sctn) = - pstn sctn"
   "normal (mirror_sctn sctn) = map uminus (normal sctn)"
   by (cases sctn) (auto simp: mirror_sctn_def)
 
 lemma length_unit_list[simp]: "length (unit_list D n) = D"
   by (auto simp: unit_list_def)
 
 lemma eucl_of_list_unit_list[simp]:
   "(eucl_of_list (unit_list D n)::'a::executable_euclidean_space) = Basis_list ! n"
   if "D = DIM('a)" "n < D"
   using that
   by (auto simp: unit_list_def eucl_of_list_inner inner_Basis nth_list_update'
       intro!: euclidean_eqI[where 'a='a])
 
 lemma le_eucl_of_list_iff: "(t::'a::executable_euclidean_space) \<le> eucl_of_list uX0 \<longleftrightarrow>
   (\<forall>i. i < DIM('a) \<longrightarrow> t \<bullet> Basis_list ! i \<le> uX0 ! i)"
   if "length uX0 = DIM('a)"
   using that
   apply (auto simp: eucl_le[where 'a='a] eucl_of_list_inner)
   using nth_Basis_list_in_Basis apply force
   by (metis Basis_list in_Basis_index_Basis_list index_less_size_conv length_Basis_list)
 
 lemma eucl_of_list_le_iff: "eucl_of_list uX0 \<le> (t::'a::executable_euclidean_space) \<longleftrightarrow>
   (\<forall>i. i < DIM('a) \<longrightarrow> uX0 ! i \<le> t \<bullet> Basis_list ! i)"
   if "length uX0 = DIM('a)"
   using that
   apply (auto simp: eucl_le[where 'a='a] eucl_of_list_inner)
   using nth_Basis_list_in_Basis apply force
   by (metis Basis_list in_Basis_index_Basis_list index_less_size_conv length_Basis_list)
 
 lemma Joints_aforms_of_ivls: "Joints (aforms_of_ivls lX0 uX0) = list_interval lX0 uX0"
   if "list_all2 (\<le>) lX0 uX0"
   using that
   apply (auto simp: list_interval_def dest: Joints_aforms_of_ivlsD1[OF _ that]
       Joints_aforms_of_ivlsD2[OF _ that] list_all2_lengthD
       intro!: aforms_of_ivls)
   by (auto simp: list_all2_conv_all_nth)
 
 lemma list_of_eucl_in_list_interval_iff:
   "list_of_eucl x0 \<in> list_interval lX0 uX0 \<longleftrightarrow> x0 \<in> {eucl_of_list lX0 .. eucl_of_list uX0::'a}"
   if "length lX0 = DIM('a::executable_euclidean_space)"
      "length uX0 = DIM('a::executable_euclidean_space)"
   using that
   by (auto simp: list_interval_def eucl_of_list_le_iff le_eucl_of_list_iff list_all2_conv_all_nth)
 
 
 text \<open>TODO: make a tactic out of this?!\<close>
 
 lemma file_output_iff: "file_output s f = f (\<lambda>_. ())"
   by (auto simp: file_output_def print_def[abs_def] Print.file_output_def)
 
 context ode_interpretation begin
 
 lemma poincare_mapsto_subset:
      "poincare_mapsto P  X0 SS CX R"
   if "poincare_mapsto P' Y0 RR CZ S" "X0 \<subseteq> Y0" "CZ \<subseteq> CX" "S \<subseteq> R" "RR = SS" "P = P'"
   using that
   by (force simp: poincare_mapsto_def)
 
 theorem solves_poincare_map_aform'_derivI:
   assumes solves:
     "solves_poincare_map_aform'_fo optns odo
       (Sctn (unit_list D n) (lP ! n))
       guards
       (lP, uP)
       (Sctn (unit_list D n) (lP ! n))
       roi
       [((1,1), aforms_of_ivls lX0 uX0, Some (aforms_of_point DX0))]
       (lR, uR)
       (Some (lDR, uDR))"
     and D: "D = DIM('a)"
   assumes DS: "list_interval lDR uDR \<subseteq> list_interval lDS uDS"
   and dim: "aform.D odo = DIM('a)"
   and lens:
     "length (lP) = DIM('a)" "length (uP) = DIM('a)"
     "length (lX0) = DIM('a)" "length (uX0) = DIM('a)"
     "length (lR) = DIM('a)" "length (uR) = DIM('a)"
     "length DX0 = DIM('a)*DIM('a)"
     "length lDR = CARD('n) * CARD('n)"
     "length uDR = CARD('n) * CARD('n)"
     and guards:
     "(\<And>a xs b ba ro.
         (xs, ro) \<in> set guards \<Longrightarrow>
       ((a, b), ba) \<in> set xs \<Longrightarrow>
           length a = DIM('a) \<and> length b = DIM('a) \<and> length (normal ba) = DIM('a))"
   and P: "P = {eucl_of_list lP .. eucl_of_list uP}"
   and plane: "uP ! n = lP ! n"
   and X0: "X0 \<subseteq> {eucl_of_list lX0 .. eucl_of_list uX0}"
   and nD: "n < DIM('a)"
   and SS: "SS = {x::'a. x \<bullet> Basis_list ! n \<le> lP ! n}"
   and R: "{eucl_of_list lR .. eucl_of_list uR} \<subseteq> R"
   shows "\<forall>x\<in>X0. returns_to P x \<and>
     return_time P differentiable at x within SS \<and>
     (\<exists>D. (poincare_map P has_derivative blinfun_apply D) (at x within SS) \<and>
          poincare_map P x \<in> R \<and> D o\<^sub>L blinfun_of_list DX0 \<in> blinfuns_of_lvivl (lDS, uDS))"
 proof (rule ballI)
   fix x assume "x \<in> X0"
   then have la2: "list_all2 (\<le>) lX0 uX0"
     using X0
     by (force simp: subset_iff eucl_of_list_le_iff le_eucl_of_list_iff lens list_all2_conv_all_nth)
   have 1: "\<And>X. X \<in> set [((1::ereal, 1::ereal), aforms_of_ivls lX0 uX0, Some (aforms_of_point DX0))] \<Longrightarrow>
       aform.c1_info_invare DIM('a) X"
     for X
     by (auto simp: aform.c1_info_invare_def aform.c1_info_invar_def lens power2_eq_square)
   have 2: "length (normal (Sctn (unit_list D n) (lP ! n))) = DIM('a)"
     by (auto simp: D)
   have 3: "length (fst (lP, uP)) = DIM('a)" "length (snd (lP, uP)) = DIM('a)"
     by (auto simp: lens)
   have 4: "length (normal (Sctn (unit_list D n) (lP ! n))) = DIM('a)"
     by (auto simp: D)
   have 5: "length (fst (lR, uR)) = CARD('n)" "length (snd (lR, uR)) = CARD('n)"
     "aform.lvivl'_invar (CARD('n) * CARD('n)) (Some (lDR, uDR))"
     by (auto simp: lens aform.lvivl'_invar_def)
   note solves = solves[unfolded solves_poincare_map_aform'_fo_def file_output_iff]
   have "poincare_mapsto
      (set_of_lvivl (lP, uP) \<inter>
       plane_of (map_sctn eucl_of_list (Sctn (unit_list D n) (lP ! n))))
      (aform.c1_info_of_apprse [((1, 1), aforms_of_ivls lX0 uX0, Some (aforms_of_point DX0))])
      (below_halfspace
        (map_sctn eucl_of_list (Sctn (unit_list D n) (lP ! n))))
      (aform.Csafe odo -
       set_of_lvivl (lP, uP) \<inter>
       plane_of (map_sctn eucl_of_list (Sctn (unit_list D n) (lP ! n))))
      (set_of_lvivl (lR, uR) \<times> blinfuns_of_lvivl' (Some (lDR, uDR)))"
     by (rule solves_poincare_map_aform'[OF solves, OF 1 dim 2 3 4 guards 5])
       auto
   then have "poincare_mapsto P (X0 \<times> {blinfun_of_list DX0}::('a \<times> ('a \<Rightarrow>\<^sub>L 'a)) set) SS UNIV
     (R \<times> blinfuns_of_lvivl (lDS, uDS))"
     apply (rule poincare_mapsto_subset)
     subgoal using X0
       apply (auto simp: aform.c1_info_of_appre_def aform.c1_info_of_appr_def
           aform.c1_info_of_apprse_def)
       subgoal for x0
         apply (rule image_eqI[where x="list_of_eucl x0@DX0"])
         using lens
          apply (auto simp: flow1_of_list_def aforms_of_point_def Joints_aforms_of_ivls_append_point)
         apply (rule imageI)
         using X0
         by (auto simp: Joints_aforms_of_ivls la2 list_of_eucl_in_list_interval_iff)
       done
     subgoal by simp
     subgoal using R DS
       by (auto simp: set_of_lvivl_def set_of_ivl_def blinfuns_of_lvivl'_def blinfuns_of_lvivl_def
           lens)
     subgoal
       using assms
       by (simp add: below_halfspace_def le_halfspace_def[abs_def])
     subgoal
       using assms
       by (fastforce simp add: P set_of_lvivl_def set_of_ivl_def plane_of_def
           le_eucl_of_list_iff eucl_of_list_le_iff)
     done
   then show "returns_to P x \<and>
     return_time P differentiable at x within SS \<and>
     (\<exists>D. (poincare_map P has_derivative blinfun_apply D) (at x within SS) \<and>
          poincare_map P x \<in> R \<and> D o\<^sub>L blinfun_of_list DX0 \<in> blinfuns_of_lvivl (lDS, uDS))"
     using \<open>x \<in> X0\<close>
     by (auto simp: poincare_mapsto_def)
 qed
 
 definition guards_invar::"nat \<Rightarrow> (((real list \<times> real list) \<times> real list sctn) list \<times>
     (real \<times> real pdevs) reach_options) list \<Rightarrow> bool"
   where "guards_invar D guards = (\<forall>(xs, ro) \<in> set guards.
     \<forall>((a, b), ba) \<in> set xs. length a = D \<and> length b = D \<and> length (normal ba) = D)"
 
 theorem solves_poincare_map_aform'I:
   assumes "TAG_optns optns"
   assumes "TAG_reach_optns roi"
   assumes "TAG_sctn mirrored"
   assumes D: "D = DIM('a)"
   assumes guards: "guards_invar DIM('a) guards"
   and P: "P = {eucl_of_list lP .. eucl_of_list uP}"
   and plane: "uP ! n = lP ! n"
   and dim: "aform.D odo = DIM('a)"
   and X0: "X0 \<subseteq> {eucl_of_list lX0 .. eucl_of_list uX0}"
   and nD: "n < DIM('a)"
   and R: "{eucl_of_list lR .. eucl_of_list uR} \<subseteq> R"
   and lens:
     "length (lP) = DIM('a)" "length (uP) = DIM('a)"
     "length (lX0) = DIM('a)" "length (uX0) = DIM('a)"
     "length (lR) = DIM('a)" "length (uR) = DIM('a)"
   and solves:
     "solves_poincare_map_aform'_fo optns odo
       (Sctn (unit_list D n) (lP ! n))
       guards
       (lP, uP)
       (mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n)))
       roi
       [((1,1), aforms_of_ivls lX0 uX0, None)]
       (lR, uR)
       None"
 shows "\<forall>x\<in>X0. returns_to P x \<and> poincare_map P x \<in> R"
 proof -
   note solves = solves[unfolded solves_poincare_map_aform'_fo_def file_output_iff]
   have 1: "\<And>X. X \<in> set [((1::ereal, 1::ereal), aforms_of_ivls lX0 uX0, None)] \<Longrightarrow>
       aform.c1_info_invare DIM('a) X"
     for X
     by (auto simp: aform.c1_info_invare_def aform.c1_info_invar_def lens)
   have 2: "length (normal ((mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n))))) = DIM('a)"
     by (auto simp: D mirrored_sctn_def)
   have 3: "length (fst (lP, uP)) = DIM('a)" "length (snd (lP, uP)) = DIM('a)"
     by (auto simp: lens)
   have 4: "length (normal (((Sctn (unit_list D n) (lP ! n))))) = DIM('a)"
     by (auto simp: D mirrored_sctn_def)
   from guards have guards: "(xs, ro) \<in> set guards \<Longrightarrow>
        ((a, b), ba) \<in> set xs \<Longrightarrow>
        length a = DIM('a) \<and>
        length b = DIM('a) \<and> length (normal ba) = DIM('a)" for xs ro a b ba
     by (auto simp: guards_invar_def)
   have 5: "length (fst (lR, uR)) = CARD('n)" "length (snd (lR, uR)) = CARD('n)"
     "aform.lvivl'_invar (CARD('n) * CARD('n)) None"
     by (auto simp: lens)
   have "poincare_mapsto
     (set_of_lvivl (lP, uP) \<inter>
       plane_of (map_sctn eucl_of_list (mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n)))))
     (aform.c1_info_of_apprse [((1, 1), aforms_of_ivls lX0 uX0, None)])
     (below_halfspace (map_sctn eucl_of_list (Sctn (unit_list D n) (lP ! n))))
     (aform.Csafe odo -
       set_of_lvivl (lP, uP) \<inter>
       plane_of (map_sctn eucl_of_list (mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n)))))
      (set_of_lvivl (lR, uR) \<times> blinfuns_of_lvivl' None)"
     by (rule solves_poincare_map_aform'[OF solves, OF 1 dim 2 3 4 guards 5])
   then have "poincare_mapsto P (X0 \<times> UNIV::('a \<times> ('a \<Rightarrow>\<^sub>L 'a)) set)
       (below_halfspace (map_sctn eucl_of_list (((Sctn (unit_list D n) (lP ! n)))))) UNIV (R \<times> UNIV)"
     apply (rule poincare_mapsto_subset)
     subgoal using X0
       apply (auto simp: aform.c1_info_of_apprse_def aform.c1_info_of_appre_def
           aform.c1_info_of_appr_def)
       apply (rule image_eqI) apply (rule eucl_of_list_list_of_eucl[symmetric])
       apply (rule aforms_of_ivls)
       by (auto simp add: lens subset_iff le_eucl_of_list_iff eucl_of_list_le_iff)
     subgoal by simp
     subgoal using R by (auto simp: set_of_lvivl_def set_of_ivl_def)
     subgoal
       using assms
       by (simp add: below_halfspace_def le_halfspace_def[abs_def])
     subgoal
       using assms
       by (fastforce simp add: P set_of_lvivl_def set_of_ivl_def plane_of_def
           le_eucl_of_list_iff eucl_of_list_le_iff mirrored_sctn_def mirror_sctn_def)  
     done
   then show "\<forall>x\<in>X0. returns_to P x \<and> poincare_map P x \<in> R"
     by (auto simp: poincare_mapsto_def)
 qed
 
 definition "poincare_map_from_outside = poincare_map"
 
 theorem poincare_maps_onto_aformI:
   assumes "TAG_optns optns"
   assumes "TAG_reach_optns roi"
   assumes "TAG_sctn mirrored"
   assumes D: "D = DIM('a)"
   assumes guards: "guards_invar DIM('a) guards"
   and P: "P = {eucl_of_list lP .. eucl_of_list uP}"
   and plane: "uP ! n = lP ! n"
   and dim: "aform.D odo = DIM('a)"
   and X0: "X0 \<subseteq> {eucl_of_list lX0 .. eucl_of_list uX0}"
   and nD: "n < DIM('a)"
   and R: "{eucl_of_list lR .. eucl_of_list uR} \<subseteq> R"
   and lens:
     "length (lP) = DIM('a)" "length (uP) = DIM('a)"
     "length (lX0) = DIM('a)" "length (uX0) = DIM('a)"
     "length (lR) = DIM('a)" "length (uR) = DIM('a)"
   and solves:
     "solves_poincare_map_onto_aform_fo optns odo
       guards
       (lP, uP)
       (mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n)))
       roi
       [((1,1), aforms_of_ivls lX0 uX0, None)]
       (lR, uR)
       None"
 shows "\<forall>x\<in>X0. returns_to P x \<and> poincare_map_from_outside P x \<in> R"
 proof -
   note solves = solves[unfolded solves_poincare_map_onto_aform_fo_def file_output_iff]
   have 1: "\<And>X. X \<in> set [((1::ereal, 1::ereal), aforms_of_ivls lX0 uX0, None)] \<Longrightarrow>
       aform.c1_info_invare DIM('a) X"
     for X
     by (auto simp: aform.c1_info_invare_def aform.c1_info_invar_def lens)
   have 2: "length (normal ((mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n))))) = DIM('a)"
     by (auto simp: D mirrored_sctn_def)
   have 3: "length (fst (lP, uP)) = DIM('a)" "length (snd (lP, uP)) = DIM('a)"
     by (auto simp: lens)
   from guards have guards: "(xs, ro) \<in> set guards \<Longrightarrow>
        ((a, b), ba) \<in> set xs \<Longrightarrow>
        length a = DIM('a) \<and>
        length b = DIM('a) \<and> length (normal ba) = DIM('a)" for xs ro a b ba
     by (auto simp: guards_invar_def)
   have 5: "length (fst (lR, uR)) = CARD('n)" "length (snd (lR, uR)) = CARD('n)"
     "aform.lvivl'_invar (CARD('n) * CARD('n)) None"
     by (auto simp: lens)
   have "poincare_mapsto
     (set_of_lvivl (lP, uP) \<inter>
       plane_of (map_sctn eucl_of_list (mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n)))))
     (aform.c1_info_of_apprse [((1, 1), aforms_of_ivls lX0 uX0, None)])
     UNIV
     (aform.Csafe odo -
       set_of_lvivl (lP, uP) \<inter>
       plane_of (map_sctn eucl_of_list (mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n)))))
      (set_of_lvivl (lR, uR) \<times> blinfuns_of_lvivl' None)"
     by (rule solves_poincare_map_onto_aform[OF solves, OF 1 dim 2 3 guards 5])
   then have "poincare_mapsto P (X0 \<times> UNIV::('a \<times> ('a \<Rightarrow>\<^sub>L 'a)) set) UNIV UNIV (R \<times> UNIV)"
     apply (rule poincare_mapsto_subset)
     subgoal using X0
       apply (auto simp: aform.c1_info_of_apprse_def aform.c1_info_of_appre_def
           aform.c1_info_of_appr_def)
       apply (rule image_eqI) apply (rule eucl_of_list_list_of_eucl[symmetric])
       apply (rule aforms_of_ivls)
       by (auto simp add: lens subset_iff le_eucl_of_list_iff eucl_of_list_le_iff)
     subgoal by simp
     subgoal using R by (auto simp: set_of_lvivl_def set_of_ivl_def)
     subgoal by simp
     subgoal
       using assms
       by (fastforce simp add: P set_of_lvivl_def set_of_ivl_def plane_of_def
           le_eucl_of_list_iff eucl_of_list_le_iff mirrored_sctn_def mirror_sctn_def)  
     done
   then show "\<forall>x\<in>X0. returns_to P x \<and> poincare_map_from_outside P x \<in> R"
     by (auto simp: poincare_mapsto_def poincare_map_from_outside_def)
 qed
 
 end
 
 lemmas [simp] = length_approxs
 
 context includes ode_ops.lifting begin
 lift_definition empty_ode_ops::"ode_ops" is "([], true_form)"
   by (auto simp: )
 end
 
 ML \<open>val ode_numerics_conv = @{computation_check
   terms:
     Trueprop
 
     Not
 
     solves_one_step_until_time_aform_fo
     solves_poincare_map_aform'_fo
     solves_poincare_map_onto_aform_fo
 
     num_options
     num_options_c1
     ro
 
     (* nat *)
     Suc "0::nat" "1::nat" "(+)::nat \<Rightarrow> nat \<Rightarrow> nat" "(-) ::nat \<Rightarrow> nat \<Rightarrow> nat" "(=)::nat\<Rightarrow>nat\<Rightarrow>bool"
     "(^)::nat\<Rightarrow>nat\<Rightarrow>nat"
 
     (* int / integer*)
     "(=)::int\<Rightarrow>int\<Rightarrow>bool"
     "(+)::int\<Rightarrow>int\<Rightarrow>int"
     "uminus::_\<Rightarrow>int"
     "uminus::_\<Rightarrow>integer"
     int_of_integer integer_of_int
     "0::int"
     "1::int"
     "(^)::int\<Rightarrow>nat\<Rightarrow>int"
 
     (* real *)
     "(=)::real\<Rightarrow>real\<Rightarrow>bool"
     "real_of_float"
     "(/)::real\<Rightarrow>real\<Rightarrow>real"
     "(^)::real\<Rightarrow>nat\<Rightarrow>real"
     "uminus::real\<Rightarrow>_"
     "(+)::real\<Rightarrow>real\<Rightarrow>real" "(-)::real\<Rightarrow>real\<Rightarrow>real"  "(*)::real\<Rightarrow>real\<Rightarrow>real"
     real_divl real_divr
     real_of_int
     "0::real"
     "1::real"
 
     (* rat *)
     Fract
     "0::rat"
     "1::rat"
     "(+)::rat\<Rightarrow>rat\<Rightarrow>rat"
     "(-)::rat\<Rightarrow>rat\<Rightarrow>rat"
     "(*)::rat\<Rightarrow>rat\<Rightarrow>rat"
     "uminus::rat\<Rightarrow>_"
     "(/)::rat\<Rightarrow>rat\<Rightarrow>rat"
     "(^)::rat\<Rightarrow>nat\<Rightarrow>rat"
 
     (* ereal *)
     "1::ereal"
 
     (* lists: *)
     "replicate::_\<Rightarrow>real\<Rightarrow>_"
     "unit_list::_\<Rightarrow>_\<Rightarrow>real list"
     "Nil::(nat \<times> nat \<times> string) list"
     "Cons::_\<Rightarrow>_\<Rightarrow>(nat \<times> nat \<times> string) list"
     "Nil::(nat \<times> nat \<times> string \<times> nat list) list"
     "Cons::_\<Rightarrow>_\<Rightarrow>(nat \<times> nat \<times> string \<times> nat list) list"
     "Nil::real list"
     "Cons::_\<Rightarrow>_\<Rightarrow>real list"
     "Nil::nat list"
     "Cons::_\<Rightarrow>_\<Rightarrow>nat list"
     "Nil::string list"
     "Cons::_\<Rightarrow>_\<Rightarrow>string list"
     "Nil::real aform list"
     "Cons::_\<Rightarrow>_\<Rightarrow>real aform list"
-    "Nil::(float \<times> float) option list"
-    "Cons::_\<Rightarrow>_\<Rightarrow>(float \<times> float) option list"
+    "Nil::(float interval) option list"
+    "Cons::_\<Rightarrow>_\<Rightarrow>(float interval) option list"
 
     "nth::_\<Rightarrow>_\<Rightarrow>real"
     "upt"
 
     (* products: *)
     "Pair::_\<Rightarrow>_\<Rightarrow>(nat \<times> string)"
     "Pair::_\<Rightarrow>_\<Rightarrow>(nat \<times> nat \<times> string)"
 
     "Pair::_\<Rightarrow>_\<Rightarrow>char list \<times> nat list"
     "Pair::_\<Rightarrow>_\<Rightarrow>nat \<times> char list \<times> nat list"
     "Pair::_\<Rightarrow>_\<Rightarrow>nat \<times> nat \<times> char list \<times> nat list"
 
     "Pair::_\<Rightarrow>_\<Rightarrow>char list \<times> ((String.literal \<Rightarrow> unit) \<Rightarrow> (real \<times> real pdevs) numeric_options)"
     "Pair::_\<Rightarrow>_\<Rightarrow>ereal\<times>ereal"
     "Pair::_\<Rightarrow>_\<Rightarrow>real aform list \<times> real aform list option"
     "Pair::_\<Rightarrow>_\<Rightarrow>(ereal \<times> ereal) \<times> real aform list \<times> real aform list option"
 
     "Pair::_\<Rightarrow>_\<Rightarrow>real aform"
     "Pair::_\<Rightarrow>_\<Rightarrow>real list \<times> real list"
 
     "Nil::(((real list \<times> real list) \<times> real list sctn) list \<times> (real aform) reach_options) list"
     "Cons::_\<Rightarrow>_\<Rightarrow>(((real list \<times> real list) \<times> real list sctn) list \<times> (real aform) reach_options) list"
     "Nil::((real list \<times> real list) \<times> real list sctn) list"
     "Cons::_\<Rightarrow>_\<Rightarrow>((real list \<times> real list) \<times> real list sctn) list"
 
     "Pair::_\<Rightarrow>_\<Rightarrow>((real list \<times> real list) \<times> real list sctn) list \<times> real aform reach_options"
 
     "Nil::((ereal \<times> ereal) \<times> (real aform) list \<times> (real aform) list option) list"
     "Cons::_\<Rightarrow>_\<Rightarrow>((ereal \<times> ereal) \<times> (real aform) list \<times> (real aform) list option) list"
 
     (* option *)
     "None::(real aform) list option"
     "Some::_\<Rightarrow>(real aform) list option"
     "None::(real list \<times> real list) option"
     "Some::_\<Rightarrow>(real list \<times> real list) option"
 
     (* aforms *)
     "aform_of_ivl::_\<Rightarrow>_\<Rightarrow>real aform"
     aforms_of_ivls
     aforms_of_point
 
     (* pdevs*)
     "zero_pdevs::real pdevs"
     "zero_aforms::_ \<Rightarrow> real aform list"
 
     (* ode_ops *)
     mk_ode_ops
     init_ode_ops
     empty_ode_ops
     can_mk_ode_ops
     "the::ode_ops option \<Rightarrow> ode_ops"
     the_odo
 
     (* Characters/Strings *)
     String.Char
     String.implode
     "Nil::string"
     "Cons::_\<Rightarrow>_\<Rightarrow>string"
 
     (* float *)
     "(=)::float\<Rightarrow>float\<Rightarrow>bool" "(+)::float\<Rightarrow>float\<Rightarrow>float" "uminus::_\<Rightarrow>float" "(-)::_\<Rightarrow>_\<Rightarrow>float"
     Float float_of_int float_of_nat
 
     (* approximation... *)
     approx
     approx1
     approx2
     approxs1
     approxs2
     approx_defined
     approxs_defined
 
     (* floatarith *)
     "0::floatarith"
     "1::floatarith"
     "(+)::_\<Rightarrow>_\<Rightarrow>floatarith"
     "(-)::_\<Rightarrow>_\<Rightarrow>floatarith"
     "(*)::_\<Rightarrow>_\<Rightarrow>floatarith"
     "(/)::_\<Rightarrow>_\<Rightarrow>floatarith"
     "inverse::_\<Rightarrow>floatarith"
     "uminus::_\<Rightarrow>floatarith"
     "Sum\<^sub>e::_\<Rightarrow>nat list\<Rightarrow>floatarith"
     Sin Half Tan
     R\<^sub>e Norm
 
     (* form *)
     true_form
     Half
 
     (* Printing *)
     print
     no_print
 
     (* sections *)
     xsec xsec' ysec ysec' zsec zsec'
     xsec2 xsec2' ysec2 ysec2'
     ysec4 ysec4'
     mirrored_sctn
 
     Code_Target_Nat.natural
     Code_Target_Int.positive
     Code_Target_Int.negative
     Code_Numeral.positive
     Code_Numeral.negative
 
   datatypes:
     bool
     num
     floatarith
     "floatarith list"
     form
     "real list sctn"
     "real \<times> real"
 }
 \<close>
 ML \<open>fun ode_numerics_tac ctxt =
   CONVERSION (ode_numerics_conv ctxt) THEN' (resolve_tac ctxt [TrueI])\<close>
 
 lemma eq_einterpretI:
   assumes "list_of_eucl (VS::'a::executable_euclidean_space) = interpret_floatariths fas xs"
   assumes "length fas = DIM('a)"
   shows "VS = eucl_of_list (interpret_floatariths fas xs)"
   using assms
   apply (subst (asm) list_of_eucl_eucl_of_list[symmetric])
   apply (auto intro!: )
   by (metis eucl_of_list_list_of_eucl)
 
 lemma one_add_square_ne_zero[simp]: "1 + t * t \<noteq> 0" for t::real
   by (metis semiring_normalization_rules(12) sum_squares_eq_zero_iff zero_neq_one)
 
 lemma abs_rat_bound:
   "abs (x - y) \<le> e / f" if "y \<in> {yl .. yu}" "x \<in> {yu - real_divl p e f.. yl + real_divl p e f}" for x y e::real
 proof -
   note \<open>x \<in> _\<close>
   also have "{yu - real_divl p e f.. yl + real_divl p e f} \<subseteq> {yu - e / f .. yl + e / f}"
     by (auto intro!: diff_mono real_divl)
   finally show ?thesis
     using that
     unfolding abs_diff_le_iff
     by auto
 qed
 
 lemma in_ivl_selfI: "a \<in> {a .. a}" for a::real by auto
 
 lemma pi4_bnds: "pi / 4 \<in> {real_divl 80 (lb_pi 80) 4 .. real_divr 80 (ub_pi 80) 4}"
   using pi_boundaries[of 80]
   unfolding atLeastAtMost_iff
   by (intro conjI real_divl[le] real_divr[ge] divide_right_mono) auto
 
 lemma abs_minus_leI: "\<bar>x - x'\<bar> \<le> e" if "x \<in> {x' - e .. x' + e}" for x e::real
   using that
   by (auto simp: )
 
 lemmas [DIM_simps] = Suc_numeral One_nat_def[symmetric] TrueI Suc_1 length_approxs arith_simps
 lemma (in ode_interpretation) length_ode_e[DIM_simps]: "length (ode_expression odo) = DIM('a)"
   by (auto simp: len)
 
 
 named_theorems solves_one_step_ivl_thms
 
 context ode_interpretation begin
 
 lemmas [solves_one_step_ivl_thms] =
   TAG_optns[OF solves_one_step_ivl[OF _ _ _ _ _ _ _ _ solves_one_step_until_time_aform_foI], rotated -1,
     of optns _ _ _ _ _ _ _ _ _ optns for optns]
 
 lemmas [solves_one_step_ivl_thms] =
   TAG_optns[OF solves_one_step_ivl'[OF _ _ _ _ _ _ _ _ _ _ _ _ solves_one_step_until_time_aform_foI], rotated -1,
     of optns _ _ _ _ _ _ _ _ _ _ _ _ _ _ optns for optns]
 
 lemmas [solves_one_step_ivl_thms] = solves_poincare_map_aform'I poincare_maps_onto_aformI
 
 end
 
 lemma TAG_optnsI: "TAG_optns optns" by simp
 
 named_theorems poincare_tac_theorems
 
 lemmas [DIM_simps] = one_less_numeral_iff rel_simps
 
 
 abbreviation "point_ivl a \<equiv> {a .. a}"
 
 lemma isFDERIV_compute: "isFDERIV D vs fas xs \<longleftrightarrow>
    (list_all (\<lambda>i. list_all (\<lambda>j. isDERIV (vs ! i) (fas ! j) xs) [0..<D]) [0..<D]) \<and> length fas = D \<and> length vs = D"
   unfolding isFDERIV_def
   by (auto simp: list.pred_set)
 
 
 theorem (in ode_interpretation) solves_poincare_map_aform'_derivI'[solves_one_step_ivl_thms]:
 \<comment> \<open>TODO: replace @{thm solves_poincare_map_aform'_derivI}\<close>
   assumes "TAG_optns optns"
   assumes "TAG_reach_optns roi"
   assumes "TAG_sctn mirrored"
     and D: "D = DIM('a)"
   assumes DS: "list_interval lDR uDR \<subseteq> list_interval lDS uDS"
     and ode_fas: "aform.D odo = DIM('a)"
     and guards: "guards_invar DIM('a) guards"
     and P: "P = {eucl_of_list lP .. eucl_of_list uP}"
     and plane: "uP ! n = lP ! n"
     and X0: "X0 \<subseteq> {eucl_of_list lX0 .. eucl_of_list uX0}"
     and nD: "n < DIM('a)"
     and R: "{eucl_of_list lR .. eucl_of_list uR} \<subseteq> R"
     and lens:
     "length (lP) = DIM('a)" "length (uP) = DIM('a)"
     "length (lX0) = DIM('a)" "length (uX0) = DIM('a)"
     "length (lR) = DIM('a)" "length (uR) = DIM('a)"
     "length DX0 = DIM('a)*DIM('a)"
     "length lDR = CARD('n) * CARD('n)"
     "length uDR = CARD('n) * CARD('n)"
     and SS: "SS = {x::'a. if mirrored then x \<bullet> Basis_list ! n \<le> lP ! n
         else x \<bullet> Basis_list ! n \<ge> lP ! n}"
   assumes solves:
     "solves_poincare_map_aform'_fo optns odo
       (mirrored_sctn (\<not>mirrored) (Sctn (unit_list D n) (lP ! n)))
       guards
       (lP, uP)
       (mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n)))
       roi
       [((1,1), aforms_of_ivls lX0 uX0, Some (aforms_of_point DX0))]
       (lR, uR)
       (Some (lDR, uDR))"
   shows "\<forall>x\<in>X0. returns_to P x \<and>
     return_time P differentiable at x within SS \<and>
     (\<exists>D. (poincare_map P has_derivative blinfun_apply D) (at x within SS) \<and>
          poincare_map P x \<in> R \<and> D o\<^sub>L blinfun_of_list DX0 \<in> blinfuns_of_lvivl (lDS, uDS))"
 proof (rule ballI)
   fix x assume "x \<in> X0"
   then have la2: "list_all2 (\<le>) lX0 uX0"
     using X0
     by (force simp: subset_iff eucl_of_list_le_iff le_eucl_of_list_iff lens list_all2_conv_all_nth)
   have 1: "\<And>X. X \<in> set [((1::ereal, 1::ereal), aforms_of_ivls lX0 uX0, Some (aforms_of_point DX0))] \<Longrightarrow>
       aform.c1_info_invare DIM('a) X"
     for X
     by (auto simp: aform.c1_info_invare_def aform.c1_info_invar_def lens power2_eq_square)
   have 2: "length (normal (mirrored_sctn (\<not>mirrored) (Sctn (unit_list D n) (lP ! n)))) = DIM('a)"
     by (auto simp: D mirrored_sctn_def)
   have 3: "length (fst (lP, uP)) = DIM('a)" "length (snd (lP, uP)) = DIM('a)"
     by (auto simp: lens)
   have 4: "length (normal (mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n)))) = DIM('a)"
     by (auto simp: D mirrored_sctn_def)
   have 5: "length (fst (lR, uR)) = CARD('n)" "length (snd (lR, uR)) = CARD('n)"
     "aform.lvivl'_invar (CARD('n) * CARD('n)) (Some (lDR, uDR))"
     by (auto simp: lens aform.lvivl'_invar_def)
   note solves = solves[unfolded solves_poincare_map_aform'_fo_def file_output_iff]
   have "poincare_mapsto
      (set_of_lvivl (lP, uP) \<inter>
       plane_of (map_sctn eucl_of_list (mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n)))))
      (aform.c1_info_of_apprse [((1, 1), aforms_of_ivls lX0 uX0, Some (aforms_of_point DX0))])
      (below_halfspace (map_sctn eucl_of_list (mirrored_sctn (\<not>mirrored) (Sctn (unit_list D n) (lP ! n)))))
      (aform.Csafe odo -
       set_of_lvivl (lP, uP) \<inter>
       plane_of (map_sctn eucl_of_list (mirrored_sctn mirrored (Sctn (unit_list D n) (lP ! n)))))
      (set_of_lvivl (lR, uR) \<times> blinfuns_of_lvivl' (Some (lDR, uDR)))"
     by (rule solves_poincare_map_aform'[OF solves, OF 1 ode_fas 4 3 2 _ 5])
       (use guards in \<open>auto simp: guards_invar_def\<close>)
   then have "poincare_mapsto P (X0 \<times> {blinfun_of_list DX0}::('a \<times> ('a \<Rightarrow>\<^sub>L 'a)) set) SS UNIV
     (R \<times> blinfuns_of_lvivl (lDS, uDS))"
     apply (rule poincare_mapsto_subset)
     subgoal using X0
       apply (auto simp: aform.c1_info_of_appre_def aform.c1_info_of_appr_def
           aform.c1_info_of_apprse_def)
       subgoal for x0
         apply (rule image_eqI[where x="list_of_eucl x0@DX0"])
         using lens
          apply (auto simp: flow1_of_list_def aforms_of_point_def Joints_aforms_of_ivls_append_point)
         apply (rule imageI)
         using X0
         by (auto simp: Joints_aforms_of_ivls la2 list_of_eucl_in_list_interval_iff)
       done
     subgoal by simp
     subgoal using R DS
       by (auto simp: set_of_lvivl_def set_of_ivl_def blinfuns_of_lvivl'_def blinfuns_of_lvivl_def
           lens)
     subgoal
       using assms
       by (auto simp:
           below_halfspace_def le_halfspace_def[abs_def] mirrored_sctn_def mirror_sctn_def)
     subgoal
       using assms
       by (fastforce simp add: P set_of_lvivl_def set_of_ivl_def plane_of_def
           le_eucl_of_list_iff eucl_of_list_le_iff mirrored_sctn_def mirror_sctn_def)
     done
   then show "returns_to P x \<and>
     return_time P differentiable at x within SS \<and>
     (\<exists>D. (poincare_map P has_derivative blinfun_apply D) (at x within SS) \<and>
          poincare_map P x \<in> R \<and> D o\<^sub>L blinfun_of_list DX0 \<in> blinfuns_of_lvivl (lDS, uDS))"
     using \<open>x \<in> X0\<close>
     by (auto simp: poincare_mapsto_def)
 qed
 
 lemmas [DIM_simps] = aform.ode_e_def
 
 ML \<open>
 structure ODE_Numerics_Tac = struct
 fun mk_nat n = HOLogic.mk_number @{typ nat} n
 fun mk_int n = HOLogic.mk_number @{typ int} n
 fun mk_integer n = @{term integer_of_int} $ (HOLogic.mk_number @{typ int} n)
 fun mk_bool b = if b then @{term True} else @{term False}
 
 fun mk_numeralT n =
   let
     fun mk_bit 0 ty = Type (@{type_name bit0}, [ty])
       | mk_bit 1 ty = Type (@{type_name bit1}, [ty]);
     fun bin_of n =
       if n = 1 then @{typ num1}
       else if n = 0 then @{typ num0}
       else if n = ~1 then raise TERM ("negative type numeral", [])
       else
         let val (q, r) = Integer.div_mod n 2;
         in mk_bit r (bin_of q) end;
   in bin_of n end;
 
 fun print_tac' ctxt s = K (print_tac ctxt s)
 
 val using_master_directory =
   File.full_path o Resources.master_directory o Proof_Context.theory_of;
 
 fun using_master_directory_term ctxt s =
   (if s = "-" orelse s = ""
   then s
   else
     Path.explode s
     |> using_master_directory ctxt
     |> Path.implode)
   |> HOLogic.mk_string
 
 fun real_in_approx_tac ctxt p =
   let
     val inst_approx =
        ([], [((("prec", 0), @{typ nat}), mk_nat p |> Thm.cterm_of ctxt)])
     val approx_thm = Thm.instantiate inst_approx @{thm real_in_approxI}
   in
     resolve_tac ctxt [approx_thm]
       THEN' SOLVED' (reify_floatariths_tac ctxt)
       THEN' ode_numerics_tac ctxt
   end
 
 fun real_subset_approx_tac ctxt p =
   let
     val inst_approx =
        ([], [((("prec", 0), @{typ nat}), mk_nat p |> Thm.cterm_of ctxt)])
     val approx_thm = Thm.instantiate inst_approx @{thm real_subset_approxI}
   in
     resolve_tac ctxt [approx_thm]
       THEN' SOLVED' (reify_floatariths_tac ctxt)
       THEN' SOLVED' (reify_floatariths_tac ctxt)
       THEN' ode_numerics_tac ctxt
       THEN' ode_numerics_tac ctxt
   end
 
 fun basic_nt_ss ctxt nt =
   put_simpset HOL_basic_ss ctxt addsimps Named_Theorems.get ctxt nt
 
 fun DIM_tac defs ctxt = (Simplifier.simp_tac (basic_nt_ss ctxt @{named_theorems DIM_simps} addsimps defs))
 
 fun subset_approx_preconds_tac ctxt p thm =
   let
     val inst_approx = ([], [((("prec", 0), @{typ nat}), mk_nat p |> Thm.cterm_of ctxt)])
   in
             resolve_tac ctxt [Thm.instantiate inst_approx thm]
       THEN' SOLVED' (reify_floatariths_tac ctxt)
       THEN' SOLVED' (reify_floatariths_tac ctxt)
       THEN' SOLVED' (DIM_tac [] ctxt)
       THEN' SOLVED' (DIM_tac [] ctxt)
       THEN' SOLVED' (ode_numerics_tac ctxt)
       THEN' SOLVED' (ode_numerics_tac ctxt)
   end
 
 val cfg_trace = Attrib.setup_config_bool @{binding ode_numerics_trace} (K false)
 fun tracing_tac ctxt = if Config.get ctxt cfg_trace then print_tac ctxt else K all_tac
 fun tracing_tac' ctxt = fn s => K (tracing_tac ctxt s)
 
 fun eucl_subset_approx_tac ctxt p = subset_approx_preconds_tac ctxt p @{thm eucl_subset_approxI}
 fun approx_subset_eucl_tac ctxt p = subset_approx_preconds_tac ctxt p @{thm approx_subset_euclI}
 fun approx_subset_list_tac ctxt p = subset_approx_preconds_tac ctxt p @{thm approx_subset_listI}
 
 val static_simpset = Simplifier.simpset_of @{context}
 
 fun nth_tac ctxt =
   Simplifier.simp_tac
     (put_simpset HOL_basic_ss ctxt addsimps @{thms nth_Cons_0 nth_Cons_Suc numeral_nat})
 fun nth_list_eq_tac ctxt n = Subgoal.FOCUS_PARAMS (fn {context, concl, ...} =>
   case try (Thm.term_of #> HOLogic.dest_Trueprop #> HOLogic.dest_eq) concl
   of
     SOME (@{const List.nth(real)} $ xs $ Var _, @{const List.nth(real)} $ ys $ Var _) =>
     let
       val i = find_index (op=) (HOLogic.dest_list xs ~~ HOLogic.dest_list ys)
       val thm = Goal.prove context [] []
         (HOLogic.mk_eq (@{const List.nth(real)} $ xs $ HOLogic.mk_number @{typ nat} i,
           @{const List.nth(real)} $ ys $ HOLogic.mk_number @{typ nat} i) |> HOLogic.mk_Trueprop)
         (fn {context, ...} => HEADGOAL (nth_tac context))
     in
       SOLVE (HEADGOAL (resolve_tac context [thm]))
     end
   | _ => no_tac
   ) ctxt n
 
 fun numeric_precond_step_tac defs thms p = Subgoal.FOCUS_PARAMS (fn {context, concl, ...} =>
   let
     val prems = Logic.strip_imp_prems (Thm.term_of concl)
     val conclusion = Logic.strip_imp_concl (Thm.term_of concl)
   in
     (case conclusion |> HOLogic.dest_Trueprop of
       @{const Set.member(real)} $ _ $ _ =>
         tracing_tac context "numeric_precond_step: real in approx"
         THEN HEADGOAL (real_in_approx_tac context p)
     | Const(@{const_name less_eq}, _) $
       (Const (@{const_name atLeastAtMost}, _) $ _ $ _) $
       (Const (@{const_name atLeastAtMost}, _) $ Var _ $ Var _)  =>
         tracing_tac context "numeric_precond_step: approx subset eucl"
         THEN HEADGOAL (real_subset_approx_tac context p)
     | Const (@{const_name less_eq}, _) $
         (Const (@{const_name atLeastAtMost}, _) $ (Const (@{const_name eucl_of_list}, _) $ Var _) $ _) $ _ =>
         tracing_tac context "numeric_precond_step: approx subset eucl"
         THEN HEADGOAL (approx_subset_eucl_tac context p)
     | Const (@{const_name less_eq}, _) $ _ $
         (Const (@{const_name atLeastAtMost}, _) $ (Const (@{const_name eucl_of_list}, _) $ Var _) $ _) =>
         tracing_tac context "numeric_precond_step: eucl subset approx"
         THEN HEADGOAL (eucl_subset_approx_tac context p)
     | Const (@{const_name less_eq}, _) $
       (@{const list_interval(real)} $ _ $ _) $
       (@{const list_interval(real)} $ _ $ _) =>
         tracing_tac context "numeric_precond_step: approx subset list"
         THEN HEADGOAL (approx_subset_list_tac context p)
     | @{const HOL.eq(nat)} $ _ $ _ =>
         tracing_tac context "numeric_precond_step: DIM_tac"
         THEN HEADGOAL (SOLVED' (DIM_tac [] context))
     | @{const less(nat)} $ _ $ _ =>
         tracing_tac context "numeric_precond_step: DIM_tac"
         THEN HEADGOAL (SOLVED' (DIM_tac [] context))
     | @{const HOL.eq(real)} $ (@{const nth(real)} $ _ $ _) $ (@{const nth(real)} $ _ $ _) =>
         tracing_tac context "numeric_precond_step: nth_list_eq_tac"
         THEN HEADGOAL (SOLVED' (nth_list_eq_tac context))
     | Const (@{const_name "HOL.eq"}, _) $ _ $
         (Const (@{const_name eucl_of_list}, _) $ (@{const interpret_floatariths} $ _ $ _)) =>
         tracing_tac context "numeric_precond_step: reify floatariths"
         THEN HEADGOAL (resolve_tac context @{thms eq_einterpretI} THEN' reify_floatariths_tac context)
     | t as _ $ _ =>
       let
         val (c, args) = strip_comb t
       in
         if member (op=)
           [@{const "solves_one_step_until_time_aform_fo"},
            @{const "solves_poincare_map_aform'_fo"},
            @{const "solves_poincare_map_onto_aform_fo"},
            @{const "can_mk_ode_ops"}
           ] c
         then
           tracing_tac context "numeric_precond_step: ode_numerics_tac"
           THEN HEADGOAL (
             CONVERSION (Simplifier.rewrite (put_simpset HOL_basic_ss context addsimps defs))
             THEN' tracing_tac' context "numeric_precond_step: ode_numerics_tac (unfolded)"
             THEN' ode_numerics_tac context)
         else if member (op=)
           [@{const "isFDERIV"}] c
         then
           tracing_tac context "numeric_precond_step: isFDERIV"
           THEN HEADGOAL (SOLVED'(Simplifier.asm_full_simp_tac
               (put_simpset static_simpset context addsimps (@{thms isFDERIV_def less_Suc_eq_0_disj isDERIV_Power_iff} @ thms @ defs))
               THEN' tracing_tac' context "numeric_precond_step: simplified isFDERIV"
           ))
         else
           tracing_tac context "numeric_precond_step: boolean, try thms"
           THEN HEADGOAL (SOLVED' (resolve_tac context thms))
       end
     | _ =>
         tracing_tac context "numeric_precond_step: boolean constant"
         THEN no_tac
     )
   end)
 
 fun integral_bnds_tac_gen_start sstep d p m N atol filename ctxt i =
   let
     val insts =
        ([((("'i", 0), @{sort "{enum}"}), mk_numeralT (d + 1) |> Thm.ctyp_of ctxt)],
         [((("optns", 0), @{typ "string \<times> ((String.literal \<Rightarrow> unit) \<Rightarrow>(real aform) numeric_options)"}),
            HOLogic.mk_prod
              (using_master_directory_term ctxt filename,
               (@{term num_options} $ mk_nat p $ mk_int sstep $ mk_nat m $ mk_nat N $ mk_int atol $
               @{term "[(0::nat, 1::nat, ''0x000000'')]"}))
           |> Thm.cterm_of ctxt),
         ((("safe_form", 0), @{typ form}), @{cterm true_form})
         ])
   in
           resolve_tac ctxt [Thm.instantiate insts @{thm solve_one_step_until_time_aform_integral_bounds}] i
     THEN (Lin_Arith.tac ctxt i ORELSE Simplifier.simp_tac ctxt i)
   end
 fun integral_bnds_tac_gen sstep d p m N atol filename thms ctxt =
   integral_bnds_tac_gen_start sstep d p m N atol filename ctxt
   THEN_ALL_NEW_FWD REPEAT_ALL_NEW_FWD (numeric_precond_step_tac [] thms p ctxt)
 
 val integral_bnds_tac = integral_bnds_tac_gen 5
 
 fun mk_proj (m, n, s) = HOLogic.mk_tuple [mk_nat m, mk_nat n, HOLogic.mk_string s]
 fun mk_projs projs = HOLogic.mk_list @{typ "nat \<times> nat \<times> string"} (map mk_proj projs)
 
 fun mk_string_list ds = HOLogic.mk_list @{typ "string"} (map HOLogic.mk_string ds)
 fun mk_nat_list ds = HOLogic.mk_list @{typ "nat"} (map mk_nat ds)
 fun mk_proj_c1 (m, n, s, ds) = HOLogic.mk_tuple [mk_nat m, mk_nat n, HOLogic.mk_string s, mk_nat_list ds]
 fun mk_projs_c1 projs = HOLogic.mk_list @{typ "nat \<times> nat \<times> string \<times> nat list"} (map mk_proj_c1 projs)
 
 fun TAG_optns_thm p sstep m N atol projs filename ctxt =
   Thm.instantiate ([],
           [((("optns", 0), @{typ "string \<times> ((String.literal \<Rightarrow> unit) \<Rightarrow>(real aform) numeric_options)"}),
            HOLogic.mk_prod
              (using_master_directory_term ctxt filename,
              @{term num_options} $ mk_nat p $ mk_int sstep $ mk_nat m $ mk_nat N $ mk_int atol $ mk_projs projs)
           |> Thm.cterm_of ctxt)]) @{thm TAG_optnsI}
 
 fun TAG_optns_c1_thm p sstep m N atol projs ds filename ctxt =
   Thm.instantiate ([],
           [((("optns", 0), @{typ "string \<times> ((String.literal \<Rightarrow> unit) \<Rightarrow>(real aform) numeric_options)"}),
            HOLogic.mk_prod
              (using_master_directory_term ctxt filename,
              @{term num_options_c1} $ mk_nat p $ mk_int sstep $ mk_nat m $ mk_nat N $ mk_int atol $ mk_projs_c1 projs $
               mk_string_list ds)
           |> Thm.cterm_of ctxt)]) @{thm TAG_optnsI}
 
 fun ode_bnds_tac_gen_start sstep p m N atol projs filename ctxt =
   tracing_tac' ctxt "solves_one_step_ivl_thms"
   THEN' resolve_tac ctxt (Named_Theorems.get ctxt @{named_theorems solves_one_step_ivl_thms})
   THEN' tracing_tac' ctxt "resolved solves_one_step_ivl_thms"
   THEN' resolve_tac ctxt [TAG_optns_thm p sstep m N atol projs filename ctxt]
 
 fun ode_bnds_tac_gen sstep ode_defs p m N atol projs filename ctxt =
   ode_bnds_tac_gen_start sstep p m N atol projs filename ctxt
   THEN_ALL_NEW_FWD REPEAT_ALL_NEW_FWD (numeric_precond_step_tac ode_defs [] p ctxt)
 val ode_bnds_tac = ode_bnds_tac_gen 5
 
 fun ode'_bnds_tac_gen_start sstep p m N atol projs ds filename ctxt =
   tracing_tac' ctxt "solves_one_step_ivl_thms"
   THEN' resolve_tac ctxt (Named_Theorems.get ctxt @{named_theorems solves_one_step_ivl_thms})
   THEN' tracing_tac' ctxt "resolved solves_one_step_ivl_thms"
   THEN' resolve_tac ctxt [TAG_optns_c1_thm p sstep m N atol projs ds filename ctxt]
 fun ode'_bnds_tac_gen sstep ode_defs p m N atol projs ds filename ctxt =
   ode'_bnds_tac_gen_start sstep p m N atol projs ds filename ctxt
   THEN_ALL_NEW_FWD REPEAT_ALL_NEW_FWD (numeric_precond_step_tac ode_defs [] p ctxt)
 
 val ode'_bnds_tac = ode'_bnds_tac_gen 5
 
 fun poincare_bnds_tac_gen_start sstep p m N atol projs filename ctxt =
   tracing_tac' ctxt "solves_one_step_ivl_thms"
   THEN' resolve_tac ctxt (Named_Theorems.get ctxt @{named_theorems solves_one_step_ivl_thms})
   THEN' tracing_tac' ctxt "resolved solves_one_step_ivl_thms"
   THEN' resolve_tac ctxt [TAG_optns_thm p sstep m N atol projs filename ctxt]
 fun poincare_bnds_tac_gen sstep ode_defs p m N atol projs filename ctxt =
    poincare_bnds_tac_gen_start sstep p m N atol projs filename ctxt
   THEN_ALL_NEW_FWD REPEAT_ALL_NEW_FWD (
     numeric_precond_step_tac ode_defs
       (Named_Theorems.get ctxt @{named_theorems poincare_tac_theorems})
       p
       ctxt)
 
 val poincare_bnds_tac = poincare_bnds_tac_gen 5
 
 fun poincare'_bnds_tac_gen_start sstep p m N atol projs filename ctxt =
          resolve_tac ctxt (Named_Theorems.get ctxt @{named_theorems solves_one_step_ivl_thms})
     THEN' resolve_tac ctxt [TAG_optns_thm p sstep m N atol projs filename ctxt]
 fun poincare'_bnds_tac_gen sstep ode_defs p m N atol projs filename ctxt =
   poincare'_bnds_tac_gen_start sstep p m N atol projs filename ctxt
   THEN_ALL_NEW_FWD REPEAT_ALL_NEW_FWD (
     numeric_precond_step_tac ode_defs
       (Named_Theorems.get ctxt @{named_theorems poincare_tac_theorems})
       p
       ctxt)
 val poincare'_bnds_tac = poincare'_bnds_tac_gen 5
 end
 \<close>
 
 lemma (in auto_ll_on_open) Poincare_Banach_fixed_pointI:
   assumes "convex S" and c: "complete S" "S \<noteq> {}" and "S \<subseteq> T"
   assumes derivative_bounded: "\<forall>x\<in>S.
     poincare_map \<Sigma> x \<in> S \<and> (\<exists>D. (poincare_map \<Sigma> has_derivative D) (at x within T) \<and> onorm D \<le> B)"
   assumes B: "B < 1"
   shows "\<exists>!x. x \<in> S \<and> poincare_map \<Sigma> x = x"
   using c _ B
 proof (rule banach_fix)
   from derivative_bounded c show "0 \<le> B"
     by (auto dest!: has_derivative_bounded_linear onorm_pos_le)
   from derivative_bounded show "poincare_map \<Sigma> ` S \<subseteq> S" by auto
   obtain D where D:
     "\<forall>x \<in> S. (poincare_map \<Sigma> has_derivative D x) (at x within T) \<and>
       onorm (D x) \<le> B"
     apply atomize_elim
     apply (rule bchoice)
     using derivative_bounded
     by auto
   with \<open>S \<subseteq> T\<close> have "(\<And>x. x \<in> S \<Longrightarrow> (poincare_map \<Sigma> has_derivative D x) (at x within S))"
     by (auto intro: has_derivative_within_subset)
   from bounded_derivative_imp_lipschitz[of S "poincare_map \<Sigma>" D B, OF this] \<open>convex S\<close> D c
     \<open>0 \<le> B\<close>
   have "B-lipschitz_on S (poincare_map \<Sigma>)" by auto
   then show "\<forall>x\<in>S. \<forall>y\<in>S. dist (poincare_map \<Sigma> x) (poincare_map \<Sigma> y) \<le> B * dist x y"
     by (auto simp: lipschitz_on_def)
 qed
 
 ML \<open>open ODE_Numerics_Tac\<close>
 
 lemma isFDERIV_product: "isFDERIV n xs fas vs \<longleftrightarrow>
   length fas = n \<and> length xs = n \<and>
   list_all (\<lambda>(x, f). isDERIV x f vs) (List.product xs fas)"
   apply (auto simp: isFDERIV_def list_all2_iff in_set_zip list_all_length product_nth)
    apply (metis gt_or_eq_0 less_mult_imp_div_less mod_less_divisor not_less0)
   by auto
 
 end
diff --git a/thys/Ordinary_Differential_Equations/Numerics/Refine_Rigorous_Numerics_Aform.thy b/thys/Ordinary_Differential_Equations/Numerics/Refine_Rigorous_Numerics_Aform.thy
--- a/thys/Ordinary_Differential_Equations/Numerics/Refine_Rigorous_Numerics_Aform.thy
+++ b/thys/Ordinary_Differential_Equations/Numerics/Refine_Rigorous_Numerics_Aform.thy
@@ -1,1740 +1,1743 @@
 theory Refine_Rigorous_Numerics_Aform
   imports
     Refine_Rigorous_Numerics
     "HOL-Types_To_Sets.Types_To_Sets"
 begin
 
 lemma Joints_ne_empty[simp]: "Joints xs \<noteq> {}" "{} \<noteq> Joints xs"
   by (auto simp: Joints_def valuate_def)
 
 lemma Inf_aform_le_Affine: "x \<in> Affine X \<Longrightarrow> Inf_aform X \<le> x"
   by (auto simp: Affine_def valuate_def intro!: Inf_aform)
 lemma Sup_aform_ge_Affine: "x \<in> Affine X \<Longrightarrow> x \<le> Sup_aform X"
   by (auto simp: Affine_def valuate_def intro!: Sup_aform)
 
 lemmas Inf_aform'_Affine_le = order_trans[OF Inf_aform' Inf_aform_le_Affine]
 lemmas Sup_aform'_Affine_ge = order_trans[OF Sup_aform_ge_Affine Sup_aform']
 
 fun approx_form_aform :: "nat \<Rightarrow> form \<Rightarrow> real aform list \<Rightarrow> bool" where
 "approx_form_aform prec (Less a b) bs =
    (case (approx_floatariths prec [a - b] bs)
    of Some [r] \<Rightarrow> Sup_aform' prec r < 0
     | _ \<Rightarrow> False)"
 | "approx_form_aform prec (LessEqual a b) bs =
    (case (approx_floatariths prec [a - b] bs)
    of Some [r] \<Rightarrow> Sup_aform' prec r \<le> 0
     | _ \<Rightarrow> False)"
 | "approx_form_aform prec (AtLeastAtMost a b c) bs =
    (case (approx_floatariths prec [a - b, a - c] bs)
    of Some [r, s] \<Rightarrow> 0 \<le> Inf_aform' prec r \<and>  Sup_aform' prec s \<le> 0
     | _ \<Rightarrow> False)"
 | "approx_form_aform prec (Bound a b c d) bs = False"
 | "approx_form_aform prec (Assign a b c) bs = False"
 | "approx_form_aform prec (Conj a b) bs \<longleftrightarrow>
     approx_form_aform prec a bs \<and> approx_form_aform prec b bs"
 | "approx_form_aform prec (Disj a b) bs \<longleftrightarrow>
     approx_form_aform prec a bs \<or> approx_form_aform prec b bs"
 
 lemma in_Joints_intervalD:
   "x \<in> {Inf_aform' p X .. Sup_aform' p X} \<and> xs \<in> Joints XS"
   if "x#xs \<in> Joints (X#XS)"
   using that
   by (auto simp: Joints_def valuate_def Affine_def
       intro!: Inf_aform'_Affine_le Sup_aform'_Affine_ge)
 
 lemma approx_form_aform:
   "interpret_form f vs"
   if "approx_form_aform p f VS" "vs \<in> Joints VS"
   using that
   by (induction f)
     (auto split: option.splits list.splits simp: algebra_simps
       dest!: approx_floatariths_outer
       dest!: in_Joints_intervalD[where p=p])
 
 fun msum_aforms::"nat \<Rightarrow> real aform list \<Rightarrow> real aform list \<Rightarrow> real aform list"  where
   "msum_aforms d (x#xs) (y#ys) = msum_aform d x y#msum_aforms d xs ys"
 | "msum_aforms d _ _ = []"
 
 definition [simp]: "degree_aforms_real = (degree_aforms::real aform list \<Rightarrow> nat)"
 
 abbreviation "msum_aforms' \<equiv> \<lambda>X Y. msum_aforms (degree_aforms_real (X @ Y)) X Y"
 
 lemma aform_val_msum_aforms:
   assumes "degree_aforms xs \<le> d"
   shows "aform_vals e (msum_aforms d xs ys) = List.map2 (+) (aform_vals e xs) (aform_vals (\<lambda>i. e (i + d)) ys)"
   using assms
 proof (induction xs ys rule: msum_aforms.induct)
   case (1 d x xs y ys)
   from 1 have "degree_aforms xs \<le> d"
     by (auto simp: degrees_def)
   from 1(1)[OF this] 1
   have "aform_vals e (msum_aforms d xs ys) = List.map2 (+) (aform_vals e xs) (aform_vals (\<lambda>i. e (i + d)) ys)"
     by simp
   then show ?case
     using 1
     by (simp add: aform_vals_def aform_val_msum_aform degrees_def)
 qed (auto simp: aform_vals_def)
 
 lemma Joints_msum_aforms:
   assumes "degree_aforms xs \<le> d"
   assumes "degree_aforms ys \<le> d"
   shows "Joints (msum_aforms d xs ys) = {List.map2 (+) a b |a b. a \<in> Joints xs \<and> b \<in> Joints ys}"
   apply (auto simp: Joints_def valuate_def aform_vals_def[symmetric]
       aform_val_msum_aforms assms)
    apply force
   subgoal for e e'
     apply (rule image_eqI[where x="\<lambda>i. if i < d then e i else e' (i - d)"])
      apply (auto simp: Pi_iff)
   proof goal_cases
     case 1
     have "(aform_vals e xs) = aform_vals (\<lambda>i. if i < d then e i else e' (i - d)) xs"
       using assms
       by (auto intro!: simp: aform_vals_def aform_val_def degrees_def intro!: pdevs_val_degree_cong)
     then show ?case
       by simp
   qed
   done
 
 definition "split_aforms_largest_uncond_take n X =
   (let (i, x) = max_pdev (abssum_of_pdevs_list (map snd (take n X))) in split_aforms X i)"
 
 text \<open>intersection with plane\<close>
 
 definition
   "project_coord x b n = (\<Sum>i\<leftarrow>Basis_list. (if i = b then n else if i = -b then -n else x \<bullet> i) *\<^sub>R i)"
 
 lemma inner_eq_abs_times_sgn:
   "u \<bullet> b = abs u \<bullet> b * sgn (u \<bullet> b)" if "b \<in> Basis" for b::"'a::ordered_euclidean_space"
   by (subst sgn_mult_abs[symmetric]) (auto simp: that abs_inner )
 
 lemma inner_Basis_eq_zero_absI: "x \<in> Basis \<Longrightarrow> abs u \<in> Basis \<Longrightarrow> x \<noteq> \<bar>u\<bar> \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> u \<bullet> x = 0"
   for x::"'a::ordered_euclidean_space"
   apply (subst euclidean_inner)
   apply (auto simp: inner_Basis if_distribR if_distrib cong: if_cong)
   apply (subst inner_eq_abs_times_sgn)
   by (auto simp: inner_Basis)
 
 lemma abs_in_BasisE:
   fixes u::"'a::ordered_euclidean_space"
   assumes "abs u \<in> Basis"
   obtains "abs u = u" | "abs u = - u"
 proof (cases "u \<bullet> abs u = 1")
   case True
   have "abs u = (\<Sum>i\<in>Basis. (if i = abs u then (abs u \<bullet> i) *\<^sub>R i else 0))"
     using assms
     by (auto simp: )
   also have "\<dots> = (\<Sum>i\<in>Basis. (if i = abs u then (u \<bullet> i) *\<^sub>R i else 0))"
     by (rule sum.cong) (auto simp: True)
   also have "\<dots> = (\<Sum>i\<in>Basis. (u \<bullet> i) *\<^sub>R i)"
     by (rule sum.cong) (auto simp: inner_Basis_eq_zero_absI assms)
   also have "\<dots> = u" by (simp add: euclidean_representation)
   finally show ?thesis ..
 next
   case False
   then have F: "u \<bullet> \<bar>u\<bar> = -1"
     apply (subst inner_eq_abs_times_sgn[OF assms]) 
     apply (subst (asm) inner_eq_abs_times_sgn[OF assms]) 
     using assms
     apply (auto simp: inner_Basis sgn_if)
     by (metis (full_types) abs_0_eq euclidean_all_zero_iff inner_Basis_eq_zero_absI nonzero_Basis)
   have "abs u = (\<Sum>i\<in>Basis. (if i = abs u then (abs u \<bullet> i) *\<^sub>R i else 0))"
     using assms
     by (auto simp: )
   also have "\<dots> = (\<Sum>i\<in>Basis. (if i = abs u then (- u \<bullet> i) *\<^sub>R i else 0))"
     by (rule sum.cong) (auto simp: F)
   also have "\<dots> = (\<Sum>i\<in>Basis. (- u \<bullet> i) *\<^sub>R i)"
     by (rule sum.cong) (auto simp: inner_Basis_eq_zero_absI assms)
   also have "\<dots> = - u" by (subst euclidean_representation) simp
   finally show ?thesis ..
 qed
   
 lemma abs_in_Basis_iff:
   fixes u::"'a::ordered_euclidean_space"
   shows "abs u \<in> Basis \<longleftrightarrow> u \<in> Basis \<or> - u \<in> Basis"
 proof -
   have u: "u = (\<Sum>i\<in>Basis. (u \<bullet> i) *\<^sub>R i)"
     by (simp add: euclidean_representation)
   have u': "- u = (\<Sum>i\<in>Basis. (- (u \<bullet> i)) *\<^sub>R i)"
     by (subst u) (simp add: sum_negf)
   have au: "abs u = (\<Sum>i\<in>Basis. \<bar>u \<bullet> i\<bar> *\<^sub>R i)"
     by (simp add: eucl_abs[where 'a='a])
   have "(u \<in> Basis \<or> - u \<in> Basis)" if "(\<bar>u\<bar> \<in> Basis)"
     apply (rule abs_in_BasisE[OF that])
     using that
     by auto
   show ?thesis
     apply safe
     subgoal premises prems
       using prems(1)
       apply (rule abs_in_BasisE)
       using prems
       by simp_all
     subgoal
       apply (subst au)
       apply (subst (asm) u)
       apply (subst sum.cong[OF refl])
        apply (subst abs_inner[symmetric]) apply auto
       using u apply auto[1]
       done
     subgoal
       apply (subst au)
       apply (subst (asm) u')
       apply (subst sum.cong[OF refl])
       apply (subst abs_inner[symmetric]) apply auto
       using u' apply auto
       by (metis Basis_nonneg abs_of_nonpos inner_minus_left neg_0_le_iff_le scaleR_left.minus)
     done
 qed
 
 lemma abs_inner_Basis:
   fixes u v::"'a::ordered_euclidean_space"
   assumes "abs u \<in> Basis" "abs v \<in> Basis"
   shows "inner u v = (if u = v then 1 else if u = -v then -1 else 0)"
 proof -
   define i where "i \<equiv> if u \<in> Basis then u else -u"
   define j where "j \<equiv> if v \<in> Basis then v else -v"
   have u: "u = (if u \<in> Basis then i else - i)"
     and v: "v = (if v \<in> Basis then j else - j)"
     by (auto simp: i_def j_def)
   have "i \<in> Basis" "j \<in> Basis"
     using assms
      by (auto simp: i_def j_def abs_in_Basis_iff)
    then show ?thesis
      apply (subst u)
      apply (subst v)
      apply (auto simp: inner_Basis)
      apply (auto simp: j_def i_def split: if_splits)
      using Basis_nonneg abs_of_nonpos by fastforce
  qed
 
 lemma
   project_coord_inner_Basis:
   assumes "i \<in> Basis"
   shows "(project_coord x b n) \<bullet> i = (if i = b then n else if i = -b then -n else x \<bullet> i)"
 proof -
   have "project_coord x b n \<bullet> i =
     (\<Sum>j\<in>Basis. (if j = b then n else if j = -b then -n else x \<bullet> j) * (if j = i then 1 else 0))"
     using assms
     by (auto simp: project_coord_def inner_sum_left inner_Basis)
   also have "\<dots> = (\<Sum>j\<in>Basis. (if j = i then (if j = b then n else if j = -b then -n else x \<bullet> j) else 0))"
     by (rule sum.cong) auto
   also have "\<dots> = (if i = b then n else if i = -b then -n else x \<bullet> i)"
     using assms
     by (subst sum.delta) auto
   finally show ?thesis by simp
 qed
 
 lemma
   project_coord_inner:
   assumes "abs i \<in> Basis"
   shows "(project_coord x b n) \<bullet> i = (if i = b then n else if i = -b then -n else x \<bullet> i)"
 proof -
   consider "i \<in> Basis" | "- i \<in> Basis"
     using assms
     by (auto simp: abs_in_Basis_iff)
   then show ?thesis
   proof cases
     case 1
     then show ?thesis by (simp add: project_coord_inner_Basis)
   next
     case 2
     have "project_coord x b n \<bullet> i = - (project_coord x b n \<bullet> - i)"
       by simp
     also have "\<dots> = - (if - i = b then n else if - i = -b then -n else x \<bullet> - i)"
       using 2
       by (subst project_coord_inner_Basis) simp_all
     also have "\<dots> = (if i = b then n else if i = -b then -n else x \<bullet> i)"
       using 2 by auto (metis Basis_nonneg abs_le_zero_iff abs_of_nonneg neg_le_0_iff_le nonzero_Basis)
     finally show ?thesis .
   qed
 qed
 
 lift_definition project_coord_pdevs::"'a::executable_euclidean_space sctn \<Rightarrow> 'a pdevs \<Rightarrow> 'a pdevs" is
   "\<lambda>sctn xs i. project_coord (xs i) (normal sctn) 0"
   by (rule finite_subset) (auto simp: project_coord_def cong: if_cong)
 
 definition "project_coord_aform sctn cxs =
   (project_coord (fst cxs) (normal sctn) (pstn sctn), project_coord_pdevs sctn (snd cxs))"
 
 definition project_coord_aform_lv :: "real aform list \<Rightarrow> nat \<Rightarrow> real \<Rightarrow> real aform list"
   where "project_coord_aform_lv xs b n = xs[b:=(n, zero_pdevs)]"
 
 definition "project_ncoord_aform x b n = project_coord_aform (Sctn (Basis_list ! b) n) x"
 
 lemma
   finite_sum_subset_aux_lemma:
   assumes "finite s"
   shows " {i. (\<Sum>x\<in>s. f x i) \<noteq> 0} \<subseteq> {i. \<exists>x\<in>s. f x i \<noteq> 0}"
 proof -
   have "{i. (\<Sum>x\<in>s. f x i) \<noteq> 0} = - {i. (\<Sum>x\<in>s. f x i) = 0}"
     by auto
   also have "\<dots> \<subseteq> - {i. \<forall>x \<in> s. f x i = 0}"
     by auto
   also have "\<dots> = {i. \<exists>x \<in> s. f x i \<noteq> 0}"
     by auto
   finally show ?thesis by simp
 qed
 
 lift_definition sum_pdevs::"('i \<Rightarrow> 'a::comm_monoid_add pdevs) \<Rightarrow> 'i set \<Rightarrow>  'a pdevs"
   is "\<lambda>f X. if finite X then (\<lambda>i. \<Sum>x\<in>X. f x i) else (\<lambda>_. 0)"
   apply auto
   apply (rule finite_subset)
    apply (rule finite_sum_subset_aux_lemma)
    apply auto
   done
 
 lemma pdevs_apply_sum_pdevs[simp]:
   "pdevs_apply (sum_pdevs f X) i = (\<Sum>x\<in>X. pdevs_apply (f x) i)"
   by transfer auto
 
 lemma sum_pdevs_empty[simp]: "sum_pdevs f {} = zero_pdevs"
   by transfer auto
 
 lemma sum_pdevs_insert[simp]:
   "finite xs \<Longrightarrow> sum_pdevs f (insert a xs) =
     (if a \<in> xs then sum_pdevs f xs else add_pdevs (f a) (sum_pdevs f xs))"
   by (auto simp: insert_absorb intro!: pdevs_eqI)
 
 lemma sum_pdevs_infinite[simp]: "infinite X \<Longrightarrow> sum_pdevs f X = zero_pdevs"
   by transfer auto
 
 lemma compute_sum_pdevs[code]:
   "sum_pdevs f (set XS) = foldr (\<lambda>a b. add_pdevs (f a) b) (remdups XS) zero_pdevs"
   by (induction XS) (auto simp: )
 
 lemma degree_sum_pdevs_le:
   "degree (sum_pdevs f X) \<le> Max (degree ` f ` X)"
   apply (rule degree_le)
   apply auto
   apply (cases "X = {}")
   subgoal by (simp add: )
   subgoal by (cases "finite X") simp_all
   done
 
 lemma pdevs_val_sum_pdevs:
   "pdevs_val e (sum_pdevs f X) = (\<Sum>x\<in>X. pdevs_val e (f x))"
   apply (cases "finite X")
   subgoal
     apply (subst pdevs_val_sum_le)
      apply (rule degree_sum_pdevs_le)
     apply (auto simp: scaleR_sum_right)
     apply (subst sum.swap)
     apply (rule sum.cong[OF refl])
     apply (subst pdevs_val_sum_le[where d="Max (degree ` f ` X)"])
      apply (auto simp: Max_ge_iff)
     done
   subgoal by simp
   done
 
 definition eucl_of_list_aform :: "(real \<times> real pdevs) list \<Rightarrow> 'a::executable_euclidean_space aform"
 where "eucl_of_list_aform xs =
   (eucl_of_list (map fst xs), sum_pdevs (\<lambda>i. pdevs_scaleR (snd (xs ! index Basis_list i)) i) Basis)"
 
 definition lv_aforms_rel::"(((real \<times> real pdevs) list) \<times> ('a::executable_euclidean_space aform)) set"
   where "lv_aforms_rel = br eucl_of_list_aform (\<lambda>xs. length xs = DIM('a))"
 
 
 definition "inner_aforms' p X Y =
   (let fas = [inner_floatariths (map floatarith.Var [0..<length X])
     (map floatarith.Var[length X..<length X + length Y])]
   in
     approx_slp_outer p (length fas) fas (X@Y)
     )"
 
 lemma
   affine_extension_AffineD:
   assumes "affine_extension2 (\<lambda>d x y. Some (F d x y)) f"
   assumes "[x, y] \<in> Joints [X, Y]"
   assumes "d \<ge> degree_aform X"
   assumes "d \<ge> degree_aform Y"
   shows "f x y \<in> Affine (F d X Y)"
 proof -
   from assms(2) obtain e where e:
     "e \<in> funcset UNIV {-1 .. 1}"
     "x = aform_val e X"
     "y = aform_val e Y"
     by (auto simp: Joints_def valuate_def)
   from affine_extension2E[OF assms(1) refl e(1) assms(3) assms(4)]
   obtain e' where "e' \<in> funcset UNIV {- 1..1}" "f (aform_val e X) (aform_val e Y) = aform_val e' (F d X Y)"
     "\<And>n. n < d \<Longrightarrow> e' n = e n" "aform_val e X = aform_val e' X" "aform_val e Y = aform_val e' Y"
     by auto
   then show ?thesis by (auto simp: Affine_def valuate_def e)
 qed
 
 lemma aform_val_zero_pdevs[simp]: "aform_val e (x, zero_pdevs) = x"
   by (auto simp: aform_val_def)
 
 lemma neg_equal_zero_eucl[simp]: "-a = a \<longleftrightarrow> a = 0" for a::"'a::euclidean_space"
   by (auto simp: algebra_simps euclidean_eq_iff[where 'a='a])
 
 context includes autoref_syntax begin
 
 lemma Option_bind_param[param, autoref_rules]:
   "((\<bind>), (\<bind>)) \<in> \<langle>S\<rangle>option_rel \<rightarrow> (S \<rightarrow> \<langle>R\<rangle>option_rel) \<rightarrow> \<langle>R\<rangle>option_rel"
   unfolding Option.bind_def
   by parametricity
 
 lemma zip_Basis_list_pat[autoref_op_pat_def]: "\<Sum>(b, m)\<leftarrow>zip Basis_list ms. m *\<^sub>R b \<equiv> OP eucl_of_list $ ms"
 proof (rule eq_reflection)
   have z: "zip ms (Basis_list::'a list) = map (\<lambda>(x, y). (y, x)) (zip Basis_list ms)"
     by (subst zip_commute) simp
   show "(\<Sum>(b, m)\<leftarrow>zip (Basis_list::'a list) ms. m *\<^sub>R b) = OP eucl_of_list $ ms"
     unfolding eucl_of_list_def autoref_tag_defs
     apply (subst z)
     apply (subst map_map)
     apply (auto cong: map_cong simp: split_beta')
     done
 qed
 
 lemma length_aforms_of_ivls: "length (aforms_of_ivls a b) = min (length a) (length b)"
   by (auto simp: aforms_of_ivls_def)
 
 lemma length_lv_rel:
   "(ys, y::'a) \<in> lv_rel \<Longrightarrow> length ys = DIM('a::executable_euclidean_space)"
   by (auto simp: lv_rel_def br_def)
 
 lemma lv_rel_nth[simp]: "(xs, x::'a::executable_euclidean_space) \<in> lv_rel \<Longrightarrow> b \<in> Basis \<Longrightarrow>
   xs ! index (Basis_list) b = x \<bullet> b"
   unfolding lv_rel_def
   by (auto simp: br_def eucl_of_list_inner)
 
 lemma aform_of_ivl_autoref[autoref_rules]:
   "(aforms_of_ivls, aform_of_ivl) \<in> lv_rel \<rightarrow> lv_rel \<rightarrow> lv_aforms_rel"
   apply (auto simp: lv_aforms_rel_def br_def eucl_of_list_aform_def length_aforms_of_ivls length_lv_rel)
   subgoal for xs x ys y
     apply (auto simp: aform_of_ivl_def aforms_of_ivls_def o_def eucl_of_list_inner inner_simps
         pdevs_apply_pdevs_of_ivl length_lv_rel
         intro!: euclidean_eqI[where 'a='a] pdevs_eqI)
     by (metis index_Basis_list_nth inner_not_same_Basis length_Basis_list nth_Basis_list_in_Basis)
   done
 
 lemma bound_intersect_2d_ud[autoref_rules]:
   shows "(bound_intersect_2d_ud, bound_intersect_2d_ud) \<in> nat_rel \<rightarrow> ((rnv_rel \<times>\<^sub>r rnv_rel) \<times>\<^sub>r Id) \<rightarrow> rnv_rel \<rightarrow> \<langle>rnv_rel \<times>\<^sub>r rnv_rel\<rangle>option_rel"
   by auto
 
 lemma eucl_of_list_autoref[autoref_rules]:
   includes autoref_syntax
   assumes "SIDE_PRECOND (length xs = DIM('a::executable_euclidean_space))"
   assumes "(xsi, xs) \<in> \<langle>rnv_rel\<rangle>list_rel"
   shows "(xsi, eucl_of_list $ xs::'a) \<in> lv_rel"
   using assms
   unfolding lv_rel_def
   by (auto simp: br_def)
 
 definition "inner2s x b c = (inner_lv_rel x b, inner_lv_rel x c)"
 
 lemma inner_lv_rel_autoref[autoref_rules]:
   "(inner_lv_rel, (\<bullet>)) \<in> lv_rel \<rightarrow> lv_rel \<rightarrow> rnv_rel"
   using lv_rel_inner[unfolded inner_lv_rel_def[symmetric]]
   by auto
 
 lemma inner_lv_rel_eq:
   "\<lbrakk>length xs = DIM('a::executable_euclidean_space); (xa, x'a) \<in> lv_rel\<rbrakk> \<Longrightarrow>
   inner_lv_rel xs xa = eucl_of_list xs \<bullet> (x'a::'a)"
   using inner_lv_rel_autoref[param_fo, of "xs" "eucl_of_list xs" xa x'a]
   unfolding lv_rel_def
   by (auto simp: br_def)
 
 definition "inner_pdevs xs ys = sum_pdevs (\<lambda>i. scaleR_pdevs (ys ! i) (xs ! i)) {..<length xs}"
 
 definition "pdevs_inner2s xs a b = prod_of_pdevs (inner_pdevs xs a) (inner_pdevs xs b)"
 
 lemma inner2_aform_autoref[autoref_rules]:
   shows "((\<lambda>xs a b. (inner2s (map fst xs) a b, pdevs_inner2s (map snd xs) a b)), inner2_aform) \<in> lv_aforms_rel \<rightarrow> lv_rel \<rightarrow> lv_rel \<rightarrow> ((rnv_rel \<times>\<^sub>r rnv_rel)\<times>\<^sub>rId)"
   unfolding inner2_aform_def
   apply (auto simp: lv_aforms_rel_def br_def eucl_of_list_aform_def inner2_aform_def )
    apply (auto simp: inner2s_def inner2_def inner_lv_rel_eq pdevs_inner2s_def inner_pdevs_def
       sum_Basis_sum_nth_Basis_list inner_sum_left inner_Basis mult.commute
       intro!: pdevs_eqI)
   subgoal for a b c d e f
     apply (rule sum.cong)
      apply force
     subgoal for n by (auto dest!: lv_rel_nth[where b="Basis_list ! n"] simp: inner_commute)
     done
   subgoal for a b c d e f
     apply (rule sum.cong)
      apply force
     subgoal for n by (auto dest!: lv_rel_nth[where b="Basis_list ! n"] simp: inner_commute)
     done
   done
 
 lemma RETURN_inter_aform_plane_ortho_annot:
   "RETURN (inter_aform_plane_ortho p (Z::'a aform) n g) =
     (case those (map (\<lambda>b. bound_intersect_2d_ud p (inner2_aform Z n b) g) Basis_list) of
       Some mMs \<Rightarrow>
       do {
         ASSERT (length mMs = DIM('a::executable_euclidean_space));
         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);
         RETURN (Some (aform_of_ivl l u))
       }
   | None \<Rightarrow> RETURN None)"
   apply (auto simp: inter_aform_plane_ortho_def split: option.splits)
   subgoal premises prems for x2
   proof -
     have "length x2 = DIM('a)" using prems
       using map_eq_imp_length_eq by (force simp: those_eq_Some_map_Some_iff)
     then show ?thesis using prems by auto
   qed
   done
 
 definition "inter_aform_plane_ortho_nres p Z n g = RETURN (inter_aform_plane_ortho p Z n g)"
 
 schematic_goal inter_aform_plane_ortho_lv:
   fixes Z::"'a::executable_euclidean_space aform"
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a) D"
   assumes [autoref_rules]: "(pp, p) \<in> nat_rel" "(Zi, Z) \<in> lv_aforms_rel"
     "(ni, n) \<in> lv_rel" "(gi, g) \<in> rnv_rel"
   notes [autoref_rules] = those_param param_map
   shows "(nres_of (?f::?'a dres), inter_aform_plane_ortho_nres $ p $ Z $ n $ g) \<in> ?R"
   unfolding autoref_tag_defs
   unfolding RETURN_inter_aform_plane_ortho_annot inter_aform_plane_ortho_nres_def
   including art
   by autoref_monadic
 concrete_definition inter_aform_plane_ortho_lv for pp Zi ni gi uses inter_aform_plane_ortho_lv
 lemmas [autoref_rules] = inter_aform_plane_ortho_lv.refine
 
 lemma project_coord_lv[autoref_rules]:
   assumes "(xs, x::'a::executable_euclidean_space aform) \<in> lv_aforms_rel" "(ni, n) \<in> nat_rel"
   assumes "SIDE_PRECOND (n < DIM('a))"
   shows "(project_coord_aform_lv xs ni, project_ncoord_aform $ x $ n) \<in> rnv_rel \<rightarrow> lv_aforms_rel"
   using assms
   apply (auto simp: project_coord_aform_lv_def project_ncoord_aform_def lv_rel_def
       project_coord_aform_def eucl_of_list_aform_def
       lv_aforms_rel_def br_def)
   subgoal
     apply (auto intro!: euclidean_eqI[where 'a='a])
     apply (subst project_coord_inner_Basis)
      apply (auto simp: eucl_of_list_inner )
      apply (subst nth_list_update)
       apply (auto simp: )
     using in_Basis_index_Basis_list apply force
     using inner_not_same_Basis nth_Basis_list_in_Basis apply fastforce
     apply (auto simp: nth_list_update)
     done
   subgoal for i
     apply (auto intro!: pdevs_eqI simp: project_coord_pdevs.rep_eq)
     apply (auto intro!: euclidean_eqI[where 'a='a])
     apply (subst project_coord_inner_Basis)
      apply (auto simp: eucl_of_list_inner )
      apply (subst nth_list_update)
       apply (auto simp: )
     using inner_not_same_Basis nth_Basis_list_in_Basis apply fastforce
     apply (auto simp: nth_list_update)
     done
   done
 
 definition inter_aform_plane
   where "inter_aform_plane prec Xs (sctn::'a sctn) =
     do {
       cxs \<leftarrow> inter_aform_plane_ortho_nres (prec) (Xs) (normal sctn) (pstn sctn);
       case cxs of
         Some cxs \<Rightarrow>
           (if normal sctn \<in> set Basis_list
             then do {
               ASSERT (index Basis_list (normal sctn) < DIM('a::executable_euclidean_space));
               RETURN ((project_ncoord_aform cxs (index Basis_list (normal sctn)) (pstn sctn)))
             }
           else if - normal sctn \<in> set Basis_list
             then do {
               ASSERT (index Basis_list (-normal sctn) < DIM('a));
               RETURN ((project_ncoord_aform cxs (index Basis_list (-normal sctn)) (- pstn sctn)))
             }
           else SUCCEED)
       | None \<Rightarrow> SUCCEED
     }"
 
 lemma [autoref_rules]:
   assumes [THEN GEN_OP_D, param]: "GEN_OP (=) (=) (A \<rightarrow> A \<rightarrow> bool_rel)"
   shows "(index, index) \<in> \<langle>A\<rangle>list_rel \<rightarrow> A \<rightarrow> nat_rel"
   unfolding index_def find_index_def
   by parametricity
 
 schematic_goal inter_aform_plane_lv:
   fixes Z::"'a::executable_euclidean_space aform"
   assumes [autoref_rules_raw]: "DIM_precond TYPE('a) D"
   assumes [autoref_rules]: "(preci, prec) \<in> nat_rel" "(Zi, Z) \<in> lv_aforms_rel"
       "(sctni, sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
   notes [autoref_rules] = those_param param_map
   shows "(nres_of (?f::?'a dres), inter_aform_plane prec Z sctn) \<in> ?R"
   unfolding autoref_tag_defs
   unfolding inter_aform_plane_def
   including art
   by (autoref_monadic )
 
 concrete_definition inter_aform_plane_lv for preci Zi sctni uses inter_aform_plane_lv
 lemmas [autoref_rules] = inter_aform_plane_lv.refine[autoref_higher_order_rule(1)]
 
 end
 
 
 lemma Basis_not_uminus:
   fixes i::"'a::euclidean_space"
   shows "i \<in> Basis \<Longrightarrow> - i \<notin> Basis"
   by (metis inner_Basis inner_minus_left one_neq_neg_one zero_neq_neg_one)
 
 lemma
   pdevs_apply_project_coord_pdevs:
   assumes "normal sctn \<in> Basis \<or> - normal sctn \<in> Basis"
   assumes "i \<in> Basis"
   shows "pdevs_apply (project_coord_pdevs sctn cxs) x \<bullet> i =
     (if i = abs (normal sctn) then 0 else pdevs_apply cxs x \<bullet> i)"
   using assms[unfolded abs_in_Basis_iff[symmetric]]
   apply (transfer fixing: sctn)
   apply (auto simp: project_coord_inner Basis_not_uminus)
   using Basis_nonneg apply force
   using Basis_nonneg assms(1) by force
 
 lemma pdevs_domain_project_coord_pdevs_subset:
   "pdevs_domain (project_coord_pdevs sctn X) \<subseteq> pdevs_domain X"
   apply (auto simp: )
   apply (auto simp: euclidean_eq_iff[where 'a='a] )
   by (metis add.inverse_neutral project_coord_inner_Basis project_coord_pdevs.rep_eq)
 
 lemma pdevs_val_project_coord_pdevs_inner_Basis:
   assumes "b \<in> Basis"
   shows "pdevs_val e (project_coord_pdevs sctn X) \<bullet> b =
     (if b = abs (normal sctn) then 0 else pdevs_val e X \<bullet> b)"
   using assms
   apply (auto simp: )
    apply (simp add: pdevs_val_pdevs_domain inner_sum_left )
    apply (subst sum.cong[OF refl])
     apply (subst pdevs_apply_project_coord_pdevs)
       apply (simp add: abs_in_Basis_iff)
      apply simp
     apply (rule refl)
    apply auto
   unfolding pdevs_val_pdevs_domain inner_sum_left
   apply (rule sum.mono_neutral_cong_left)
      apply simp
     apply (rule pdevs_domain_project_coord_pdevs_subset)
      apply auto
    apply (metis Basis_nonneg abs_minus_cancel abs_of_nonneg euclidean_all_zero_iff
       project_coord_inner_Basis project_coord_pdevs.rep_eq)
    apply (metis Basis_nonneg abs_minus_cancel abs_of_nonneg
       project_coord_inner_Basis project_coord_pdevs.rep_eq)
   done
 
 lemma inner_in_Sum: "b \<in> Basis \<Longrightarrow> x \<bullet> b = (\<Sum>i\<in>Basis. x \<bullet> i * (i \<bullet> b))"
   apply (subst euclidean_representation[of x, symmetric])
   unfolding inner_sum_left
   by (auto simp: intro!: )
 
 lemma aform_val_project_coord_aform:
   "aform_val e (project_coord_aform sctn X) = project_coord (aform_val e X) (normal sctn) (pstn sctn)"
   apply (auto simp: aform_val_def project_coord_def project_coord_aform_def)
   apply (rule euclidean_eqI)
   unfolding inner_add_left inner_sum_left
   apply (subst pdevs_val_project_coord_pdevs_inner_Basis)
    apply (auto simp: )
    apply (rule sum.cong)
   apply auto
    apply (metis abs_in_Basis_iff abs_inner abs_inner_Basis abs_zero inner_commute)
   apply (subst inner_in_Sum[where x="pdevs_val e (snd X)"], force)
   unfolding sum.distrib[symmetric]
   apply (rule sum.cong)
   apply auto
   apply (metis Basis_nonneg abs_inner_Basis abs_of_nonneg abs_of_nonpos inner_commute neg_0_le_iff_le)
    apply (metis Basis_nonneg abs_inner_Basis abs_of_nonneg abs_of_nonpos neg_0_le_iff_le)
   apply (auto simp: inner_Basis)
   done
 
 lemma project_coord_on_plane:
   assumes "x \<in> plane_of (Sctn n c)"
   shows "project_coord x n c = x"
   using assms
   by (auto simp: project_coord_def plane_of_def intro!: euclidean_eqI[where 'a='a])
 
 lemma
   mem_Affine_project_coord_aformI:
   assumes "x \<in> Affine X"
   assumes "x \<in> plane_of sctn"
   shows "x \<in> Affine (project_coord_aform sctn X)"
 proof -
   have "x = project_coord x (normal sctn) (pstn sctn)"
     using assms by (intro project_coord_on_plane[symmetric]) auto
   also
   from assms obtain e where "e \<in> funcset UNIV {-1 .. 1}" "x = aform_val e X"
     by (auto simp: Affine_def valuate_def)
   note this(2)
   also have "project_coord (aform_val e X) (normal sctn) (pstn sctn) =
     aform_val e (project_coord_aform sctn X)"
     by (simp add: aform_val_project_coord_aform)
   finally have "x = aform_val e (project_coord_aform sctn X)" unfolding \<open>x = aform_val e X\<close> .
   then show ?thesis using \<open>e \<in> _\<close>
     by (auto simp: Affine_def valuate_def)
 qed
 
 lemma
   mem_Affine_project_coord_aformD:
   assumes "x \<in> Affine (project_coord_aform sctn X)"
   assumes "abs (normal sctn) \<in> Basis"
   shows "x \<in> plane_of sctn"
   using assms
   by (auto simp: Affine_def valuate_def aform_val_project_coord_aform plane_of_def
       project_coord_inner)
 
 definition "reduce_aform prec t X =
     summarize_aforms (prec) (collect_threshold (prec) 0 t) (degree_aforms X) X"
 
 definition "correct_girard p m N (X::real aform list) =
   (let
     Xs = map snd X;
     M = pdevs_mapping Xs;
     D = domain_pdevs Xs;
     diff = m - card D
   in if 0 < diff then (\<lambda>_ _. True) else
     let
       Ds = sorted_list_of_set D;
       ortho_indices = map fst (take (diff + N) (sort_key (\<lambda>(i, r). r) (map (\<lambda>i. let xs = M i in (i, sum_list' p (map abs xs) - fold max (map abs xs) 0)) Ds)));
       _ = ()
     in (\<lambda>i (xs::real list). i \<notin> set ortho_indices))"
 
 definition "reduce_aforms prec C X = summarize_aforms (prec) C (degree_aforms X) X"
 
 definition "pdevs_of_real x = (x, zero_pdevs)"
 
 definition aform_inf_inner where "aform_inf_inner prec X n =
   (case inner_aforms' (prec) X (map pdevs_of_real n) of
     Some Xn \<Rightarrow> Inf_aform' (prec) (hd Xn))"
 definition aform_sup_inner where "aform_sup_inner prec X n =
   (case inner_aforms' (prec) X (map pdevs_of_real n) of
     Some Xn \<Rightarrow> Sup_aform' (prec) (hd Xn))"
 
 text \<open>cannot fail\<close>
 
-lemma approx_un_ne_None: "approx_un p (\<lambda>l u. Some (f l u)) (Some r) \<noteq> None"
+lemma approx_un_ne_None: "approx_un p (\<lambda>ivl. Some (f ivl)) (Some r) \<noteq> None"
   by (auto simp: approx_un_def split_beta')
 
 lemma approx_un_eq_Some:
-  "approx_un p (\<lambda>l u. Some (f l u)) (Some r) = Some s \<longleftrightarrow>
-  s = ivl_err ((fst (f (Inf_aform_err p r) (Sup_aform_err p r))))
-        ((snd (f (Inf_aform_err p r) (Sup_aform_err p r))))"
+  "approx_un p (\<lambda>ivl. Some (f ivl)) (Some r) = Some s \<longleftrightarrow>
+  s = ivl_err (real_interval (f (ivl_of_aform_err p r)))"
   using approx_un_ne_None
   by (auto simp: approx_un_def split_beta')
 
 lemma is_float_uminus:
   "is_float aa \<Longrightarrow> is_float (- aa)"
   by (auto simp: is_float_def)
 
 lemma is_float_uminus_iff[simp]:
   "is_float (- aa) = is_float aa"
   using is_float_uminus[of aa] is_float_uminus[of "-aa"]
   by (auto simp: is_float_def)
 
 lemma is_float_simps[simp]:
   "is_float 0"
   "is_float 1"
   "is_float (real_of_float x)"
   "is_float (truncate_down p X)"
   "is_float (truncate_up p X)"
   "is_float (eucl_truncate_down p X)"
   "is_float (eucl_truncate_up p X)"
   by (auto simp: is_float_def eucl_truncate_down_def eucl_truncate_up_def truncate_down_def truncate_up_def)
 
 lemma is_float_sum_list'[simp]:
   "is_float (sum_list' p xs)"
   by (induction xs) (auto simp: is_float_def)
 
 lemma is_float_inverse_aform': "is_float (fst (fst (inverse_aform' p X)))"
   unfolding inverse_aform'_def
   by (simp add: Let_def trunc_bound_eucl_def)
 
 lemma is_float_min_range:
   "min_range_antimono p F D E X Y = Some ((a, b), c) \<Longrightarrow> is_float a"
   "min_range_antimono p F D E X Y = Some ((a, b), c) \<Longrightarrow> is_float c"
   "min_range_mono p F D E X Y = Some ((a, b), c) \<Longrightarrow> is_float a"
   "min_range_mono p F D E X Y = Some ((a, b), c) \<Longrightarrow> is_float c"
   by (auto simp: min_range_antimono_def min_range_mono_def Let_def bind_eq_Some_conv
       prod_eq_iff trunc_bound_eucl_def
       mid_err_def affine_unop_def split: prod.splits)
 
 lemma is_float_ivl_err:
-  assumes "ivl_err (x1) (x2) = ((a, b), c)" "is_float x1" "is_float x2"
+  assumes "ivl_err x = ((a, b), c)" "is_float (lower x)" "is_float (upper x)"
   shows "is_float a" "is_float c"
 proof -
+  define x1 where "x1 = lower x"
+  define x2 where "x2 = upper x"
   have "a = (x1 + x2) / 2" "c = (x2 - x1) / 2"
-    using assms by (auto simp: ivl_err_def)
+    using assms by (auto simp: ivl_err_def x1_def x2_def)
   moreover have "(x1 + x2) / 2 \<in> float" "(x2 - x1) / 2 \<in> float"
     using assms
-    by (auto simp: is_float_def)
+    by (auto simp: is_float_def x1_def x2_def)
   ultimately show "is_float a" "is_float c"
     unfolding is_float_def by blast+
 qed
 
 lemma is_float_trunc_bound_eucl[simp]:
   "is_float (fst (trunc_bound_eucl p X))"
   by (auto simp: trunc_bound_eucl_def Let_def)
 
 lemma add_eq_times_2_in_float: "a + b = c * 2 \<Longrightarrow> is_float a \<Longrightarrow> is_float b \<Longrightarrow> is_float c"
 proof goal_cases
   case 1
   then have "c = (a + b) / 2"
     by simp
   also have "\<dots> \<in> float" using 1(3,2) by (simp add: is_float_def)
   finally show ?case by (simp add: is_float_def)
 qed
 
 
 lemma approx_floatarith_Some_is_float:
   "approx_floatarith p fa XS = Some ((a, b), ba) \<Longrightarrow>
   list_all (\<lambda>((a, b), c). is_float a \<and> is_float c) XS \<Longrightarrow>
   is_float a \<and> is_float ba"
   apply (induction fa arbitrary: a b ba)
   subgoal by (auto simp: bind_eq_Some_conv add_aform'_def Let_def )
   subgoal by (auto simp: bind_eq_Some_conv uminus_aform_def Let_def)
   subgoal by (auto simp: bind_eq_Some_conv mult_aform'_def Let_def )
   subgoal by (auto simp: bind_eq_Some_conv inverse_aform_err_def map_aform_err_def
         prod_eq_iff is_float_inverse_aform'
         acc_err_def aform_to_aform_err_def aform_err_to_aform_def inverse_aform_def
         Let_def split: if_splits)
   subgoal by (auto simp: bind_eq_Some_conv cos_aform_err_def Let_def is_float_min_range
         is_float_ivl_err
         split: if_splits prod.splits)
   subgoal by (auto simp: bind_eq_Some_conv arctan_aform_err_def Let_def is_float_min_range
         is_float_ivl_err
         split: if_splits prod.splits)
-  subgoal by (auto simp: bind_eq_Some_conv uminus_aform_def Let_def is_float_min_range
-        is_float_ivl_err
+  subgoal apply (auto simp: bind_eq_Some_conv uminus_aform_def Let_def is_float_min_range
+        is_float_ivl_err set_of_eq real_interval_abs
         split: if_splits prod.splits)
+    apply (metis is_float_ivl_err(1) is_float_simps(3) lower_real_interval real_interval_abs upper_real_interval)
+    by (metis is_float_ivl_err(2) is_float_simps(3) lower_real_interval real_interval_abs upper_real_interval)
   subgoal by (auto simp: bind_eq_Some_conv max_aform_err_def Let_def is_float_min_range
         is_float_ivl_err max_def
         split: if_splits prod.splits)
   subgoal by (auto simp: bind_eq_Some_conv min_aform_err_def Let_def is_float_min_range
         is_float_ivl_err min_def
         split: if_splits prod.splits)
   subgoal by (auto simp: bind_eq_Some_conv arctan_aform_err_def Let_def is_float_min_range
         is_float_ivl_err
         split: if_splits prod.splits)
   subgoal by (auto simp: bind_eq_Some_conv sqrt_aform_err_def Let_def is_float_min_range
         is_float_ivl_err
         split: if_splits prod.splits)
   subgoal by (auto simp: bind_eq_Some_conv exp_aform_err_def Let_def is_float_min_range
         is_float_ivl_err
         split: if_splits prod.splits)
   subgoal by (auto simp: bind_eq_Some_conv powr_aform_err_def approx_bin_def
         exp_aform_err_def Let_def is_float_min_range
         is_float_ivl_err mult_aform'_def
         split: if_splits prod.splits)
   subgoal by (auto simp: bind_eq_Some_conv ln_aform_err_def Let_def is_float_min_range
         is_float_ivl_err
         split: if_splits prod.splits)
   subgoal by (auto simp: bind_eq_Some_conv power_aform_err_def Let_def is_float_min_range
         is_float_ivl_err mid_err_def dest!: add_eq_times_2_in_float
         split: if_splits prod.splits)
   subgoal by (auto simp: bind_eq_Some_conv cos_aform_err_def Let_def is_float_min_range
         approx_un_def is_float_ivl_err
         split: if_splits)
   subgoal by (auto simp: bind_eq_Some_conv cos_aform_err_def Let_def is_float_min_range
         list_all_length
         split: if_splits)
   subgoal by (auto simp: bind_eq_Some_conv num_aform_def Let_def)
   done
 
 lemma plain_floatarith_not_None:
   assumes "plain_floatarith N fa" "N \<le> length XS"
     "list_all (\<lambda>((a, b), c). is_float a \<and> is_float c) XS"
   shows "approx_floatarith p fa XS \<noteq> None"
   using assms
   by (induction fa)
     (auto simp: Let_def split_beta' approx_un_eq_Some prod_eq_iff
       approx_floatarith_Some_is_float)
 
 lemma plain_floatarith_slp_not_None:
   assumes "\<And>fa. fa \<in> set fas \<Longrightarrow> plain_floatarith N fa" "N \<le> length XS"
     "list_all (\<lambda>((a, b), c). is_float a \<and> is_float c) XS"
   shows "approx_slp p fas XS \<noteq> None"
   using assms 
   apply (induction fas arbitrary: XS)
   subgoal by simp
   subgoal for fa fas XS
     using plain_floatarith_not_None[of N fa XS p]
     by (auto simp: Let_def split_beta' approx_un_eq_Some prod_eq_iff
       bind_eq_Some_conv approx_floatarith_Some_is_float)
   done
 
 lemma plain_floatarithE:
   assumes "plain_floatarith N fa" "N \<le> length XS"
     "list_all (\<lambda>((a, b), c). is_float a \<and> is_float c) XS"
   obtains R where "approx_floatarith p fa XS = Some R"
   using plain_floatarith_not_None[OF assms]
   by force
 
 lemma approx_slp_outer_eq_None_iff:
   "approx_slp_outer p a b XS = None \<longleftrightarrow>
     approx_slp p b ((map (\<lambda>x. (x, 0)) XS)) = None"
   by (auto simp: approx_slp_outer_def Let_def bind_eq_None_conv)
 
 lemma approx_slp_sing_eq_None_iff:
   "approx_slp p [b] xs = None \<longleftrightarrow> approx_floatarith p b xs = None"
   by (auto simp: approx_slp_outer_def Let_def bind_eq_None_conv)
 
 lemma plain_inner_floatariths:
   "plain_floatarith N (inner_floatariths xs ys)"
   if "list_all (plain_floatarith N) xs"  "list_all (plain_floatarith N) ys"
   using that
   by (induction xs ys rule: inner_floatariths.induct) auto
 
 lemma aiN: "approx_floatarith p (inner_floatariths xs ys) zs \<noteq> None"
   if "\<And>x. x \<in> set xs \<Longrightarrow> approx_floatarith p x zs \<noteq> None"
   and "\<And>x. x \<in> set ys \<Longrightarrow> approx_floatarith p x zs \<noteq> None"
   using that
   apply (induction xs ys rule: inner_floatariths.induct)
   apply (auto simp: Let_def bind_eq_Some_conv)
   by (metis old.prod.exhaust)
 
 lemma aiVN: "approx_floatarith p
         (inner_floatariths (map floatarith.Var [0..<length a])
           (map floatarith.Var [length a..<length a + length b]))
         (map (\<lambda>x. (x, 0)) a @ map (\<lambda>x. (x, 0)) b) \<noteq> None"
   by (rule aiN) (auto simp: nth_append)
 
 lemma iaN: "inner_aforms' p a b \<noteq> None"
   unfolding inner_aforms'_def Let_def approx_slp_outer_def
   using aiVN[of p a b]
   by (auto simp: Let_def bind_eq_Some_conv)
 
 definition "support_aform prec b X = (let ia = inner_aform X b in fst X \<bullet> b + tdev' (prec) (snd ia))"
 
 definition "width_aforms prec X =
   (let t = tdev' (prec) ((abssum_of_pdevs_list (map snd X))) in t)"
 
 definition "inf_aforms prec xs = map (Inf_aform' (prec)) xs"
 definition "sup_aforms prec xs = map (Sup_aform' (prec)) xs"
 
 definition "fresh_index_aforms xs = Max (insert 0 (degree_aform ` set xs))"
 
 definition "independent_aforms x env = (msum_aform (fresh_index_aforms env) (0, zero_pdevs) x#env)"
 
 definition "aform_form_ivl prec form xs =
   dRETURN (approx_form prec form (ivls_of_aforms prec xs) [])"
 definition "aform_form prec form xs =
   dRETURN (approx_form_aform prec form xs)"
 definition "aform_slp prec n slp xs =
   dRETURN (approx_slp_outer prec n slp xs)"
 definition
   "aform_isFDERIV prec n ns fas xs =
     dRETURN (isFDERIV_approx prec n ns fas (ivls_of_aforms prec xs))"
 
 definition aform_rel_internal: "aform_rel R = br Affine top O \<langle>R\<rangle>set_rel"
 lemma aform_rel_def: "\<langle>rnv_rel\<rangle>aform_rel = br Affine top"
   unfolding relAPP_def
   by (auto simp: aform_rel_internal)
 definition "aforms_rel = br Joints top"
 
 definition aform_rell :: "((real \<times> real pdevs) list \<times> real list set) set"
 where "aform_rell = aforms_rel"
 
 definition aforms_relp_internal: "aforms_relp R = aforms_rel O \<langle>R\<rangle>set_rel"
 lemma aforms_relp_def: "\<langle>R\<rangle>aforms_relp = aforms_rel O \<langle>R\<rangle>set_rel"
   by (auto simp: aforms_relp_internal relAPP_def)
 
 definition "product_aforms x y = x @ msum_aforms (degree_aforms (x)) (replicate (length y) (0, zero_pdevs)) y"
 
 lemma
   eucl_of_list_mem_eucl_of_list_aform:
   assumes "x \<in> Joints a"
   assumes "length a = DIM('a::executable_euclidean_space)"
   shows "eucl_of_list x \<in> Affine (eucl_of_list_aform a::'a aform)"
   using assms
   by (auto simp: Joints_def Affine_def valuate_def eucl_of_list_aform_def
       aform_val_def pdevs_val_sum_pdevs inner_simps eucl_of_list_inner
       intro!: euclidean_eqI[where 'a='a])
 
 lemma
   in_image_eucl_of_list_eucl_of_list_aform:
   assumes "length x = DIM('a::executable_euclidean_space)" "xa \<in> Affine (eucl_of_list_aform x::'a aform)"
   shows "xa \<in> eucl_of_list ` Joints x"
   using assms
   by (auto intro!: nth_equalityI image_eqI[where x="list_of_eucl xa"]
       simp: aform_val_def eucl_of_list_aform_def Affine_def valuate_def Joints_def
       inner_simps pdevs_val_sum_pdevs eucl_of_list_inner)
 
 lemma
   eucl_of_list_image_Joints:
   assumes "length x = DIM('a::executable_euclidean_space)"
   shows "eucl_of_list ` Joints x = Affine (eucl_of_list_aform x::'a aform)"
   using assms
   by (auto intro!: eucl_of_list_mem_eucl_of_list_aform
       in_image_eucl_of_list_eucl_of_list_aform)
 
 definition "aform_ops =
 \<lparr>
   appr_of_ivl = aforms_of_ivls,
   product_appr = product_aforms,
   msum_appr = msum_aforms',
   inf_of_appr = \<lambda>optns. inf_aforms (precision optns),
   sup_of_appr = \<lambda>optns. sup_aforms (precision optns),
   split_appr = split_aforms_largest_uncond_take,
   appr_inf_inner = \<lambda>optns. aform_inf_inner (precision optns),
   appr_sup_inner = \<lambda>optns. aform_sup_inner (precision optns),
   inter_appr_plane = \<lambda>optns xs sctn. inter_aform_plane_lv (length xs) (precision optns) xs sctn,
   reduce_appr = \<lambda>optns. reduce_aforms (precision optns),
   width_appr = \<lambda>optns. width_aforms (precision optns),
   approx_slp_dres = \<lambda>optns. aform_slp (precision optns),
   approx_euclarithform = \<lambda>optns. aform_form (precision optns),
   approx_isFDERIV = \<lambda>optns. aform_isFDERIV  (precision optns)
 \<rparr>"
 
 lemma Affine_eq_permI:
   assumes "fst X = fst Y"
   assumes "map snd (list_of_pdevs (snd X)) <~~> map snd (list_of_pdevs (snd Y))" (is "?perm X Y")
   shows "Affine X = Affine Y"
 proof -
   {
     fix X Y and e::"nat \<Rightarrow> real"
     assume perm: "?perm X Y" and e: "e \<in> funcset UNIV {- 1..1}"
     from pdevs_val_of_list_of_pdevs2[OF e, of "snd X"]
     obtain e' where e':
       "pdevs_val e (snd X) = pdevs_val e' (pdevs_of_list (map snd (list_of_pdevs (snd X))))"
       "e' \<in> funcset UNIV {- 1..1}"
       by auto
     note e'(1)
     also from pdevs_val_perm[OF perm e'(2)]
     obtain e'' where e'':
       "e'' \<in> funcset UNIV {- 1..1}"
       "pdevs_val e' (pdevs_of_list (map snd (list_of_pdevs (snd X)))) =
       pdevs_val e'' (pdevs_of_list (map snd (list_of_pdevs (snd Y))))"
       by auto
     note e''(2)
     also from pdevs_val_of_list_of_pdevs[OF e''(1), of "snd Y", simplified]
     obtain e''' where e''':
       "pdevs_val e'' (pdevs_of_list (map snd (list_of_pdevs (snd Y)))) = pdevs_val e''' (snd Y)"
       "e''' \<in> funcset UNIV {- 1..1}"
       by auto
     note e'''(1)
     finally have "\<exists>e' \<in> funcset UNIV {-1 .. 1}. pdevs_val e (snd X) = pdevs_val e' (snd Y)"
       using e'''(2) by auto
   } note E = this
   note e1 = E[OF assms(2)]
     and e2 = E[OF perm_sym[OF assms(2)]]
   show ?thesis
     by (auto simp: Affine_def valuate_def aform_val_def assms dest: e1 e2)
 qed
 
 context includes autoref_syntax begin
 
 lemma aform_of_ivl_refine: "x \<le> y \<Longrightarrow> (aform_of_ivl x y, atLeastAtMost x y) \<in> \<langle>rnv_rel\<rangle>aform_rel"
   by (auto simp: aform_rel_def br_def Affine_aform_of_ivl)
 
 lemma aforms_of_ivl_leI1:
   fixes en::real
   assumes "-1 \<le> en" "xsn \<le> ysn"
   shows "xsn \<le> (xsn + ysn) / 2 + (ysn - xsn) * en / 2"
 proof -
   have "xsn * (1 + en) \<le> ysn * (1 + en)"
     using assms mult_right_mono by force
   then show ?thesis
     by (auto simp: algebra_simps divide_simps)
 qed
 
 lemma aforms_of_ivl_leI2:
   fixes en::real
   assumes "1 \<ge> en" "xsn \<le> ysn"
   shows "(xsn + ysn) / 2 + (ysn - xsn) * en / 2 \<le> ysn"
 proof -
   have "xsn * (1 - en) \<le> ysn * (1 - en)"
     using assms mult_right_mono by force
   then show ?thesis
     by (auto simp: algebra_simps divide_simps)
 qed
 
 lemma Joints_aforms_of_ivlsD1:
   "zs \<in> Joints (aforms_of_ivls xs ys) \<Longrightarrow> list_all2 (\<le>) xs ys \<Longrightarrow> list_all2 (\<le>) xs zs"
   by (auto simp: Joints_def valuate_def aforms_of_ivls_def aform_val_def Pi_iff
       list_all2_conv_all_nth intro!: list_all2_all_nthI aforms_of_ivl_leI1)
 
 lemma Joints_aforms_of_ivlsD2:
   "zs \<in> Joints (aforms_of_ivls xs ys) \<Longrightarrow> list_all2 (\<le>) xs ys \<Longrightarrow> list_all2 (\<le>) zs ys"
   by (auto simp: Joints_def valuate_def aforms_of_ivls_def aform_val_def Pi_iff
       list_all2_conv_all_nth intro!: list_all2_all_nthI aforms_of_ivl_leI2)
 
 lemma aforms_of_ivls_refine:
   "list_all2 (\<le>) xrs yrs \<Longrightarrow>
        (xri, xrs) \<in> \<langle>rnv_rel\<rangle>list_rel \<Longrightarrow>
        (yri, yrs) \<in> \<langle>rnv_rel\<rangle>list_rel \<Longrightarrow> (aforms_of_ivls xri yri, lv_ivl xrs yrs) \<in> aforms_rel"
   apply (auto simp: aforms_rel_def br_def list_all2_lengthD lv_ivl_def
       Joints_aforms_of_ivlsD1 Joints_aforms_of_ivlsD2 intro!: aforms_of_ivls)
   subgoal by (simp add: list_all2_conv_all_nth)
   subgoal by (simp add: list_all2_conv_all_nth)
   done
 
 lemma degrees_zero_pdevs[simp]: "degrees (replicate n zero_pdevs) = 0"
   by (auto simp: degrees_def intro!: Max_eqI)
 
 lemma Joints_product_aforms:
   "Joints (product_aforms a b) = product_listset (Joints a) (Joints b)"
   apply (auto simp: Joints_def valuate_def product_listset_def product_aforms_def
       aform_vals_def[symmetric] aform_val_msum_aforms)
   subgoal for e
     apply (rule image_eqI[where
           x="(aform_vals e a,
               List.map2 (+) (aform_vals e (replicate (length b) (0, zero_pdevs))) (aform_vals (\<lambda>i. e (i + degree_aforms a)) b))"])
      apply (auto simp: split_beta')
     apply (auto simp: aform_vals_def intro!: nth_equalityI image_eqI[where x="\<lambda>i. e (i + degree_aforms a)"])
     done
   subgoal for e1 e2
     apply (rule image_eqI[where x="\<lambda>i. if i < degree_aforms a then e1 i else e2 (i - degree_aforms a)"])
      apply (auto simp: aform_vals_def aform_val_def Pi_iff
         intro!: nth_equalityI pdevs_val_degree_cong)
     subgoal premises prems for x xs k
     proof -
       from prems
       have "degree xs \<le> degree_aforms a"
         by (auto simp: degrees_def Max_gr_iff)
       then show ?thesis using prems by auto
     qed
     done
   done
 
 lemma product_aforms_refine:
   "(product_aforms, product_listset) \<in> aforms_rel \<rightarrow> aforms_rel \<rightarrow> aforms_rel"
   by (auto simp: aforms_rel_def br_def Joints_product_aforms)
 
 lemma mem_lv_rel_set_rel_iff:
   fixes z::"'a::executable_euclidean_space set"
   shows "(y, z) \<in> \<langle>lv_rel\<rangle>set_rel \<longleftrightarrow> (z = eucl_of_list ` y \<and> (\<forall>x \<in> y. length x = DIM('a)))"
   unfolding lv_rel_def
   by (auto simp: set_rel_def br_def)
 
 lemma eucl_of_list_mem_lv_rel: "length x = DIM('a::executable_euclidean_space) \<Longrightarrow>
     (x, eucl_of_list x::'a) \<in> lv_rel"
   unfolding lv_rel_def
   by (auto simp:  br_def)
 
 lemma
   mem_Joints_msum_aforms'I:
   "a \<in> Joints x \<Longrightarrow> b \<in> Joints y \<Longrightarrow> List.map2 (+) a b \<in> Joints (msum_aforms' x y)"
   by (auto simp: Joints_msum_aforms degrees_def)
 
 lemma
   mem_Joints_msum_aforms'E:
   assumes "xa \<in> Joints (msum_aforms' x y)" 
   obtains a b where "xa = List.map2 (+) a b" "a \<in> Joints x" "b \<in> Joints y"
   using assms
   by (auto simp: Joints_msum_aforms degrees_def)
 
 lemma msum_aforms'_refine_raw:
   shows "(msum_aforms' x y, {List.map2 (+) a b|a b. a \<in> Joints x \<and> b \<in> Joints y}) \<in> aforms_rel"
   unfolding aforms_rel_def br_def
   by (safe elim!: mem_Joints_msum_aforms'E intro!: mem_Joints_msum_aforms'I) (auto simp: Joints_imp_length_eq)
 
 lemma aforms_relD: "(a, b) \<in> aforms_rel \<Longrightarrow> b = Joints a"
   by (auto simp: aforms_rel_def br_def)
 
 lemma msum_aforms'_refine:
   "(msum_aforms', \<lambda>xs ys. {List.map2 (+) x y |x y. x \<in> xs \<and> y \<in> ys}) \<in> aforms_rel \<rightarrow> aforms_rel \<rightarrow> aforms_rel"
   by (safe dest!: aforms_relD intro!: msum_aforms'_refine_raw)
 
 lemma length_inf_aforms[simp]: "length (inf_aforms optns x) = length x"
   and length_sup_aforms[simp]: "length (sup_aforms optns x) = length x"
   by (auto simp: inf_aforms_def sup_aforms_def)
 
 lemma inf_aforms_refine:
   "(xi, x) \<in> aforms_rel \<Longrightarrow> length xi = d \<Longrightarrow> (RETURN (inf_aforms optns xi), Inf_specs d x) \<in> \<langle>rl_rel\<rangle>nres_rel"
   unfolding o_def
   apply (auto simp: br_def aforms_rel_def mem_lv_rel_set_rel_iff nres_rel_def Inf_specs_def
       intro!: RETURN_SPEC_refine)
   unfolding lv_rel_def
   by (auto simp: aforms_rel_def br_def Joints_imp_length_eq
       eucl_of_list_inner inf_aforms_def nth_in_AffineI
       intro!: Inf_aform'_Affine_le list_all2_all_nthI)
 
 lemma sup_aforms_refine:
   "(xi, x) \<in> aforms_rel \<Longrightarrow> length xi = d \<Longrightarrow> (RETURN (sup_aforms optns xi), Sup_specs d x) \<in> \<langle>rl_rel\<rangle>nres_rel"
   unfolding o_def
   apply (auto simp: aforms_relp_def mem_lv_rel_set_rel_iff nres_rel_def Sup_specs_def
       intro!: RETURN_SPEC_refine)
   unfolding lv_rel_def
   by (auto simp: aforms_rel_def br_def Joints_imp_length_eq
       eucl_of_list_inner sup_aforms_def nth_in_AffineI
       intro!: Sup_aform'_Affine_ge list_all2_all_nthI)
 
 lemma nres_of_THE_DRES_le:
   assumes "\<And>v. x = Some v \<Longrightarrow> RETURN v \<le> y"
   shows "nres_of (THE_DRES x) \<le> y"
   using assms by (auto simp: THE_DRES_def split: option.split)
 
 lemma degree_le_fresh_index: "a \<in> set A \<Longrightarrow> degree_aform a \<le> fresh_index_aforms A"
   by (auto simp: fresh_index_aforms_def intro!: Max_ge)
 
 lemma zero_in_JointsI: "xs \<in> Joints XS \<Longrightarrow> z = (0, zero_pdevs) \<Longrightarrow> 0 # xs \<in> Joints (z # XS)"
   by (auto simp: Joints_def valuate_def)
 
 lemma cancel_nonneg_pos_add_multI: "0 \<le> c + c * x"
   if "c \<ge> 0" "1 + x \<ge> 0"
   for c x::real
 proof -
   have "0 \<le> c + c * x \<longleftrightarrow> 0 \<le> c * (1 + x)" by (auto simp: algebra_simps)
   also have "\<dots> \<longleftrightarrow> 0 \<le> 1 + x"
     using that
     by (auto simp: zero_le_mult_iff)
   finally show ?thesis 
     using that by simp
 qed
    
 lemma Joints_map_split_aform:
   fixes x::"real aform list"
   shows "Joints x \<subseteq> Joints (map (\<lambda>a. fst (split_aform a i)) x) \<union> Joints (map (\<lambda>b. snd (split_aform b i)) x)"
   unfolding subset_iff
   apply (intro allI impI)
 proof goal_cases
   case (1 xs)
   then obtain e where e: "e \<in> funcset UNIV {-1 .. 1}" "xs = map (aform_val e) x"
     by (auto simp: Joints_def valuate_def)
   consider "e i \<ge> 0" | "e i \<le> 0" by arith
   then show ?case
   proof cases
     case 1
     let ?e = "e(i:= 2 * e i - 1)"
     note e(2)
     also
     have "map (aform_val e) x = map (aform_val ?e) (map (\<lambda>b. snd (split_aform b i)) x)"
       by (auto simp: aform_val_def split_aform_def Let_def divide_simps algebra_simps)
     also have "\<dots> \<in> Joints (map (\<lambda>b. snd (split_aform b i)) x)"
       using e \<open>0 \<le> e i\<close>
       by (auto simp: Joints_def valuate_def Pi_iff intro!: image_eqI[where x = ?e])
     finally show ?thesis by simp
   next
     case 2
     let ?e = "e(i:= 2 * e i + 1)"
     note e(2)
     also
     have "map (aform_val e) x = map (aform_val ?e) (map (\<lambda>b. fst (split_aform b i)) x)"
       by (auto simp: aform_val_def split_aform_def Let_def divide_simps algebra_simps)
     also have "\<dots> \<in> Joints (map (\<lambda>b. fst (split_aform b i)) x)"
       using e \<open>0 \<ge> e i\<close>
       by (auto simp: Joints_def valuate_def Pi_iff real_0_le_add_iff
           intro!: image_eqI[where x = ?e] cancel_nonneg_pos_add_multI)
     finally show ?thesis by simp
   qed
 qed
 
 
 lemma split_aforms_lemma:
   fixes x::"real aform list"
   assumes "(x, y) \<in> aforms_rel"
   assumes "z \<subseteq> y"
   assumes "l = (length x)"
   shows "\<exists>a b. (split_aforms x i, a, b)
      \<in> aforms_rel \<times>\<^sub>r aforms_rel \<and> env_len a l \<and> env_len b l \<and> z \<subseteq> a \<union> b"
   using assms
   apply (auto simp: split_aforms_def o_def)
   apply (rule exI[where x="Joints (map (\<lambda>x. fst (split_aform x i)) x)"])
   apply auto
   subgoal by (auto intro!: brI simp: aforms_rel_def)
   apply (rule exI[where x="Joints (map (\<lambda>x. snd (split_aform x i)) x)"])
   apply (rule conjI)
   subgoal by (auto intro!: brI simp: aforms_rel_def)
   subgoal
     using Joints_map_split_aform[of x i]
     by (auto simp: br_def aforms_rel_def env_len_def Joints_imp_length_eq)
   done
 
 lemma length_summarize_pdevs_list[simp]:
   "length (summarize_pdevs_list a b c d) = length d"
   by (auto simp: summarize_pdevs_list_def)
 
 lemma length_summarize_aforms[simp]:
   "length (summarize_aforms a b e d) = length d"
   by (auto simp: summarize_aforms_def Let_def)
 
 lemma
   split_aform_largest_take_refine:
   "(ni, n) \<in> nat_rel \<Longrightarrow>
        (xi::real aform list, x) \<in> aforms_rel \<Longrightarrow>
        length xi = d \<Longrightarrow> (RETURN (split_aforms_largest_uncond_take ni xi), split_spec_params d n x) \<in> \<langle>aforms_rel \<times>\<^sub>r aforms_rel\<rangle>nres_rel"
   apply (auto simp: split_spec_params_def nres_rel_def aforms_relp_def mem_lv_rel_set_rel_iff
       split_aforms_largest_uncond_take_def Let_def comps
       split: prod.splits
       intro!: RETURN_SPEC_refine)
   apply (rule split_aforms_lemma)
   by (auto simp add: aforms_rel_def)
 
 lemma aform_val_pdevs_of_real[simp]: "aform_val e (pdevs_of_real x) = x"
   by (auto simp: pdevs_of_real_def)
 
 lemma degree_aform_pdevs_of_real[simp]: "degree_aform (pdevs_of_real x) = 0"
   by (auto simp: pdevs_of_real_def)
 
 lemma interpret_floatarith_inner_eq:
   shows "interpret_floatarith (inner_floatariths xs ys) vs =
     (\<Sum>(x, y) \<leftarrow> (zip xs ys). (interpret_floatarith x vs) * (interpret_floatarith y vs))"
   by (induction xs ys rule: inner_floatariths.induct) auto
 
 lemma approx_slp_outer_sing:
   "approx_slp_outer p (Suc 0) [fa] XS = Some R \<longleftrightarrow> (\<exists>Y.
   approx_floatarith p fa (map (\<lambda>x. (x, 0)) XS) = Some Y \<and>
        [aform_err_to_aform Y (max (degree_aforms XS) (degree_aform_err Y))] = R)"
   by (auto simp: approx_slp_outer_def bind_eq_Some_conv degrees_def)
 
 lemma aforms_err_aform_valsI:
   assumes "vs = aform_vals e XS"
   shows "vs \<in> aforms_err e (map (\<lambda>x. (x, 0)) (XS))"
     by (auto simp: assms aforms_err_def o_def aform_err_def aform_vals_def)
 
 
 lemma aform_val_degree_cong:
   "b = d \<Longrightarrow> (\<And>i. i < degree_aform d \<Longrightarrow> a i = c i) \<Longrightarrow> aform_val a b = aform_val c d"
   by (auto simp: aform_val_def intro!: pdevs_val_degree_cong)
 
 lemma mem_degree_aformD: "x \<in> set XS \<Longrightarrow> degree_aform x \<le> degree_aforms XS"
   by (auto simp: degrees_def)
 lemma degrees_append_leD1: "(degrees xs) \<le> degrees (xs @ ys)"
   unfolding degrees_def
   by (rule Max_mono) (auto simp: degrees_def min_def max_def Max_ge_iff image_Un Max_gr_iff)
 
 lemma inner_aforms':
   assumes "xs \<in> Joints XS"
   assumes "inner_aforms' p XS (map pdevs_of_real rs) = Some R"
   shows "(\<Sum>(x, y) \<leftarrow> (zip xs rs). x * y) \<in> Affine (hd R)" (is ?th1) "length R = 1" (is ?th2)
 proof -
   from assms obtain e where "e \<in> funcset UNIV {-1 .. 1}" "xs = aform_vals e XS"
     by (auto simp: Joints_def valuate_def aform_vals_def)
   then have e: "xs @ rs = aform_vals e (XS @ map pdevs_of_real rs)"
     "xs @ rs \<in> Joints (XS @ map pdevs_of_real rs)"
     "length xs = length XS"
     "e \<in> funcset UNIV {- 1..1}"
     by (auto simp: aform_vals_def o_def degrees_def Joints_def valuate_def)
   have "approx_slp_outer p (Suc 0)
      ([inner_floatariths (map floatarith.Var [0..<length XS])
          (map floatarith.Var [length XS..<length XS + length rs])])
      (XS @ map pdevs_of_real rs) =
     Some R"
     using assms(2)
     by (auto simp: inner_aforms'_def)
   then obtain Y where Y:
     "approx_floatarith p
        (inner_floatariths (map floatarith.Var [0..<length XS])
          (map floatarith.Var [length XS..<length XS + length rs]))
        (map (\<lambda>x. (x, 0)) (XS @ map pdevs_of_real rs)) =
       Some Y"
     "R = [aform_err_to_aform Y (max (degree_aforms (XS @ map pdevs_of_real rs)) (degree_aform_err Y))]"
     unfolding approx_slp_outer_sing by auto
   let ?m = "(max (degree_aforms (XS @ map pdevs_of_real rs)) (degree_aform_err Y))"
   from approx_floatarith_Elem[OF Y(1) e(4) aforms_err_aform_valsI[OF e(1)]]
   have "interpret_floatarith
      (inner_floatariths (map floatarith.Var [0..<length XS]) (map floatarith.Var [length XS..<length XS + length rs]))
      (xs @ rs)
     \<in> aform_err e Y" "degree_aform_err Y \<le> max (degree_aforms (XS @ map pdevs_of_real rs)) (degree_aform_err Y)"
     by auto
   from aform_err_to_aformE[OF this] obtain err where err:
     "interpret_floatarith
            (inner_floatariths (map floatarith.Var [0..<length XS])
              (map floatarith.Var [length XS..<length XS + length rs]))
            (xs @ rs) =
           aform_val (e(max (degree_aforms (XS @ map pdevs_of_real rs)) (degree_aform_err Y) := err))
            (aform_err_to_aform Y (max (degree_aforms (XS @ map pdevs_of_real rs)) (degree_aform_err Y)))"
     "- 1 \<le> err" "err \<le> 1"
     by auto
   let ?e' = "(e(max (degrees (map snd XS @ map (snd \<circ> pdevs_of_real) rs)) (degree_aform_err Y) := err))"
   from e(1) have e': "xs @ rs = aform_vals ?e' (XS @ map pdevs_of_real rs)"
     apply (auto simp: aform_vals_def intro!: aform_val_degree_cong)
      apply (frule mem_degree_aformD)
      apply (frule le_less_trans[OF degrees_append_leD1])
      apply (auto simp: o_def)
     done
   from err have "interpret_floatarith
            (inner_floatariths (map floatarith.Var [0..<length XS])
              (map floatarith.Var [length XS..<length XS + length rs]))
            (xs @ rs)#xs@rs \<in> Joints (R @ XS @ map pdevs_of_real rs)"
     using e(1,3,4) e'
     apply (auto simp: valuate_def Joints_def
       intro!: nth_equalityI
         image_eqI[where x="?e'"])
      apply (simp add: Y aform_vals_def; fail)
     apply (simp add: Y o_def)
     apply (simp add: nth_append nth_Cons)
     apply (auto split: nat.splits simp: nth_append nth_Cons aform_vals_def)
     done
   then have "(\<Sum>(x, y)\<leftarrow>zip (map floatarith.Var [0..<length XS])
                 (map floatarith.Var
                   [length XS..<
                    length XS + length rs]). interpret_floatarith x (xs @ rs) * interpret_floatarith y (xs @ rs)) #
     xs @ rs
     \<in> Joints (R @ XS @ map pdevs_of_real rs)"
     apply (subst (asm)interpret_floatarith_inner_eq )
     apply (auto simp:  )
     done
   also have "(\<Sum>(x, y)\<leftarrow>zip (map floatarith.Var [0..<length XS])
                 (map floatarith.Var
                   [length XS..<
                    length XS + length rs]). interpret_floatarith x (xs @ rs) * interpret_floatarith y (xs @ rs)) =
     (\<Sum>(x, y)\<leftarrow>zip xs rs. x * y)"
     by (auto simp: sum_list_sum_nth assms e(3) nth_append intro!: sum.cong)
   finally show ?th1 ?th2
     by (auto simp: Affine_def valuate_def Joints_def Y)
 qed
 
 lemma inner_aforms'_inner_lv_rel:
   "(a, a') \<in> aforms_rel \<Longrightarrow>
        inner_aforms' prec a (map pdevs_of_real a'a) = Some R \<Longrightarrow>
        x \<in> a' \<Longrightarrow> inner_lv_rel x a'a \<in> Affine (hd R)"
   unfolding mem_lv_rel_set_rel_iff
   unfolding lv_rel_def aforms_rel_def
   apply (auto simp: br_def)
   apply (subst arg_cong2[where f="(\<in>)", OF _ refl])
   defer
    apply (rule inner_aforms')
      apply (auto simp: br_def Joints_imp_length_eq inner_lv_rel_def)
   done
 
 lemma aform_inf_inner_refine:
   "(RETURN o2 aform_inf_inner optns, Inf_inners) \<in> aforms_rel \<rightarrow> rl_rel \<rightarrow> \<langle>rnv_rel\<rangle>nres_rel"
   by (auto simp: aforms_relp_def nres_rel_def Inf_inners_def aform_inf_inner_def[abs_def] comp2_def
       iaN
       intro!: Inf_aform'_Affine_le inner_aforms'_inner_lv_rel
       split: option.splits list.splits)
 
 lemma aform_sup_inner_refine:
   "(RETURN o2 aform_sup_inner optns, Sup_inners) \<in> aforms_rel \<rightarrow> rl_rel \<rightarrow> \<langle>rnv_rel\<rangle>nres_rel"
   by (auto simp: aforms_relp_def nres_rel_def Sup_inners_def aform_sup_inner_def[abs_def] comp2_def
       iaN
       intro!: Sup_aform'_Affine_ge inner_aforms'_inner_lv_rel
       split: option.splits list.splits)
 
 lemma lv_aforms_rel_comp_br_Affine_le: "lv_aforms_rel O br Affine top \<subseteq> \<langle>lv_rel\<rangle>aforms_relp"
   apply (auto simp: lv_aforms_rel_def aforms_relp_def br_def)
   apply (rule relcompI)
    apply (auto simp: aforms_rel_def intro!: brI )
   by (auto simp: mem_lv_rel_set_rel_iff Joints_imp_length_eq
       intro!: eucl_of_list_mem_eucl_of_list_aform intro!: in_image_eucl_of_list_eucl_of_list_aform)
 
 lemma bijective_lv_rel[relator_props]: "bijective lv_rel"
   unfolding lv_rel_def bijective_def
   apply (auto simp: br_def)
   by (metis eucl_of_list_inj)
 
 lemma sv_lv_rel_inverse[relator_props]: "single_valued (lv_rel\<inverse>)"
   using bijective_lv_rel
   by (rule bijective_imp_sv)
 
 lemma list_of_eucl_image_lv_rel_inverse:
   "(x, list_of_eucl ` x) \<in> \<langle>lv_rel\<inverse>\<rangle>set_rel"
   unfolding set_rel_sv[OF sv_lv_rel_inverse]
   apply (auto simp: )
     apply (rule ImageI)
      apply (rule converseI)
      apply (rule lv_relI)
      apply auto
    apply (rule image_eqI)
     prefer 2 apply assumption
   unfolding lv_rel_def
    apply (auto simp: br_def)
   subgoal for y
     apply (rule exI[where x="list_of_eucl y"])
     apply auto
     done
   done
 
 lemma lv_rel_comp_lv_rel_inverse:
   "((lv_rel::(_\<times>'a::executable_euclidean_space) set) O lv_rel\<inverse>) = {(x, y). x = y \<and> length x = DIM('a)}"
   apply (auto simp: intro!: lv_relI)
   unfolding lv_rel_def
   by (auto simp: br_def intro!: eucl_of_list_inj)
 
 lemma inter_aform_plane_refine_aux:
   "d = CARD('n::enum) \<Longrightarrow>
   (xi, x) \<in> aforms_rel \<Longrightarrow> (si, s) \<in> \<langle>rl_rel\<rangle>sctn_rel \<Longrightarrow>
   length xi = d \<Longrightarrow>
   length (normal si) = d \<Longrightarrow>
   (nres_of (inter_aform_plane_lv (length xi) optns xi si), inter_sctn_specs d x s)
   \<in> \<langle>aforms_rel\<rangle>nres_rel"
 proof (goal_cases)
   case 1
   from 1 have sis: "si = s"
     by (cases si; cases s) (auto simp: sctn_rel_def)
   have Dp: "DIM_precond TYPE('n rvec) CARD('n)"
     by auto
   have a: "(xi, eucl_of_list_aform xi::'n rvec aform) \<in> lv_aforms_rel"
     by (auto simp: lv_aforms_rel_def br_def aforms_relp_def aforms_rel_def mem_lv_rel_set_rel_iff 1
         Joints_imp_length_eq)
   have b: "(si, (Sctn (eucl_of_list (normal si)) (pstn si))::'n rvec sctn) \<in> \<langle>lv_rel\<rangle>sctn_rel"
     using 1
     by (cases si)
       (auto simp: lv_aforms_rel_def br_def aforms_relp_def aforms_rel_def mem_lv_rel_set_rel_iff
         Joints_imp_length_eq sctn_rel_def intro!: lv_relI)
   have a: "(nres_of (inter_aform_plane_lv CARD('n) optns xi si),
     inter_aform_plane optns (eucl_of_list_aform xi::'n rvec aform) (Sctn (eucl_of_list (normal si)) (pstn si)))
     \<in> \<langle>lv_aforms_rel\<rangle>nres_rel"
     (is "(_, inter_aform_plane _ ?ea ?se) \<in> _")
     using inter_aform_plane_lv.refine[OF Dp IdI a b, of optns]
     by simp
   have b: "(inter_aform_plane optns ?ea ?se, inter_sctn_spec (Affine ?ea) ?se) \<in> \<langle>br Affine top\<rangle>nres_rel"
     using 1
     apply (auto simp: inter_sctn_spec_def nres_rel_def inter_aform_plane_def project_ncoord_aform_def
         inter_aform_plane_ortho_nres_def
         split: option.splits
         intro!: RETURN_SPEC_refine
         dest!: inter_inter_aform_plane_ortho)
      apply (auto simp: aform_rel_def br_def nres_rel_def comps bind_eq_Some_conv
         inter_sctn_spec_def inter_aform_plane_def plane_of_def aforms_relp_def aforms_rel_def
         mem_lv_rel_set_rel_iff
         intro!: RETURN_SPEC_refine nres_of_THE_DRES_le mem_Affine_project_coord_aformI
         dest!: inter_inter_aform_plane_ortho
         split: if_splits)
      apply (auto dest!: mem_Affine_project_coord_aformD simp: abs_in_Basis_iff plane_of_def)
     done
   from relcompI[OF a b]
   have "(nres_of (inter_aform_plane_lv CARD('n) optns xi si), inter_sctn_spec (Affine ?ea) ?se) \<in>
       \<langle>lv_aforms_rel\<rangle>nres_rel O \<langle>br Affine top\<rangle>nres_rel"
     by auto
   also have "\<langle>lv_aforms_rel\<rangle>nres_rel O \<langle>br Affine top\<rangle>nres_rel \<subseteq> \<langle>\<langle>lv_rel\<rangle>aforms_relp\<rangle>nres_rel"
     unfolding nres_rel_comp
     apply (rule nres_rel_mono)
     apply (rule lv_aforms_rel_comp_br_Affine_le)
     done
   finally
   have step1: "(nres_of (inter_aform_plane_lv CARD('n) optns xi si),
       inter_sctn_spec (Affine (eucl_of_list_aform xi)::'n rvec set) (Sctn (eucl_of_list (normal si)) (pstn si)))
       \<in> \<langle>\<langle>lv_rel\<rangle>aforms_relp\<rangle>nres_rel"
     by simp
   have step2: "(inter_sctn_spec (Affine (eucl_of_list_aform xi)::'n rvec set) (Sctn (eucl_of_list (normal si)) (pstn si)),
     inter_sctn_specs CARD('n) (Joints xi) si) \<in> \<langle>\<langle>lv_rel\<inverse>\<rangle>set_rel\<rangle>nres_rel"
     apply (auto simp: inter_sctn_specs_def inter_sctn_spec_def simp: nres_rel_def intro!: SPEC_refine)
     subgoal for x
       apply (rule exI[where x="list_of_eucl ` x"])
       apply (auto simp: env_len_def plane_ofs_def intro: list_of_eucl_image_lv_rel_inverse)
       subgoal for y
         apply (rule image_eqI[where x="eucl_of_list y"])
           apply (subst list_of_eucl_eucl_of_list)
           apply (auto simp: 1 Joints_imp_length_eq)
         apply (rule subsetD, assumption)
         apply (auto simp: intro!: eucl_of_list_mem_eucl_of_list_aform 1)
         using inner_lv_rel_autoref[where 'a="'n rvec", param_fo, OF lv_relI lv_relI, of y "normal si"]
         by (auto simp: plane_of_def 1 Joints_imp_length_eq)
       subgoal for y
         apply (drule subsetD, assumption)
         using inner_lv_rel_autoref[where 'a="'n rvec", param_fo, OF lv_relI lv_relI, of "list_of_eucl y" "normal si"]
         by (auto simp: plane_of_def 1 Joints_imp_length_eq)
       done
     done
   from relcompI[OF step1 step2]
   have "(nres_of (inter_aform_plane_lv CARD('n) optns xi si), inter_sctn_specs CARD('n) (Joints xi) si)
     \<in> \<langle>\<langle>lv_rel::(real list \<times> 'n rvec)set\<rangle>aforms_relp\<rangle>nres_rel O \<langle>\<langle>lv_rel\<inverse>\<rangle>set_rel\<rangle>nres_rel" by simp
   also have "\<langle>\<langle>lv_rel::(real list \<times> 'n rvec)set\<rangle>aforms_relp\<rangle>nres_rel O \<langle>\<langle>lv_rel\<inverse>\<rangle>set_rel\<rangle>nres_rel \<subseteq>
     \<langle>aforms_rel O Id\<rangle>nres_rel"
     unfolding nres_rel_comp O_assoc aforms_relp_def
     apply (rule nres_rel_mono)
     apply (rule relcomp_mono[OF order_refl])
     unfolding set_rel_sv[OF sv_lv_rel_inverse] set_rel_sv[OF lv_rel_sv]
     apply (auto simp: length_lv_rel)
     unfolding relcomp_Image[symmetric] lv_rel_comp_lv_rel_inverse
      apply (auto simp: Basis_not_uminus length_lv_rel)
     unfolding lv_rel_def
     subgoal for a b c d
       apply (auto dest!: brD simp: length_lv_rel)
       using eucl_of_list_inj[where 'a="'n rvec", of d b]
       by auto
     done
   finally show ?case using 1 by (simp add: aforms_rel_def br_def sis)
 qed
 
 end
 
 setup \<open>Sign.add_const_constraint (@{const_name "enum_class.enum"}, SOME @{typ "'a list"})\<close>
 setup \<open>Sign.add_const_constraint (@{const_name "enum_class.enum_all"}, SOME @{typ "('a \<Rightarrow> bool) \<Rightarrow> bool"})\<close>
 setup \<open>Sign.add_const_constraint (@{const_name "enum_class.enum_ex"}, SOME @{typ "('a \<Rightarrow> bool) \<Rightarrow> bool"})\<close>
 
 lemmas inter_aform_plane_refine_unoverloaded0 =
   inter_aform_plane_refine_aux[internalize_sort "'n::enum",
     unoverload enum_class.enum,
     unoverload enum_class.enum_all,
     unoverload enum_class.enum_ex]
 
 theorem
   inter_aform_plane_refine_unoverloaded:
     "class.enum (enum::'a list) enum_all enum_ex \<and> d = CARD('a) \<Longrightarrow>
     (xi, x) \<in> aforms_rel \<Longrightarrow>
     (si, s) \<in> \<langle>rl_rel\<rangle>sctn_rel \<Longrightarrow>
     length xi = d \<Longrightarrow>
     length (normal si) = d \<Longrightarrow>
     (nres_of (inter_aform_plane_lv (length xi) optns xi si), inter_sctn_specs d x s)
     \<in> \<langle>aforms_rel\<rangle>nres_rel"
   by (rule inter_aform_plane_refine_unoverloaded0) auto
 
 setup \<open>Sign.add_const_constraint (@{const_name "enum_class.enum"}, SOME @{typ "'a::enum list"})\<close>
 setup \<open>Sign.add_const_constraint (@{const_name "enum_class.enum_all"}, SOME @{typ "('a::enum \<Rightarrow> bool) \<Rightarrow> bool"})\<close>
 setup \<open>Sign.add_const_constraint (@{const_name "enum_class.enum_ex"}, SOME @{typ "('a::enum \<Rightarrow> bool) \<Rightarrow> bool"})\<close>
 
 context includes autoref_syntax begin
 
 text \<open>TODO: this is a special case of \<open>Cancel_Card_Constraint\<close> from \<open>AFP/Perron_Frobenius\<close>!\<close>
 lemma type_impl_card_n_enum:
   assumes "\<exists>(Rep :: 'a \<Rightarrow> nat) Abs. type_definition Rep Abs {0 ..< n :: nat}"
   obtains enum enum_all enum_ex
   where "class.enum (enum::'a list) enum_all enum_ex \<and> n = CARD('a)"
 proof -
   from assms obtain rep :: "'a \<Rightarrow> nat" and abs :: "nat \<Rightarrow> 'a" where t: "type_definition rep abs {0 ..< n}" by auto
   have "card (UNIV :: 'a set) = card {0 ..< n}" using t by (rule type_definition.card)
   also have "\<dots> = n" by auto
   finally have bn: "CARD ('a) = n" .
 
   let ?enum = "(map abs [0..<n])"
   have "class.enum ?enum (Ball (set ?enum)) (Bex (set ?enum))"
     apply standard
     using t
     apply (auto simp: distinct_map type_definition_def)
     using t type_definition.univ apply fastforce
     using t type_definition.Abs_inj_on apply blast
     apply (meson t type_definition.Abs_induct)
     by (metis t tdD1)
   with bn have "class.enum ?enum (Ball (set ?enum)) (Bex (set ?enum)) \<and> n = CARD('a)"
     by simp
   then show ?thesis ..
 qed
 
 
 lemma inter_aform_plane_refine_ex_typedef:
   "(xi, x) \<in> aforms_rel \<Longrightarrow>
   (si, s) \<in> \<langle>rl_rel\<rangle>sctn_rel \<Longrightarrow>
   length xi = d \<Longrightarrow>
   length (normal si) = d \<Longrightarrow>
   (nres_of (inter_aform_plane_lv (length xi) optns xi si), inter_sctn_specs d x s)
   \<in> \<langle>aforms_rel\<rangle>nres_rel"
   if "\<exists>(Rep :: 'a \<Rightarrow> nat) Abs. type_definition Rep Abs {0 ..< d :: nat}"
   by (rule type_impl_card_n_enum[OF that]) (rule inter_aform_plane_refine_unoverloaded; assumption)
 
 lemma inter_aform_plane_refine:
   "0 < d \<Longrightarrow>
   (xi, x) \<in> aforms_rel \<Longrightarrow>
   (si, s) \<in> \<langle>Id\<rangle>sctn_rel \<Longrightarrow>
   length xi = d \<Longrightarrow>
   length (normal si) = d \<Longrightarrow>
   (nres_of (inter_aform_plane_lv (length xi) optns xi si), inter_sctn_specs d x s)
   \<in> \<langle>aforms_rel\<rangle>nres_rel"
   by (rule inter_aform_plane_refine_ex_typedef[cancel_type_definition, simplified])
 
 lemma Joints_reduce_aforms: "x \<in> Joints X \<Longrightarrow> x \<in> Joints (reduce_aforms prec t X)"
 proof (auto simp: reduce_aforms_def summarize_threshold_def[abs_def] Joints_def valuate_def aform_val_def, goal_cases)
   case (1 e)
   from summarize_aformsE[OF \<open>e \<in> _\<close> order_refl, of "X" "prec" t]
   guess e' .
   thus ?case
     by (auto intro!: image_eqI[where x=e'] simp: aform_vals_def)
 qed
 
 lemma length_reduce_aform[simp]: "length (reduce_aforms optns a x) = length x"
   by (auto simp: reduce_aforms_def)
 
 lemma reduce_aform_refine:
   "(xi, x) \<in> aforms_rel \<Longrightarrow> length xi = d \<Longrightarrow>
     (RETURN (reduce_aforms prec C xi), reduce_specs d r x) \<in> \<langle>aforms_rel\<rangle>nres_rel"
   apply (auto simp: reduce_specs_def nres_rel_def comps aforms_relp_def mem_lv_rel_set_rel_iff
       aforms_rel_def env_len_def
       intro!: RETURN_SPEC_refine)
   apply (auto simp: br_def env_len_def)
   by (auto simp: mem_lv_rel_set_rel_iff Joints_imp_length_eq
       intro!: in_image_eucl_of_list_eucl_of_list_aform Joints_reduce_aforms
       eucl_of_list_mem_eucl_of_list_aform)
 
 lemma aform_euclarithform_refine:
   "(nres_of o2 aform_form optns, approx_form_spec) \<in> Id \<rightarrow> aforms_rel \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"
   by (auto simp: approx_form_spec_def nres_rel_def comps aform_form_def
       aforms_rel_def br_def approx_form_aform
       dest!: approx_form_aux
       intro!: ivls_of_aforms)
 
 lemma aform_isFDERIV:
   "(\<lambda>N xs fas vs. nres_of (aform_isFDERIV optns N xs fas vs), isFDERIV_spec)
     \<in> nat_rel \<rightarrow> \<langle>nat_rel\<rangle>list_rel \<rightarrow> \<langle>Id\<rangle>list_rel \<rightarrow> aforms_rel \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"
   by (auto simp: isFDERIV_spec_def nres_rel_def comps aform_isFDERIV_def
       aforms_rel_def br_def
       dest!: approx_form_aux
       intro!: ivls_of_aforms isFDERIV_approx)
 
 lemma approx_slp_lengthD: "approx_slp p slp a = Some xs \<Longrightarrow>
   length xs = length slp + length a"
   by (induction slp arbitrary: xs a) (auto simp: bind_eq_Some_conv)
 
 lemma approx_slp_outer_lengthD: "approx_slp_outer p d slp a = Some xs \<Longrightarrow>
   length xs = min d (length slp + length a)"
   by (auto simp: approx_slp_outer_def Let_def bind_eq_Some_conv o_def
       aforms_err_to_aforms_def aform_err_to_aform_def dest!: approx_slp_lengthD)
 
 lemma approx_slp_refine:
   "(nres_of o3 aform_slp prec, approx_slp_spec fas) \<in> 
     nat_rel \<rightarrow> fas_rel \<rightarrow> aforms_rel \<rightarrow> \<langle>\<langle>aforms_rel\<rangle>option_rel\<rangle>nres_rel"
   apply (auto simp: approx_slp_spec_def comps aform_slp_def nres_rel_def
       intro!: RETURN_SPEC_refine ASSERT_refine_right)
   subgoal for a b
     apply (rule exI[where x = "map_option Joints (approx_slp_outer prec (length fas) (slp_of_fas fas) a)"])
     apply (auto simp: option.splits aforms_rel_def br_def env_len_def Joints_imp_length_eq)
     apply (auto dest!: approx_slp_outer_lengthD)[]
     using length_slp_of_fas_le trans_le_add1 approx_slp_outer_lengthD apply blast
     using approx_slp_outer_plain by blast
   done
 
 lemma fresh_index_aforms_Nil[simp]: "fresh_index_aforms [] = 0"
   by (auto simp: fresh_index_aforms_def)
 
 lemma independent_aforms_Nil[simp]:
   "independent_aforms x [] = [x]"
   by (auto simp: independent_aforms_def)
 
 lemma mem_Joints_zero_iff[simp]: "x # xs \<in> Joints ((0, zero_pdevs) # XS) \<longleftrightarrow> (x = 0 \<and> xs \<in> Joints XS)"
   by (auto simp: Joints_def valuate_def)
 
 lemma Joints_independent_aforms_eq: "Joints (independent_aforms x xs) = set_Cons (Affine x) (Joints xs)"
   by (simp add: independent_aforms_def Joints_msum_aform degree_le_fresh_index set_Cons_def)
 
 lemma independent_aforms_refine: "(independent_aforms, set_Cons) \<in> \<langle>rnv_rel\<rangle>aform_rel \<rightarrow> aforms_rel \<rightarrow> aforms_rel"
   by (auto simp: aforms_rel_def br_def aform_rel_def Joints_independent_aforms_eq)
 
 end
 
 
 locale aform_approximate_sets = approximate_sets
   aform_ops
   Joints
   aforms_rel
 begin
 
 lemma Joints_in_lv_rel_set_relD:
   "(Joints xs, X) \<in> \<langle>lv_rel\<rangle>set_rel \<Longrightarrow> X = Affine (eucl_of_list_aform xs)"
   unfolding lv_rel_def set_rel_br
   by (auto simp: br_def Joints_imp_length_eq eucl_of_list_image_Joints[symmetric])
 
 lemma ncc_precond: "ncc_precond TYPE('a::executable_euclidean_space)"
   unfolding ncc_precond_def ncc_def appr_rel_def
   by (auto simp: aforms_rel_def compact_Affine convex_Affine dest!: Joints_in_lv_rel_set_relD brD)
 
 lemma fst_eucl_of_list_aform_map: "fst (eucl_of_list_aform (map (\<lambda>x. (fst x, asdf x)) x)) =
   fst (eucl_of_list_aform x)"
   by (auto simp: eucl_of_list_aform_def o_def)
 
 lemma
   Affine_pdevs_of_list:\<comment> \<open>TODO: move!\<close>
   "Affine (fst x, pdevs_of_list (map snd (list_of_pdevs (snd x)))) = Affine x"
   by (auto simp: Affine_def valuate_def aform_val_def
       elim: pdevs_val_of_list_of_pdevs2[where X = "snd x"]
         pdevs_val_of_list_of_pdevs[where X = "snd x"])
 
 end
 
 lemma aform_approximate_sets: "aform_approximate_sets prec"
   apply (unfold_locales)
   unfolding aform_ops_def approximate_set_ops.simps
   subgoal unfolding relAPP_def aforms_rel_def .
   subgoal by (force simp: aforms_of_ivls_refine)
   subgoal by (rule product_aforms_refine)
   subgoal by (rule msum_aforms'_refine)
   subgoal by (rule inf_aforms_refine)
   subgoal by (rule sup_aforms_refine)
   subgoal by (rule split_aform_largest_take_refine)
   subgoal by (rule aform_inf_inner_refine)
   subgoal by (rule aform_sup_inner_refine)
   subgoal by (rule inter_aform_plane_refine) simp_all
   subgoal by (auto split: option.splits intro!: reduce_aform_refine)
   subgoal by (force simp: width_spec_def nres_rel_def)
   subgoal by (rule approx_slp_refine)
   subgoal by (rule aform_euclarithform_refine)
   subgoal by (rule aform_isFDERIV)
   subgoal by simp
   subgoal by (auto simp: Joints_imp_length_eq)
   subgoal by (force simp: Affine_def Joints_def valuate_def intro!:)
   subgoal by (force simp: Affine_def Joints_def valuate_def intro!:)
   subgoal by (auto simp: Joints_imp_length_eq)
   done
 
 end
diff --git a/thys/Taylor_Models/Experiments.thy b/thys/Taylor_Models/Experiments.thy
--- a/thys/Taylor_Models/Experiments.thy
+++ b/thys/Taylor_Models/Experiments.thy
@@ -1,87 +1,89 @@
 theory Experiments
   imports Taylor_Models
     Affine_Arithmetic.Affine_Arithmetic
 begin
 
 instantiation interval::("{show, preorder}") "show" begin
 
+context includes interval.lifting begin
 lift_definition shows_prec_interval::
   "nat \<Rightarrow> 'a interval \<Rightarrow> char list \<Rightarrow> char list"
   is "\<lambda>p ivl s. (shows_string ''Interval'' o shows ivl) s" .
 
 
 lift_definition shows_list_interval::
   "'a interval list \<Rightarrow> char list \<Rightarrow> char list"
   is "\<lambda>ivls s. shows_list ivls s" .
 
 instance
   apply standard
   subgoal by transfer (auto simp: show_law_simps)
   subgoal by transfer (auto simp: show_law_simps)
   done
+end
 
 end
 
 definition  split_largest_interval :: "float interval list \<Rightarrow> float interval list \<times> float interval list" where
 "split_largest_interval xs = (case sort_key (uminus o snd) (zip [0..<length xs] (map (\<lambda>x. upper x - lower x) xs)) of Nil \<Rightarrow> ([], [])
   | (i, _)#_ \<Rightarrow> let x = xs! i in (xs[i:=Ivl (lower x) ((upper x + lower x)*Float 1 (-1))],
                  xs[i:=Ivl ((upper x + lower x)*Float 1 (-1)) (upper x)]))"
 
 definition "Inf_tm p params tm =
   lower (compute_bound_tm p (replicate params (Ivl (-1) (1))) (replicate params (Ivl 0 0)) tm)"
 
 primrec prove_pos::"bool \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>
     (nat \<Rightarrow> nat \<Rightarrow> taylor_model list \<Rightarrow> taylor_model option) \<Rightarrow> float interval list list \<Rightarrow> bool" where
   "prove_pos prnt 0 p ord F X = (let _ = if prnt then print (STR ''# depth limit exceeded\<newline>'') else () in False)"
 | "prove_pos prnt (Suc i) p ord F XXS =
     (case XXS of [] \<Rightarrow> True | (X#XS) \<Rightarrow>
     let
        params = length X;
        R = F p ord (tms_of_ivls X);
        _ = if prnt  then print (String.implode ((shows ''# '' o shows (map (\<lambda>ivl. (lower ivl, upper ivl)) X)) ''\<newline>'')) else ()
     in
     if R \<noteq> None \<and> 0 < Inf_tm p params (the R)
     then let _ = if prnt then print (STR ''# Success\<newline>'') else () in prove_pos prnt i p ord F XS
     else let _ = if prnt then print (String.implode ((shows ''# Split ('' o shows ((map_option (Inf_tm p params)) R) o shows '')'') ''\<newline>'')) else () in case split_largest_interval X of (a, b) \<Rightarrow>
       prove_pos prnt i p ord F (a#b#XS))"
 
 hide_const (open) prove_pos_slp
 
 definition "prove_pos_slp prnt prec ord fa i xs = (let slp = slp_of_fas [fa] in prove_pos prnt i prec ord (\<lambda>p ord xs.
   case approx_slp prec ord 1 slp xs of None \<Rightarrow> None | Some [x] \<Rightarrow> Some x | Some _ \<Rightarrow> None) xs)"
 
 experiment begin
 
 unbundle floatarith_notation
 
 abbreviation "schwefel \<equiv>
   (5.8806 / 10 ^ 10) + (Var 0 - (Var 1)^\<^sub>e2)^\<^sub>e2 + (Var 1 - 1)^\<^sub>e2 + (Var 0 - (Var 2)^\<^sub>e2)^\<^sub>e2 + (Var 2 - 1)^\<^sub>e2"
 
 lemma "prove_pos_slp True 30 0 schwefel 100000 [replicate 3 (Ivl (-10) 10)]"
   by eval
 
 abbreviation "delta6 \<equiv> (Var 0 * Var 3 * (-Var 0 + Var 1 + Var 2 - Var 3 + Var 4 + Var 5) +
     Var 1 * Var 4 * ( Var 0 - Var 1 + Var 2 + Var 3 - Var 4 + Var 5) +
     Var 2 * Var 5 * ( Var 0 + Var 1 - Var 2 + Var 3 + Var 4 - Var 5)
    - Var 1 * Var 2 * Var 3
    - Var 0 * Var 2 * Var 4
    - Var 0 * Var 1 * Var 5
    - Var 3 * Var 4 * Var 5)"
 
 lemma "prove_pos_slp True 30 3 delta6 10000 [replicate 6 (Ivl 4 (Float 104045 (-14)))]"
   by eval
 
 abbreviation "caprasse \<equiv> (3.1801 + - Var 0 * (Var 2) ^\<^sub>e 3 + 4 * Var 1 * (Var 2)^\<^sub>e2 * Var 3 +
     4 * Var 0 * Var 2 * (Var 3)^\<^sub>e2 + 2 * Var 1 * (Var 3)^\<^sub>e3 + 4 * Var 0 * Var 2 + 4 * (Var 2)^\<^sub>e2 - 10 * Var 1 * Var 3 +
     -10 * (Var 3)^\<^sub>e2 + 2)"
 
 lemma "prove_pos_slp True 30 2 caprasse 10000 [replicate 4 (Ivl (-Float 1 (-1)) (Float 1 (-1)))]"
   by eval
 
 abbreviation "magnetism \<equiv>
   0.25001 + (Var 0)^\<^sub>e2 + 2 * (Var 1)^\<^sub>e2 + 2 * (Var 2)^\<^sub>e2 + 2 * (Var 3)^\<^sub>e2 + 2 * (Var 4)^\<^sub>e2 + 2 * (Var 5)^\<^sub>e2 +
     2 * (Var 6)^\<^sub>e2 - Var 0"
 
 end
 
 end
diff --git a/thys/Taylor_Models/Horner_Eval.thy b/thys/Taylor_Models/Horner_Eval.thy
--- a/thys/Taylor_Models/Horner_Eval.thy
+++ b/thys/Taylor_Models/Horner_Eval.thy
@@ -1,82 +1,82 @@
 section \<open>Horner Evaluation\<close>
 theory Horner_Eval
-  imports Interval
+  imports "HOL-Library.Interval"
 begin
 
 text \<open>Function and lemmas for evaluating polynomials via the horner scheme.
    Because interval multiplication is not distributive, interval polynomials
    expressed as a sum of monomials are not equivalent to their respective horner form.
    The functions and lemmas in this theory can be used to express interval
    polynomials in horner form and prove facts about them.\<close>
 
 fun horner_eval' where
   "horner_eval' f x v 0 = v"
 | "horner_eval' f x v (Suc i) = horner_eval' f x (f i + x * v) i"
 
 definition horner_eval
   where "horner_eval f x n = horner_eval' f x 0 n"
 
 lemma horner_eval_cong:
   assumes "\<And>i. i < n \<Longrightarrow> f i = g i"
   assumes "x = y"
   assumes "n = m"
   shows "horner_eval f x n = horner_eval g y m"
 proof-
   {
     fix v have "horner_eval' f x v n = horner_eval' g x v n"
       using assms(1) by (induction n arbitrary: v, simp_all)
   }
   thus ?thesis
     by (simp add: assms(2,3) horner_eval_def)
 qed
 
 lemma horner_eval_eq_setsum:
   fixes x::"'a::linordered_idom"
   shows "horner_eval f x n = (\<Sum>i<n. f i * x^i)"
 proof-
   {
     fix v have "horner_eval' f x v n = (\<Sum>i<n. f i * x^i) + v * x^n"
       by (induction n arbitrary: v, simp_all add: distrib_left mult.commute)
   }
   thus ?thesis by (simp add: horner_eval_def)
 qed
 
 lemma horner_eval_Suc[simp]:
   fixes x::"'a::linordered_idom"
   shows "horner_eval f x (Suc n) = horner_eval f x n + (f n) * x^n"
   unfolding horner_eval_eq_setsum
   by simp
 
 lemma horner_eval_Suc'[simp]:
   fixes x::"'a::{comm_monoid_add, times}"
   shows "horner_eval f x (Suc n) = f 0 + x * (horner_eval (\<lambda>i. f (Suc i)) x n)"
 proof-
   {
     fix v have "horner_eval' f x v (Suc n) = f 0 + x * horner_eval' (\<lambda>i. f (Suc i)) x v n"
       by (induction n arbitrary: v, simp_all)
   }
   thus ?thesis by (simp add: horner_eval_def)
 qed
 
 lemma horner_eval_0[simp]:
   shows "horner_eval f x 0 = 0"
   by (simp add: horner_eval_def)
 
 lemma horner_eval'_interval:
   fixes x::"'a::linordered_ring"
   assumes "\<And>i. i < n \<Longrightarrow> f i \<in> set_of (g i)"
   assumes "x \<in>\<^sub>i I" "v \<in>\<^sub>i V"
   shows "horner_eval' f x v n \<in>\<^sub>i horner_eval' g I V n"
   using assms
   by (induction n arbitrary: v V) (auto intro!: plus_in_intervalI times_in_intervalI)
 
 lemma horner_eval_interval:
   fixes x::"'a::linordered_idom"
   assumes "\<And>i. i < n \<Longrightarrow> f i \<in> set_of (g i)"
   assumes "x \<in> set_of I"
   shows "horner_eval f x n \<in>\<^sub>i horner_eval g I n"
   unfolding horner_eval_def
   using assms
   by (rule horner_eval'_interval) (auto simp: set_of_eq)
 
 end
diff --git a/thys/Taylor_Models/Interval.thy b/thys/Taylor_Models/Interval.thy
deleted file mode 100644
--- a/thys/Taylor_Models/Interval.thy
+++ /dev/null
@@ -1,840 +0,0 @@
-(* Author:     Christoph Traut, TU Muenchen
-                Fabian Immler, TU Muenchen
-*)
-section \<open>Interval Type\<close>
-theory Interval
-  imports
-    "HOL-Analysis.Multivariate_Analysis"
-    "HOL-Library.Set_Algebras"
-    "HOL-Library.Float"
-begin
-
-text \<open>A type of non-empty, closed intervals.\<close>
-
-typedef (overloaded) 'a interval =
-  "{(a::'a::preorder, b). a \<le> b}"
-  morphisms bounds_of_interval Interval
-  by auto
-
-setup_lifting type_definition_interval
-
-lift_definition lower::"('a::preorder) interval \<Rightarrow> 'a" is fst .
-
-lift_definition upper::"('a::preorder) interval \<Rightarrow> 'a" is snd .
-
-lemma interval_eq_iff: "a = b \<longleftrightarrow> lower a = lower b \<and> upper a = upper b"
-  by transfer auto
-
-lemma interval_eqI: "lower a = lower b \<Longrightarrow> upper a = upper b \<Longrightarrow> a = b"
-  by (auto simp: interval_eq_iff)
-
-lemma lower_le_upper[simp]: "lower i \<le> upper i"
-  by transfer auto
-
-lift_definition set_of :: "'a::preorder interval \<Rightarrow> 'a set" is "\<lambda>x. {fst x .. snd x}" .
-
-lemma set_of_eq: "set_of x = {lower x .. upper x}"
-  by transfer simp
-
-context notes [[typedef_overloaded]] begin
-
-lift_definition(code_dt) Interval'::"'a::preorder \<Rightarrow> 'a::preorder \<Rightarrow> 'a interval option"
-  is "\<lambda>a b. if a \<le> b then Some (a, b) else None"
-  by auto
-
-end
-
-instantiation "interval" :: ("{preorder,equal}") equal
-begin
-
-definition "equal_class.equal a b \<equiv> (lower a = lower b) \<and> (upper a = upper b)"
-
-instance proof qed (simp add: equal_interval_def interval_eq_iff)
-end
-
-instantiation interval :: ("preorder") ord begin
-
-definition less_eq_interval :: "'a interval \<Rightarrow> 'a interval \<Rightarrow> bool"
-  where "less_eq_interval a b \<longleftrightarrow> lower b \<le> lower a \<and> upper a \<le> upper b"
-
-definition less_interval :: "'a interval \<Rightarrow> 'a interval \<Rightarrow> bool"
-  where  "less_interval x y = (x \<le> y \<and> \<not> y \<le> x)"
-
-instance proof qed
-end
-
-instantiation interval :: ("lattice") semilattice_sup
-begin
-
-lift_definition sup_interval :: "'a interval \<Rightarrow> 'a interval \<Rightarrow> 'a interval"
-  is "\<lambda>(a, b) (c, d). (inf a c, sup b d)"
-  by (auto simp: le_infI1 le_supI1)
-
-lemma lower_sup[simp]: "lower (sup A B) = inf (lower A) (lower B)"
-  by transfer auto
-
-lemma upper_sup[simp]: "upper (sup A B) = sup (upper A) (upper B)"
-  by transfer auto
-
-instance proof qed (auto simp: less_eq_interval_def less_interval_def interval_eq_iff)
-end
-
-lemma set_of_interval_union: "set_of A \<union> set_of B \<subseteq> set_of (sup A B)" for A::"'a::lattice interval"
-  by (auto simp: set_of_eq)
-
-lemma interval_union_commute: "sup A B = sup B A" for A::"'a::lattice interval"
-  by (auto simp add: interval_eq_iff inf.commute sup.commute)
-
-lemma interval_union_mono1: "set_of a \<subseteq> set_of (sup a A)" for A :: "'a::lattice interval"
-  using set_of_interval_union by blast
-
-lemma interval_union_mono2: "set_of A \<subseteq> set_of (sup a A)" for A :: "'a::lattice interval"
-  using set_of_interval_union by blast
-
-lift_definition interval_of :: "'a::preorder \<Rightarrow> 'a interval" is "\<lambda>x. (x, x)"
-  by auto
-
-lemma lower_interval_of[simp]: "lower (interval_of a) = a"
-  by transfer auto
-
-lemma upper_interval_of[simp]: "upper (interval_of a) = a"
-  by transfer auto
-
-definition width :: "'a::{preorder,minus} interval \<Rightarrow> 'a"
-  where "width i = upper i - lower i"
-
-
-instantiation "interval" :: ("ordered_ab_semigroup_add") ab_semigroup_add
-begin
-
-lift_definition plus_interval::"'a interval \<Rightarrow> 'a interval \<Rightarrow> 'a interval"
-  is "\<lambda>(a, b). \<lambda>(c, d). (a + c, b + d)"
-  by (auto intro!: add_mono)
-lemma lower_plus[simp]: "lower (plus A B) = plus (lower A) (lower B)"
-  by transfer auto
-lemma upper_plus[simp]: "upper (plus A B) = plus (upper A) (upper B)"
-  by transfer auto
-
-instance proof qed (auto simp: interval_eq_iff less_eq_interval_def ac_simps)
-end
-
-instance "interval" :: ("{ordered_ab_semigroup_add, lattice}") ordered_ab_semigroup_add
-proof qed (auto simp: less_eq_interval_def intro!: add_mono)
-
-instantiation "interval" :: ("{preorder,zero}") zero
-begin
-
-lift_definition zero_interval::"'a interval" is "(0, 0)" by auto
-lemma lower_zero[simp]: "lower 0 = 0"
-  by transfer auto
-lemma upper_zero[simp]: "upper 0 = 0"
-  by transfer auto
-instance proof qed
-end
-
-instance "interval" :: ("{ordered_comm_monoid_add}") comm_monoid_add
-proof qed (auto simp: interval_eq_iff)
-
-instance "interval" :: ("{ordered_comm_monoid_add,lattice}") ordered_comm_monoid_add ..
-
-instantiation "interval" :: ("{ordered_ab_group_add}") uminus
-begin
-
-lift_definition uminus_interval::"'a interval \<Rightarrow> 'a interval" is "\<lambda>(a, b). (-b, -a)" by auto
-lemma lower_uminus[simp]: "lower (- A) = - upper A"
-  by transfer auto
-lemma upper_uminus[simp]: "upper (- A) = - lower A"
-  by transfer auto
-instance ..
-end
-
-instantiation "interval" :: ("{ordered_ab_group_add}") minus
-begin
-
-definition minus_interval::"'a interval \<Rightarrow> 'a interval \<Rightarrow> 'a interval"
-  where "minus_interval a b = a + - b"
-lemma lower_minus[simp]: "lower (minus A B) = minus (lower A) (upper B)"
-  by (auto simp: minus_interval_def)
-lemma upper_minus[simp]: "upper (minus A B) = minus (upper A) (lower B)"
-  by (auto simp: minus_interval_def)
-
-instance ..
-end
-
-instantiation "interval" :: (linordered_semiring) times
-begin
-
-lift_definition times_interval :: "'a interval \<Rightarrow> 'a interval \<Rightarrow> 'a interval"
-  is "\<lambda>(a1, a2). \<lambda>(b1, b2).
-    (let x1 = a1 * b1; x2 = a1 * b2; x3 = a2 * b1; x4 = a2 * b2
-    in (min x1 (min x2 (min x3 x4)), max x1 (max x2 (max x3 x4))))"
-  by (auto simp: Let_def intro!: min.coboundedI1 max.coboundedI1)
-
-lemma lower_times:
-  "lower (times A B) = Min {lower A * lower B, lower A * upper B, upper A * lower B, upper A * upper B}"
-  by transfer (auto simp: Let_def)
-
-lemma upper_times:
-  "upper (times A B) = Max {lower A * lower B, lower A * upper B, upper A * lower B, upper A * upper B}"
-  by transfer (auto simp: Let_def)
-
-instance ..
-end
-
-lemma interval_eq_set_of_iff: "X = Y \<longleftrightarrow> set_of X = set_of Y" for X Y::"'a::order interval"
-  by (auto simp: set_of_eq interval_eq_iff)
-
-
-subsection \<open>Membership\<close>
-
-abbreviation (in preorder) in_interval ("(_/ \<in>\<^sub>i _)" [51, 51] 50)
-  where "in_interval x X \<equiv> x \<in> set_of X"
-
-lemma in_interval_to_interval[intro!]: "a \<in>\<^sub>i interval_of a"
-  by (auto simp: set_of_eq)
-
-lemma plus_in_intervalI:
-  fixes x y :: "'a :: ordered_ab_semigroup_add"
-  shows "x \<in>\<^sub>i X \<Longrightarrow> y \<in>\<^sub>i Y \<Longrightarrow> x + y \<in>\<^sub>i X + Y"
-  by (simp add: add_mono_thms_linordered_semiring(1) set_of_eq)
-
-lemma connected_set_of[intro, simp]:
-  "connected (set_of X)" for X::"'a::linear_continuum_topology interval"
-  by (auto simp: set_of_eq )
-
-lemma ex_sum_in_interval_lemma: "\<exists>xa\<in>{la .. ua}. \<exists>xb\<in>{lb .. ub}. x = xa + xb"
-  if "la \<le> ua" "lb \<le> ub" "la + lb \<le> x" "x \<le> ua + ub"
-    "ua - la \<le> ub - lb"
-  for la b c d::"'a::linordered_ab_group_add"
-proof -
-  define wa where "wa = ua - la"
-  define wb where "wb = ub - lb"
-  define w where "w = wa + wb"
-  define d where "d = x - la - lb"
-  define da where "da = max 0 (min wa (d - wa))"
-  define db where "db = d - da"
-  from that have nonneg: "0 \<le> wa" "0 \<le> wb" "0 \<le> w" "0 \<le> d" "d \<le> w"
-    by (auto simp add: wa_def wb_def w_def d_def add.commute le_diff_eq)
-  have "0 \<le> db"
-    by (auto simp: da_def nonneg db_def intro!: min.coboundedI2)
-  have "x = (la + da) + (lb + db)"
-    by (simp add: da_def db_def d_def)
-  moreover
-  have "x - la - ub \<le> da"
-    using that
-    unfolding da_def
-    by (intro max.coboundedI2) (auto simp: wa_def d_def diff_le_eq diff_add_eq)
-  then have "db \<le> wb"
-    by (auto simp: db_def d_def wb_def algebra_simps)
-  with \<open>0 \<le> db\<close> that nonneg have "lb + db \<in> {lb..ub}"
-    by (auto simp: wb_def algebra_simps)
-  moreover
-  have "da \<le> wa"
-    by (auto simp: da_def nonneg)
-  then have "la + da \<in> {la..ua}"
-    by (auto simp: da_def wa_def algebra_simps)
-  ultimately show ?thesis
-    by force
-qed
-
-
-lemma ex_sum_in_interval: "\<exists>xa\<ge>la. xa \<le> ua \<and> (\<exists>xb\<ge>lb. xb \<le> ub \<and> x = xa + xb)"
-  if a: "la \<le> ua" and b: "lb \<le> ub" and x: "la + lb \<le> x" "x \<le> ua + ub"
-  for la b c d::"'a::linordered_ab_group_add"
-proof -
-  from linear consider "ua - la \<le> ub - lb" | "ub - lb \<le> ua - la"
-    by blast
-  then show ?thesis
-  proof cases
-    case 1
-    from ex_sum_in_interval_lemma[OF that 1]
-    show ?thesis by auto
-  next
-    case 2
-    from x have "lb + la \<le> x" "x \<le> ub + ua" by (simp_all add: ac_simps)
-    from ex_sum_in_interval_lemma[OF b a this 2]
-    show ?thesis by auto
-  qed
-qed
-
-lemma Icc_plus_Icc:
-  "{a .. b} + {c .. d} = {a + c .. b + d}"
-  if "a \<le> b" "c \<le> d"
-  for a b c d::"'a::linordered_ab_group_add"
-  using ex_sum_in_interval[OF that]
-  by (auto intro: add_mono simp: atLeastAtMost_iff Bex_def set_plus_def)
-
-lemma set_of_plus:
-  fixes A :: "'a::linordered_ab_group_add interval"
-  shows "set_of (A + B) = set_of A + set_of B"
-  using Icc_plus_Icc[of "lower A" "upper A" "lower B" "upper B"]
-  by (auto simp: set_of_eq)
-
-lemma plus_in_intervalE:
-  fixes xy :: "'a :: linordered_ab_group_add"
-  assumes "xy \<in>\<^sub>i X + Y"
-  obtains x y where "xy = x + y" "x \<in>\<^sub>i X" "y \<in>\<^sub>i Y"
-  using assms
-  unfolding set_of_plus set_plus_def
-  by auto
-
-lemma set_of_uminus: "set_of (-X) = {- x | x. x \<in> set_of X}"
-  for X :: "'a :: ordered_ab_group_add interval"
-  by (auto simp: set_of_eq simp: le_minus_iff minus_le_iff
-      intro!: exI[where x="-x" for x])
-
-lemma uminus_in_intervalI:
-  fixes x :: "'a :: ordered_ab_group_add"
-  shows "x \<in>\<^sub>i X \<Longrightarrow> -x \<in>\<^sub>i -X"
-  by (auto simp: set_of_uminus)
-
-lemma uminus_in_intervalD:
-  fixes x :: "'a :: ordered_ab_group_add"
-  shows "x \<in>\<^sub>i - X \<Longrightarrow> - x \<in>\<^sub>i X"
-  by (auto simp: set_of_uminus)
-
-lemma minus_in_intervalI:
-  fixes x y :: "'a :: ordered_ab_group_add"
-  shows "x \<in>\<^sub>i X \<Longrightarrow> y \<in>\<^sub>i Y \<Longrightarrow> x - y \<in>\<^sub>i X - Y"
-  by (metis diff_conv_add_uminus minus_interval_def plus_in_intervalI uminus_in_intervalI)
-
-lemma set_of_minus: "set_of (X - Y) = {x - y | x y . x \<in> set_of X \<and> y \<in> set_of Y}"
-  for X Y :: "'a :: linordered_ab_group_add interval"
-  unfolding minus_interval_def set_of_plus set_of_uminus set_plus_def
-  by force
-
-lemma times_in_intervalI:
-  fixes x y::"'a::linordered_ring"
-  assumes "x \<in>\<^sub>i X" "y \<in>\<^sub>i Y"
-  shows "x * y \<in>\<^sub>i X * Y"
-proof -
-  define X1 where "X1 \<equiv> lower X"
-  define X2 where "X2 \<equiv> upper X"
-  define Y1 where "Y1 \<equiv> lower Y"
-  define Y2 where "Y2 \<equiv> upper Y"
-  from assms have assms: "X1 \<le> x" "x \<le> X2" "Y1 \<le> y" "y \<le> Y2"
-    by (auto simp: X1_def X2_def Y1_def Y2_def set_of_eq)
-  have "(X1 * Y1 \<le> x * y \<or> X1 * Y2 \<le> x * y \<or> X2 * Y1 \<le> x * y \<or> X2 * Y2 \<le> x * y) \<and>
-        (X1 * Y1 \<ge> x * y \<or> X1 * Y2 \<ge> x * y \<or> X2 * Y1 \<ge> x * y \<or> X2 * Y2 \<ge> x * y)"
-  proof (cases x "0::'a" rule: linorder_cases)
-    case x0: less
-    show ?thesis
-    proof (cases "y < 0")
-      case y0: True
-      from y0 x0 assms have "x * y \<le> X1 * y" by (intro mult_right_mono_neg, auto)
-      also from x0 y0 assms have "X1 * y \<le> X1 * Y1" by (intro mult_left_mono_neg, auto)
-      finally have 1: "x * y \<le> X1 * Y1".
-      show ?thesis proof(cases "X2 \<le> 0")
-        case True
-        with assms have "X2 * Y2 \<le> X2 * y" by (auto intro: mult_left_mono_neg)
-        also from assms y0 have "... \<le> x * y" by (auto intro: mult_right_mono_neg)
-        finally have "X2 * Y2 \<le> x * y".
-        with 1 show ?thesis by auto
-      next
-        case False
-        with assms have "X2 * Y1 \<le> X2 * y" by (auto intro: mult_left_mono)
-        also from assms y0 have "... \<le> x * y" by (auto intro: mult_right_mono_neg)
-        finally have "X2 * Y1 \<le> x * y".
-        with 1 show ?thesis by auto
-      qed
-    next
-      case False
-      then have y0: "y \<ge> 0" by auto
-      from x0 y0 assms have "X1 * Y2 \<le> x * Y2" by (intro mult_right_mono, auto)
-      also from y0 x0 assms have "... \<le> x * y" by (intro mult_left_mono_neg, auto)
-      finally have 1: "X1 * Y2 \<le> x * y".
-      show ?thesis
-      proof(cases "X2 \<le> 0")
-        case X2: True
-        from assms y0 have "x * y \<le> X2 * y" by (intro mult_right_mono)
-        also from assms X2 have "... \<le> X2 * Y1" by (auto intro: mult_left_mono_neg)
-        finally have "x * y \<le> X2 * Y1".
-        with 1 show ?thesis by auto
-      next
-        case X2: False
-        from assms y0 have "x * y \<le> X2 * y" by (intro mult_right_mono)
-        also from assms X2 have "... \<le> X2 * Y2" by (auto intro: mult_left_mono)
-        finally have "x * y \<le> X2 * Y2".
-        with 1 show ?thesis by auto
-      qed
-    qed
-  next
-    case [simp]: equal
-    with assms show ?thesis by (cases "Y2 \<le> 0", auto intro:mult_sign_intros)
-  next
-    case x0: greater
-    show ?thesis
-    proof (cases "y < 0")
-      case y0: True
-      from x0 y0 assms have "X2 * Y1 \<le> X2 * y" by (intro mult_left_mono, auto)
-      also from y0 x0 assms have "X2 * y \<le> x * y" by (intro mult_right_mono_neg, auto)
-      finally have 1: "X2 * Y1 \<le> x * y".
-      show ?thesis
-      proof(cases "Y2 \<le> 0")
-        case Y2: True
-        from x0 assms have "x * y \<le> x * Y2" by (auto intro: mult_left_mono)
-        also from assms Y2 have "... \<le> X1 * Y2" by (auto intro: mult_right_mono_neg)
-        finally have "x * y \<le> X1 * Y2".
-        with 1 show ?thesis by auto
-      next
-        case Y2: False
-        from x0 assms have "x * y \<le> x * Y2" by (auto intro: mult_left_mono)
-        also from assms Y2 have "... \<le> X2 * Y2" by (auto intro: mult_right_mono)
-        finally have "x * y \<le> X2 * Y2".
-        with 1 show ?thesis by auto
-      qed
-    next
-      case y0: False
-      from x0 y0 assms have "x * y \<le> X2 * y" by (intro mult_right_mono, auto)
-      also from y0 x0 assms have "... \<le> X2 * Y2" by (intro mult_left_mono, auto)
-      finally have 1: "x * y \<le> X2 * Y2".
-      show ?thesis
-      proof(cases "X1 \<le> 0")
-        case True
-        with assms have "X1 * Y2 \<le> X1 * y" by (auto intro: mult_left_mono_neg)
-        also from assms y0 have "... \<le> x * y" by (auto intro: mult_right_mono)
-        finally have "X1 * Y2 \<le> x * y".
-        with 1 show ?thesis by auto
-      next
-        case False
-        with assms have "X1 * Y1 \<le> X1 * y" by (auto intro: mult_left_mono)
-        also from assms y0 have "... \<le> x * y" by (auto intro: mult_right_mono)
-        finally have "X1 * Y1 \<le> x * y".
-        with 1 show ?thesis by auto
-      qed
-    qed
-  qed
-  hence min:"min (X1 * Y1) (min (X1 * Y2) (min (X2 * Y1) (X2 * Y2))) \<le> x * y"
-    and max:"x * y \<le> max (X1 * Y1) (max (X1 * Y2) (max (X2 * Y1) (X2 * Y2)))"
-    by (auto simp:min_le_iff_disj le_max_iff_disj)
-  show ?thesis using min max
-    by (auto simp: Let_def X1_def X2_def Y1_def Y2_def set_of_eq lower_times upper_times)
-qed
-
-lemma times_in_intervalE:
-  fixes xy :: "'a :: {linordered_semiring, real_normed_algebra, linear_continuum_topology}"
-    \<comment> \<open>TODO: linear continuum topology is pretty strong\<close>
-  assumes "xy \<in>\<^sub>i X * Y"
-  obtains x y where "xy = x * y" "x \<in>\<^sub>i X" "y \<in>\<^sub>i Y"
-proof -
-  let ?mult = "\<lambda>(x, y). x * y"
-  let ?XY = "set_of X \<times> set_of Y"
-  have cont: "continuous_on ?XY ?mult"
-    by (auto intro!: tendsto_eq_intros simp: continuous_on_def split_beta')
-  have conn: "connected (?mult ` ?XY)"
-    by (rule connected_continuous_image[OF cont]) auto
-  have "lower (X * Y) \<in> ?mult ` ?XY" "upper (X * Y) \<in> ?mult ` ?XY"
-    by (auto simp: set_of_eq lower_times upper_times min_def max_def split: if_splits)
-  from connectedD_interval[OF conn this, of xy] assms
-  obtain x y where "xy = x * y" "x \<in>\<^sub>i X" "y \<in>\<^sub>i Y" by (auto simp: set_of_eq)
-  then show ?thesis ..
-qed
-
-lemma set_of_times: "set_of (X * Y) = {x * y | x y. x \<in> set_of X \<and> y \<in> set_of Y}"
-  for X Y::"'a :: {linordered_ring, real_normed_algebra, linear_continuum_topology} interval"
-  by (auto intro!: times_in_intervalI elim!: times_in_intervalE)
-
-instance "interval" :: (linordered_idom) cancel_semigroup_add
-proof qed (auto simp: interval_eq_iff)
-
-lemma interval_mul_commute: "A * B = B * A" for A B:: "'a::linordered_idom interval"
-  by (simp add: interval_eq_iff lower_times upper_times ac_simps)
-
-lemma interval_times_zero_right[simp]: "A * 0 = 0" for A :: "'a::linordered_ring interval"
-  by (simp add: interval_eq_iff lower_times upper_times ac_simps)
-
-lemma interval_times_zero_left[simp]:
-  "0 * A = 0" for A :: "'a::linordered_ring interval"
-  by (simp add: interval_eq_iff lower_times upper_times ac_simps)
-
-instantiation "interval" :: ("{preorder,one}") one
-begin
-
-lift_definition one_interval::"'a interval" is "(1, 1)" by auto
-lemma lower_one[simp]: "lower 1 = 1"
-  by transfer auto
-lemma upper_one[simp]: "upper 1 = 1"
-  by transfer auto
-instance proof qed
-end
-
-instance interval :: ("{one, preorder, linordered_semiring}") power
-proof qed
-
-lemma set_of_one[simp]: "set_of (1::'a::{one, order} interval) = {1}"
-  by (auto simp: set_of_eq)
-
-instance "interval" ::
-  ("{linordered_idom,linordered_ring, real_normed_algebra, linear_continuum_topology}") monoid_mult
-  apply standard
-  unfolding interval_eq_set_of_iff set_of_times
-  subgoal for a b c 
-    by (auto simp: interval_eq_set_of_iff set_of_times; metis mult.assoc)
-  by auto
-
-lemma one_times_ivl_left[simp]: "1 * A = A" for A :: "'a::linordered_idom interval"
-  by (simp add: interval_eq_iff lower_times upper_times ac_simps min_def max_def)
-
-lemma one_times_ivl_right[simp]: "A * 1 = A" for A :: "'a::linordered_idom interval"
-  by (metis interval_mul_commute one_times_ivl_left)
-
-lemma set_of_power_mono: "a^n \<in> set_of (A^n)" if "a \<in> set_of A"
-  for a :: "'a::linordered_idom"
-  using that
-  by (induction n) (auto intro!: times_in_intervalI)
-
-lemma set_of_add_cong:
-  "set_of (A + B) = set_of (A' + B')"
-  if "set_of A = set_of A'" "set_of B = set_of B'"
-  for A :: "'a::linordered_ab_group_add interval"
-  unfolding set_of_plus that ..
-
-lemma set_of_add_inc_left:
-  "set_of (A + B) \<subseteq> set_of (A' + B)"
-  if "set_of A \<subseteq> set_of A'"
-  for A :: "'a::linordered_ab_group_add interval"
-  unfolding set_of_plus using that by (auto simp: set_plus_def)
-
-lemma set_of_add_inc_right:
-  "set_of (A + B) \<subseteq> set_of (A + B')"
-  if "set_of B \<subseteq> set_of B'"
-  for A :: "'a::linordered_ab_group_add interval"
-  using set_of_add_inc_left[OF that]
-  by (simp add: add.commute)
-
-lemma set_of_add_inc:
-  "set_of (A + B) \<subseteq> set_of (A' + B')"
-  if "set_of A \<subseteq> set_of A'" "set_of B \<subseteq> set_of B'"
-  for A :: "'a::linordered_ab_group_add interval"
-  using set_of_add_inc_left[OF that(1)] set_of_add_inc_right[OF that(2)]
-  by auto
-
-lemma set_of_neg_inc:
-  "set_of (-A) \<subseteq> set_of (-A')"
-  if "set_of A \<subseteq> set_of A'"
-  for A :: "'a::ordered_ab_group_add interval"
-  using that
-  unfolding set_of_uminus
-  by auto
-
-lemma set_of_sub_inc_left:
-  "set_of (A - B) \<subseteq> set_of (A' - B)"
-  if "set_of A \<subseteq> set_of A'"
-  for A :: "'a::linordered_ab_group_add interval"
-  using that
-  unfolding set_of_minus
-  by auto
-
-lemma set_of_sub_inc_right:
-  "set_of (A - B) \<subseteq> set_of (A - B')"
-  if "set_of B \<subseteq> set_of B'"
-  for A :: "'a::linordered_ab_group_add interval"
-  using that
-  unfolding set_of_minus
-  by auto
-
-lemma set_of_sub_inc:
-  "set_of (A - B) \<subseteq> set_of (A' - B')"
-  if "set_of A \<subseteq> set_of A'" "set_of B \<subseteq> set_of B'"
-  for A :: "'a::linordered_idom interval"
-  using set_of_sub_inc_left[OF that(1)] set_of_sub_inc_right[OF that(2)]
-  by auto
-
-lemma set_of_mul_inc_right:
-  "set_of (A * B) \<subseteq> set_of (A * B')"
-  if "set_of B \<subseteq> set_of B'"
-  for A :: "'a::linordered_ring interval"
-  using that
-  apply transfer
-  apply (auto simp: Let_def)
-  apply (metis linear min.coboundedI1 min.coboundedI2 mult_left_mono mult_left_mono_neg order_trans)
-  apply (metis linear min.coboundedI1 min.coboundedI2 mult_left_mono mult_left_mono_neg order_trans)
-  apply (metis linear min.coboundedI1 min.coboundedI2 mult_left_mono mult_left_mono_neg order_trans)
-  apply (metis linear min.coboundedI1 min.coboundedI2 mult_left_mono mult_left_mono_neg order_trans)
-  apply (metis linear max.coboundedI1 max.coboundedI2 mult_left_mono mult_left_mono_neg order_trans)
-  apply (metis linear max.coboundedI1 max.coboundedI2 mult_left_mono mult_left_mono_neg order_trans)
-  apply (metis linear max.coboundedI1 max.coboundedI2 mult_left_mono mult_left_mono_neg order_trans)
-  apply (metis linear max.coboundedI1 max.coboundedI2 mult_left_mono mult_left_mono_neg order_trans)
-  done
-
-lemma set_of_distrib_left:
-  "set_of (B * (A1 + A2)) \<subseteq> set_of (B * A1 + B * A2)"
-  for A1 :: "'a::linordered_ring interval"
-  apply transfer
-  apply (auto simp: Let_def add_mono distrib_left distrib_right)
-  apply (metis add_mono min.cobounded1 min.left_commute)
-  apply (metis add_mono min.cobounded1 min.left_commute)
-  apply (metis add_mono min.assoc min.cobounded2)
-  apply (meson add_mono_thms_linordered_semiring(1) dual_order.trans max.cobounded1 max.cobounded2)
-  apply (meson add_mono_thms_linordered_semiring(1) dual_order.trans max.cobounded1 max.cobounded2)
-  apply (meson add_mono_thms_linordered_semiring(1) dual_order.trans max.cobounded1 max.cobounded2)
-  done
-
-lemma set_of_distrib_right:
-  "set_of ((A1 + A2) * B) \<subseteq> set_of (A1 * B + A2 * B)"
-  for A1 A2 B :: "'a::{linordered_ring, real_normed_algebra, linear_continuum_topology} interval"
-  unfolding set_of_times set_of_plus set_plus_def
-  apply clarsimp
-  subgoal for b a1 a2
-    apply (rule exI[where x="a1 * b"])
-    apply (rule conjI)
-    subgoal by force
-    subgoal
-      apply (rule exI[where x="a2 * b"])
-      apply (rule conjI)
-      subgoal by force
-      subgoal by (simp add: algebra_simps)
-      done
-    done
-  done
-
-lemma set_of_mul_inc_left:
-  "set_of (A * B) \<subseteq> set_of (A' * B)"
-  if "set_of A \<subseteq> set_of A'"
-  for A :: "'a::{linordered_ring, real_normed_algebra, linear_continuum_topology} interval"
-  using that
-  unfolding set_of_times
-  by auto
-
-lemma set_of_mul_inc:
-  "set_of (A * B) \<subseteq> set_of (A' * B')"
-  if "set_of A \<subseteq> set_of A'" "set_of B \<subseteq> set_of B'"
-  for A :: "'a::{linordered_ring, real_normed_algebra, linear_continuum_topology} interval"
-  using that unfolding set_of_times by auto
-
-lemma set_of_pow_inc:
-  "set_of (A^n) \<subseteq> set_of (A'^n)"
-  if "set_of A \<subseteq> set_of A'"
-  for A :: "'a::{linordered_idom, real_normed_algebra, linear_continuum_topology} interval"
-  using that
-  by (induction n, simp_all add: set_of_mul_inc)
-
-lemma set_of_distrib_right_left:
-  "set_of ((A1 + A2) * (B1 + B2)) \<subseteq> set_of (A1 * B1 + A1 * B2 + A2 * B1 + A2 * B2)"
-  for A1 :: "'a::{linordered_idom, real_normed_algebra, linear_continuum_topology} interval"
-proof-
-  have "set_of ((A1 + A2) * (B1 + B2)) \<subseteq> set_of (A1 * (B1 + B2) + A2 * (B1 + B2))"
-    by (rule set_of_distrib_right)
-  also have "... \<subseteq> set_of ((A1 * B1 + A1 * B2) + A2 * (B1 + B2))"
-    by (rule set_of_add_inc_left[OF set_of_distrib_left])
-  also have "... \<subseteq> set_of ((A1 * B1 + A1 * B2) + (A2 * B1 + A2 * B2))"
-    by (rule set_of_add_inc_right[OF set_of_distrib_left])
-  finally show ?thesis
-    by (simp add: add.assoc)
-qed
-
-lemma mult_bounds_enclose_zero1:
-  "min (la * lb) (min (la * ub) (min (lb * ua) (ua * ub))) \<le> 0"
-  "0 \<le> max (la * lb) (max (la * ub) (max (lb * ua) (ua * ub)))"
-  if "la \<le> 0" "0 \<le> ua"
-  for la lb ua ub:: "'a::linordered_idom"
-  subgoal by (metis (no_types, hide_lams) that eq_iff min_le_iff_disj mult_zero_left
-        mult_zero_right zero_le_mult_iff)
-  subgoal by (metis that le_max_iff_disj mult_zero_right order_refl zero_le_mult_iff)
-  done
-
-lemma mult_bounds_enclose_zero2:
-  "min (la * lb) (min (la * ub) (min (lb * ua) (ua * ub))) \<le> 0"
-  "0 \<le> max (la * lb) (max (la * ub) (max (lb * ua) (ua * ub)))"
-  if "lb \<le> 0" "0 \<le> ub"
-  for la lb ua ub:: "'a::linordered_idom"
-  using mult_bounds_enclose_zero1[OF that, of la ua]
-  by (simp_all add: ac_simps)
-
-lemma set_of_mul_contains_zero:
-  "0 \<in> set_of (A * B)"
-  if "0 \<in> set_of A \<or> 0 \<in> set_of B"
-  for A :: "'a::linordered_idom interval"
-  using that
-  by (auto simp: set_of_eq lower_times upper_times algebra_simps mult_le_0_iff
-      mult_bounds_enclose_zero1 mult_bounds_enclose_zero2)
-
-instance "interval" :: (linordered_semiring) mult_zero
-  apply standard
-  subgoal by transfer auto
-  subgoal by transfer auto
-  done
-
-lift_definition min_interval::"'a::linorder interval \<Rightarrow> 'a interval \<Rightarrow> 'a interval" is
-  "\<lambda>(l1, u1). \<lambda>(l2, u2). (min l1 l2, min u1 u2)"
-  by (auto simp: min_def)
-lemma lower_min_interval[simp]: "lower (min_interval x y) = min (lower x) (lower y)"
-  by transfer auto
-lemma upper_min_interval[simp]: "upper (min_interval x y) = min (upper x) (upper y)"
-  by transfer auto
-
-lemma min_intervalI:
-  "a \<in>\<^sub>i A \<Longrightarrow> b \<in>\<^sub>i B \<Longrightarrow> min a b \<in>\<^sub>i min_interval A B"
-  by (auto simp: set_of_eq min_def)
-
-lift_definition max_interval::"'a::linorder interval \<Rightarrow> 'a interval \<Rightarrow> 'a interval" is
-  "\<lambda>(l1, u1). \<lambda>(l2, u2). (max l1 l2, max u1 u2)"
-  by (auto simp: max_def)
-lemma lower_max_interval[simp]: "lower (max_interval x y) = max (lower x) (lower y)"
-  by transfer auto
-lemma upper_max_interval[simp]: "upper (max_interval x y) = max (upper x) (upper y)"
-  by transfer auto
-
-lemma max_intervalI:
-  "a \<in>\<^sub>i A \<Longrightarrow> b \<in>\<^sub>i B \<Longrightarrow> max a b \<in>\<^sub>i max_interval A B"
-  by (auto simp: set_of_eq max_def)
-
-lift_definition abs_interval::"'a::linordered_idom interval \<Rightarrow> 'a interval" is
-  "(\<lambda>(l,u). (if l < 0 \<and> 0 < u then 0 else min \<bar>l\<bar> \<bar>u\<bar>, max \<bar>l\<bar> \<bar>u\<bar>))"
-  by auto
-
-lemma lower_abs_interval[simp]:
-  "lower (abs_interval x) = (if lower x < 0 \<and> 0 < upper x then 0 else min \<bar>lower x\<bar> \<bar>upper x\<bar>)"
-  by transfer auto
-lemma upper_abs_interval[simp]: "upper (abs_interval x) = max \<bar>lower x\<bar> \<bar>upper x\<bar>"
-  by transfer auto
-
-lemma in_abs_intervalI1:
-  "lx < 0 \<Longrightarrow> 0 < ux \<Longrightarrow> 0 \<le> xa \<Longrightarrow> xa \<le> max (- lx) (ux) \<Longrightarrow> xa \<in> abs ` {lx..ux}"
-  for xa::"'a::linordered_idom"
-  by (metis abs_minus_cancel abs_of_nonneg atLeastAtMost_iff image_eqI le_less le_max_iff_disj
-      le_minus_iff neg_le_0_iff_le order_trans)
-
-lemma in_abs_intervalI2:
-  "min (\<bar>lx\<bar>) \<bar>ux\<bar> \<le> xa \<Longrightarrow> xa \<le> max \<bar>lx\<bar> \<bar>ux\<bar> \<Longrightarrow> lx \<le> ux \<Longrightarrow> 0 \<le> lx \<or> ux \<le> 0 \<Longrightarrow>
-    xa \<in> abs ` {lx..ux}"
-  for xa::"'a::linordered_idom"
-  by (force intro: image_eqI[where x="-xa"] image_eqI[where x="xa"])
-
-lemma set_of_abs_interval: "set_of (abs_interval x) = abs ` set_of x"
-  by (auto simp: set_of_eq not_less intro: in_abs_intervalI1 in_abs_intervalI2 cong del: image_cong_simp)
-
-fun split_domain :: "('a::preorder interval \<Rightarrow> 'a interval list) \<Rightarrow> 'a interval list \<Rightarrow> 'a interval list list"
-  where "split_domain split [] = [[]]"
-  | "split_domain split (I#Is) = (
-         let S = split I;
-             D = split_domain split Is
-         in concat (map (\<lambda>d. map (\<lambda>s. s # d) S) D)
-       )"
-
-context notes [[typedef_overloaded]] begin
-lift_definition(code_dt) split_interval::"'a::linorder interval \<Rightarrow> 'a \<Rightarrow> ('a interval \<times> 'a interval)"
-  is "\<lambda>(l, u) x. ((min l x, max l x), (min u x, max u x))"
-  by (auto simp: min_def)
-end
-
-lemma split_domain_nonempty:
-  assumes "\<And>I. split I \<noteq> []"
-  shows "split_domain split I \<noteq> []"
-  using last_in_set assms
-  by (induction I, auto)
-
-
-lemma split_intervalD: "split_interval X x = (A, B) \<Longrightarrow> set_of X \<subseteq> set_of A \<union> set_of B"
-  unfolding set_of_eq
-  by transfer (auto simp: min_def max_def split: if_splits)
-
-definition "split_float_interval x = split_interval x ((lower x + upper x) * Float 1 (-1))"
-
-lemma split_float_intervalD: "split_float_interval X = (A, B) \<Longrightarrow> set_of X \<subseteq> set_of A \<union> set_of B"
-  by (auto dest!: split_intervalD simp: split_float_interval_def)
-
-lemmas float_round_down_le[intro] = order_trans[OF float_round_down]
-  and float_round_up_ge[intro] = order_trans[OF _ float_round_up]
-
-instantiation interval :: ("{topological_space, preorder}") topological_space
-begin
-
-definition open_interval_def[code del]: "open (X::'a interval set) =
-  (\<forall>x\<in>X.
-      \<exists>A B.
-         open A \<and>
-         open B \<and>
-         lower x \<in> A \<and> upper x \<in> B \<and> Interval ` (A \<times> B) \<subseteq> X)"
-
-instance
-proof
-  show "open (UNIV :: ('a interval) set)"
-    unfolding open_interval_def by auto
-next
-  fix S T :: "('a interval) set"
-  assume "open S" "open T"
-  show "open (S \<inter> T)"
-    unfolding open_interval_def
-  proof (safe)
-    fix x assume "x \<in> S" "x \<in> T"
-    from \<open>x \<in> S\<close> \<open>open S\<close> obtain Sl Su where S:
-      "open Sl" "open Su" "lower x \<in> Sl" "upper x \<in> Su" "Interval ` (Sl \<times> Su) \<subseteq> S"
-      by (auto simp: open_interval_def)
-    from \<open>x \<in> T\<close> \<open>open T\<close> obtain Tl Tu where T:
-      "open Tl" "open Tu" "lower x \<in> Tl" "upper x \<in> Tu" "Interval ` (Tl \<times> Tu) \<subseteq> T"
-      by (auto simp: open_interval_def)
-
-    let ?L = "Sl \<inter> Tl" and ?U = "Su \<inter> Tu" 
-    have "open ?L \<and> open ?U \<and> lower x \<in> ?L \<and> upper x \<in> ?U \<and> Interval ` (?L \<times> ?U) \<subseteq> S \<inter> T"
-      using S T by (auto simp add: open_Int)
-    then show "\<exists>A B. open A \<and> open B \<and> lower x \<in> A \<and> upper x \<in> B \<and> Interval ` (A \<times> B) \<subseteq> S \<inter> T"
-      by fast
-  qed
-qed (unfold open_interval_def, fast)
-
-end
-
-
-definition mid :: "float interval \<Rightarrow> float"
-  where "mid i = (lower i + upper i) * Float 1 (-1)"
-
-lemma mid_in_interval: "mid i \<in>\<^sub>i i"
-  using lower_le_upper[of i]
-  by (auto simp: mid_def set_of_eq powr_minus)
-
-definition centered :: "float interval \<Rightarrow> float interval"
-  where "centered i = i - interval_of (mid i)"
-
-
-subsection \<open>Quickcheck\<close>
-
-lift_definition Ivl::"'a \<Rightarrow> 'a::preorder \<Rightarrow> 'a interval" is "\<lambda>a b. (min a b, b)"
-  by (auto simp: min_def)
-
-instantiation interval :: ("{exhaustive,preorder}") exhaustive
-begin
-
-definition exhaustive_interval::"('a interval \<Rightarrow> (bool \<times> term list) option)
-     \<Rightarrow> natural \<Rightarrow> (bool \<times> term list) option"
-  where
-    "exhaustive_interval f d =
-    Quickcheck_Exhaustive.exhaustive (\<lambda>x. Quickcheck_Exhaustive.exhaustive (\<lambda>y. f (Ivl x y)) d) d"
-
-instance ..
-
-end
-
-definition (in term_syntax) [code_unfold]:
-  "valtermify_interval x y = Code_Evaluation.valtermify (Ivl::'a::{preorder,typerep}\<Rightarrow>_) {\<cdot>} x {\<cdot>} y"
-
-instantiation interval :: ("{full_exhaustive,preorder,typerep}") full_exhaustive
-begin
-
-definition full_exhaustive_interval::
-  "('a interval \<times> (unit \<Rightarrow> term) \<Rightarrow> (bool \<times> term list) option)
-     \<Rightarrow> natural \<Rightarrow> (bool \<times> term list) option" where
-  "full_exhaustive_interval f d =
-    Quickcheck_Exhaustive.full_exhaustive
-      (\<lambda>x. Quickcheck_Exhaustive.full_exhaustive (\<lambda>y. f (valtermify_interval x y)) d) d"
-
-instance ..
-
-end
-
-instantiation interval :: ("{random,preorder,typerep}") random
-begin
-
-definition random_interval ::
-  "natural
-  \<Rightarrow> natural \<times> natural
-     \<Rightarrow> ('a interval \<times> (unit \<Rightarrow> term)) \<times> natural \<times> natural" where
-  "random_interval i =
-  scomp (Quickcheck_Random.random i)
-    (\<lambda>man. scomp (Quickcheck_Random.random i) (\<lambda>exp. Pair (valtermify_interval man exp)))"
-
-instance ..
-
-end
-
-end
diff --git a/thys/Taylor_Models/Interval_Approximation.thy b/thys/Taylor_Models/Interval_Approximation.thy
deleted file mode 100644
--- a/thys/Taylor_Models/Interval_Approximation.thy
+++ /dev/null
@@ -1,774 +0,0 @@
-section \<open>Approximate Operations on Intervals of Floating Point Numbers\<close>
-theory Interval_Approximation
-  imports
-    "HOL-Decision_Procs.Approximation_Bounds"
-    Interval
-begin
-
-lifting_update float.lifting \<comment> \<open>TODO: in Float!\<close>
-lifting_forget float.lifting
-
-text \<open>TODO: many of the lemmas should move to theories Float or Approximation
-  (the latter should be based on type @{type interval}.\<close>
-
-subsection "Intervals with Floating Point Bounds"
-
-lift_definition round_interval :: "nat \<Rightarrow> float interval \<Rightarrow> float interval"
-  is "\<lambda>p. \<lambda>(l, u). (float_round_down p l, float_round_up p u)"
-  by (auto simp: intro!: float_round_down_le float_round_up_le)
-
-lemma lower_round_ivl[simp]: "lower (round_interval p x) = float_round_down p (lower x)"
-  by transfer auto
-lemma upper_round_ivl[simp]: "upper (round_interval p x) = float_round_up p (upper x)"
-  by transfer auto
-
-lemma round_ivl_correct: "set_of A \<subseteq> set_of (round_interval prec A)"
-  by (auto simp: set_of_eq float_round_down_le float_round_up_le)
-
-lift_definition truncate_ivl :: "nat \<Rightarrow> real interval \<Rightarrow> real interval"
-  is "\<lambda>p. \<lambda>(l, u). (truncate_down p l, truncate_up p u)"
-  by (auto intro!: truncate_down_le truncate_up_le)
-
-lemma lower_truncate_ivl[simp]: "lower (truncate_ivl p x) = truncate_down p (lower x)"
-  by transfer auto
-lemma upper_truncate_ivl[simp]: "upper (truncate_ivl p x) = truncate_up p (upper x)"
-  by transfer auto
-
-lemma truncate_ivl_correct: "set_of A \<subseteq> set_of (truncate_ivl prec A)"
-  by (auto simp: set_of_eq intro!: truncate_down_le truncate_up_le)
-
-lift_definition real_interval::"float interval \<Rightarrow> real interval"
-  is "\<lambda>(l, u). (real_of_float l, real_of_float u)"
-  by auto
-
-lemma lower_real_interval[simp]: "lower (real_interval x) = lower x"
-  by transfer auto
-lemma upper_real_interval[simp]: "upper (real_interval x) = upper x"
-  by transfer auto
-
-definition "set_of' x = (case x of None \<Rightarrow> UNIV | Some i \<Rightarrow> set_of (real_interval i))"
-
-lemma real_interval_min_interval[simp]:
-  "real_interval (min_interval a b) = min_interval (real_interval a) (real_interval b)"
-  by (auto simp: interval_eq_set_of_iff set_of_eq real_of_float_min)
-
-lemma real_interval_max_interval[simp]:
-  "real_interval (max_interval a b) = max_interval (real_interval a) (real_interval b)"
-  by (auto simp: interval_eq_set_of_iff set_of_eq real_of_float_max)
-
-subsection \<open>Intervals for standard functions\<close>
-
-lift_definition power_float_interval :: "nat \<Rightarrow> nat \<Rightarrow> float interval \<Rightarrow> float interval"
-  is "\<lambda>p n (l, u). float_power_bnds p n l u"
-  using float_power_bnds
-  by (auto simp: bnds_power dest!: float_power_bnds[OF sym])
-
-lemma lower_power_float_interval[simp]:
-  "lower (power_float_interval p n x) = fst (float_power_bnds p n (lower x) (upper x))"
-  by transfer auto
-lemma upper_power_float_interval[simp]:
-  "upper (power_float_interval p n x) = snd (float_power_bnds p n (lower x) (upper x))"
-  by transfer auto
-
-lemma power_float_intervalI: "x \<in>\<^sub>i real_interval X \<Longrightarrow> x ^ n \<in>\<^sub>i real_interval (power_float_interval p n X)"
-  using float_power_bnds[OF prod.collapse]
-  by (auto simp: set_of_eq )
-
-lift_definition mult_float_interval::"nat \<Rightarrow> float interval \<Rightarrow> float interval \<Rightarrow> float interval"
-  is "\<lambda>prec. \<lambda>(a1, a2). \<lambda>(b1, b2). bnds_mult prec a1 a2 b1 b2"
-  by (auto dest!: bnds_mult[OF sym])
-
-lemma lower_mult_float_interval[simp]:
-  "lower (mult_float_interval p x y) = fst (bnds_mult p (lower x) (upper x) (lower y) (upper y))"
-  by transfer auto
-lemma upper_mult_float_interval[simp]:
-  "upper (mult_float_interval p x y) = snd (bnds_mult p (lower x) (upper x) (lower y) (upper y))"
-  by transfer auto
-
-lemma mult_float_interval:
-  "set_of (real_interval A) * set_of (real_interval B) \<subseteq>
-    set_of (real_interval (mult_float_interval prec A B))"
-proof -
-  let ?bm = "bnds_mult prec (lower A) (upper A) (lower B) (upper B)"
-  show ?thesis
-    using bnds_mult[of "fst ?bm" "snd ?bm", simplified, OF refl]
-    by (auto simp: set_of_eq set_times_def)
-qed
-
-lemma mult_float_intervalI:
-  "x * y \<in>\<^sub>i (real_interval (mult_float_interval prec A B))"
-  if "x \<in>\<^sub>i real_interval A" "y \<in>\<^sub>i real_interval B"
-  using mult_float_interval[of A B] that
-  by (auto simp: )
-
-lift_definition sqrt_float_interval::"nat \<Rightarrow> float interval \<Rightarrow> float interval"
-  is "\<lambda>prec. \<lambda>(lx, ux). (lb_sqrt prec lx, ub_sqrt prec ux)"
-  using bnds_sqrt'
-  by auto (meson order_trans real_sqrt_le_iff)
-
-lemma lower_float_interval[simp]: "lower (sqrt_float_interval prec X) = lb_sqrt prec (lower X)"
-  by transfer auto
-
-lemma upper_float_interval[simp]: "upper (sqrt_float_interval prec X) = ub_sqrt prec (upper X)"
-  by transfer auto
-
-lemma sqrt_float_interval:
-  "sqrt ` set_of (real_interval X) \<subseteq> set_of (real_interval (sqrt_float_interval prec X))"
-  using bnds_sqrt
-  by (auto simp: set_of_eq)
-
-lemma sqrt_float_intervalI:
-  "sqrt x \<in>\<^sub>i real_interval (sqrt_float_interval p X)"
-  if "x \<in> set_of (real_interval X)"
-  using sqrt_float_interval[of X p] that
-  by auto
-
-lemmas [simp del] = lb_arctan.simps ub_arctan.simps
-
-lemma lb_arctan: "arctan (real_of_float x) \<le> y \<Longrightarrow> real_of_float (lb_arctan prec x) \<le> y"
-  and ub_arctan: "y \<le> arctan x \<Longrightarrow> y \<le> ub_arctan prec x"
-  for x::float and y::real
-  using arctan_boundaries[of x prec] by auto
-
-lift_definition arctan_float_interval :: "nat \<Rightarrow> float interval \<Rightarrow> float interval"
-  is "\<lambda>prec. \<lambda>(lx, ux). (lb_arctan prec lx, ub_arctan prec ux)"
-  by (auto intro!: lb_arctan ub_arctan arctan_monotone')
-
-lemma lower_arctan_float_interval[simp]: "lower (arctan_float_interval p x) = lb_arctan p (lower x)"
-  by transfer auto
-lemma upper_arctan_float_interval[simp]: "upper (arctan_float_interval p x) = ub_arctan p (upper x)"
-  by transfer auto
-
-lemma arctan_float_interval:
-  "arctan ` set_of (real_interval x) \<subseteq> set_of (real_interval (arctan_float_interval p x))"
-  by (auto simp: set_of_eq intro!: lb_arctan ub_arctan arctan_monotone')
-
-lemma arctan_float_intervalI:
-  "arctan x \<in>\<^sub>i real_interval (arctan_float_interval p X)"
-  if "x \<in> set_of (real_interval X)"
-  using arctan_float_interval[of X p] that
-  by auto
-
-lemma bnds_cos_lower: "\<And>x. real_of_float xl \<le> x \<Longrightarrow> x \<le> real_of_float xu \<Longrightarrow> cos x \<le> y \<Longrightarrow> real_of_float (fst (bnds_cos prec xl xu)) \<le> y"
-  and bnds_cos_upper: "\<And>x. real_of_float xl \<le> x \<Longrightarrow> x \<le> real_of_float xu \<Longrightarrow> y \<le> cos x \<Longrightarrow> y \<le> real_of_float (snd (bnds_cos prec xl xu))"
-  for xl xu::float and y::real
-  using bnds_cos[of "fst (bnds_cos prec xl xu)" "snd (bnds_cos prec xl xu)" prec]
-  by force+
-
-lift_definition cos_float_interval :: "nat \<Rightarrow> float interval \<Rightarrow> float interval"
-  is "\<lambda>prec. \<lambda>(lx, ux). bnds_cos prec lx ux"
-  using bnds_cos
-  by auto (metis (full_types) order_refl order_trans)
-
-lemma lower_cos_float_interval[simp]: "lower (cos_float_interval p x) = fst (bnds_cos p (lower x) (upper x))"
-  by transfer auto
-lemma upper_cos_float_interval[simp]: "upper (cos_float_interval p x) = snd (bnds_cos p (lower x) (upper x))"
-  by transfer auto
-
-lemma cos_float_interval:
-  "cos ` set_of (real_interval x) \<subseteq> set_of (real_interval (cos_float_interval p x))"
-  by (auto simp: set_of_eq bnds_cos_lower bnds_cos_upper)
-
-lemma cos_float_intervalI:
-  "cos x \<in>\<^sub>i real_interval (cos_float_interval p X)"
-  if "x \<in> set_of (real_interval X)"
-  using cos_float_interval[of X p] that
-  by auto
-
-lemma lb_exp: "exp x \<le> y \<Longrightarrow> lb_exp prec x \<le> y"
-  and ub_exp: "y \<le> exp x \<Longrightarrow> y \<le> ub_exp prec x"
-  for x::float and y::real using exp_boundaries[of x prec] by auto
-
-lift_definition exp_float_interval :: "nat \<Rightarrow> float interval \<Rightarrow> float interval"
-  is "\<lambda>prec. \<lambda>(lx, ux). (lb_exp prec lx, ub_exp prec ux)"
-  by (auto simp: lb_exp ub_exp)
-
-lemma lower_exp_float_interval[simp]: "lower (exp_float_interval p x) = lb_exp p (lower x)"
-  by transfer auto
-lemma upper_exp_float_interval[simp]: "upper (exp_float_interval p x) = ub_exp p (upper x)"
-  by transfer auto
-
-lemma exp_float_interval:
-  "exp ` set_of (real_interval x) \<subseteq> set_of (real_interval (exp_float_interval p x))"
-  using exp_boundaries apply (auto simp: set_of_eq)
-  apply (smt exp_le_cancel_iff)
-  apply (smt exp_le_cancel_iff)
-  done
-
-lemma exp_float_intervalI:
-  "exp x \<in>\<^sub>i real_interval (exp_float_interval p X)"
-  if "x \<in> set_of (real_interval X)"
-  using exp_float_interval[of X p] that
-  by auto
-
-lemmas [simp del] = lb_ln.simps ub_ln.simps
-
-lemma lb_lnD:
-  "y \<le> ln x \<and> 0 < real_of_float x" if "lb_ln prec x = Some y"
-  using lb_ln[OF that[symmetric]] by auto
-
-lemma ub_lnD:
-  "ln x \<le> y\<and> 0 < real_of_float x" if "ub_ln prec x = Some y"
-  using ub_ln[OF that[symmetric]] by auto
-
-lift_definition(code_dt) ln_float_interval :: "nat \<Rightarrow> float interval \<Rightarrow> float interval option"
-  is "\<lambda>prec. \<lambda>(lx, ux).
-    Option.bind (lb_ln prec lx) (\<lambda>l.
-      Option.bind (ub_ln prec ux) (\<lambda>u. Some (l, u)))"
-  by (auto simp: pred_option_def bind_eq_Some_conv ln_le_cancel_iff[symmetric]
-      simp del: ln_le_cancel_iff dest!: lb_lnD ub_lnD)
-
-lemma ln_float_interval_eq_Some_conv[simp]:
-  "ln_float_interval p x = Some y \<longleftrightarrow>
-    lb_ln p (lower x) = Some (lower y) \<and> ub_ln p (upper x) = Some (upper y)"
-  by transfer (auto simp: bind_eq_Some_conv)
-
-lemma ln_float_interval: "ln ` set_of (real_interval x) \<subseteq> set_of (real_interval y)"
-  if "ln_float_interval p x = Some y"
-  using that
-  by (simp add: set_of_eq)
-    (smt atLeastAtMost_iff bnds_ln image_subset_iff)
-
-lemma ln_float_intervalI:
-  "ln x \<in> set_of' (ln_float_interval p X)"
-  if "x \<in>\<^sub>i (real_interval X)"
-  using ln_float_interval[of p X] that
-  by (auto simp: set_of'_def split: option.splits)
-
-lift_definition(code_dt) powr_float_interval :: "nat \<Rightarrow> float interval \<Rightarrow> float interval \<Rightarrow> float interval option"
-  is "\<lambda>prec. \<lambda>(l1, u1). \<lambda>(l2, u2). bnds_powr prec l1 u1 l2 u2"
-  by (auto simp: pred_option_def dest!: bnds_powr[OF sym])
-
-lemma powr_float_interval:
-  "{x powr y | x y. x \<in> set_of (real_interval X) \<and> y \<in> set_of (real_interval Y)}
-    \<subseteq> set_of (real_interval R)"
-  if "powr_float_interval prec X Y = Some R"
-  using that
-  by transfer (auto dest!: bnds_powr[OF sym])
-
-lemma powr_float_intervalI:
-  "x powr y \<in> set_of' (powr_float_interval p X Y)"
-  if "x \<in>\<^sub>i real_interval X" "y \<in>\<^sub>i real_interval Y"
-  using powr_float_interval[of p X Y] that
-  by (auto simp: set_of'_def split: option.splits)
-
-lift_definition(code_dt) inverse_float_interval::"nat \<Rightarrow> float interval \<Rightarrow> float interval option" is
-  "\<lambda>prec (l, u). if (0 < l \<or> u < 0) then Some (float_divl prec 1 u, float_divr prec 1 l) else None"
-  by (auto intro!: order_trans[OF float_divl] order_trans[OF _ float_divr]
-      simp: divide_simps)
-
-lemma inverse_float_interval_eq_Some_conv[simp]:
-  defines "one \<equiv> (1::float)"
-  shows 
-    "inverse_float_interval p X = Some R \<longleftrightarrow>
-    (lower X > 0 \<or> upper X < 0) \<and>
-    lower R = float_divl p one (upper X) \<and>
-    upper R = float_divr p one (lower X)"
-  by clarsimp (transfer fixing: one, force simp: one_def split: if_splits)
-
-lemma inverse_float_interval:
-  "inverse ` set_of (real_interval X) \<subseteq> set_of (real_interval Y)"
-  if "inverse_float_interval p X = Some Y"
-  using that
-  apply (clarsimp simp: set_of_eq)
-  by (intro order_trans[OF float_divl] order_trans[OF _ float_divr] conjI)
-    (auto simp: divide_simps)
-
-lemma inverse_float_intervalI:
-  "x \<in> set_of (real_interval X) \<Longrightarrow> inverse x \<in> set_of' (inverse_float_interval p X)"
-  using inverse_float_interval[of p X]
-  by (auto simp: set_of'_def split: option.splits)
-
-
-lift_definition pi_float_interval::"nat \<Rightarrow> float interval" is "\<lambda>prec. (lb_pi prec, ub_pi prec)"
-  using pi_boundaries
-  by (auto intro: order_trans)
-
-lemma lower_pi_float_interval[simp]: "lower (pi_float_interval prec) = lb_pi prec"
-  by transfer auto
-lemma upper_pi_float_interval[simp]: "upper (pi_float_interval prec) = ub_pi prec"
-  by transfer auto
-lemma pi_float_interval: "pi \<in> set_of (real_interval (pi_float_interval prec))"
-  using pi_boundaries
-  by (auto simp: set_of_eq)
-
-lemma real_interval_abs_interval[simp]:
-  "real_interval (abs_interval x) = abs_interval (real_interval x)"
-  by (auto simp: interval_eq_set_of_iff set_of_eq real_of_float_max real_of_float_min)
-
-lift_definition floor_float_interval::"float interval \<Rightarrow> float interval" is
-  "\<lambda>(l, u). (floor_fl l, floor_fl u)"
-  by (auto intro!: floor_mono simp: floor_fl.rep_eq)
-
-lemma lower_floor_float_interval[simp]: "lower (floor_float_interval x) = floor_fl (lower x)"
-  by transfer auto
-lemma upper_floor_float_interval[simp]: "upper (floor_float_interval x) = floor_fl (upper x)"
-  by transfer auto
-
-lemma floor_float_intervalI: "\<lfloor>x\<rfloor> \<in>\<^sub>i real_interval (floor_float_interval X)"
-  if "x \<in>\<^sub>i real_interval X"
-  using that by (auto simp: set_of_eq floor_fl_def floor_mono)
-
-
-lemma in_intervalI:
-  "x \<in>\<^sub>i X" if "lower X \<le> x" "x \<le> upper X"
-  using that by (auto simp: set_of_eq)
-
-abbreviation in_real_interval ("(_/ \<in>\<^sub>r _)" [51, 51] 50) where
-  "x \<in>\<^sub>r X \<equiv> x \<in>\<^sub>i real_interval X"
-
-lemma in_real_intervalI:
-  "x \<in>\<^sub>r X" if "lower X \<le> x" "x \<le> upper X" for x::real and X::"float interval"
-  using that
-  by (intro in_intervalI) auto
-
-lemma lower_Interval: "lower (Interval x) = fst x"
-  and upper_Interval: "upper (Interval x) = snd x"
-  if "fst x \<le> snd x"
-  using that
-  by (auto simp: lower_def upper_def Interval_inverse split_beta')
-
-definition all_in_i :: "'a::preorder list \<Rightarrow> 'a interval list \<Rightarrow> bool"
-  (infix "(all'_in\<^sub>i)" 50)
-  where "x all_in\<^sub>i I = (length x = length I \<and> (\<forall>i < length I. x ! i \<in>\<^sub>i I ! i))"
-
-definition all_in :: "real list \<Rightarrow> float interval list \<Rightarrow> bool"
-  (infix "(all'_in)" 50)
-  where "x all_in I = (length x = length I \<and> (\<forall>i < length I. x ! i \<in>\<^sub>r I ! i))"
-
-definition all_subset :: "'a::order interval list \<Rightarrow> 'a interval list \<Rightarrow> bool"
-  (infix "(all'_subset)" 50)
-  where "I all_subset J = (length I = length J \<and> (\<forall>i < length I. set_of (I!i) \<subseteq> set_of (J!i)))"
-
-lemmas [simp] = all_in_def all_subset_def
-
-lemma all_subsetD:
-  assumes "I all_subset J"
-  assumes "x all_in I"
-  shows "x all_in J"
-  using assms
-  by (auto simp: set_of_eq; fastforce)
-
-lemma plus_down_mono: "plus_down p a b \<le> plus_down p c d" if "a + b \<le> c + d"
-  by (auto simp: plus_down_def intro!: truncate_down_mono that)
-
-lemma plus_up_mono: "plus_up p a b \<le> plus_up p c d" if "a + b \<le> c + d"
-  by (auto simp: plus_up_def intro!: truncate_up_mono that)
-
-lemma round_interval_mono: "set_of (round_interval prec X) \<subseteq> set_of (round_interval prec Y)"
-  if "set_of X \<subseteq> set_of Y"
-  using that
-  by transfer
-    (auto simp: float_round_down.rep_eq float_round_up.rep_eq truncate_down_mono truncate_up_mono)
-
-lemma mult_mono_nonpos_nonneg: "a * b \<le> c * d"
-  if  "a \<le> c" "a \<le> 0" "0 \<le> d" "d \<le> b" for a b c d::"'a::ordered_ring"
-  apply (rule order_trans[OF mult_left_mono_neg[OF \<open>d \<le> b\<close>]])
-  subgoal using that by auto
-  by (rule mult_right_mono; fact)
-
-lemma mult_mono_nonneg_nonpos: "b * a \<le> d * c"
-  if  "a \<le> c" "c \<le> 0" "0 \<le> d" "d \<le> b" for a b c d::"'a::ordered_ring"
-  apply (rule order_trans[OF mult_right_mono_neg[OF \<open>d \<le> b\<close>]])
-  subgoal using that by auto
-  by (rule mult_left_mono; fact)
-
-lemma mult_mono_nonpos_nonpos: "a * b \<le> c * d"
-  if  "a \<ge> c" "a \<le> 0" "b \<ge> d" "d \<le> 0" for a b c d::real
-  apply (rule order_trans[OF mult_left_mono_neg[OF \<open>d \<le> b\<close>]])
-  subgoal using that by auto
-  by (rule mult_right_mono_neg; fact)
-
-lemma mult_float_mono1:
-  notes mono_rules = plus_down_mono add_mono nprt_mono nprt_le_zero zero_le_pprt pprt_mono
-  shows "a \<le> b \<Longrightarrow> ab \<le> bb \<Longrightarrow>
-       aa \<le> a \<Longrightarrow>
-       b \<le> ba \<Longrightarrow>
-       ac \<le> ab \<Longrightarrow>
-       bb \<le> bc \<Longrightarrow>
-       plus_down prec (nprt aa * pprt bc)
-        (plus_down prec (nprt ba * nprt bc)
-          (plus_down prec (pprt aa * pprt ac)
-            (pprt ba * nprt ac)))
-       \<le> plus_down prec (nprt a * pprt bb)
-           (plus_down prec (nprt b * nprt bb)
-             (plus_down prec (pprt a * pprt ab)
-               (pprt b * nprt ab)))"
-  apply (rule order_trans)
-  apply (rule mono_rules | assumption)+
-  apply (rule mult_mono_nonpos_nonneg)
-  apply (rule mono_rules | assumption)+
-  apply (rule mult_mono_nonpos_nonpos)
-  apply (rule mono_rules | assumption)+
-  apply (rule mult_mono)
-  apply (rule mono_rules | assumption)+
-  apply (rule mult_mono_nonneg_nonpos)
-  apply (rule mono_rules | assumption)+
-  by (rule order_refl)+
-
-lemma mult_float_mono2:
-  notes mono_rules = plus_up_mono add_mono nprt_mono nprt_le_zero zero_le_pprt pprt_mono
-  shows "a \<le> b \<Longrightarrow>
-       ab \<le> bb \<Longrightarrow>
-       aa \<le> a \<Longrightarrow>
-       b \<le> ba \<Longrightarrow>
-       ac \<le> ab \<Longrightarrow>
-       bb \<le> bc \<Longrightarrow>
-       plus_up prec (pprt b * pprt bb)
-        (plus_up prec (pprt a * nprt bb)
-          (plus_up prec (nprt b * pprt ab)
-            (nprt a * nprt ab)))
-       \<le> plus_up prec (pprt ba * pprt bc)
-           (plus_up prec (pprt aa * nprt bc)
-             (plus_up prec (nprt ba * pprt ac)
-               (nprt aa * nprt ac)))"
-  apply (rule order_trans)
-  apply (rule mono_rules | assumption)+
-  apply (rule mult_mono)
-  apply (rule mono_rules | assumption)+
-  apply (rule mult_mono_nonneg_nonpos)
-  apply (rule mono_rules | assumption)+
-  apply (rule mult_mono_nonpos_nonneg)
-  apply (rule mono_rules | assumption)+
-  apply (rule mult_mono_nonpos_nonpos)
-  apply (rule mono_rules | assumption)+
-  by (rule order_refl)+
-
-lemma mult_float_interval_mono: "set_of (mult_float_interval prec A B) \<subseteq> set_of (mult_float_interval prec X Y)"
-  if "set_of A \<subseteq> set_of X" "set_of B \<subseteq> set_of Y"
-  using that
-  apply transfer
-  unfolding bnds_mult_def atLeastatMost_subset_iff float_plus_down.rep_eq float_plus_up.rep_eq
-  by (auto simp: float_plus_down.rep_eq float_plus_up.rep_eq mult_float_mono1 mult_float_mono2)
-
-lemma Ivl_simps[simp]: "lower (Ivl a b) = min a b" "upper (Ivl a b) = b"
-  subgoal by transfer simp
-  subgoal by transfer simp
-  done
-
-lemmas [simp del] = power_down.simps(2) power_up.simps(2)
-lemmas power_down_simp = power_down.simps(2)
-lemmas power_up_simp = power_up.simps(2)
-
-lemma power_down_even_nonneg: "even n \<Longrightarrow> 0 \<le> power_down p x n"
-  by (induct p x n rule: power_down.induct)
-    (auto simp: power_down_simp simp del: odd_Suc_div_two intro!: truncate_down_nonneg )
-
-lemma truncate_down_less_zero_iff[simp]: "truncate_down p x < 0 \<longleftrightarrow> x < 0"
-  by (metis le_less_trans not_less_iff_gr_or_eq truncate_down truncate_down_pos truncate_down_zero)
-
-lemma truncate_down_nonneg_iff[simp]: "truncate_down p x \<ge> 0 \<longleftrightarrow> x \<ge> 0"
-  using truncate_down_less_zero_iff[of p x] truncate_down_nonneg[of x p]
-  by linarith
-
-lemma truncate_down_eq_zero_iff[simp]: "truncate_down prec x = 0 \<longleftrightarrow> x = 0"
-  by (metis not_less_iff_gr_or_eq truncate_down_less_zero_iff truncate_down_pos truncate_down_zero)
-
-lemma power_down_eq_zero_iff[simp]: "power_down prec b n = 0 \<longleftrightarrow> b = 0 \<and> n \<noteq> 0"
-proof (induction n arbitrary: b rule: less_induct)
-  case (less x)
-  then show ?case
-    using power_down_simp[of _ _ "x - 1"]
-    by (cases x) (auto simp add: div2_less_self)
-qed
-
-lemma power_down_nonneg_iff[simp]:
-  "power_down prec b n \<ge> 0 \<longleftrightarrow> even n \<or> b \<ge> 0"
-proof (induction n arbitrary: b rule: less_induct)
-  case (less x)
-  show ?case
-    using less(1)[of "x - 1" b] power_down_simp[of _ _ "x - 1"]
-    by (cases x) (auto simp: algebra_split_simps zero_le_mult_iff)
-qed
-
-lemma power_down_neg_iff[simp]:
-  "power_down prec b n < 0 \<longleftrightarrow>
-    b < 0 \<and> odd n"
-  using power_down_nonneg_iff[of prec b n] by (auto simp del: power_down_nonneg_iff)
-
-lemma power_down_nonpos_iff[simp]:
-  notes [simp del] = power_down_neg_iff power_down_eq_zero_iff
-  shows "power_down prec b n \<le> 0 \<longleftrightarrow> b < 0 \<and> odd n \<or> b = 0 \<and> n \<noteq> 0"
-  using power_down_neg_iff[of prec b n] power_down_eq_zero_iff[of prec b n]
-  by auto
-
-lemma power_down_mono:
-  "power_down prec a n \<le> power_down prec b n"
-  if "((0 \<le> a \<and> a \<le> b)\<or>(odd n \<and> a \<le> b) \<or> (even n \<and> a \<le> 0 \<and> b \<le> a))"
-  using that
-proof (induction n arbitrary: a b rule: less_induct)
-  case (less i)
-  show ?case
-  proof (cases i)
-    case j: (Suc j)
-    note IH = less[unfolded j even_Suc not_not]
-    note [simp del] = power_down.simps
-    show ?thesis
-    proof cases
-      assume [simp]: "even j"
-      have "a * power_down prec a j \<le> b * power_down prec b j"
-        by (smt IH(1) IH(2) \<open>even j\<close> lessI mult_mono' mult_mono_nonpos_nonneg power_down_even_nonneg)
-      then have "truncate_down (Suc prec) (a * power_down prec a j) \<le> truncate_down (Suc prec) (b * power_down prec b j)"
-        by (auto intro!: truncate_down_mono simp: abs_le_square_iff[symmetric] abs_real_def)
-      then show ?thesis
-        unfolding j
-        by (simp add: power_down_simp)
-    next
-      assume [simp]: "odd j"
-      have "power_down prec 0 (Suc (j div 2)) \<le> - power_down prec b (Suc (j div 2))"
-        if "b < 0" "even (j div 2)"
-        apply (rule order_trans[where y=0])
-        using IH that by (auto simp: div2_less_self)
-      then have "truncate_down (Suc prec) ((power_down prec a (Suc (j div 2)))\<^sup>2)
-        \<le> truncate_down (Suc prec) ((power_down prec b (Suc (j div 2)))\<^sup>2)"
-        using IH
-        by (auto intro!: truncate_down_mono intro: order_trans[where y=0]
-            simp: abs_le_square_iff[symmetric] abs_real_def
-            div2_less_self)
-      then show ?thesis
-        unfolding j
-        by (simp add: power_down_simp)
-    qed
-  qed simp
-qed
-
-lemma truncate_up_nonneg: "0 \<le> truncate_up p x" if "0 \<le> x"
-  by (simp add: that truncate_up_le)
-
-lemma truncate_up_pos: "0 < truncate_up p x" if "0 < x"
-  by (meson less_le_trans that truncate_up)
-
-lemma truncate_up_less_zero_iff[simp]: "truncate_up p x < 0 \<longleftrightarrow> x < 0"
-proof -
-  have f1: "\<forall>n r. truncate_up n r + truncate_down n (- 1 * r) = 0"
-    by (simp add: truncate_down_uminus_eq)
-  have f2: "(\<forall>v0 v1. truncate_up v0 v1 + truncate_down v0 (- 1 * v1) = 0) = (\<forall>v0 v1. truncate_up v0 v1 = - 1 * truncate_down v0 (- 1 * v1))"
-    by (auto simp: truncate_up_eq_truncate_down)
-  have f3: "\<forall>x1. ((0::real) < x1) = (\<not> x1 \<le> 0)"
-    by fastforce
-  have "(- 1 * x \<le> 0) = (0 \<le> x)"
-    by force
-  then have "0 \<le> x \<or> \<not> truncate_down p (- 1 * x) \<le> 0"
-    using f3 by (meson truncate_down_pos)
-  then have "(0 \<le> truncate_up p x) \<noteq> (\<not> 0 \<le> x)"
-    using f2 f1 truncate_up_nonneg by force
-  then show ?thesis
-    by linarith
-qed
-
-lemma truncate_up_nonneg_iff[simp]: "truncate_up p x \<ge> 0 \<longleftrightarrow> x \<ge> 0"
-  using truncate_up_less_zero_iff[of p x] truncate_up_nonneg[of x]
-  by linarith
-
-lemma power_up_even_nonneg: "even n \<Longrightarrow> 0 \<le> power_up p x n"
-  by (induct p x n rule: power_up.induct)
-    (auto simp: power_up.simps simp del: odd_Suc_div_two intro!: )
-
-lemma truncate_up_eq_zero_iff[simp]: "truncate_up prec x = 0 \<longleftrightarrow> x = 0"
-  by (metis not_less_iff_gr_or_eq truncate_up_less_zero_iff truncate_up_pos truncate_up_zero)
-
-lemma power_up_eq_zero_iff[simp]: "power_up prec b n = 0 \<longleftrightarrow> b = 0 \<and> n \<noteq> 0"
-proof (induction n arbitrary: b rule: less_induct)
-  case (less x)
-  then show ?case
-    using power_up_simp[of _ _ "x - 1"]
-    by (cases x) (auto simp: algebra_split_simps zero_le_mult_iff div2_less_self)
-qed
-
-lemma power_up_nonneg_iff[simp]:
-  "power_up prec b n \<ge> 0 \<longleftrightarrow> even n \<or> b \<ge> 0"
-proof (induction n arbitrary: b rule: less_induct)
-  case (less x)
-  show ?case
-    using less(1)[of "x - 1" b] power_up_simp[of _ _ "x - 1"]
-    by (cases x) (auto simp: algebra_split_simps zero_le_mult_iff)
-qed
-
-lemma power_up_neg_iff[simp]:
-  "power_up prec b n < 0 \<longleftrightarrow> b < 0 \<and> odd n"
-  using power_up_nonneg_iff[of prec b n] by (auto simp del: power_up_nonneg_iff)
-
-lemma power_up_nonpos_iff[simp]:
-  notes [simp del] = power_up_neg_iff power_up_eq_zero_iff
-  shows "power_up prec b n \<le> 0 \<longleftrightarrow> b < 0 \<and> odd n \<or> b = 0 \<and> n \<noteq> 0"
-  using power_up_neg_iff[of prec b n] power_up_eq_zero_iff[of prec b n]
-  by auto
-
-lemma power_up_mono:
-  "power_up prec a n \<le> power_up prec b n"
-  if "((0 \<le> a \<and> a \<le> b)\<or>(odd n \<and> a \<le> b) \<or> (even n \<and> a \<le> 0 \<and> b \<le> a))"
-  using that
-proof (induction n arbitrary: a b rule: less_induct)
-  case (less i)
-  show ?case
-  proof (cases i)
-    case j: (Suc j)
-    note IH = less[unfolded j even_Suc not_not]
-    note [simp del] = power_up.simps
-    show ?thesis
-    proof cases
-      assume [simp]: "even j"
-      have "a * power_up prec a j \<le> b * power_up prec b j"
-        by (smt IH(1) IH(2) \<open>even j\<close> lessI mult_mono' mult_mono_nonpos_nonneg power_up_even_nonneg)
-      then have "truncate_up prec (a * power_up prec a j) \<le> truncate_up prec (b * power_up prec b j)"
-        by (auto intro!: truncate_up_mono simp: abs_le_square_iff[symmetric] abs_real_def)
-      then show ?thesis
-        unfolding j
-        by (simp add: power_up_simp)
-    next
-      assume [simp]: "odd j"
-      have "power_up prec 0 (Suc (j div 2)) \<le> - power_up prec b (Suc (j div 2))"
-        if "b < 0" "even (j div 2)"
-        apply (rule order_trans[where y=0])
-        using IH that by (auto simp: div2_less_self)
-      then have "truncate_up prec ((power_up prec a (Suc (j div 2)))\<^sup>2)
-        \<le> truncate_up prec ((power_up prec b (Suc (j div 2)))\<^sup>2)"
-        using IH
-        by (auto intro!: truncate_up_mono intro: order_trans[where y=0]
-            simp: abs_le_square_iff[symmetric] abs_real_def
-            div2_less_self)
-      then show ?thesis
-        unfolding j
-        by (simp add: power_up_simp)
-    qed
-  qed simp
-qed
-
-lemma set_of_subset_iff: "set_of X \<subseteq> set_of Y \<longleftrightarrow> lower Y \<le> lower X \<and> upper X \<le> upper Y"
-  for X Y::"'a::linorder interval"
-  by (auto simp: set_of_eq subset_iff)
-
-lemma power_float_interval_mono:
-  "set_of (power_float_interval prec n A)
-    \<subseteq> set_of (power_float_interval prec n B)"
-  if "set_of A \<subseteq> set_of B"
-proof -
-  define la where "la = real_of_float (lower A)"
-  define ua where "ua = real_of_float (upper A)"
-  define lb where "lb = real_of_float (lower B)"
-  define ub where "ub = real_of_float (upper B)"
-  have ineqs: "lb \<le> la" "la \<le> ua" "ua \<le> ub" "lb \<le> ub"
-    using that lower_le_upper[of A] lower_le_upper[of B]
-    by (auto simp: la_def ua_def lb_def ub_def set_of_eq)
-  show ?thesis
-    using ineqs
-    by (simp add: set_of_subset_iff float_power_bnds_def max_def
-        power_down_fl.rep_eq power_up_fl.rep_eq
-        la_def[symmetric] ua_def[symmetric] lb_def[symmetric] ub_def[symmetric])
-      (auto intro!: power_down_mono power_up_mono intro: order_trans[where y=0])
-qed
-
-lemma bounds_of_interval_eq_lower_upper:
-  "bounds_of_interval ivl = (lower ivl, upper ivl)" if "lower ivl \<le> upper ivl"
-  using that
-  by (auto simp: lower.rep_eq upper.rep_eq)
-
-lemma real_interval_Ivl: "real_interval (Ivl a b) = Ivl a b"
-  by transfer (auto simp: min_def)
-
-lemma set_of_mul_contains_real_zero:
-  "0 \<in>\<^sub>r (A * B)" if "0 \<in>\<^sub>r A \<or> 0 \<in>\<^sub>r B"
-  using that set_of_mul_contains_zero[of A B]
-  by (auto simp: set_of_eq)
-
-fun subdivide_interval :: "nat \<Rightarrow> float interval \<Rightarrow> float interval list"
-  where "subdivide_interval 0 I = [I]"
-  | "subdivide_interval (Suc n) I = (
-         let m = mid I
-         in (subdivide_interval n (Ivl (lower I) m)) @ (subdivide_interval n (Ivl m (upper I)))
-       )"
-
-lemma subdivide_interval_length:
-  shows "length (subdivide_interval n I) = 2^n"
-  by(induction n arbitrary: I, simp_all add: Let_def)
-
-lemma lower_le_mid: "lower x \<le> mid x" "real_of_float (lower x) \<le> mid x"
-  and mid_le_upper: "mid x \<le> upper x" "real_of_float (mid x) \<le> upper x"
-  unfolding mid_def
-  subgoal by transfer auto
-  subgoal by transfer auto
-  subgoal by transfer auto
-  subgoal by transfer auto
-  done
-
-lemma subdivide_interval_correct:
-  "list_ex (\<lambda>i. x \<in>\<^sub>r i) (subdivide_interval n I)" if "x \<in>\<^sub>r I" for x::real
-  using that
-proof(induction n arbitrary: x I)
-  case 0
-  then show ?case by simp
-next
-  case (Suc n)
-  from \<open>x \<in>\<^sub>r I\<close> consider "x \<in>\<^sub>r Ivl (lower I) (mid I)" | "x \<in>\<^sub>r Ivl (mid I) (upper I)"
-    by (cases "x \<le> real_of_float (mid I)")
-      (auto simp: set_of_eq min_def lower_le_mid mid_le_upper)
-  from this[case_names lower upper] show ?case
-    by cases (use Suc.IH in \<open>auto simp: Let_def\<close>)
-qed
-
-fun interval_list_union :: "'a::lattice interval list \<Rightarrow> 'a interval"
-  where "interval_list_union [] = undefined"
-  | "interval_list_union [I] = I"
-  | "interval_list_union (I#Is) = sup I (interval_list_union Is)"
-
-lemma interval_list_union_correct:
-  assumes "S \<noteq> []"
-  assumes "i < length S"
-  shows "set_of (S!i) \<subseteq> set_of (interval_list_union S)"
-  using assms
-proof(induction S arbitrary: i)
-  case (Cons a S i)
-  thus ?case
-  proof(cases S)
-    fix b S'
-    assume "S = b # S'"
-    hence "S \<noteq> []"
-      by simp
-    show ?thesis
-    proof(cases i)
-      case 0
-      show ?thesis
-        apply(cases S)
-        using interval_union_mono1
-        by (auto simp add: 0)
-    next
-      case (Suc i_prev)
-      hence "i_prev < length S"
-        using Cons(3) by simp
-
-      from Cons(1)[OF \<open>S \<noteq> []\<close> this] Cons(1)
-      have "set_of ((a # S) ! i) \<subseteq> set_of (interval_list_union S)"
-        by (simp add: \<open>i = Suc i_prev\<close>)
-      also have "... \<subseteq> set_of (interval_list_union (a # S))"
-        using \<open>S \<noteq> []\<close>
-        apply(cases S)
-        using interval_union_mono2
-        by auto
-      finally show ?thesis .
-    qed
-  qed simp
-qed simp
-
-lemma split_domain_correct:
-  fixes x :: "real list"
-  assumes "x all_in I"
-  assumes split_correct: "\<And>x a I. x \<in>\<^sub>r I \<Longrightarrow> list_ex (\<lambda>i::float interval. x \<in>\<^sub>r i) (split I)"
-  shows "list_ex (\<lambda>s. x all_in s) (split_domain split I)"
-  using assms(1)
-proof(induction I arbitrary: x)
-  case (Cons I Is x)
-  have "x \<noteq> []"
-    using Cons(2) by auto
-  obtain x' xs where x_decomp: "x = x' # xs"
-    using \<open>x \<noteq> []\<close> list.exhaust by auto
-  hence "x' \<in>\<^sub>r I" "xs all_in Is"
-    using Cons(2)
-    by auto
-  show ?case
-    using Cons(1)[OF \<open>xs all_in Is\<close>]
-      split_correct[OF \<open>x' \<in>\<^sub>r I\<close>]
-    apply (auto simp add: list_ex_iff set_of_eq)
-    by (smt length_Cons less_Suc_eq_0_disj nth_Cons_0 nth_Cons_Suc x_decomp)
-qed simp
-
-end
\ No newline at end of file
diff --git a/thys/Taylor_Models/Polynomial_Expression_Additional.thy b/thys/Taylor_Models/Polynomial_Expression_Additional.thy
--- a/thys/Taylor_Models/Polynomial_Expression_Additional.thy
+++ b/thys/Taylor_Models/Polynomial_Expression_Additional.thy
@@ -1,407 +1,407 @@
 theory Polynomial_Expression_Additional
-  imports Interval_Approximation
+  imports
     "Polynomial_Expression"
     "HOL-Decision_Procs.Approximation"
 begin
 
 lemma real_of_float_eq_zero_iff[simp]: "real_of_float x = 0 \<longleftrightarrow> x = 0"
   by (simp add: real_of_float_eq)
 
 text \<open>Theory @{theory Taylor_Models.Polynomial_Expression} contains a, more or less, 1:1 generalization
    of theory \<open>Multivariate_Polynomial\<close>. Any additions belong here.\<close>
 
 declare [[coercion_map map_poly]]
 declare [[coercion "interval_of::float\<Rightarrow>float interval"]]
 
 text \<open>Apply float interval arguments to a float poly.\<close>
 value "Ipoly [Ivl (Float 4 (-6)) (Float 10 6)] (poly.Add (poly.C (Float 3 5)) (poly.Bound 0))"
 
 text \<open>@{term map_poly} for homomorphisms\<close>
 
 lemma map_poly_homo_polyadd_eq_zero_iff:
   "map_poly f (p +\<^sub>p q) = 0\<^sub>p \<longleftrightarrow> p +\<^sub>p q = 0\<^sub>p"
   if [symmetric, simp]: "\<And>x y. f (x + y) = f x + f y" "\<And>x. f x = 0 \<longleftrightarrow> x = 0"
   by (induction p q rule: polyadd.induct) auto
 
 lemma zero_iffD: "(\<And>x. f x = 0 \<longleftrightarrow> x = 0) \<Longrightarrow> f 0 = 0"
   by auto
 
 lemma map_poly_homo_polyadd:
   "map_poly f (p1 +\<^sub>p p2) = map_poly f p1 +\<^sub>p map_poly f p2"
   if [simp]: "\<And>x y. f (x + y) = f x + f y" "\<And>x. f x = 0 \<longleftrightarrow> x = 0"
   by (induction p1 p2 rule: polyadd.induct)
     (auto simp: zero_iffD[OF that(2)] Let_def map_poly_homo_polyadd_eq_zero_iff)
 
 lemma map_poly_homo_polyneg:
   "map_poly f (~\<^sub>p p1) = ~\<^sub>p (map_poly f p1)"
   if [simp]: "\<And>x y. f (- x) = - f x"
   by (induction p1) (auto simp: Let_def map_poly_homo_polyadd_eq_zero_iff)
 
 lemma map_poly_homo_polysub:
   "map_poly f (p1 -\<^sub>p p2) = map_poly f p1 -\<^sub>p map_poly f p2"
   if [simp]: "\<And>x y. f (x + y) = f x + f y" "\<And>x. f x = 0 \<longleftrightarrow> x = 0" "\<And>x y. f (- x) = - f x"
   by (auto simp: polysub_def map_poly_homo_polyadd map_poly_homo_polyneg)
 
 lemma map_poly_homo_polymul:
   "map_poly f (p1 *\<^sub>p p2) = map_poly f p1 *\<^sub>p map_poly f p2"
   if [simp]: "\<And>x y. f (x + y) = f x + f y" "\<And>x. f x = 0 \<longleftrightarrow> x = 0" "\<And>x y. f (x * y) = f x * f y"
   by (induction p1 p2 rule: polymul.induct)
     (auto simp: zero_iffD[OF that(2)] map_poly_homo_polyadd)
 
 lemma map_poly_homo_polypow:
   "map_poly f (p1 ^\<^sub>p n) = map_poly f p1 ^\<^sub>p n"
   if [simp]: "\<And>x y. f (x + y) = f x + f y" "\<And>x. f x = 0 \<longleftrightarrow> x = 0" "\<And>x y. f (x * y) = f x * f y"
     "f 1 = 1" 
 proof(induction n rule: nat_less_induct)
   case (1 n)
   then show ?case
     apply (cases n)
      apply (auto simp: map_poly_homo_polyadd map_poly_homo_polymul)
     by (smt Suc_less_eq div2_less_self even_Suc odd_Suc_div_two map_poly_homo_polymul that)
 qed
 
 lemmas map_poly_homo_polyarith = map_poly_homo_polyadd map_poly_homo_polyneg map_poly_homo_polysub map_poly_homo_polymul map_poly_homo_polypow
 
 text \<open>Count the number of parameters of a polynomial.\<close>
 
 fun num_params :: "'a poly \<Rightarrow> nat"
   where "num_params (poly.C c) = 0"
   | "num_params (poly.Bound n)  = Suc n"
   | "num_params (poly.Add a b)  = max (num_params a) (num_params b)"
   | "num_params (poly.Sub a b)  = max (num_params a) (num_params b)"
   | "num_params (poly.Mul a b)  = max (num_params a) (num_params b)"
   | "num_params (poly.Neg a)    = num_params a"
   | "num_params (poly.Pw a n)   = num_params a"
   | "num_params (poly.CN a n b) = max (max (num_params a) (num_params b)) (Suc n)"
 
 lemma num_params_map_poly[simp]:
   shows "num_params (map_poly f p) = num_params p"
   by (induction p, simp_all)
 
 lemma num_params_polyadd:
   shows "num_params (p1 +\<^sub>p p2) \<le> max (num_params p1) (num_params p2)"
 proof (induction p1 p2 rule: polyadd.induct)
   case (4 c n p c' n' p')
   then show ?case
     by auto (auto simp: max_def Let_def split: if_splits)
 qed auto
 
 lemma num_params_polyneg:
   shows "num_params (~\<^sub>p p) = num_params p"
   by (induction p rule: polyneg.induct) simp_all
 
 lemma num_params_polymul:
   shows "num_params (p1 *\<^sub>p p2) \<le> max (num_params p1) (num_params p2)"
 proof (induction p1 p2 rule: polymul.induct)
   case (4 c n p c' n' p')
   then show ?case
     by auto (auto simp: max_def Let_def split: if_splits
           intro!: num_params_polyadd[THEN order_trans])
 qed auto
 
 lemma num_params_polypow:
   shows "num_params (p ^\<^sub>p n) \<le> num_params p"
   apply (induction n rule: polypow.induct)
   unfolding polypow.simps
   by (auto intro!: order_trans[OF num_params_polymul]
       simp: Let_def simp del: polypow.simps)
 
 lemma num_params_polynate:
   shows "num_params (polynate p) \<le> num_params p"
 proof(induction p rule: polynate.induct)
   case (2 l r)
   thus ?case
     using num_params_polyadd[of "polynate l" "polynate r"]
     by simp
 next
   case (3 l r)
   thus ?case
     using num_params_polyadd[of "polynate l" "~\<^sub>p (polynate r)"] 
     by (simp add: polysub_def num_params_polyneg)
 next
   case (4 l r)
   thus ?case
     using num_params_polymul[of "polynate l" "polynate r"]
     by simp
 next
   case (5 p)
   thus ?case
     by (simp add: num_params_polyneg)
 next
   case (6 p n)
   thus ?case
     using num_params_polypow[of n "polynate p"]
     by simp
 qed simp_all
 
 lemma polynate_map_poly_real[simp]:
   fixes p :: "float poly"
   shows "map_poly real_of_float (polynate p) = polynate (map_poly real_of_float p)"
   by (induction p) (simp_all add: map_poly_homo_polyarith)
 
 text \<open>Evaluating a float poly is equivalent to evaluating the corresponding
    real poly with the float parameters converted to reals.\<close>
 lemma Ipoly_real_float_eqiv:
   fixes p::"float poly" and xs::"float list"
   assumes "num_params p \<le> length xs"
   shows "Ipoly xs (p::real poly) = Ipoly xs p"
   using assms by (induction p, simp_all)
 
 text \<open>Evaluating an \<open>'a poly\<close> with \<open>'a interval\<close> arguments is monotone.\<close>
 lemma Ipoly_interval_args_mono:
   fixes p::"'a::linordered_idom poly"
     and   x::"'a list"
     and   xs::"'a interval list"
   assumes "x all_in\<^sub>i xs"
   assumes "num_params p \<le> length xs"
   shows "Ipoly x p \<in> set_of (Ipoly xs (map_poly interval_of p))"
   using assms
   by (induction p)
     (auto simp: all_in_i_def plus_in_intervalI minus_in_intervalI times_in_intervalI
       uminus_in_intervalI set_of_power_mono)
 
 lemma Ipoly_interval_args_inc_mono:
   fixes p::"'a::{real_normed_algebra, linear_continuum_topology, linordered_idom} poly"
     and   I::"'a interval list" and J::"'a interval list"
   assumes "num_params p \<le> length I"
   assumes "I all_subset J"
   shows "set_of (Ipoly I (map_poly interval_of p)) \<subseteq> set_of (Ipoly J (map_poly interval_of p))"
   using assms
   by (induction p)
     (simp_all add: set_of_add_inc set_of_sub_inc set_of_mul_inc set_of_neg_inc set_of_pow_inc)
 
 section \<open>Splitting polynomials to reduce floating point precision\<close>
 
 text \<open>TODO: Move this!
   Definitions regarding floating point numbers should not be in a theory about polynomials.\<close>
 fun float_prec :: "float \<Rightarrow> int"
   where "float_prec f = (let p=exponent f in if p \<ge> 0 then 0 else -p)"
 
 fun float_round :: "nat \<Rightarrow> float \<Rightarrow> float"
   where "float_round prec f = (
          let d = float_down prec f; u = float_up prec f
          in if f - d < u - f then d else u)"
 
 
 text \<open>Splits any polynomial \<open>p\<close> into two polynomials \<open>l\<close>, \<open>r\<close>, such that \<open>\<forall>x::real. p(x) = l(x) + r(x)\<close>
    and all floating point coefficients in \<open>p\<close> are rounded to precision \<open>prec\<close>.
    Not all cases need to give good results. Polynomials normalized with polynate
    only contain \<open>poly.C\<close> and \<open>poly.CN\<close> constructors.\<close>
 fun split_by_prec :: "nat \<Rightarrow> float poly \<Rightarrow> float poly * float poly"
   where "split_by_prec prec (poly.C f) = (let r = float_round prec f in (poly.C r, poly.C (f - r)))"
   | "split_by_prec prec (poly.Bound n) = (poly.Bound n, poly.C 0)"
   | "split_by_prec prec (poly.Add l r) = (let (ll, lr) = split_by_prec prec l;
                                                 (rl, rr) = split_by_prec prec r
                                             in (poly.Add ll rl, poly.Add lr rr))"
   | "split_by_prec prec (poly.Sub l r) = (let (ll, lr) = split_by_prec prec l;
                                              (rl, rr) = split_by_prec prec r
                                          in (poly.Sub ll rl, poly.Sub lr rr))"
   | "split_by_prec prec (poly.Mul l r) = (let (ll, lr) = split_by_prec prec l;
                                                 (rl, rr) = split_by_prec prec r
                                             in (poly.Mul ll rl, poly.Add (poly.Add (poly.Mul lr rl) (poly.Mul ll rr)) (poly.Mul lr rr)))"
   | "split_by_prec prec (poly.Neg p) = (let (l, r) = split_by_prec prec p in (poly.Neg l, poly.Neg r))"
   | "split_by_prec prec (poly.Pw p 0) = (poly.C 1, poly.C 0)"
   | "split_by_prec prec (poly.Pw p (Suc n)) = (let (l, r) = split_by_prec prec p in (poly.Pw l n, poly.Sub (poly.Pw p (Suc n)) (poly.Pw l n)))"
   | "split_by_prec prec (poly.CN c n p) = (let (cl, cr) = split_by_prec prec c;
                                                  (pl, pr) = split_by_prec prec p
                                              in (poly.CN cl n pl, poly.CN cr n pr))"
 
 text \<open>TODO: Prove precision constraint on \<open>l\<close>.\<close>
 lemma split_by_prec_correct:
   fixes args :: "real list"
   assumes "(l, r) = split_by_prec prec p"
   shows "Ipoly args p = Ipoly args l + Ipoly args r" (is ?P1)
     and   "num_params l \<le> num_params p" (is ?P2)
     and   "num_params r \<le> num_params p" (is ?P3)
   unfolding atomize_conj
   using assms
 proof(induction p arbitrary: l r)
   case (Add p1 p2 l r)
   thus ?case
     apply(simp add: Add(1,2)[OF prod.collapse] split_beta)
     using max.coboundedI1 max.coboundedI2 prod.collapse
     by metis
 next
   case (Sub p1 p2 l r)
   thus ?case
     apply(simp add: Sub(1,2)[OF prod.collapse] split_beta)
     using max.coboundedI1 max.coboundedI2 prod.collapse
     by metis
 next
   case (Mul p1 p2 l r)
   thus ?case
     apply(simp add: Mul(1,2)[OF prod.collapse] split_beta algebra_simps)
     using max.coboundedI1 max.coboundedI2 prod.collapse
     by metis
 next
   case (Neg p l r) 
   thus ?case by (simp add: Neg(1)[OF prod.collapse] split_beta)
 next
   case (Pw p n l r)
   thus ?case by (cases n) (simp_all add: Pw(1)[OF prod.collapse] split_beta)
 next
   case (CN c n p2)
   thus ?case
     apply(simp add: CN(1,2)[OF prod.collapse] split_beta algebra_simps) 
     by (meson le_max_iff_disj prod.collapse)
 qed (simp_all add: Let_def)
 
 section \<open>Splitting polynomials by degree\<close>
 
 fun maxdegree :: "('a::zero) poly \<Rightarrow> nat"
   where "maxdegree (poly.C c) = 0"
   | "maxdegree (poly.Bound n) = 1"
   | "maxdegree (poly.Add l r) = max (maxdegree l) (maxdegree r)"
   | "maxdegree (poly.Sub l r) = max (maxdegree l) (maxdegree r)"
   | "maxdegree (poly.Mul l r) = maxdegree l + maxdegree r"
   | "maxdegree (poly.Neg p) = maxdegree p"
   | "maxdegree (poly.Pw p n) = n * maxdegree p"
   | "maxdegree (poly.CN c n p) = max (maxdegree c) (1 + maxdegree p)"
 
 fun split_by_degree :: "nat \<Rightarrow> 'a::zero poly \<Rightarrow> 'a poly * 'a poly"
   where "split_by_degree n (poly.C c) = (poly.C c, poly.C 0)"
   | "split_by_degree 0 p = (poly.C 0, p)"
   | "split_by_degree (Suc n) (poly.CN c v p) = (
          let (cl, cr) = split_by_degree (Suc n) c;
              (pl, pr) = split_by_degree n p
          in (poly.CN cl v pl, poly.CN cr v pr))"
     \<comment> \<open>This function is only intended for use on polynomials in normal form.
        Hence most cases never get executed.\<close>
   | "split_by_degree n p = (poly.C 0, p)"
 
 lemma split_by_degree_correct:
   fixes x :: "real list" and p :: "float poly"
   assumes "(l, r) = split_by_degree ord p"
   shows "maxdegree l \<le> ord" (is ?P1)
     and   "Ipoly x p = Ipoly x l + Ipoly x r" (is ?P2)
     and   "num_params l \<le> num_params p" (is ?P3)
     and   "num_params r \<le> num_params p" (is ?P4)
   unfolding atomize_conj
   using assms
 proof(induction p arbitrary: l r ord)
   case (C c l r ord)
   thus ?case by simp
 next
   case (Bound v l r ord)
   thus ?case by (cases ord) simp_all
 next
   case (Add p1 p2 l r ord)
   thus ?case by (cases ord) simp_all
 next
   case (Sub p1 p2 l r ord)
   thus ?case by (cases ord) simp_all
 next
   case (Mul p1 p2 l r ord)
   thus ?case by (cases ord) simp_all
 next
   case (Neg p l r ord)
   thus ?case by (cases ord) simp_all
 next
   case (Pw p k l r ord)
   thus ?case by (cases ord) simp_all
 next
   case (CN c v p l r ord)
   then show ?case
   proof(cases ord)
     case (Suc m)
     obtain cl cr where cl_cr_def: "(cl, cr) = split_by_degree (Suc m) c"
       by (cases "split_by_degree (Suc m) c", simp)
     obtain pl pr where pl_pr_def: "(pl, pr) = split_by_degree m p"
       by (cases "split_by_degree m p", simp)
     have [simp]: "Ipoly x p = Ipoly x pl + Ipoly x pr"
       using CN(2)[OF pl_pr_def]
       by (cases ord) simp_all
     from CN(3)
     have l_decomp: "l = CN cl v pl" and r_decomp: "r = CN cr v pr"
       by (simp_all add: Suc cl_cr_def[symmetric] pl_pr_def[symmetric])
     show ?thesis
       using CN(1)[OF cl_cr_def]  CN(2)[OF pl_pr_def]
       unfolding l_decomp
       by (cases p) (auto simp add: l_decomp r_decomp algebra_simps Suc)
   qed simp
 qed
 
 text \<open>Operations on lists.\<close>
 
 lemma length_map2[simp]: "length (map2 f a b) = min (length a) (length b)"
 proof(induction "map2 f a b" arbitrary: a b)
   case (Nil a b)
   hence "a = [] | b = []"
     by(cases a, simp, cases b, simp_all)
   then show ?case
     by auto
 next
   case (Cons x c a b)
   have "0 < length a \<and> 0 < length b"
     using Cons(2)
     by (cases a, simp, cases b, simp_all)
   then obtain xa ar xb br
     where a_decomp[simp]: "a = xa # ar"
       and   b_decomp[simp]: "b = xb # br"
     by (cases a, simp_all, cases b, simp_all)
   show ?case
     using Cons
     by simp
 qed
 
 lemma map2_nth[simp]:
   assumes "n < length a"
   assumes "n < length b"
   shows "(map2 f a b)!n = f (a!n) (b!n)"
   using assms
 proof(induction n arbitrary: a b)
   case (0 a b)
   have "0 < length a" and "0 < length b"
     using 0
     by simp_all
   thus ?case
     using 0
     by simp
 next
   case (Suc n a b)
   from Suc.prems have  "0 < length a" "0 < length b" "n < length (tl a)" "n < length (tl b)"
     using Suc.prems by auto
   have "map2 f a b = map2 f (hd a # tl a) (hd b # tl b)"
     using \<open>0 < length a\<close> \<open>0 < length b\<close>
     by simp
   also have "\<dots> ! Suc n = map2 f (tl a) (tl b) ! n"
     by simp
   also have "\<dots> = f (tl a ! n) (tl b ! n)"
     using \<open>n < length (tl a)\<close> \<open>n < length (tl b)\<close> by (rule Suc.IH)
   also have "tl a ! n = (hd a # tl a) ! Suc n" by simp
   also have "(hd a # tl a) = a" using \<open>0 < length a\<close> by simp
   also have "tl b ! n = (hd b # tl b) ! Suc n" by simp
   also have "(hd b # tl b) = b" using \<open>0 < length b\<close> by simp
   finally show ?case .
 qed
 
 text \<open>Translating a polynomial by a vector.\<close>
 fun poly_translate :: "'a list \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "poly_translate vs (poly.C c)  = poly.C c"
   | "poly_translate vs (poly.Bound n) = poly.Add (poly.Bound n) (poly.C (vs ! n))"
   | "poly_translate vs (poly.Add l r) = poly.Add (poly_translate vs l) (poly_translate vs r)"
   | "poly_translate vs (poly.Sub l r) = poly.Sub (poly_translate vs l) (poly_translate vs r)"
   | "poly_translate vs (poly.Mul l r) = poly.Mul (poly_translate vs l) (poly_translate vs r)"
   | "poly_translate vs (poly.Neg p) = poly.Neg (poly_translate vs p)"
   | "poly_translate vs (poly.Pw p n) = poly.Pw (poly_translate vs p) n"
   | "poly_translate vs (poly.CN c n p) = poly.Add (poly_translate vs c) (poly.Mul (poly.Add (poly.Bound n) (poly.C (vs ! n))) (poly_translate vs p))"
 
 text \<open>Translating a polynomial is equivalent to translating its argument.\<close>
 lemma poly_translate_correct:
   assumes "num_params p \<le> length x"
   assumes "length x = length v"
   shows "Ipoly x (poly_translate v p) = Ipoly (map2 (+) x v) p"
   using assms
   by (induction p, simp_all)
 
 lemma real_poly_translate: 
   assumes "num_params p \<le> length v"
   shows "Ipoly x (map_poly real_of_float (poly_translate v p)) = Ipoly x (poly_translate v (map_poly real_of_float p))"
   using assms
   by (induction p, simp_all)
 
 lemma num_params_poly_translate[simp]:
   shows "num_params (poly_translate v p) = num_params p"
   by (induction p, simp_all)
 
 end
diff --git a/thys/Taylor_Models/Taylor_Models.thy b/thys/Taylor_Models/Taylor_Models.thy
--- a/thys/Taylor_Models/Taylor_Models.thy
+++ b/thys/Taylor_Models/Taylor_Models.thy
@@ -1,2092 +1,2086 @@
 theory Taylor_Models
-  imports "Interval_Approximation"
+  imports
     "Horner_Eval"
     "Polynomial_Expression_Additional"
     "Taylor_Models_Misc"
     "HOL-Decision_Procs.Approximation"
     "HOL-Library.Function_Algebras"
     "HOL-Library.Set_Algebras"
     "Affine_Arithmetic.Straight_Line_Program"
     "Affine_Arithmetic.Affine_Approximation"
 begin
 
 text \<open>TODO: get rid of float poly/float inteval and use real poly/real interval
   and data refinement?\<close>
 
 section \<open>Multivariate Taylor Models\<close>
 
 subsection \<open>Computing interval bounds on arithmetic expressions\<close>
 
 text \<open>This is a wrapper around the "approx" function.
   It computes range bounds on floatarith expressions.\<close>
 fun compute_bound_fa :: "nat \<Rightarrow> floatarith \<Rightarrow> float interval list \<Rightarrow> float interval option"
-  where "compute_bound_fa prec f I =
-  (case approx prec f (map (Some o (\<lambda>x. (lower x, upper x))) I) of
-    Some (a, b) \<Rightarrow> (if a \<le> b then Some (Ivl a b) else None)
-  | _ \<Rightarrow> None)"
+  where "compute_bound_fa prec f I = approx prec f (map Some I)"
 
 lemma compute_bound_fa_correct:
   "interpret_floatarith f i \<in>\<^sub>r ivl"
   if "compute_bound_fa prec f I = Some ivl"
     "i all_in I"
   for i::"real list"
 proof-
-  have bounded: "bounded_by i (map (Some \<circ> (\<lambda>x. (lower x, upper x))) I)"
+  have bounded: "bounded_by i (map Some I)"
     using that(2)
     unfolding bounded_by_def
     by (auto simp: bounds_of_interval_eq_lower_upper set_of_eq)
-  from that have Some: "approx prec f (map (Some \<circ> (\<lambda>x. (lower x, upper x))) I) = Some (lower ivl, upper ivl)"
+  from that have Some: "approx prec f (map Some I) = Some ivl"
     by (auto simp: lower_Interval upper_Interval min_def split: option.splits if_splits)
-  from approx[OF bounded Some[symmetric]]
+  from approx[OF bounded Some]
   show ?thesis by (auto simp: set_of_eq)
 qed
 
 
 subsection \<open>Definition of Taylor models and notion of rangeity\<close>
 
 text \<open>Taylor models are a pair of a polynomial and an absolute error bound.\<close>
 datatype taylor_model = TaylorModel (tm_poly: "float poly") (tm_bound: "float interval")
 
 text \<open>Taylor model for a real valuation of variables\<close>
 
 primrec insertion :: "(nat \<Rightarrow> 'a) \<Rightarrow> 'a poly \<Rightarrow> 'a::{plus,zero,minus,uminus,times,one,power}"
 where
   "insertion bs (C c) = c"
 | "insertion bs (poly.Bound n) = bs n"
 | "insertion bs (Neg a) = - insertion bs a"
 | "insertion bs (poly.Add a b) = insertion bs a + insertion bs b"
 | "insertion bs (Sub a b) = insertion bs a - insertion bs b"
 | "insertion bs (Mul a b) = insertion bs a * insertion bs b"
 | "insertion bs (Pw t n) = insertion bs t ^ n"
 | "insertion bs (CN c n p) = insertion bs c + (bs n) * insertion bs p"
 
 definition range_tm :: "(nat \<Rightarrow> real) \<Rightarrow> taylor_model \<Rightarrow> real interval" where
 "range_tm e tm = interval_of (insertion e (tm_poly tm)) + real_interval (tm_bound tm)"
 
 lemma Ipoly_num_params_cong: "Ipoly xs p = Ipoly ys p"
   if "\<And>i. i < num_params p \<Longrightarrow> xs ! i = ys ! i"
   using that
   by (induction p; auto)
 
 lemma insertion_num_params_cong: "insertion e p = insertion f p"
   if "\<And>i. i < num_params p \<Longrightarrow> e i = f i"
   using that
   by (induction p; auto)
 
 lemma insertion_eq_IpolyI: "insertion xs p = Ipoly ys p"
   if "\<And>i. i < num_params p \<Longrightarrow> xs i = ys ! i"
   using that
   by (induction p; auto)
 
 lemma Ipoly_eq_insertionI: "Ipoly ys p = insertion xs p"
   if "\<And>i. i < num_params p \<Longrightarrow> xs i = ys ! i"
   using that
   by (induction p; auto)
 
 lemma range_tmI:
   "x \<in>\<^sub>i range_tm e tm"
   if x: "x \<in>\<^sub>i interval_of (insertion e ((tm_poly tm))) + real_interval (tm_bound tm)"
   for e::"nat\<Rightarrow>real"
   by (auto simp: range_tm_def x)
 
 lemma range_tmD:
   "x \<in>\<^sub>i interval_of (insertion e (tm_poly tm)) + real_interval (tm_bound tm)"
   if "x \<in>\<^sub>i range_tm e tm"
   for e::"nat\<Rightarrow>real"
   using that
   by (auto simp: range_tm_def)
 
 
 subsection \<open>Interval bounds for Taylor models\<close>
 
 text \<open>Bound a polynomial by simply approximating it with interval arguments.\<close>
 fun compute_bound_poly :: "nat \<Rightarrow> float interval poly \<Rightarrow> (float interval list) \<Rightarrow> (float interval list) \<Rightarrow> float interval" where
   "compute_bound_poly prec (poly.C f) I a = f"
 | "compute_bound_poly prec (poly.Bound n) I a = round_interval prec (I ! n - (a ! n))"
 | "compute_bound_poly prec (poly.Add p q) I a =
     round_interval prec (compute_bound_poly prec p I a + compute_bound_poly prec q I a)"
 | "compute_bound_poly prec (poly.Sub p q) I a =
     round_interval prec (compute_bound_poly prec p I a - compute_bound_poly prec q I a)"
 | "compute_bound_poly prec (poly.Mul p q) I a =
     mult_float_interval prec (compute_bound_poly prec p I a) (compute_bound_poly prec q I a)"
 | "compute_bound_poly prec (poly.Neg p) I a = -compute_bound_poly prec p I a"
 | "compute_bound_poly prec (poly.Pw p n) I a = power_float_interval prec n (compute_bound_poly prec p I a)"
 | "compute_bound_poly prec (poly.CN p n q) I a =
     round_interval prec (compute_bound_poly prec p I a +
       mult_float_interval prec (round_interval prec (I ! n - (a ! n))) (compute_bound_poly prec q I a))"
 
 text \<open>Bounds on Taylor models are simply a bound on its polynomial, widened by the approximation error.\<close>
 fun compute_bound_tm :: "nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> taylor_model \<Rightarrow> float interval"
   where "compute_bound_tm prec I a (TaylorModel p e) = compute_bound_poly prec p I a + e"
 
 lemma compute_bound_tm_def:
   "compute_bound_tm prec I a tm = compute_bound_poly prec (tm_poly tm) I a + (tm_bound tm)"
   by (cases tm) auto
 
 lemma real_of_float_in_real_interval_of[intro, simp]: "real_of_float x \<in>\<^sub>r X" if "x \<in>\<^sub>i X"
   using that
   by (auto simp: set_of_eq)
 
 lemma in_set_of_round_interval[intro, simp]:
   "x \<in>\<^sub>r round_interval prec X" if "x \<in>\<^sub>r X"
   using round_ivl_correct[of X prec] that
   by (auto simp: set_of_eq)
 
 lemma in_set_real_minus_interval[intro, simp]:
   "x - y \<in>\<^sub>r X - Y" if "x \<in>\<^sub>r X" "y \<in>\<^sub>r Y"
   using that
   by (auto simp: set_of_eq)
 
 lemma real_interval_plus: "real_interval (a + b) = real_interval a + real_interval b"
-  by transfer auto
+  by (simp add: interval_eqI)
 
 lemma real_interval_uminus: "real_interval (- b) = - real_interval b"
-  by transfer auto
+  by (simp add: interval_eqI)
 
 lemma real_interval_of: "real_interval (interval_of b) = interval_of b"
-  by transfer auto
+  by (simp add: interval_eqI)
 
 lemma real_interval_minus: "real_interval (a - b) = real_interval a - real_interval b"
   using real_interval_plus[of a "-b"] real_interval_uminus[of b]
   by (auto simp: interval_eq_iff)
 
 lemma in_set_real_plus_interval[intro, simp]:
   "x + y \<in>\<^sub>r X + Y" if "x \<in>\<^sub>r X" "y \<in>\<^sub>r Y"
   using that
   by (auto simp: set_of_eq)
 
 lemma in_set_neg_plus_interval[intro, simp]:
   "- y \<in>\<^sub>r - Y" if "y \<in>\<^sub>r Y"
   using that
   by (auto simp: set_of_eq)
 
-lemma real_interval_times: "real_interval (a * b) = real_interval a * real_interval b"
-  by transfer (auto simp: Let_def min_def max_def)
-
 lemma in_set_real_times_interval[intro, simp]:
   "x * y \<in>\<^sub>r X * Y" if "x \<in>\<^sub>r X" "y \<in>\<^sub>r Y"
   using that
   by (auto simp: real_interval_times intro!: times_in_intervalI)
 
 lemma real_interval_one: "real_interval 1 = 1"
-  by transfer simp
+  by (simp add: interval_eqI)
 
 lemma real_interval_zero: "real_interval 0 = 0"
-  by transfer simp
+  by (simp add: interval_eqI)
 
 lemma real_interval_power: "real_interval (a ^ b) = real_interval a ^ b"
   by (induction b arbitrary: a)
     (auto simp: real_interval_times real_interval_one)
 
 lemma in_set_real_power_interval[intro, simp]:
   "x ^ n \<in>\<^sub>r X ^ n" if "x \<in>\<^sub>r X"
   using that
   by (auto simp: real_interval_power intro!: set_of_power_mono)
 
 lemma power_float_interval_real_interval[intro, simp]:
   "x ^ n \<in>\<^sub>r power_float_interval prec n X" if "x \<in>\<^sub>r X"
   by (auto simp: real_interval_power that intro!: power_float_intervalI)
 
 lemma in_set_mult_float_interval[intro, simp]:
   "x * y \<in>\<^sub>r mult_float_interval prec X Y" if "x \<in>\<^sub>r X" "y \<in>\<^sub>r Y"
   using mult_float_interval[of X Y] in_set_real_times_interval[OF that] that(1) that(2)
   by blast
 
 lemma in_set_real_minus_swapI: "e i \<in>\<^sub>r I ! i - a ! i"
   if "x - e i \<in>\<^sub>r a ! i" "x \<in>\<^sub>r I ! i"
   using that
   by (auto simp: set_of_eq)
 
 definition develops_at_within::"(nat \<Rightarrow> real) \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> bool"
   where "develops_at_within e a I \<longleftrightarrow> (a all_subset I) \<and> (\<forall>i < length I. e i \<in>\<^sub>r I ! i - a ! i)"
 
 lemma develops_at_withinI:
   assumes all_in: "a all_subset I"
   assumes e: "\<And>i. i < length I \<Longrightarrow> e i \<in>\<^sub>r I ! i - a ! i"
   shows "develops_at_within e a I"
   using assms by (auto simp: develops_at_within_def)
 
 lemma develops_at_withinD:
   assumes "develops_at_within e a I"
   shows "a all_subset I"
     "\<And>i. i < length I \<Longrightarrow> e i \<in>\<^sub>r I ! i - a ! i"
   using assms by (auto simp: develops_at_within_def)
 
 lemma compute_bound_poly_correct:
   fixes p::"float poly"
   assumes "num_params p \<le> length I"
   assumes dev: "develops_at_within e a I"
   shows "insertion e (p::real poly) \<in>\<^sub>r compute_bound_poly prec (map_poly interval_of p) I a"
   using assms(1)
 proof (induction p)
   case (C x)
   then show ?case by auto
 next
   case (Bound i)
   then show ?case
     using dev
     by (auto simp: develops_at_within_def)
 next
   case (Add p1 p2)
   then show ?case by force
 next
   case (Sub p1 p2)
   then show ?case by force
 next
   case (Mul p1 p2)
   then show ?case by force
 next
   case (Neg p)
   then show ?case by force
 next
   case (Pw p x2a)
   then show ?case by force
 next
   case (CN p1 i p2)
   then show ?case
     using dev
     by (auto simp: develops_at_within_def)
 qed
 
 lemma compute_bound_tm_correct:
   fixes I :: "float interval list" and f :: "real list \<Rightarrow> real"
   assumes n: "num_params (tm_poly t) \<le> length I"
   assumes dev: "develops_at_within e a I"
   assumes x0: "x0 \<in>\<^sub>i range_tm e t"
   shows "x0 \<in>\<^sub>r compute_bound_tm prec I a t"
 proof -
   let ?I = "insertion e (tm_poly t)"
   have "x0 = ?I + (x0 - ?I)" by simp
   also have "\<dots> \<in>\<^sub>r compute_bound_tm prec I a t"
     unfolding compute_bound_tm_def
     apply (rule in_set_real_plus_interval)
      apply (rule compute_bound_poly_correct)
         apply (rule assms)
        apply (rule dev)
     using range_tmD[OF x0]
     by (auto simp: set_of_eq)
   finally show "x0 \<in>\<^sub>r compute_bound_tm prec I a t" .
 qed
 
 lemma compute_bound_tm_correct_subset:
   fixes I :: "float interval list" and f :: "real list \<Rightarrow> real"
   assumes n: "num_params (tm_poly t) \<le> length I"
   assumes dev: "develops_at_within e a I"
   shows "set_of (range_tm e t) \<subseteq> set_of (real_interval (compute_bound_tm prec I a t))"
   using assms
   by (auto intro!: compute_bound_tm_correct)
 
 lemma compute_bound_poly_mono:
   assumes "num_params p \<le> length I"
   assumes mem: "I all_subset J" "a all_subset I"
   shows "set_of (compute_bound_poly prec p I a) \<subseteq> set_of (compute_bound_poly prec p J a)"
   using assms(1)
 proof (induction p arbitrary: a)
   case (C x)
   then show ?case by auto
 next
   case (Bound x)
   then show ?case using mem
     by (simp add: round_interval_mono set_of_sub_inc)
 next
   case (Add p1 p2)
   then show ?case using mem
     by (simp add: round_interval_mono set_of_add_inc)
 next
   case (Sub p1 p2)
   then show ?case using mem
     by (simp add: round_interval_mono set_of_sub_inc)
 next
   case (Mul p1 p2)
   then show ?case using mem
     by (simp add: round_interval_mono mult_float_interval_mono)
 next
   case (Neg p)
   then show ?case using mem
     by (simp add: round_interval_mono set_of_neg_inc)
 next
   case (Pw p x2a)
   then show ?case using mem
     by (simp add: power_float_interval_mono)
 next
   case (CN p1 x2a p2)
   then show ?case using mem
     by (simp add: round_interval_mono mult_float_interval_mono
         set_of_add_inc set_of_sub_inc)
 qed
 
 lemma compute_bound_tm_mono:
   fixes I :: "float interval list" and f :: "real list \<Rightarrow> real"
   assumes "num_params (tm_poly t) \<le> length I"
   assumes "I all_subset J"
   assumes "a all_subset I"
   shows "set_of (compute_bound_tm prec I a t) \<subseteq> set_of (compute_bound_tm prec J a t)"
   apply (simp add: compute_bound_tm_def)
   apply (rule set_of_add_inc_left)
   apply (rule compute_bound_poly_mono)
   using assms
   by (auto simp: set_of_eq)
 
 
 subsection \<open>Computing taylor models for basic, univariate functions\<close>
 
 definition tm_const :: "float \<Rightarrow> taylor_model"
   where "tm_const c = TaylorModel (poly.C c) 0"
 
 context includes floatarith_notation begin
 
 definition tm_pi :: "nat \<Rightarrow> taylor_model"
   where "tm_pi prec = (
   let pi_ivl = the (compute_bound_fa prec Pi [])
   in TaylorModel (poly.C (mid pi_ivl)) (centered pi_ivl)
 )"
 
 lemma zero_real_interval[intro,simp]: "0 \<in>\<^sub>r 0"
   by (auto simp: set_of_eq)
 
 lemma range_TM_tm_const[simp]: "range_tm e (tm_const c) = interval_of c"
   by (auto simp: range_tm_def real_interval_zero tm_const_def)
 
 lemma num_params_tm_const[simp]: "num_params (tm_poly (tm_const c)) = 0"
   by (auto simp: tm_const_def)
 
 lemma num_params_tm_pi[simp]: "num_params (tm_poly (tm_pi prec)) = 0"
   by (auto simp: tm_pi_def Let_def)
 
 lemma range_tm_tm_pi: "pi \<in>\<^sub>i range_tm e (tm_pi prec)"
 proof-
   have "\<And>prec. real_of_float (lb_pi prec) \<le> real_of_float (ub_pi prec)"
     using iffD1[OF atLeastAtMost_iff, OF pi_boundaries]
     using order_trans by auto
   then obtain ivl_pi where ivl_pi_def: "compute_bound_fa prec Pi [] = Some ivl_pi"
     by (simp add: approx.simps)
   show ?thesis
     unfolding range_tm_def Let_def
     using compute_bound_fa_correct[OF ivl_pi_def, of "[]"]
     by (auto simp: set_of_eq Let_def centered_def ivl_pi_def tm_pi_def
         simp del: compute_bound_fa.simps)
 qed
 
 
 subsubsection \<open>Derivations of floatarith expressions\<close>
 
 text \<open>Compute the nth derivative of a floatarith expression\<close>
 fun deriv :: "nat \<Rightarrow> floatarith \<Rightarrow> nat \<Rightarrow> floatarith"
   where "deriv v f 0 = f"
   | "deriv v f (Suc n) = DERIV_floatarith v (deriv v f n)"
 
 lemma isDERIV_DERIV_floatarith:
   assumes "isDERIV v f vs"
   shows "isDERIV v (DERIV_floatarith v f) vs"
   using assms
 proof(induction f)
   case (Power f m)
   then show ?case
     by (cases m) (auto simp: isDERIV_Power)
 qed (simp_all add: numeral_eq_Suc add_nonneg_eq_0_iff )
 
 lemma isDERIV_is_analytic:
   "isDERIV i (Taylor_Models.deriv i f n) xs"
   if "isDERIV i f xs"
   using isDERIV_DERIV_floatarith that
   by(induction n) auto
 
 lemma deriv_correct:
   assumes "isDERIV i f (xs[i:=t])" "i < length xs"
   shows "((\<lambda>x. interpret_floatarith (deriv i f n) (xs[i:=x])) has_real_derivative interpret_floatarith (deriv i f (Suc n)) (xs[i:=t]))
     (at t within S)"
   apply(simp)
   apply (rule has_field_derivative_at_within)
   apply(rule DERIV_floatarith)
    apply fact
   apply (rule isDERIV_is_analytic)
   apply fact
   done
 
 text \<open>Faster derivation for univariate functions, producing smaller terms and thus less over-approximation.\<close>
 text \<open>TODO: Extend to Arctan, Log!\<close>
 fun deriv_rec :: "floatarith \<Rightarrow> nat \<Rightarrow> floatarith"
   where "deriv_rec (Exp (Var 0)) _ = Exp (Var 0)"
   | "deriv_rec (Cos (Var 0)) n = (case n mod 4
          of 0 \<Rightarrow> Cos (Var 0)
          | Suc 0 \<Rightarrow> Minus (Sin (Var 0))
          | Suc (Suc 0) \<Rightarrow> Minus (Cos (Var 0))
          | Suc (Suc (Suc 0)) \<Rightarrow> Sin (Var 0))"
   | "deriv_rec (Inverse (Var 0)) n = (if n = 0 then Inverse (Var 0) else Mult (Num (fact n * (if n mod 2 = 0 then 1 else -1))) (Inverse (Power (Var 0) (Suc n))))"
   | "deriv_rec f n = deriv 0 f n"
 
 lemma deriv_rec_correct:
   assumes "isDERIV 0 f (xs[0:=t])" "0 < length xs"
   shows "((\<lambda>x. interpret_floatarith (deriv_rec f n) (xs[0:=x])) has_real_derivative interpret_floatarith (deriv_rec f (Suc n)) (xs[0:=t])) (at t within S)"
   apply(cases "(f, n)" rule: deriv_rec.cases)
                       apply(safe)
   using assms deriv_correct[OF assms]
 proof-
   assume "f = Cos (Var 0)"
 
   have n_mod_4_cases: "n mod 4 = 0 | n mod 4 = 1 | n mod 4 = 2 | n mod 4 = 3"
     by auto
   have Sin_sin: "(\<lambda>xs. interpret_floatarith (Sin (Var 0)) xs) = (\<lambda>xs. sin (xs!0))"
     by (simp add: )
   show "((\<lambda>x. interpret_floatarith (deriv_rec (Cos (Var 0)) n) (xs[0:=x])) has_real_derivative
          interpret_floatarith (deriv_rec (Cos (Var 0)) (Suc n)) (xs[0:=t]))
          (at t within S)"
     using n_mod_4_cases assms
     by (auto simp add: mod_Suc Sin_sin field_differentiable_minus
         intro!: derivative_eq_intros)
 next
   assume f_def: "f = Inverse (Var 0)" and "isDERIV 0 f (xs[0:=t])"
   hence "t \<noteq> 0" using assms
     by simp
   {
     fix n::nat and x::real
     assume "x \<noteq> 0"
     moreover have "(n mod 2 = 0 \<and> Suc n mod 2 = 1) \<or> (n mod 2 = 1 \<and> Suc n mod 2 = 0)"
       by (cases n rule: parity_cases) auto
     ultimately have "interpret_floatarith (deriv_rec f n) (xs[0:=x]) = fact n * (-1::real)^n / (x^Suc n)"
       using assms by (auto simp add: f_def field_simps fact_real_float_equiv)
   }
   note closed_formula = this
 
   have "((\<lambda>x. inverse (x ^ Suc n)) has_real_derivative -real (Suc n) * inverse (t ^ Suc (Suc n))) (at t)"
     using DERIV_inverse_fun[OF DERIV_pow[where n="Suc n"], where s=UNIV]
     apply(rule iffD1[OF DERIV_cong_ev[OF refl], rotated 2])
     using \<open>t \<noteq> 0\<close>
     by (simp_all add: divide_simps)
   hence "((\<lambda>x. fact n * (-1::real)^n * inverse (x ^ Suc n)) has_real_derivative fact (Suc n) * (- 1) ^ Suc n / t ^ Suc (Suc n)) (at t)"
     apply(rule iffD1[OF DERIV_cong_ev, OF refl _ _ DERIV_cmult[where c="fact n * (-1::real)^n"], rotated 2])
     using \<open>t \<noteq> 0\<close>
     by (simp_all add: field_simps distrib_left)
   then show "((\<lambda>x. interpret_floatarith (deriv_rec (Inverse (Var 0)) n) (xs[0:=x])) has_real_derivative
          interpret_floatarith (deriv_rec (Inverse (Var 0)) (Suc n)) (xs[0:=t]))
          (at t within S)"
     apply -
     apply (rule has_field_derivative_at_within)
     apply(rule iffD1[OF DERIV_cong_ev[OF refl _ closed_formula[OF \<open>t \<noteq> 0\<close>, symmetric]], unfolded f_def, rotated 1])
      apply simp
     using assms
     by (simp, safe, simp_all add: fact_real_float_equiv inverse_eq_divide even_iff_mod_2_eq_zero)
 qed (use assms in \<open>simp_all add: has_field_derivative_subset[OF DERIV_exp subset_UNIV]\<close>)
 
 lemma deriv_rec_0_idem[simp]:
   shows "deriv_rec f 0 = f"
   by (cases "(f, 0::nat)" rule: deriv_rec.cases, simp_all)
 
 
 subsubsection \<open>Computing Taylor models for arbitrary univariate expressions\<close> 
 
 fun tmf_c :: "nat \<Rightarrow> float interval list \<Rightarrow> floatarith \<Rightarrow> nat \<Rightarrow> float interval option"
   where "tmf_c prec I f i = compute_bound_fa prec (Mult (deriv_rec f i) (Inverse (Num (fact i)))) I"
     \<comment> \<open>The interval coefficients of the Taylor polynomial,
    i.e. the real coefficients approximated by a float interval.\<close>
 
 fun tmf_ivl_cs :: "nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float list \<Rightarrow> floatarith \<Rightarrow> float interval list option"
   where "tmf_ivl_cs prec ord I a f = those (map (tmf_c prec a f) [0..<ord] @ [tmf_c prec I f ord])"
     \<comment> \<open>Make a list of bounds on the n+1 coefficients, with the n+1-th coefficient bounding
    the remainder term of the Taylor-Lagrange formula.\<close>
 
 fun tmf_polys :: "float interval list \<Rightarrow> float poly \<times> float interval poly"
   where "tmf_polys [] = (poly.C 0, poly.C 0)"
   | "tmf_polys (c # cs) = (
          let (pf, pi) = tmf_polys cs
          in (poly.CN (poly.C (mid c)) 0 pf, poly.CN (poly.C (centered c)) 0 pi)
        )"
 
 fun tm_floatarith :: "nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float list \<Rightarrow> floatarith \<Rightarrow> taylor_model option"
   where "tm_floatarith prec ord I a f = (
   map_option (\<lambda>cs. 
     let (pf, pi) = tmf_polys cs;
         _ = compute_bound_tm prec (List.map2 (-) I a);
         e = round_interval prec (Ipoly (List.map2 (-) I a) pi) \<comment> \<open>TODO: use \<open>compute_bound_tm\<close> here?!\<close>
     in TaylorModel pf e
   ) (tmf_ivl_cs prec ord I a f)
 )" \<comment> \<open>Compute a Taylor model from an arbitrary, univariate floatarith expression, if possible.
    This is used to compute Taylor models for elemental functions like sin, cos, exp, etc.\<close>
 
 term compute_bound_poly
 lemma tmf_c_correct:
   fixes A::"float interval list" and I::"float interval" and f::floatarith and a::"real list"
   assumes "a all_in A"
   assumes "tmf_c prec A f i = Some I"
   shows "interpret_floatarith (deriv_rec f i) a / fact i \<in>\<^sub>r I"
   using compute_bound_fa_correct[OF assms(2)[unfolded tmf_c.simps], where i="a"] assms(1)
   by (simp add: divide_real_def fact_real_float_equiv)
 
 lemma tmf_ivl_cs_length:
   assumes "tmf_ivl_cs prec n A a f = Some cs"
   shows "length cs = n + 1"
   by (simp add: Some_those_length[OF assms[unfolded tmf_ivl_cs.simps]])
 
 lemma tmf_ivl_cs_correct:
   fixes A::"float interval list" and f::floatarith
   assumes "a all_in I"
   assumes "tmf_ivl_cs prec ord I a f = Some cs"
   shows "\<And>i. i < ord \<Longrightarrow> tmf_c prec (map interval_of a) f i = Some (cs!i)"
     and "tmf_c prec I f ord = Some (cs!ord)"
     and "length cs = Suc ord"
 proof-
   from tmf_ivl_cs_length[OF assms(2)]
   show "tmf_c prec I f ord = Some (cs!ord)"
     by (metis Some_those_nth assms(2) diff_zero length_map length_upt less_add_one
         nth_append_length tmf_ivl_cs.simps)
 next
   fix i assume "i < ord"
   have "Some (cs!i) = (map (tmf_c prec a f) [0..<ord] @ [tmf_c prec I f ord]) ! i"
     apply(rule Some_those_nth)
     using assms(2) tmf_ivl_cs_length \<open>i < ord\<close>
     by simp_all
   then show "tmf_c prec a f i = Some (cs!i)" 
     using \<open>i < ord\<close>
     by (simp add: nth_append)
 next
   show "length cs = Suc ord"
     using assms
     by (auto simp: split_beta' those_eq_Some_iff list_eq_iff_nth_eq)
 qed 
 
 lemma Ipoly_fst_tmf_polys:
   "Ipoly xs (fst (tmf_polys z)) = (\<Sum>i<length z. xs ! 0 ^ i * (mid (z ! i)))"
   for xs::"real list"
 proof (induction z)
   case (Cons z zs)
   show ?case
     unfolding list.size add_Suc_right sum.lessThan_Suc_shift
     by (auto simp: split_beta' Let_def nth_Cons Cons sum_distrib_left ac_simps)
 qed simp
 
 lemma insertion_fst_tmf_polys:
   "insertion e (fst (tmf_polys z)) = (\<Sum>i<length z. e 0 ^ i * (mid (z ! i)))"
   for e::"nat \<Rightarrow> real"
 proof (induction z)
   case (Cons z zs)
   show ?case
     unfolding list.size add_Suc_right sum.lessThan_Suc_shift
     by (auto simp: split_beta' Let_def nth_Cons Cons sum_distrib_left ac_simps)
 qed simp
 
 lemma Ipoly_snd_tmf_polys:
   "set_of (horner_eval (real_interval o centered o nth z) x (length z)) \<subseteq> set_of (Ipoly [x] (map_poly real_interval (snd (tmf_polys z))))"
 proof (induction z)
   case (Cons z zs)
   show ?case
     using Cons[THEN set_of_mul_inc_right]
     unfolding list.size add_Suc_right sum.lessThan_Suc_shift
     by (auto simp: split_beta' Let_def nth_Cons sum_distrib_left ac_simps
         elim!: plus_in_intervalE intro!: plus_in_intervalI)
 qed (auto simp: real_interval_zero)
 
 lemma zero_interval[intro,simp]: "0 \<in>\<^sub>i 0"
-  by transfer auto
+  by (simp add: set_of_eq)
 
 lemma sum_in_intervalI: "sum f X \<in>\<^sub>i sum g X" if "\<And>x. x \<in> X \<Longrightarrow> f x \<in>\<^sub>i g x"
   for f :: "_ \<Rightarrow> 'a :: ordered_comm_monoid_add"
   using that
 proof (induction X rule: infinite_finite_induct)
   case (insert x F)
   then show ?case
     by (auto intro!: plus_in_intervalI)
 qed simp_all
 
 lemma set_of_sum_subset: "set_of (sum f X) \<subseteq> set_of (sum g X)"
   if "\<And>x. x \<in> X \<Longrightarrow> set_of (f x) \<subseteq> set_of (g x)"
   for f :: "_\<Rightarrow>'a::linordered_ab_group_add interval"
   using that
   by (induction X rule: infinite_finite_induct) (simp_all add: set_of_add_inc)
 
 lemma interval_of_plus: "interval_of (a + b) = interval_of a + interval_of b"
-  by transfer auto
+  by (simp add: interval_eqI)
 
 lemma interval_of_uminus: "interval_of (- a) = - interval_of a"
-  by transfer auto
+  by (simp add: interval_eqI)
 
 lemma interval_of_zero: "interval_of 0 = 0"
-  by transfer auto
+  by (simp add: interval_eqI)
 
 lemma interval_of_sum: "interval_of (sum f X) = sum (\<lambda>x. interval_of (f x)) X"
   by (induction X rule: infinite_finite_induct) (auto simp: interval_of_plus interval_of_zero)
 
 lemma interval_of_prod: "interval_of (a * b) = interval_of a * interval_of b"
-  by transfer (simp add: Let_def)
+  by (simp add: lower_times upper_times interval_eqI)
 
 lemma in_set_of_interval_of[simp]: "x \<in>\<^sub>i (interval_of y) \<longleftrightarrow> x = y" for x y::"'a::order"
   by (auto simp: set_of_eq)
 
 lemma real_interval_Ipoly: "real_interval (Ipoly xs p) = Ipoly (map real_interval xs) (map_poly real_interval p)"
   if "num_params p \<le> length xs"
   using that
   by (induction p)
     (auto simp: real_interval_plus real_interval_minus real_interval_times
       real_interval_uminus real_interval_power)
 
 lemma num_params_tmf_polys1: "num_params (fst (tmf_polys z)) \<le> Suc 0"
   by (induction z) (auto simp: split_beta' Let_def)
 
 lemma num_params_tmf_polys2: "num_params (snd (tmf_polys z)) \<le> Suc 0"
   by (induction z) (auto simp: split_beta' Let_def)
 
 lemma set_of_real_interval_subset: "set_of (real_interval x) \<subseteq> set_of (real_interval y)"
   if "set_of x \<subseteq> set_of y"
   using that
-  by transfer auto
+  by (auto simp: set_of_eq)
 
 theorem tm_floatarith:
   assumes t: "tm_floatarith prec ord I xs f = Some t"
   assumes a: "xs all_in I" and x: "x \<in>\<^sub>r I ! 0"
   assumes xs_ne: "xs \<noteq> []"
   assumes deriv: "\<And>x. x \<in>\<^sub>r I ! 0 \<Longrightarrow> isDERIV 0 f (xs[0 := x])"
   assumes "\<And>i. 0 < i \<Longrightarrow> i < length xs \<Longrightarrow> e i = real_of_float (xs ! i)"
   assumes diff_e: "(x - real_of_float (xs ! 0)) = e 0"
   shows "interpret_floatarith f (xs[0:=x]) \<in>\<^sub>i range_tm e t"
 proof -
   from xs_ne a have I_ne[simp]: "I \<noteq> []" by auto
   have xs'_in: "xs[0 := x] all_in I"
     using a
     by (auto simp: nth_list_update x)
   from t obtain z where z: "tmf_ivl_cs prec ord I xs f = Some z"
     and tz: "tm_poly t = fst (tmf_polys z)"
     and tb: "tm_bound t = round_interval prec (Ipoly (List.map2 (-) I xs) (snd (tmf_polys z)))"
     using assms(1)
     by (cases t) (auto simp: those_eq_Some_iff split_beta' Let_def simp del: tmf_ivl_cs.simps)
   from tmf_ivl_cs_correct[OF a z(1)]
   have z_less: "i < ord \<Longrightarrow> tmf_c prec (map interval_of xs) f i = Some (z ! i)"
     and lz: "length z = Suc ord" "length z - 1 = ord"
     and z_ord: "tmf_c prec I f ord = Some (z ! ord)" for i
     by auto
   have rewr: "{..ord} = insert ord {..<ord}" by auto
   let ?diff = "\<lambda>(i::nat) (x::real). interpret_floatarith (deriv_rec f i) (xs[0:=x])"
   let ?c = "real_of_float (xs ! 0)"
   let ?n = "ord"
   let ?a = "real_of_float (lower (I!0))"
   let ?b = "real_of_float (upper (I!0))"
   let ?x = "x::real"
   let ?f = "\<lambda>x::real. interpret_floatarith f (xs[0 := x])"
   have 2: "?diff 0 = ?f" using \<open>xs \<noteq> []\<close>
     by (simp add: map_update)
   have 3: "\<forall>m t. m < ?n \<and> ?a \<le> t \<and> t \<le> ?b \<longrightarrow> (?diff m has_real_derivative ?diff (Suc m) t) (at t)"
     by (auto intro!: derivative_eq_intros deriv_rec_correct deriv simp: set_of_eq xs_ne)
   have 4: "?a \<le> ?c" "?c \<le> ?b"  "?a \<le> ?x" "?x \<le> ?b"
     using a xs_ne x
     by (force simp: set_of_eq)+
 
   define cr where "cr \<equiv> \<lambda>s m. if m < ord then ?diff m ?c / fact m - mid (z ! m)
                            else ?diff m s / fact ord - mid (z ! ord)"
   define ci where "ci \<equiv> \<lambda>i. real_interval (z ! i) - interval_of (real_of_float (mid (z ! i)))"
 
   have cr_ord: "cr x ord \<in>\<^sub>i ci ord"
     using tmf_c_correct[OF xs'_in z_ord]
     by (auto simp: ci_def set_of_eq cr_def)
 
   have enclosure: "(\<Sum>m<ord. cr s m * (x - (xs ! 0)) ^ m) + cr s ord * (x - (xs ! 0)) ^ ord
       \<in>\<^sub>r round_interval prec (Ipoly (List.map2 (-) I (map interval_of xs)) (snd (tmf_polys z)))"
     if cr_ord: "cr s ord \<in>\<^sub>i ci ord" for s
   proof -
     have "(\<Sum>m<ord. cr s m  * (x - xs!0) ^ m) + cr s ord * (x - xs!0) ^ ord =
         horner_eval (cr s) (x - xs!0) (Suc ord)"
       by (simp add: horner_eval_eq_setsum)
     also have "\<dots> \<in>\<^sub>i horner_eval ci (real_interval (I ! 0 - xs ! 0)) (Suc ord)"
     proof (rule horner_eval_interval)
       fix i assume "i < Suc ord"
       then consider "i < ord" | "i = ord" by arith
       then show "cr s i \<in>\<^sub>i ci i"
       proof cases
         case 1
         then show ?thesis 
           by (auto simp: cr_def ci_def not_less less_Suc_eq_le
               intro!: minus_in_intervalI tmf_c_correct[OF _ z_less])
             (metis in_set_of_interval_of list_update_id map_update nth_map real_interval_of)
       qed (simp add: cr_ord)
     qed (auto intro!: minus_in_intervalI simp: real_interval_minus x)
     also have "\<dots> = set_of (horner_eval (real_interval o centered \<circ> (!) z)
       (real_interval (I ! 0 - xs ! 0)) (length z))"
       by (auto simp: ci_def centered_def real_interval_minus real_interval_of lz)
     also have "\<dots> \<subseteq> set_of (Ipoly [real_interval (I ! 0 - xs ! 0)]
         (map_poly real_interval (snd (tmf_polys z))))"
       (is "_ \<subseteq> set_of ?x")
       by (rule Ipoly_snd_tmf_polys)
     also have "\<dots> = set_of (real_interval (Ipoly [(I ! 0 - xs ! 0)] (snd (tmf_polys z))))"
       by (auto simp: real_interval_Ipoly num_params_tmf_polys2)
     also have "\<dots> \<subseteq> set_of (real_interval (round_interval prec (Ipoly [(I ! 0 - xs ! 0)] (snd (tmf_polys z)))))"
       by (rule set_of_real_interval_subset) (rule round_ivl_correct)
     also
     have "Ipoly [I ! 0 - interval_of (xs ! 0)] (snd (tmf_polys z)) = Ipoly (List.map2 (-) I (map interval_of xs)) (snd (tmf_polys z))"
       using  a
       apply (auto intro!: Ipoly_num_params_cong nth_equalityI
           simp: nth_Cons  simp del:length_greater_0_conv split: nat.splits dest!: less_le_trans[OF _ num_params_tmf_polys2[of z]])
       apply (subst map2_nth)
       by simp_all
     finally show ?thesis .
   qed
   consider "0 < ord" "x \<noteq> xs ! 0" | "0 < ord" "x = xs ! 0" | "ord = 0" by arith
   then show ?thesis
   proof cases
     case hyps: 1
     then have 1: "0 < ord" and 5: "x \<noteq> xs ! 0" by simp_all
     from Taylor[OF 1 2 3 4 5] obtain s where s: "(if ?x < ?c then ?x < s \<and> s < ?c else ?c < s \<and> s < ?x)"
       and tse: "?f ?x = (\<Sum>m<?n. ?diff m ?c / fact m * (?x - ?c) ^ m) + ?diff ?n s / fact ?n * (?x - ?c) ^ ?n"
       by blast
 
     have "interpret_floatarith f ((map real_of_float xs)[0 := x]) -
     Ipoly (List.map2 (-) [x] [xs!0]) (fst (tmf_polys z)) =
     (\<Sum>m<?n. ?diff m ?c / fact m * (?x - ?c) ^ m) + ?diff ?n s / fact ?n * (?x - ?c) ^ ?n -
     (\<Sum>m\<le>?n. (x - xs!0) ^ m * mid (z ! m))"
       unfolding tse
       by (simp add: Ipoly_fst_tmf_polys rewr lz)
     also have "\<dots> = (\<Sum>m<ord. cr s m  * (x - xs!0) ^ m) + cr s ord * (x - xs!0) ^ ord"
       unfolding rewr
       by (simp add: algebra_simps cr_def sum.distrib sum_subtractf)
     also have "cr s ord \<in>\<^sub>i ci ord"
       using a
       apply (auto simp: cr_def ci_def intro!: minus_in_intervalI
           tmf_c_correct[OF _ z_ord])
       by (smt "4"(1) "4"(2) "4"(3) "4"(4) a all_in_def in_real_intervalI length_greater_0_conv nth_list_update s xs_ne)
     note enclosure[OF this]
     also have "Ipoly (List.map2 (-) [x] (map real_of_float [xs ! 0])) (map_poly real_of_float (fst (tmf_polys z))) =
         insertion e (map_poly real_of_float (fst (tmf_polys z)))"
       using diff_e
       by (auto intro!: Ipoly_eq_insertionI simp: nth_Cons split: nat.splits dest: less_le_trans[OF _ num_params_tmf_polys1[of z]])
     finally
     show ?thesis
       by (simp add: tz tb range_tm_def set_of_eq)
   next
     case 3
     with 3 have "length z = Suc 0" by (simp add: lz)
     then have "fst (tmf_polys z) = fst (tmf_polys [z ! 0])"
       by (cases z) auto
     also have "\<dots> = CN (mid (z ! 0))\<^sub>p 0 0\<^sub>p"
       by simp
     finally have "fst (tmf_polys z) = CN (mid (z ! 0))\<^sub>p 0 0\<^sub>p" .
     with enclosure[OF cr_ord]
     show ?thesis
       by (simp add: cr_def 3 range_tm_def tz tb set_of_eq)
   next
     case 2
     have rewr: "{..<length z} = insert 0 {1..<length z}"
       by (auto simp: lz)
     from 2 enclosure[OF cr_ord]
     show ?thesis
       by (auto simp: zero_power 2 cr_def range_tm_def tz tb insertion_fst_tmf_polys
           diff_e[symmetric] rewr set_of_eq)
   qed
 qed
 
 
 subsection \<open>Operations on Taylor models\<close>
 
 fun tm_norm_poly :: "taylor_model \<Rightarrow> taylor_model"
   where "tm_norm_poly (TaylorModel p e) = TaylorModel (polynate p) e"
 \<comment> \<open>Normalizes the Taylor model by transforming its polynomial into horner form.\<close>
 
 fun tm_lower_order tm_lower_order_of_normed :: "nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_lower_order prec ord I a t = tm_lower_order_of_normed prec ord I a (tm_norm_poly t)"
   |  "tm_lower_order_of_normed prec ord I a (TaylorModel p e) = (
          let (l, r) = split_by_degree ord p
          in TaylorModel l (round_interval prec (e + compute_bound_poly prec r I a))
        )"
 \<comment> \<open>Reduces the degree of a Taylor model's polynomial to n and keeps it range by increasing the error bound.\<close>
 
 fun tm_round_floats tm_round_floats_of_normed :: "nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_round_floats prec I a t = tm_round_floats_of_normed prec I a (tm_norm_poly t)"
   | "tm_round_floats_of_normed prec I a (TaylorModel p e) = (
          let (l, r) = split_by_prec prec p
          in TaylorModel l (round_interval prec (e + compute_bound_poly prec r I a))
        )"
 \<comment> \<open>Rounding of Taylor models. Rounds both the coefficients of the polynomial and the floats in the error bound.\<close>
 
 fun tm_norm tm_norm' :: "nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_norm prec ord I a t = tm_norm' prec ord I a (tm_norm_poly t)"
   | "tm_norm' prec ord I a t = tm_round_floats_of_normed prec I a (tm_lower_order_of_normed prec ord I a t)" 
 \<comment> \<open>Normalization of taylor models. Performs order lowering and rounding on tayor models,
    also converts the polynomial into horner form.\<close>
 
 fun tm_neg :: "taylor_model \<Rightarrow> taylor_model"
   where "tm_neg (TaylorModel p e) = TaylorModel (~\<^sub>p p) (-e)"
 
 fun tm_add :: "taylor_model \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_add (TaylorModel p1 e1) (TaylorModel p2 e2) = TaylorModel (p1 +\<^sub>p p2) (e1 + e2)"
 
 fun tm_sub :: "taylor_model \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_sub t1 t2 = tm_add t1 (tm_neg t2)"
 
 fun tm_mul :: "nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> taylor_model \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_mul prec ord I a (TaylorModel p1 e1) (TaylorModel p2 e2) = (
          let d1 = compute_bound_poly prec p1 I a;
              d2 = compute_bound_poly prec p2 I a;
              p = p1 *\<^sub>p p2;
              e = e1*d2 + d1*e2 + e1*e2
          in tm_norm' prec ord I a (TaylorModel p e)
        )"
 lemmas [simp del] = tm_norm'.simps
 
 fun tm_pow :: "nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> taylor_model \<Rightarrow> nat \<Rightarrow> taylor_model"
   where "tm_pow prec ord I a t 0 = tm_const 1"
   | "tm_pow prec ord I a t (Suc n) = (
          if odd (Suc n)
          then tm_mul prec ord I a t (tm_pow prec ord I a t n)
          else let t' = tm_pow prec ord I a t ((Suc n) div 2)
               in tm_mul prec ord I a t' t'
        )"
 
 text \<open>Evaluates a float polynomial, using a Taylor model as the parameter. This is used to compose Taylor models.\<close>
 fun eval_poly_at_tm :: "nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> float poly \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "eval_poly_at_tm prec ord I a (poly.C c) t = tm_const c"
   | "eval_poly_at_tm prec ord I a (poly.Bound n) t = t"
   | "eval_poly_at_tm prec ord I a (poly.Add p1 p2) t
          = tm_add (eval_poly_at_tm prec ord I a p1 t)
                   (eval_poly_at_tm prec ord I a p2 t)"
   | "eval_poly_at_tm prec ord I a (poly.Sub p1 p2) t
          = tm_sub (eval_poly_at_tm prec ord I a p1 t)
                   (eval_poly_at_tm prec ord I a p2 t)"
   | "eval_poly_at_tm prec ord I a (poly.Mul p1 p2) t
          = tm_mul prec ord I a (eval_poly_at_tm prec ord I a  p1 t)
                                (eval_poly_at_tm prec ord I a p2 t)"
   | "eval_poly_at_tm prec ord I a (poly.Neg p) t
          = tm_neg (eval_poly_at_tm prec ord I a p t)"
   | "eval_poly_at_tm prec ord I a (poly.Pw p n) t
          = tm_pow prec ord I a (eval_poly_at_tm prec ord I a p t) n"
   | "eval_poly_at_tm prec ord I a (poly.CN c n p) t = (
          let pt = eval_poly_at_tm prec ord I a p t;
              t_mul_pt = tm_mul prec ord I a t pt 
          in tm_add (eval_poly_at_tm prec ord I a c t) t_mul_pt
        )"
 
 fun tm_inc_err :: "float interval \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_inc_err i (TaylorModel p e) = TaylorModel p (e + i)"
 
 fun tm_comp :: "nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> float \<Rightarrow> taylor_model \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_comp prec ord I a ta (TaylorModel p e) t = (
          let t_sub_ta = tm_sub t (tm_const ta);
              pt = eval_poly_at_tm prec ord I a p t_sub_ta
          in tm_inc_err e pt
        )"
 
 text \<open>\<open>tm_max\<close>, \<open>tm_min\<close> and \<open>tm_abs\<close> are implemented extremely naively, because I don't expect them to be very useful.
    But the implementation is fairly modular, i.e. \<open>tm_{abs,min,max}\<close> all can easily be swapped out,
    as long as the corresponding correctness lemmas \<open>tm_{abs,min,max}_range\<close> are updated as well.\<close>
 fun tm_abs :: "nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_abs prec I a t = (
   let bound = compute_bound_tm prec I a t; abs_bound=Ivl (0::float) (max (abs (lower bound)) (abs (upper bound)))
   in TaylorModel (poly.C (mid abs_bound)) (centered abs_bound))"
 
 fun tm_union :: "nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> taylor_model \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_union prec I a t1 t2 = (
   let b1 = compute_bound_tm prec I a t1; b2 = compute_bound_tm prec I a t2;
       b_combined = sup b1 b2
   in TaylorModel (poly.C (mid b_combined)) (centered b_combined))"
 
 fun tm_min :: "nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> taylor_model \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_min prec I a t1 t2 = tm_union prec I a t1 t2"
 
 fun tm_max :: "nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> taylor_model \<Rightarrow> taylor_model \<Rightarrow> taylor_model"
   where "tm_max  prec I a t1 t2 = tm_union prec I a t1 t2"
 
 text \<open>Rangeity of is preserved by our operations on Taylor models.\<close>
 
 lemma insertion_polyadd[simp]: "insertion e (a +\<^sub>p b) = insertion e a + insertion e b"
   for a b::"'a::ring_1 poly"
   apply (induction a b rule: polyadd.induct)
   apply (auto simp: algebra_simps Let_def)
   by (metis (no_types) mult_zero_right ring_class.ring_distribs(1))
 
 
 lemma insertion_polyneg[simp]: "insertion e (~\<^sub>p b) =  - insertion e b"
   for b::"'a::ring_1 poly"
   by (induction b rule: polyneg.induct) (auto simp: algebra_simps Let_def)
 
 lemma insertion_polysub[simp]: "insertion e (a -\<^sub>p b) = insertion e a - insertion e b"
   for a b::"'a::ring_1 poly"
   by (simp add: polysub_def)
 
 lemma insertion_polymul[simp]: "insertion e (a *\<^sub>p b) = insertion e a * insertion e b"
   for a b::"'a::comm_ring_1 poly"
   by (induction a b rule: polymul.induct)
     (auto simp: algebra_simps Let_def)
 
 lemma insertion_polypow[simp]: "insertion e (a ^\<^sub>p b) = insertion e a ^ b"
   for a::"'a::comm_ring_1 poly"
 proof (induction b rule: nat_less_induct)
   case (1 n)
   then show ?case 
   proof (cases n)
     case (Suc nat)
     then show ?thesis
       apply (auto simp: )
       apply (auto simp: Let_def div2_less_self 1 simp del: polypow.simps)
       apply (metis even_Suc even_two_times_div_two odd_Suc_div_two semiring_normalization_rules(27) semiring_normalization_rules(36))
       apply (metis even_two_times_div_two semiring_normalization_rules(36))
       done
   qed simp
 qed
 
 lemma insertion_polynate [simp]:
   "insertion bs (polynate p) = (insertion bs p :: 'a::comm_ring_1)"
   by (induct p rule: polynate.induct) (auto simp: )
 
 lemma tm_norm_poly_range:
   assumes "x \<in>\<^sub>i range_tm e t"
   shows "x \<in>\<^sub>i range_tm e (tm_norm_poly t)"
   using assms
   by (cases t) (simp add: range_tm_def)
 
 lemma split_by_degree_correct_insertion:
   fixes x :: "nat \<Rightarrow> real" and p :: "float poly"
   assumes "split_by_degree ord p = (l, r)"
   shows "maxdegree l \<le> ord" (is ?P1)
     and   "insertion x p = insertion x l + insertion x r" (is ?P2)
     and   "num_params l \<le> num_params p" (is ?P3)
     and   "num_params r \<le> num_params p" (is ?P4)
 proof -
   define xs where "xs = map x [0..<num_params p]"
   have xs: "i < num_params p \<Longrightarrow> x i = xs ! i" for i
     by (auto simp: xs_def)
   have "insertion x p = Ipoly xs p"
     by (auto intro!: insertion_eq_IpolyI xs)
   also
   from split_by_degree_correct[OF assms(1)[symmetric]]
   have "maxdegree l \<le> ord"
     and p: "Ipoly xs (map_poly real_of_float p) =
     Ipoly xs (map_poly real_of_float l) + Ipoly xs (map_poly real_of_float r)"
    and l: "num_params l \<le> num_params p"
    and r: "num_params r \<le> num_params p"
     by auto
   show ?P1 ?P3 ?P4 by fact+
   note p
   also have "Ipoly xs (map_poly real_of_float l) = insertion x l"
     using l
     by (auto intro!: xs Ipoly_eq_insertionI)
   also have "Ipoly xs (map_poly real_of_float r) = insertion x r"
     using r
     by (auto intro!: xs Ipoly_eq_insertionI)
   finally show ?P2 .
 qed
 
 lemma split_by_prec_correct_insertion:
   fixes x :: "nat \<Rightarrow> real" and p :: "float poly"
   assumes "split_by_prec ord p = (l, r)"
   shows "insertion x p = insertion x l + insertion x r" (is ?P1)
     and "num_params l \<le> num_params p" (is ?P2)
     and "num_params r \<le> num_params p" (is ?P3)
 proof -
   define xs where "xs = map x [0..<num_params p]"
   have xs: "i < num_params p \<Longrightarrow> x i = xs ! i" for i
     by (auto simp: xs_def)
   have "insertion x p = Ipoly xs p"
     by (auto intro!: insertion_eq_IpolyI xs)
   also
   from split_by_prec_correct[OF assms(1)[symmetric]]
   have p: "Ipoly xs (map_poly real_of_float p) =
     Ipoly xs (map_poly real_of_float l) + Ipoly xs (map_poly real_of_float r)"
    and l: "num_params l \<le> num_params p"
    and r: "num_params r \<le> num_params p"
     by auto
   show ?P2 ?P3 by fact+
   note p
   also have "Ipoly xs (map_poly real_of_float l) = insertion x l"
     using l
     by (auto intro!: xs Ipoly_eq_insertionI)
   also have "Ipoly xs (map_poly real_of_float r) = insertion x r"
     using r
     by (auto intro!: xs Ipoly_eq_insertionI)
   finally show ?P1 .
 qed
 
 lemma tm_lower_order_of_normed_range:
   assumes "x \<in>\<^sub>i range_tm e t"
   assumes dev: "develops_at_within e a I"
   assumes "num_params (tm_poly t) \<le> length I"
   shows "x \<in>\<^sub>i range_tm e (tm_lower_order_of_normed prec ord I a t)"
 proof-
   obtain p err where t_decomp: "t = TaylorModel p err"
     by (cases t) simp
   obtain pl pr where p_split: "split_by_degree ord p = (pl, pr)"
     by (cases "split_by_degree ord p", simp)
 
   from split_by_degree_correct_insertion[OF p_split]
   have params: "maxdegree pl \<le> ord" "num_params pl \<le> num_params p" "num_params pr \<le> num_params p"
     and ins: "insertion e (map_poly real_of_float p) =
       insertion e (map_poly real_of_float pl) + insertion e (map_poly real_of_float pr)"
     by auto
   from assms params have params_pr: "num_params pr \<le> length I" by (auto simp: t_decomp)
 
   have "range_tm e t =
     interval_of (insertion e (map_poly real_of_float pl)) +
     (interval_of (insertion e (map_poly real_of_float pr)) + real_interval err)"
     by (auto simp: t_decomp range_tm_def ins ac_simps interval_of_plus) term round_interval
   also have "set_of \<dots> \<subseteq> set_of (interval_of (insertion e pl)) +
     set_of (real_interval (round_interval prec (err + compute_bound_poly prec pr I a)))"
     unfolding set_of_plus real_interval_plus add.commute[of err]
     apply (rule set_plus_mono2[OF order_refl])
     apply (rule order_trans) prefer 2
      apply (rule set_of_real_interval_subset)
      apply (rule round_ivl_correct)
     unfolding set_of_plus real_interval_plus
     apply (rule set_plus_mono2[OF _ order_refl])
     apply (rule subsetI)
     apply simp
     apply (rule compute_bound_poly_correct)
       apply (rule params_pr)
     by (rule assms)
   also have "\<dots> = set_of (range_tm e (tm_lower_order_of_normed prec ord I a t))"
     by (simp add: t_decomp split_beta' Let_def p_split range_tm_def set_of_plus)
   finally show ?thesis using assms by auto
 qed
 
 lemma num_params_tm_norm_poly_le: "num_params (tm_poly (tm_norm_poly t)) \<le> X"
   if "num_params (tm_poly t) \<le> X"
   using that
   by (cases t) (auto simp: intro!: num_params_polynate[THEN order_trans])
 
 lemma tm_lower_order_range:
   assumes "x \<in>\<^sub>i range_tm e t"
   assumes dev: "develops_at_within e a I"
   assumes "num_params (tm_poly t) \<le> length I"
   shows "x \<in>\<^sub>i range_tm e (tm_lower_order prec ord I a t)"
   by (auto simp add: intro!: tm_lower_order_of_normed_range tm_norm_poly_range assms
       num_params_tm_norm_poly_le)
 
 lemma tm_round_floats_of_normed_range:
   assumes "x \<in>\<^sub>i range_tm e t"
   assumes dev: "develops_at_within e a I"
   assumes "num_params (tm_poly t) \<le> length I"
   shows "x \<in>\<^sub>i range_tm e (tm_round_floats_of_normed prec I a t)"
     \<comment> \<open>TODO: this is a clone of @{thm tm_lower_order_of_normed_range} -> general sweeping method!\<close>
 proof-
   obtain p err where t_decomp: "t = TaylorModel p err"
     by (cases t) simp
   obtain pl pr where p_prec: "split_by_prec prec p = (pl, pr)"
     by (cases "split_by_prec prec p", simp)
 
   from split_by_prec_correct_insertion[OF p_prec]
   have params: "num_params pl \<le> num_params p" "num_params pr \<le> num_params p"
     and ins: "insertion e (map_poly real_of_float p) =
       insertion e (map_poly real_of_float pl) + insertion e (map_poly real_of_float pr)"
     by auto
   from assms params have params_pr: "num_params pr \<le> length I"
     by (auto simp: t_decomp)
 
   have "range_tm e t =
     interval_of (insertion e (map_poly real_of_float pl)) +
     (interval_of (insertion e (map_poly real_of_float pr)) + real_interval err)"
     by (auto simp: t_decomp range_tm_def ins ac_simps interval_of_plus)
   also have "set_of \<dots> \<subseteq> set_of (interval_of (insertion e pl)) +
     set_of (real_interval (round_interval prec (err + compute_bound_poly prec pr I a)))"
     unfolding set_of_plus real_interval_plus add.commute[of err]
     apply (rule set_plus_mono2[OF order_refl])
     apply (rule order_trans) prefer 2
      apply (rule set_of_real_interval_subset)
      apply (rule round_ivl_correct)
     unfolding set_of_plus real_interval_plus
     apply (rule set_plus_mono2[OF _ order_refl])
     apply (rule subsetI)
     apply simp
     apply (rule compute_bound_poly_correct)
      apply (rule params_pr)
     by (rule assms)
   also have "\<dots> = set_of (range_tm e (tm_round_floats_of_normed prec I a t))"
     by (simp add: t_decomp split_beta' Let_def p_prec range_tm_def set_of_plus)
   finally show ?thesis using assms by auto
 qed
 
 lemma num_params_split_by_degree_le: "num_params (fst (split_by_degree ord x)) \<le> K"
   "num_params (snd (split_by_degree ord x)) \<le> K"
   if "num_params x \<le> K" for x::"float poly"
   using split_by_degree_correct_insertion(3,4)[of ord x, OF surjective_pairing] that
   by auto
 
 lemma num_params_split_by_prec_le: "num_params (fst (split_by_prec ord x)) \<le> K"
   "num_params (snd (split_by_prec ord x)) \<le> K"
   if "num_params x \<le> K" for x::"float poly"
   using split_by_prec_correct_insertion(2,3)[of ord x, OF surjective_pairing] that
   by auto
 
 lemma num_params_tm_norm'_le:
   "num_params (tm_poly (tm_round_floats_of_normed prec I a t)) \<le> X"
   if "num_params (tm_poly t) \<le> X"
   using that
   by (cases t) (auto simp: tm_norm'.simps split_beta' Let_def intro!: num_params_split_by_prec_le)
 
 lemma tm_round_floats_range:
   assumes "x \<in>\<^sub>i range_tm e t" "develops_at_within e a I" "num_params (tm_poly t) \<le> length I"
   shows "x \<in>\<^sub>i range_tm e (tm_round_floats prec I a t)"
   by (auto intro!: tm_round_floats_of_normed_range assms tm_norm_poly_range num_params_tm_norm_poly_le)
 
 lemma num_params_tm_lower_order_of_normed_le: "num_params (tm_poly (tm_lower_order_of_normed prec ord I a t)) \<le> X"
   if "num_params (tm_poly t) \<le> X"
   using that
   apply (cases t)
   apply (auto simp: split_beta' Let_def intro!: num_params_polynate[THEN order_trans])
   apply (rule order_trans[OF split_by_degree_correct(3)])
   by (auto simp: prod_eq_iff)
 
 
 lemma tm_norm'_range:
   assumes "x \<in>\<^sub>i range_tm e t" "develops_at_within e a I" "num_params (tm_poly t) \<le> length I"
   shows "x \<in>\<^sub>i range_tm e (tm_norm' prec ord I a t)"
   by (auto intro!: tm_round_floats_of_normed_range tm_lower_order_of_normed_range assms
       num_params_tm_norm_poly_le num_params_tm_lower_order_of_normed_le
       simp: tm_norm'.simps)
 
 lemma num_params_tm_norm':
   "num_params (tm_poly (tm_norm' prec ord I a t)) \<le> X"
   if "num_params (tm_poly t) \<le> X"
   using that
   by (cases t) (auto simp: tm_norm'.simps split_beta' Let_def
       intro!: num_params_tm_norm'_le num_params_split_by_prec_le num_params_split_by_degree_le)
 
 lemma tm_norm_range:
   assumes "x \<in>\<^sub>i range_tm e t" "develops_at_within e a I" "num_params (tm_poly t) \<le> length I"
   shows "x \<in>\<^sub>i range_tm e (tm_norm prec ord I a t)"
   by (auto intro!: assms tm_norm'_range tm_norm_poly_range num_params_tm_norm_poly_le)
 lemmas [simp del] = tm_norm.simps
 
 lemma tm_neg_range:
   assumes "x \<in>\<^sub>i range_tm e t"
   shows "- x \<in>\<^sub>i range_tm e (tm_neg t)"
   using assms
   by (cases t)
     (auto simp: set_of_eq range_tm_def interval_of_plus interval_of_uminus map_poly_homo_polyneg)
 lemmas [simp del] = tm_neg.simps
 
 
 lemma tm_bound_tm_add[simp]: "tm_bound (tm_add t1 t2) = tm_bound t1 + tm_bound t2"
   by (cases t1; cases t2) (auto simp: )
 
 lemma interval_of_add: "interval_of (a + b) = interval_of a + interval_of b"
   by (auto intro!: interval_eqI)
 
 lemma tm_add_range:
   "x + y \<in>\<^sub>i range_tm e (tm_add t1 t2)"
   if "x \<in>\<^sub>i range_tm e t1"
     "y \<in>\<^sub>i range_tm e t2"
 proof -
   from range_tmD[OF that(1)] range_tmD[OF that(2)]
   show ?thesis
     apply (cases t1; cases t2)
     apply (rule range_tmI)
     by (auto simp: map_poly_homo_polyadd real_interval_plus ac_simps interval_of_add
         num_params_polyadd insertion_polyadd set_of_eq
         dest: less_le_trans[OF _ num_params_polyadd])
 qed
 lemmas [simp del] = tm_add.simps
 
 lemma tm_sub_range:
   assumes "x \<in>\<^sub>i range_tm e t1"
   assumes "y \<in>\<^sub>i range_tm e t2"
   shows "x - y \<in>\<^sub>i range_tm e (tm_sub t1 t2)"
   using tm_add_range[OF assms(1) tm_neg_range[OF assms(2)]]
   by simp
 lemmas [simp del] = tm_sub.simps
 
 lemma set_of_intervalI: "set_of (interval_of y) \<subseteq> set_of Y" if "y \<in>\<^sub>i Y" for y::"'a::order"
   using that by (auto simp: set_of_eq)
 
 lemma set_of_real_intervalI: "set_of (interval_of y) \<subseteq> set_of (real_interval Y)" if "y \<in>\<^sub>r Y"
   using that by (auto simp: set_of_eq)
 
 lemma tm_mul_range:
   assumes "x \<in>\<^sub>i range_tm e t1"
   assumes "y \<in>\<^sub>i range_tm e t2"
   assumes dev: "develops_at_within e a I"
   assumes params: "num_params (tm_poly t1) \<le> length I" "num_params (tm_poly t2) \<le> length I"
   shows "x * y \<in>\<^sub>i range_tm e (tm_mul prec ord I a t1 t2)"
 proof -
   define p1 where "p1 = tm_poly t1"
   define p2 where "p2 = tm_poly t2"
   define e1 where "e1 = tm_bound t1"
   define e2 where "e2 = tm_bound t2"
   have t1_def: "t1 = TaylorModel p1 e1" and t2_def: "t2 = TaylorModel p2 e2"
     by (auto simp: p1_def e1_def p2_def e2_def)
   from params have params: "num_params p1 \<le> length I" "num_params p2 \<le> length I"
     by (auto simp: p1_def p2_def)
   from range_tmD[OF assms(1)]
   obtain xe where x: "x = insertion e p1 + xe"
     (is "_ = ?x' + _")
     and xe: "xe \<in>\<^sub>r e1"
     by (auto simp: p1_def e1_def elim!: plus_in_intervalE)
   from range_tmD[OF assms(2)]
   obtain ye where y: "y = insertion e p2 + ye"
     (is "_ = ?y' + _")
     and ye: "ye \<in>\<^sub>r e2"
     by (auto simp: p2_def e2_def elim!: plus_in_intervalE)
   have "x * y = insertion e (p1 *\<^sub>p p2) + (xe * ?y' + ?x' * ye + xe * ye)"
     by (simp add: algebra_simps x y map_poly_homo_polymul)
   also have "\<dots> \<in>\<^sub>i range_tm e (tm_mul prec ord I a t1 t2)"
     by (auto intro!: tm_round_floats_of_normed_range assms tm_norm'_range
         simp: split_beta' Let_def t1_def t2_def)
      (auto simp: range_tm_def real_interval_plus real_interval_times intro!: plus_in_intervalI
         times_in_intervalI xe ye params compute_bound_poly_correct dev
         num_params_polymul[THEN order_trans])
   finally show ?thesis .
 qed
 
 lemma num_params_tm_mul_le:
   "num_params (tm_poly (tm_mul prec ord I a t1 t2)) \<le> X"
   if "num_params (tm_poly t1) \<le> X"
     "num_params (tm_poly t2) \<le> X"
   using that
   by (cases t1; cases t2)
      (auto simp: intro!: num_params_tm_norm' num_params_polymul[THEN order_trans])
 
 lemmas [simp del] = tm_pow.simps\<comment> \<open>TODO: make a systematic decision\<close>
 
 lemma
   shows tm_pow_range: "num_params (tm_poly t) \<le> length I \<Longrightarrow>
       develops_at_within e a I \<Longrightarrow>
       x \<in>\<^sub>i range_tm e t \<Longrightarrow>
       x ^ n \<in>\<^sub>i range_tm e (tm_pow prec ord I a t n)"
     and num_params_tm_pow_le[THEN order_trans]:
       "num_params (tm_poly (tm_pow prec ord I a t n)) \<le> num_params (tm_poly t)"
   unfolding atomize_conj atomize_imp
 proof(induction n arbitrary: x t rule: nat_less_induct)
   case (1 n)
   note IH1 = 1(1)[rule_format, THEN conjunct1, rule_format]
   note IH2 = 1(1)[rule_format, THEN conjunct2, THEN order_trans]
   show ?case
   proof (cases n)
     case 0
     then show ?thesis by (auto simp: tm_const_def range_tm_def set_of_eq tm_pow.simps)
   next
     case (Suc nat)
     have eq: "odd nat \<Longrightarrow> x * x ^ nat = x ^ ((Suc nat) div 2) * x ^ ((Suc nat) div 2)"
       apply (subst power_add[symmetric])
       unfolding div2_plus_div2
       by simp
     show ?thesis
       unfolding tm_pow.simps Suc
       using Suc
       apply (auto )
       subgoal
         apply (rule tm_mul_range) apply (assumption)
            apply (rule IH1) apply force
              apply assumption+
         apply (rule IH2) apply force
         apply assumption
         done
       subgoal
         apply (rule num_params_tm_mul_le) apply force
         apply (rule IH2) apply force 
         apply force
         done
       subgoal
         apply (auto simp: Let_def)
         unfolding eq odd_Suc_div_two
         apply (rule tm_mul_range)
         subgoal by (rule IH1) (auto intro!: tm_mul_range num_params_tm_mul_le IH1 IH2 1
               simp: Let_def div2_less_self)
         subgoal by (rule IH1) (auto intro!: tm_mul_range num_params_tm_mul_le IH1 IH2 1
               simp: Let_def div2_less_self)
         subgoal by assumption
         subgoal by (rule IH2) (auto simp: div2_less_self 1)
         subgoal by (rule IH2) (auto simp: div2_less_self 1)
         done
       subgoal
         by (auto simp: Let_def div2_less_self 1 intro!: IH2 num_params_tm_mul_le)
       done
   qed
 qed
 
 lemma num_params_tm_add_le:
   "num_params (tm_poly (tm_add t1 t2)) \<le> X"
   if "num_params (tm_poly t1) \<le> X"
     "num_params (tm_poly t2) \<le> X"
   using that
   by (cases t1; cases t2)
      (auto simp: tm_add.simps
        intro!: num_params_tm_norm' num_params_polymul[THEN order_trans]
        num_params_polyadd[THEN order_trans])
 
 lemma num_params_tm_neg_eq[simp]:
   "num_params (tm_poly (tm_neg t1)) = num_params (tm_poly t1)"
   by (cases t1) (auto simp: tm_neg.simps num_params_polyneg)
 
 lemma num_params_tm_sub_le:
   "num_params (tm_poly (tm_sub t1 t2)) \<le> X"
   if "num_params (tm_poly t1) \<le> X"
     "num_params (tm_poly t2) \<le> X"
   using that
   by (cases t1; cases t2) (auto simp: tm_sub.simps intro!: num_params_tm_add_le)
 
 lemma num_params_eval_poly_le: "num_params (tm_poly (eval_poly_at_tm prec ord I a p t)) \<le> x"
   if "num_params (tm_poly t) \<le> x" "num_params p \<le> max 1 x"
   using that
   by (induction prec ord I a p t rule: eval_poly_at_tm.induct)
     (auto intro!: num_params_tm_add_le num_params_tm_sub_le num_params_tm_mul_le
       num_params_tm_pow_le)
 
 lemma eval_poly_at_tm_range:
   assumes "num_params p \<le> 1"
   assumes tg_def: "e' 0 \<in>\<^sub>i range_tm e tg"
   assumes dev: "develops_at_within e a I" and params: "num_params (tm_poly tg) \<le> length I"
   shows "insertion e' p \<in>\<^sub>i range_tm e (eval_poly_at_tm prec ord I a p tg)"
   using assms(1) params
 proof(induction p)
   case (C c) thus ?case
     using tg_def
     by (cases tg) (auto simp: tm_const_def range_tm_def real_interval_zero)
 next
   case (Bound n) thus ?case
     using tg_def
     by simp
 next
   case (Add p1l p1r) thus ?case 
     using tm_add_range by (simp add: func_plus)
 next
   case (Sub p1l p1r) thus ?case 
     using tm_sub_range by (simp add: fun_diff_def)
 next
   case (Mul p1l p1r) thus ?case
     by (auto intro!: tm_mul_range Mul dev num_params_eval_poly_le)
 next
   case (Neg p1') thus ?case 
     using tm_neg_range by (simp add: fun_Compl_def)
 next
   case (Pw p1' n) thus ?case 
     by (auto intro!: tm_pow_range Pw dev num_params_eval_poly_le)
 next
   case (CN p1l n p1r) thus ?case 
     by (auto intro!: tm_mul_range tm_pow_range CN dev num_params_eval_poly_le tm_add_range tg_def)
 qed
 
 lemma tm_inc_err_range: "x \<in>\<^sub>i range_tm e (tm_inc_err i t)"
   if "x \<in>\<^sub>i range_tm e t + real_interval i"
   using that
   by (cases t) (auto simp: range_tm_def real_interval_plus ac_simps)
 
 lemma num_params_tm_inc_err: "num_params (tm_poly (tm_inc_err i t)) \<le> X"
   if "num_params (tm_poly t) \<le> X"
   using that
   by (cases t) auto
 
 lemma num_params_tm_comp_le: "num_params (tm_poly (tm_comp prec ord I a ga tf tg)) \<le> X"
   if "num_params (tm_poly tf) \<le> max 1 X" "num_params (tm_poly tg) \<le> X"
   using that
   by (cases tf) (auto intro!: num_params_tm_inc_err num_params_eval_poly_le num_params_tm_sub_le)
 
 lemma tm_comp_range:
   assumes tf_def: "x \<in>\<^sub>i range_tm e' tf"
   assumes tg_def: "e' 0 \<in>\<^sub>i range_tm e (tm_sub tg (tm_const ga))"
   assumes params: "num_params (tm_poly tf) \<le> 1" "num_params (tm_poly tg) \<le> length I"
   assumes dev: "develops_at_within e a I"
   shows "x \<in>\<^sub>i range_tm e (tm_comp prec ord I a ga tf tg)"
 proof-
   obtain pf ef where tf_decomp: "tf = TaylorModel pf ef" using taylor_model.exhaust by auto
   obtain pg eg where tg_decomp: "tg = TaylorModel pg eg" using taylor_model.exhaust by auto
 
   from params have params: "num_params pf \<le> Suc 0" "num_params pg \<le> length I"
     by (auto simp: tf_decomp tg_decomp)
   from tf_def obtain xe where x_def: "x = insertion e' pf + xe" "xe \<in>\<^sub>r ef"
     by (auto simp: tf_decomp range_tm_def elim!: plus_in_intervalE)
   show ?thesis
     using tg_def
     by (auto simp: tf_decomp tg_decomp x_def params dev
         intro!: tm_inc_err_range eval_poly_at_tm_range plus_in_intervalI num_params_tm_sub_le)
 qed
 
 lemma mid_centered_collapse:
   "interval_of (real_of_float (mid abs_bound)) + real_interval (centered abs_bound) =
     real_interval abs_bound"
   by (auto simp: centered_def interval_eq_iff)
 
 lemmas [simp del] = tm_abs.simps
 lemma tm_abs_range:
   assumes x: "x \<in>\<^sub>i range_tm e t"
   assumes n: "num_params (tm_poly t) \<le> length I" and d: "develops_at_within e a I"
   shows "abs x \<in>\<^sub>i range_tm e (tm_abs prec I a t)"
 proof-
   obtain p e where t_def[simp]: "t = TaylorModel p e" using taylor_model.exhaust by auto
   define bound where "bound = compute_bound_tm prec I a t"
   have bound: "x \<in>\<^sub>r bound"
     unfolding bound_def
     using n d x
     by (rule compute_bound_tm_correct)
   define abs_bound where "abs_bound \<equiv> Ivl 0 (max \<bar>lower bound\<bar> \<bar>upper bound\<bar>)"
   have abs_bound: "\<bar>x\<bar> \<in>\<^sub>r abs_bound" using bound
     by (auto simp: abs_bound_def set_of_eq abs_real_def max_def min_def)
   have tm_abs_decomp: "tm_abs prec I a t = TaylorModel (poly.C (mid abs_bound)) (centered abs_bound)"
     by (simp add: bound_def abs_bound_def Let_def tm_abs.simps)
   show ?thesis
     unfolding tm_abs_decomp
     by (rule range_tmI) (auto simp: mid_centered_collapse abs_bound)
 qed
 
 lemma num_params_tm_abs_le: "num_params (tm_poly (tm_abs prec I a t)) \<le> X" if "num_params (tm_poly t) \<le> X"
   using that
   by (auto simp: tm_abs.simps Let_def)
 
 lemma real_interval_sup: "real_interval (sup a b) = sup (real_interval a) (real_interval b)"
   by (auto simp: interval_eq_iff inf_real_def inf_float_def sup_float_def sup_real_def min_def max_def)
 
 lemma in_interval_supI1: "x \<in>\<^sub>i a \<Longrightarrow> x \<in>\<^sub>i sup a b"
   and in_interval_supI2: "x \<in>\<^sub>i b \<Longrightarrow> x \<in>\<^sub>i sup a b"
   for x::"'a::lattice"
   by (auto simp: set_of_eq le_infI1 le_infI2 le_supI1 le_supI2)
   
 lemma tm_union_range_left:
   assumes "x \<in>\<^sub>i range_tm e t1"
     "num_params (tm_poly t1) \<le> length I" "develops_at_within e a I"
   shows "x \<in>\<^sub>i range_tm e (tm_union prec I a t1 t2)"
 proof-
   define b1 where "b1 \<equiv> compute_bound_tm prec I a t1"
   define b2 where "b2 \<equiv> compute_bound_tm prec I a t2"
   define b_combined where "b_combined \<equiv> sup b1 b2"
 
   obtain p e where tm_union_decomp: "tm_union prec I a t1 t2 = TaylorModel p e"
     using taylor_model.exhaust by auto
   then have p_def: "p = (mid b_combined)\<^sub>p"
     and e_def: "e = centered b_combined"
     by (auto simp: Let_def b1_def b2_def b_combined_def interval_eq_iff)
   have "x \<in>\<^sub>r b1"
     by (auto simp : b1_def intro!: compute_bound_tm_correct assms)
   then have "x \<in>\<^sub>r b_combined"
     by (auto simp: b_combined_def real_interval_sup in_interval_supI1)
   then show ?thesis
     unfolding tm_union_decomp
     by (auto simp: range_tm_def p_def e_def mid_centered_collapse)
 qed
 
 lemma tm_union_range_right:
   assumes "x \<in>\<^sub>i range_tm e t2"
     "num_params (tm_poly t2) \<le> length I" "develops_at_within e a I"
   shows "x \<in>\<^sub>i range_tm e (tm_union prec I a t1 t2)"
   using tm_union_range_left[OF assms]
   by (simp add: interval_union_commute)
 
 lemma num_params_tm_union_le:
   "num_params (tm_poly (tm_union prec I a t1 t2)) \<le> X"
   if "num_params (tm_poly t1) \<le> X" "num_params (tm_poly t2) \<le> X"
   using that
   by (auto simp: Let_def)
   
 lemmas [simp del] = tm_union.simps tm_min.simps tm_max.simps
 
 lemma tm_min_range:
   assumes "x \<in>\<^sub>i range_tm e t1"
   assumes "y \<in>\<^sub>i range_tm e t2"
     "num_params (tm_poly t1) \<le> length I"
     "num_params (tm_poly t2) \<le> length I"
     "develops_at_within e a I"
   shows "min x y \<in>\<^sub>i range_tm e (tm_min prec I a t1 t2)"
   using assms
   by (auto simp: Let_def tm_min.simps min_def intro: tm_union_range_left tm_union_range_right)
 
 lemma tm_max_range:
   assumes "x \<in>\<^sub>i range_tm e t1"
   assumes "y \<in>\<^sub>i range_tm e t2"
     "num_params (tm_poly t1) \<le> length I"
     "num_params (tm_poly t2) \<le> length I"
     "develops_at_within e a I"
   shows "max x y \<in>\<^sub>i range_tm e (tm_max prec I a t1 t2)"
   using assms
   by (auto simp: Let_def tm_max.simps max_def intro: tm_union_range_left tm_union_range_right)
 
 
 subsection \<open>Computing Taylor models for multivariate expressions\<close>
 
 text \<open>Compute Taylor models for expressions of the form "f (g x)", where f is an elementary function like exp or cos,
    by composing Taylor models for f and g. For our correctness proof, we need to make it explicit that the range
    of g on I is inside the domain of f, by introducing the \<open>f_exists_on\<close> predicate.\<close>
 fun compute_tm_by_comp :: "nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> floatarith \<Rightarrow> taylor_model option \<Rightarrow> (float interval \<Rightarrow> bool) \<Rightarrow> taylor_model option"
   where "compute_tm_by_comp prec ord I a f g f_exists_on = (
          case g
          of Some tg \<Rightarrow> (
            let gI = compute_bound_tm prec I a tg;
                ga = mid (compute_bound_tm prec a a tg)
            in if f_exists_on gI
               then map_option (\<lambda>tf. tm_comp prec ord I a ga tf tg ) (tm_floatarith prec ord [gI] [ga] f)
               else None)
          | _ \<Rightarrow> None
        )"
 
 text \<open>Compute Taylor models with numerical precision \<open>prec\<close> of degree \<open>ord\<close>,
   with Taylor models in the environment \<open>env\<close> whose variables are jointly interpreted with domain
   \<open>I\<close> and expanded around point \<open>a\<close>.
   from floatarith expressions on a rectangular domain.\<close>
 fun approx_tm :: "nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> floatarith \<Rightarrow> taylor_model list \<Rightarrow>
     taylor_model option"
   where "approx_tm _ _ I _ (Num c) env = Some (tm_const c)"
   | "approx_tm _ _ I a (Var n) env = (if n < length env then Some (env ! n) else None)"
   | "approx_tm prec ord I a (Add l r) env = (
          case (approx_tm prec ord I a l env, approx_tm prec ord I a r env) 
          of (Some t1, Some t2) \<Rightarrow> Some (tm_add t1 t2)
           | _ \<Rightarrow> None)"
   | "approx_tm prec ord I a (Minus f) env
          = map_option tm_neg (approx_tm prec ord I a f env)"
   | "approx_tm prec ord I a (Mult l r) env = (
          case (approx_tm prec ord I a l env, approx_tm prec ord I a r env) 
          of (Some t1, Some t2) \<Rightarrow> Some (tm_mul prec ord I a t1 t2)
           | _ \<Rightarrow> None)"     
   | "approx_tm prec ord I a (Power f k) env
          = map_option (\<lambda>t. tm_pow prec ord I a t k)
                       (approx_tm prec ord I a f env)"
   | "approx_tm prec ord I a (Inverse f) env
          = compute_tm_by_comp prec ord I a (Inverse (Var 0)) (approx_tm prec ord I a f env) (\<lambda>x. 0 < lower x \<or> upper x < 0)"
   | "approx_tm prec ord I a (Cos f) env
          = compute_tm_by_comp prec ord I a (Cos (Var 0)) (approx_tm prec ord I a f env) (\<lambda>x. True)"
   | "approx_tm prec ord I a (Arctan f) env
          = compute_tm_by_comp prec ord I a (Arctan (Var 0)) (approx_tm prec ord I a f env) (\<lambda>x. True)"
   | "approx_tm prec ord I a (Exp f) env
          = compute_tm_by_comp prec ord I a (Exp (Var 0)) (approx_tm prec ord I a f env) (\<lambda>x. True)"
   | "approx_tm prec ord I a (Ln f) env
          = compute_tm_by_comp prec ord I a (Ln (Var 0)) (approx_tm prec ord I a f env) (\<lambda>x. 0 < lower x)"
   | "approx_tm prec ord I a (Sqrt f) env
          = compute_tm_by_comp prec ord I a (Sqrt (Var 0)) (approx_tm prec ord I a f env) (\<lambda>x. 0 < lower x)"
   | "approx_tm prec ord I a Pi env = Some (tm_pi prec)"
   | "approx_tm prec ord I a (Abs f) env
          = map_option (tm_abs prec I a) (approx_tm prec ord I a f env)"
   | "approx_tm prec ord I a (Min l r) env = (
          case (approx_tm prec ord I a l env, approx_tm prec ord I a r env) 
          of (Some t1, Some t2) \<Rightarrow> Some (tm_min prec I a t1 t2)
           | _ \<Rightarrow> None)"
   | "approx_tm prec ord I a (Max l r) env = (
          case (approx_tm prec ord I a l env, approx_tm prec ord I a r env)
          of (Some t1, Some t2) \<Rightarrow> Some (tm_max prec I a t1 t2)
           | _ \<Rightarrow> None)"
   | "approx_tm prec ord I a (Powr l r) env = None" \<comment> \<open>TODO\<close>
   | "approx_tm prec ord I a (Floor l) env = None" \<comment> \<open>TODO\<close>
 
 lemma mid_in_real_interval: "mid i \<in>\<^sub>r i"
   using lower_le_upper[of i]
   by (auto simp: mid_def set_of_eq powr_minus)
 
 lemma set_of_real_interval_mono:"set_of (real_interval x) \<subseteq> set_of (real_interval y)"
   if "set_of x \<subseteq> set_of y"
   using that by (auto simp: set_of_eq)
 
 lemmas [simp del] = compute_bound_poly.simps tm_floatarith.simps
 
 (*
   assumes tx_valid: "valid_tm I a (interpret_floatarith g) tg"
   assumes t_def: "compute_tm_on_ivl_by_comp prec ord I a f (Some tg) c = Some t"
   assumes f_deriv: "\<And>x. x \<in>\<^sub>r (compute_bound_tm prec I a tg) \<Longrightarrow> c (compute_bound_tm prec I a tg) \<Longrightarrow> isDERIV 0 f [x]"
   shows "valid_tm I a ((\<lambda>x. interpret_floatarith f [x]) o interpret_floatarith g) t"
 *)
 
 lemmas [simp del] = tmf_ivl_cs.simps compute_bound_tm.simps tmf_polys.simps
 
 lemma tm_floatarith_eq_Some_num_params:
   "tm_floatarith prec ord a b f = Some tf \<Longrightarrow> num_params (tm_poly tf) \<le> 1"
   by (auto simp: tm_floatarith.simps split_beta' Let_def those_eq_Some_iff num_params_tmf_polys1)
 
 lemma compute_tm_by_comp_range:
   assumes "max_Var_floatarith f \<le> 1"
   assumes a: "a all_subset I"
   assumes tx_range: "x \<in>\<^sub>i range_tm e tg"
   assumes t_def: "compute_tm_by_comp prec ord I a f (Some tg) c = Some t"
   assumes f_deriv:
     "\<And>x. x \<in>\<^sub>r compute_bound_tm prec I a tg \<Longrightarrow> c (compute_bound_tm prec I a tg) \<Longrightarrow> isDERIV 0 f [x]"
   assumes params: "num_params (tm_poly tg) \<le> length I"
     and dev: "develops_at_within e a I"
   shows "interpret_floatarith f [x] \<in>\<^sub>i range_tm e t"
 proof-
   from t_def[simplified, simplified Let_def]
   obtain tf
     where t1_def: "tm_floatarith prec ord [compute_bound_tm prec I (a) tg]
           [mid (compute_bound_tm prec a a tg)] f =
          Some tf"
       and t_decomp: "t = tm_comp prec ord I a (mid (compute_bound_tm prec a a tg)) tf tg "
       and c_true:   "c (compute_bound_tm prec I a tg)"
     by (auto simp: split_beta' Let_def split: if_splits)
   have a1: "mid (compute_bound_tm prec a a tg) \<in>\<^sub>r (compute_bound_tm prec I a tg)"
     apply(rule rev_subsetD[OF mid_in_real_interval])
     apply (rule set_of_real_interval_mono)
     apply (rule compute_bound_tm_mono)
     using params a
     by (auto simp add: set_of_eq elim!: range_tmD)
   from \<open>max_Var_floatarith f \<le> 1\<close>
   have [simp]: "\<And>x. 0 \<le> length x \<Longrightarrow> (\<lambda>x. interpret_floatarith f [x ! 0]) x = interpret_floatarith f x"
     by (induction f, simp_all)
 
   let ?mid = "real_of_float (mid (compute_bound_tm prec a a tg))"
   have 1: "interpret_floatarith f [x] \<in>\<^sub>i range_tm (\<lambda>_. x - ?mid) tf"
     apply (rule tm_floatarith[OF t1_def, simplified])
     subgoal
       apply (rule rev_subsetD)
       apply (rule mid_in_real_interval)
       apply (rule set_of_real_interval_mono)
       apply (rule compute_bound_tm_mono)
       using assms
       by (auto)
     subgoal
       by (rule compute_bound_tm_correct assms)+
     subgoal by (auto intro!: assms c_true)
     subgoal by (auto simp: )
     done
   show ?thesis
     unfolding t_decomp
     apply (rule tm_comp_range)
          apply (rule 1)
     using tm_floatarith_eq_Some_num_params[OF t1_def]
     by (auto simp: intro!: tm_sub_range assms )
 qed
 
 lemmas [simp del] = compute_tm_by_comp.simps
 
 lemma compute_tm_by_comp_num_params_le:
   assumes "compute_tm_by_comp prec ord I a f (Some t0) i = Some t"
   assumes "1 \<le> X" "num_params (tm_poly t0) \<le> X"
   shows "num_params (tm_poly t) \<le> X"
   using assms
   by (auto simp: compute_tm_by_comp.simps Let_def intro!: num_params_tm_comp_le
       dest!: tm_floatarith_eq_Some_num_params
       split: option.splits if_splits)
 
 lemma compute_tm_by_comp_eq_Some_iff: "compute_tm_by_comp prec ord I a f t0 i = Some t \<longleftrightarrow>
   (\<exists>z x2. t0 = Some x2 \<and>
     tm_floatarith prec ord [compute_bound_tm prec I a x2]
       [mid (compute_bound_tm prec a a x2)] f =
       Some z
    \<and> tm_comp prec ord I a
       (mid (compute_bound_tm prec a a x2)) z x2 = t
    \<and> i (compute_bound_tm prec I a x2))"
   by (auto simp: compute_tm_by_comp.simps Let_def split: option.splits)
 
 lemma num_params_approx_tm:
   assumes "approx_tm prec ord I a f env = Some t"
   assumes "\<And>tm. tm \<in> set env \<Longrightarrow> num_params (tm_poly tm) \<le> length I"
   shows "num_params (tm_poly t) \<le> length I"
   using assms
 proof (induction f arbitrary: t)
   case (Add f1 f2)
   then show ?case by (auto split: option.splits intro!: num_params_tm_add_le)
 next
   case (Minus f)
   then show ?case by (auto split: option.splits)
 next
   case (Mult f1 f2)
   then show ?case by (auto split: option.splits intro!: num_params_tm_mul_le)
 next
   case (Inverse f)
   then show ?case
     by (auto split: option.splits simp: Let_def compute_tm_by_comp_eq_Some_iff
         intro!: num_params_tm_comp_le dest!: tm_floatarith_eq_Some_num_params)
 next
   case (Cos f)
   then show ?case
     by (auto split: option.splits simp: Let_def compute_tm_by_comp_eq_Some_iff
         intro!: num_params_tm_comp_le dest!: tm_floatarith_eq_Some_num_params)
 next
   case (Arctan f)
   then show ?case
     by (auto split: option.splits simp: Let_def compute_tm_by_comp_eq_Some_iff
         intro!: num_params_tm_comp_le dest!: tm_floatarith_eq_Some_num_params)
 next
   case (Abs f)
   then show ?case
     by (auto simp: tm_abs.simps Let_def intro!: num_params_tm_union_le)
 next
   case (Max f1 f2)
   then show ?case
     by (auto simp: tm_max.simps Let_def intro!: num_params_tm_union_le split: option.splits)
 next
   case (Min f1 f2)
   then show ?case
     by (auto simp: tm_min.simps Let_def intro!: num_params_tm_union_le split: option.splits)
 next
   case Pi
   then show ?case
     by (auto )
 next
   case (Sqrt f)
   then show ?case
     by (auto split: option.splits simp: Let_def compute_tm_by_comp_eq_Some_iff
         intro!: num_params_tm_comp_le dest!: tm_floatarith_eq_Some_num_params)
 next
   case (Exp f)
   then show ?case
     by (auto split: option.splits simp: Let_def compute_tm_by_comp_eq_Some_iff
         intro!: num_params_tm_comp_le dest!: tm_floatarith_eq_Some_num_params)
 next
   case (Powr f1 f2)
   then show ?case
     by (auto split: option.splits simp: Let_def compute_tm_by_comp_eq_Some_iff
         intro!: num_params_tm_comp_le dest!: tm_floatarith_eq_Some_num_params)
 next
   case (Ln f)
   then show ?case
     by (auto split: option.splits simp: Let_def compute_tm_by_comp_eq_Some_iff
         intro!: num_params_tm_comp_le dest!: tm_floatarith_eq_Some_num_params)
 next
 case (Power f x2a)
   then show ?case
     by (auto split: option.splits simp: Let_def compute_tm_by_comp_eq_Some_iff
         intro!: num_params_tm_pow_le dest!: tm_floatarith_eq_Some_num_params)
 next
   case (Floor f)
   then show ?case
     by (auto split: option.splits simp: Let_def compute_tm_by_comp_eq_Some_iff
         intro!: num_params_tm_comp_le dest!: tm_floatarith_eq_Some_num_params)
 next
   case (Var x)
   then show ?case by (auto split: if_splits)
 next
   case (Num x)
   then show ?case by auto
 qed
 
 lemma in_interval_realI: "a \<in>\<^sub>i I" if "a \<in>\<^sub>r I" using that by (auto simp: set_of_eq)
 
 lemma all_subset_all_inI: "map interval_of a all_subset I" if "a all_in I"
   using that by (auto simp: in_interval_realI)
 
 lemma compute_tm_by_comp_None: "compute_tm_by_comp p ord I a x None k = None"
   by (rule ccontr) (auto simp: compute_tm_by_comp_eq_Some_iff)
 
 lemma approx_tm_num_Vars_None:
   assumes "max_Var_floatarith f > length env"
   shows "approx_tm p ord I a f env = None"
   using assms
   by (induction f) (auto split: option.splits if_splits simp: max_def compute_tm_by_comp_None)
 
 lemma approx_tm_num_Vars:
   assumes "approx_tm prec ord I a f env = Some t"
   shows "max_Var_floatarith f \<le> length env"
   apply (rule ccontr)
   using approx_tm_num_Vars_None[of env f prec ord I a] assms
   by auto
 
 definition "range_tms e xs = map (range_tm e) xs"
 
 lemma approx_tm_range:
   assumes a: "a all_subset I"
   assumes t_def: "approx_tm prec ord I a f env = Some t"
   assumes allin: "xs all_in\<^sub>i range_tms e env"
   assumes devs: "develops_at_within e a I"
   assumes env: "\<And>tm. tm \<in> set env \<Longrightarrow> num_params (tm_poly tm) \<le> length I"
   shows "interpret_floatarith f xs \<in>\<^sub>i range_tm e t"
   using t_def
 proof(induct f arbitrary: t)
   case (Var n)
   thus ?case
     using assms(2) allin approx_tm_num_Vars[of prec ord I a "Var n" env t]
       by (auto simp: all_in_i_def range_tms_def)
 next
   case (Num c)
   thus ?case 
     using assms(2) by (auto simp add: assms(3))
 next
   case (Add l r t)
   obtain t1 where t1_def: "approx_tm prec ord I a l env = Some t1"
     by (metis (no_types, lifting) Add(3) approx_tm.simps(3) option.case_eq_if option.collapse prod.case)
   obtain t2 where t2_def: "approx_tm prec ord I a r env = Some t2"
     by (smt Add(3) approx_tm.simps(3) option.case_eq_if option.collapse prod.case)
   have t_def: "t = tm_add t1 t2"
     using Add(3) t1_def t2_def
     by (metis approx_tm.simps(3) option.case(2) option.inject prod.case)
 
   have [simp]: "interpret_floatarith (floatarith.Add l r) = interpret_floatarith l + interpret_floatarith r"
     by auto
   show ?case
     using Add
     by (auto simp: t_def intro!: tm_add_range Add t1_def t2_def)
 next
   case (Minus f t)
   have [simp]: "interpret_floatarith (Minus f) = -interpret_floatarith f"
     by auto
 
   obtain t1 where t1_def: "approx_tm prec ord I a f env = Some t1"
     by (metis Minus.prems(1) approx_tm.simps(4) map_option_eq_Some)
   have t_def: "t = tm_neg t1"
     by (metis Minus.prems(1) approx_tm.simps(4) option.inject option.simps(9) t1_def)
 
   show ?case
     by (auto simp: t_def intro!: tm_neg_range t1_def Minus)
 next
   case (Mult l r t)
   obtain t1 where t1_def: "approx_tm prec ord I a l env = Some t1"
     by (metis (no_types, lifting) Mult(3) approx_tm.simps(5) option.case_eq_if option.collapse prod.case)
   obtain t2 where t2_def: "approx_tm prec ord I a r env = Some t2"
     by (smt Mult(3) approx_tm.simps(5) option.case_eq_if option.collapse prod.case)
   have t_def: "t = tm_mul prec ord I a t1 t2"
     using Mult(3) t1_def t2_def
     by (metis approx_tm.simps(5) option.case(2) option.inject prod.case)
 
   have [simp]: "interpret_floatarith (floatarith.Mult l r) = interpret_floatarith l * interpret_floatarith r"
     by auto
   show ?case
     using env Mult
     by (auto simp add: t_def intro!: tm_mul_range Mult t1_def t2_def devs
         num_params_approx_tm[OF t1_def] num_params_approx_tm[OF t2_def])
 next
   case (Power f k t)
   from Power(2)
   obtain tm_f where tm_f_def: "approx_tm prec ord I a f env = Some tm_f"
     apply(simp) by metis
   have t_decomp: "t = tm_pow prec ord I a tm_f k"
     using Power(2) by (simp add: tm_f_def)
   show ?case
     using env Power
     by (auto simp add: t_def tm_f_def intro!: tm_pow_range Power  devs
         num_params_approx_tm[OF tm_f_def])
 next
   case (Inverse f t)
   from Inverse obtain tf where tf_def: "approx_tm prec ord I a f env = Some tf"
     by (auto simp: compute_tm_by_comp_eq_Some_iff)
   have safe: "\<And>x. x \<in>\<^sub>r (compute_bound_tm prec I a tf) \<Longrightarrow>
           0 < lower (compute_bound_tm prec I a tf) \<or> upper (compute_bound_tm prec I a tf) < 0 \<Longrightarrow>
           isDERIV 0 (Inverse (Var 0)) [x]"
     by (simp add: set_of_eq , safe, simp_all)
   have np: "num_params (tm_poly tf) \<le> length I"
     using tf_def
     apply (rule num_params_approx_tm)
     using assms by auto
   from compute_tm_by_comp_range[OF _ a
       Inverse(1)[OF tf_def]
       Inverse(2)[unfolded approx_tm.simps tf_def]
       safe np devs]
   show ?case by simp
 next
   case hyps: (Cos f t)
   from hyps obtain tf where tf_def: "approx_tm prec ord I a f env = Some tf"
     by (auto simp: compute_tm_by_comp_eq_Some_iff)
   have np: "num_params (tm_poly tf) \<le> length I"
     using tf_def
     apply (rule num_params_approx_tm)
     using assms by auto
   from compute_tm_by_comp_range[OF _ a
       hyps(1)[OF tf_def]
       hyps(2)[unfolded approx_tm.simps tf_def]
       _ np devs]
   show ?case by simp
 next
   case hyps: (Arctan f t)
   from hyps obtain tf where tf_def: "approx_tm prec ord I a f env = Some tf"
     by (auto simp: compute_tm_by_comp_eq_Some_iff)
   have np: "num_params (tm_poly tf) \<le> length I"
     using tf_def
     apply (rule num_params_approx_tm)
     using assms by auto
   from compute_tm_by_comp_range[OF _ a
       hyps(1)[OF tf_def]
       hyps(2)[unfolded approx_tm.simps tf_def]
       _ np devs]
   show ?case by simp
 next
   case hyps: (Exp f t)
   from hyps obtain tf where tf_def: "approx_tm prec ord I a f env = Some tf"
     by (auto simp: compute_tm_by_comp_eq_Some_iff)
   have np: "num_params (tm_poly tf) \<le> length I"
     using tf_def
     apply (rule num_params_approx_tm)
     using assms by auto
   from compute_tm_by_comp_range[OF _ a
       hyps(1)[OF tf_def]
       hyps(2)[unfolded approx_tm.simps tf_def]
       _ np devs]
   show ?case by simp
 next
   case hyps: (Ln f t)
   from hyps obtain tf where tf_def: "approx_tm prec ord I a f env = Some tf"
     by (auto simp: compute_tm_by_comp_eq_Some_iff)
   have safe: "\<And>x. x \<in>\<^sub>r compute_bound_tm prec I a tf \<Longrightarrow>
         0 < lower (compute_bound_tm prec I a tf) \<Longrightarrow> isDERIV 0 (Ln (Var 0)) [x]"
     by (auto simp: set_of_eq)
   have np: "num_params (tm_poly tf) \<le> length I"
     using tf_def
     apply (rule num_params_approx_tm)
     using assms by auto
   from compute_tm_by_comp_range[OF _ a
       hyps(1)[OF tf_def]
       hyps(2)[unfolded approx_tm.simps tf_def]
       safe np devs]
   show ?case by simp
 next
   case hyps: (Sqrt f t)
   from hyps obtain tf where tf_def: "approx_tm prec ord I a f env = Some tf"
     by (auto simp: compute_tm_by_comp_eq_Some_iff)
   have safe: "\<And>x. x \<in>\<^sub>r compute_bound_tm prec I a tf \<Longrightarrow>
         0 < lower (compute_bound_tm prec I a tf) \<Longrightarrow> isDERIV 0 (Sqrt (Var 0)) [x]"
     by (auto simp: set_of_eq)
   have np: "num_params (tm_poly tf) \<le> length I"
     using tf_def
     apply (rule num_params_approx_tm)
     using assms by auto
   from compute_tm_by_comp_range[OF _ a
       hyps(1)[OF tf_def]
       hyps(2)[unfolded approx_tm.simps tf_def]
       safe np devs]
   show ?case by simp
 next
   case (Pi t)
   hence "t = tm_pi prec" by simp
   then show ?case
     by (auto intro!: range_tm_tm_pi)
 next
   case (Abs f t)
   from Abs(2) obtain tf where tf_def: "approx_tm prec ord I a f env = Some tf"
     and  t_def: "t = tm_abs prec I a tf"
     by (metis (no_types, lifting) approx_tm.simps(14) map_option_eq_Some)
   have np: "num_params (tm_poly tf) \<le> length I"
     using tf_def
     apply (rule num_params_approx_tm)
     using assms by auto
   from tm_abs_range[OF Abs(1)[OF tf_def] np devs]
   show ?case
     unfolding t_def interpret_floatarith.simps(9) comp_def
     by assumption
 next
   case hyps: (Min l r t)
   from hyps(3)
   obtain t1 t2 where t_decomp: "t = tm_min prec I a t1 t2"
     and t1_def: "Some t1 = approx_tm prec ord I a l env"
     and t2_def: "approx_tm prec ord I a r env = Some t2"
     by (smt approx_tm.simps(15) option.case_eq_if option.collapse option.distinct(2) option.inject split_conv)
   from this(2,3) hyps(1-3)
   have t1_range: "(interpret_floatarith l xs) \<in>\<^sub>i range_tm e t1"
     and  t2_range: "(interpret_floatarith r xs) \<in>\<^sub>i range_tm e t2"
     by auto
 
   have [simp]: "interpret_floatarith (floatarith.Min l r) = (\<lambda>vs. min (interpret_floatarith l vs) (interpret_floatarith r vs))"
     by auto
   have np1: "num_params (tm_poly t1) \<le> length I"
     using t1_def[symmetric]
     apply (rule num_params_approx_tm)
     using assms by auto
   have np2: "num_params (tm_poly t2) \<le> length I"
     using t2_def
     apply (rule num_params_approx_tm)
     using assms by auto
   show ?case
     unfolding t_decomp(1)
     apply(simp del: tm_min.simps)
     using t1_range t2_range np1 np2
     by (auto intro!: tm_min_range devs)
 next
   case hyps: (Max l r t)
   from hyps(3)
   obtain t1 t2 where t_decomp: "t = tm_max prec I a t1 t2"
     and t1_def: "Some t1 = approx_tm prec ord I a l env"
     and t2_def: "approx_tm prec ord I a r env = Some t2"
     by (smt approx_tm.simps(16) option.case_eq_if option.collapse option.distinct(2) option.inject split_conv)
   from this(2,3) hyps(1-3)
   have t1_range: "(interpret_floatarith l xs) \<in>\<^sub>i range_tm e t1"
     and  t2_range: "(interpret_floatarith r xs) \<in>\<^sub>i range_tm e t2"
     by auto
 
   have [simp]: "interpret_floatarith (floatarith.Min l r) = (\<lambda>vs. min (interpret_floatarith l vs) (interpret_floatarith r vs))"
     by auto
   have np1: "num_params (tm_poly t1) \<le> length I"
     using t1_def[symmetric]
     apply (rule num_params_approx_tm)
     using assms by auto
   have np2: "num_params (tm_poly t2) \<le> length I"
     using t2_def
     apply (rule num_params_approx_tm)
     using assms by auto
   show ?case
     unfolding t_decomp(1)
     apply(simp del: tm_min.simps)
     using t1_range t2_range np1 np2
     by (auto intro!: tm_max_range devs)
 qed simp_all
 
 
 text \<open>Evaluate expression with Taylor models in environment.\<close>
 
 subsection \<open>Computing bounds for floatarith expressions\<close>
 
 text \<open>TODO: compare parametrization of input vs. uncertainty for input...\<close>
 
 definition "tm_of_ivl_par n ivl = TaylorModel (CN (C ((upper ivl + lower ivl)*Float 1 (-1))) n
   (C ((upper ivl - lower ivl)*Float 1 (-1)))) 0"
   \<comment> \<open>track uncertainty in parameter \<open>n\<close>, which is to be interpreted over standardized domain \<open>[-1, 1]\<close>.\<close>
 
 value "tm_of_ivl_par 3 (Ivl (-1) 1)"
 
 definition "tms_of_ivls ivls = map (\<lambda>(i, ivl). tm_of_ivl_par i ivl) (zip [0..<length ivls] ivls)"
 
 value "tms_of_ivls [Ivl 1 2, Ivl 4 5]"
 
 primrec approx_slp'::"nat \<Rightarrow> nat \<Rightarrow> float interval list \<Rightarrow> float interval list \<Rightarrow> slp \<Rightarrow>
   taylor_model list \<Rightarrow> taylor_model list option"
 where
   "approx_slp' p ord I a [] xs = Some xs"
 | "approx_slp' p ord I a (ea # eas) xs =
     do {
       r \<leftarrow> approx_tm p ord I a ea xs;
       approx_slp' p ord I a eas (r#xs)
     }"
 
 lemma mem_range_tms_Cons_iff[simp]: "x#xs all_in\<^sub>i range_tms e (X#XS) \<longleftrightarrow> x \<in>\<^sub>i range_tm e X \<and> xs all_in\<^sub>i range_tms e XS"
   by (auto simp: range_tms_def all_in_i_def nth_Cons split: nat.splits)
 
 lemma approx_slp'_range:
   assumes i: "i all_subset I"
   assumes dev: "develops_at_within e i I"
   assumes vs: "vs all_in\<^sub>i range_tms e VS" "(\<And>tm. tm \<in> set VS \<Longrightarrow> num_params (tm_poly tm) \<le> length I)"
   assumes appr: "approx_slp' p ord I i ra VS = Some X"
   shows "interpret_slp ra vs all_in\<^sub>i range_tms e X"
   using appr vs
 proof (induction ra arbitrary: X vs VS)
   case (Cons ra ras)
   from Cons.prems
   obtain a where a: "approx_tm p ord I i ra VS = Some a"
     and r: "approx_slp' p ord I i ras (a # VS) = Some X"
     by (auto simp: bind_eq_Some_conv)
   from approx_tm_range[OF i a Cons.prems(2) dev Cons.prems(3)]
   have "interpret_floatarith ra vs \<in>\<^sub>i range_tm e a"
     by auto
   then have 1: "interpret_floatarith ra vs#vs all_in\<^sub>i range_tms e (a#VS)"
     using Cons.prems(2)
     by auto
   show ?case
     apply auto
     apply (rule Cons.IH)
       apply (rule r)
      apply (rule 1)
     apply auto
      apply (rule num_params_approx_tm)
       apply (rule a)
     by (auto intro!: Cons.prems)
 qed auto
 
 definition approx_slp::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> slp \<Rightarrow> taylor_model list \<Rightarrow> taylor_model list option"
   where
     "approx_slp p ord d slp tms =
       map_option (take d)
         (approx_slp' p ord (replicate (length tms) (Ivl (-1) 1)) (replicate (length tms) 0) slp tms)"
 
 lemma length_range_tms[simp]: "length (range_tms e VS) = length VS"
   by (auto simp: range_tms_def)
 
 lemma set_of_Ivl: "set_of (Ivl a b) = {a .. b}" if "a \<le> b"
   by (auto simp: set_of_eq that min_def)
 
 lemma set_of_zero[simp]: "set_of 0 = {0::'a::ordered_comm_monoid_add}"
   by (auto simp: set_of_eq)
 
 theorem approx_slp_range_tms:
   assumes "approx_slp p ord d slp VS = Some X"
   assumes slp_def: "slp = slp_of_fas fas"
   assumes d_def: "d = length fas"
   assumes e: "e \<in> UNIV \<rightarrow> {-1 .. 1}"
   assumes vs: "vs all_in\<^sub>i range_tms e VS"
   assumes lens: "\<And>tm. tm \<in> set VS \<Longrightarrow> num_params (tm_poly tm) \<le> length vs"
   shows "interpret_floatariths fas vs all_in\<^sub>i range_tms e X"
 proof -
   have "interpret_floatariths fas vs = take d (interpret_slp slp vs)"
     by (simp add: slp_of_fas slp_def d_def)
   also
   have lvs: "length vs = length VS"
     using assms by (auto simp: all_in_i_def)
   define i where "i = replicate (length vs) (0::float interval)"
   define I where "I = replicate (length vs) (Ivl (-1) 1::float interval)"
   from assms obtain XS where
     XS: "approx_slp' p ord I i slp VS = Some XS"
     and X: "take d XS = X"
     by (auto simp: approx_slp_def lvs i_def I_def)
   have iI: "i all_subset I"
     by (auto simp: i_def I_def set_of_Ivl)
   have dev: "develops_at_within e i I"
     using e
     by (auto simp: develops_at_within_def i_def I_def set_of_Ivl real_interval_Ivl
         real_interval_minus real_interval_zero set_of_eq Pi_iff min_def)
   from approx_slp'_range[OF iI dev vs _ XS] lens
   have "interpret_slp slp vs all_in\<^sub>i range_tms e XS" by (auto simp: I_def)
   then have "take d (interpret_slp slp vs) all_in\<^sub>i range_tms e (take d XS)"
     by (auto simp: all_in_i_def range_tms_def)
   also note \<open>take d XS = X\<close>
   finally show ?thesis .
 qed
 
 end
 
 end
\ No newline at end of file