diff --git a/thys/Auto2_HOL/HOL/Arith_Thms.thy b/thys/Auto2_HOL/HOL/Arith_Thms.thy
--- a/thys/Auto2_HOL/HOL/Arith_Thms.thy
+++ b/thys/Auto2_HOL/HOL/Arith_Thms.thy
@@ -1,252 +1,252 @@
 (*
   File: Arith_Thms.thy
   Author: Bohua Zhan
 
   Setup for proof steps related to arithmetic, mostly on natural numbers.
 *)
 
 section \<open>Setup for arithmetic\<close>
 
 theory Arith_Thms
   imports Order_Thms HOL.Binomial
 begin
 
 (* Reducing inequality on natural numbers. *)
 theorem reduce_le_plus_consts: "(x::nat) + n1 \<le> y + n2 \<Longrightarrow> x \<le> y + (n2-n1)" by simp
 theorem reduce_le_plus_consts': "n1 \<ge> n2 \<Longrightarrow> (x::nat) + n1 \<le> y + n2 \<Longrightarrow> x + (n1-n2) \<le> y" by simp
 theorem reduce_less_plus_consts: "(x::nat) + n1 < y + n2 \<Longrightarrow> x < y + (n2-n1)" by simp
 theorem reduce_less_plus_consts': "n1 \<ge> n2 \<Longrightarrow> (x::nat) + n1 < y + n2 \<Longrightarrow> x + (n1-n2) < y" by simp
 
 (* To normal form. *)
 theorem norm_less_lminus: "(x::nat) - n < y \<Longrightarrow> x \<le> y + (n-1)" by simp
 theorem norm_less_lplus:  "(x::nat) + n < y \<Longrightarrow> x + (n+1) \<le> y" by simp
 theorem norm_less_rminus: "(x::nat) < y - n \<Longrightarrow> x + (n+1) \<le> y" by simp
 theorem norm_less_rplus:  "(x::nat) < y + n \<Longrightarrow> x \<le> y + (n-1)" by simp
 theorem norm_less:        "(x::nat) < y     \<Longrightarrow> x + 1 \<le> y"     by simp
 theorem norm_le_lminus: "(x::nat) - n \<le> y \<Longrightarrow> x \<le> y + n"  by simp
 theorem norm_le_rminus: "(x::nat) \<le> y - n \<Longrightarrow> x \<le> y + 0"  by simp
 theorem norm_le: "(x::nat) \<le> y \<Longrightarrow> x \<le> y + 0" by simp
 theorem norm_le_lplus0: "(x::nat) + 0 \<le> y \<Longrightarrow> x \<le> y + 0" by simp
 
 (* Transitive resolve. *)
 theorem trans_resolve1: "n1 > 0 \<Longrightarrow> (x::nat) + n1 \<le> y \<Longrightarrow> (y::nat) + n2 \<le> x \<Longrightarrow> False" by simp
 theorem trans_resolve2: "n1 > n2 \<Longrightarrow> (x::nat) + n1 \<le> y \<Longrightarrow> (y::nat) \<le> x + n2 \<Longrightarrow> False" by simp
 
 (* Transitive. *)
 theorem trans1: "(x::nat) + n1 \<le> y \<Longrightarrow> y + n2 \<le> z \<Longrightarrow> x + (n1+n2) \<le> z" by simp
 theorem trans2: "(x::nat) \<le> y + n1 \<Longrightarrow> y \<le> z + n2 \<Longrightarrow> x \<le> z + (n1+n2)" by simp
 theorem trans3: "(x::nat) + n1 \<le> y \<Longrightarrow> y \<le> z + n2 \<Longrightarrow> x \<le> z + (n2-n1)" by simp
 theorem trans4: "n1 > n2 \<Longrightarrow> (x::nat) + n1 \<le> y \<Longrightarrow> y \<le> z + n2 \<Longrightarrow> x + (n1-n2) \<le> z" by simp
 theorem trans5: "(x::nat) \<le> y + n1 \<Longrightarrow> y + n2 \<le> z \<Longrightarrow> x \<le> z + (n1-n2)" by simp
 theorem trans6: "n2 > n1 \<Longrightarrow> (x::nat) \<le> y + n1 \<Longrightarrow> y + n2 \<le> z \<Longrightarrow> x + (n2-n1) \<le> z" by simp
 
 (* Resolve. *)
 theorem single_resolve: "n > 0 \<Longrightarrow> (x::nat) + n \<le> x \<Longrightarrow> False" by simp
 theorem single_resolve_const: "n > 0 \<Longrightarrow> (x::nat) + n \<le> 0 \<Longrightarrow> False" by simp
 
 (* Comparison with constants. *)
 theorem cv_const1: "(x::nat) + n \<le> y \<Longrightarrow> 0 + (x+n) \<le> y" by simp  (* x is const *)
 theorem cv_const2: "(x::nat) + n \<le> y \<Longrightarrow> x \<le> 0 + (y-n)" by simp  (* y is const *)
 theorem cv_const3: "y < n \<Longrightarrow> (x::nat) + n \<le> y \<Longrightarrow> x + (n-y) \<le> 0" by simp  (* y is const (contradiction with 0 \<le> x) *)
 theorem cv_const4: "(x::nat) \<le> y + n \<Longrightarrow> 0 + (x-n) \<le> y" by simp  (* x is const *)
 theorem cv_const5: "(x::nat) \<le> y + n \<Longrightarrow> 0 \<le> y + (n-x)" by simp  (* x is const (trivial) *)
 theorem cv_const6: "(x::nat) \<le> y + n \<Longrightarrow> x \<le> 0 + (y+n)" by simp  (* y is const *)
 
 (* Misc *)
 theorem nat_eq_to_ineqs: "(x::nat) = y + n \<Longrightarrow> x \<le> y + n \<and> x \<ge> y + n" by simp
 theorem nat_ineq_impl_not_eq: "(x::nat) + n \<le> y \<Longrightarrow> n > 0 \<Longrightarrow> x \<noteq> y" by simp
 theorem eq_to_ineqs: "(x::nat) \<equiv> y \<Longrightarrow> x \<le> y \<and> y \<le> x" by simp
 theorem ineq_to_eqs1: "(x::nat) \<le> y + 0 \<Longrightarrow> y \<le> x + 0 \<Longrightarrow> x = y" by simp
 
 ML_file \<open>arith.ML\<close>
 ML_file \<open>order.ML\<close>
 ML_file \<open>order_test.ML\<close>
 
 setup \<open>register_wellform_data ("(a::nat) - b", ["a \<ge> b"])\<close>
 setup \<open>add_prfstep_check_req ("(a::nat) - b", "(a::nat) \<ge> b")\<close>
 
 (* Normalize any expression to "a - b" form. *)
 lemma nat_sub_norm:
   "(a::nat) = a - 0 \<and> a \<ge> 0" by simp
 
 (* Adding and subtracting two normalized expressions. *)
 lemma nat_sub1:
   "(a::nat) \<ge> b \<Longrightarrow> c \<ge> d \<Longrightarrow> (a - b) + (c - d) = (a + c) - (b + d) \<and> a + c \<ge> b + d" by simp
 
 lemma nat_sub2:
   "(a::nat) \<ge> b \<Longrightarrow> c \<ge> d \<Longrightarrow> a - b \<ge> c - d \<Longrightarrow> (a - b) - (c - d) = (a + d) - (b + c) \<and> a + d \<ge> b + c" by simp
 
 lemma nat_sub3:
   "(a::nat) \<ge> b \<Longrightarrow> c \<ge> d \<Longrightarrow> (a - b) * (c - d) = (a * c + b * d) - (a * d + b * c) \<and> a * c + b * d \<ge> a * d + b * c"
   by (smt diff_mult_distrib mult.commute mult_le_mono1 nat_sub2)
 
 (* Cancel identical terms on two sides, yielding a normalized expression. *)
 lemma nat_sub_combine:
   "(a::nat) + b \<ge> c + b \<Longrightarrow> (a + b) - (c + b) = a - c \<and> a \<ge> c" by simp
 
 lemma nat_sub_combine2:
   "n \<ge> m \<Longrightarrow> (a::nat) + b * n \<ge> c + b * m \<Longrightarrow> (a + b * n) - (c + b * m) = (a + b * (n - m)) - c \<and> a + b * (n - m) \<ge> c \<and> n \<ge> m"
   by (simp add: add.commute right_diff_distrib')
 
 lemma nat_sub_combine3:
   "n \<le> m \<Longrightarrow> (a::nat) + b * n \<ge> c + b * m \<Longrightarrow> (a + b * n) - (c + b * m) = a - (c + b * (m - n)) \<and> a \<ge> c + b * (m - n) \<and> m \<ge> n"
   by (smt add.commute mult.commute nat_diff_add_eq2 nat_le_add_iff1)
 
 ML_file \<open>nat_sub.ML\<close>
 ML_file \<open>nat_sub_test.ML\<close>
 
 (* Ordering on Nats. *)
 lemma le_neq_implies_less' [forward]: "(m::nat) \<noteq> n \<Longrightarrow> m \<le> n \<Longrightarrow> m < n" by simp
 lemma le_zero_to_equal_zero [forward]: "(n::nat) \<le> 0 \<Longrightarrow> n = 0" by simp
 lemma less_one_to_equal_zero [forward]: "(n::nat) < 1 \<Longrightarrow> n = 0" by simp
 setup \<open>add_backward_prfstep_cond @{thm Nat.mult_le_mono1} [with_cond "?k \<noteq> 1"]\<close>
 setup \<open>add_resolve_prfstep @{thm Nat.not_add_less1}\<close>
 lemma not_minus_less [resolve]: "\<not>(i::nat) < (i - j)" by simp
 lemma nat_le_prod_with_same [backward]: "m \<noteq> 0 \<Longrightarrow> (n::nat) \<le> m * n" by simp
 lemma nat_le_prod_with_le [backward1]: "k \<noteq> 0 \<Longrightarrow> (n::nat) \<le> m \<Longrightarrow> (n::nat) \<le> k * m"
   using le_trans nat_le_prod_with_same by blast
 lemma nat_plus_le_to_less [backward1]: "b \<noteq> 0 \<Longrightarrow> (a::nat) + b \<le> c \<Longrightarrow> a < c" by simp
 lemma nat_plus_le_to_less2 [backward1]: "a \<noteq> 0 \<Longrightarrow> (a::nat) + b \<le> c \<Longrightarrow> b < c" by simp
 setup \<open>add_forward_prfstep @{thm add_right_imp_eq}\<close>
 setup \<open>add_forward_prfstep @{thm add_left_imp_eq}\<close>
 
-setup \<open>add_rewrite_rule_cond @{thm Nat.le_diff_conv2} [with_term "?i + ?k"]\<close>
+setup \<open>add_rewrite_rule_cond @{thm le_diff_conv2} [with_term "?i + ?k"]\<close>
 lemma nat_less_diff_conv: "(i::nat) < j - k \<Longrightarrow> i + k < j" by simp
 setup \<open>add_forward_prfstep_cond @{thm nat_less_diff_conv} [with_cond "?k \<noteq> ?NUMC", with_term "?i + ?k"]\<close>
 lemma Nat_le_diff_conv2_same [forward]: "i \<ge> j \<Longrightarrow> (i::nat) \<le> i - j \<Longrightarrow> j = 0" by simp
 lemma nat_gt_zero [forward]: "b - a > 0 \<Longrightarrow> b > (a::nat)" by simp
 lemma n_minus_1_less_n: "(n::nat) \<ge> 1 \<Longrightarrow> n - 1 < n" by simp
 setup \<open>add_forward_prfstep_cond @{thm n_minus_1_less_n} [with_term "?n - 1"]\<close>
   
 (* Monotonicity of ordering *)
 setup \<open>add_backward_prfstep @{thm Nat.diff_le_mono}\<close>
 setup \<open>add_backward2_prfstep @{thm Nat.diff_less_mono}\<close>
 setup \<open>add_backward_prfstep @{thm Nat.mult_le_mono2}\<close>
 setup \<open>add_resolve_prfstep @{thm Nat.le_add1}\<close>
 setup \<open>add_resolve_prfstep @{thm Nat.le_add2}\<close>
 setup \<open>add_backward_prfstep @{thm add_left_mono}\<close>
 setup \<open>add_backward_prfstep @{thm add_right_mono}\<close>
 lemma add_mono_neutr [backward]: "(0::'a::linordered_ring) \<le> b \<Longrightarrow> a \<le> a + b" by simp
 lemma add_mono_neutl [backward]: "(0::'a::linordered_ring) \<le> b \<Longrightarrow> a \<le> b + a" by simp
 setup \<open>add_forward_prfstep @{thm add_less_imp_less_left}\<close>
 lemma sum_le_zero1 [forward]: "(a::'a::linordered_ring) + b < 0 \<Longrightarrow> a \<ge> 0 \<Longrightarrow> b < 0" by (meson add_less_same_cancel1 less_le_trans)
 lemma less_sum1 [backward]: "b > 0 \<Longrightarrow> a < a + (b::nat)" by auto
 setup \<open>add_backward_prfstep @{thm Nat.trans_less_add2}\<close>
 setup \<open>add_backward_prfstep @{thm Nat.add_less_mono1}\<close>
 setup \<open>add_backward1_prfstep @{thm Nat.add_less_mono}\<close>
 setup \<open>add_backward1_prfstep @{thm Nat.add_le_mono}\<close>
 setup \<open>add_backward1_prfstep @{thm add_increasing2}\<close>
 setup \<open>add_backward1_prfstep @{thm add_mono}\<close>
 setup \<open>add_backward_prfstep @{thm add_strict_left_mono}\<close>
 setup \<open>add_backward1_prfstep @{thm Nat.mult_le_mono}\<close>
 
 (* Addition. *)
 theorem nat_add_eq_self_zero [forward]: "(m::nat) = m + n \<Longrightarrow> n = 0" by simp
 theorem nat_add_eq_self_zero' [forward]: "(m::nat) = n + m \<Longrightarrow> n = 0" by simp
 theorem nat_mult_2: "(a::nat) + a = 2 * a" by simp
 setup \<open>add_rewrite_rule_cond @{thm nat_mult_2} [with_cond "?a \<noteq> 0"]\<close>
 theorem plus_one_non_zero [resolve]: "\<not>(n::nat) + 1 = 0" by simp
 
 (* Diff. *)
 lemma nat_same_minus_ge [forward]: "(c::nat) - a \<ge> c - b \<Longrightarrow> a \<le> c \<Longrightarrow> a \<le> b" by arith
 lemma diff_eq_zero [forward]: "(k::nat) \<le> j \<Longrightarrow> j - k = 0 \<Longrightarrow> j = k" by simp
 lemma diff_eq_zero' [forward]: "(k::nat) \<le> j \<Longrightarrow> j - k + i = j \<Longrightarrow> k = i" by simp
 
 (* Divides. *)
 theorem dvd_defD1 [resolve]: "(a::nat) dvd b \<Longrightarrow> \<exists>k. b = a * k" using dvdE by blast
 theorem dvd_defD2 [resolve]: "(a::nat) dvd b \<Longrightarrow> \<exists>k. b = k * a" by (metis dvd_mult_div_cancel mult.commute)
 setup \<open>add_forward_prfstep @{thm Nat.dvd_imp_le}\<close>
 theorem dvd_ineq2 [forward]: "(k::nat) dvd n \<Longrightarrow> n > 0 \<Longrightarrow> k \<ge> 1" by (simp add: Suc_leI dvd_pos_nat)
 
 setup \<open>add_forward_prfstep_cond @{thm dvd_trans} (with_conds ["?a \<noteq> ?b", "?b \<noteq> ?c", "?a \<noteq> ?c"])\<close>
 setup \<open>add_forward_prfstep_cond @{thm Nat.dvd_antisym} [with_cond "?m \<noteq> ?n"]\<close>
 theorem dvd_cancel [backward1]: "c > 0 \<Longrightarrow> (a::nat) * c dvd b * c \<Longrightarrow> a dvd b" by simp
 setup \<open>add_forward_prfstep (equiv_forward_th @{thm dvd_add_right_iff})\<close>
 
 (* Divisibility: existence. *)
 setup \<open>add_resolve_prfstep @{thm dvd_refl}\<close>
 theorem exists_n_dvd_n [backward]: "P (n::nat) \<Longrightarrow> \<exists>k. k dvd n \<and> P k" using dvd_refl by blast
 setup \<open>add_resolve_prfstep @{thm one_dvd}\<close>
 
 theorem any_n_dvd_0 [forward]: "\<not> (\<exists> k. k dvd (0::nat) \<and> P k) \<Longrightarrow> \<not> (\<exists> k. P k)" by simp
 
 theorem n_dvd_one: "(n::nat) dvd 1 \<Longrightarrow> n = 1" by simp
 setup \<open>add_forward_prfstep_cond @{thm n_dvd_one} [with_cond "?n \<noteq> 1"]\<close>
 
 (* Products. *)
 setup \<open>add_rewrite_rule @{thm mult_zero_left}\<close>
 lemma prod_ineqs1 [forward]: "(m::nat) * k > 0 \<Longrightarrow> m > 0 \<and> k > 0" by simp
 lemma prod_ineqs2 [backward]: "(k::nat) > 0 \<Longrightarrow> m \<le> m * k" by simp
 
 theorem prod_cancel: "(a::nat) * b = a * c \<Longrightarrow> a > 0 \<Longrightarrow> b = c" by auto
 setup \<open>add_forward_prfstep_cond @{thm prod_cancel} [with_cond "?b \<noteq> ?c"]\<close>
 
 theorem mult_n1n: "(n::nat) = m * n \<Longrightarrow> n > 0 \<Longrightarrow> m = 1" by auto
 setup \<open>add_forward_prfstep_cond @{thm mult_n1n} [with_cond "?m \<noteq> 1"]\<close>
 
 theorem prod_is_one [forward]: "(x::nat) * y = 1 \<Longrightarrow> x = 1" by simp
 
 theorem prod_dvd_intro [backward]: "(k::nat) dvd m \<or> k dvd n \<Longrightarrow> k dvd m * n"
   using dvd_mult dvd_mult2 by blast
 
 (* Definition of gcd. *)
 setup \<open>add_forward_prfstep_cond @{thm gcd_dvd1} [with_term "gcd ?a ?b"]\<close>
 setup \<open>add_forward_prfstep_cond @{thm gcd_dvd2} [with_term "gcd ?a ?b"]\<close>
 
 (* Coprimality. *)
 setup \<open>add_rewrite_rule_bidir @{thm coprime_iff_gcd_eq_1}\<close>
 lemma coprime_exp [backward]: "coprime d a \<Longrightarrow> coprime (d::nat) (a ^ n)" by simp
 setup \<open>add_backward_prfstep @{thm coprime_exp}\<close>
 setup \<open>add_rewrite_rule @{thm gcd.commute}\<close>
 lemma coprime_dvd_mult [backward1]: "coprime (a::nat) b \<Longrightarrow> a dvd c * b \<Longrightarrow> a dvd c"
   by (metis coprime_dvd_mult_left_iff)
 lemma coprime_dvd_mult' [backward1]: "coprime (a::nat) b \<Longrightarrow> a dvd b * c \<Longrightarrow> a dvd c"
   by (metis coprime_dvd_mult_right_iff)
 
 theorem coprime_dvd [forward]:
   "coprime (a::nat) b \<Longrightarrow> p dvd a \<Longrightarrow> p > 1 \<Longrightarrow> \<not> p dvd b"
   using coprime_common_divisor_nat by blast
 
 (* Powers. *)
 setup \<open>add_rewrite_rule @{thm power_0}\<close>
 theorem power_ge_0 [rewrite]: "m \<noteq> 0 \<Longrightarrow> p ^ m = p * (p ^ (m - 1))" by (simp add: power_eq_if)
 setup \<open>add_rewrite_rule_cond @{thm power_one} [with_cond "?n \<noteq> 0"]\<close>
 setup \<open>add_rewrite_rule_cond @{thm power_one_right} [with_cond "?a \<noteq> 1"]\<close>
 setup \<open>add_gen_prfstep ("power_case_intro",
   [WithTerm @{term_pat "?p ^ (?FREE::nat)"}, CreateCase @{term_pat "(?FREE::nat) = 0"}])\<close>
 
 lemma one_is_power_of_any [resolve]: "\<exists>i. (1::nat) = a ^ i" by (metis power.simps(1))
 
 setup \<open>add_rewrite_rule @{thm power_Suc}\<close>
 
 theorem power_dvd [forward]: "(p::nat)^n dvd a \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> p dvd a" using dvd_power dvd_trans by blast
 
 theorem power_eq_one: "(b::nat) ^ n = 1 \<Longrightarrow> b = 1 \<or> n = 0"
   by (metis One_nat_def Suc_lessI nat_zero_less_power_iff power_0 power_inject_exp)
 setup \<open>add_forward_prfstep_cond @{thm power_eq_one} (with_conds ["?b \<noteq> 1", "?n \<noteq> 0"])\<close>
 
 (* Factorial. *)
 theorem fact_ge_1_nat: "fact (n::nat) \<ge> (1::nat)" by simp
 setup \<open>add_forward_prfstep_cond @{thm fact_ge_1_nat} [with_term "fact ?n"]\<close>
 setup \<open>add_backward1_prfstep @{thm dvd_fact}\<close>
 
 (* Successor function. *)
 setup \<open>add_rewrite_rule @{thm Nat.Suc_eq_plus1}\<close>
 setup \<open>add_backward_prfstep @{thm Nat.gr0_implies_Suc}\<close>
 
 (* Cases *)
 setup \<open>fold add_rewrite_rule @{thms Nat.nat.case}\<close>
 
 (* Induction. *)
 lemma nat_cases: "P 0 \<Longrightarrow> (\<And>n. P (Suc n)) \<Longrightarrow> P n" using nat_induct by auto
 
 (* div *)
 declare times_div_less_eq_dividend [resolve]
 
 setup \<open>
   add_var_induct_rule @{thm nat_induct} #>
   add_strong_induct_rule @{thm nat_less_induct} #>
   add_cases_rule @{thm nat_cases}
 \<close>
 
 end
diff --git a/thys/Gauss_Jordan/Rank.thy b/thys/Gauss_Jordan/Rank.thy
--- a/thys/Gauss_Jordan/Rank.thy
+++ b/thys/Gauss_Jordan/Rank.thy
@@ -1,46 +1,46 @@
 (*  
     Title:      Rank.thy
     Author:     Jose Divasón <jose.divasonm at unirioja.es>
     Author:     Jesús Aransay <jesus-maria.aransay at unirioja.es>
     Maintainer: Jose Divasón <jose.divasonm at unirioja.es>
 *)
 
 section\<open>Rank of a matrix\<close>
 
 theory Rank
 imports 
       Rank_Nullity_Theorem.Dim_Formula
 begin
 
 subsection\<open>Row rank, column rank and rank\<close>
 
 text\<open>Definitions of row rank, column rank and rank\<close>
 
 definition row_rank :: "'a::{field}^'n^'m=>nat"
   where "row_rank A = vec.dim (row_space A)"
 
 definition col_rank :: "'a::{field}^'n^'m=>nat"
   where "col_rank A = vec.dim (col_space A)"
 
 lemma rank_def: "rank A = row_rank A"
   by (auto simp: row_rank_def row_rank_def_gen row_space_def)
 
 subsection\<open>Properties\<close>
 
 lemma rrk_is_preserved:
 fixes A::"'a::{field}^'cols^'rows::{finite, wellorder}"
   and P::"'a::{field}^'rows::{finite, wellorder}^'rows::{finite, wellorder}"
 assumes inv_P: "invertible P"
 shows "row_rank A = row_rank (P**A)"
 by (metis row_space_is_preserved row_rank_def inv_P)
 
 lemma crk_is_preserved:
 fixes A::"'a::{field}^'cols::{finite, wellorder}^'rows"
   and P::"'a::{field}^'rows^'rows"
 assumes inv_P: "invertible P"
 shows "col_rank A = col_rank (P**A)"
   using rank_nullity_theorem_matrices unfolding ncols_def 
-  by (metis col_rank_def inv_P nat_add_left_cancel null_space_is_preserved) 
+  by (metis col_rank_def inv_P add_left_cancel null_space_is_preserved) 
 
 end
 
diff --git a/thys/List-Infinite/CommonArith/Util_Nat.thy b/thys/List-Infinite/CommonArith/Util_Nat.thy
--- a/thys/List-Infinite/CommonArith/Util_Nat.thy
+++ b/thys/List-Infinite/CommonArith/Util_Nat.thy
@@ -1,311 +1,311 @@
 (*  Title:      Util_Nat.thy
     Date:       Oct 2006
     Author:     David Trachtenherz
 *)
 
 section \<open>Results for natural arithmetics\<close>
 
 theory Util_Nat
 imports Main
 begin
 
 subsection \<open>Some convenience arithmetic lemmata\<close>
 
 lemma add_1_Suc_conv: "m + 1 = Suc m" by simp
 lemma sub_Suc0_sub_Suc_conv: "b - a - Suc 0 = b - Suc a" by simp
 
 lemma Suc_diff_Suc: "m < n \<Longrightarrow> Suc (n - Suc m) = n - m"
 apply (rule subst[OF sub_Suc0_sub_Suc_conv])
 apply (rule Suc_pred)
 apply (simp only: zero_less_diff)
 done
 
 lemma nat_grSuc0_conv: "(Suc 0 < n) = (n \<noteq> 0 \<and> n \<noteq> Suc 0)"
 by fastforce
 
 lemma nat_geSucSuc0_conv: "(Suc (Suc 0) \<le> n) = (n \<noteq> 0 \<and> n \<noteq> Suc 0)"
 by fastforce
 
 lemma nat_lessSucSuc0_conv: "(n < Suc (Suc 0)) = (n = 0 \<or> n = Suc 0)"
 by fastforce
 
 lemma nat_leSuc0_conv: "(n \<le> Suc 0) = (n = 0 \<or> n = Suc 0)"
 by fastforce
 
 lemma mult_pred: "(m - Suc 0) * n = m * n - n"
 by (simp add: diff_mult_distrib)
 
 lemma mult_pred_right: "m * (n - Suc 0) = m * n - m"
 by (simp add: diff_mult_distrib2)
 
 lemma gr_implies_gr0: "m < (n::nat) \<Longrightarrow> 0 < n" by simp
 
 corollary mult_cancel1_gr0: "
   (0::nat) < k \<Longrightarrow> (k * m = k * n) = (m = n)" by simp
 corollary mult_cancel2_gr0: "
   (0::nat) < k \<Longrightarrow> (m * k = n * k) = (m = n)" by simp
 
 corollary mult_le_cancel1_gr0: "
   (0::nat) < k \<Longrightarrow> (k * m \<le> k * n) = (m \<le> n)" by simp
 corollary mult_le_cancel2_gr0: "
   (0::nat) < k \<Longrightarrow> (m * k \<le> n * k) = (m \<le> n)" by simp
 
 lemma gr0_imp_self_le_mult1: "0 < (k::nat) \<Longrightarrow> m \<le> m * k"
 by (drule Suc_leI, drule mult_le_mono[OF order_refl], simp)
 
 lemma gr0_imp_self_le_mult2: "0 < (k::nat) \<Longrightarrow> m \<le> k * m"
 by (subst mult.commute, rule gr0_imp_self_le_mult1)
 
 lemma less_imp_Suc_mult_le: "m < n \<Longrightarrow> Suc m * k \<le> n * k"
 by (rule mult_le_mono1, simp)
 
 lemma less_imp_Suc_mult_pred_less: "\<lbrakk> m < n; 0 < k \<rbrakk> \<Longrightarrow> Suc m * k - Suc 0 < n * k"
 apply (rule Suc_le_lessD)
 apply (simp only: Suc_pred[OF nat_0_less_mult_iff[THEN iffD2, OF conjI, OF zero_less_Suc]])
 apply (rule less_imp_Suc_mult_le, assumption)
 done
 
 lemma ord_zero_less_diff: "(0 < (b::'a::ordered_ab_group_add) - a) = (a < b)"
 by (simp add: less_diff_eq)
 
 lemma ord_zero_le_diff: "(0 \<le> (b::'a::ordered_ab_group_add) - a) = (a \<le> b)"
 by (simp add: le_diff_eq)
 
 text \<open>\<open>diff_diff_right\<close> in rule format\<close>
 lemmas diff_diff_right = Nat.diff_diff_right[rule_format]
 
 
 lemma less_add1: "(0::nat) < j \<Longrightarrow> i < i + j" by simp
 lemma less_add2: "(0::nat) < j \<Longrightarrow> i < j + i" by simp
 
 lemma add_lessD2: "i + j < (k::nat) \<Longrightarrow> j < k" by simp
 
 lemma add_le_mono2: "i \<le> (j::nat) \<Longrightarrow> k + i \<le> k + j" by simp
 
 lemma add_less_mono2: "i < (j::nat) \<Longrightarrow> k + i < k + j" by simp
 
 
 lemma diff_less_self: "\<lbrakk> (0::nat) < i;  0 < j \<rbrakk> \<Longrightarrow> i - j < i" by simp
 
 lemma
   ge_less_neq_conv: "((a::'a::linorder) \<le> n) = (\<forall>x. x < a \<longrightarrow> n \<noteq> x)" and
   le_greater_neq_conv: "(n \<le> (a::'a::linorder)) = (\<forall>x. a < x \<longrightarrow> n \<noteq> x)"
 by (subst linorder_not_less[symmetric], blast)+
 lemma
   greater_le_neq_conv: "((a::'a::linorder) < n) = (\<forall>x. x \<le> a \<longrightarrow> n \<noteq> x)" and
   less_ge_neq_conv: "(n < (a::'a::linorder)) = (\<forall>x. a \<le> x \<longrightarrow> n \<noteq> x)"
 by (subst linorder_not_le[symmetric], blast)+
 
 
 
 text \<open>Lemmas for @term{abs} function\<close>
 
 lemma leq_pos_imp_abs_leq: "\<lbrakk> 0 \<le> (a::'a::ordered_ab_group_add_abs); a \<le> b \<rbrakk> \<Longrightarrow> \<bar>a\<bar> \<le> \<bar>b\<bar>"
 by simp
 lemma leq_neg_imp_abs_geq: "\<lbrakk> (a::'a::ordered_ab_group_add_abs) \<le> 0; b \<le> a \<rbrakk> \<Longrightarrow> \<bar>a\<bar> \<le> \<bar>b\<bar>"
 by simp
 lemma abs_range: "\<lbrakk> 0 \<le> (a::'a::{ordered_ab_group_add_abs,abs_if}); -a \<le> x; x \<le> a \<rbrakk> \<Longrightarrow> \<bar>x\<bar> \<le> a"
 apply (clarsimp simp: abs_if)
 apply (rule neg_le_iff_le[THEN iffD1], simp)
 done
 
 
 
 text \<open>Lemmas for @term{sgn} function\<close>
 
 lemma sgn_abs:"(x::'a::linordered_idom) \<noteq> 0 \<Longrightarrow> \<bar>sgn x\<bar> = 1"
 by (case_tac "x < 0", simp+)
 lemma sgn_mult_abs:"\<bar>x\<bar> * \<bar>sgn (a::'a::linordered_idom)\<bar> = \<bar>x * sgn a\<bar>"
 by (fastforce simp add: sgn_if abs_if)
 lemma abs_imp_sgn_abs: "\<bar>a\<bar> = \<bar>b\<bar> \<Longrightarrow> \<bar>sgn (a::'a::linordered_idom)\<bar> = \<bar>sgn b\<bar>"
 by (fastforce simp add: abs_if)
 lemma sgn_mono: "a \<le> b \<Longrightarrow> sgn (a::'a::{linordered_idom,linordered_semidom}) \<le> sgn b"
 by (auto simp add: sgn_if)
 
 
 subsection \<open>Additional facts about inequalities\<close>
 
 lemma add_diff_le: "k \<le> n \<Longrightarrow> m + k - n \<le> (m::nat)"
 by (case_tac "m + k < n", simp_all)
 
 lemma less_add_diff: "k < (n::nat) \<Longrightarrow> m < n + m - k"
 
 by (rule add_less_imp_less_right[of _ k], simp)
 
 lemma add_diff_less: "\<lbrakk> k < n; 0 < m \<rbrakk> \<Longrightarrow> m + k - n < (m::nat)"
 by (case_tac "m + k < n", simp_all)
 
 
 lemma add_le_imp_le_diff1: "i + k \<le> j \<Longrightarrow> i \<le> j - (k::nat)"
 by (case_tac "k \<le> j", simp_all)
 
 lemma add_le_imp_le_diff2: "k + i \<le> j \<Longrightarrow> i \<le> j - (k::nat)" by simp
 
 lemma diff_less_imp_less_add: "j - (k::nat) < i \<Longrightarrow> j < i + k" by simp
 
 lemma diff_less_conv: "0 < i \<Longrightarrow> (j - (k::nat) < i) = (j < i + k)"
 by (safe, simp_all)
 
 lemma le_diff_swap: "\<lbrakk> i \<le> (k::nat); j \<le> k \<rbrakk> \<Longrightarrow> (k - j \<le> i) = (k - i \<le> j)"
 by (safe, simp_all)
 
 lemma diff_less_imp_swap: "\<lbrakk> 0 < (i::nat); k - i < j \<rbrakk> \<Longrightarrow> (k - j < i)" by simp
 lemma diff_less_swap: "\<lbrakk> 0 < (i::nat); 0 < j \<rbrakk> \<Longrightarrow> (k - j < i) = (k - i < j)"
 by (blast intro: diff_less_imp_swap)
 
 lemma less_diff_imp_less: "(i::nat) < j - m \<Longrightarrow> i < j" by simp
 lemma le_diff_imp_le: "(i::nat) \<le> j - m \<Longrightarrow> i \<le> j" by simp
 
 lemma less_diff_le_imp_less: "\<lbrakk> (i::nat) < j - m; n \<le> m \<rbrakk> \<Longrightarrow> i < j - n" by simp
 lemma le_diff_le_imp_le: "\<lbrakk> (i::nat) \<le> j - m; n \<le> m \<rbrakk> \<Longrightarrow> i \<le> j - n" by simp
 
 lemma le_imp_diff_le: "(j::nat) \<le> k \<Longrightarrow> j - n \<le> k" by simp
 
 
 subsection \<open>Inequalities for Suc and pred\<close>
 
 corollary less_eq_le_pred: "0 < (n::nat) \<Longrightarrow> (m < n) = (m \<le> n - Suc 0)"
 by (safe, simp_all)
 
 corollary less_imp_le_pred: "m < n \<Longrightarrow> m \<le> n - Suc 0" by simp
 corollary le_pred_imp_less: "\<lbrakk> 0 < n; m \<le> n - Suc 0 \<rbrakk> \<Longrightarrow> m < n" by simp
 
 corollary pred_less_eq_le: "0 < m \<Longrightarrow> (m - Suc 0 < n) = (m \<le> n)"
 by (safe, simp_all)
 corollary pred_less_imp_le: "m - Suc 0 < n \<Longrightarrow> m \<le> n" by simp
 corollary le_imp_pred_less: "\<lbrakk> 0 < m; m \<le> n \<rbrakk> \<Longrightarrow> m - Suc 0 < n" by simp
 
 lemma diff_add_inverse_Suc: "n < m \<Longrightarrow> n + (m - Suc n) = m - Suc 0" by simp
 
 lemma pred_mono: "\<lbrakk> m < n; 0 < m \<rbrakk> \<Longrightarrow> m - Suc 0 < n - Suc 0" by simp
 corollary pred_Suc_mono: "\<lbrakk> m < Suc n; 0 < m \<rbrakk> \<Longrightarrow> m - Suc 0 < n" by simp
 
 lemma Suc_less_pred_conv: "(Suc m < n) = (m < n - Suc 0)" by (safe, simp_all)
 lemma Suc_le_pred_conv: "0 < n \<Longrightarrow> (Suc m \<le> n) = (m \<le> n - Suc 0)" by (safe, simp_all)
 lemma Suc_le_imp_le_pred: "Suc m \<le> n \<Longrightarrow> m \<le> n - Suc 0" by simp
 
 
 subsection \<open>Additional facts about cancellation in (in-)equalities\<close>
 
 lemma diff_cancel_imp_eq: "\<lbrakk> 0 < (n::nat);  n + i - j = n \<rbrakk> \<Longrightarrow> i = j" by simp
 
 lemma nat_diff_left_cancel_less: "k - m < k - (n::nat) \<Longrightarrow> n < m" by simp
 lemma nat_diff_right_cancel_less: "n - k < (m::nat) - k \<Longrightarrow> n < m" by simp
 
 lemma nat_diff_left_cancel_le1: "\<lbrakk> k - m \<le> k - (n::nat); m < k \<rbrakk> \<Longrightarrow> n \<le> m" by simp
 lemma nat_diff_left_cancel_le2: "\<lbrakk> k - m \<le> k - (n::nat); n \<le> k \<rbrakk> \<Longrightarrow> n \<le> m" by simp
 
 lemma nat_diff_right_cancel_le1: "\<lbrakk> m - k \<le> n - (k::nat); k < m \<rbrakk> \<Longrightarrow> m \<le> n" by simp
 lemma nat_diff_right_cancel_le2: "\<lbrakk> m - k \<le> n - (k::nat); k \<le> n \<rbrakk> \<Longrightarrow> m \<le> n" by simp
 
 lemma nat_diff_left_cancel_eq1: "\<lbrakk> k - m = k - (n::nat); m < k \<rbrakk> \<Longrightarrow> m = n" by simp
 lemma nat_diff_left_cancel_eq2: "\<lbrakk> k - m = k - (n::nat); n < k \<rbrakk> \<Longrightarrow> m = n" by simp
 
 lemma nat_diff_right_cancel_eq1: "\<lbrakk> m - k = n - (k::nat); k < m \<rbrakk> \<Longrightarrow> m = n" by simp
 lemma nat_diff_right_cancel_eq2: "\<lbrakk> m - k = n - (k::nat); k < n \<rbrakk> \<Longrightarrow> m = n" by simp
 
 lemma eq_diff_left_iff: "\<lbrakk> (m::nat) \<le> k; n \<le> k\<rbrakk> \<Longrightarrow> (k - m = k - n) = (m = n)"
 by (safe, simp_all)
 
 lemma eq_imp_diff_eq: "m = (n::nat) \<Longrightarrow> m - k = n - k" by simp
 
 
 text \<open>List of definitions and lemmas\<close>
 
 thm
   Nat.add_Suc_right
   add_1_Suc_conv
   sub_Suc0_sub_Suc_conv
 
 thm
   Nat.mult_cancel1
   Nat.mult_cancel2
   mult_cancel1_gr0
   mult_cancel2_gr0
 
 thm
   Nat.add_lessD1
   add_lessD2
 
 thm
   Nat.zero_less_diff
   ord_zero_less_diff
   ord_zero_le_diff
 
 thm
   Nat.le_add_diff
   add_diff_le
   less_add_diff
   add_diff_less
 
 thm
-  Nat.le_diff_conv Nat.le_diff_conv2
+  Nat.le_diff_conv le_diff_conv2
   Nat.less_diff_conv
   diff_less_imp_less_add
   diff_less_conv
 
 thm
   le_diff_swap
   diff_less_imp_swap
   diff_less_swap
 
 thm
   less_diff_imp_less
   le_diff_imp_le
 
 thm
   less_diff_le_imp_less
   le_diff_le_imp_le
 
 thm
   Nat.less_imp_diff_less
   le_imp_diff_le
 
 thm
   Nat.less_Suc_eq_le
   less_eq_le_pred
   less_imp_le_pred
   le_pred_imp_less
 
 thm
   Nat.Suc_le_eq
   pred_less_eq_le
   pred_less_imp_le
   le_imp_pred_less
 
 thm
   diff_cancel_imp_eq
 thm
   diff_add_inverse_Suc
 thm
   Nat.nat_add_left_cancel_less
   Nat.nat_add_left_cancel_le
   Nat.nat_add_right_cancel
-  Nat.nat_add_left_cancel
+  Nat.add_left_cancel
   Nat.eq_diff_iff
   Nat.less_diff_iff
   Nat.le_diff_iff
 thm
   nat_diff_left_cancel_less
   nat_diff_right_cancel_less
 thm
   nat_diff_left_cancel_le1
   nat_diff_left_cancel_le2
   nat_diff_right_cancel_le1
   nat_diff_right_cancel_le2
 thm
   nat_diff_left_cancel_eq1
   nat_diff_left_cancel_eq2
   nat_diff_right_cancel_eq1
   nat_diff_right_cancel_eq2
 
 thm
   Nat.eq_diff_iff
   eq_diff_left_iff
 
 thm
-  Nat.nat_add_right_cancel Nat.nat_add_left_cancel
+  Nat.nat_add_right_cancel Nat.add_left_cancel
   Nat.diff_le_mono
   eq_imp_diff_eq
 
 end
diff --git a/thys/List-Infinite/ListInf/List2.thy b/thys/List-Infinite/ListInf/List2.thy
--- a/thys/List-Infinite/ListInf/List2.thy
+++ b/thys/List-Infinite/ListInf/List2.thy
@@ -1,1194 +1,1194 @@
 (*  Title:      List2.thy
     Date:       Oct 2006
     Author:     David Trachtenherz
 *)
 
 section \<open>Additional definitions and results for lists\<close>
 
 theory List2
 imports "../CommonSet/SetIntervalCut"
 begin
 
 subsection \<open>Additional definitions and results for lists\<close>
 
 text \<open>
   Infix syntactical abbreviations for operators @{term take} and @{term drop}.
   The abbreviations resemble to the operator symbols used later
   for take and drop operators on infinite lists in ListInf.\<close>
 
 abbreviation f_take' :: "'a list \<Rightarrow> nat \<Rightarrow> 'a list"  (infixl "\<down>" 100)
   where "xs \<down> n \<equiv> take n xs"
 abbreviation f_drop' :: "'a list \<Rightarrow> nat \<Rightarrow> 'a list"  (infixl "\<up>" 100)
   where "xs \<up> n \<equiv> drop n xs"
 
 lemma append_eq_Cons: "[x] @ xs = x # xs"
 by simp
 
 lemma length_Cons: "length (x # xs) = Suc (length xs)"
 by simp
 
 lemma length_snoc: "length (xs @ [x]) = Suc (length xs)"
 by simp
 
 
 subsubsection \<open>Additional lemmata about list emptiness\<close>
 
 lemma length_greater_imp_not_empty:"n < length xs \<Longrightarrow> xs \<noteq> []"
 by fastforce
 
 lemma length_ge_Suc_imp_not_empty:"Suc n \<le> length xs \<Longrightarrow> xs \<noteq> []"
 by fastforce
 
 lemma length_take_le: "length (xs \<down> n) \<le> length xs"
 by simp
 
 lemma take_not_empty_conv:"(xs \<down> n \<noteq> []) = (0 < n \<and> xs \<noteq> [])"
 by simp
 
 lemma drop_not_empty_conv:"(xs \<up> n \<noteq> []) = (n < length xs)"
 by fastforce
 
 lemma zip_eq_Nil: "(zip xs ys = []) = (xs = [] \<or> ys = [])"
 by (force simp: length_0_conv[symmetric] min_def simp del: length_0_conv)
 
 lemma zip_not_empty_conv: "(zip xs ys \<noteq> []) = (xs \<noteq> [] \<and> ys \<noteq> [])"
 by (simp add: zip_eq_Nil)
 
 
 subsubsection \<open>Additional lemmata about @{term take}, @{term drop}, @{term hd}, @{term last}, \<open>nth\<close> and \<open>filter\<close>\<close>
 
 lemma nth_tl_eq_nth_Suc: "
   Suc n \<le> length xs \<Longrightarrow> (tl xs) ! n = xs ! Suc n"
 by (rule hd_Cons_tl[OF length_ge_Suc_imp_not_empty, THEN subst], simp+)
 corollary nth_tl_eq_nth_Suc2: "
   n < length xs \<Longrightarrow> (tl xs) ! n = xs ! Suc n"
 by (simp add: nth_tl_eq_nth_Suc)
 
 lemma hd_eq_first: "xs \<noteq> [] \<Longrightarrow> xs ! 0 = hd xs"
 by (induct xs, simp_all)
 corollary take_first:"xs \<noteq> [] \<Longrightarrow> xs \<down>  (Suc 0) = [xs ! 0]"
 by (induct xs, simp_all)
 corollary take_hd:"xs \<noteq> [] \<Longrightarrow> xs \<down>  (Suc 0) = [hd xs]"
 by (simp add: take_first hd_eq_first)
 
 theorem last_nth: "xs \<noteq> [] \<Longrightarrow> last xs = xs ! (length xs - Suc 0)"
 by (simp add: last_conv_nth)
 
 lemma last_take: "n < length xs \<Longrightarrow> last (xs \<down> Suc n) = xs ! n"
 by (simp add: last_nth length_greater_imp_not_empty min_eqR)
 corollary last_take2:"
   \<lbrakk> 0 < n; n \<le> length xs \<rbrakk> \<Longrightarrow> last (xs \<down> n) = xs ! (n - Suc 0)"
 apply (frule diff_Suc_less[THEN order_less_le_trans, of _ "length xs" 0], assumption)
 apply (drule last_take[of "n - Suc 0" xs])
 apply simp
 done
 
 corollary nth_0_drop: "n \<le> length xs \<Longrightarrow> (xs \<up> n) ! 0 = xs ! n"
   by (cut_tac nth_drop[of n xs 0], simp+)
 
 
 lemma drop_eq_tl: "xs \<up> (Suc 0) = tl xs"
 by (simp add: drop_Suc)
 
 lemma drop_take_1: "
   n < length xs \<Longrightarrow> xs \<up> n \<down> (Suc 0) = [xs ! n]"
 by (simp add: take_hd hd_drop_conv_nth)
 
 lemma upt_append: "m \<le> n \<Longrightarrow> [0..<m] @ [m..<n] = [0..<n]"
 by (insert upt_add_eq_append[of 0 m "n - m"], simp)
 
 lemma nth_append1: "n < length xs \<Longrightarrow> (xs @ ys) ! n = xs ! n"
 by (simp add: nth_append)
 lemma nth_append2: "length xs \<le> n \<Longrightarrow> (xs @ ys) ! n = ys ! (n - length xs)"
 by (simp add: nth_append)
 
 
 lemma list_all_conv: "list_all P xs = (\<forall>i<length xs. P (xs ! i))"
 by (rule list_all_length)
 
 lemma expand_list_eq: "
   \<And>ys. (xs = ys) = (length xs = length ys \<and> (\<forall>i<length xs. xs ! i = ys ! i))"
 by (rule list_eq_iff_nth_eq)
 lemmas list_eq_iff = expand_list_eq
 
 
 lemma list_take_drop_imp_eq: "
   \<lbrakk> xs \<down> n = ys \<down> n;  xs \<up> n = ys \<up> n \<rbrakk> \<Longrightarrow> xs = ys"
 apply (rule subst[OF append_take_drop_id[of n xs]])
 apply (rule subst[OF append_take_drop_id[of n ys]])
 apply simp
 done
 
 lemma list_take_drop_eq_conv: "
   (xs = ys) = (\<exists>n. (xs \<down> n = ys \<down> n \<and> xs \<up> n = ys \<up> n))"
 by (blast intro: list_take_drop_imp_eq)
 
 lemma list_take_eq_conv: "(xs = ys) = (\<forall>n. xs \<down> n = ys \<down> n)"
 apply (rule iffI, simp)
 apply (drule_tac x="max (length xs) (length ys)" in spec)
 apply simp
 done
 
 lemma list_drop_eq_conv: "(xs = ys) = (\<forall>n. xs \<up> n = ys \<up> n)"
 apply (rule iffI, simp)
 apply (drule_tac x=0 in spec)
 apply simp
 done
 
 
 abbreviation replicate' :: "'a \<Rightarrow> nat \<Rightarrow> 'a list"  ("_\<^bsup>_\<^esup>" [1000,65])
   where "x\<^bsup>n\<^esup> \<equiv> replicate n x"
 
 lemma replicate_snoc: "x\<^bsup>n\<^esup> @ [x] = x\<^bsup>Suc n\<^esup>"
 by (simp add: replicate_app_Cons_same)
 
 lemma eq_replicate_conv: "(\<forall>i<length xs. xs ! i = m) = (xs = m\<^bsup>length xs\<^esup>)"
 apply (rule iffI)
  apply (simp add: expand_list_eq)
 apply clarsimp
 apply (rule ssubst[of xs "replicate (length xs) m"], assumption)
 apply (rule nth_replicate, simp)
 done
 
 lemma replicate_Cons_length: "length (x # a\<^bsup>n\<^esup>) = Suc n"
 by simp
 lemma replicate_pred_Cons_length: "0 < n \<Longrightarrow> length (x # a\<^bsup>n - Suc 0\<^esup>) = n"
 by simp
 
 lemma replicate_le_diff: "m \<le> n \<Longrightarrow> x\<^bsup>m\<^esup> @ x\<^bsup>n - m\<^esup> = x\<^bsup>n\<^esup>"
 by (simp add: replicate_add[symmetric])
 lemma replicate_le_diff2: "\<lbrakk> k \<le> m; m \<le> n \<rbrakk> \<Longrightarrow> x\<^bsup>m - k\<^esup> @ x\<^bsup>n - m\<^esup> = x\<^bsup>n - k\<^esup>"
 by (subst replicate_add[symmetric], simp)
 
 lemma append_constant_length_induct_aux: "\<And>xs.
   \<lbrakk> length xs div k = n; \<And>ys. k = 0 \<or> length ys < k \<Longrightarrow> P ys;
     \<And>xs ys. \<lbrakk> length xs = k; P ys \<rbrakk> \<Longrightarrow> P (xs @ ys) \<rbrakk> \<Longrightarrow> P xs"
 apply (case_tac "k = 0", blast)
 apply simp
 apply (induct n)
  apply (simp add: div_eq_0_conv')
 apply (subgoal_tac "k \<le> length xs")
  prefer 2
  apply (rule div_gr_imp_gr_divisor[of 0], simp)
 apply (simp only: atomize_all atomize_imp, clarsimp)
 apply (erule_tac x="drop k xs" in allE)
 apply (simp add: div_diff_self2)
 apply (erule_tac x=undefined in allE)
 apply (erule_tac x="take k xs" in allE)
 apply (simp add: min_eqR)
 apply (erule_tac x="drop k xs" in allE)
 apply simp
 done
 
 lemma append_constant_length_induct: "
   \<lbrakk> \<And>ys. k = 0 \<or> length ys < k \<Longrightarrow> P ys;
     \<And>xs ys. \<lbrakk> length xs = k; P ys \<rbrakk> \<Longrightarrow> P (xs @ ys) \<rbrakk> \<Longrightarrow> P xs"
 by (simp add: append_constant_length_induct_aux[of _ _ "length xs div k"])
 
 lemma zip_swap: "map (\<lambda>(y,x). (x,y)) (zip ys xs) = (zip xs ys)"
 by (simp add: expand_list_eq)
 
 lemma zip_takeL: "(zip xs ys) \<down> n = zip (xs \<down> n) ys"
 by (simp add: expand_list_eq)
 
 lemma zip_takeR: "(zip xs ys) \<down> n = zip xs (ys \<down> n)"
 apply (subst zip_swap[of ys, symmetric])
 apply (subst take_map)
 apply (subst zip_takeL)
 apply (simp add: zip_swap)
 done
 
 lemma zip_take: "(zip xs ys) \<down> n = zip (xs \<down> n) (ys \<down> n)"
 by (rule take_zip)
 
 lemma hd_zip: "\<lbrakk> xs \<noteq> []; ys \<noteq> [] \<rbrakk> \<Longrightarrow> hd (zip xs ys) = (hd xs, hd ys)"
 by (simp add: hd_conv_nth zip_not_empty_conv)
 
 lemma map_id: "map id xs = xs"
 by (simp add: id_def)
 
 lemma map_id_subst: "P (map id xs) \<Longrightarrow> P xs"
 by (subst map_id[symmetric])
 
 lemma map_one: "map f [x] = [f x]"
 by simp
 
 lemma map_last: "xs \<noteq> [] \<Longrightarrow> last (map f xs) = f (last xs)"
 by (rule last_map)
 
 
 lemma filter_list_all: "list_all P xs \<Longrightarrow> filter P xs = xs"
 by (induct xs, simp+)
 
 lemma filter_snoc: "filter P (xs @ [x]) = (if P x then (filter P xs) @ [x] else filter P xs)"
 by (case_tac "P x", simp+)
 
 lemma filter_filter_eq: "list_all (\<lambda>x. P x = Q x) xs \<Longrightarrow> filter P xs = filter Q xs"
 by (induct xs, simp+)
 
 lemma filter_nth: "\<And>n.
   n < length (filter P xs) \<Longrightarrow>
   (filter P xs) ! n =
   xs ! (LEAST k.
     k < length xs \<and>
     n < card {i. i \<le> k \<and> i < length xs \<and> P (xs ! i)})"
 apply (induct xs rule: rev_induct, simp)
 apply (rename_tac x xs n)
 apply (simp only: filter_snoc)
 apply (simp split del: if_split)
 apply (case_tac "xs = []")
  apply (simp split del: if_split)
  apply (rule_tac
    t = "\<lambda>k i. i = 0 \<and> i \<le> k \<and> P ([x] ! i)" and
    s = "\<lambda>k i. i = 0 \<and> P x"
    in subst)
   apply (simp add: fun_eq_iff)
   apply fastforce
  apply (fastforce simp: Least_def)
 apply (rule_tac
   t = "\<lambda>k. card {i. i \<le> k \<and> i < Suc (length xs) \<and> P ((xs @ [x]) ! i)}" and
   s = "\<lambda>k. (card {i. i \<le> k \<and> i < length xs \<and> P (xs ! i)} +
            (if k \<ge> length xs \<and> P x then Suc 0 else 0))"
   in subst)
  apply (clarsimp simp: fun_eq_iff split del: if_split, rename_tac k)
  apply (simp split del: if_split add: less_Suc_eq conj_disj_distribL conj_disj_distribR Collect_disj_eq)
  apply (subst card_Un_disjoint)
     apply (rule_tac n="length xs" in bounded_nat_set_is_finite, blast)
    apply (rule_tac n="Suc (length xs)" in bounded_nat_set_is_finite, blast)
   apply blast
  apply (rule_tac
    t = "\<lambda>i. i < length xs \<and> P ((xs @ [x]) ! i)" and
    s = "\<lambda>i. i < length xs \<and> P (xs ! i)"
    in subst)
   apply (rule fun_eq_iff[THEN iffD2])
   apply (fastforce simp: nth_append1)
- apply (rule nat_add_left_cancel[THEN iffD2])
+ apply (rule add_left_cancel[THEN iffD2])
  apply (rule_tac
    t = "\<lambda>i. i = length xs \<and> i \<le> k \<and> P ((xs @ [x]) ! i)" and
    s = "\<lambda>i. i = length xs \<and> i \<le> k \<and> P x"
    in subst)
   apply (rule fun_eq_iff[THEN iffD2])
   apply fastforce
  apply (case_tac "length xs \<le> k")
   apply clarsimp
   apply (rule_tac
     t = "\<lambda>i. i = length xs \<and> i \<le> k" and
     s = "\<lambda>i. i = length xs"
     in subst)
    apply (rule fun_eq_iff[THEN iffD2])
    apply fastforce
   apply simp
  apply simp
 apply (simp split del: if_split add: less_Suc_eq conj_disj_distribL conj_disj_distribR)
 apply (rule_tac
   t = "\<lambda>k. k < length xs \<and>
            n < card {i. i \<le> k \<and> i < length xs \<and> P (xs ! i)} + (if length xs \<le> k \<and> P x then Suc 0 else 0)" and
   s = "\<lambda>k. k < length xs \<and> n < card {i. i \<le> k \<and> i < length xs \<and> P (xs ! i)}"
   in subst)
  apply (simp add: fun_eq_iff)
 apply (rule_tac
   t = "\<lambda>k. k = length xs \<and>
            n < card {i. i \<le> k \<and> i < length xs \<and> P (xs ! i)} + (if length xs \<le> k \<and> P x then Suc 0 else 0)" and
   s = "\<lambda>k. k = length xs \<and>
            n < card {i. i \<le> k \<and> i < length xs \<and> P (xs ! i)} + (if P x then Suc 0 else 0)"
   in subst)
  apply (simp add: fun_eq_iff)
 apply (case_tac "n < length (filter P xs)")
  apply (rule_tac
    t = "(if P x then filter P xs @ [x] else filter P xs) ! n" and
    s = "(filter P xs) ! n"
    in subst)
   apply (simp add: nth_append1)
  apply (simp split del: if_split)
  apply (subgoal_tac "\<exists>k<length xs. n < card {i. i \<le> k \<and> i < length xs \<and> P (xs ! i)}")
   prefer 2
   apply (rule_tac x="length xs - Suc 0" in exI)
   apply (simp add: length_filter_conv_card less_eq_le_pred[symmetric])
  apply (subgoal_tac "\<exists>k\<le>length xs. n < card {i. i \<le> k \<and> i < length xs \<and> P (xs ! i)}")
   prefer 2
   apply (blast intro: less_imp_le)
  apply (subst Least_le_imp_le_disj)
    apply simp
   apply simp
  apply (rule sym, rule nth_append1)
  apply (rule LeastI2_ex, assumption)
  apply blast
 apply (simp add: linorder_not_less)
 apply (subgoal_tac "P x")
  prefer 2
  apply (rule ccontr, simp)
 apply (simp add: length_snoc)
 apply (drule less_Suc_eq_le[THEN iffD1], drule_tac x=n in order_antisym, assumption)
 apply (simp add: nth_append2)
 apply (simp add: length_filter_conv_card)
 apply (rule_tac
   t = "\<lambda>k. card {i. i < length xs \<and> P (xs ! i)} < card {i. i \<le> k \<and> i < length xs \<and> P (xs ! i)}" and
   s = "\<lambda>k. False"
   in subst)
  apply (rule fun_eq_iff[THEN iffD2], rule allI, rename_tac k)
  apply (simp add: linorder_not_less)
  apply (rule card_mono)
   apply fastforce
  apply blast
 apply simp
 apply (rule_tac
   t = "(LEAST k. k = length xs \<and>
                  card {i. i < length xs \<and> P (xs ! i)} < Suc (card {i. i \<le> k \<and> i < length xs \<and> P (xs ! i)}))" and
   s = "length xs"
   in subst)
  apply (rule sym, rule Least_equality)
   apply simp
   apply (rule le_imp_less_Suc)
   apply (rule card_mono)
    apply fastforce
   apply fastforce
  apply simp
 apply simp
 done
 
 
 subsubsection \<open>Ordered lists\<close>
 
 fun list_ord :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a::ord) list \<Rightarrow> bool"
 where
   "list_ord ord (x1 # x2 # xs) = (ord x1 x2 \<and> list_ord ord (x2 # xs))"
 | "list_ord ord xs = True"
 
 definition list_asc :: "('a::ord) list \<Rightarrow> bool" where
   "list_asc xs \<equiv> list_ord (\<le>) xs"
 definition list_strict_asc :: "('a::ord) list \<Rightarrow> bool" where
   "list_strict_asc xs \<equiv> list_ord (<) xs"
 value "list_asc  [1::nat, 2, 2]"
 value "list_strict_asc  [1::nat, 2, 2]"
 definition list_desc :: "('a::ord) list \<Rightarrow> bool" where
   "list_desc xs \<equiv> list_ord (\<ge>) xs"
 definition list_strict_desc :: "('a::ord) list \<Rightarrow> bool" where
   "list_strict_desc xs \<equiv> list_ord (>) xs"
 
 lemma list_ord_Nil: "list_ord ord []"
 by simp
 lemma list_ord_one: "list_ord ord [x]"
 by simp
 lemma list_ord_Cons: "
   list_ord ord (x # xs) =
   (xs = [] \<or> (ord x (hd xs) \<and> list_ord ord xs))"
 by (induct xs, simp+)
 lemma list_ord_Cons_imp: "\<lbrakk> list_ord ord xs; ord x (hd xs) \<rbrakk> \<Longrightarrow> list_ord ord (x # xs)"
 by (induct xs, simp+)
 lemma list_ord_append: "\<And>ys.
   list_ord ord (xs @ ys) =
   (list_ord ord xs \<and>
   (ys = [] \<or> (list_ord ord ys \<and> (xs = [] \<or> ord (last xs) (hd ys)))))"
 apply (induct xs, fastforce)
 apply (case_tac xs, case_tac ys, fastforce+)
 done
 lemma list_ord_snoc: "
   list_ord ord (xs @ [x]) =
   (xs = [] \<or> (ord (last xs) x \<and> list_ord ord xs))"
 by (fastforce simp: list_ord_append)
 
 lemma list_ord_all_conv: "
   (list_ord ord xs) = (\<forall>n < length xs - 1. ord (xs ! n) (xs ! Suc n))"
 apply (rule iffI)
  apply (induct xs, simp)
  apply clarsimp
  apply (simp add: list_ord_Cons)
  apply (erule disjE, simp)
  apply clarsimp
  apply (case_tac n)
   apply (simp add: hd_conv_nth)
  apply simp
 apply (induct xs, simp)
 apply (simp add: list_ord_Cons)
 apply (case_tac "xs = []", simp)
 apply (drule meta_mp)
  apply (intro allI impI, rename_tac n)
  apply (drule_tac x="Suc n" in spec, simp)
 apply (drule_tac x=0 in spec)
 apply (simp add: hd_conv_nth)
 done
 
 lemma list_ord_imp: "
   \<lbrakk> \<And>x y. ord x y \<Longrightarrow> ord' x y; list_ord ord xs \<rbrakk> \<Longrightarrow>
   list_ord ord' xs"
 apply (induct xs, simp)
 apply (simp add: list_ord_Cons)
 apply fastforce
 done
 corollary list_strict_asc_imp_list_asc: "
   list_strict_asc (xs::'a::preorder list) \<Longrightarrow> list_asc xs"
 by (unfold list_strict_asc_def list_asc_def, rule list_ord_imp[of "(<)"], rule order_less_imp_le)
 corollary list_strict_desc_imp_list_desc: "
   list_strict_desc (xs::'a::preorder list) \<Longrightarrow> list_desc xs"
 by (unfold list_strict_desc_def list_desc_def, rule list_ord_imp[of "(>)"], rule order_less_imp_le)
 
 lemma list_ord_trans_imp: "\<And>i.
   \<lbrakk> transP ord; list_ord ord xs; j < length xs; i < j \<rbrakk> \<Longrightarrow>
   ord (xs ! i) (xs ! j)"
 apply (simp add: list_ord_all_conv)
 apply (induct j, simp)
 apply (case_tac "j < i", simp)
 apply (simp add: linorder_not_less)
 apply (case_tac "i = j", simp)
 apply (drule_tac x=i in meta_spec, simp)
 apply (drule_tac x=j in spec, simp add: Suc_less_pred_conv)
 apply (unfold trans_def)
 apply (drule_tac x="xs ! i" in spec, drule_tac x="xs ! j" in spec, drule_tac x="xs ! Suc j" in spec)
 apply simp
 done
 
 lemma list_ord_trans: "
   transP ord \<Longrightarrow>
   (list_ord ord xs) =
   (\<forall>j < length xs. \<forall>i < j. ord (xs ! i) (xs ! j))"
 apply (rule iffI)
  apply (simp add: list_ord_trans_imp)
 apply (simp add: list_ord_all_conv)
 done
 
 lemma list_ord_trans_refl_le: "
   \<lbrakk> transP ord; reflP ord \<rbrakk> \<Longrightarrow>
   (list_ord ord xs) =
   (\<forall>j < length xs. \<forall>i \<le> j. ord (xs ! i) (xs ! j))"
 apply (subst list_ord_trans, simp)
 apply (rule iffI)
  apply clarsimp
  apply (case_tac "i = j")
   apply (simp add: refl_on_def)
  apply simp+
 done
 
 lemma list_ord_trans_refl_le_imp: "
   \<lbrakk> transP ord; \<And>x y. ord x y \<Longrightarrow> ord' x y; reflP ord';
     list_ord ord xs \<rbrakk> \<Longrightarrow>
   (\<forall>j < length xs. \<forall>i \<le> j. ord' (xs ! i) (xs ! j))"
 apply clarify
 apply (case_tac "i = j")
  apply (simp add: refl_on_def)
 apply (simp add: list_ord_trans_imp)
 done
 
 corollary
   list_asc_trans: "
     (list_asc (xs::'a::preorder list)) =
     (\<forall>j < length xs. \<forall>i < j. xs ! i \<le> xs ! j)" and
   list_strict_asc_trans: "
     (list_strict_asc (xs::'a::preorder list)) =
     (\<forall>j < length xs. \<forall>i < j. xs ! i < xs ! j)" and
   list_desc_trans: "
     (list_desc (xs::'a::preorder list)) =
     (\<forall>j < length xs. \<forall>i < j. xs ! j \<le> xs ! i)" and
   list_strict_desc_trans: "
     (list_strict_desc (xs::'a::preorder list)) =
     (\<forall>j < length xs. \<forall>i < j. xs ! j < xs ! i)"
 apply (unfold list_asc_def list_strict_asc_def list_desc_def list_strict_desc_def)
 apply (rule list_ord_trans, unfold trans_def, blast intro: order_trans order_less_trans)+
 done
 
 corollary
   list_asc_trans_le: "
     (list_asc (xs::'a::preorder list)) =
     (\<forall>j < length xs. \<forall>i \<le> j. xs ! i \<le> xs ! j)" and
   list_desc_trans_le: "
     (list_desc (xs::'a::preorder list)) =
     (\<forall>j < length xs. \<forall>i \<le> j. xs ! j \<le> xs ! i)"
 apply (unfold list_asc_def list_strict_asc_def list_desc_def list_strict_desc_def)
 apply (rule list_ord_trans_refl_le, unfold trans_def, blast intro: order_trans, simp add: refl_on_def)+
 done
 
 corollary
   list_strict_asc_trans_le: "
     (list_strict_asc (xs::'a::preorder list)) \<Longrightarrow>
     (\<forall>j < length xs. \<forall>i \<le> j. xs ! i \<le> xs ! j)"
 apply (unfold list_strict_asc_def)
 apply (rule list_ord_trans_refl_le_imp[where ord="(\<le>)"])
    apply (unfold trans_def, blast intro: order_trans)
   apply assumption
  apply (unfold refl_on_def, clarsimp)
 apply (rule list_ord_imp[where ord="(<)"], simp_all add: less_imp_le)
 done
 
 lemma list_ord_le_sorted_eq: "list_asc xs = sorted xs"
 apply (rule sym)
 apply (simp add: list_asc_def)
 apply (induct xs, simp)
 apply (rename_tac x xs)
 apply (simp add: list_ord_Cons)
 apply (case_tac "xs = []", simp_all)
 apply (case_tac "list_ord (\<le>) xs", simp_all)
 apply (rule iffI)
  apply (drule_tac x="hd xs" in bspec, simp_all)
 apply clarify
 apply (drule in_set_conv_nth[THEN iffD1], clarsimp, rename_tac i1)
 apply (simp add: hd_conv_nth)
 apply (case_tac i1, simp)
 apply (rename_tac i2)
 apply simp
 apply (fold list_asc_def)
 apply (fastforce simp: list_asc_trans)
 done
 
 corollary list_asc_upto: "list_asc [m..n]"
 by (simp add: list_ord_le_sorted_eq)
 
 lemma list_strict_asc_upt: "list_strict_asc [m..<n]"
 by (simp add: list_strict_asc_def list_ord_all_conv)
 
 
 lemma list_ord_distinct_aux: "
   \<lbrakk> irrefl {(a, b). ord a b}; transP ord; list_ord ord xs;
     i < length xs; j < length xs; i < j \<rbrakk> \<Longrightarrow>
   xs ! i \<noteq> xs ! j"
 apply (subgoal_tac "\<And>x y. ord x y \<Longrightarrow> x \<noteq> y")
  prefer 2
  apply (rule ccontr)
  apply (simp add: irrefl_def)
 apply (simp add: list_ord_trans)
 done
 
 lemma list_ord_distinct: "
   \<lbrakk> irrefl {(a,b). ord a b}; transP ord; list_ord ord xs \<rbrakk> \<Longrightarrow>
   distinct xs"
 apply (simp add: distinct_conv_nth, intro allI impI, rename_tac i j)
 apply (drule neq_iff[THEN iffD1], erule disjE)
  apply (simp add: list_ord_distinct_aux)
 apply (simp add: list_ord_distinct_aux[THEN not_sym])
 done
 
 lemma list_strict_asc_distinct: "list_strict_asc (xs::'a::preorder list) \<Longrightarrow> distinct xs"
 apply (rule_tac ord="(<)" in list_ord_distinct)
 apply (unfold irrefl_def list_strict_asc_def trans_def)
 apply (blast intro: less_trans)+
 done
 
 lemma list_strict_desc_distinct: "list_strict_desc (xs::'a::preorder list) \<Longrightarrow> distinct xs"
 apply (rule_tac ord="(>)" in list_ord_distinct)
 apply (unfold irrefl_def list_strict_desc_def trans_def)
 apply (blast intro: less_trans)+
 done
 
 
 subsubsection \<open>Additional definitions and results for sublists\<close>
 
 primrec sublist_list :: "'a list \<Rightarrow> nat list \<Rightarrow> 'a list"
 where
   "sublist_list xs [] = []"
 | "sublist_list xs (y # ys) = (xs ! y) # (sublist_list xs ys)"
 
 value "sublist_list [0::int,10::int,20,30,40,50] [1::nat,2,3]"
 value "sublist_list [0::int,10::int,20,30,40,50] [1::nat,1,2,3]"
 value [nbe] "sublist_list [0::int,10::int,20,30,40,50] [1::nat,1,2,3,10]"
 
 lemma sublist_list_length: "length (sublist_list xs ys) = length ys"
 by (induct ys, simp_all)
 
 lemma sublist_list_append: "
  \<And>zs. sublist_list xs (ys @ zs) = sublist_list xs ys @ sublist_list xs zs"
 by (induct ys, simp_all)
 
 lemma sublist_list_Nil: "sublist_list xs [] =[]"
 by simp
 
 lemma sublist_list_is_Nil_conv: "
   (sublist_list xs ys = []) = (ys = [])"
 apply (rule iffI)
  apply (rule ccontr)
  apply (clarsimp simp: neq_Nil_conv)
 apply simp
 done
 
 lemma sublist_list_eq_imp_length_eq: "
   sublist_list xs ys = sublist_list xs zs \<Longrightarrow> length ys = length zs"
 by (drule arg_cong[where f=length], simp add: sublist_list_length)
 
 lemma sublist_list_nth: "
   \<And>n. n < length ys \<Longrightarrow> sublist_list xs ys ! n = xs ! (ys ! n)"
 apply (induct ys, simp)
 apply (case_tac n, simp_all)
 done
 
 lemma take_drop_eq_sublist_list: "
   m + n \<le> length xs \<Longrightarrow> xs \<up> m \<down> n = sublist_list xs [m..<m+n]"
 apply (insert length_upt[of m "m+n"])
 apply (simp add: expand_list_eq)
 apply (simp add: sublist_list_length)
 apply (frule add_le_imp_le_diff2)
 apply (simp add: min_eqR)
 apply (clarsimp, rename_tac i)
 apply (simp add: sublist_list_nth)
 done
 
 
 primrec sublist_list_if :: "'a list \<Rightarrow> nat list \<Rightarrow> 'a list"
 where
   "sublist_list_if xs [] = []"
 | "sublist_list_if xs (y # ys) =
     (if y < length xs then (xs ! y) # (sublist_list_if xs ys)
      else (sublist_list_if xs ys))"
 
 value "sublist_list_if [0::int,10::int,20,30,40,50] [1::nat,2,3]"
 value "sublist_list_if [0::int,10::int,20,30,40,50] [1::nat,1,2,3]"
 value "sublist_list_if [0::int,10::int,20,30,40,50] [1::nat,1,2,3,10]"
 
 lemma sublist_list_if_sublist_list_filter_conv: "\<And>xs.
   sublist_list_if xs ys = sublist_list xs (filter (\<lambda>i. i < length xs) ys)"
 by (induct ys, simp+)
 
 corollary sublist_list_if_sublist_list_eq: "\<And>xs.
   list_all (\<lambda>i. i < length xs) ys \<Longrightarrow>
   sublist_list_if xs ys = sublist_list xs ys"
 by (simp add: sublist_list_if_sublist_list_filter_conv filter_list_all)
 
 corollary sublist_list_if_sublist_list_eq2: "\<And>xs.
   \<forall>n<length ys. ys ! n < length xs \<Longrightarrow>
   sublist_list_if xs ys = sublist_list xs ys"
 by (rule sublist_list_if_sublist_list_eq, rule list_all_conv[THEN iffD2])
 
 lemma sublist_list_if_Nil_left: "sublist_list_if [] ys = []"
 by (induct ys, simp+)
 lemma sublist_list_if_Nil_right: "sublist_list_if xs [] = []"
 by simp
 
 lemma sublist_list_if_length: "
   length (sublist_list_if xs ys) = length (filter (\<lambda>i. i < length xs) ys)"
 by (simp add: sublist_list_if_sublist_list_filter_conv sublist_list_length)
 lemma sublist_list_if_append: "
   sublist_list_if xs (ys @ zs) = sublist_list_if xs ys @ sublist_list_if xs zs"
 by (simp add: sublist_list_if_sublist_list_filter_conv sublist_list_append)
 lemma sublist_list_if_snoc: "
   sublist_list_if xs (ys @ [y]) = sublist_list_if xs ys @ (if y < length xs then [xs ! y] else [])"
 by (simp add: sublist_list_if_append)
 
 
 lemma sublist_list_if_is_Nil_conv: "
   (sublist_list_if xs ys = []) = (list_all (\<lambda>i. length xs \<le> i) ys)"
 by (simp add: sublist_list_if_sublist_list_filter_conv sublist_list_is_Nil_conv filter_empty_conv list_all_iff linorder_not_less)
 
 lemma sublist_list_if_nth: "
   n < length ((filter (\<lambda>i. i < length xs) ys)) \<Longrightarrow>
   sublist_list_if xs ys ! n = xs ! ((filter (\<lambda>i. i < length xs) ys) ! n)"
 by (simp add: sublist_list_if_sublist_list_filter_conv sublist_list_nth)
 
 lemma take_drop_eq_sublist_list_if: "
   m + n \<le> length xs \<Longrightarrow> xs \<up> m \<down> n = sublist_list_if xs [m..<m+n]"
 by (simp add: sublist_list_if_sublist_list_filter_conv take_drop_eq_sublist_list)
 
 lemma nths_empty_conv: "(nths xs I = []) = (\<forall>i\<in>I. length xs \<le> i)"
   using [[hypsubst_thin = true]]
 by (fastforce simp: set_empty[symmetric] set_nths linorder_not_le[symmetric])
 
 lemma nths_singleton2: "nths xs {y} = (if y < length xs then [xs ! y] else [])"
 apply (unfold nths_def)
 apply (induct xs rule: rev_induct, simp)
 apply (simp add: nth_append)
 done
 
 lemma nths_take_eq: "
   \<lbrakk> finite I; Max I < n \<rbrakk> \<Longrightarrow> nths (xs \<down> n) I = nths xs I"
 apply (case_tac "I = {}", simp)
 apply (case_tac "n < length xs")
  prefer 2
  apply simp
 apply (rule_tac
   t = "nths xs I" and
   s = "nths (xs \<down> n @ xs \<up> n) I"
   in subst)
  apply simp
 apply (subst nths_append)
 apply (simp add: min_eqR)
 apply (rule_tac t="{j. j + n \<in> I}" and s="{}" in subst)
  apply blast
 apply simp
 done
 
 lemma nths_drop_eq: "
   n \<le> iMin I \<Longrightarrow> nths (xs \<up> n) {j. j + n \<in> I} = nths xs I"
 apply (case_tac "I = {}", simp)
 apply (case_tac "n < length xs")
  prefer 2
  apply (simp add: nths_def filter_empty_conv linorder_not_less)
  apply (clarsimp, rename_tac a b)
  apply (drule set_zip_rightD)
  apply fastforce
 apply (rule_tac
   t = "nths xs I" and
   s = "nths (xs \<down> n @ xs \<up> n) I"
   in subst)
  apply simp
 apply (subst nths_append)
 apply (fastforce simp: nths_empty_conv min_eqR)
 done
 
 lemma nths_cut_less_eq: "
   length xs \<le> n \<Longrightarrow> nths xs (I \<down>< n) = nths xs I"
 apply (simp add: nths_def cut_less_mem_iff)
 apply (rule_tac f="\<lambda>xs. map fst xs" in arg_cong)
 apply (rule filter_filter_eq)
 apply (simp add: list_all_conv)
 done
 
 lemma nths_disjoint_Un: "
   \<lbrakk> finite A; Max A < iMin B \<rbrakk> \<Longrightarrow> nths xs (A \<union> B) = nths xs A @ nths xs B"
 apply (case_tac "A = {}", simp)
 apply (case_tac "B = {}", simp)
 apply (case_tac "length xs \<le> iMin B")
  apply (subst nths_cut_less_eq[of xs "iMin B", symmetric], assumption)
  apply (simp (no_asm_simp) add: cut_less_Un cut_less_Min_empty cut_less_Max_all)
  apply (simp add: nths_empty_conv iMin_ge_iff)
 apply (simp add: linorder_not_le)
 apply (rule_tac
   t = "nths xs (A \<union> B)" and
   s = "nths (xs \<down> (iMin B) @ xs \<up> (iMin B)) (A \<union> B)"
   in subst)
  apply simp
 apply (subst nths_append)
 apply (simp add: min_eqR)
 apply (subst nths_cut_less_eq[where xs="xs \<down> iMin B" and n="iMin B", symmetric], simp)
 apply (simp add: cut_less_Un cut_less_Min_empty cut_less_Max_all)
 apply (simp add: nths_take_eq)
 apply (rule_tac
   t = "\<lambda>j. j + iMin B \<in> A \<or> j + iMin B \<in> B" and
   s = "\<lambda>j. j + iMin B \<in> B"
   in subst)
  apply (force simp: fun_eq_iff)
 apply (simp add: nths_drop_eq)
 done
 
 corollary nths_disjoint_insert_left: "
   \<lbrakk> finite I; x < iMin I \<rbrakk> \<Longrightarrow> nths xs (insert x I) = nths xs {x} @ nths xs I"
 apply (rule_tac t="insert x I" and s="{x} \<union> I" in subst, simp)
 apply (subst nths_disjoint_Un)
 apply simp_all
 done
 
 corollary nths_disjoint_insert_right: "
   \<lbrakk> finite I; Max I < x \<rbrakk> \<Longrightarrow> nths xs (insert x I) = nths xs I @ nths xs {x}"
 apply (rule_tac t="insert x I" and s="I \<union> {x}" in subst, simp)
 apply (subst nths_disjoint_Un)
 apply simp_all
 done
 
 lemma nths_all: "{..<length xs} \<subseteq> I \<Longrightarrow> nths xs I = xs"
 apply (case_tac "xs = []", simp)
 apply (rule_tac
   t = "I" and
   s = "I \<down>< (length xs) \<union> I \<down>\<ge> (length xs)"
   in subst)
  apply (simp add: cut_less_cut_ge_ident)
 apply (rule_tac
   t = "I \<down>< length xs" and
   s = "{..<length xs}"
   in subst)
  apply blast
 apply (case_tac "I \<down>\<ge> (length xs) = {}", simp)
 apply (subst nths_disjoint_Un[OF finite_lessThan])
  apply (rule less_imp_Max_less_iMin[OF finite_lessThan])
    apply blast
   apply blast
  apply (blast intro: less_le_trans)
 apply (fastforce simp: nths_empty_conv)
 done
 
 corollary nths_UNIV: "nths xs UNIV = xs"
 by (rule nths_all[OF subset_UNIV])
 
 lemma sublist_list_nths_eq: "\<And>xs.
   list_strict_asc ys \<Longrightarrow> sublist_list_if xs ys = nths xs (set ys)"
 apply (case_tac "xs = []")
  apply (simp add: sublist_list_if_Nil_left)
 apply (induct ys rule: rev_induct, simp)
 apply (rename_tac y ys xs)
 apply (case_tac "ys = []")
  apply (simp add: nths_singleton2)
 apply (unfold list_strict_asc_def)
 apply (simp add: sublist_list_if_snoc split del: if_split)
 apply (frule list_ord_append[THEN iffD1])
 apply (clarsimp split del: if_split)
 apply (subst nths_disjoint_insert_right)
   apply simp
  apply (clarsimp simp: in_set_conv_nth, rename_tac i)
  apply (drule_tac i=i and j="length ys" in list_strict_asc_trans[unfolded list_strict_asc_def, THEN iffD1, rule_format])
  apply (simp add: nth_append split del: if_split)+
 apply (simp add: nths_singleton2)
 done
 
 lemma set_sublist_list_if: "\<And>xs. set (sublist_list_if xs ys) = {xs ! i |i. i < length xs \<and> i \<in> set ys}"
 apply (induct ys, simp_all)
 apply blast
 done
 
 lemma set_sublist_list: "
   list_all (\<lambda>i. i < length xs) ys \<Longrightarrow>
   set (sublist_list xs ys) = {xs ! i |i. i < length xs \<and> i \<in> set ys}"
 by (simp add: sublist_list_if_sublist_list_eq[symmetric] set_sublist_list_if)
 
 lemma set_sublist_list_if_eq_set_sublist: "set (sublist_list_if xs ys) = set (nths xs (set ys))"
 by (simp add: set_nths set_sublist_list_if)
 
 lemma set_sublist_list_eq_set_sublist: "
   list_all (\<lambda>i. i < length xs) ys \<Longrightarrow>
   set (sublist_list xs ys) = set (nths xs (set ys))"
 by (simp add: sublist_list_if_sublist_list_eq[symmetric] set_sublist_list_if_eq_set_sublist)
 
 
 subsubsection \<open>Natural set images with lists\<close>
 
 definition f_image :: "'a list \<Rightarrow> nat set \<Rightarrow> 'a set"    (infixr "`\<^sup>f" 90)
   where "xs `\<^sup>f A \<equiv> {y. \<exists>n\<in>A. n < length xs \<and> y = xs ! n}"
 
 abbreviation f_range :: "'a list \<Rightarrow> 'a set"
   where "f_range xs \<equiv> f_image xs UNIV"
 
 lemma f_image_eqI[simp, intro]: "
   \<lbrakk> x = xs ! n; n \<in> A; n < length xs \<rbrakk> \<Longrightarrow> x \<in> xs `\<^sup>f A"
 by (unfold f_image_def, blast)
 
 lemma f_imageI: "\<lbrakk> n \<in> A; n < length xs \<rbrakk> \<Longrightarrow> xs ! n \<in> xs `\<^sup>f A"
 by blast
 
 lemma rev_f_imageI: "\<lbrakk> n \<in> A; n < length xs; x = xs ! n \<rbrakk> \<Longrightarrow> x \<in> xs `\<^sup>f A"
 by (rule f_image_eqI)
 
 lemma f_imageE[elim!]: "
   \<lbrakk> x \<in> xs `\<^sup>f A; \<And>n. \<lbrakk> x = xs ! n; n \<in> A; n < length xs \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
 by (unfold f_image_def, blast)
 
 lemma f_image_Un: "xs `\<^sup>f (A \<union> B) = xs `\<^sup>f A \<union> xs `\<^sup>f B"
 by blast
 
 lemma f_image_mono: "A \<subseteq> B ==> xs `\<^sup>f A \<subseteq> xs `\<^sup>f B"
 by blast
 
 lemma f_image_iff: "(x \<in> xs `\<^sup>f A) = (\<exists>n\<in>A. n < length xs \<and> x = xs ! n)"
 by blast
 
 lemma f_image_subset_iff: "
   (xs `\<^sup>f A \<subseteq> B) = (\<forall>n\<in>A. n < length xs \<longrightarrow> xs ! n \<in> B)"
 by blast
 
 lemma subset_f_image_iff: "(B \<subseteq> xs `\<^sup>f A) = (\<exists>A'\<subseteq>A. B = xs `\<^sup>f A')"
 apply (rule iffI)
  apply (rule_tac x="{ n. n \<in> A \<and> n < length xs \<and> xs ! n \<in> B }" in exI)
  apply blast
 apply (blast intro: f_image_mono)
 done
 
 lemma f_image_subsetI: "
   \<lbrakk> \<And>n. n \<in> A \<and> n < length xs \<Longrightarrow> xs ! n \<in> B \<rbrakk> \<Longrightarrow> xs `\<^sup>f A \<subseteq> B"
 by blast
 
 lemma f_image_empty: "xs `\<^sup>f {} = {}"
 by blast
 
 lemma f_image_insert_if: "
   xs `\<^sup>f (insert n A) = (
   if n < length xs then insert (xs ! n) (xs `\<^sup>f A) else (xs `\<^sup>f A))"
 by (split if_split, blast)
 
 lemma f_image_insert_eq1: "
   n < length xs \<Longrightarrow> xs `\<^sup>f (insert n A) = insert (xs ! n) (xs `\<^sup>f A)"
 by (simp add: f_image_insert_if)
 
 lemma f_image_insert_eq2: "
   length xs \<le> n \<Longrightarrow> xs `\<^sup>f (insert n A) = (xs `\<^sup>f A)"
 by (simp add: f_image_insert_if)
 
 lemma insert_f_image: "
   \<lbrakk> n \<in> A; n < length xs \<rbrakk> \<Longrightarrow> insert (xs ! n) (xs `\<^sup>f A) = (xs `\<^sup>f A)"
 by blast
 
 lemma f_image_is_empty: "(xs `\<^sup>f A = {}) = ({x. x \<in> A \<and> x < length xs} = {})"
 by blast
 
 lemma f_image_Collect: "xs `\<^sup>f {n. P n} = {xs ! n |n. P n \<and> n < length xs}"
 by blast
 
 
 lemma f_image_eq_set: "\<forall>n<length xs. n \<in> A \<Longrightarrow> xs `\<^sup>f A = set xs"
 by (fastforce simp: in_set_conv_nth)
 lemma f_range_eq_set: "f_range xs = set xs"
 by (simp add: f_image_eq_set)
 
 lemma f_image_eq_set_nths: "xs `\<^sup>f A = set (nths xs A)"
 by (unfold set_nths, blast)
 lemma f_image_eq_set_sublist_list_if: "xs `\<^sup>f (set ys) = set (sublist_list_if xs ys)"
 by (simp add: set_sublist_list_if_eq_set_sublist f_image_eq_set_nths)
 lemma f_image_eq_set_sublist_list: "
   list_all (\<lambda>i. i < length xs) ys \<Longrightarrow> xs `\<^sup>f (set ys) = set (sublist_list xs ys)"
 by (simp add: sublist_list_if_sublist_list_eq f_image_eq_set_sublist_list_if)
 
 
 lemma f_range_eqI: "\<lbrakk> x = xs ! n; n < length xs \<rbrakk> \<Longrightarrow> x \<in> f_range xs"
 by blast
 
 lemma f_rangeI: "n < length xs \<Longrightarrow> xs ! n \<in> f_range xs"
 by blast
 
 lemma f_rangeE[elim?]: "
   \<lbrakk> x \<in> f_range xs; \<And>n. \<lbrakk> n < length xs; x = xs ! n \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
 by blast
 
 
 subsubsection \<open>Mapping lists of functions to lists\<close>
 
 primrec map_list :: "('a \<Rightarrow> 'b) list \<Rightarrow> 'a list \<Rightarrow> 'b list"
 where
   "map_list [] xs = []"
 | "map_list (f # fs) xs = f (hd xs) # map_list fs (tl xs)"
 
 lemma map_list_Nil: "map_list [] xs = []"
 by simp
 
 lemma map_list_Cons_Cons: "
   map_list (f # fs) (x # xs) =
   (f x) # map_list fs xs"
 by simp
 
 lemma map_list_length: "\<And>xs.
   length (map_list fs xs) = length fs"
 by (induct fs, simp+)
 corollary map_list_empty_conv: "
   (map_list fs xs = []) = (fs = [])"
 by (simp del: length_0_conv add: length_0_conv[symmetric] map_list_length)
 corollary map_list_not_empty_conv: "
   (map_list fs xs \<noteq> []) = (fs \<noteq> [])"
 by (simp add: map_list_empty_conv)
 
 lemma map_list_nth: "\<And>n xs.
   \<lbrakk> n < length fs; n < length xs \<rbrakk> \<Longrightarrow>
   (map_list fs xs ! n) =
   (fs ! n) (xs ! n)"
 apply (induct fs, simp+)
 apply (case_tac n)
  apply (simp add: hd_conv_nth)
 apply (simp add: nth_tl_eq_nth_Suc2)
 done
 
 lemma map_list_xs_take: "\<And>n xs.
   length fs \<le> n \<Longrightarrow>
   map_list fs (xs \<down> n) =
   map_list fs xs"
 apply (induct fs, simp+)
 apply (rename_tac fs n xs)
 apply (simp add: tl_take)
 done
 
 lemma map_list_take: "\<And>n xs.
   (map_list fs xs) \<down> n =
   (map_list (fs \<down> n) xs)"
 apply (induct fs, simp)
 apply (case_tac n, simp+)
 done
 lemma map_list_take_take: "\<And>n xs.
   (map_list fs xs) \<down> n =
   (map_list (fs \<down> n) (xs \<down> n))"
 by (simp add: map_list_take map_list_xs_take)
 lemma map_list_drop: "\<And>n xs.
   (map_list fs xs) \<up> n =
   (map_list (fs \<up> n) (xs \<up> n))"
 apply (induct fs, simp)
 apply (case_tac n)
 apply (simp add: drop_Suc)+
 done
 
 
 
 lemma map_list_append_append: "\<And>xs1 .
   length fs1 = length xs1 \<Longrightarrow>
   map_list (fs1 @ fs2) (xs1 @ xs2) =
   map_list fs1 xs1 @
   map_list fs2 xs2"
 apply (induct fs1, simp+)
 apply (case_tac "xs1", simp+)
 done
 lemma map_list_snoc_snoc: "
   length fs = length xs \<Longrightarrow>
   map_list (fs @ [f]) (xs @ [x]) =
   map_list fs xs @ [f x]"
 by (simp add: map_list_append_append)
 lemma map_list_snoc: "\<And>xs.
   length fs < length xs \<Longrightarrow>
   map_list (fs @ [f]) xs =
   map_list fs xs @  [f (xs ! (length fs))]"
 apply (induct fs)
  apply (simp add: hd_conv_nth)
 apply (simp add: nth_tl_eq_nth_Suc2)
 done
 
 
 lemma map_list_Cons_if: "
   map_list fs (x # xs) =
   (if (fs = []) then [] else (
     ((hd fs) x) # map_list (tl fs) xs))"
 by (case_tac "fs", simp+)
 lemma map_list_Cons_not_empty: "
   fs \<noteq> [] \<Longrightarrow>
   map_list fs (x # xs) =
   ((hd fs) x) # map_list (tl fs) xs"
 by (simp add: map_list_Cons_if)
 
 lemma map_eq_map_list_take: "\<And>xs.
   \<lbrakk> length fs \<le> length xs; list_all (\<lambda>x. x = f) fs \<rbrakk> \<Longrightarrow>
   map_list fs xs = map f (xs \<down> length fs)"
 apply (induct fs, simp+)
 apply (case_tac xs, simp+)
 done
 lemma map_eq_map_list_take2: "
   \<lbrakk> length fs = length xs; list_all (\<lambda>x. x = f) fs \<rbrakk> \<Longrightarrow>
   map_list fs xs = map f xs"
 by (simp add: map_eq_map_list_take)
 lemma map_eq_map_list_replicate: "
   map_list (f\<^bsup>length xs\<^esup>) xs = map f xs"
 by (induct xs, simp+)
 
 
 subsubsection \<open>Mapping functions with two arguments to lists\<close>
 
 primrec map2 :: "
   \<comment> \<open>Function taking two parameters\<close>
   ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow>
   \<comment> \<open>Lists of parameters\<close>
   'a list \<Rightarrow> 'b list \<Rightarrow>
   'c list"
 where
   "map2 f [] ys = []"
 | "map2 f (x # xs) ys = f x (hd ys) # map2 f xs (tl ys)"
 
 
 lemma map2_map_list_conv: "\<And>ys. map2 f xs ys = map_list (map f xs) ys"
 by (induct xs, simp+)
 
 lemma map2_Nil: "map2 f [] ys = []"
 by simp
 lemma map2_Cons_Cons: "
   map2 f (x # xs) (y # ys) =
   (f x y) # map2 f xs ys"
 by simp
 
 lemma map2_length: "\<And>ys. length (map2 f xs ys) = length xs"
 by (induct xs, simp+)
 corollary map2_empty_conv: "
   (map2 f xs ys = []) = (xs = [])"
 by (simp del: length_0_conv add: length_0_conv[symmetric] map2_length)
 corollary map2_not_empty_conv: "
   (map2 f xs ys \<noteq> []) = (xs \<noteq> [])"
 by (simp add: map2_empty_conv)
 
 lemma map2_nth: "\<And>n ys.
   \<lbrakk> n < length xs; n < length ys \<rbrakk> \<Longrightarrow>
   (map2 f xs ys ! n) =
   f (xs ! n) (ys ! n)"
 by (simp add: map2_map_list_conv map_list_nth)
 
 lemma map2_ys_take: "\<And>n ys.
   length xs \<le> n \<Longrightarrow>
   map2 f xs (ys \<down> n) =
   map2 f xs ys"
 by (simp add: map2_map_list_conv map_list_xs_take)
 
 lemma map2_take: "\<And>n ys.
   (map2 f xs ys) \<down> n =
   (map2 f (xs \<down> n) ys)"
 by (simp add: map2_map_list_conv take_map map_list_take)
 
 lemma map2_take_take: "\<And>n ys.
   (map2 f xs ys) \<down> n =
   (map2 f (xs \<down> n) (ys \<down> n))"
 by (simp add: map2_take map2_ys_take)
 
 lemma map2_drop: "\<And>n ys.
   (map2 f xs ys) \<up> n =
   (map2 f (xs \<up> n) (ys \<up> n))"
 by (simp add: map2_map_list_conv map_list_drop drop_map)
 
 
 lemma map2_append_append: "\<And>ys1 .
   length xs1 = length ys1 \<Longrightarrow>
   map2 f (xs1 @ xs2) (ys1 @ ys2) =
   map2 f xs1 ys1 @
   map2 f xs2 ys2"
 by (simp add: map2_map_list_conv map_list_append_append)
 
 lemma map2_snoc_snoc: "
   length xs = length ys \<Longrightarrow>
   map2 f (xs @ [x]) (ys @ [y]) =
   map2 f xs ys @
   [f x y]"
 by (simp add: map2_append_append)
 
 lemma map2_snoc: "\<And>ys.
   length xs < length ys \<Longrightarrow>
   map2 f (xs @ [x]) ys =
   map2 f xs ys @
   [f x (ys ! (length xs))]"
 by (simp add: map2_map_list_conv map_list_snoc)
 
 lemma map2_Cons_if: "
   map2 f xs (y # ys) =
   (if (xs = []) then [] else (
     (f (hd xs) y) # map2 f (tl xs) ys))"
 by (case_tac "xs", simp+)
 lemma map2_Cons_not_empty: "
   xs \<noteq> [] \<Longrightarrow>
   map2 f xs (y # ys) =
   (f (hd xs) y) # map2 f (tl xs) ys"
 by (simp add: map2_Cons_if)
 
 lemma map2_append1_take_drop: "
   length xs1 \<le> length ys \<Longrightarrow>
   map2 f (xs1 @ xs2) ys =
   map2 f xs1 (ys \<down> length xs1) @
   map2 f xs2 (ys \<up> length xs1)"
 apply (rule_tac
   t = "map2 f (xs1 @ xs2) ys" and
   s = "map2 f (xs1 @ xs2) (ys \<down> length xs1 @ ys \<up> length xs1)"
   in subst)
  apply simp
 apply (simp add: map2_append_append del: append_take_drop_id)
 done
 
 lemma map2_append2_take_drop: "
   length ys1 \<le> length xs \<Longrightarrow>
   map2 f xs (ys1 @ ys2) =
   map2 f (xs \<down> length ys1) ys1 @
   map2 f (xs \<up> length ys1) ys2"
 apply (rule_tac
   t = "map2 f xs (ys1 @ ys2)" and
   s = "map2 f (xs \<down> length ys1 @ xs \<up> length ys1) (ys1 @ ys2)"
   in subst)
  apply simp
 apply (simp add: map2_append_append del: append_take_drop_id)
 done
 
 lemma map2_cong: "
   \<lbrakk> xs1 = xs2; ys1 = ys2; length xs2 \<le> length ys2;
     \<And>x y. \<lbrakk> x \<in> set xs2; y \<in> set ys2 \<rbrakk> \<Longrightarrow> f x y = g x y \<rbrakk> \<Longrightarrow>
   map2 f xs1 ys1 = map2 g xs2 ys2"
 by (simp (no_asm_simp) add: expand_list_eq map2_length map2_nth)
 
 lemma map2_eq_conv: "
   length xs \<le> length ys \<Longrightarrow>
   (map2 f xs ys = map2 g xs ys) = (\<forall>i<length xs. f (xs ! i) (ys ! i) = g (xs ! i) (ys ! i))"
 by (simp add: expand_list_eq map2_length map2_nth)
 
 lemma map2_replicate: "map2 f x\<^bsup>n\<^esup> y\<^bsup>n\<^esup> = (f x y)\<^bsup>n\<^esup>"
 by (induct n, simp+)
 
 lemma map2_zip_conv: "\<And>ys.
   length xs \<le> length ys \<Longrightarrow>
   map2 f xs ys = map (\<lambda>(x,y). f x y) (zip xs ys)"
 apply (induct xs, simp)
 apply (case_tac ys, simp+)
 done
 
 lemma map2_rev: "\<And>ys.
   length xs = length ys \<Longrightarrow>
   rev (map2 f xs ys) = map2 f (rev xs) (rev ys)"
 apply (induct xs, simp)
 apply (case_tac ys, simp)
 apply (simp add: map2_Cons_Cons map2_snoc_snoc)
 done
 
 hide_const (open) map2
 
 end
diff --git a/thys/LocalLexing/Derivations.thy b/thys/LocalLexing/Derivations.thy
--- a/thys/LocalLexing/Derivations.thy
+++ b/thys/LocalLexing/Derivations.thy
@@ -1,942 +1,942 @@
 theory Derivations
 imports CFG ListTools InductRules
 begin
 
 (* leftderives and leftderives1 *)
 context CFG begin
 
 lemma [simp]: "is_terminal t \<Longrightarrow> is_symbol t"
   by (auto simp add: is_terminal_def is_symbol_def)
 
 lemma [simp]: "is_sentence []" by (auto simp add: is_sentence_def)
 
 lemma [simp]: "is_word []" by (auto simp add: is_word_def)
 
 lemma [simp]: "is_word u \<Longrightarrow> is_sentence u"
   by (induct u, auto simp add: is_word_def is_sentence_def)
 
 definition leftderives1 :: "sentence \<Rightarrow> sentence \<Rightarrow> bool"
 where
   "leftderives1 u v = 
      (\<exists> x y N \<alpha>. 
           u = x @ [N] @ y
         \<and> v = x @ \<alpha> @ y
         \<and> is_word x
         \<and> is_sentence y
         \<and> (N, \<alpha>) \<in> \<RR>)"  
 
 lemma leftderives1_implies_derives1[simp]: "leftderives1 u v \<Longrightarrow> derives1 u v"
   apply (auto simp add: leftderives1_def derives1_def)
   apply (rule_tac x="x" in exI)
   apply (rule_tac x="y" in exI)
   apply (rule_tac x="N" in exI)
   by auto
 
 definition leftderivations1 :: "(sentence \<times> sentence) set"
 where
   "leftderivations1 = { (u,v) | u v. leftderives1 u v }"
 
 lemma [simp]: "leftderivations1 \<subseteq> derivations1"
   by (auto simp add: leftderivations1_def derivations1_def)
 
 definition leftderivations :: "(sentence \<times> sentence) set"
 where 
   "leftderivations = leftderivations1^*"
 
 lemma rtrancl_subset_implies: "a \<subseteq> b \<Longrightarrow> a \<subseteq> b^*" by blast
 
 lemma leftderivations_subset_derivations[simp]: "leftderivations \<subseteq> derivations"
   apply (simp add: leftderivations_def derivations_def)
   apply (rule rtrancl_subset_rtrancl)
   apply (rule rtrancl_subset_implies)
   by simp
 
 definition leftderives :: "sentence \<Rightarrow> sentence \<Rightarrow> bool"
 where
   "leftderives u v = ((u, v) \<in> leftderivations)"
 
 lemma leftderives_implies_derives[simp]: "leftderives u v \<Longrightarrow> derives u v"
   apply (auto simp add: leftderives_def derives_def)
   by (rule subsetD[OF leftderivations_subset_derivations])
 
 definition is_leftderivation :: "sentence \<Rightarrow> bool"
 where
   "is_leftderivation u = leftderives [\<SS>] u"
 
 lemma leftderivation_implies_derivation[simp]: 
   "is_leftderivation u \<Longrightarrow> is_derivation u"
   by (simp add: is_leftderivation_def is_derivation_def)
 
 lemma leftderives_refl[simp]: "leftderives u u"
   by (auto simp add: leftderives_def leftderivations_def)
 
 lemma leftderives1_implies_leftderives[simp]:"leftderives1 a b \<Longrightarrow> leftderives a b"
   by (auto simp add: leftderives_def leftderivations_def leftderivations1_def)
 
 lemma leftderives_trans: "leftderives a b \<Longrightarrow> leftderives b c \<Longrightarrow> leftderives a c"
   by (auto simp add: leftderives_def leftderivations_def)
 
 lemma leftderives1_eq_leftderivations1: "leftderives1 x y = ((x, y) \<in> leftderivations1)"
   by (simp add: leftderivations1_def)
 
 lemma leftderives_induct[consumes 1, case_names Base Step]:
   assumes derives: "leftderives a b"
   assumes Pa: "P a"
   assumes induct: "\<And>y z. leftderives a y \<Longrightarrow> leftderives1 y z \<Longrightarrow> P y \<Longrightarrow> P z"
   shows "P b"
 proof -
   note rtrancl_lemma = rtrancl_induct[where a = a and b = b and r = leftderivations1 and P=P]
   from derives Pa induct rtrancl_lemma show "P b"
     by (metis leftderives_def leftderivations_def leftderives1_eq_leftderivations1)
 qed
 
 end
 
 (* Basic lemmas about derives1 and derives *)
 context CFG begin
 
 lemma derives1_implies_derives[simp]:"derives1 a b \<Longrightarrow> derives a b"
   by (auto simp add: derives_def derivations_def derivations1_def)
 
 lemma derives_trans: "derives a b \<Longrightarrow> derives b c \<Longrightarrow> derives a c"
   by (auto simp add: derives_def derivations_def)
 
 lemma derives1_eq_derivations1: "derives1 x y = ((x, y) \<in> derivations1)"
   by (simp add: derivations1_def)
 
 lemma derives_induct[consumes 1, case_names Base Step]:
   assumes derives: "derives a b"
   assumes Pa: "P a"
   assumes induct: "\<And>y z. derives a y \<Longrightarrow> derives1 y z \<Longrightarrow> P y \<Longrightarrow> P z"
   shows "P b"
 proof -
   note rtrancl_lemma = rtrancl_induct[where a = a and b = b and r = derivations1 and P=P]
   from derives Pa induct rtrancl_lemma show "P b"
     by (metis derives_def derivations_def derives1_eq_derivations1)
 qed
 
 end
 
 (* Derives1 and Derivation, LDerives1 and LDerivation *)
 context CFG begin
 
 definition Derives1 :: "sentence \<Rightarrow> nat \<Rightarrow> rule \<Rightarrow> sentence \<Rightarrow> bool"
 where
   "Derives1 u i r v = 
      (\<exists> x y N \<alpha>. 
           u = x @ [N] @ y
         \<and> v = x @ \<alpha> @ y
         \<and> is_sentence x
         \<and> is_sentence y
         \<and> (N, \<alpha>) \<in> \<RR>
         \<and> r = (N, \<alpha>) \<and> i = length x)"  
 
 lemma Derives1_split:
   "Derives1 u i r v \<Longrightarrow> \<exists> x y. u = x @ [fst r] @ y \<and> v = x @ (snd r) @ y \<and> length x = i"
 by (metis Derives1_def fst_conv snd_conv)
 
 lemma Derives1_implies_derives1: "Derives1 u i r v \<Longrightarrow> derives1 u v"
   by (auto simp add: Derives1_def derives1_def)
 
 lemma derives1_implies_Derives1: "derives1 u v \<Longrightarrow> \<exists> i r. Derives1 u i r v"
   by (auto simp add: Derives1_def derives1_def)
 
 lemma Derives1_unique_dest: "Derives1 u i r v \<Longrightarrow> Derives1 u i r w \<Longrightarrow> v = w"
   by (auto simp add: Derives1_def derives1_def)
 
 lemma Derives1_unique_src: "Derives1 u i r w \<Longrightarrow> Derives1 v i r w \<Longrightarrow> u = v"
   by (auto simp add: Derives1_def derives1_def)
 
 type_synonym derivation = "(nat \<times> rule) list"
 
 fun Derivation :: "sentence \<Rightarrow> derivation \<Rightarrow> sentence \<Rightarrow> bool"
 where
   "Derivation a [] b = (a = b)"
 | "Derivation a (d#D) b = (\<exists> x. Derives1 a (fst d) (snd d) x \<and> Derivation x D b)"
 
 lemma Derivation_implies_derives: "Derivation a D b \<Longrightarrow> derives a b"
 proof (induct D arbitrary: a b)
   case Nil thus ?case 
     by (simp add: derives_def derivations_def)
 next
   case (Cons d D)
     note ihyps = this
     from ihyps have "\<exists> x. Derives1 a (fst d) (snd d) x \<and> Derivation x D b" by auto
     then obtain x where "Derives1 a (fst d) (snd d) x" and xb: "Derivation x D b" by blast
     with Derives1_implies_derives1 have d1: "derives a x" by auto
     from ihyps xb have d2:"derives x b" by simp
     show "derives a b" by (rule derives_trans[OF d1 d2])
 qed 
 
 lemma Derivation_Derives1: "Derivation a S y \<Longrightarrow> Derives1 y i r z \<Longrightarrow> Derivation a (S@[(i,r)]) z"
 proof (induct S arbitrary: a y z i r)
   case Nil thus ?case by simp
 next
   case (Cons s S) thus ?case 
     by (metis Derivation.simps(2) append_Cons) 
 qed
 
 lemma derives_implies_Derivation: "derives a b \<Longrightarrow> \<exists> D. Derivation a D b"
 proof (induct rule: derives_induct)
   case Base
   show ?case by (rule exI[where x="[]"], simp)
 next
   case (Step y z)
   note ihyps = this
   from ihyps obtain D where ay: "Derivation a D y" by blast
   from ihyps derives1_implies_Derives1 obtain i r where yz: "Derives1 y i r z" by blast
   from Derivation_Derives1[OF ay yz] show ?case by auto
 qed
     
 lemma Derives1_take: "Derives1 a i r b \<Longrightarrow> take i a = take i b"
   by (auto simp add: Derives1_def)
 
 lemma Derives1_drop: "Derives1 a i r b \<Longrightarrow> drop (Suc i) a = drop (i + length (snd r)) b"
   by (auto simp add: Derives1_def)
 
 lemma Derives1_bound: "Derives1 a i r b \<Longrightarrow> i < length a"
   by (auto simp add: Derives1_def)
 
 lemma Derives1_length: "Derives1 a i r b \<Longrightarrow> length b = length a + length (snd r) - 1"
   by (auto simp add: Derives1_def)
 
 definition leftmost :: "nat \<Rightarrow> sentence \<Rightarrow> bool"
 where
   "leftmost i s = (i < length s \<and> is_word (take i s) \<and> is_nonterminal (s ! i))" 
 
 lemma set_take: "set (take n s) = { s ! i | i. i < n \<and> i < length s}"
 proof (cases "n \<le> length s")
   case True thus ?thesis
   by (subst List.nth_image[symmetric], auto)
 next
   case False thus ?thesis
     apply (subst set_conv_nth)
     by (metis less_trans linear not_le take_all)
 qed
   
 lemma list_all_take: "list_all P (take n s) = (\<forall> i. i < n \<and> i < length s \<longrightarrow> P (s ! i))"
   by (auto simp add: set_take list_all_iff)
 
 lemma is_sentence_concat: "is_sentence (x@y) = (is_sentence x \<and> is_sentence y)"
   by (auto simp add: is_sentence_def)
 
 lemma is_sentence_cons: "is_sentence (x#xs) = (is_symbol x \<and> is_sentence xs)"
   by (auto simp add: is_sentence_def)
 
 lemma rule_nonterminal_type[simp]: "(N, \<alpha>) \<in> \<RR> \<Longrightarrow> is_nonterminal N"
   apply (insert validRules)
   by (auto simp add: is_nonterminal_def)
 
 lemma rule_\<alpha>_type[simp]: "(N, \<alpha>) \<in> \<RR> \<Longrightarrow> is_sentence \<alpha>"
   apply (insert validRules)
   by (auto simp add: is_sentence_def is_symbol_def list_all_iff is_terminal_def is_nonterminal_def)
 
 lemma [simp]: "is_nonterminal N \<Longrightarrow> is_symbol N"
   by (simp add: is_symbol_def)
 
 lemma Derives1_sentence1[elim]: "Derives1 a i r b \<Longrightarrow> is_sentence a"
   by (auto simp add: Derives1_def is_sentence_cons is_sentence_concat)
 
 lemma Derives1_sentence2[elim]: "Derives1 a i r b \<Longrightarrow> is_sentence b"
   by (auto simp add: Derives1_def is_sentence_cons is_sentence_concat)
 
 lemma [elim]: "Derives1 a i r b \<Longrightarrow> r \<in> \<RR>"
   using Derives1_def by auto
 
 lemma is_sentence_symbol: "is_sentence a \<Longrightarrow> i < length a \<Longrightarrow> is_symbol (a ! i)"
   by (simp add: is_sentence_def list_all_iff)
 
 lemma is_symbol_distinct: "is_symbol x \<Longrightarrow> is_terminal x \<noteq> is_nonterminal x"
   apply (insert disjunct_symbols)
   apply (auto simp add: is_symbol_def is_terminal_def is_nonterminal_def)
   done
 
 lemma is_terminal_nonterminal: "is_terminal x \<Longrightarrow> is_nonterminal x \<Longrightarrow> False"
   by (metis is_symbol_def is_symbol_distinct)
 
 lemma Derives1_leftmost:
   assumes "Derives1 a i r b"
   shows "\<exists> j. leftmost j a \<and> j \<le> i"
 proof -
   let ?J = "{j . j < length a \<and> is_nonterminal (a ! j)}"
   let ?M = "Min ?J"
   from assms have J1:"i \<in> ?J"
     apply (auto simp add: Derives1_def is_nonterminal_def)
     by (metis (mono_tags, lifting) prod.simps(2) validRules)
   have J2:"finite ?J" by auto
   note J = J1 J2
   from J have M1: "?M \<in> ?J" by (rule_tac Min_in, auto) 
   {
     fix j
     assume "j \<in> ?J"
     with J have "?M \<le> j" by auto
   }
   note M3 = this[OF J1]
   from assms have a_sentence: "is_sentence a" by (simp add: Derives1_sentence1)
   have is_word: "is_word (take ?M a)"
     apply (auto simp add: is_word_def list_all_take)
     proof -
       fix i
       assume i_less_M: "i < ?M"
       assume i_inbounds: "i < length a"
       show "is_terminal (a ! i)"
       proof(cases "is_terminal (a ! i)")
         case True thus ?thesis by auto
       next
         case False
         then have "is_nonterminal (a ! i)"
         using i_inbounds a_sentence is_sentence_symbol is_symbol_distinct by blast
         then have "i \<in> ?J" by (metis i_inbounds mem_Collect_eq) 
         then have "?M < i" by (metis J2 Min_le i_less_M leD) 
         then have "False" by (metis i_less_M less_asym') 
         then show ?thesis by auto
       qed
     qed  
   show ?thesis 
     apply (rule_tac exI[where x="?M"])
     apply (simp add: leftmost_def)
     by (metis (mono_tags, lifting) M1 M3 is_word mem_Collect_eq)
 qed
 
 lemma Derivation_leftmost: "D \<noteq> [] \<Longrightarrow> Derivation a D b \<Longrightarrow> \<exists> i. leftmost i a"
   apply (case_tac "D")
   apply (auto)
   apply (metis Derives1_leftmost)
   done
 
 lemma nonword_has_nonterminal:
   "is_sentence a \<Longrightarrow>  \<not> (is_word a) \<Longrightarrow> \<exists> k. k < length a \<and> is_nonterminal (a ! k)"
   apply (auto simp add: is_sentence_def list_all_iff is_word_def)
   by (metis in_set_conv_nth is_symbol_distinct)
 
 lemma leftmost_cons_nonterminal: 
   "is_nonterminal x \<Longrightarrow> leftmost 0 (x#xs)"
 by (metis CFG.is_word_def CFG_axioms leftmost_def length_greater_0_conv list.distinct(1) 
     list_all_simps(2) nth_Cons_0 take_Cons')
 
 lemma leftmost_cons_terminal: 
   "is_terminal x \<Longrightarrow> leftmost i (x#xs) = (i > 0 \<and> leftmost (i - 1) xs)"
 by (metis Suc_diff_1 Suc_less_eq is_terminal_nonterminal is_word_def leftmost_def length_Cons 
     list_all_simps(1) not_gr0 nth_Cons' take_Cons')
 
 lemma is_nonterminal_cons_terminal: 
   "is_terminal x \<Longrightarrow> k < length (x # a) \<Longrightarrow> is_nonterminal ((x # a) ! k) \<Longrightarrow>
    k > 0 \<and> k - 1 < length a \<and> is_nonterminal (a ! (k - 1))"
 by (metis One_nat_def Suc_leI is_terminal_nonterminal less_diff_conv2 
     list.size(4) nth_non_equal_first_eq)
 
 lemma leftmost_exists:
   "is_sentence a \<Longrightarrow> k < length a \<Longrightarrow> is_nonterminal (a ! k) \<Longrightarrow> 
    \<exists> i. leftmost i a \<and> i \<le> k" 
 proof (induct a arbitrary: k)
   case Nil thus ?case by auto
 next
   case (Cons x a) 
   show ?case
   proof(cases "is_nonterminal x")
     case True thus ?thesis
       apply(rule_tac exI[where x="0"])
       apply (simp add: leftmost_cons_nonterminal)
       done
   next
     case False
     then have x: "is_terminal x"
       by (metis Cons.prems(1) is_sentence_cons is_symbol_distinct)
     note k = is_nonterminal_cons_terminal[OF x Cons(3) Cons(4)]
     with Cons have "\<exists>i. leftmost i a \<and> i \<le> k - 1" by (metis is_sentence_cons)
     then show ?thesis
       apply (auto simp add: leftmost_cons_terminal[OF x])
-      by (metis Nat.le_diff_conv2 Suc_leI add_Suc_right add_diff_cancel_right' k 
+      by (metis le_diff_conv2 Suc_leI add_Suc_right add_diff_cancel_right' k 
           le_0_eq le_imp_less_Suc nat_le_linear)
   qed
 qed
 
 lemma nonword_leftmost_exists: 
   "is_sentence a \<Longrightarrow> \<not> (is_word a) \<Longrightarrow> \<exists> i. leftmost i a"
   by (metis leftmost_exists nonword_has_nonterminal)
   
 lemma leftmost_unaffected_Derives1: "leftmost j a \<Longrightarrow> j < i \<Longrightarrow> Derives1 a i r b \<Longrightarrow> leftmost j b"
 apply (simp add: leftmost_def)
 proof -
   assume a1: "j < length a \<and> is_word (take j a) \<and> is_nonterminal (a ! j)"
   assume a2: "j < i"
   assume "Derives1 a i r b"
   then have f3: "take i a = take i b"
     by (metis Derives1_take)
   have f4: "\<And>n ss ssa. take (length (take n (ss::symbol list))) (ssa::symbol list) = take (length ss) (take n ssa)"
     by (metis length_take take_take)
   have f5: "\<And>ss. take j (ss::symbol list) = take i (take j ss)"
     using a2 by (metis dual_order.strict_implies_order min.absorb2 take_take)
   have f6: "length (take j a) = j"
     using a1 by (metis dual_order.strict_implies_order length_take min.absorb2)
   then have f7: "\<And>n. min j n = length (take n (take j a))"
     by (metis length_take)
   have f8: "\<And>n ss. n = length (take n (ss::symbol list)) \<or> length ss < n"
     by (metis leI length_take min.absorb2)
   have f9: "\<And>ss. take j (ss::symbol list) = take j (take i ss)"
     using f7 f6 f5 by (metis take_take)
   have f10: "\<And>ss n. length (ss::symbol list) \<le> n \<or> length (take n ss) = n"
     using f8 by (metis dual_order.strict_implies_order)
   then have f11: "\<And>ss ssa. length (ss::symbol list) = length (take (length ss) (ssa::symbol list)) \<or> length (take (length ssa) ss) = length ssa"
     by (metis length_take min.absorb2)
   have f12: "\<And>ss ssa n. take (length (ss::symbol list)) (ssa::symbol list) = take n (take (length ss) ssa) \<or> length (take n ss) = n"
     using f10 by (metis min.absorb2 take_take)
   { assume "\<not> j < j"
     { assume "\<not> j < j \<and> i \<noteq> j"
       moreover
       { assume "length a \<noteq> j \<and> length (take i a) \<noteq> i"
         then have "\<exists>ss. length (take (length (take i (take (length a) (ss::symbol list)))) (take j ss)) \<noteq> length (take i (take (length a) ss))"
           using f12 f11 f6 f5 f4 by metis
         then have "\<exists>ss ssa. take (length (ss::symbol list)) (take j (ssa::symbol list)) \<noteq> take (length ss) (take i (take (length a) ssa))"
           using f11 by metis
         then have "length b \<noteq> j"
           using f9 f4 f3 by metis }
       ultimately have "length b \<noteq> j"
         using f7 f6 f5 f3 a1 by (metis length_take) }
     then have "length b = j \<longrightarrow> j < j"
       using a2 by metis }
   then have "j < length b"
     using f9 f8 f7 f6 f4 f3 by metis
   then show "j < length b \<and> is_word (take j b) \<and> is_nonterminal (b ! j)"
     using f9 f3 a2 a1 by (metis nth_take)
 qed
 
 definition derivation_ge :: "derivation \<Rightarrow> nat \<Rightarrow> bool"
 where
   "derivation_ge D i = (\<forall> d \<in> set D. fst d \<ge> i)"
 
 lemma derivation_ge_cons: "derivation_ge (d#D) i = (fst d \<ge> i \<and> derivation_ge D i)"
   by (auto simp add: derivation_ge_def)
 
 lemma derivation_ge_append: 
   "derivation_ge (D@E) i = (derivation_ge D i \<and> derivation_ge E i)"
   by (auto simp add: derivation_ge_def)
 
 lemma leftmost_unaffected_Derivation: 
   "derivation_ge D (Suc i) \<Longrightarrow> leftmost i a \<Longrightarrow> Derivation a D b \<Longrightarrow> leftmost i b"
 proof (induct D arbitrary: a)
   case Nil thus ?case by auto
 next
   case (Cons d D) 
   then have "\<exists> x. Derives1 a (fst d) (snd d) x \<and> Derivation x D b" by simp
   then obtain x where x1: "Derives1 a (fst d) (snd d) x" and x2: "Derivation x D b" by blast  
   with Cons have leftmost_x: "leftmost i x"
     apply (rule_tac leftmost_unaffected_Derives1[
            where a=a and j=i and b="x" and i="fst d" and r="snd d"])
     by (auto simp add: derivation_ge_def)
   with Cons x2 show ?case by (auto simp add: derivation_ge_def)
 qed
 
 lemma le_Derives1_take: 
   assumes le: "i \<le> j" 
   and D: "Derives1 a j r b"
   shows "take i a = take i b"
 proof -
   note Derives1_take[where a=a and i=j and r=r and b=b]
   with le D show ?thesis by (rule_tac le_take_same[where i=i and j=j], auto)
 qed  
 
 lemma Derivation_take: "derivation_ge D i \<Longrightarrow> Derivation a D b \<Longrightarrow> take i a = take i b"
 proof(induct D arbitrary: a b)
   case Nil thus ?case by auto
 next
   case (Cons d D)
   then have "\<exists> x. Derives1 a (fst d) (snd d) x \<and> Derivation x D b"
     by simp
   then obtain x where ax: "Derives1 a (fst d) (snd d) x" and xb: "Derivation x D b" by blast  
   from derivation_ge_cons Cons(2) have d: "i \<le> fst d" and D: "derivation_ge D i" by auto
   note take_i_xb = Cons(1)[OF D xb]
   note take_i_ax = le_Derives1_take[OF d ax]
   from take_i_xb take_i_ax show ?case by auto
 qed
 
 lemma leftmost_cons_less: "i < length u \<Longrightarrow> leftmost i (u@v) = leftmost i u"
   by (auto simp add: leftmost_def nth_append)
 
 lemma leftmost_is_nonterminal: "leftmost i u \<Longrightarrow> is_nonterminal (u ! i)"
   by (metis leftmost_def)
 
 lemma is_word_is_terminal: "i < length u \<Longrightarrow> is_word u \<Longrightarrow> is_terminal (u ! i)"
   by (metis is_word_def list_all_length)
   
 lemma leftmost_append: 
   assumes leftmost: "leftmost i (u@v)"
   and is_word: "is_word u"
   shows "length u \<le> i"
 proof (cases "i < length u")
   case False thus ?thesis by auto
 next
   case True 
   with leftmost have "leftmost i u" using leftmost_cons_less[OF True] by simp
   then have is_nonterminal: "is_nonterminal (u ! i)" by (rule leftmost_is_nonterminal)
   note is_terminal = is_word_is_terminal[OF True is_word]
   note is_terminal_nonterminal[OF is_terminal is_nonterminal]
   then show ?thesis by auto
 qed
 
 lemma derivation_ge_empty[simp]: "derivation_ge [] i" 
 by (simp add: derivation_ge_def)
 
 lemma leftmost_notword: "leftmost i a \<Longrightarrow> j > i \<Longrightarrow> \<not> (is_word (take j a))"
 by (metis is_terminal_nonterminal is_word_def leftmost_def list_all_take)
 
 lemma leftmost_unique: "leftmost i a \<Longrightarrow> leftmost j a \<Longrightarrow> i = j" 
 by (metis leftmost_def leftmost_notword linorder_neqE_nat)
 
 lemma leftmost_Derives1: "leftmost i a \<Longrightarrow> Derives1 a j r b \<Longrightarrow> i \<le> j"
 by (metis Derives1_leftmost leftmost_unique)
 
 lemma leftmost_Derives1_propagate: 
   assumes leftmost: "leftmost i a"
       and Derives1: "Derives1 a j r b"
     shows "(is_word b \<and> i = j) \<or> (\<exists> k. leftmost k b \<and> i \<le> k)"
 proof -
   from leftmost_Derives1[OF leftmost Derives1] have ij: "i \<le> j" by auto
   show ?thesis
   proof (cases "is_word b")
     case True show ?thesis
       by (metis Derives1 True ij le_neq_implies_less leftmost 
           leftmost_unaffected_Derives1 order_refl)
   next
     case False show ?thesis
       by (metis (no_types, hide_lams) Derives1 Derives1_bound Derives1_sentence2 
           Derives1_take append_take_drop_id ij le_neq_implies_less leftmost 
           leftmost_append leftmost_cons_less leftmost_def length_take 
           min.absorb2 nat_le_linear nonword_leftmost_exists not_le)
   qed
 qed
 
 lemma is_word_Derives1[elim]: "is_word a \<Longrightarrow> Derives1 a i r b \<Longrightarrow> False"
 by (metis Derives1_leftmost is_terminal_nonterminal is_word_is_terminal leftmost_def)
   
 lemma is_word_Derivation[elim]: "is_word a \<Longrightarrow> Derivation a D b \<Longrightarrow> D = []"
 by (metis Derivation_leftmost is_terminal_nonterminal is_word_def 
     leftmost_def list_all_length)
  
 lemma leftmost_Derivation: 
   "leftmost i a \<Longrightarrow> Derivation a D b \<Longrightarrow> j \<le> i \<Longrightarrow> derivation_ge D j"
 proof (induct D arbitrary: a b i j)
   case Nil thus ?case by auto
 next
   case (Cons d D)
   then have "\<exists> x. Derives1 a (fst d) (snd d) x \<and> Derivation x D b" by auto
   then obtain x where ax:"Derives1 a (fst d) (snd d) x" and xb:"Derivation x D b" by blast
   note ji = Cons(4)
   note i_fstd = leftmost_Derives1[OF Cons(2) ax]
   note disj = leftmost_Derives1_propagate[OF Cons(2) ax]
   thus ?case
   proof(induct rule: disjCases2)
     case 1 
     with xb have "D = []" by auto
     with 1 ji show ?case by (simp add: derivation_ge_def)
   next
     case 2 
     then obtain k where k: "leftmost k x" and ik: "i \<le> k" by blast
     note ge = Cons(1)[OF k xb, where j=j]
     from ji ik i_fstd ge show ?case
       by (simp add: derivation_ge_cons)
   qed
 qed
 
 lemma derivation_ge_list_all: "derivation_ge D i = list_all (\<lambda> d. fst d \<ge> i) D"
 by (simp add: Ball_set derivation_ge_def)
 
 lemma split_derivation_leftmost:
   assumes "derivation_ge D i"
   and "\<not> (derivation_ge D (Suc i))"
   shows "\<exists> E F r. D = E@[(i, r)]@F \<and> derivation_ge E (Suc i)"
 proof -
   from assms have "\<exists> k. k < length D \<and> fst(D ! k) \<ge> i \<and> \<not>(fst(D ! k) \<ge> Suc i)"
     by (metis derivation_ge_def in_set_conv_nth)
   then have "\<exists> k. k < length D \<and> fst(D ! k) = i" by auto
   then show ?thesis
   proof(induct rule: ex_minimal_witness)
     case (Minimal k)
       then have k_len: "k < length D" and k_i: "fst (D ! k) = i" by auto
       let ?E = "take k D"
       let ?r = "snd (D ! k)"
       let ?F = "drop (Suc k) D"
       note split = split_list_at[OF k_len]
       from k_i have D_k: "D ! k = (i, ?r)" by auto
       show ?case
         apply (rule exI[where x="?E"])
         apply (rule exI[where x="?F"])
         apply (rule exI[where x="?r"])
         apply (subst D_k[symmetric])
         apply (rule conjI)
         apply (rule split)
         by (metis (mono_tags, lifting) Minimal.hyps(2) Suc_leI assms(1) 
             derivation_ge_list_all le_neq_implies_less list_all_length list_all_take)
   qed
 qed
 
 lemma Derives1_Derives1_swap:
   assumes "i < j"
   and "Derives1 a j p b"
   and "Derives1 b i q c"
   shows "\<exists> b'. Derives1 a i q b' \<and> Derives1 b' (j - 1 + length (snd q)) p c"
 proof -
   from Derives1_split[OF assms(2)] obtain a1 a2 where
     a_src: "a = a1 @ [fst p] @ a2" and a_dest: "b = a1 @ snd p @ a2" 
     and a1_len: "length a1 = j" by blast
   note a = this
   from a have is_sentence_a1: "is_sentence a1"
     using Derives1_sentence2 assms(2) is_sentence_concat by blast
   from a have is_sentence_a2: "is_sentence a2"
     using Derives1_sentence2 assms(2) is_sentence_concat by blast
   from a have is_symbol_fst_p:  "is_symbol (fst p)"
     by (metis Derives1_sentence1 assms(2) is_sentence_concat is_sentence_cons)
   from Derives1_split[OF assms(3)] obtain b1 b2 where
     b_src: "b = b1 @ [fst q] @ b2" and b_dest: "c = b1 @ snd q @ b2" 
     and b1_len: "length b1 = i" by blast
   have a_take_j: "a1 = take j a" by (metis a1_len a_src append_eq_conv_conj) 
   have b_take_i: "b1 @ [fst q] = take (Suc i) b"
     by (metis append_assoc append_eq_conv_conj b1_len b_src length_append_singleton) 
   from a_take_j b_take_i  take_eq_take_append[where j=j and i="Suc i" and a=a]
   have "\<exists> u. a1 = (b1 @ [fst q]) @ u"
     by (metis le_iff_add Suc_leI a1_len a_dest append_eq_conv_conj assms(1) take_add) 
   then obtain u where u1: "a1 = (b1 @ [fst q]) @ u" by blast
   then have j_i_u: "j = i + 1 + length u"
     using Suc_eq_plus1 a1_len b1_len length_append length_append_singleton by auto
   from u1 is_sentence_a1 have is_sentence_b1_u: "is_sentence b1 \<and> is_sentence u"
     using is_sentence_concat by blast    
   have u2: "b2 = u @ snd p @ a2" by (metis a_dest append_assoc b_src same_append_eq u1) 
   let ?b = "b1 @ (snd q) @ u @ [fst p] @ a2"
   from assms have q_dom: "q \<in> \<RR>" by auto
   have a_b': "Derives1 a i q ?b"
     apply (subst Derives1_def)
     apply (rule exI[where x="b1"])
     apply (rule exI[where x="u@[fst p]@a2"])
     apply (rule exI[where x="fst q"])
     apply (rule exI[where x="snd q"])
     apply (auto simp add: b1_len is_sentence_cons is_sentence_concat
            is_sentence_a2 is_symbol_fst_p is_sentence_b1_u a_src u1 q_dom)
     done
   from assms have p_dom: "p \<in> \<RR>" by auto
   have is_sentence_snd_q: "is_sentence (snd q)" 
     using Derives1_sentence2 a_b' is_sentence_concat by blast
   have b'_c: "Derives1 ?b (j - 1 + length (snd q)) p c"
     apply (subst Derives1_def)
     apply (rule exI[where x="b1 @ (snd q) @ u"])
     apply (rule exI[where x="a2"])
     apply (rule exI[where x="fst p"])
     apply (rule exI[where x="snd p"])
     apply (auto simp add: is_sentence_concat is_sentence_b1_u is_sentence_a2 p_dom
            is_sentence_snd_q b_dest u2 b1_len j_i_u)
     done
   show ?thesis
     apply (rule exI[where x="?b"])
     apply (rule conjI)
     apply (rule a_b')
     apply (rule b'_c)
     done
 qed
 
 definition derivation_shift :: "derivation \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> derivation"
 where
   "derivation_shift D left right = map (\<lambda> d. (fst d - left + right, snd d)) D"
 
 lemma derivation_shift_empty[simp]: "derivation_shift [] left right = []" 
   by (auto simp add: derivation_shift_def)
 
 lemma derivation_shift_cons[simp]:
   "derivation_shift (d#D) left right = ((fst d - left + right, snd d)#(derivation_shift D left right))"
 by (simp add: derivation_shift_def)
 
 lemma Derivation_append: "Derivation a (D@E) c = (\<exists> b. Derivation a D b \<and> Derivation b E c)"
 proof(induct D arbitrary: a c E)
   case Nil thus ?case by auto
 next
   case (Cons d D) thus ?case by auto
 qed
 
 lemma Derivation_implies_append: 
   "Derivation a D b \<Longrightarrow> Derivation b E c \<Longrightarrow> Derivation a (D@E) c"
 using Derivation_append by blast
 
 lemma Derivation_swap_single_end_to_front: 
   "i < j \<Longrightarrow> derivation_ge D j \<Longrightarrow> Derivation a (D@[(i,r)]) b \<Longrightarrow>
    Derivation a ((i,r)#(derivation_shift D 1 (length (snd r)))) b"
 proof(induct D arbitrary: a)
   case Nil thus ?case by auto
 next
   case (Cons d D) 
   from Cons have "\<exists> c. Derives1 a (fst d) (snd d) c \<and> Derivation c (D @ [(i, r)]) b"
     by simp
   then obtain c where ac: "Derives1 a (fst d) (snd d) c"
     and cb: "Derivation c (D @ [(i, r)]) b" by blast
   from Cons(3) have D_j: "derivation_ge D j" by (simp add: derivation_ge_cons)
   from Cons(1)[OF Cons(2) D_j cb, simplified]
   obtain x where cx: "Derives1 c i r x" and  
     xb: "Derivation x (derivation_shift D 1 (length (snd r))) b" by auto
   have i_fst_d: "i < fst d" using Cons derivation_ge_cons by auto
   from Derives1_Derives1_swap[OF i_fst_d ac cx]
   obtain b' where ab': "Derives1 a i r b'" and 
     b'x: "Derives1 b' (fst d - 1 + length (snd r)) (snd d) x" by blast
   show ?case using ab' b'x xb by auto
 qed    
 
 lemma Derivation_swap_single_mid_to_front: 
   assumes "i < j"
   and "derivation_ge D j" 
   and "Derivation a (D@[(i,r)]@E) b"
   shows "Derivation a ((i,r)#((derivation_shift D 1 (length (snd r)))@E)) b"
 proof -
   from assms have "\<exists> x. Derivation a (D@[(i, r)]) x \<and> Derivation x E b"
     using Derivation_append by auto
   then obtain x where ax: "Derivation a (D@[(i, r)]) x" and xb: "Derivation x E b"
     by blast
   with assms have "Derivation a ((i, r)#(derivation_shift D 1 (length (snd r)))) x"
     using Derivation_swap_single_end_to_front by blast
   then show ?thesis using Derivation_append xb by auto
 qed
 
 lemma length_derivation_shift[simp]: 
   "length(derivation_shift D left right) = length D"
   by (simp add: derivation_shift_def)
 
 definition LeftDerives1 :: "sentence \<Rightarrow> nat \<Rightarrow> rule \<Rightarrow> sentence \<Rightarrow> bool"
 where 
   "LeftDerives1 u i r v = (leftmost i u \<and> Derives1 u i r v)"
 
 lemma LeftDerives1_implies_leftderives1: "LeftDerives1 u i r v \<Longrightarrow> leftderives1 u v"
 by (metis Derives1_def LeftDerives1_def append_eq_conv_conj leftderives1_def 
     leftmost_def)
     
 lemma leftmost_Derives1_leftderives: 
   "leftmost i a \<Longrightarrow> Derives1 a i r b \<Longrightarrow> leftderives b c \<Longrightarrow> leftderives a c"
 using LeftDerives1_def LeftDerives1_implies_leftderives1 
   leftderives1_implies_leftderives leftderives_trans by blast
 
 theorem Derivation_implies_leftderives_gen:
   "Derivation a D (u@v) \<Longrightarrow> is_word u \<Longrightarrow> (\<exists> w. 
           leftderives a (u@w) \<and> 
           (v = [] \<longrightarrow> w = []) \<and> 
           (\<forall> X. is_first X v \<longrightarrow> is_first X w))"
 proof (induct "length D" arbitrary: D a u v)
   case 0
     then have "a = u@v" by auto
     thus ?case by (rule_tac x = v in exI, auto)
 next
   case (Suc n)
     from Suc have "D \<noteq> []" by auto
     with Suc Derivation_leftmost have "\<exists> i. leftmost i a" by auto
     then obtain i where i: "leftmost i a" by blast
     show "?case"
     proof (cases "derivation_ge D (Suc i)")
       case True
         with Suc have leftmost: "leftmost i (u@v)" 
           by (rule_tac leftmost_unaffected_Derivation[OF True i], auto)
         have length_u: "length u \<le> i" 
           using leftmost_append[OF leftmost Suc(4)] .
         have take_Suc: "take (Suc i) a = take (Suc i) (u@v)" 
           using  Derivation_take[OF True Suc(3)] .
         with length_u have is_prefix_u: "is_prefix u a"
           by (metis append_assoc append_take_drop_id dual_order.strict_implies_order 
               is_prefix_def le_imp_less_Suc take_all take_append)  
         have a: "u @ drop (length u) a = a" 
           using is_prefix_unsplit[OF is_prefix_u] .
         from take_Suc have length_take_Suc: "length (take (Suc i) a) = Suc i"
           by (metis Suc_leI i leftmost_def length_take min.absorb2)
         have v: "v \<noteq> []"
         proof(cases "v = []")
           case False thus ?thesis by auto
         next
           case True
           with length_u have right: "length(take (Suc i) (u@v)) = length u" by simp
           note left = length_take_Suc
           from left right take_Suc have "Suc i = length u" by auto
           with length_u show ?thesis by auto
         qed
         then have "\<exists> X w. v = X#w" by (cases v, auto)
         then obtain X w where v: "v = X#w" by blast
         have is_first_X: "is_first X (drop (length u) a)"
           apply (rule_tac is_first_drop_length[where v=v and w=w and k="Suc i"])
           apply (simp_all add: take_Suc v)
           apply (metis Suc_leI i leftmost_def)
           apply (insert length_u)
           apply arith
           done
         show ?thesis
           apply (rule exI[where x="drop (length u) a"])
           by (simp add: a v is_first_cons is_first_X)
     next
       case False
       have Di: "derivation_ge D i" 
       using leftmost_Derivation[OF i Suc(3), where j=i, simplified] .
       from split_derivation_leftmost[OF Di False]
       obtain E F r where D_split: "D = E @ [(i, r)] @ F" 
         and E_Suc: "derivation_ge E (Suc i)" by auto
       let ?D = "(derivation_shift E 1 (length (snd r)))@F"
       from D_split 
       have "Derivation a ((i,r) # ?D) (u @ v)"
         using Derivation_swap_single_mid_to_front E_Suc Suc.prems(1) lessI by blast
       then have "\<exists> y. Derives1 a i r y \<and> Derivation y ?D (u @ v)" by simp
       then obtain y where ay:"Derives1 a i r y" 
         and yuv: "Derivation y ?D (u @ v)" by blast
       have length_D': "length ?D = n" using D_split Suc.hyps(2) by auto
       from Suc(1)[OF length_D'[symmetric] yuv Suc(4)] 
       obtain w where "leftderives y (u @ w)" and "(v = [] \<longrightarrow> w = [])" 
         and "\<forall>X. is_first X v \<longrightarrow> is_first X w" by blast 
       then show ?thesis using ay i leftmost_Derives1_leftderives by blast
     qed    
 qed   
 
 lemma derives_implies_leftderives_gen: "derives a (u@v) \<Longrightarrow> is_word u \<Longrightarrow> (\<exists> w. 
           leftderives a (u@w) \<and> 
           (v = [] \<longrightarrow> w = []) \<and> 
           (\<forall> X. is_first X v \<longrightarrow> is_first X w))"
 using Derivation_implies_leftderives_gen derives_implies_Derivation by blast
 
 lemma derives_implies_leftderives: "derives a b \<Longrightarrow> is_word b \<Longrightarrow> leftderives a b"
 using derives_implies_leftderives_gen by force
 
 fun LeftDerivation :: "sentence \<Rightarrow> derivation \<Rightarrow> sentence \<Rightarrow> bool"
 where
   "LeftDerivation a [] b = (a = b)"
 | "LeftDerivation a (d#D) b = (\<exists> x. LeftDerives1 a (fst d) (snd d) x \<and> LeftDerivation x D b)"
   
 lemma LeftDerives1_implies_Derives1: "LeftDerives1 a i r b \<Longrightarrow> Derives1 a i r b"
 by (metis LeftDerives1_def)
 
 lemma LeftDerivation_implies_Derivation:
   "LeftDerivation a D b \<Longrightarrow> Derivation a D b"
 proof (induct D arbitrary: a)
   case (Nil) thus ?case by simp
 next
   case (Cons d D)
   thus ?case
   using CFG.LeftDerivation.simps(2) CFG_axioms Derivation.simps(2) 
     LeftDerives1_implies_Derives1 by blast 
 qed
 
 lemma LeftDerivation_implies_leftderives: "LeftDerivation a D b \<Longrightarrow> leftderives a b"
 proof (induct D arbitrary: a b)
   case Nil thus ?case by simp
 next
   case (Cons d D)
     note ihyps = this
     from ihyps have "\<exists> x. LeftDerives1 a (fst d) (snd d) x \<and> LeftDerivation x D b" by auto
     then obtain x where "LeftDerives1 a (fst d) (snd d) x" and xb: "LeftDerivation x D b" by blast
     with LeftDerives1_implies_leftderives1 have d1: "leftderives a x" by auto
     from ihyps xb have d2:"leftderives x b" by simp
     show "leftderives a b" by (rule leftderives_trans[OF d1 d2])
 qed 
 
 lemma leftmost_witness[simp]: "leftmost (length x) (x@(N#y)) = (is_word x \<and> is_nonterminal N)"
   by (auto simp add: leftmost_def)
 
 lemma leftderives1_implies_LeftDerives1: 
   assumes leftderives1: "leftderives1 u v"
   shows "\<exists> i r. LeftDerives1 u i r v"
 proof -
   from leftderives1 have 
     "\<exists>x y N \<alpha>. u = x @ [N] @ y \<and> v = x @ \<alpha> @ y \<and> is_word x \<and> is_sentence y \<and> (N, \<alpha>) \<in> \<RR>"
     by (simp add: leftderives1_def)
   then obtain x y N \<alpha> where 
     u:"u = x @ [N] @ y" and
     v:"v = x @ \<alpha> @ y" and
     x:"is_word x" and  
     y:"is_sentence y" and 
     r:"(N, \<alpha>) \<in> \<RR>"
     by blast
   show ?thesis
     apply (rule_tac x="length x" in exI)
     apply (rule_tac x="(N, \<alpha>)" in exI)
     apply (auto simp add: LeftDerives1_def)
     apply (simp add: leftmost_def x u rule_nonterminal_type[OF r])
     apply (simp add: Derives1_def u v)
     apply (rule_tac x=x in exI)
     apply (rule_tac x=y in exI)
     apply (auto simp add: x y r)
     done
 qed    
 
 lemma LeftDerivation_LeftDerives1: 
   "LeftDerivation a S y \<Longrightarrow> LeftDerives1 y i r z \<Longrightarrow> LeftDerivation a (S@[(i,r)]) z"
 proof (induct S arbitrary: a y z i r)
   case Nil thus ?case by simp
 next
   case (Cons s S) thus ?case 
     by (metis LeftDerivation.simps(2) append_Cons) 
 qed
 
 lemma leftderives_implies_LeftDerivation: "leftderives a b \<Longrightarrow> \<exists> D. LeftDerivation a D b"
 proof (induct rule: leftderives_induct)
   case Base
   show ?case by (rule exI[where x="[]"], simp)
 next
   case (Step y z)
   note ihyps = this
   from ihyps obtain D where ay: "LeftDerivation a D y" by blast
   from ihyps leftderives1_implies_LeftDerives1 obtain i r where yz: "LeftDerives1 y i r z" by blast
   from LeftDerivation_LeftDerives1[OF ay yz] show ?case by auto
 qed
 
 lemma LeftDerivation_append: 
   "LeftDerivation a (D@E) c = (\<exists> b. LeftDerivation a D b \<and> LeftDerivation b E c)"
 proof(induct D arbitrary: a c E)
   case Nil thus ?case by auto
 next
   case (Cons d D) thus ?case by auto
 qed
 
 lemma LeftDerivation_implies_append: 
   "LeftDerivation a D b \<Longrightarrow> LeftDerivation b E c \<Longrightarrow> LeftDerivation a (D@E) c"
 using LeftDerivation_append by blast
 
 lemma Derivation_unique_dest: "Derivation a D b \<Longrightarrow> Derivation a D c \<Longrightarrow> b = c"
   apply (induct D arbitrary: a b c)
   apply auto
   using Derives1_unique_dest by blast
 
 lemma Derivation_unique_src: "Derivation a D c \<Longrightarrow> Derivation b D c \<Longrightarrow> a = b"
   apply (induct D arbitrary: a b c)
   apply auto
   using Derives1_unique_src by blast
 
 lemma LeftDerives1_unique: "LeftDerives1 a i r b \<Longrightarrow> LeftDerives1 a j s b \<Longrightarrow> i = j \<and> r = s"
 using Derives1_def LeftDerives1_def leftmost_unique by auto
  
 lemma leftlang: "\<L> = { v | v. is_word v \<and> is_leftderivation v }"
 by (metis (no_types, lifting) CFG.is_derivation_def CFG.is_leftderivation_def 
     CFG.leftderivation_implies_derivation CFG_axioms Collect_cong 
     \<L>_def derives_implies_leftderives)
   
 lemma leftprefixlang:  "\<L>\<^sub>P = { u | u v. is_word u \<and> is_leftderivation (u@v) }"
 apply (auto simp add: \<L>\<^sub>P_def)
 using derives_implies_leftderives_gen is_derivation_def is_leftderivation_def apply blast
 using leftderivation_implies_derivation by blast
 
 lemma derives_implies_leftderives_cons:
   "is_word a \<Longrightarrow> derives u (a@X#b) \<Longrightarrow> \<exists> c. leftderives u  (a@X#c)"
 by (metis append_Cons append_Nil derives_implies_leftderives_gen is_first_def) 
 
 lemma is_word_append[simp]: "is_word (a@b) = (is_word a \<and> is_word b)"
   by (auto simp add: is_word_def)
 
 lemma \<L>\<^sub>P_split: "a@b \<in> \<L>\<^sub>P \<Longrightarrow> a \<in> \<L>\<^sub>P"
   by (auto simp add: \<L>\<^sub>P_def)
 
 lemma \<L>\<^sub>P_is_word: "a \<in> \<L>\<^sub>P \<Longrightarrow> is_word a"
   by (metis (no_types, lifting) leftprefixlang mem_Collect_eq)
 
 definition Derive :: "sentence \<Rightarrow> derivation \<Rightarrow> sentence"
 where 
   "Derive a D = (THE b. Derivation a D b)"
 
 lemma Derivation_dest_ex_unique: "Derivation a D b \<Longrightarrow> \<exists>! x. Derivation a D x"
 using CFG.Derivation_unique_dest CFG_axioms by blast
 
 lemma Derive:
   assumes ab: "Derivation a D b"
   shows "Derive a D = b"
 proof -
   note the1_equality[OF Derivation_dest_ex_unique[OF ab] ab]
   thus ?thesis by (simp add: Derive_def)
 qed
 
 end
 
 end
 
diff --git a/thys/LocalLexing/Ladder.thy b/thys/LocalLexing/Ladder.thy
--- a/thys/LocalLexing/Ladder.thy
+++ b/thys/LocalLexing/Ladder.thy
@@ -1,3579 +1,3579 @@
 theory Ladder
 imports TheoremD9
 begin
 
 context LocalLexing begin
 
 definition LeftDerivationFix :: "sentence \<Rightarrow> nat \<Rightarrow> derivation \<Rightarrow> nat \<Rightarrow> sentence \<Rightarrow> bool"
 where
   "LeftDerivationFix \<alpha> i D j \<beta> = (is_sentence \<alpha> \<and> is_sentence \<beta> 
      \<and> LeftDerivation \<alpha> D \<beta> \<and> i < length \<alpha> \<and> j < length \<beta>
      \<and> \<alpha> ! i = \<beta> ! j \<and> (\<exists> E F. D = E@(derivation_shift F 0 (Suc j)) \<and> 
        LeftDerivation (take i \<alpha>) E (take j \<beta>) \<and>
        LeftDerivation (drop (Suc i) \<alpha>) F (drop (Suc j) \<beta>)))" 
 
 definition LeftDerivationIntro :: 
   "sentence \<Rightarrow> nat \<Rightarrow> rule \<Rightarrow> nat \<Rightarrow> derivation \<Rightarrow> nat \<Rightarrow> sentence \<Rightarrow> bool"
 where
   "LeftDerivationIntro \<alpha> i r ix D j \<gamma> = (\<exists> \<beta>. LeftDerives1 \<alpha> i r \<beta> \<and>  
      ix < length (snd r) \<and> (snd r) ! ix = \<gamma> ! j \<and>
      LeftDerivationFix \<beta> (i + ix) D j \<gamma>)"
 
 lemma LeftDerivationFix_empty[simp]: "is_sentence \<alpha> \<Longrightarrow> i < length \<alpha> \<Longrightarrow> LeftDerivationFix \<alpha> i [] i \<alpha>"
   apply (auto simp add: LeftDerivationFix_def)
   apply (rule_tac x="[]" in exI)
   apply auto
   done
 
 lemma Derive_empty[simp]: "Derive a [] = a"
   by (auto simp add: Derive_def)
 
 lemma LeftDerivation_append1: "LeftDerivation a (D@[(i, r)]) c \<Longrightarrow> \<exists> b. LeftDerivation a D b 
   \<and> LeftDerives1 b i r c"
 by (simp add: LeftDerivation_append)
 
 lemma Derivation_append1: "Derivation a (D@[(i, r)]) c \<Longrightarrow> \<exists> b. Derivation a D b 
   \<and> Derives1 b i r c"
 by (simp add: Derivation_append)
 
 lemma  Derivation_take_derive:
   assumes "Derivation a D b"
   shows "Derivation a (take n D) (Derive a (take n D))"
 by (metis Derivation_append Derive append_take_drop_id assms)
 
 lemma  LeftDerivation_take_derive:
   assumes "LeftDerivation a D b"
   shows "LeftDerivation a (take n D) (Derive a (take n D))"
 by (metis Derive LeftDerivation_append LeftDerivation_implies_Derivation append_take_drop_id assms)
 
 lemma Derivation_Derive_take_Derives1:
   assumes "N \<noteq> 0"
   assumes "N \<le> length D"
   assumes "Derivation a D b"
   assumes \<alpha>: "\<alpha> = Derive a (take (N - 1) D)"
   assumes "\<beta> = Derive a (take N D)"
   shows "Derives1 \<alpha> (fst (D ! (N - 1))) (snd (D ! (N - 1))) \<beta>"
 proof -
   let ?D1 = "take (N - 1) D"
   let ?D2 = "take N D"
   from assms have app: "?D2 = ?D1 @ [D ! (N - 1)]"
     apply auto
     by (metis Suc_less_eq Suc_pred le_imp_less_Suc take_Suc_conv_app_nth)
   from assms have "Derivation a ?D2 \<beta>"
     using Derivation_take_derive by blast
   with app show ?thesis
     using Derivation.simps Derivation_append Derive \<alpha> by auto   
 qed    
 
 lemma LeftDerivation_Derive_take_LeftDerives1:
   assumes "N \<noteq> 0"
   assumes "N \<le> length D"
   assumes "LeftDerivation a D b"
   assumes \<alpha>: "\<alpha> = Derive a (take (N - 1) D)"
   assumes "\<beta> = Derive a (take N D)"
   shows "LeftDerives1 \<alpha> (fst (D ! (N - 1))) (snd (D ! (N - 1))) \<beta>"
 proof -
   let ?D1 = "take (N - 1) D"
   let ?D2 = "take N D"
   from assms have app: "?D2 = ?D1 @ [D ! (N - 1)]"
     apply auto
     by (metis Suc_less_eq Suc_pred le_imp_less_Suc take_Suc_conv_app_nth)
   from assms have "LeftDerivation a ?D2 \<beta>"
     using LeftDerivation_take_derive by blast
   with app show ?thesis
     by (metis Derive LeftDerivation_append1 LeftDerivation_implies_Derivation \<alpha> prod.collapse)
 qed
 
 lemma LeftDerives1_skip_prefix:
   "length a \<le> i \<Longrightarrow> LeftDerives1 (a@b) i r (a@c) \<Longrightarrow> LeftDerives1 b (i - length a) r c"
 apply (auto simp add: LeftDerives1_def)
 using leftmost_skip_prefix apply blast
 by (simp add: Derives1_skip_prefix)
 
 lemma LeftDerives1_skip_suffix:
   assumes i: "i < length a"
   assumes D: "LeftDerives1 (a@c) i r (b@c)"
   shows "LeftDerives1 a i r b"
 proof -
   note Derives1_def[where u="a@c" and v="b@c" and i=i and r=r]
   then have "\<exists>x y N \<alpha>.
     a @ c = x @ [N] @ y \<and>
     b @ c = x @ \<alpha> @ y \<and> is_sentence x \<and> is_sentence y \<and> (N, \<alpha>) \<in> \<RR> \<and> r = (N, \<alpha>) \<and> i = length x"
     using D LeftDerives1_implies_Derives1 by auto 
   then obtain x y N \<alpha> where split:
     "a @ c = x @ [N] @ y \<and>
      b @ c = x @ \<alpha> @ y \<and> is_sentence x \<and> is_sentence y \<and> (N, \<alpha>) \<in> \<RR> \<and> r = (N, \<alpha>) \<and> i = length x"
      by blast
   from split have "length (a@c) = length (x @ [N] @ y)" by auto
   then have "length a + length c = length x + length y + 1" by simp
   with split have "length a + length c = i + length y + 1" by simp
   with i have len_c_y: "length c \<le> length y" by arith
   let ?y = "take (length y - length c) y"
   from split have ac: "a @ c = (x @ [N]) @ y" by auto
   note cancel_suffix[where a=a and c = c and b = "x@[N]" and d = "y", OF ac len_c_y]
   then have a: "a = x @ [N] @ ?y" by auto
   from split have bc: "b @ c = (x @ \<alpha>) @ y" by auto
   note cancel_suffix[where a=b and c = c and b = "x@\<alpha>" and d = "y", OF bc len_c_y]
   then have b: "b = x @ \<alpha> @ ?y" by auto
   from split len_c_y a b show ?thesis
     apply (simp only: LeftDerives1_def Derives1_def)
     apply (rule_tac conjI)
     using D LeftDerives1_def i leftmost_cons_less apply blast    
     apply (rule_tac x=x in exI)
     apply (rule_tac x="?y" in exI)
     apply (rule_tac x="N" in exI)
     apply (rule_tac x="\<alpha>" in exI)
     apply auto
     by (rule is_sentence_take)
 qed
 
 lemma LeftDerives1_X_is_part_of_rule[consumes 2, case_names Suffix Prefix]:
   assumes aXb: "LeftDerives1 \<delta> i r (a@[X]@b)"
   assumes split: "splits_at \<delta> i \<alpha> N \<beta>"
   assumes prefix: "\<And> \<beta>. \<delta> = a @ [X] @ \<beta> \<Longrightarrow> length a < i \<Longrightarrow> is_word (a @ [X]) \<Longrightarrow>
                      LeftDerives1 \<beta> (i - length a - 1) r b \<Longrightarrow> False"
   assumes suffix: "\<And> \<alpha>. \<delta> = \<alpha> @ [X] @ b \<Longrightarrow> LeftDerives1 \<alpha> i r a \<Longrightarrow> False" 
   shows "\<exists> u v. a = \<alpha> @ u \<and> b = v @ \<beta> \<and> (snd r) = u@[X]@v"
 proof -
   have aXb_old: "Derives1 \<delta> i r (a@[X]@b)"
     using LeftDerives1_implies_Derives1 aXb by blast
   have prefix_or: "is_prefix \<alpha> a \<or> is_proper_prefix a \<alpha>"
     by (metis Derives1_prefix split aXb_old is_prefix_eq_proper_prefix)
   have is_word_\<alpha>: "is_word \<alpha>"
     using LeftDerives1_splits_at_is_word aXb assms(2) by blast 
   have "is_proper_prefix a \<alpha> \<Longrightarrow> False"
   proof -
     assume proper:"is_proper_prefix a \<alpha>"
     then have "\<exists> u. u \<noteq> [] \<and> \<alpha> = a@u" by (metis is_proper_prefix_def)
     then obtain u where u: "u \<noteq> [] \<and> \<alpha> = a@u" by blast
     note splits_at = splits_at_\<alpha>[OF aXb_old split] splits_at_combine[OF split]
     from splits_at have \<alpha>1: "\<alpha> = take i \<delta>" by blast
     from splits_at have \<alpha>2: "\<alpha> = take i (a@[X]@b)" by blast
     from splits_at have len\<alpha>: "length \<alpha> = i" by blast
     with proper have lena: "length a < i"
       using append_eq_conv_conj drop_eq_Nil leI u by auto 
     with is_word_\<alpha> \<alpha>2 have is_word_aX: "is_word (a@[X])"
       by (simp add: is_word_terminals not_less take_Cons' u)
     from u \<alpha>2 have "a@u = take i (a@[X]@b)" by auto
     with lena have "u = take (i - length a) ([X]@b)" by (simp add: less_or_eq_imp_le) 
     with lena have uX: "u = [X]@(take (i - length a - 1) b)" by (simp add: not_less take_Cons')
     let ?\<beta> = "(take (i - length a - 1) b) @ [N] @ \<beta>"
     from splits_at have f1: "\<delta> = \<alpha> @ [N] @ \<beta>" by blast
     with u uX have f2: "\<delta> = a @ [X] @ ?\<beta>" by simp
     note skip = LeftDerives1_skip_prefix[where a = "a @ [X]" and b = "?\<beta>" and 
       r = r and i = i and c = b]
     then have D: "LeftDerives1 ?\<beta> (i - length a - 1) r b"
       using One_nat_def Suc_leI aXb append_assoc diff_diff_left f2 lena length_Cons 
         length_append length_append_singleton list.size(3) by fastforce
     note prefix[OF f2 lena is_word_aX D]
     then show "False" .
   qed
   with prefix_or have is_prefix: "is_prefix \<alpha> a" by blast
 
   from aXb have aXb': "LeftDerives1 \<delta> i r ((a@[X])@b)" by auto
   then have aXb'_old: "Derives1 \<delta> i r ((a@[X])@b)" by (simp add: LeftDerives1_implies_Derives1)  
   note Derives1_suffix[OF aXb'_old split]
   then have suffix_or: "is_suffix \<beta> b \<or> is_proper_suffix b \<beta>"
     by (metis is_suffix_eq_proper_suffix)
   have "is_proper_suffix b \<beta> \<Longrightarrow> False"
   proof -
     assume proper: "is_proper_suffix b \<beta>"
     then have "\<exists> u. u \<noteq> [] \<and> \<beta> = u@b" by (metis is_proper_suffix_def)
     then obtain u where u: "u \<noteq> [] \<and> \<beta> = u@b" by blast
     note splits_at = splits_at_\<beta>[OF aXb_old split] splits_at_combine[OF split]
     from splits_at have \<beta>1: "\<beta> = drop (Suc i) \<delta>" by blast
     from splits_at have \<beta>2: "\<beta> = drop (i + length (snd r)) (a @ [X] @ b)" by blast
     from splits_at have len\<beta>: "length \<beta> = length \<delta> - i - 1" by blast
     with proper have lenb: "length b < length \<beta>" by (metis is_proper_suffix_length_cmp) 
     from u \<beta>2 have "u@b = drop (i + length (snd r)) ((a @ [X]) @ b)" by auto
     hence "u = drop (i + length (snd r)) (a @ [X])" 
       by (metis drop_cancel_suffix)
     hence uX: "u = drop (i + length (snd r)) a @ [X]" by (metis drop_keep_last u)
     let ?\<alpha> = "\<alpha> @ [N] @ (drop (i + length (snd r)) a)"
     from splits_at have f1: "\<delta> = \<alpha> @ [N] @ \<beta>" by blast
     with u uX have f2: "\<delta> = ?\<alpha> @ [X] @ b" by simp
     note skip = LeftDerives1_skip_suffix[where a = "?\<alpha>" and c = "[X]@b" and b="a" and
       r = r and i = i]
     have f3: "i < length (\<alpha> @ [N] @ drop (i + length (snd r)) a)"
     proof -
       have f1: "1 + i + length b = length [X] + length b + i"
         by (metis Groups.add_ac(2) Suc_eq_plus1_left length_Cons list.size(3) list.size(4) semiring_normalization_rules(22))
       have f2: "length \<delta> - i - 1 = length ((\<alpha> @ [N] @ drop (i + length (snd r)) a) @ [X] @ b) - Suc i"
         by (metis f2 length_drop splits_at(1))
       have "length ([]::symbol list) \<noteq> length \<delta> - i - 1 - length b"
         by (metis add_diff_cancel_right' append_Nil2 append_eq_append_conv len\<beta> length_append u)
       then have "length ([]::symbol list) \<noteq> length \<alpha> + length ([N] @ drop (i + length (snd r)) a) - i"
         using f2 f1 by (metis Suc_eq_plus1_left add_diff_cancel_right' diff_diff_left length_append)
       then show ?thesis
         by auto
     qed
     from aXb f2 have D: "LeftDerives1 (?\<alpha> @ [X] @ b) i r (a@[X]@b)" by auto
     note skip[OF f3 D]
     note suffix[OF f2  skip[OF f3 D]]
     then show "False" .
   qed
   with suffix_or have is_suffix: "is_suffix \<beta> b" by blast
 
   from is_prefix have "\<exists> u. a = \<alpha> @ u" by (auto simp add: is_prefix_def)
   then obtain u where u: "a = \<alpha> @ u" by blast
   from is_suffix have "\<exists> v. b = v @ \<beta>" by (auto simp add: is_suffix_def)
   then obtain v where v: "b = v @ \<beta>" by blast
   
   from u v splits_at_combine[OF split] aXb have D:"LeftDerives1 (\<alpha>@[N]@\<beta>) i r (\<alpha>@(u@[X]@v)@\<beta>)"
     by simp
   from splits_at_\<alpha>[OF aXb_old split] have i: "length \<alpha> = i" by blast
   from i have i1: "length \<alpha> \<le> i" and i2: "i \<le> length \<alpha>" by auto
   note LeftDerives1_skip_suffix[OF _ LeftDerives1_skip_prefix[OF i1 D], simplified, OF i2]
   then have "LeftDerives1 [N] 0 r (u @ [X] @ v)" by auto
   then have "Derives1 [N] 0 r (u @ [X] @ v)"
     using LeftDerives1_implies_Derives1 by auto 
   then have r: "snd r = u @ [X] @ v"  
     by (metis Derives1_split append_Cons append_Nil length_0_conv list.inject self_append_conv) 
   show ?thesis using u v r by auto
 qed   
 
 lemma LeftDerivationFix_grow_suffix:
   assumes LDF: "LeftDerivationFix (b1@[X]@b2) (length b1) D j c"
   assumes suffix_b2: "LeftDerives1 suffix e r b2"
   assumes is_word_b1X: "is_word (b1@[X])"
   shows "LeftDerivationFix (b1@[X]@suffix) (length b1) ((e + length (b1@[X]), r)#D) j c"
 proof -
   from LDF have LDF': "is_sentence (b1@[X]@b2) \<and> is_sentence c \<and> 
     LeftDerivation (b1 @ [X] @ b2) D c \<and> length b1 < length (b1 @ [X] @ b2) \<and>
     j < length c \<and>
     (b1 @ [X] @ b2) ! length b1 = c ! j \<and>
     (\<exists>E F. D = E @ derivation_shift F 0 (Suc j) \<and>
         LeftDerivation (take (length b1) (b1 @ [X] @ b2)) E (take j c) \<and>
         LeftDerivation (drop (Suc (length b1)) (b1 @ [X] @ b2)) F (drop (Suc j) c))"
     using LeftDerivationFix_def by blast
   then obtain E F where EF: "D = E @ derivation_shift F 0 (Suc j) \<and>
         LeftDerivation (take (length b1) (b1 @ [X] @ b2)) E (take j c) \<and>
         LeftDerivation (drop (Suc (length b1)) (b1 @ [X] @ b2)) F (drop (Suc j) c)" by blast
   then have LD_b1_c: "LeftDerivation b1 E (take j c)" by simp 
   with is_word_b1X have E: "E = []"
     using LeftDerivation_implies_Derivation is_word_Derivation is_word_append by blast 
   then have b1_def: "b1 = take j c" using LD_b1_c by auto
   then have b1_len: "j = length b1"
     by (simp add: LDF' dual_order.strict_implies_order min.absorb2) 
   have D: "D = derivation_shift F 0 (Suc j)" using EF E by simp  
   have step: "LeftDerives1 (b1 @ [X] @ suffix) (Suc (e + length b1)) r (b1 @ [X] @ b2) \<and> 
     LeftDerivation  (b1 @ [X] @ b2) D c"
     by (metis LDF' LeftDerives1_append_prefix add_Suc_right append_assoc assms(2) is_word_b1X 
       length_append_singleton)
   then have is_sentence_b1Xsuffix: "is_sentence (b1 @ [X] @ suffix)"
     using Derives1_sentence1 LeftDerives1_implies_Derives1 by blast
   have X_eq_cj: "X = c ! j" using LDF' by auto    
   show ?thesis
     apply (simp add: LeftDerivationFix_def)
     apply (rule conjI)
     using is_sentence_b1Xsuffix apply simp
     apply (rule conjI)
     using LDF' apply simp
     apply (rule conjI)
     using step apply force
     apply (rule conjI)
     using LDF' apply simp
     apply (rule conjI)
     apply (rule X_eq_cj)
     apply (rule_tac x="[]" in exI)
     apply (rule_tac x="(e, r)#F" in exI)
     apply auto
     apply (rule b1_len[symmetric])
     apply (rule D)
     apply (rule b1_def)
     apply (rule_tac x="b2" in exI)
     apply (simp add: suffix_b2)
     using EF by auto
 qed
 
 lemma Derives1_append_suffix: 
   assumes Derives1: "Derives1 v i r w"
   assumes u: "is_sentence u"
   shows "Derives1 (v@u) i r (w@u)"
 proof -
   have "\<exists> \<alpha> N \<beta>. splits_at v i \<alpha> N \<beta>" using assms splits_at_ex by auto
   then obtain \<alpha> N \<beta> where split_v: "splits_at v i \<alpha> N \<beta>" by blast
   have split_w: "w = \<alpha>@(snd r)@\<beta>" using assms split_v splits_at_combine_dest by blast 
   have split_uv: "splits_at (v@u) i \<alpha> N (\<beta>@u)"   
     by (simp add: split_v splits_at_append)
   have is_sentence_uv: "is_sentence (v@u)"
     using Derives1 Derives1_sentence1 is_sentence_concat u by blast 
   show ?thesis
     by (metis Derives1 Derives1_nonterminal Derives1_rule append_assoc is_sentence_uv 
         split_uv split_v split_w splits_at_implies_Derives1)
 qed
 
 lemma leftmost_append_suffix: "leftmost i v \<Longrightarrow> leftmost i (v@u)"
 by (simp add: leftmost_def nth_append)
 
 lemma LeftDerives1_append_suffix: 
   assumes Derives1: "LeftDerives1 v i r w"
   assumes u: "is_sentence u"
   shows "LeftDerives1 (v@u) i r (w@u)"
 proof -
   have 1: "Derives1 v i r w"
     by (simp add: Derives1 LeftDerives1_implies_Derives1) 
   have 2: "leftmost i v"
     using Derives1 LeftDerives1_def by blast  
   have 3: "is_sentence u" using u by fastforce 
   have 4: "Derives1 (v@u) i r (w@u)"
     by (simp add: "1" "3" Derives1_append_suffix) 
   have 5: "leftmost i (v@u)"
     by (simp add: "2" leftmost_append_suffix u) 
   show ?thesis
     by (simp add: "4" "5" LeftDerives1_def)
 qed     
 
 lemma LeftDerivationFix_is_sentence: 
   "LeftDerivationFix a i D j b \<Longrightarrow> is_sentence a \<and> is_sentence b"
   using LeftDerivationFix_def by blast
   
 lemma LeftDerivationIntro_is_sentence:
   "LeftDerivationIntro \<alpha> i r ix D j \<gamma> \<Longrightarrow> is_sentence \<alpha> \<and> is_sentence \<gamma>"
   by (meson Derives1_sentence1 LeftDerivationFix_is_sentence LeftDerivationIntro_def 
     LeftDerives1_implies_Derives1)
 
 lemma LeftDerivationFix_grow_prefix:
   assumes LDF: "LeftDerivationFix (b1@[X]@b2) (length b1) D j c"
   assumes prefix_b1: "LeftDerives1 prefix e r b1"
   shows "LeftDerivationFix (prefix@[X]@b2) (length prefix) ((e, r)#D) j c"
 proof -
   from LDF have LDF': "LeftDerivation (b1 @ [X] @ b2) D c \<and>
     length b1 < length (b1 @ [X] @ b2) \<and>
     j < length c \<and>
     (b1 @ [X] @ b2) ! length b1 = c ! j \<and>
     (\<exists>E F. D = E @ derivation_shift F 0 (Suc j) \<and>
         LeftDerivation (take (length b1) (b1 @ [X] @ b2)) E (take j c) \<and>
         LeftDerivation (drop (Suc (length b1)) (b1 @ [X] @ b2)) F (drop (Suc j) c))"
     using LeftDerivationFix_def by blast
   then obtain E F where EF: "D = E @ derivation_shift F 0 (Suc j) \<and>
         LeftDerivation (take (length b1) (b1 @ [X] @ b2)) E (take j c) \<and>
         LeftDerivation (drop (Suc (length b1)) (b1 @ [X] @ b2)) F (drop (Suc j) c)" by blast
   then have E_b1_c: "LeftDerivation b1 E (take j c)" by simp 
   with EF have F_b2_c: "LeftDerivation b2 F (drop (Suc j) c)" by simp
   have step: "LeftDerives1 (prefix @ [X] @ b2) e r (b1 @ [X] @ b2)"
     using LDF LeftDerivationFix_is_sentence LeftDerives1_append_suffix 
       is_sentence_concat prefix_b1 by blast   
   show ?thesis
     apply (simp add: LeftDerivationFix_def)
     apply (rule conjI)
     apply (metis Derives1_sentence1 LDF LeftDerivationFix_def LeftDerives1_implies_Derives1 
       is_sentence_concat is_sentence_cons prefix_b1)
     apply (rule conjI)
     using LDF LeftDerivationFix_is_sentence apply blast
     apply (rule conjI)
     apply (rule_tac x="b1@[X]@b2" in exI)
     using step apply simp
     using LDF' apply auto[1]
     apply (rule conjI)
     using LDF' apply simp
     apply (rule conjI)
     using LDF' apply auto[1]
     apply (rule_tac x="(e,r)#E" in exI)
     apply (rule_tac x="F" in exI)
     apply (auto simp add: EF F_b2_c)
     apply (rule_tac x="b1" in exI)
     apply (simp add: prefix_b1 E_b1_c)
     done
 qed
 
 lemma LeftDerivationFixOrIntro: 
   "LeftDerivation a D \<gamma> \<Longrightarrow> is_sentence \<gamma> \<Longrightarrow> j < length \<gamma> \<Longrightarrow>
   (\<exists> i. LeftDerivationFix a i D j \<gamma>) \<or> 
   (\<exists> d \<alpha> ix. d < length D \<and> LeftDerivation a (take d D) \<alpha> \<and> 
     LeftDerivationIntro \<alpha> (fst (D ! d)) (snd (D ! d)) ix (drop (Suc d) D) j \<gamma>)" 
 proof (induct "length D" arbitrary: a D \<gamma> j rule: less_induct) 
   (* The induction here is unnecessary, but we use it anyway for context reasons *)
   case less
   have "length D = 0 \<or> length D \<noteq> 0" by blast
   then show ?case
   proof (induct rule: disjCases2)
     case 1 
     then have D: "D = []" by auto
     with less have "\<exists>i. LeftDerivationFix a i D j \<gamma>" 
       apply (rule_tac x=j in exI)
       by auto
     then show ?case by blast
   next
     case 2
     note less2 = 2
     have "\<exists> n \<beta> i. n \<le> length D \<and> \<beta> = Derive a (take n D) \<and> LeftDerivationFix \<beta> i (drop n D) j \<gamma>"  
       apply (rule_tac x="length D" in exI)
       apply auto
       using Derive LeftDerivationFix_empty LeftDerivation_implies_Derivation less by blast
     then show ?case
     proof (induct rule: ex_minimal_witness)
       case (Minimal N)
       then obtain \<beta> i where Minimal_N:
         "N \<le> length D \<and> \<beta> = Derive a (take N D) \<and> LeftDerivationFix \<beta> i (drop N D) j \<gamma>" by blast 
       have "N = 0 \<or> N \<noteq> 0" by blast
       then show ?case
       proof (induct rule: disjCases2)
         case 1
         with Minimal_N have "\<beta> = a" by auto
         with 1 Minimal_N show ?case
           apply (rule_tac disjI1)
           by auto
       next
         case 2
         let ?\<delta> = "Derive a (take (N - 1) D)"
         have LeftDerives1_\<delta>: "LeftDerives1 ?\<delta> (fst (D ! (N - 1))) (snd (D ! (N - 1))) \<beta>"
           using "2.hyps" LeftDerivation_Derive_take_LeftDerives1 Minimal_N less.prems(1) by blast
         then have Derives1_\<delta>: "Derives1 ?\<delta> (fst (D ! (N - 1))) (snd (D ! (N - 1))) \<beta>"
           using LeftDerives1_implies_Derives1 by blast   
         have i_len: "i < length \<beta>" using Minimal_N 
           by (auto simp add: LeftDerivationFix_def)
         then have "\<exists> X \<beta>_1 \<beta>_2. splits_at \<beta> i \<beta>_1 X \<beta>_2"
           using splits_at_def by blast
         then obtain X \<beta>_1 \<beta>_2 where \<beta>_split: "splits_at \<beta> i \<beta>_1 X \<beta>_2" by blast
         then have \<beta>_combine: "\<beta> = \<beta>_1 @ [X] @ \<beta>_2" using splits_at_combine by blast 
         then have LeftDerives1_\<delta>_hyp: 
           "LeftDerives1 ?\<delta> (fst (D ! (N - 1))) (snd (D ! (N - 1))) (\<beta>_1 @ [X] @ \<beta>_2)"
           using LeftDerives1_\<delta> by blast 
         from \<beta>_split have i_def: "i = length \<beta>_1"
           by (simp add: dual_order.strict_implies_order  min.absorb2 splits_at_def)  
         have "\<exists> Y \<delta>_1 \<delta>_2. splits_at ?\<delta> (fst (D ! (N - 1))) \<delta>_1 Y \<delta>_2"
           using Derives1_\<delta> splits_at_ex by blast
         then obtain Y \<delta>_1 \<delta>_2 where \<delta>_split: "splits_at ?\<delta> (fst (D ! (N - 1))) \<delta>_1 Y \<delta>_2" by blast 
         have NFix: "LeftDerivationFix (\<beta>_1 @ [X] @ \<beta>_2) (length \<beta>_1) (drop N D) j \<gamma>"              
           using Minimal_N \<beta>_combine i_def by auto      
         from LeftDerives1_\<delta>_hyp \<delta>_split 
         have "\<exists>u v. \<beta>_1 = \<delta>_1 @ u \<and> \<beta>_2 = v @ \<delta>_2 \<and> snd (snd (D ! (N - 1))) = u @ [X] @ v"
         proof (induct rule: LeftDerives1_X_is_part_of_rule)
           case (Suffix suffix)
             let ?k = "N - 1"
             let ?\<beta> = "Derive a (take ?k D)"
             let ?i = "length \<beta>_1"
             have k_less: "?k < length D" using "2.hyps" Minimal_N by linarith 
             then have k_leq: "?k \<le> length D" by auto
             have drop_k_d: "drop ?k D = (D ! (N - 1))#(drop N D)"
               using "2.hyps" Cons_nth_drop_Suc k_less by fastforce 
             from LeftDerivationFix_grow_suffix[OF NFix Suffix(4) Suffix(3)] Suffix(1) Suffix(2) 2
             have "LeftDerivationFix ?\<beta> ?i (drop ?k D) j \<gamma>" 
               apply auto
               by (metis One_nat_def drop_k_d)
             with Minimal(2)[where k="?k"] show "False"
               using "2.hyps" k_leq by auto 
         next
           case (Prefix prefix)
             have collapse: "(fst (D ! (N - 1)), snd (D ! (N - 1))) # drop N D = drop (N - 1) D"
               by (metis "2.hyps" Cons_nth_drop_Suc Minimal_N Suc_diff_1 neq0_conv not_less 
                 not_less_eq prod.collapse)          
             from LeftDerivationFix_grow_prefix[OF NFix Prefix(2)] Prefix(1) collapse
             have "LeftDerivationFix ?\<delta> (length prefix) (drop (N - 1) D) j \<gamma>" by auto
             with Minimal(2)[where k = "N - 1"] show "False"
               by (metis Minimal_N collapse diff_le_self le_neq_implies_less less_imp_diff_less 
                 less_or_eq_imp_le not_Cons_self2)
         qed
         then obtain u v where uv:
           "\<beta>_1 = \<delta>_1 @ u \<and> \<beta>_2 = v @ \<delta>_2 \<and> snd (snd (D ! (N - 1))) = u @ [X] @ v" by blast
         have X_1: "snd (snd (D ! (N - Suc 0))) ! length u = X" using uv by auto
         have X_2: "\<gamma> ! j = X" using LeftDerivationFix_def NFix by auto        
         show ?case
           apply (rule disjI2)
           apply (rule_tac x="N - 1" in exI)
           apply (rule_tac x="?\<delta>" in exI)
           apply (rule_tac x="length u" in exI)
           apply (rule conjI)
           using Minimal_N less2 apply linarith
           apply (rule conjI)
           using LeftDerivation_take_derive less.prems(1) apply blast
           apply (subst LeftDerivationIntro_def)
           apply (rule_tac x=\<beta> in exI)
           apply auto
           using LeftDerives1_\<delta> One_nat_def apply presburger
           using uv apply auto[1]
           using X_1 X_2 apply auto[1]
           by (metis (no_types, lifting) "2.hyps" Derives1_\<delta> Derives1_split Minimal_N One_nat_def 
             Suc_diff_1 \<delta>_split append_eq_conv_conj i_def length_append neq0_conv splits_at_def uv)
       qed
     qed
   qed
 qed
 
 type_synonym deriv = "nat \<times> nat \<times> nat" 
 type_synonym ladder = "deriv list"
 
 definition deriv_n :: "deriv \<Rightarrow> nat" where 
   "deriv_n d = fst d"
 
 definition deriv_j :: "deriv \<Rightarrow> nat" where
   "deriv_j d = fst (snd d)"
 
 definition deriv_ix :: "deriv \<Rightarrow> nat" where
   "deriv_ix d = snd (snd d)"
 
 definition deriv_i :: "deriv \<Rightarrow> nat" where
   "deriv_i d = snd (snd d)"
 
 definition ladder_j :: "ladder \<Rightarrow> nat \<Rightarrow> nat" where
   "ladder_j L index = deriv_j (L ! index)"
 
 definition ladder_i :: "ladder \<Rightarrow> nat \<Rightarrow> nat" where
   "ladder_i L index = (if index = 0 then deriv_i (hd L) else ladder_j L (index - 1))"
 
 definition ladder_n :: "ladder \<Rightarrow> nat \<Rightarrow> nat" where
   "ladder_n L index = deriv_n (L ! index)"
 
 definition ladder_prev_n :: "ladder \<Rightarrow> nat \<Rightarrow> nat" where
   "ladder_prev_n L index = (if index = 0 then 0 else (ladder_n L (index - 1)))" 
 
 definition ladder_ix :: "ladder \<Rightarrow> nat \<Rightarrow> nat" where
   "ladder_ix L index = (if index = 0 then undefined else deriv_ix (L ! index))"
 
 definition ladder_last_j :: "ladder \<Rightarrow> nat" where
   "ladder_last_j L = ladder_j L (length L - 1)"
 
 definition ladder_last_n :: "ladder \<Rightarrow> nat" where
   "ladder_last_n L = ladder_n L (length L - 1)"
 
 definition is_ladder :: "derivation \<Rightarrow> ladder \<Rightarrow> bool" where
   "is_ladder D L = (L \<noteq> [] \<and> 
     (\<forall> u. u < length L \<longrightarrow> ladder_n L u \<le> length D) \<and>
     (\<forall> u v. u < v \<and> v < length L \<longrightarrow> ladder_n L u < ladder_n L v) \<and>
     ladder_last_n L = length D)"   
 
 definition ladder_\<gamma> :: "sentence \<Rightarrow> derivation \<Rightarrow> ladder \<Rightarrow> nat \<Rightarrow> sentence" where
   "ladder_\<gamma> a D L index = Derive a (take (ladder_n L index) D)"
 
 definition ladder_\<alpha> :: "sentence \<Rightarrow> derivation \<Rightarrow> ladder \<Rightarrow> nat \<Rightarrow> sentence" where
   "ladder_\<alpha> a D L index = (if index = 0 then a else ladder_\<gamma> a D L (index - 1))"
 
 definition LeftDerivationIntrosAt :: "sentence \<Rightarrow> derivation \<Rightarrow> ladder \<Rightarrow> nat \<Rightarrow> bool" where
   "LeftDerivationIntrosAt a D L index = (
        let \<alpha> = ladder_\<alpha> a D L index in
        let i = ladder_i L index in
        let j = ladder_j L index in
        let ix = ladder_ix L index in
        let \<gamma> = ladder_\<gamma> a D L index in 
        let n = ladder_n L (index - 1) in
        let m = ladder_n L index in
        let e = D ! n in
        let E = drop (Suc n) (take m D) in
         i = fst e \<and>
         LeftDerivationIntro \<alpha> i (snd e) ix E j \<gamma>)"
 
 definition LeftDerivationIntros :: "sentence \<Rightarrow> derivation \<Rightarrow> ladder \<Rightarrow> bool" where
   "LeftDerivationIntros a D L = (
      \<forall> index. 1 \<le> index \<and> index < length L \<longrightarrow> LeftDerivationIntrosAt a D L index)"
 
 definition LeftDerivationLadder :: "sentence \<Rightarrow> derivation \<Rightarrow> ladder \<Rightarrow> sentence \<Rightarrow> bool" where 
   "LeftDerivationLadder a D L b = (
     LeftDerivation a D b \<and> 
     is_ladder D L \<and>
     LeftDerivationFix a (ladder_i L 0) (take (ladder_n L 0) D) (ladder_j L 0) (ladder_\<gamma> a D L 0) \<and> 
     LeftDerivationIntros a D L)" 
 
 definition mk_deriv_fix :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> deriv" where
   "mk_deriv_fix i n j = (n, j, i)"
 
 definition mk_deriv_intro :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> deriv" where
   "mk_deriv_intro ix n j = (n, j, ix)"
 
 lemma mk_deriv_fix_i[simp]: "deriv_i (mk_deriv_fix i n j) = i"
   by (simp add: deriv_i_def mk_deriv_fix_def)
 
 lemma mk_deriv_fix_j[simp]: "deriv_j (mk_deriv_fix i n j) = j"
   by (simp add: deriv_j_def mk_deriv_fix_def)
 
 lemma mk_deriv_fix_n[simp]: "deriv_n (mk_deriv_fix i n j) = n"
   by (simp add: deriv_n_def mk_deriv_fix_def)
 
 lemma mk_deriv_intro_i[simp]: "deriv_i (mk_deriv_intro i n j) = i"
   by (simp add: deriv_i_def mk_deriv_intro_def)
 
 lemma mk_deriv_intro_ix[simp]: "deriv_ix (mk_deriv_intro ix n j) = ix"
   by (simp add: deriv_ix_def mk_deriv_intro_def)
 
 lemma mk_deriv_intro_j[simp]: "deriv_j (mk_deriv_intro i n j) = j"
   by (simp add: deriv_j_def mk_deriv_intro_def)
 
 lemma mk_deriv_intro_n[simp]: "deriv_n (mk_deriv_intro i n j) = n"
   by (simp add: deriv_n_def mk_deriv_intro_def)
 
 lemma LeftDerivationFix_implies_ex_ladder:
   "LeftDerivationFix a i D j \<gamma> \<Longrightarrow> \<exists> L. LeftDerivationLadder a D L \<gamma> \<and> 
     ladder_last_j L = j \<and> ladder_last_n L = length D"
   apply (rule_tac x="[mk_deriv_fix i (length D) j]" in exI)
   apply (auto simp add: LeftDerivationLadder_def)
   apply (simp add: LeftDerivationFix_def)
   apply (simp add: is_ladder_def)
   apply (auto simp add: ladder_i_def ladder_j_def ladder_n_def ladder_\<gamma>_def)
   apply (simp add: ladder_last_n_def ladder_n_def)
   using Derive LeftDerivationFix_def LeftDerivation_implies_Derivation apply blast
   apply (simp add: LeftDerivationIntros_def)
   apply (simp add: ladder_last_j_def ladder_j_def)
   apply (simp add: ladder_last_n_def ladder_n_def)
   done 
 
 lemma trivP[case_names prems]: "P \<Longrightarrow> P" by blast
 
 lemma LeftDerivationLadder_ladder_n_bound:
   assumes "LeftDerivationLadder a D L b"
   assumes "index < length L"
   shows "ladder_n L index \<le> length D"
 using LeftDerivationLadder_def assms(1) assms(2) is_ladder_def by blast 
 
 lemma LeftDerivationLadder_deriv_n_bound:
   assumes "LeftDerivationLadder a D L b"
   assumes "index < length L"
   shows "deriv_n (L ! index) \<le> length D"
 using LeftDerivationLadder_def assms(1) assms(2) is_ladder_def ladder_n_def by auto
 
 lemma ladder_n_simp1[simp]: "u < length L \<Longrightarrow> ladder_n (L@L') u = ladder_n L u"
 by (simp add: ladder_n_def)
 
 lemma ladder_n_simp2[simp]: "ladder_n (L@[d]) (length L) = deriv_n d"
 by (simp add: ladder_n_def)
 
 lemma ladder_j_simp1[simp]: "u < length L \<Longrightarrow> ladder_j (L@L') u = ladder_j L u"
 by (simp add: ladder_j_def)
 
 lemma ladder_j_simp2[simp]: "ladder_j (L@[d]) (length L) = deriv_j d"
 by (simp add: ladder_j_def)
 
 lemma ladder_i_simp1[simp]: "u < length L \<Longrightarrow> ladder_i (L@L') u = ladder_i L u"
 by (auto simp add: ladder_i_def)
 
 lemma ladder_ix_simp1[simp]: "u < length L \<Longrightarrow> ladder_ix (L@L') u = ladder_ix L u"
 by (auto simp add: ladder_ix_def)
 
 lemma ladder_ix_simp2[simp]: "L \<noteq> [] \<Longrightarrow> ladder_ix (L@[d]) (length L) = deriv_ix d"
 by (auto simp add: ladder_ix_def)
 
 lemma ladder_\<gamma>_simp1[simp]: "u < length L \<Longrightarrow> ladder_\<gamma> a D (L@L') u = ladder_\<gamma> a D L u"
 by (simp add: ladder_\<gamma>_def)
 
 lemma ladder_\<gamma>_simp2[simp]: "u < length L \<Longrightarrow> is_ladder D L \<Longrightarrow> 
   ladder_\<gamma> a (D@D') L u = ladder_\<gamma> a D L u"
 by (simp add: is_ladder_def ladder_\<gamma>_def)
 
 lemma ladder_\<alpha>_simp1[simp]: "u < length L \<Longrightarrow> ladder_\<alpha> a D (L@L') u = ladder_\<alpha> a D L u"
 by (simp add: ladder_\<alpha>_def)
 
 lemma ladder_\<alpha>_simp2[simp]: "u < length L \<Longrightarrow> is_ladder D L \<Longrightarrow> 
   ladder_\<alpha> a (D@D') L u = ladder_\<alpha> a D L u"
 by (simp add: is_ladder_def ladder_\<alpha>_def)
 
 lemma ladder_n_minus_1_bound: "is_ladder D L \<Longrightarrow> index \<ge> 1 \<Longrightarrow> index < length L \<Longrightarrow> 
   ladder_n L (index - Suc 0) < length D"
 by (metis (no_types, lifting) One_nat_def Suc_diff_1 Suc_le_lessD dual_order.strict_implies_order 
   is_ladder_def le_neq_implies_less not_less)
 
 lemma LeftDerivationIntrosAt_ignore_appendix:
   assumes is_ladder: "is_ladder D L"
   assumes hyp: "LeftDerivationIntrosAt a D L index"
   assumes index_ge: "index \<ge> 1"
   assumes index_less: "index < length L"
   shows "LeftDerivationIntrosAt a (D @ D') (L @ L') index"
 proof -
   have index_minus_1: "index - Suc 0 < length L"
     using index_less by arith
   have is_0: "ladder_n L index - length D = 0"
     using index_less is_ladder is_ladder_def by auto
   from index_ge index_less show ?thesis
     apply (simp add: LeftDerivationIntrosAt_def Let_def)
     apply (simp add: index_minus_1 is_ladder ladder_n_minus_1_bound is_0)
     using hyp apply (auto simp add: LeftDerivationIntrosAt_def Let_def)
     done
 qed
 
 lemma ladder_i_eq_last_j: "L \<noteq> [] \<Longrightarrow> ladder_i (L @ L') (length L) = ladder_last_j L"
 by (simp add: ladder_i_def ladder_last_j_def)
 
 lemma ladder_last_n_intro: "L \<noteq> [] \<Longrightarrow> ladder_n L (length L - Suc 0) = ladder_last_n L"
 by (simp add: ladder_last_n_def)
   
 lemma is_ladder_not_empty: "is_ladder D L \<Longrightarrow> L \<noteq> []"
 using is_ladder_def by blast
   
 lemma last_ladder_\<gamma>:
   assumes is_ladder: "is_ladder D L"
   assumes ladder_last_n: "ladder_last_n L = length D"
   shows "ladder_\<gamma> a D L (length L - Suc 0) = Derive a D"
 proof -
   from is_ladder is_ladder_not_empty have "L \<noteq> []" by blast
   then show ?thesis
     by (simp add: ladder_\<gamma>_def ladder_last_n_intro ladder_last_n)
 qed
 
 lemma ladder_\<alpha>_full:
   assumes is_ladder: "is_ladder D L"
   assumes ladder_last_n: "ladder_last_n L = length D"
   shows "ladder_\<alpha> a (D @ D') (L @ L') (length L) = Derive a D"
 proof -
   from is_ladder have L_not_empty: "L \<noteq> []" by (simp add: is_ladder_def)  
   with is_ladder ladder_last_n show ?thesis
     apply (simp add: ladder_\<alpha>_def)
     apply (simp add: last_ladder_\<gamma>) 
     done
 qed
 
 lemma LeftDerivationIntro_implies_LeftDerivation:
   "LeftDerivationIntro \<alpha> i r ix D j \<gamma> \<Longrightarrow> LeftDerivation \<alpha> ((i,r)#D) \<gamma>"
 using LeftDerivationFix_def LeftDerivationIntro_def by auto
 
 lemma LeftDerivationLadder_grow: 
   "LeftDerivationLadder a D L \<alpha> \<Longrightarrow> ladder_last_j L = i \<Longrightarrow>
    LeftDerivationIntro \<alpha> i r ix E j \<gamma> \<Longrightarrow>
    LeftDerivationLadder a (D@[(i, r)]@E) (L@[mk_deriv_intro ix (Suc(length D + length E)) j]) \<gamma>"
 proof (induct arbitrary: a D L \<alpha> i r ix E j \<gamma> rule: trivP)
   case prems
   {
     fix u :: nat
     assume "u < Suc (length L)"
     then have "u < length L \<or> u = length L" by arith
     then have "ladder_n (L @ [mk_deriv_intro ix (Suc (length D + length E)) j]) u \<le> 
       Suc (length D + length E)"
     proof (induct rule: disjCases2)
       case 1
       then show ?case
         apply simp
         by (meson LeftDerivationLadder_ladder_n_bound le_Suc_eq le_add1 le_trans prems(1))
     next
       case 2
       then show ?case
         by (simp add: ladder_n_def)
     qed
   }
   note ladder_n_ineqs = this    
   {
     fix u :: nat
     fix v :: nat
     assume u_less_v: "u < v"
     assume "v < Suc (length L)"
     then have "v < length L \<or> v = length L" by arith
     then have "ladder_n (L @ [mk_deriv_intro ix (Suc (length D + length E)) j]) u
            < ladder_n (L @ [mk_deriv_intro ix (Suc (length D + length E)) j]) v"
     proof (induct rule: disjCases2) 
       case 1
       with u_less_v have u_bound: "u < length L" by arith
       show ?case using 1 u_bound apply simp
       using prems u_less_v LeftDerivationLadder_def is_ladder_def by auto
     next
       case 2
       with u_less_v have u_bound: "u < length L" by arith
       have "deriv_n (L ! u) \<le> length D"
         using LeftDerivationLadder_deriv_n_bound prems(1) u_bound by blast       
       then show ?case
         apply (simp add: u_bound)
         apply (simp add: ladder_n_def 2)
         done
     qed
   }
   note ladder_n_ineqs = ladder_n_ineqs this
   have is_ladder: 
     "is_ladder (D @ (i, r) # E) (L @ [mk_deriv_intro ix (Suc (length D + length E)) j])"
     apply (auto simp add: is_ladder_def)
     using ladder_n_ineqs apply auto
     apply (simp add: ladder_last_n_def)
     done
   have is_ladder_L: "is_ladder D L"
     using LeftDerivationLadder_def prems.prems(1) by blast 
   have ladder_last_n_eq_length: "ladder_last_n L = length D"
     using is_ladder_L is_ladder_def by blast   
   have L_not_empty: "L \<noteq> []"
     using LeftDerivationLadder_def is_ladder_def prems(1) by blast 
   {
     fix index :: nat
     assume index_ge: "Suc 0 \<le> index"
     assume "index < Suc (length L)"
     then have "index < length L \<or> index = length L" by arith
     then have "LeftDerivationIntrosAt a (D @ (i, r) # E) 
       (L @ [mk_deriv_intro ix (Suc (length D + length E)) j]) index"
     proof (induct rule: disjCases2)
       case 1
       then show ?case
         using LeftDerivationIntrosAt_ignore_appendix
           LeftDerivationIntros_def LeftDerivationLadder_def One_nat_def 
           index_ge prems.prems(1) by presburger 
     next
       case 2
       have min_simp:  "\<And> n E. min n (Suc (n + length E)) = n"
         by auto
       with 2 prems is_ladder_L ladder_last_n_eq_length show ?case        
         apply (simp add: LeftDerivationIntrosAt_def)
         apply (simp add: L_not_empty ladder_i_eq_last_j ladder_last_n_intro)
         apply (simp add: ladder_\<alpha>_full min_simp)
         apply (simp add: ladder_\<gamma>_def)
         by (metis Derive LeftDerivationIntro_implies_LeftDerivation LeftDerivationLadder_def 
           LeftDerivation_implies_Derivation LeftDerivation_implies_append)
     qed
   }
   then show ?case
     apply (auto simp add: LeftDerivationLadder_def)
     using prems apply (auto simp add: LeftDerivationLadder_def)[1]
     using LeftDerivationFix_def LeftDerivationIntro_def LeftDerivation_append apply auto[1]
     using is_ladder apply simp
     using L_not_empty apply simp
     using LeftDerivationLadder_def LeftDerivationLadder_ladder_n_bound ladder_\<gamma>_def 
       prems.prems(1) apply auto[1]
     apply (subst LeftDerivationIntros_def)
     apply auto
     done
 qed 
 
 lemma LeftDerivationIntro_bounds_ij: 
   "LeftDerivationIntro \<alpha> i r ix D j \<beta> \<Longrightarrow> i < length \<alpha> \<and> j < length \<beta>"
   by (meson Derives1_bound LeftDerivationFix_def LeftDerivationIntro_def 
     LeftDerives1_implies_Derives1)
 
 theorem LeftDerivationLadder_exists: "LeftDerivation a D \<gamma> \<Longrightarrow> is_sentence \<gamma> \<Longrightarrow> j < length \<gamma> \<Longrightarrow> 
   \<exists> L. LeftDerivationLadder a D L \<gamma> \<and> ladder_last_j L = j"
 proof (induct "length D" arbitrary: a D \<gamma> j rule: less_induct)
   case less
   from LeftDerivationFixOrIntro[OF less(2,3,4)] show ?case
   proof (induct rule: disjCases2) 
     case 1
     then obtain i where "LeftDerivationFix a i D j \<gamma>" by blast
     show ?case
     using "1.hyps" LeftDerivationFix_implies_ex_ladder by blast
   next
     case 2
     then obtain d \<alpha> ix where inductrule: "d < length D \<and>
       LeftDerivation a (take d D) \<alpha> \<and>
       LeftDerivationIntro \<alpha> (fst (D ! d)) (snd (D ! d)) ix (drop (Suc d) D) j \<gamma>" by blast
     then have less_length_D: "length (take d D) < length D" 
       and LeftDerivation_\<alpha>: "LeftDerivation a (take d D) \<alpha>" by auto
     have is_sentence_\<alpha>: "is_sentence \<alpha>" using LeftDerivationIntro_is_sentence inductrule by blast
     have "fst (D ! d) < length \<alpha>" using LeftDerivationIntro_bounds_ij inductrule by blast 
     from less(1)[OF less_length_D LeftDerivation_\<alpha> is_sentence_\<alpha>, where j=" fst (D ! d)", OF this]
     obtain L where induct_Ladder:
       "LeftDerivationLadder a (take d D) L \<alpha>" and induct_last: "ladder_last_j L = fst (D ! d)" 
       by blast
     have induct_intro: "LeftDerivationIntro \<alpha> (fst (D ! d)) (snd (D ! d)) ix (drop (Suc d) D) j \<gamma>"
       using inductrule by blast
     have "d < length D" using inductrule by blast
     then have simp_to_D: "take d D @ D ! d # drop (Suc d) D = D"
       using id_take_nth_drop by force        
     from LeftDerivationLadder_grow[OF induct_Ladder induct_last induct_intro] simp_to_D
     show ?case
       apply auto
       apply (rule_tac x=
         "L @ [mk_deriv_intro ix (Suc (min (length D) d + (length D - Suc d))) j]" in exI)
       apply (simp add: ladder_last_j_def)
       done
   qed
 qed
 
 lemma LeftDerivationLadder_L_0: 
   assumes "LeftDerivationLadder \<alpha> D L \<beta>"
   assumes "length L = 1"
   shows "\<exists> i. LeftDerivationFix \<alpha> i D (ladder_last_j L) \<beta>"
 proof -
   have "is_ladder D L" using assms by (auto simp add: LeftDerivationLadder_def)
   then have ladder_n: "ladder_n L 0 = length D"
     by (simp add: assms(2) is_ladder_def ladder_last_n_def)
   show ?thesis
     apply (rule_tac x = "ladder_i L 0" in exI)
     using assms(1) apply (auto simp add: LeftDerivationLadder_def)
     by (metis Derive LeftDerivationFix_def LeftDerivation_implies_Derivation One_nat_def assms(2) 
       diff_Suc_1 ladder_last_j_def ladder_n order_refl take_all) 
 qed    
   
 lemma LeftDerivationFix_splits_at_derives:
   assumes "LeftDerivationFix a i D j b"
   shows "\<exists> U a1 a2 b1 b2. splits_at a i a1 U a2 \<and> splits_at b j b1 U b2 \<and> 
     derives a1 b1 \<and> derives a2 b2"
 proof -
   note hyp = LeftDerivationFix_def[where \<alpha>=a and \<beta>=b and D=D and i=i and j=j]
   from hyp obtain E F where EF:
     "D = E @ derivation_shift F 0 (Suc j) \<and>
       LeftDerivation (take i a) E (take j b) \<and> LeftDerivation (drop (Suc i) a) F (drop (Suc j) b)"
     using assms by blast
   show ?thesis
     apply (rule_tac x="a ! i" in exI)
     apply (rule_tac x="take i a" in exI)
     apply (rule_tac x="drop (Suc i) a" in exI)
     apply (rule_tac x="take j b" in exI)
     apply (rule_tac x="drop (Suc j) b" in exI)
     using Derivation_implies_derives LeftDerivation_implies_Derivation assms hyp 
       splits_at_def by blast
 qed
 
 lemma  LeftDerivation_append_suffix:
   "LeftDerivation a D b \<Longrightarrow> is_sentence c \<Longrightarrow> LeftDerivation (a@c) D (b@c)" 
 proof (induct D arbitrary: a b c)
   case Nil
   then show ?case by auto
 next
   case (Cons d D)
   then show ?case 
     apply auto
     apply (rule_tac x="x@c" in exI)
     apply auto
     using LeftDerives1_append_suffix by simp
 qed
 
 lemma LeftDerivation_impossible: "LeftDerivation a D b \<Longrightarrow> i < length a \<Longrightarrow> 
   is_nonterminal (a ! i) \<Longrightarrow> derivation_ge D (Suc i) \<Longrightarrow> D = []"
 proof (induct D)
   case Nil then show ?case by auto
 next
   case (Cons d D) 
   then have lm: "\<And> j. leftmost j a \<Longrightarrow> j \<le> i"
     by (metis Derives1_sentence1 LeftDerivation.simps(2) LeftDerives1_implies_Derives1 
       leftmost_exists leftmost_unique)     
   from Cons show ?case
     apply auto
     apply (auto simp add: derivation_ge_def LeftDerives1_def)
     using lm[where j="fst d"] by arith
 qed
 
 lemma derivation_ge_shift: "derivation_ge (derivation_shift F 0 j) j"
   apply (induct F)
   apply (auto simp add: derivation_ge_def)
   done
 
 lemma LeftDerivationFix_splits_at_nonterminal:
   assumes "LeftDerivationFix a i D j b"
   assumes "is_nonterminal (a ! i)"
   shows "\<exists> U a1 a2 b1. splits_at a i a1 U a2 \<and> splits_at b j b1 U a2 \<and> LeftDerivation a1 D b1"
 proof -
   note hyp = LeftDerivationFix_def[where \<alpha>=a and \<beta>=b and D=D and i=i and j=j]
   from hyp obtain E F where EF:
     "D = E @ derivation_shift F 0 (Suc j) \<and> LeftDerivation (take i a) E (take j b) \<and> 
       LeftDerivation (drop (Suc i) a) F (drop (Suc j) b)"
     using assms by blast
   have "\<exists> \<beta>. LeftDerivation a E \<beta> \<and> LeftDerivation \<beta> (derivation_shift F 0 (Suc j)) b"
     using EF LeftDerivation_append assms(1) hyp by blast
   then obtain \<beta> where \<beta>_intro: 
     "LeftDerivation a E \<beta> \<and> LeftDerivation \<beta> (derivation_shift F 0 (Suc j)) b" by blast
   have "LeftDerivation ((take i a)@(drop i a)) E ((take j b)@(drop i a))"
     by (metis EF LeftDerivation_append_suffix append_take_drop_id assms(1) hyp is_sentence_concat)
   then have "LeftDerivation a E ((take j b)@(drop i a))" by simp 
   then have \<beta>_decomposed: "\<beta> = (take j b)@(drop i a)"
     using Derivation_unique_dest LeftDerivation_implies_Derivation \<beta>_intro by blast 
   then have "\<beta> ! j = a ! i"
     by (metis Cons_nth_drop_Suc assms(1) hyp length_take min.absorb2 nth_append_length 
       order.strict_implies_order)
   then have is_nt: "is_nonterminal (\<beta> ! j)" by (simp add: assms(2)) 
   have index_j: "j < length \<beta>" using \<beta>_decomposed assms(1) hyp by auto 
   have derivation: "LeftDerivation \<beta> (derivation_shift F 0 (Suc j)) b"
     by (simp add: \<beta>_intro) 
   from LeftDerivation_impossible[OF derivation index_j is_nt derivation_ge_shift]
   have F: "F = []" by (metis length_0_conv length_derivation_shift)    
   then have \<beta>_is_b: "\<beta> = b" using \<beta>_intro by auto     
   show ?thesis
     apply (rule_tac x="a ! i" in exI)
     apply (rule_tac x="take i a" in exI)
     apply (rule_tac x="drop (Suc i) a" in exI)
     apply (rule_tac x="take j b" in exI)
     using EF F assms(1) hyp splits_at_def by auto
 qed
 
 lemma LeftDerivationIntro_implies_nonterminal: 
   "LeftDerivationIntro \<alpha> i (snd e) ix E j \<gamma> \<Longrightarrow> is_nonterminal (\<alpha> ! i)"
 by (simp add: LeftDerivationIntro_def LeftDerives1_def leftmost_is_nonterminal)
 
 lemma LeftDerivationIntrosAt_implies_nonterminal:
   "LeftDerivationIntrosAt a D L index \<Longrightarrow> is_nonterminal((ladder_\<alpha> a D L index) ! (ladder_i L index))"
 by (meson LeftDerivationIntro_implies_nonterminal LeftDerivationIntrosAt_def)
    
 lemma LeftDerivationIntro_examine_rule: 
   "LeftDerivationIntro \<alpha> i r ix D j \<gamma> \<Longrightarrow> splits_at \<alpha> i \<alpha>1 M \<alpha>2 \<Longrightarrow> 
     \<exists> \<eta>. M = fst r \<and> \<eta> = snd r \<and> (M, \<eta>) \<in> \<RR>"
 by (metis Derives1_nonterminal Derives1_rule LeftDerivationIntro_def LeftDerives1_implies_Derives1 
   prod.collapse)
 
 lemma LeftDerivation_skip_prefixword_ex:
   assumes "LeftDerivation (u@v) D w"
   assumes "is_word u"
   shows "\<exists> w'. w = u@w' \<and> LeftDerivation v (derivation_shift D (length u) 0) w'"
 by (metis LeftDerivation.simps(1) LeftDerivation_breakdown LeftDerivation_implies_Derivation 
   LeftDerivation_skip_prefix append_eq_conv_conj assms(1) assms(2) is_word_Derivation 
   is_word_Derivation_derivation_ge)
 
 definition ladder_cut :: "ladder \<Rightarrow> nat \<Rightarrow> ladder"
 where "ladder_cut L n = (let i = length L - 1 in L[i := (n, snd (L ! i))])"
 
 fun deriv_shift :: "nat \<Rightarrow> nat \<Rightarrow> deriv \<Rightarrow> deriv"
 where "deriv_shift dn dj (n, j, i) = (n - dn, j - dj, i)"
 
 definition ladder_shift :: "ladder \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ladder"
 where "ladder_shift L dn dj = map (deriv_shift dn dj) L"
 
 lemma splits_at_append_suffix_prevails: 
   assumes "splits_at (a@b) i u N v"
   assumes "i < length a"
   shows "\<exists> v'. v = v'@b \<and> a=u@[N]@v'"
 proof -
   have "min (length a) (Suc i) = Suc i"
     using Suc_leI assms(2) min.absorb2 by blast
   then show ?thesis
     by (metis (no_types) append_assoc append_eq_conv_conj append_take_drop_id assms(1) 
       hd_drop_conv_nth length_take splits_at_def take_hd_drop)
 qed
 
 lemma derivation_shift_right_left_cancel:
   "derivation_shift (derivation_shift D 0 r) r 0 = D"
 by (induct D, auto)
 
 lemma derivation_shift_left_right_cancel:
   assumes "derivation_ge D r"
   shows "derivation_shift (derivation_shift D r 0) 0 r = D"
 using assms derivation_ge_shift_simp derivation_shift_0_shift by auto
 
 lemma LeftDerivation_ge_take:
   assumes "derivation_ge D k"
   assumes "LeftDerivation a D b"
   assumes "D \<noteq> []"
   shows "take k a = take k b \<and> is_word (take k a)"
 proof -
   obtain d D' where d: "d#D' = D" using assms(3) list.exhaust by blast 
   then have "\<exists> x. LeftDerives1 a (fst d) (snd d) x \<and> LeftDerivation x D' b"
     using LeftDerivation.simps(2) assms(2) by blast
   then obtain x where x: "LeftDerives1 a (fst d) (snd d) x \<and> LeftDerivation x D' b" by blast
   have fst_d_k: "fst d \<ge> k" using d assms(1) derivation_ge_cons by blast 
   from x fst_d_k have is_word: "is_word (take k a)"
     by (metis LeftDerives1_def append_take_drop_id is_word_append leftmost_def 
       min.absorb2 take_append take_take)
   have is_eq: "take k a = take k b"
     using Derivation_take LeftDerivation_implies_Derivation assms(1) assms(2) by blast
   show ?thesis using is_word is_eq by blast
 qed 
         
 lemma LeftDerivationFix_splits_at_symbol:
   assumes "LeftDerivationFix a i D j b"
   shows "\<exists> U a1 a2 b1 b2 n. splits_at a i a1 U a2 \<and> splits_at b j b1 U b2 \<and> 
     n \<le> length D \<and> LeftDerivation a1 (take n D) b1 \<and> derivation_ge (drop n D) (Suc(length b1)) \<and>
     LeftDerivation a2 (derivation_shift (drop n D) (Suc(length b1)) 0) b2 \<and>
     (n = length D \<or> (n < length D \<and> is_word (b1@[U])))"
 proof -
   note hyp = LeftDerivationFix_def[where \<alpha>=a and \<beta>=b and D=D and i=i and j=j]
   from hyp obtain E F where EF:
     "D = E @ derivation_shift F 0 (Suc j) \<and> LeftDerivation (take i a) E (take j b) \<and> 
       LeftDerivation (drop (Suc i) a) F (drop (Suc j) b)"
     using assms by blast
   have "\<exists> \<beta>. LeftDerivation a E \<beta> \<and> LeftDerivation \<beta> (derivation_shift F 0 (Suc j)) b"
     using EF LeftDerivation_append assms(1) hyp by blast
   then obtain \<beta> where \<beta>_intro: 
     "LeftDerivation a E \<beta> \<and> LeftDerivation \<beta> (derivation_shift F 0 (Suc j)) b" by blast
   have "LeftDerivation ((take i a)@(drop i a)) E ((take j b)@(drop i a))"
     by (metis EF LeftDerivation_append_suffix append_take_drop_id assms(1) hyp is_sentence_concat)
   then have "LeftDerivation a E ((take j b)@(drop i a))" by simp 
   then have \<beta>_decomposed: "\<beta> = (take j b)@(drop i a)"
     using Derivation_unique_dest LeftDerivation_implies_Derivation \<beta>_intro by blast 
   have derivation: "LeftDerivation \<beta> (derivation_shift F 0 (Suc j)) b"
     by (simp add: \<beta>_intro) 
   have "\<exists> n. n \<le> length D \<and> E = take n D"
     by (metis EF append_eq_conv_conj is_prefix_length is_prefix_take)
   then obtain n where n: "n \<le> length D \<and> E = take n D" by blast
   have F_def: "drop n D = derivation_shift F 0 (Suc j)"
     by (metis EF append_eq_conv_conj length_take min.absorb2 n)
   have min_j: "min (length b) j = j" using assms hyp by linarith 
   have derivation_ge_Suc_j: "derivation_ge (drop n D) (Suc j)"
     using F_def derivation_ge_shift by simp
   have LeftDerivation_\<beta>_b: "LeftDerivation \<beta> (drop n D) b" by (simp add: F_def \<beta>_intro)
   have is_word_Suc_j_b: "n \<noteq> length D \<Longrightarrow> is_word (take (Suc j) b)"
     by (metis EF F_def LeftDerivation_ge_take \<beta>_intro append_Nil2 derivation_ge_Suc_j 
       length_take min.absorb2 n)
   have take_Suc_j_b_decompose: "take (Suc j) b = take j b @ [a ! i]"
     using assms hyp take_Suc_conv_app_nth by auto
   show ?thesis
     apply (rule_tac x="a ! i" in exI)
     apply (rule_tac x="take i a" in exI)
     apply (rule_tac x="drop (Suc i) a" in exI)
     apply (rule_tac x="take j b" in exI)
     apply (rule_tac x="drop (Suc j) b" in exI)
     apply (rule_tac x="n" in exI)
     apply (auto simp add: min_j)
     using assms hyp splits_at_def apply blast
     using assms hyp splits_at_def apply blast
     using n apply blast
     using EF n apply simp
     using F_def apply simp
     using derivation_ge_shift apply blast
     using F_def  derivation_shift_right_left_cancel apply simp
     using EF apply blast
     using n apply arith
     using is_word_Suc_j_b  take_Suc_j_b_decompose is_word_append apply simp+
     done
 qed    
 
 lemma LeftDerivation_breakdown': "LeftDerivation (u @ v) D w \<Longrightarrow>
   \<exists>n w1 w2.
     n \<le> length D \<and>
     w = w1 @ w2 \<and>
     LeftDerivation u (take n D) w1 \<and>
     derivation_ge (drop n D) (length w1) \<and>
     LeftDerivation v (derivation_shift (drop n D) (length w1) 0) w2"
 proof -
   assume hyp: "LeftDerivation (u @ v) D w"
   from LeftDerivation_breakdown[OF hyp] obtain n w1 w2 where breakdown:
    "w = w1 @ w2 \<and>
     LeftDerivation u (take n D) w1 \<and>
     derivation_ge (drop n D) (length w1) \<and>
     LeftDerivation v (derivation_shift (drop n D) (length w1) 0) w2" by blast
   obtain m where m: "m = min (length D) n" by blast
   have take_m: "take m D = take n D" using m is_prefix_take take_prefix by fastforce
   have drop_m: "drop m D = drop n D"
     by (metis append_eq_conv_conj append_take_drop_id length_take m) 
   have m_bound: "m \<le> length D" by (simp add: m)      
   show ?thesis
     apply (rule_tac x="m" in exI)
     apply (rule_tac x="w1" in exI)
     apply (rule_tac x="w2" in exI)
     using breakdown m_bound take_m drop_m by auto
 qed    
 
 lemma LeftDerives1_append_replace_in_left: 
   assumes ld1: "LeftDerives1 (\<alpha>@\<delta>) i r \<beta>"
   assumes i_bound: "i < length \<alpha>"
   shows "\<exists> \<alpha>'. \<beta> = \<alpha>'@\<delta> \<and> LeftDerives1 \<alpha> i r \<alpha>' \<and> i + length (snd r) \<le> length \<alpha>'"
 proof - 
   obtain \<alpha>' where \<alpha>': "\<alpha>' = (take i \<alpha>)@(snd r)@(drop (i+1) \<alpha>)" by blast
   have fst_r: "fst r = \<alpha> ! i"
   proof -
     have "\<forall>ss n p ssa. \<not> LeftDerives1 ss n p ssa \<or> Derives1 ss n p ssa"
       using LeftDerives1_implies_Derives1 by blast
     then have "Derives1 (\<alpha> @ \<delta>) i r \<beta>"
       using ld1 by blast
     then show ?thesis
       using Derives1_nonterminal i_bound splits_at_def by auto
   qed    
   have "Derives1 \<alpha> i r \<alpha>'"
     using i_bound ld1
     apply (auto simp add: \<alpha>' Derives1_def)
     apply (rule_tac x="take i \<alpha>" in exI)
     apply (rule_tac x="drop (i+1) \<alpha>" in exI)
     apply (rule_tac x="fst r" in exI)
     apply auto
     apply (simp add: fst_r)
     using id_take_nth_drop apply blast
     using Derives1_sentence1 LeftDerives1_implies_Derives1 is_sentence_concat 
       is_sentence_take apply blast
     apply (metis Derives1_sentence1 LeftDerives1_implies_Derives1 append_take_drop_id 
       is_sentence_concat)
     using Derives1_rule LeftDerives1_implies_Derives1 by blast
   then have leftderives1_\<alpha>_\<alpha>': "LeftDerives1 \<alpha> i r \<alpha>'"
     using LeftDerives1_def i_bound ld1 leftmost_cons_less by auto
   have i_bound_\<alpha>': "i + length (snd r) \<le> length \<alpha>'"
     using \<alpha>' i_bound
     by (simp add: add_mono_thms_linordered_semiring(2) le_add1 less_or_eq_imp_le min.absorb2)
   have is_sentence_\<delta>: "is_sentence \<delta>"
     using Derives1_sentence1 LeftDerives1_implies_Derives1 is_sentence_concat ld1 by blast
   then have \<beta>: "\<beta> = \<alpha>'@\<delta>"
     using ld1 leftderives1_\<alpha>_\<alpha>' Derives1_append_suffix Derives1_unique_dest 
       LeftDerives1_implies_Derives1 by blast 
   show ?thesis
     apply (rule_tac x="\<alpha>'" in exI)
     using \<beta> i_bound_\<alpha>' leftderives1_\<alpha>_\<alpha>' by blast
 qed   
     
 lemma LeftDerivationIntro_propagate:
   assumes intro: "LeftDerivationIntro (\<alpha>@\<delta>) i r ix D j \<gamma>"
   assumes i_\<alpha>: "i < length \<alpha>"
   assumes non: "is_nonterminal (\<gamma> ! j)"
   shows "\<exists> \<omega>. LeftDerivation \<alpha> ((i,r)#D) \<omega> \<and> \<gamma> = \<omega>@\<delta> \<and> j < length \<omega>"
 proof -
   from intro LeftDerivationIntro_def[where \<alpha>="\<alpha>@\<delta>" and i=i and r=r and ix=ix and D=D and 
     j=j and \<gamma>=\<gamma>]
   obtain \<beta> where ld_\<beta>: "LeftDerives1 (\<alpha> @ \<delta>) i r \<beta>" and 
      ix: "ix < length (snd r) \<and> snd r ! ix = \<gamma> ! j" and 
      \<beta>_fix: "LeftDerivationFix \<beta> (i + ix) D j \<gamma>"
      by blast
   from LeftDerives1_append_replace_in_left[OF ld_\<beta> i_\<alpha>]
   obtain \<alpha>' where \<alpha>': "\<beta> = \<alpha>' @ \<delta> \<and> LeftDerives1 \<alpha> i r \<alpha>' \<and> i + length (snd r) \<le> length \<alpha>'"
     by blast
   have i_plus_ix_bound: "i + ix < length \<alpha>'" using \<alpha>' ix by linarith
   have ld_\<gamma>: "LeftDerivationFix (\<alpha>' @ \<delta>) (i + ix) D j \<gamma>"
     using \<beta>_fix \<alpha>' by simp
   then have non_i_ix: "is_nonterminal ((\<alpha>' @ \<delta>) ! (i + ix))"
     by (simp add: LeftDerivationFix_def non)
   from LeftDerivationFix_splits_at_nonterminal[OF ld_\<gamma> non_i_ix] 
   obtain U a1 a2 b1 where U: 
     "splits_at (\<alpha>' @ \<delta>) (i + ix) a1 U a2 \<and> splits_at \<gamma> j b1 U a2 \<and> LeftDerivation a1 D b1" 
     by blast
   have "\<exists> q. a2 = q@\<delta> \<and> \<alpha>' = a1 @ [U] @ q" 
     using splits_at_append_suffix_prevails[OF _ i_plus_ix_bound, where b=\<delta>] U by blast
   then obtain q where q: "a2 = q@\<delta> \<and> \<alpha>' = a1 @ [U] @ q" by blast
   show ?thesis
     apply (rule_tac x="b1@[U]@q" in exI)
     apply auto
     apply (rule_tac x="\<alpha>'" in exI)
     apply (metis LeftDerivationFix_def LeftDerivation_append_suffix U \<alpha>' 
       q append_Cons append_Nil is_sentence_concat ld_\<gamma>)
     using U q splits_at_combine apply auto[1]
     using U splits_at_def by auto  
 qed    
 
 lemma LeftDerivationIntro_finish:
   assumes intro: "LeftDerivationIntro (\<alpha>@\<delta>) i r ix D j \<gamma>"
   assumes i_\<alpha>: "i < length \<alpha>"
   shows "\<exists> k \<omega> \<delta>'.
     k \<le> length D \<and>
     LeftDerivation \<alpha> ((i, r)#(take k D)) \<omega> \<and>
     LeftDerivation (\<alpha> @ \<delta>) ((i, r)#(take k D)) (\<omega> @ \<delta>) \<and>
     derivation_ge (drop k D) (length \<omega>) \<and>
     LeftDerivation \<delta> (derivation_shift (drop k D) (length \<omega>) 0) \<delta>' \<and>
     \<gamma> = \<omega> @ \<delta>' \<and> j < length \<omega>"
 proof -
   from intro LeftDerivationIntro_def[where \<alpha>="\<alpha>@\<delta>" and i=i and r=r and ix=ix and D=D and 
     j=j and \<gamma>=\<gamma>]
   obtain \<beta> where ld_\<beta>: "LeftDerives1 (\<alpha> @ \<delta>) i r \<beta>" and 
      ix: "ix < length (snd r) \<and> snd r ! ix = \<gamma> ! j" and 
      \<beta>_fix: "LeftDerivationFix \<beta> (i + ix) D j \<gamma>"
      by blast
   from LeftDerives1_append_replace_in_left[OF ld_\<beta> i_\<alpha>]
   obtain \<alpha>' where \<alpha>': "\<beta> = \<alpha>' @ \<delta> \<and> LeftDerives1 \<alpha> i r \<alpha>' \<and> i + length (snd r) \<le> length \<alpha>'"
     by blast
   have i_plus_ix_bound: "i + ix < length \<alpha>'" using \<alpha>' ix by linarith
   have ld_\<gamma>: "LeftDerivationFix (\<alpha>' @ \<delta>) (i + ix) D j \<gamma>"
     using \<beta>_fix \<alpha>' by simp
   from LeftDerivationFix_splits_at_symbol[OF ld_\<gamma>] 
   obtain U a1 a2 b1 b2 n where U: 
     "splits_at (\<alpha>' @ \<delta>) (i + ix) a1 U a2 \<and>
      splits_at \<gamma> j b1 U b2 \<and>
      n \<le> length D \<and>
      LeftDerivation a1 (take n D) b1 \<and>
      derivation_ge (drop n D) (Suc (length b1)) \<and>
      LeftDerivation a2 (derivation_shift (drop n D) (Suc (length b1)) 0) b2 \<and>
      (n = length D \<or> n < length D \<and> is_word (b1 @ [U]))"
     by blast
   have n_bound: "n \<le> length D" using U by blast
   have "\<exists> q. a2 = q@\<delta> \<and> \<alpha>' = a1 @ [U] @ q" 
     using splits_at_append_suffix_prevails[OF _ i_plus_ix_bound, where b=\<delta>] U by blast
   then obtain q where q: "a2 = q@\<delta> \<and> \<alpha>' = a1 @ [U] @ q" by blast
   have j: "j = length b1"
     using U by (simp add: dual_order.strict_implies_order  min.absorb2 splits_at_def)
   have "n = length D \<or> n < length D \<and> is_word (b1 @ [U])" using U by blast
   then show ?thesis
   proof (induct rule: disjCases2)
     case 1
       from 1 have drop_n_D: "drop n D = []" by (simp add: U)
       then have "LeftDerivation a2 [] b2" using U by simp
       then have a2_eq_b2: "a2 = b2" by simp
         show ?case
           apply (rule_tac x="n" in exI)
           apply (rule_tac x="b1@[U]@q" in exI)
           apply (rule_tac x="\<delta>" in exI)
           apply auto
           apply (simp add: 1)
           apply (rule_tac x="\<alpha>'" in exI)
           apply (metis LeftDerivationFix_is_sentence LeftDerivation_append_suffix U \<alpha>' 
             append_Cons append_Nil is_sentence_concat ld_\<gamma> q)
           apply (rule_tac x="\<alpha>' @ \<delta>" in exI)
           apply (metis "1.hyps" LeftDerivationFix_def U \<alpha>' a2_eq_b2 id_take_nth_drop ld_\<beta> 
             ld_\<gamma> q splits_at_def take_all)
           apply (simp add: drop_n_D)+
           apply (metis U a2_eq_b2 id_take_nth_drop q splits_at_def)
           using j apply arith
           done
   next
     case 2   
       obtain E where E: "E = (derivation_shift (drop n D) (Suc (length b1)) 0)" by blast
       then have "LeftDerivation (q@\<delta>) E b2" using U q  by simp
       from LeftDerivation_breakdown'[OF this] obtain n' w1 w2 where w1w2:
         "n' \<le> length E \<and>
          b2 = w1 @ w2 \<and>
          LeftDerivation q (take n' E) w1 \<and>
          derivation_ge (drop n' E) (length w1) \<and>
          LeftDerivation \<delta> (derivation_shift (drop n' E) (length w1) 0) w2" by blast
       have length_E_D: "length E = length D - n" using E n_bound by simp
       have n_plus_n'_bound: "n + n' \<le> length D" using length_E_D w1w2 n_bound by arith
       have take_breakdown: "take (n + n') D = (take n D) @ (take n' (drop n D))"
         using take_add by blast
       have q_w1: "LeftDerivation q (take n' E) w1" using w1w2 by blast
       have isw: "is_word (b1 @ [U])" using 2 by blast
       have take_n': "take n' (drop n D) = derivation_shift (take n' E) 0 (Suc (length b1))"
         by (metis E U derivation_shift_left_right_cancel take_derivation_shift)  
       have \<alpha>'_derives_b1_U_w1: "LeftDerivation \<alpha>' (take (n + n') D) (b1 @ U # w1)"
         apply (subst take_breakdown)
         apply (rule_tac LeftDerivation_implies_append[where b="b1@[U]@q"])
         apply (metis LeftDerivationFix_is_sentence LeftDerivation_append_suffix U 
           is_sentence_concat ld_\<gamma> q)
         apply (simp add: take_n')
         by (rule LeftDerivation_append_prefix[OF q_w1, where u = "b1@[U]", OF isw, simplified])
       have dge: "derivation_ge (drop (n + n') D) (Suc (length b1 + length w1))"
       proof -
         have "derivation_ge (drop n' (drop n D)) (length b1 + 1 + length w1)"
           by (metis (no_types) E Suc_eq_plus1 U append_take_drop_id derivation_ge_append derivation_ge_shift_plus drop_derivation_shift w1w2)
         then show "derivation_ge (drop (n + n') D) (Suc (length b1 + length w1))"
           by (metis (no_types) Suc_eq_plus1 add.commute drop_drop semiring_normalization_rules(23))
       qed
       show ?case
         apply (rule_tac x="n+n'" in exI)
         apply (rule_tac x="b1 @ [U] @ w1" in exI)
         apply (rule_tac x=w2 in exI)
         apply auto
         using n_plus_n'_bound apply simp
         apply (rule_tac x="\<alpha>'" in exI)
         using \<alpha>' \<alpha>'_derives_b1_U_w1 apply blast
         apply (rule_tac x="\<alpha>' @ \<delta>" in exI)
         apply (metis Cons_eq_appendI LeftDerivationFix_is_sentence LeftDerivation_append_suffix
           \<alpha>' \<alpha>'_derives_b1_U_w1 append_assoc is_sentence_concat ld_\<beta> ld_\<gamma>)
         apply (rule dge)
         apply (metis E Suc_eq_plus1 add.commute derivation_shift_0_shift drop_derivation_shift 
           drop_drop w1w2)
         using U splits_at_combine w1w2 apply auto[1]
         by (simp add: j)  
   qed      
 qed    
 
 lemma LeftDerivationLadder_propagate:
   "LeftDerivationLadder (\<alpha>@\<delta>) D L \<gamma> \<Longrightarrow> ladder_i L 0 < length \<alpha> \<Longrightarrow> n = ladder_n L index
    \<Longrightarrow> index < length L \<Longrightarrow> 
      if (index + 1 < length L) then
        (\<exists> \<beta>. LeftDerivation \<alpha> (take n D) \<beta> \<and> ladder_\<gamma> (\<alpha>@\<delta>) D L index = \<beta>@\<delta> \<and> 
          ladder_j L index < length \<beta>)
      else 
        (\<exists> n' \<beta> \<delta>'. (index = 0 \<or> ladder_prev_n L index < n') \<and> n' \<le> n \<and> LeftDerivation \<alpha> (take n' D) \<beta> \<and>
          LeftDerivation (\<alpha>@\<delta>) (take n' D) (\<beta>@\<delta>) \<and>
          derivation_ge (drop n' D) (length \<beta>) \<and> 
          LeftDerivation \<delta> (derivation_shift (drop n' D) (length \<beta>) 0) \<delta>' \<and>
          ladder_\<gamma> (\<alpha>@\<delta>) D L index = \<beta>@\<delta>' \<and> ladder_j L index < length \<beta>)"
 proof (induct index arbitrary: n)
   case 0
   have ldfix:
     "LeftDerivationFix (\<alpha>@\<delta>) (ladder_i L 0) (take n D) (ladder_j L 0) (ladder_\<gamma> (\<alpha>@\<delta>) D L 0)"
     using "0.prems"(1) "0.prems"(3) LeftDerivationLadder_def by blast
   from 0 have "1 < length L \<or> 1 = length L" by arith
   then show ?case
   proof (induct rule: disjCases2) 
     case 1
     have "LeftDerivationIntrosAt (\<alpha>@\<delta>) D L 1"
       using "0.prems"(1) "1.hyps" LeftDerivationIntros_def LeftDerivationLadder_def by blast
     from LeftDerivationIntrosAt_implies_nonterminal[OF this] 
     have "is_nonterminal (ladder_\<gamma> (\<alpha> @ \<delta>) D L 0 ! ladder_j L 0)"
       by (simp add: ladder_\<alpha>_def ladder_i_def)
     with ldfix have "is_nonterminal ((\<alpha>@\<delta>) ! (ladder_i L 0))" by (simp add: LeftDerivationFix_def)
     from LeftDerivationFix_splits_at_nonterminal[OF ldfix this] obtain U a1 a2 b where thesplit:
       "splits_at (\<alpha> @ \<delta>) (ladder_i L 0) a1 U a2 \<and>
        splits_at (ladder_\<gamma> (\<alpha> @ \<delta>) D L 0) (ladder_j L 0) b U a2 \<and> 
        LeftDerivation a1 (take n D) b" by blast
     have "\<exists> \<delta>'. a2 = \<delta>' @ \<delta> \<and> \<alpha> = a1 @ [U] @ \<delta>'" 
     using thesplit splits_at_append_suffix_prevails using "0.prems"(2) by blast
     then obtain \<delta>' where \<delta>': "a2 = \<delta>' @ \<delta> \<and> \<alpha> = a1 @ ([U] @ \<delta>')" by blast
     obtain \<beta> where \<beta>: "\<beta> = b @ ([U] @ \<delta>')" by blast
     have "is_sentence \<alpha>" using LeftDerivationFix_is_sentence is_sentence_concat ldfix by blast
     then have "is_sentence ([U] @ \<delta>')" using \<delta>' is_sentence_concat by blast
     with \<delta>' thesplit have "LeftDerivation (a1 @ ([U] @ \<delta>')) (take n D) (b @ ([U] @ \<delta>'))"
       using LeftDerivation_append_suffix by blast
     then have \<alpha>_derives_\<beta>: "LeftDerivation \<alpha> (take n D) \<beta>" using \<beta> \<delta>' by blast
     have \<beta>_append_\<delta>: "ladder_\<gamma> (\<alpha> @ \<delta>) D L 0 = \<beta>@\<delta>" 
       by (metis \<beta> \<delta>' append_assoc splits_at_combine thesplit) 
     have ladder_j_bound: "ladder_j L 0 < length \<beta>"
       by (metis One_nat_def \<beta> diff_add_inverse dual_order.strict_implies_order leD le_add1 
         length_Cons length_append length_take list.size(3) min.absorb2 neq0_conv splits_at_def 
         thesplit zero_less_diff zero_less_one)
     show ?case
       using 1 apply simp
       apply (rule_tac x="\<beta>" in exI)
       by (auto simp add: \<alpha>_derives_\<beta> \<beta>_append_\<delta> ladder_j_bound)
   next
     case 2  
     note case_2 = 2
     have n_def: "n = length D"
       by (metis "0.prems"(1) "0.prems"(3) "2.hyps" LeftDerivationLadder_def One_nat_def 
         diff_Suc_1 is_ladder_def ladder_last_n_intro)
     then have take_n_D: "take n D = D" by (simp add: eq_imp_le)   
     from LeftDerivationFix_splits_at_symbol[OF ldfix] obtain U a1 a2 b1 b2 m where U:
       "splits_at (\<alpha> @ \<delta>) (ladder_i L 0) a1 U a2 \<and>
        splits_at (ladder_\<gamma> (\<alpha> @ \<delta>) D L 0) (ladder_j L 0) b1 U b2 \<and>
        m \<le> length (take n D) \<and>
        LeftDerivation a1 (take m (take n D)) b1 \<and>
        derivation_ge (drop m (take n D)) (Suc (length b1)) \<and> 
        LeftDerivation a2 (derivation_shift (drop m (take n D)) (Suc (length b1)) 0) b2 \<and>
        (m = length (take n D) \<or> (m < length (take n D) \<and> is_word (b1 @ [U])))" by blast
     obtain D' where D': "D' = derivation_shift (drop m D) (Suc (length b1)) 0" by blast
     then have a2_derives_b2: "LeftDerivation a2 D' b2" using U take_n_D by auto
     from U have m_leq_n: "m \<le> n"
       by (simp add: "0.prems"(1) "0.prems"(3) "0.prems"(4) LeftDerivationLadder_def is_ladder_def 
          min.absorb2) 
     from U have "splits_at (\<alpha> @ \<delta>) (ladder_i L 0) a1 U a2" by blast
     from splits_at_append_suffix_prevails[OF this 0(2)] obtain v' where 
       v': "a2 = v' @ \<delta> \<and> \<alpha> = a1 @ [U] @ v'" by blast
     have a1_derives_b1: "LeftDerivation a1 (take m D) b1" using m_leq_n U
       by (metis "0.prems"(1) "0.prems"(3) "2.hyps" LeftDerivationLadder_def One_nat_def 
         cancel_comm_monoid_add_class.diff_cancel is_ladder_def ladder_last_n_intro order_refl 
         take_all) 
     have "LeftDerivation (v' @ \<delta>) D' b2" using a2_derives_b2 v' by simp
     from LeftDerivation_breakdown'[OF this] obtain m' w1 w2 where w12:
       "b2 = w1 @ w2 \<and>
        m' \<le> length D' \<and>
        LeftDerivation v' (take m' D') w1 \<and>
        derivation_ge (drop m' D') (length w1) \<and>
        LeftDerivation \<delta> (derivation_shift (drop m' D') (length w1) 0) w2" by blast
     have "length D' \<le> length D - m" by (simp add: D')
     then have "m' \<le> length D - m" using w12 dual_order.trans by blast   
-    then have m_m'_leq_n: "m + m' \<le> n" using n_def m_leq_n Nat.le_diff_conv2 add.commute 
+    then have m_m'_leq_n: "m + m' \<le> n" using n_def m_leq_n le_diff_conv2 add.commute 
       by linarith  
     obtain \<beta> where \<beta>: "\<beta> = b1 @ ([U] @ w1)" by blast
     have "is_sentence ([U] @ v')"
       using LeftDerivationFix_is_sentence is_sentence_concat ldfix v' by blast 
     then have "LeftDerivation (a1 @ ([U] @ v')) (take m D) (b1 @ ([U] @ v'))"
       using LeftDerivation_append_suffix a1_derives_b1 by blast
     then have \<alpha>_derives_pre_\<beta>: "LeftDerivation \<alpha> (take m D) (b1 @ ([U] @ v'))" 
       using v' by blast 
     have "m = n \<or> (m < n \<and> is_word (b1 @ [U]))"
       using U n_def[symmetric] take_n_D by simp
     then have pre_\<beta>_derives_\<beta>: "LeftDerivation (b1 @ ([U] @ v')) (take m' (drop m D)) \<beta>"
     proof (induct rule: disjCases2)
       case 1
         then have "m' = 0" using m_m'_leq_n by arith
         then show ?case
           apply (simp add: \<beta>)
           using w12 by simp
     next
       case 2
         then have is_word_prefix: "is_word (b1 @ [U])" by blast
         have take_drop_eq: "take m' (drop m D) = derivation_shift (take m' D') 
             0 (length (b1 @ [U]))"
             apply (simp add: D' take_derivation_shift)
             by (metis U derivation_shift_left_right_cancel take_derivation_shift take_n_D)
         have v'_derives_w1: "LeftDerivation v' (take m' D') w1"
           by (simp add: w12)  
         with is_word_prefix have 
           "LeftDerivation ((b1 @ [U]) @ v') (derivation_shift (take m' D') 
             0 (length (b1 @ [U]))) ((b1 @ [U]) @ w1)"
           using  LeftDerivation_append_prefix by blast
         with take_drop_eq show ?case by (simp add: \<beta>) 
     qed   
     have "(take m D) @ (take m' (drop m D)) = (take (m + m') D)"
       by (simp add: take_add)  
     then have \<alpha>_derives_\<beta>: "LeftDerivation \<alpha> (take (m + m') D) \<beta>"
       using LeftDerivation_implies_append \<alpha>_derives_pre_\<beta> pre_\<beta>_derives_\<beta> by fastforce
     have derivation_ge_drop_m_m': "derivation_ge (drop (m + m') D) (length \<beta>)"
       proof -
         have f1: "drop m' (drop m D) = drop (m + m') D"
           by (simp add: add.commute)
         have "derivation_ge (drop m' (drop m D)) (Suc (length b1))"
           by (metis (no_types) U append_take_drop_id derivation_ge_append take_n_D)
         then show "derivation_ge (drop (m + m') D) (length \<beta>)"
           using f1 by (metis (no_types) D' \<beta> append_assoc derivation_ge_shift_plus 
             drop_derivation_shift length_append length_append_singleton w12)   
       qed  
     have \<delta>_derives_w2: "LeftDerivation \<delta> (derivation_shift (drop (m + m') D) (length \<beta>) 0) w2" 
       proof -
         have "derivation_shift (drop m' D') (length w1) 0 = derivation_shift (drop (m + m') D) (length \<beta>) 0"
           by (simp add: D' \<beta> add.commute derivation_shift_0_shift drop_derivation_shift)
         then show "LeftDerivation \<delta> (derivation_shift (drop (m + m') D) (length \<beta>) 0) w2"
           using w12 by presburger
       qed
     have ladder_\<gamma>_def: "ladder_\<gamma> (\<alpha> @ \<delta>) D L 0 = \<beta> @ w2"
       using U \<beta> splits_at_combine w12 by auto
     have ladder_j_bound: "ladder_j L 0 < length \<beta>" using U \<beta> splits_at_def by auto 
     show ?case
       using 2 apply simp
       apply (rule_tac x="m + m'" in exI)
       apply (auto simp add: m_m'_leq_n)
       apply (rule_tac x="\<beta>" in exI)
       apply (auto simp add: \<alpha>_derives_\<beta>)
       using LeftDerivationFix_is_sentence LeftDerivation_append_suffix \<alpha>_derives_\<beta> 
         is_sentence_concat ldfix apply blast
       using derivation_ge_drop_m_m' apply blast
       apply (rule_tac x="w2" in exI)
       apply auto
       using \<delta>_derives_w2 apply blast
       using ladder_\<gamma>_def apply blast
       using ladder_j_bound apply blast
       done
   qed
 next
   case (Suc index)
   have step: "LeftDerivationIntrosAt (\<alpha>@\<delta>) D L (Suc index)"
     by (metis LeftDerivationIntros_def LeftDerivationLadder_def Suc.prems(1) Suc.prems(4)      
       Suc_eq_plus1_left le_add1)
   have index_plus_1_bound: "index + 1 < length L"
     using Suc.prems(4) by linarith
   then have index_bound: "index < length L" by arith
   obtain n' where n': "n' = ladder_n L index" by blast
   from Suc.hyps[OF Suc.prems(1) Suc.prems(2) n' index_bound] index_plus_1_bound 
   have "\<exists> \<alpha>'. LeftDerivation \<alpha> (take n' D) \<alpha>' \<and> 
     ladder_\<gamma> (\<alpha>@\<delta>) D L index = \<alpha>'@\<delta> \<and> ladder_j L index < length \<alpha>'"
     by auto
   then obtain \<alpha>' where \<alpha>': "LeftDerivation \<alpha> (take n' D) \<alpha>' \<and> 
     ladder_\<gamma> (\<alpha>@\<delta>) D L index = \<alpha>'@\<delta> \<and> ladder_j L index < length \<alpha>'"
     by blast
   have Suc_index_bound: "Suc index < length L" using Suc.prems by auto
   have is_ladder: "is_ladder D L" using Suc.prems LeftDerivationLadder_def by auto 
   have n_def: "n = ladder_n L (Suc index)" 
     using Suc_index_bound n' by (simp add: Suc.prems(3)) 
   with n' have n'_less_n: "n' < n" using is_ladder Suc_index_bound is_ladder_def lessI by blast
   have ladder_\<alpha>_is_\<gamma>: "ladder_\<alpha> (\<alpha>@\<delta>) D L (Suc index) = ladder_\<gamma> (\<alpha>@\<delta>) D L index"
     by (simp add: ladder_\<alpha>_def)
   obtain i where i: "i = ladder_i L (Suc index)" by blast
   obtain e where e: "e = (D ! n')" by blast
   obtain E where E: "E = drop (Suc n') (take n D)" by blast
   obtain ix where ix: "ix = ladder_ix L (Suc index)" by blast
   obtain j where j: "j = ladder_j L (Suc index)" by blast
   obtain \<gamma> where \<gamma>: "\<gamma> = ladder_\<gamma> (\<alpha>@\<delta>) D L (Suc index)" by blast
   have intro: "LeftDerivationIntro (\<alpha>'@\<delta>) i (snd e) ix E j \<gamma>"
     by (metis E LeftDerivationIntrosAt_def \<alpha>' \<gamma> ladder_\<alpha>_is_\<gamma> 
       diff_Suc_1 e i ix j local.step n' n_def)
   have is_eq_fst_e: "i = fst e" 
     by (metis LeftDerivationIntrosAt_def diff_Suc_1 e i local.step n')
   have i_less_\<alpha>': "i < length \<alpha>'" using i \<alpha>' ladder_i_def by simp
   have "(Suc index) + 1 < length L \<or> (Suc index) + 1 = length L"
     using Suc_index_bound by arith
   then show ?case
   proof (induct rule: disjCases2)
     case 1
       from 1 have "LeftDerivationIntrosAt (\<alpha>@\<delta>) D L (Suc (Suc index))"
         by (metis LeftDerivationIntros_def LeftDerivationLadder_def Suc.prems(1) 
           Suc_eq_plus1 Suc_eq_plus1_left le_add1)
       from LeftDerivationIntrosAt_implies_nonterminal[OF this] have 
         "is_nonterminal (ladder_\<alpha> (\<alpha> @ \<delta>) D L (Suc (Suc index)) ! ladder_i L (Suc (Suc index)))"
         by blast
       then have non_\<gamma>_j: "is_nonterminal (\<gamma> ! j)" by (simp add: \<gamma> j ladder_\<alpha>_def ladder_i_def)
       from LeftDerivationIntro_propagate[OF intro i_less_\<alpha>' non_\<gamma>_j]  
       obtain \<omega> where \<omega>: "LeftDerivation \<alpha>' ((i, snd e) # E) \<omega> \<and> \<gamma> = \<omega> @ \<delta> \<and> j < length \<omega>"
         by blast
       have \<alpha>_\<omega>: "LeftDerivation \<alpha> ((take n' D)@((i, snd e) # E)) \<omega>"
         using \<alpha>' \<omega> LeftDerivation_implies_append by blast
       have i_e: "(i, snd e) = e" by (simp add: is_eq_fst_e)
       have take_n_D_e: "((take n' D)@(e # E)) = take n D"
       proof - (* automatically found *)
         obtain nn :: "(nat \<times> symbol \<times> symbol list) list \<Rightarrow> (nat \<times> nat \<times> nat) list \<Rightarrow> nat" and 
           nna :: "(nat \<times> symbol \<times> symbol list) list \<Rightarrow> (nat \<times> nat \<times> nat) list \<Rightarrow> nat" and 
           nnb :: "(nat \<times> symbol \<times> symbol list) list \<Rightarrow> (nat \<times> nat \<times> nat) list \<Rightarrow> nat" where
           f1: "(\<forall>ps psa. \<not> is_ladder ps psa \<or> psa \<noteq> [] \<and> (\<forall>n. \<not> n < length psa \<or> 
             ladder_n psa n \<le> length ps) \<and> (\<forall>n na. (\<not> n < na \<or> \<not> na < length psa) \<or> 
             ladder_n psa n < ladder_n psa na) \<and> ladder_last_n psa = length ps) \<and> 
             (\<forall>ps psa. (psa = [] \<or> nn ps psa < length psa \<and> \<not> ladder_n psa (nn ps psa) \<le> 
               length ps \<or> (nna ps psa < nnb ps psa \<and> nnb ps psa < length psa) \<and> 
               \<not> ladder_n psa (nna ps psa) < ladder_n psa (nnb ps psa) \<or> 
               ladder_last_n psa \<noteq> length ps) \<or> is_ladder ps psa)"
           using is_ladder_def by moura
         then have f2: "ladder_last_n L = length D"
           using is_ladder by blast
         have f3: "min (ladder_last_n L) n = n"
           using f1 by (metis (no_types) Suc_eq_plus1 index_plus_1_bound is_ladder 
             min.absorb2 n_def)
         then have "take n' (take n D) @ take n D ! n' # E = take n D"
           using f2 by (metis E id_take_nth_drop length_take n'_less_n)
         then show ?thesis
           using f3 f2 by (metis (no_types) append_assoc append_eq_conv_conj 
             dual_order.strict_implies_order e length_take min.absorb2 n'_less_n nth_append)
       qed             
       from 1 show ?case
         apply auto
         apply (rule_tac x=\<omega> in exI)
         apply auto
         using \<alpha>_\<omega> i_e take_n_D_e apply auto[1]
         using \<gamma> \<omega> apply blast
         using \<omega> j by blast
   next
     case 2  
     from LeftDerivationIntro_finish[OF intro i_less_\<alpha>'] obtain k \<omega> \<delta>' where kw\<delta>':
       "k \<le> length E \<and>
        LeftDerivation \<alpha>' ((i, snd e) # take k E) \<omega> \<and>
        LeftDerivation (\<alpha>' @ \<delta>) ((i, snd e) # take k E) (\<omega> @ \<delta>) \<and>
        derivation_ge (drop k E) (length \<omega>) \<and>
        LeftDerivation \<delta> (derivation_shift (drop k E) (length \<omega>) 0) \<delta>' \<and> 
        \<gamma> = \<omega> @ \<delta>' \<and> j < length \<omega>" by blast
     have ladder_last_n_1: "ladder_last_n L = n"
       by (metis "2.hyps" Suc_eq_plus1 diff_Suc_1 ladder_last_n_def n_def)
     from is_ladder have ladder_last_n_2: "ladder_last_n L = length D"
       using is_ladder_def by blast 
     from ladder_last_n_1 ladder_last_n_2 have n_eq_length_D: "n = length D" by blast  
     have take_split: "take (Suc (n' + k)) D = (take n' D) @ ((i, snd e) # take k E)"
       apply (simp add: E n_eq_length_D)
       by (metis (no_types, lifting) Cons_eq_appendI add_Suc append_eq_appendI e 
         is_eq_fst_e n'_less_n n_eq_length_D prod.collapse 
         self_append_conv2 take_Suc_conv_app_nth take_add)
     have \<alpha>_\<omega>: "LeftDerivation \<alpha> (take (Suc (n' + k)) D) \<omega>" 
       apply (subst take_split)
       apply (rule LeftDerivation_implies_append[where b="\<alpha>'"])
       apply (simp add: \<alpha>')
       using kw\<delta>' by blast 
     have Suc_n'_k_bound: "Suc (n' + k) \<le> n" using E kw\<delta>' n'_less_n by auto[1]
     from 2 show ?case
       apply auto   
       apply (rule_tac x="Suc (n' + k)" in exI)
       apply auto
       apply (simp add: ladder_prev_n_def n')
       using Suc_n'_k_bound apply blast
       apply (rule_tac x="\<omega>" in exI)
       apply auto
       using \<alpha>_\<omega> apply blast
       using \<alpha>_\<omega> LeftDerivationFix_def LeftDerivationLadder_def LeftDerivation_append_suffix 
         Suc.prems(1) is_sentence_concat apply auto[1]
       apply (metis E add.commute add_Suc_right drop_drop kw\<delta>' n_eq_length_D nat_le_linear 
         take_all)
       apply (rule_tac x="\<delta>'" in exI)
       apply auto
       apply (metis E LeftDerivationLadder_ladder_n_bound Suc.prems(1) Suc_index_bound 
         add.commute add_Suc_right drop_drop kw\<delta>' n_def n_eq_length_D take_all)
       using \<gamma> kw\<delta>' apply blast
       using j kw\<delta>' by blast
   qed
 qed    
 
 lemma ladder_i_of_cut_at_0: 
   assumes L_non_empty: "L \<noteq> []"
   shows "ladder_i (ladder_cut L n) 0 = ladder_i L 0"
 proof -
   have "length L \<noteq> 0" using L_non_empty by auto
   then have "length L = 1 \<or> length L > 1" by arith
   then show ?thesis
   proof (induct rule: disjCases2)
     case 1
       then show ?case
         apply (simp add: ladder_cut_def ladder_i_def deriv_i_def)
         by (simp add: assms hd_conv_nth)
   next  
     case 2
       then show ?case
         apply (simp add: ladder_cut_def ladder_i_def deriv_i_def)
         by (metis diff_is_0_eq hd_conv_nth leD list_update_nonempty nth_list_update_neq)
   qed
 qed 
 
 lemma ladder_last_j_of_cut: 
   assumes L_non_empty: "L \<noteq> []"
   shows "ladder_last_j (ladder_cut L n) = ladder_last_j L"
 proof -
   have length_L_nonzero: "length L \<noteq> 0" using L_non_empty by auto
   then have length_ladder_cut: "length (ladder_cut L n) = length L"
     by (metis ladder_cut_def length_list_update) 
   show ?thesis
     apply (simp add: ladder_last_j_def length_ladder_cut)
     apply (simp add: ladder_cut_def ladder_j_def deriv_j_def)
     by (metis length_L_nonzero diff_less neq0_conv nth_list_update_eq snd_conv zero_less_Suc)
 qed
 
 lemma length_ladder_cut:
   assumes L_non_empty: "L \<noteq> []"
   shows "length (ladder_cut L n) = length L"
 by (metis ladder_cut_def length_list_update)
 
 lemma ladder_last_n_of_cut:
   assumes L_non_empty: "L \<noteq> []"
   shows "ladder_last_n (ladder_cut L n) = n"
 proof -
   show ?thesis
     apply (simp add: ladder_last_n_def length_ladder_cut[OF L_non_empty])
     apply (simp add: ladder_n_def ladder_cut_def deriv_n_def)
     by (metis assms diff_Suc_less fst_conv length_greater_0_conv nth_list_update_eq)
 qed  
 
 lemma ladder_n_of_cut:
   assumes L_non_empty: "L \<noteq> []"
   assumes "index < length L - 1"
   shows "ladder_n (ladder_cut L n) index = ladder_n L index"
 by (metis assms(2) ladder_cut_def ladder_n_def nat_neq_iff nth_list_update_neq)
      
 lemma ladder_n_prev_bound:
   assumes ladder: "is_ladder D L"
   assumes u_bound: "u < length L - 1"
   shows "ladder_n L u \<le> ladder_prev_n L (length L - 1)"
 proof -
   have "ladder_n L u \<le> ladder_n L (length L - 2)"
   proof -
     have "u < Suc (length L - 2)"
       using u_bound by linarith
     then show ?thesis
       by (metis (no_types) diff_Suc_less is_ladder_def ladder leI length_greater_0_conv 
         not_less_eq numeral_2_eq_2 order.order_iff_strict)
   qed
   then show ?thesis
     by (metis One_nat_def Suc_diff_Suc diff_Suc_1 ladder_prev_n_def neq0_conv not_less0 
       numeral_2_eq_2 u_bound zero_less_diff)
 qed      
 
 lemma ladder_n_last_is_length:
   assumes "is_ladder D L"
   shows "ladder_n L (length L - 1) = length D"
 using assms is_ladder_def ladder_last_n_intro by auto
 
 lemma derivation_ge_shift_implies_derivation_ge:
   assumes dge: "derivation_ge (derivation_shift F 0 j) k"
   shows "derivation_ge F (k - j)"
 proof -
   have "\<And> i r. (i, r) \<in> set (derivation_shift F 0 j) \<Longrightarrow> i \<ge> k"
     using dge derivation_ge_def by auto
   {
     fix i :: nat
     fix r :: "symbol \<times> (symbol list)"
     assume ir: "(i, r) \<in> set F"
     then have "(i + j, r) \<in> set (derivation_shift F 0 j)"
     proof -
       have "(i + j, r) \<in> (\<lambda>p. (fst p - 0 + j, snd p)) ` set F"
         by (metis (lifting) ir diff_zero image_eqI prod.collapse prod.inject)
       then show ?thesis
         by (simp add: derivation_shift_def)
     qed
     then have "i + j \<ge> k" using dge derivation_ge_def by auto
     then have "i \<ge> k - j" by auto
   }
   then show ?thesis using derivation_ge_def by auto
 qed      
 
 lemma Derives1_bound': "Derives1 a i r b \<Longrightarrow> i \<le> length b"
   by (metis Derives1_bound Derives1_take append_Nil2 append_take_drop_id drop_eq_Nil 
     dual_order.strict_implies_order length_take min.absorb2 nat_le_linear) 
 
 lemma LeftDerivation_Derives1_last:
   assumes "LeftDerivation a D b"
   assumes "D \<noteq> []"
   shows "Derives1 (Derive a (take (length D - 1) D)) (fst (last D)) (snd (last D)) b"
 by (metis Derive LeftDerivation_Derive_take_LeftDerives1 LeftDerivation_implies_Derivation 
   LeftDerives1_implies_Derives1 assms(1) assms(2) last_conv_nth le_refl length_0_conv take_all)
 
 lemma last_of_prefix_in_set:
   assumes "n < length E"
   assumes "D = E@F"
   shows "last E \<in> set (drop n D)"
 proof -
   have f1: "last (drop n E) = last E"
     by (simp add: assms(1))
   have "drop n E \<noteq> []"
     by (metis (no_types) Cons_nth_drop_Suc assms(1) list.simps(3))
   then show ?thesis
     using f1 by (metis (no_types) append.simps(2) append_butlast_last_id append_eq_conv_conj assms(2) drop_append in_set_dropD insertCI list.set(2))
 qed
 
 lemma LeftDerivationFix_cut_appendix:
   assumes ldfix: "LeftDerivationFix (\<alpha>@\<delta>) i D j (\<beta>@\<delta>')"
   assumes \<alpha>_\<beta>: "LeftDerivation \<alpha> (take n D) \<beta>"
   assumes n_bound: "n \<le> length D"
   assumes dge: "derivation_ge (drop n D) (length \<beta>)"
   assumes i_in: "i < length \<alpha>"
   assumes j_in: "j < length \<beta>"
   shows "LeftDerivationFix \<alpha> i (take n D) j \<beta>"
 proof - 
   from LeftDerivationFix_def[where \<alpha>="\<alpha>@\<delta>" and i=i and D=D and j=j and \<beta>="\<beta>@\<delta>'"] 
   obtain E F where EF:
     "is_sentence (\<alpha> @ \<delta>) \<and>
      is_sentence (\<beta> @ \<delta>') \<and>
      LeftDerivation (\<alpha> @ \<delta>) D (\<beta> @ \<delta>') \<and>
      i < length (\<alpha> @ \<delta>) \<and>
      j < length (\<beta> @ \<delta>') \<and>
      (\<alpha> @ \<delta>) ! i = (\<beta> @ \<delta>') ! j \<and>
      D = E @ derivation_shift F 0 (Suc j) \<and>
         LeftDerivation (take i (\<alpha> @ \<delta>)) E (take j (\<beta> @ \<delta>')) \<and>
         LeftDerivation (drop (Suc i) (\<alpha> @ \<delta>)) F (drop (Suc j) (\<beta> @ \<delta>'))" using ldfix by auto
   with i_in j_in have take_i_E_take_j: "LeftDerivation (take i \<alpha>) E (take j \<beta>)"
     by (simp add: less_or_eq_imp_le)  
   obtain m where m: "m = length E" by blast
   {
     assume n_less_m: "n < m"
     then have E_nonempty: "E \<noteq> []" using gr_implies_not0 list.size(3) m by auto 
     have last_E_in_set: "last E \<in> set (drop n D)" 
       using last_of_prefix_in_set n_less_m m EF by blast 
     obtain k r where kr: "(k, r) = last E" by (metis old.prod.exhaust)
     have k_lower_bound: "k \<ge> length \<beta>" using dge last_E_in_set kr
       by (metis derivation_ge_def fst_conv) 
     have "\<exists> \<alpha>'. Derives1 \<alpha>' k r (take j \<beta>)"  using LeftDerivation_Derives1_last take_i_E_take_j
       by (metis E_nonempty kr fst_conv snd_conv)
     then have "k \<le> j" by (metis Derives1_bound' j_in length_take less_imp_le_nat min.absorb2)   
     then have k_upper_bound: "k < length \<beta>" using j_in by arith
     from k_lower_bound k_upper_bound have "False" by arith
   }
   then have m_le_n: "m \<le> n" by arith
   have take_i_E_take_j: "LeftDerivation (take i \<alpha>) E (take j \<beta>)"
     by (simp add: take_i_E_take_j)
   have "take n D = E @ (take (n - m) (derivation_shift F 0 (Suc j)))"
     using EF m m_le_n by auto
   then have take_n_D: "take n D = E @ (derivation_shift (take (n - m) F) 0 (Suc j))"
     using take_derivation_shift by auto
   obtain F' where F': "F' = derivation_shift (take (n - m) F) 0 (Suc j)" by blast 
   have "LeftDerivation ((take i \<alpha>)@(drop i \<alpha>)) E ((take j \<beta>)@(drop i \<alpha>))" 
     using take_i_E_take_j
     by (metis EF LeftDerivation_append_suffix append_take_drop_id is_sentence_concat)     
   then have "LeftDerivation \<alpha> E ((take j \<beta>)@(drop i \<alpha>))" by simp
   with take_n_D have take_j_drop_i: "LeftDerivation ((take j \<beta>)@(drop i \<alpha>)) F' \<beta>" using F'  
     by (metis Derivation_unique_dest LeftDerivation_append LeftDerivation_implies_Derivation \<alpha>_\<beta>)
   have F'_ge: "derivation_ge F' (Suc j)" using F' derivation_ge_shift by blast 
   have drop_append: "drop i \<alpha> = [\<alpha>!i] @ (drop (Suc i) \<alpha>)" by (simp add: Cons_nth_drop_Suc i_in)
   have take_append: "take j \<beta> @ [\<alpha>!i] = take (Suc j) \<beta>"
     by (metis LeftDerivationFix_def i_in j_in ldfix nth_superfluous_append take_Suc_conv_app_nth)
   have take_drop_Suc: "(take j \<beta>)@(drop i \<alpha>) = (take (Suc j) \<beta>)@(drop (Suc i) \<alpha>)"
     by (simp add: drop_append take_append)
   with take_drop_Suc take_j_drop_i have "LeftDerivation ((take (Suc j) \<beta>)@(drop (Suc i) \<alpha>)) F' \<beta>"
     by auto
   note helper = LeftDerivation_skip_prefix[OF this]
   have len_take: "length (take (Suc j) \<beta>) = Suc j" by (simp add: Suc_leI j_in min.absorb2)    
   have F'_shift: "derivation_shift F' (Suc j) 0 = take (n - m) F"
     using F' derivation_shift_right_left_cancel by blast  
   have LeftDerivation_drop: "LeftDerivation (drop (Suc i) \<alpha>) (take (n - m) F) (drop (Suc j) \<beta>)"  
     using helper len_take F'_shift F'_ge by auto   
   show ?thesis
     apply (auto simp add: LeftDerivationFix_def)
     using LeftDerivationFix_is_sentence is_sentence_concat ldfix apply blast
     using LeftDerivationFix_is_sentence is_sentence_concat ldfix apply blast
     using \<alpha>_\<beta> apply blast
     using i_in apply blast
     using j_in apply blast
     using LeftDerivationFix_def i_in j_in ldfix apply auto[1]
     apply (rule_tac x=E in exI)
     apply (rule_tac x="take (n - m) F" in exI)
     apply auto
     using take_n_D apply blast
     using take_i_E_take_j apply blast
     using LeftDerivation_drop by blast
 qed
 
 lemma LeftDerivationFix_cut_appendix':
   assumes ldfix: "LeftDerivationFix (\<alpha>@\<delta>) i D j (\<beta>@\<delta>')"
   assumes \<alpha>_\<beta>: "LeftDerivation \<alpha> D \<beta>"
   assumes i_in: "i < length \<alpha>"
   assumes j_in: "j < length \<beta>"
   shows "LeftDerivationFix \<alpha> i D j \<beta>"
 proof -
   obtain n where n: "n = length D" by blast
   have "LeftDerivationFix \<alpha> i (take n D) j \<beta>"
     apply (rule_tac LeftDerivationFix_cut_appendix)
     apply (rule ldfix)
     using \<alpha>_\<beta> n apply auto[1]
     using n apply auto[1]
     using n apply auto[1]
     using i_in apply blast
     using j_in apply blast
     done
   then show ?thesis using n by auto
 qed
 
 lemma LeftDerivationIntro_cut_appendix:
   assumes ldfix: "LeftDerivationIntro (\<alpha>@\<delta>) i r ix D j (\<beta>@\<delta>')"
   assumes \<alpha>_\<beta>: "LeftDerivation \<alpha> ((i,r)#(take n D)) \<beta>"
   assumes n_bound: "n \<le> length D"
   assumes dge: "derivation_ge (drop n D) (length \<beta>)"
   assumes i_in: "i < length \<alpha>"
   assumes j_in: "j < length \<beta>"
   shows "LeftDerivationIntro \<alpha> i r ix (take n D) j \<beta>"
 proof -
   from LeftDerivationIntro_def[where \<alpha>="\<alpha>@\<delta>" and i=i and r=r and ix=ix and D=D and j=j and \<gamma>="\<beta>@\<delta>'"]
   obtain \<omega> where \<omega>: "LeftDerives1 (\<alpha> @ \<delta>) i r \<omega> \<and>
       ix < length (snd r) \<and> snd r ! ix = (\<beta> @ \<delta>') ! j \<and> LeftDerivationFix \<omega> (i + ix) D j (\<beta> @ \<delta>')"
       using ldfix by blast
   then have "\<exists> \<alpha>'. \<omega> = \<alpha>' @ \<delta> \<and> i + length (snd r) \<le> length \<alpha>'" 
     using i_in using LeftDerives1_append_replace_in_left by blast 
   then obtain \<alpha>' where \<alpha>': "\<omega> = \<alpha>' @ \<delta> \<and> i + length (snd r) \<le> length \<alpha>'" by blast
   have \<alpha>_\<alpha>': "LeftDerives1 \<alpha> i r \<alpha>'" using \<alpha>' \<omega> using LeftDerives1_skip_suffix i_in by blast 
   from \<alpha>_\<beta> obtain u where u: "LeftDerives1 \<alpha> i r u \<and> LeftDerivation u (take n D) \<beta>" by auto
   with \<alpha>_\<alpha>' have "u = \<alpha>'" using Derives1_unique_dest LeftDerives1_implies_Derives1 by blast
   with u have \<alpha>'_\<beta>: "LeftDerivation \<alpha>' (take n D) \<beta>" by auto
   have ldfix_append: "LeftDerivationFix (\<alpha>' @ \<delta>) (i + ix) D j (\<beta> @ \<delta>')" using \<alpha>' \<omega> by blast
   have i_plus_ix_bound: "i + ix < length \<alpha>'" using \<omega> \<alpha>'
     using add_lessD1 le_add_diff_inverse less_asym' linorder_neqE_nat nat_add_left_cancel_less 
     by linarith 
   from LeftDerivationFix_cut_appendix[OF ldfix_append \<alpha>'_\<beta> n_bound dge i_plus_ix_bound j_in]  
   have ldfix: "LeftDerivationFix \<alpha>' (i + ix) (take n D) j \<beta>" .
   show ?thesis
     apply (simp add: LeftDerivationIntro_def)
     apply (rule_tac x="\<alpha>'" in exI)
     apply auto
     using \<alpha>_\<alpha>' apply blast
     using \<omega> apply blast
     apply (simp add: \<omega> j_in)
     using ldfix by blast
 qed
 
 lemma LeftDerivationIntro_cut_appendix':
   assumes ldfix: "LeftDerivationIntro (\<alpha>@\<delta>) i r ix D j (\<beta>@\<delta>')"
   assumes \<alpha>_\<beta>: "LeftDerivation \<alpha> ((i,r)#D) \<beta>"
   assumes i_in: "i < length \<alpha>"
   assumes j_in: "j < length \<beta>"
   shows "LeftDerivationIntro \<alpha> i r ix D j \<beta>"
 proof -
   obtain n where n: "n = length D" by blast
   have "LeftDerivationIntro \<alpha> i r ix (take n D) j \<beta>"
     apply (rule_tac LeftDerivationIntro_cut_appendix)
     apply (rule ldfix)
     using \<alpha>_\<beta> n apply auto[1]
     using n apply auto[1]
     using n apply auto[1]
     using i_in apply blast
     using j_in apply blast
     done
   then show ?thesis using n by auto
 qed
 
 lemma ladder_n_monotone: "is_ladder D L \<Longrightarrow> u \<le> v \<Longrightarrow> v < length L \<Longrightarrow> ladder_n L u \<le> ladder_n L v"
 by (metis is_ladder_def le_neq_implies_less linear not_less)
     
 lemma ladder_i_cut: 
   assumes index_bound: "index < length L"
   shows "ladder_i (ladder_cut L n) index = ladder_i L index"
 proof -
   have "index = 0 \<or> index > 0" by arith
   then show ?thesis
   proof (induct rule: disjCases2)
     case 1 
       with index_bound have "L \<noteq> []" by (simp add: less_numeral_extra(3))
       then show ?case using 1 by (simp add: ladder_i_of_cut_at_0) 
   next
     case 2      
       then show ?case
         apply (auto simp add: ladder_i_def ladder_cut_def ladder_j_def deriv_j_def Let_def)
         using index_bound by auto
   qed
 qed
 
 lemma ladder_j_cut: 
   assumes index_bound: "index < length L"
   shows "ladder_j (ladder_cut L n) index = ladder_j L index"
 by (metis gr_implies_not0 index_bound ladder_cut_def ladder_j_def ladder_last_j_def 
   ladder_last_j_of_cut length_ladder_cut list.size(3) nth_list_update_neq)
 
 lemma ladder_ix_cut: 
   assumes index_lower_bound: "index > 0"
   assumes index_upper_bound: "index < length L"
   shows "ladder_ix (ladder_cut L n) index = ladder_ix L index"
 proof -
   show ?thesis
     using index_lower_bound apply (simp add: ladder_ix_def deriv_ix_def)
     by (metis index_upper_bound ladder_cut_def nth_list_update_eq nth_list_update_neq snd_conv)
 qed    
 
 lemma LeftDerivation_from_in_between:
   assumes \<alpha>_\<beta>: "LeftDerivation \<alpha> (take u D) \<beta>"
   assumes \<alpha>_\<gamma>: "LeftDerivation \<alpha> (take v D) \<gamma>"
   assumes u_le_v: "u \<le> v"
   shows "LeftDerivation \<beta> (drop u (take v D)) \<gamma>"
 proof -
   have take_split: "take v D = take u D @ (drop u (take v D))"
     by (metis u_le_v add_diff_cancel_left' drop_take le_Suc_ex take_add) 
   then show ?thesis using \<alpha>_\<gamma> \<alpha>_\<beta>
     by (metis (no_types, lifting) Derivation_unique_dest LeftDerivation_append 
       LeftDerivation_implies_Derivation) 
 qed
 
 lemma LeftDerivationLadder_cut_appendix_helper: 
   assumes LDLadder: "LeftDerivationLadder (\<alpha>@\<delta>) D L \<gamma>"
   assumes ladder_i_in_\<alpha>: "ladder_i L 0 < length \<alpha>"
   shows "\<exists> E F \<gamma>1 \<gamma>2 L'. D = E@F \<and> 
     \<gamma> = \<gamma>1 @ \<gamma>2 \<and> 
     LeftDerivationLadder \<alpha> E L' \<gamma>1 \<and> 
     derivation_ge F (length \<gamma>1) \<and>
     LeftDerivation \<delta> (derivation_shift F (length \<gamma>1) 0) \<gamma>2 \<and>
     L' = ladder_cut L (length E)" 
 proof -
   have is_ladder_D_L: "is_ladder D L" using LDLadder LeftDerivationLadder_def by blast 
   obtain n where n: "n = ladder_last_n L" by blast
   then have n_eq_ladder_n: "n = ladder_n L (length L - 1)" using ladder_last_n_def by blast 
   have length_L_nonzero: "length L > 0"
     using LeftDerivationLadder_def assms(1) is_ladder_def by blast 
   from LeftDerivationLadder_propagate[OF LDLadder ladder_i_in_\<alpha> n_eq_ladder_n]
   obtain n' \<beta> \<delta>' where finish:
     "(length L - 1 = 0 \<or> ladder_prev_n L (length L - 1) < n') \<and>
      n' \<le> n \<and>
      LeftDerivation \<alpha> (take n' D) \<beta> \<and>
      LeftDerivation (\<alpha> @ \<delta>) (take n' D) (\<beta> @ \<delta>) \<and>
      derivation_ge (drop n' D) (length \<beta>) \<and>
      LeftDerivation \<delta> (derivation_shift (drop n' D) (length \<beta>) 0) \<delta>' \<and>
      ladder_\<gamma> (\<alpha> @ \<delta>) D L (length L - 1) = \<beta> @ \<delta>' \<and> ladder_j L (length L - 1) < length \<beta>"
      using length_L_nonzero by auto
   obtain E where E: "E = take n' D" by blast
   obtain F where F: "F = drop n' D" by blast
   obtain L' where L': "L' = ladder_cut L (length E)" by blast
   have \<gamma>_ladder: "\<gamma> = ladder_\<gamma> (\<alpha> @ \<delta>) D L (length L - 1)"
     by (metis Derive LDLadder LeftDerivationLadder_def LeftDerivation_implies_Derivation 
       append_Nil2 append_take_drop_id drop_eq_Nil is_ladder_def ladder_\<gamma>_def le_refl n 
       n_eq_ladder_n) 
   then have \<gamma>: "\<gamma> = \<beta> @ \<delta>'" using finish by auto
   have "is_sentence (\<alpha>@\<delta>)"
     using LDLadder LeftDerivationFix_is_sentence LeftDerivationLadder_def by blast
   then have is_sentence_\<alpha>: "is_sentence \<alpha>" using is_sentence_concat by blast 
   have "is_sentence \<gamma>"
     using Derivation_implies_derives LDLadder LeftDerivationFix_is_sentence 
       LeftDerivationLadder_def LeftDerivation_implies_Derivation derives_is_sentence by blast
   then have is_sentence_\<beta>: "is_sentence \<beta>" using \<gamma> is_sentence_concat by blast 
   have length_L': "length L' = length L"
     by (metis L' ladder_cut_def length_list_update)
   have ladder_last_n_L': "ladder_last_n L' = length E"
     using L' ladder_last_n_of_cut length_L_nonzero by blast
   have length_D_eq_n: "length D = n"
     using LDLadder LeftDerivationLadder_def is_ladder_def n by auto     
   then have length_E_eq_n': "length E = n'" by (simp add: E finish min.absorb2) 
   {
     fix u :: nat
     assume "u < length L'"
     then have "u < length L' - 1 \<or> u = length L' - 1" by arith
     then have "ladder_n L' u \<le> length E"
     proof (induct rule: disjCases2) 
       case 1
         have u_bound: "u < length L - 1" using 1 by (simp add: length_L')
         then have L'_eq_L: "ladder_n L' u = ladder_n L u" using L' ladder_n_of_cut 
           length_L_nonzero length_greater_0_conv by blast 
         from u_bound have "ladder_n L u \<le> ladder_prev_n L (length L - 1)" 
           using ladder_n_prev_bound LeftDerivationLadder_def assms(1) by blast    
         then show ?case
           using L'_eq_L finish length_E_eq_n' u_bound by linarith 
     next
       case 2
         then have "ladder_n L' u = length E" using ladder_last_n_L' ladder_last_n_def by auto
         then show ?case by auto
     qed
   }
   note ladder_n_bound = this
   {
     fix u :: nat
     fix v :: nat
     assume u_less_v: "u < v"
     assume v_bound: "v < length L'"
     have "v < length L' - 1 \<or> v = length L' - 1" using v_bound by arith
     then have "ladder_n L' u < ladder_n L' v"
     proof (induct rule: disjCases2)
       case 1
         show ?case
           using "1.hyps" L' LeftDerivationLadder_def assms(1) is_ladder_def ladder_n_of_cut 
             length_L' u_less_v by auto
     next
       case 2
         note v_def = 2
         have "v = 0 \<or> v \<noteq> 0" by arith
         then show ?case
         proof (induct rule: disjCases2)
           case 1
           then show ?case using u_less_v by auto
         next
           case 2
           then have "ladder_prev_n L (length L - 1) < n'" using finish v_def length_L' 
             by linarith 
           then show ?case
             by (metis (no_types, lifting) L' LeftDerivationLadder_def assms(1) 
               ladder_last_n_L' ladder_last_n_def ladder_n_of_cut ladder_n_prev_bound 
               le_neq_implies_less length_E_eq_n' length_L' length_greater_0_conv 
               less_trans u_less_v v_def) 
         qed
     qed
   }
   note ladder_n_pairwise_bound = this
 
   have is_ladder_E_L': "is_ladder E L'"
     apply (auto simp add: is_ladder_def ladder_last_n_L')
     using length_L_nonzero length_L' apply simp
     using ladder_n_bound apply blast
     using ladder_n_pairwise_bound by blast
 
   {
     fix index :: nat
     assume index_bound: "index + 1 < length L"
     then have index_le: "index < length L" by arith
     from index_bound have len_L_minus_1: "length L - 1 \<noteq> 0" by arith
     obtain m where m: "m = ladder_n L index" by blast
     from LeftDerivationLadder_propagate[OF LDLadder ladder_i_in_\<alpha> m index_le] obtain \<omega> where
       \<omega>: "LeftDerivation \<alpha> (take m D) \<omega> \<and> ladder_\<gamma> (\<alpha> @ \<delta>) D L index = \<omega> @ \<delta> \<and> 
       ladder_j L index < length \<omega>" using index_bound by auto
     have L'_Derive: "ladder_\<gamma> \<alpha> E L' index = Derive \<alpha> (take (ladder_n L' index) E)"
       by (simp add: ladder_\<gamma>_def)
     have ladder_n_L'_eq_L: "ladder_n L' index = ladder_n L index"
       using L' index_bound ladder_n_of_cut length_L_nonzero by auto
     have "ladder_prev_n L (length L - 1) < n'" using finish len_L_minus_1 by blast 
     then have n'_is_upper_bound: "ladder_n L (length L - 2) < n'" using index_bound
       by (metis diff_diff_left ladder_prev_n_def len_L_minus_1 one_add_one)  
     have index_upper_bound: "index \<le> length L - 2" using index_bound by linarith  
     have ladder_n_upper_bound: "ladder_n L index \<le> ladder_n L (length L - 2)"
       apply (rule_tac ladder_n_monotone)
       apply (rule_tac is_ladder_D_L)
       apply (rule index_upper_bound)
       using length_L_nonzero by linarith
     with n'_is_upper_bound have m_le_n': "m \<le> n'"
       using dual_order.strict_implies_order le_less_trans m by linarith
     then have "take m E = take m D"
       by (metis E le_take_same length_E_eq_n' order_refl take_all)
     then have take_helper: "(take (ladder_n L' index) E) = take m D"
       by (simp add: ladder_n_L'_eq_L m)
     then have Derive_eq_\<omega>: "Derive \<alpha> (take (ladder_n L' index) E) = \<omega>"
       by (simp add: Derive LeftDerivation_implies_Derivation \<omega>)
     then have t1: "ladder_\<gamma> (\<alpha>@\<delta>) D L index = (ladder_\<gamma> \<alpha> E L' index) @ \<delta>"
       by (simp add: L'_Derive \<omega>)
     have \<omega>_eq: "\<omega> = ladder_\<gamma> \<alpha> E L' index" by (simp add: Derive_eq_\<omega> L'_Derive) 
     then have t2: "LeftDerivation \<alpha> (take (ladder_n L index) D) (ladder_\<gamma> \<alpha> E L' index)"
       using \<omega> m by blast 
     have t3: "(take (ladder_n L' index) E) = take (ladder_n L index) D"
       by (simp add: m take_helper)     
     have t4: "ladder_j L index < length (ladder_\<gamma> \<alpha> E L' index)"
       using \<omega> \<omega>_eq by blast     
     have t5: "E ! (ladder_n L' index) = D ! (ladder_n L index)"
       using E ladder_n_L'_eq_L ladder_n_upper_bound n'_is_upper_bound by auto
     note t = t1 t2 t3 t4 t5
   }  
   note ladder_early_stage = this
 
   {
     fix index :: nat
     assume index_bound: "index < length L"
     have i: "ladder_i L' index = ladder_i L index"
       using L' ladder_i_cut by (simp add: index_bound) 
     have j: "ladder_j L' index = ladder_j L index"
       using L' ladder_j_cut by (simp add: index_bound)
     have ix: "index > 0 \<Longrightarrow> ladder_ix L' index = ladder_ix L index"
       using L' ladder_ix_cut by (simp add: index_bound)
     have \<alpha>: "ladder_\<alpha> (\<alpha>@\<delta>) D L index = (ladder_\<alpha> \<alpha> E L' index) @ \<delta>"
       by (simp add: index_bound ladder_\<alpha>_def ladder_early_stage(1))
     have i_bound: "index > 0 \<Longrightarrow> ladder_i L' index < length (ladder_\<alpha> \<alpha> E L' index)"
       using i index_bound ladder_\<alpha>_def ladder_early_stage(4) ladder_i_def by auto     
     note ij = i j ix \<alpha> i_bound
   }
   note ladder_every_stage = this
 
   {
     fix u :: nat
     fix v :: nat
     assume u_le_v: "u \<le> v"
     assume v_bound: "v < length L"
     have "ladder_n L u \<le> ladder_n L v"
       using is_ladder_D_L ladder_n_monotone u_le_v v_bound by blast
   }       
   note ladder_L_n_pairwise_le = this
 
   {
     fix index :: nat
     assume index_lower_bound: "index > 0"
     assume index_upper_bound: "index + 1 < length L"
     note derivation = ladder_early_stage(2)
     have derivation1: 
       "LeftDerivation \<alpha> (take (ladder_n L (index - Suc 0)) D) (ladder_\<gamma> \<alpha> E L' (index - Suc 0))"
       using derivation[of "index - Suc 0"] index_lower_bound index_upper_bound
       using One_nat_def Suc_diff_1 Suc_eq_plus1 le_less_trans lessI less_or_eq_imp_le by linarith
     have derivation2:
       "LeftDerivation \<alpha> (take (ladder_n L index) D) (ladder_\<gamma> \<alpha> E L' index)"
       using derivation[of index] index_upper_bound by blast
     have ladder_\<alpha>_is_\<gamma>[symmetric]: "ladder_\<gamma> \<alpha> E L' (index - Suc 0) = ladder_\<alpha> \<alpha> E L' index"
       using index_lower_bound ladder_\<alpha>_def by auto
     have ladder_n_le: "ladder_n L (index - Suc 0) \<le> ladder_n L index"
       apply (rule_tac ladder_L_n_pairwise_le)
       apply arith
       using index_upper_bound by arith 
     from LeftDerivation_from_in_between[OF derivation1 derivation2 ladder_n_le] ladder_\<alpha>_is_\<gamma>
     have "LeftDerivation (ladder_\<alpha> \<alpha> E L' index) (drop (ladder_n L' (index - Suc 0)) 
       (take (ladder_n L' index) E)) (ladder_\<gamma> \<alpha> E L' index)"
       by (metis L' Suc_leI add_lessD1 index_lower_bound index_upper_bound ladder_early_stage(3) 
         ladder_n_of_cut le_add_diff_inverse2 length_L_nonzero length_greater_0_conv less_diff_conv)          
   }
   note LeftDerivation_delta_early = this 
    
   have LeftDerivationFix_\<alpha>_0: "LeftDerivationFix \<alpha> (ladder_i L' 0) (take (ladder_n L' 0) E) 
     (ladder_j L' 0) (ladder_\<gamma> \<alpha> E L' 0)"
   proof -
     have ldfix: "LeftDerivationFix (\<alpha>@\<delta>) (ladder_i L 0) (take (ladder_n L 0) D) (ladder_j L 0) 
       (ladder_\<gamma> (\<alpha>@\<delta>) D L 0)"
       using LDLadder LeftDerivationLadder_def by blast
     have ladder_i_L': "ladder_i L' 0 = ladder_i L 0"
       using L' ladder_i_of_cut_at_0 length_L_nonzero by blast
     have ladder_j_L': "ladder_j L' 0 = ladder_j L 0"
       by (metis L' ladder_cut_def ladder_j_def ladder_last_j_def ladder_last_j_of_cut 
          length_L' length_greater_0_conv nth_list_update_neq)
     have "length L = 1 \<or> length L > 1" using length_L_nonzero by linarith 
     then show ?thesis
     proof (induct rule: disjCases2)
       case 1
         from 1 have ladder_n_L'_0: "ladder_n L' 0 = n'"
           using diff_is_0_eq' ladder_last_n_L' ladder_last_n_def length_E_eq_n' 
             length_L' less_or_eq_imp_le by auto 
         have take_n'_E: "take n' E = E" by (simp add: length_E_eq_n') 
         from ladder_n_L'_0 take_n'_E have take_ladder_n_L': "take (ladder_n L' 0) E = E" by auto
         have "ladder_n L 0 = length D"
           by (simp add: "1.hyps" length_D_eq_n n_eq_ladder_n) 
         then have take_ladder_n_L_0: "take (ladder_n L 0) D = D" by simp 
         have ladder_\<gamma>_\<alpha>: "ladder_\<gamma> \<alpha> E L' 0 = \<beta>"
           apply (simp add: ladder_\<gamma>_def take_ladder_n_L')
           by (simp add: Derive E LeftDerivation_implies_Derivation finish)
         have ladder_j_in_\<beta>: "ladder_j L 0 < length \<beta>" 
           using finish "1.hyps" by auto 
         have ldfix_1: "LeftDerivationFix (\<alpha>@\<delta>) (ladder_i L 0) D (ladder_j L 0) (\<beta>@\<delta>')"
           using "1.hyps" \<gamma> \<gamma>_ladder ldfix take_ladder_n_L_0 by auto
         then have "LeftDerivationFix \<alpha> (ladder_i L 0) E (ladder_j L 0) \<beta>"
           by (simp add: E LeftDerivationFix_cut_appendix finish ladder_i_in_\<alpha> ladder_j_in_\<beta> 
             length_D_eq_n)
         then show ?case
           by (simp add: ladder_i_L' ladder_j_L' take_ladder_n_L' ladder_\<gamma>_\<alpha>)
     next
       case 2
         have h: "0 + 1 < length L" using "2.hyps" by auto 
         note stage = ladder_early_stage[of 0, OF h]
         have ldfix0: "LeftDerivationFix (\<alpha>@\<delta>) (ladder_i L 0) (take (ladder_n L 0) D) (ladder_j L 0) 
           ((ladder_\<gamma> \<alpha> E L' 0) @ \<delta>)"
           using ladder_i_L' ladder_j_L' ldfix stage(1) stage(3) by auto
         from LeftDerivationFix_cut_appendix'[OF ldfix0 stage(2) ladder_i_in_\<alpha> stage(4)]
         show ?case
           by (simp add: ladder_i_L' ladder_j_L' stage(3))
     qed
   qed
 
   {
     fix index :: nat
     assume index_bounds: "1 \<le> index \<and> index + 1 < length L"
     have introsAt_appendix: "LeftDerivationIntrosAt (\<alpha>@\<delta>) D L index"
       using LDLadder LeftDerivationIntros_def LeftDerivationLadder_def add_lessD1 index_bounds 
       by blast
     have index_plus_1_upper_bound: "index + 1 < length L" using index_bounds by arith
     note early_stage = ladder_early_stage[of index, OF index_plus_1_upper_bound]
     have ladder_i_L_index_eq_fst: "ladder_i L index = fst (D ! ladder_n L (index - Suc 0))"
       using introsAt_appendix LeftDerivationIntrosAt_def index_bounds by (metis One_nat_def) 
     have E_at_D_at: "(E ! ladder_n L' (index - Suc 0)) = (D ! ladder_n L (index - Suc 0))"
       using ladder_early_stage[of "index - Suc 0"]
       by (metis One_nat_def add_lessD1 index_bounds le_add_diff_inverse2) 
     then have ladder_i_L'_index_eq_fst: "ladder_i L' index = fst (E ! ladder_n L' (index - Suc 0))"
       using index_bounds ladder_i_L_index_eq_fst ladder_every_stage(1) le_add1 le_less_trans by auto
     have same_derivation: "(drop (Suc (ladder_n L' (index - Suc 0))) (take (ladder_n L' index) E)) =
      (drop (Suc (ladder_n L (index - Suc 0))) (take (ladder_n L index) D))"
      using L' early_stage(3) index_bounds ladder_n_of_cut length_L_nonzero by auto
     have deriv_split: "(drop (ladder_n L' (index - Suc 0)) (take (ladder_n L' index) E)) =
        ((ladder_i L' index, snd (E ! ladder_n L' (index - Suc 0))) #
       drop (Suc (ladder_n L' (index - Suc 0))) (take (ladder_n L' index) E))"
       by (metis Cons_nth_drop_Suc One_nat_def Suc_le_lessD add_lessD1 diff_Suc_less index_bounds 
         ladder_i_L'_index_eq_fst ladder_n_bound ladder_n_pairwise_bound length_L' 
         length_take min.absorb2 nth_take prod.collapse)       
     have "LeftDerivationIntrosAt \<alpha> E L' index"
       apply (auto simp add: LeftDerivationIntrosAt_def Let_def)
       using ladder_i_L'_index_eq_fst apply blast
       apply (rule_tac LeftDerivationIntro_cut_appendix'[where \<delta>=\<delta> and \<delta>' = \<delta>])
       apply (metis E_at_D_at LeftDerivationIntrosAt_def One_nat_def Suc_le_lessD add_lessD1 
         early_stage(1) index_bounds introsAt_appendix ladder_every_stage(2) 
         ladder_every_stage(3) ladder_every_stage(4) ladder_i_L'_index_eq_fst same_derivation)
       defer 1
       using index_bounds ladder_every_stage(5) apply auto[1]
       using early_stage(4) index_bounds ladder_every_stage(2) apply auto[1]
       using LeftDerivation_delta_early deriv_split
       by (metis One_nat_def Suc_le_eq index_bounds) 
   }
   note LeftDerivationIntrosAt_early = this
 
   {
     fix index :: nat
     assume index_bounds: "1 \<le> index \<and> index + 1 = length L"
     have introsAt_appendix: "LeftDerivationIntrosAt (\<alpha>@\<delta>) D L index"
       using LDLadder LeftDerivationIntros_def LeftDerivationLadder_def add_lessD1 index_bounds
       by (metis Suc_eq_plus1 not_less_eq)      
     have ladder_i_L_index_eq_fst: "ladder_i L index = fst (D ! ladder_n L (index - Suc 0))"
       using introsAt_appendix LeftDerivationIntrosAt_def index_bounds by (metis One_nat_def) 
     have E_at_D_at: "(E ! ladder_n L' (index - Suc 0)) = (D ! ladder_n L (index - Suc 0))"
       using ladder_early_stage[of "index - Suc 0"]
       by (metis One_nat_def Suc_eq_plus1 index_bounds le_add_diff_inverse2 lessI)
     then have ladder_i_L'_index_eq_fst: "ladder_i L' index = fst (E ! ladder_n L' (index - Suc 0))"
       using index_bounds ladder_i_L_index_eq_fst ladder_every_stage(1) le_add1 le_less_trans by auto      
     obtain D' where D': "D' = (drop (Suc (ladder_n L (index - Suc 0))) (take (ladder_n L index) D))"
       by blast
     obtain k where k: "k = (ladder_n L' index) - (Suc (ladder_n L' (index - Suc 0)))"
       by blast
     have ladder_n_L'_index: "ladder_n L' index = length E"
       by (metis diff_add_inverse2 index_bounds ladder_last_n_L' ladder_last_n_def length_L')
     have take_is_E: "take (ladder_n L' index) E = E" by (simp add: ladder_n_L'_index)
     have ladder_n_L_index: "ladder_n L index = length D"
       by (metis diff_add_inverse2 index_bounds length_D_eq_n n_eq_ladder_n)
     have take_is_D: "take (ladder_n L index) D = D"
       by (simp add: ladder_n_L_index)
     have write_as_take_k_D': "(drop (Suc (ladder_n L' (index - Suc 0))) E) = take k D'"
       using take_is_D
       by (metis D' E L' One_nat_def Suc_le_lessD add_diff_cancel_right' diff_Suc_less 
         drop_take index_bounds k ladder_n_L'_index ladder_n_of_cut length_E_eq_n' 
         length_L_nonzero length_greater_0_conv)   
     have k_bound: "k \<le> length D'"
       by (metis le_iff_add append_take_drop_id k ladder_n_L'_index length_append 
         length_drop write_as_take_k_D')
     have D'_alt: "D' = drop (Suc (ladder_n L (index - Suc 0))) D"
       by (simp add: D' take_is_D)
     have "LeftDerivationIntrosAt \<alpha> E L' index"
       apply (auto simp add: LeftDerivationIntrosAt_def Let_def)
       using ladder_i_L'_index_eq_fst apply blast
       apply (subst take_is_E)
       apply (subst write_as_take_k_D')
       apply (rule_tac LeftDerivationIntro_cut_appendix[where \<delta>=\<delta> and \<delta>' = \<delta>'])
       apply (metis D' Derive E E_at_D_at LeftDerivationIntrosAt_def 
         LeftDerivation_implies_Derivation One_nat_def Suc_le_lessD add_diff_cancel_right' 
         diff_Suc_less finish index_bounds introsAt_appendix ladder_\<gamma>_def ladder_every_stage(2) 
         ladder_every_stage(3) ladder_every_stage(4) ladder_i_L'_index_eq_fst length_L_nonzero 
         take_is_E)
       apply (metis Cons_nth_drop_Suc E L' LeftDerivation_from_in_between LeftDerivation_take_derive 
         One_nat_def Suc_le_lessD add_diff_cancel_right' diff_Suc_less finish index_bounds 
         ladder_\<alpha>_def ladder_\<gamma>_def ladder_i_L'_index_eq_fst ladder_n_L'_index ladder_n_of_cut 
         ladder_prev_n_def length_E_eq_n' length_L_nonzero less_imp_le_nat less_numeral_extra(3) 
         list.size(3) prod.collapse take_is_E write_as_take_k_D')
       using k_bound apply blast
       using D'_alt apply (metis (no_types, lifting) Derive E L' LeftDerivation_implies_Derivation 
         One_nat_def Suc_leI Suc_le_lessD add_diff_cancel_right' diff_Suc_less drop_drop finish 
         index_bounds k ladder_\<gamma>_def ladder_n_L'_index ladder_n_of_cut ladder_prev_n_def 
         le_add_diff_inverse2 length_E_eq_n' length_L_nonzero length_greater_0_conv 
         less_not_refl2 take_is_E) 
       using index_bounds ladder_every_stage(5) apply auto[1]
       by (metis Derive E LeftDerivation_implies_Derivation One_nat_def add_diff_cancel_right' 
         diff_Suc_less finish index_bounds ladder_\<gamma>_def ladder_every_stage(2) length_L_nonzero 
         take_is_E)
   }
   note LeftDerivationIntrosAt_last = this
 
   have ladder_E_L': "LeftDerivationLadder \<alpha> E L' \<beta>"
     apply (auto simp add: LeftDerivationLadder_def)
     using finish E apply blast
     using is_ladder_E_L' apply blast
     using LeftDerivationFix_\<alpha>_0 apply blast
     using LeftDerivationIntros_def LeftDerivationIntrosAt_early LeftDerivationIntrosAt_last
     by (metis Suc_eq_plus1 Suc_leI le_neq_implies_less length_L')
     
   show ?thesis
     apply (rule_tac x=E in exI)
     apply (rule_tac x=F in exI)
     apply (rule_tac x=\<beta> in exI)
     apply (rule_tac x=\<delta>' in exI)
     apply (rule_tac x=L' in exI)
     apply auto
     using E F apply simp
     apply (rule \<gamma>)
     using ladder_E_L' apply blast
     using F finish apply blast
     using F finish apply blast
     by (rule L')
 qed  
 
 theorem LeftDerivationLadder_cut_appendix: 
   assumes LDLadder: "LeftDerivationLadder (\<alpha>@\<delta>) D L \<gamma>"
   assumes ladder_i_in_\<alpha>: "ladder_i L 0 < length \<alpha>"
   shows "\<exists> E F \<gamma>1 \<gamma>2 L'. D = E@F \<and> 
     \<gamma> = \<gamma>1 @ \<gamma>2 \<and> 
     LeftDerivationLadder \<alpha> E L' \<gamma>1 \<and> 
     derivation_ge F (length \<gamma>1) \<and>
     LeftDerivation \<delta> (derivation_shift F (length \<gamma>1) 0) \<gamma>2 \<and>
     length L' = length L \<and> ladder_i L' 0 = ladder_i L 0 \<and>
     ladder_last_j L' = ladder_last_j L"
 proof -
   from LeftDerivationLadder_cut_appendix_helper[OF LDLadder ladder_i_in_\<alpha>]
   obtain E F \<gamma>1 \<gamma>2 L' where helper:
     "D = E @ F \<and>
      \<gamma> = \<gamma>1 @ \<gamma>2 \<and>
      LeftDerivationLadder \<alpha> E L' \<gamma>1 \<and>
      derivation_ge F (length \<gamma>1) \<and>
      LeftDerivation \<delta> (derivation_shift F (length \<gamma>1) 0) \<gamma>2 \<and> L' = ladder_cut L (length E)"
      by blast
   show ?thesis
     apply (rule_tac x=E in exI)
     apply (rule_tac x=F in exI)
     apply (rule_tac x=\<gamma>1 in exI)
     apply (rule_tac x=\<gamma>2 in exI)
     apply (rule_tac x=L' in exI)
     using helper LDLadder LeftDerivationLadder_def is_ladder_def ladder_i_of_cut_at_0 
       ladder_last_j_of_cut length_ladder_cut by force 
 qed
 
 definition ladder_stepdown_diff :: "ladder \<Rightarrow> nat" where
   "ladder_stepdown_diff L = Suc (ladder_n L 0)"
 
 definition ladder_stepdown_\<alpha>_0 :: "sentence \<Rightarrow> derivation \<Rightarrow> ladder \<Rightarrow> sentence" where
   "ladder_stepdown_\<alpha>_0 a D L = Derive a (take (ladder_stepdown_diff L) D)"
 
 lemma LeftDerivationIntro_LeftDerives1:
   assumes "LeftDerivationIntro \<alpha> i r ix D j \<gamma>"
   assumes "splits_at \<alpha> i a1 A a2"
   shows "LeftDerives1 \<alpha> i r (a1@(snd r)@a2)"
 by (metis LeftDerivationIntro_def LeftDerivationIntro_examine_rule LeftDerivationIntro_is_sentence 
   LeftDerives1_def assms(1) assms(2) prod.collapse splits_at_implies_Derives1)
 
 lemma LeftDerives1_Derive:
   assumes "LeftDerives1 \<alpha> i r \<gamma>"
   shows "Derive \<alpha> [(i, r)] = \<gamma>"
 by (metis Derive LeftDerivation.simps(1) LeftDerivation_LeftDerives1 
   LeftDerivation_implies_Derivation append_Nil assms)
 
 lemma ladder_stepdown_\<alpha>_0_altdef:
   assumes ladder: "LeftDerivationLadder \<alpha> D L \<gamma>"
   assumes length_L: "length L > 1"
   assumes split: "splits_at (ladder_\<alpha> \<alpha> D L 1) (ladder_i L 1) a1 A a2"
   shows "ladder_stepdown_\<alpha>_0 \<alpha> D L = a1 @ (snd (snd (D ! (ladder_n L 0)))) @ a2"
 proof -
   have 1: "ladder_\<alpha> \<alpha> D L 1 = Derive \<alpha> (take (ladder_n L 0) D)"
     by (simp add: ladder_\<alpha>_def ladder_\<gamma>_def)
   obtain rule  where rule: "rule = snd (D ! (ladder_n L 0))" by blast
   have "\<exists> E \<omega>. LeftDerivationIntro (ladder_\<alpha> \<alpha> D L 1) (ladder_i L 1) rule (ladder_ix L 1)
     E (ladder_j L 1) \<omega>"
     by (metis LeftDerivationIntrosAt_def LeftDerivationIntros_def LeftDerivationLadder_def 
       One_nat_def diff_Suc_1 ladder length_L order_refl rule)
   then obtain E \<omega> where intro: 
     "LeftDerivationIntro (ladder_\<alpha> \<alpha> D L 1) (ladder_i L 1) rule (ladder_ix L 1) E (ladder_j L 1) \<omega>"
     by blast
   then have 2: "LeftDerives1 (ladder_\<alpha> \<alpha> D L 1) (ladder_i L 1) rule (a1@(snd rule)@a2)"
     using LeftDerivationIntro_LeftDerives1 split by blast
   have fst_D: "fst (D ! (ladder_n L 0)) = ladder_i L 1"
     by (metis LeftDerivationIntrosAt_def LeftDerivationIntros_def LeftDerivationLadder_def 
       One_nat_def diff_Suc_1 ladder le_numeral_extra(4) length_L)
   have derive_derive: "Derive \<alpha> (take (Suc (ladder_n L 0)) D) = 
     Derive (Derive \<alpha> (take (ladder_n L 0) D)) [D ! (ladder_n L 0)]"
     proof -
       have f1: "Derivation \<alpha> (take (Suc (ladder_n L 0)) D) (Derive \<alpha> (take (Suc (ladder_n L 0)) D))"
         using Derivation_take_derive LeftDerivationLadder_def LeftDerivation_implies_Derivation ladder by blast
       have f2: "length L - 1 < length L"
         using length_L by linarith
       have "0 < length L - 1"
         using length_L by linarith
       then have f3: "take (Suc (ladder_n L 0)) D = take (ladder_n L 0) D @ [D ! ladder_n L 0]"
         using f2 by (metis (full_types) LeftDerivationLadder_def is_ladder_def ladder ladder_last_n_def take_Suc_conv_app_nth)
       obtain sss :: "symbol list \<Rightarrow> (nat \<times> symbol \<times> symbol list) list \<Rightarrow> (nat \<times> symbol \<times> symbol list) list \<Rightarrow> symbol list \<Rightarrow> symbol list" where
         "\<forall>x0 x1 x2 x3. (\<exists>v4. Derivation x3 x2 v4 \<and> Derivation v4 x1 x0) = (Derivation x3 x2 (sss x0 x1 x2 x3) \<and> Derivation (sss x0 x1 x2 x3) x1 x0)"
         by moura
       then show ?thesis
         using f3 f1 Derivation_append Derive by auto
     qed
   then have 3: "ladder_stepdown_\<alpha>_0 \<alpha> D L = Derive (ladder_\<alpha> \<alpha> D L 1) [D ! (ladder_n L 0)]"
     using 1 by (simp add: ladder_stepdown_\<alpha>_0_def ladder_stepdown_diff_def) 
   have 4: "D ! (ladder_n L 0) = (ladder_i L 1, rule)"
     using rule fst_D by (metis prod.collapse) 
   then show ?thesis using 2 3 4 LeftDerives1_Derive snd_conv by auto 
 qed   
 
 lemma ladder_i_0_bound:
   assumes ld: "LeftDerivationLadder \<alpha> D L \<gamma>"
   shows "ladder_i L 0 < length \<alpha>"
 proof -
   have "LeftDerivationFix \<alpha> (ladder_i L 0) (take (ladder_n L 0) D) 
     (ladder_j L 0) (ladder_\<gamma> \<alpha> D L 0)"
     using ld LeftDerivationLadder_def by simp
   then show ?thesis using LeftDerivationFix_def by simp
 qed
 
 lemma ladder_j_bound:
   assumes ld: "LeftDerivationLadder \<alpha> D L \<gamma>"
   assumes index_bound: "index < length L"
   shows "ladder_j L index < length (ladder_\<gamma> \<alpha> D L index)"
 proof -
   have ld': "LeftDerivationLadder (\<alpha>@[]) D L \<gamma>" using ld by simp
   have ladder_i_0: "ladder_i L 0 < length \<alpha>" using ladder_i_0_bound ld by auto
   obtain n where n: "n = ladder_n L index" by blast
   note propagate = LeftDerivationLadder_propagate[OF ld' ladder_i_0 n index_bound]
   from index_bound have "index + 1 < length L \<or> index + 1 = length L" by arith
   then show ?thesis
   proof (induct rule: disjCases2)
     case 1
       then have "\<exists>\<beta>. LeftDerivation \<alpha> (take n D) \<beta> \<and>
          ladder_\<gamma> (\<alpha> @ []) D L index = \<beta> @ [] \<and> ladder_j L index < length \<beta>"
          using propagate by auto
       then show ?case by auto
   next
     case 2
       then have "
         \<exists>n' \<beta> \<delta>'.
           (index = 0 \<or> ladder_prev_n L index < n') \<and>
           n' \<le> n \<and>
           LeftDerivation \<alpha> (take n' D) \<beta> \<and>
           LeftDerivation (\<alpha> @ []) (take n' D) (\<beta> @ []) \<and>
           derivation_ge (drop n' D) (length \<beta>) \<and>
           LeftDerivation [] (derivation_shift (drop n' D) (length \<beta>) 0) \<delta>' \<and>
           ladder_\<gamma> (\<alpha> @ []) D L index = \<beta> @ \<delta>' \<and> ladder_j L index < length \<beta>"
           using propagate by auto
       then show ?case by auto
   qed
 qed
   
 lemma ladder_last_j_bound:
   assumes ld: "LeftDerivationLadder \<alpha> D L \<gamma>"
   shows "ladder_last_j L < length \<gamma>"
 proof -
   have "length L - 1 < length L"
     using LeftDerivationLadder_def assms is_ladder_def by auto 
   from ladder_j_bound[OF ld this]
   show ?thesis
     by (metis Derive LeftDerivationLadder_def LeftDerivation_implies_Derivation One_nat_def 
       is_ladder_def ladder_last_j_def last_ladder_\<gamma> ld) 
 qed    
 
 fun ladder_shift_n :: "nat \<Rightarrow> ladder \<Rightarrow> ladder" where 
   "ladder_shift_n N [] = []"
 | "ladder_shift_n N ((n, j, i)#L) = ((n - N, j, i)#(ladder_shift_n N L))" 
 
 fun ladder_stepdown :: "ladder \<Rightarrow> ladder"
 where 
   "ladder_stepdown [] = undefined"
 | "ladder_stepdown [v] = undefined"
 | "ladder_stepdown ((n0, j0, i0)#(n1, j1, ix1)#L) = 
   (n1 - Suc n0, j1, j0 + ix1) # (ladder_shift_n (Suc n0) L)"
     
 lemma ladder_shift_n_length: 
   "length (ladder_shift_n N L) = length L"
   by (induct L, auto)
 
 lemma ladder_stepdown_prepare:
   assumes "length L > 1"
   shows "L = (ladder_n L 0, ladder_j L 0, ladder_i L 0)#
     (ladder_n L 1, ladder_j L 1, ladder_ix L 1)#(drop 2 L)"
 proof -
   have "\<exists> n0 j0 i0 n1 j1 ix1 L'. L = ((n0, j0, i0)#(n1, j1, ix1)#L')"
     by (metis One_nat_def Suc_eq_plus1 assms ladder_stepdown.cases less_not_refl list.size(3) 
       list.size(4) not_less0)
   then obtain n0 j0 i0 n1 j1 ix1 L' where L': "L = ((n0, j0, i0)#(n1, j1, ix1)#L')" by blast
   have n0: "n0 = ladder_n L 0" using L'
     by (auto simp add: ladder_n_def deriv_n_def)
   show ?thesis using L'
     by (auto simp add: ladder_n_def deriv_n_def ladder_j_def deriv_j_def 
       ladder_i_def deriv_i_def ladder_ix_def deriv_ix_def)
 qed
 
 lemma ladder_stepdown_length:
   assumes "length L > 1"
   shows "length (ladder_stepdown L) = length L - 1"
 apply (subst ladder_stepdown_prepare[OF assms(1)])
 apply (simp add: ladder_shift_n_length)
 using assms apply arith
 done
 
 lemma ladder_stepdown_i_0:
   assumes "length L > 1"
   shows "ladder_i (ladder_stepdown L) 0 = ladder_i L 1 + ladder_ix L 1"
   using ladder_stepdown_prepare[OF assms] ladder_i_def ladder_j_def deriv_j_def
   by (metis One_nat_def deriv_i_def diff_Suc_1 ladder_stepdown.simps(3) list.sel(1) 
     snd_conv zero_neq_one)
 
 lemma ladder_shift_n_cons: "ladder_shift_n N (x#L) = (fst x - N, snd x)#(ladder_shift_n N L)"
   apply (induct L)
   by (cases x, simp)+
 
 lemma ladder_shift_n_drop: "ladder_shift_n N (drop n L) = drop n (ladder_shift_n N L)"
 proof (induct L arbitrary: n)
   case Nil then show ?case by simp
 next
   case (Cons x L)
     show ?case
     proof (cases n)
       case 0 then show ?thesis 
         by simp
     next
       case (Suc n) then show ?thesis
         by (simp add: ladder_shift_n_cons Cons)
     qed
 qed
 
 lemma drop_2_shift:
   assumes "index > 0"
   assumes "length L > 1"
   shows "drop 2 L ! (index - Suc 0) = L ! Suc index"
 proof -
   define l1 l2 and L' where "l1 = L ! 0" "l2 = L ! 1"
     and "L' = drop 2 L"
   with \<open>length L > 1\<close> have "L = l1 # l2 # L'"
     by (cases L) (auto simp add: neq_Nil_conv)
   with \<open>index > 0\<close> show ?thesis
     by simp
 qed
 
 lemma ladder_shift_n_at:
   "index < length L \<Longrightarrow> (ladder_shift_n N L) ! index = (fst (L ! index) - N, snd (L ! index))"
 proof (induct L arbitrary: index)
   case Nil then show ?case by auto
 next
   case (Cons x L)
     show ?case
       apply (simp add: ladder_shift_n_cons)
       apply (cases index)
       apply (auto)
       apply (rule_tac Cons(1))
       using Cons(2) by auto
 qed
 
 lemma ladder_stepdown_j:
   assumes length_L_greater_1: "length L > 1"
   assumes L': "L' = ladder_stepdown L"
   assumes index_bound: "index < length L'"
   shows "ladder_j L' index = ladder_j L (Suc index)"
 proof -
   note L_prepare = ladder_stepdown_prepare[OF length_L_greater_1]  
   have ladder_stepdown_L_def: "ladder_stepdown L = ((ladder_n L (Suc 0) - Suc (ladder_n L 0), ladder_j L (Suc 0), ladder_j L 0 + ladder_ix L (Suc 0)) #
     ladder_shift_n (Suc (ladder_n L 0)) (drop 2 L))" 
     by (subst L_prepare, simp)
   have "index = 0 \<or> index > 0" by arith
   then show "ladder_j L' index = ladder_j L (Suc index)"
   proof (induct rule: disjCases2)
     case 1
       show ?case
         by (simp add: L' ladder_stepdown_L_def 1 ladder_j_def deriv_j_def)
   next
     case 2
       have index_bound': "Suc index < length L"
         using index_bound L' ladder_stepdown_length length_L_greater_1 by auto
       show ?case
         apply (simp add: L' ladder_stepdown_L_def 2 ladder_j_def ladder_shift_n_drop drop_2_shift)
         apply (subst drop_2_shift)
         apply (simp add: 2)
         using length_L_greater_1 apply (simp add: ladder_shift_n_length)
         apply (simp add: deriv_j_def)
         apply (simp add: ladder_shift_n_at[OF index_bound'])
         done
   qed
 qed  
 
 lemma ladder_stepdown_last_j:
   assumes length_L_greater_1: "length L > 1"
   shows "ladder_last_j (ladder_stepdown L) = ladder_last_j L"
   using ladder_stepdown_j Suc_diff_Suc diff_Suc_1 ladder_last_j_def ladder_stepdown_length 
   length_L_greater_1 lessI by auto
 
 lemma ladder_stepdown_n:
   assumes length_L_greater_1: "length L > 1"
   assumes L': "L' = ladder_stepdown L"
   assumes index_bound: "index < length L'"
   shows "ladder_n L' index = ladder_n L (Suc index) - ladder_stepdown_diff L"
 proof -
   note L_prepare = ladder_stepdown_prepare[OF length_L_greater_1]  
   have ladder_stepdown_L_def: "ladder_stepdown L = ((ladder_n L (Suc 0) - Suc (ladder_n L 0), ladder_j L (Suc 0), ladder_j L 0 + ladder_ix L (Suc 0)) #
     ladder_shift_n (Suc (ladder_n L 0)) (drop 2 L))" 
     by (subst L_prepare, simp)
   have "index = 0 \<or> index > 0" by arith
   then show "ladder_n L' index = ladder_n L (Suc index) - ladder_stepdown_diff L"
   proof (induct rule: disjCases2)
     case 1
       show ?case
         by (simp add: L' ladder_stepdown_L_def 1 ladder_n_def deriv_n_def ladder_stepdown_diff_def)
   next
     case 2
       have index_bound': "Suc index < length L"
         using index_bound L' ladder_stepdown_length length_L_greater_1 by auto
       show ?case
         apply (simp add: L' ladder_stepdown_L_def 2 ladder_n_def ladder_shift_n_drop drop_2_shift
           ladder_stepdown_diff_def)
         apply (subst drop_2_shift)
         apply (simp add: 2)
         using length_L_greater_1 apply (simp add: ladder_shift_n_length)
         apply (simp add: deriv_n_def)
         apply (simp add: ladder_shift_n_at[OF index_bound'])
         done
   qed
 qed  
 
 lemma ladder_stepdown_ix:
   assumes length_L_greater_1: "length L > 1"
   assumes L': "L' = ladder_stepdown L"
   assumes index_lower_bound: "0 < index"
   assumes index_upper_bound: "index < length L'"
   shows "ladder_ix L' index = ladder_ix L (Suc index)"
 proof -
   note L_prepare = ladder_stepdown_prepare[OF length_L_greater_1]  
   have ladder_stepdown_L_def: "ladder_stepdown L = ((ladder_n L (Suc 0) - Suc (ladder_n L 0), ladder_j L (Suc 0), ladder_j L 0 + ladder_ix L (Suc 0)) #
     ladder_shift_n (Suc (ladder_n L 0)) (drop 2 L))" 
     by (subst L_prepare, simp)
       
   have index_bound': "Suc index < length L"
     using index_upper_bound L' ladder_stepdown_length length_L_greater_1 by auto
   show ?thesis
         apply (simp add: L' ladder_stepdown_L_def index_lower_bound ladder_ix_def ladder_shift_n_drop)
         apply (subst drop_2_shift)
         apply (simp add: index_lower_bound)
         using length_L_greater_1 apply (simp add: ladder_shift_n_length)
         apply (simp add: deriv_ix_def)
         apply (simp add: ladder_shift_n_at[OF index_bound'])
         using index_lower_bound by arith
 qed
 
 lemma Derive_Derive:
   assumes "Derivation \<alpha> (D@E) \<gamma>"
   shows "Derive (Derive \<alpha> D) E = Derive \<alpha> (D@E)"
 using Derivation_append Derive assms by fastforce
 
 lemma drop_at_shift:
   assumes "n \<le> index"
   assumes "index < length D"
   shows "drop n D ! (index - n) = D ! index"
 using assms(1) assms(2) by auto
 
 theorem LeftDerivationLadder_stepdown:
   assumes ldl: "LeftDerivationLadder \<alpha> D L \<gamma>" 
   assumes length_L: "length L > 1"
   shows "\<exists> L'. LeftDerivationLadder (ladder_stepdown_\<alpha>_0 \<alpha> D L) (drop (ladder_stepdown_diff L) D)
            L' \<gamma> \<and> length L' = length L - 1 \<and> ladder_i L' 0 = ladder_i L 1 + ladder_ix L 1 \<and>
            ladder_last_j L' = ladder_last_j L" 
 proof -
   obtain L' where L': "L' = ladder_stepdown L" by blast
   have ldl1: "LeftDerivation (ladder_stepdown_\<alpha>_0 \<alpha> D L) (drop (ladder_stepdown_diff L) D) \<gamma>"
   proof -
     have D_split: "D = (take (ladder_stepdown_diff L) D) @ (drop (ladder_stepdown_diff L) D)"
       by simp
     show ?thesis using D_split ldl
       proof -
         obtain sss :: "symbol list \<Rightarrow> (nat \<times> symbol \<times> symbol list) list \<Rightarrow> (nat \<times> symbol \<times> symbol list) list \<Rightarrow> symbol list \<Rightarrow> symbol list" where
           "\<forall>x0 x1 x2 x3. (\<exists>v4. LeftDerivation x3 x2 v4 \<and> LeftDerivation v4 x1 x0) = (LeftDerivation x3 x2 (sss x0 x1 x2 x3) \<and> LeftDerivation (sss x0 x1 x2 x3) x1 x0)"
           by moura
         then have "(\<not> LeftDerivation \<alpha> (take (ladder_stepdown_diff L) D @ drop (ladder_stepdown_diff L) D) \<gamma> \<or> LeftDerivation \<alpha> (take (ladder_stepdown_diff L) D) (sss \<gamma> (drop (ladder_stepdown_diff L) D) (take (ladder_stepdown_diff L) D) \<alpha>) \<and> LeftDerivation (sss \<gamma> (drop (ladder_stepdown_diff L) D) (take (ladder_stepdown_diff L) D) \<alpha>) (drop (ladder_stepdown_diff L) D) \<gamma>) \<and> (LeftDerivation \<alpha> (take (ladder_stepdown_diff L) D @ drop (ladder_stepdown_diff L) D) \<gamma> \<or> (\<forall>ss. \<not> LeftDerivation \<alpha> (take (ladder_stepdown_diff L) D) ss \<or> \<not> LeftDerivation ss (drop (ladder_stepdown_diff L) D) \<gamma>))"
           using LeftDerivation_append by blast
         then show ?thesis
           by (metis (no_types) D_split Derivation_take_derive Derivation_unique_dest LeftDerivationLadder_def LeftDerivation_implies_Derivation ladder_stepdown_\<alpha>_0_def ldl)
       qed 
   qed
   have L'_nonempty: "L' \<noteq> []" using L' ladder_stepdown_length length_L by fastforce
   {
     fix u :: nat
     assume u': "u < length L'"
     then have Suc_u: "Suc u < length L" using L' ladder_stepdown_length length_L by auto
     have "ladder_n L (Suc u)  \<le> length D"
       using ldl Suc_u by (simp add: LeftDerivationLadder_ladder_n_bound) 
     then have "ladder_n L' u \<le> length D - ladder_stepdown_diff L"
       apply (subst ladder_stepdown_n[OF length_L L' u'])
       by auto
   }
   note is_ladder_prop1 = this
   {
     fix u :: nat
     fix v :: nat
     assume u_less_v: "u < v"
     assume v_L': "v < length L'"
     from u_less_v v_L' have u_L': "u < length L'" by arith
     have "ladder_n L (Suc u) < ladder_n L (Suc v)"
       using ldl by (metis (no_types, lifting) L' LeftDerivationLadder_def One_nat_def Suc_diff_1 
         Suc_lessD Suc_mono is_ladder_def ladder_stepdown_length length_L u_less_v v_L') 
     then have "ladder_n L' u < ladder_n L' v"
       apply (simp add: ladder_stepdown_n[OF length_L L'] u_L' v_L')
       by (metis (no_types, lifting) L' LeftDerivationLadder_def Suc_eq_plus1 Suc_leI 
         diff_less_mono is_ladder_def ladder_stepdown_diff_def ladder_stepdown_length ldl 
         length_L less_diff_conv u_L' zero_less_Suc)
   }
   note is_ladder_prop2 = this
   have is_ladder_L': "is_ladder (drop (ladder_stepdown_diff L) D) L'"
     apply (auto simp add: is_ladder_def)
     using L'_nonempty apply blast
     using is_ladder_prop1 apply blast
     using is_ladder_prop2 apply blast
     using ladder_last_n_def ladder_stepdown_n L' LeftDerivationLadder_def Suc_diff_Suc diff_Suc_1 
       ladder_n_last_is_length ladder_stepdown_length ldl length_L lessI by auto 
   have ldfix: "LeftDerivationFix (ladder_stepdown_\<alpha>_0 \<alpha> D L) (ladder_i L' 0)
      (take (ladder_n L' 0) (drop (ladder_stepdown_diff L) D)) (ladder_j L' 0)
      (ladder_\<gamma> (ladder_stepdown_\<alpha>_0 \<alpha> D L) (drop (ladder_stepdown_diff L) D) L' 0)"
   proof -
     have introsAt_L_1: "LeftDerivationIntrosAt \<alpha> D L 1"
       using LeftDerivationIntros_def LeftDerivationLadder_def ldl length_L by blast
     thm LeftDerivationIntrosAt_def
     obtain n where n: "n = ladder_n L 0" by blast
     obtain m where m: "m = ladder_n L 1" by blast
     have "LeftDerivationIntro (ladder_\<alpha> \<alpha> D L 1) (ladder_i L 1) (snd (D ! n)) 
       (ladder_ix L 1) (drop (Suc n) (take m D)) (ladder_j L 1) (ladder_\<gamma> \<alpha> D L 1)"  
       using n m introsAt_L_1 by (metis LeftDerivationIntrosAt_def One_nat_def diff_Suc_1) 
     from iffD1[OF  LeftDerivationIntro_def this] obtain \<beta> where \<beta>:
       "LeftDerives1 (ladder_\<alpha> \<alpha> D L 1) (ladder_i L 1) (snd (D ! n)) \<beta> \<and>
        ladder_ix L 1 < length (snd (snd (D ! n))) \<and>
        snd (snd (D ! n)) ! ladder_ix L 1 = ladder_\<gamma> \<alpha> D L 1 ! ladder_j L 1 \<and>
        LeftDerivationFix \<beta> (ladder_i L 1 + ladder_ix L 1) (drop (Suc n) (take m D)) (ladder_j L 1)
        (ladder_\<gamma> \<alpha> D L 1)"
        by blast
     have "\<beta> = Derive (ladder_\<alpha> \<alpha> D L 1) [D ! n]"
       by (metis (no_types, hide_lams) LeftDerivationIntrosAt_def LeftDerives1_Derive \<beta> 
         cancel_comm_monoid_add_class.diff_cancel introsAt_L_1 n prod.collapse) 
     then have \<beta>_def: "\<beta> = ladder_stepdown_\<alpha>_0 \<alpha> D L"
       proof -
         obtain sss :: "nat \<Rightarrow> symbol list \<Rightarrow> symbol list" and ss :: "nat \<Rightarrow> symbol list \<Rightarrow> symbol" and sssa :: "nat \<Rightarrow> symbol list \<Rightarrow> symbol list" where
           "\<forall>x2 x3. (\<exists>v4 v5 v6. splits_at x3 x2 v4 v5 v6) = splits_at x3 x2 (sss x2 x3) (ss x2 x3) (sssa x2 x3)"
           by moura
         then have f1: "\<forall>ssa n p ssb. \<not> Derives1 ssa n p ssb \<or> splits_at ssa n (sss n ssa) (ss n ssa) (sssa n ssa)"
           using splits_at_ex by presburger
         then have "\<beta> = sss (ladder_i L 1) (ladder_\<alpha> \<alpha> D L 1) @ snd (snd (D ! n)) @ sssa (ladder_i L 1) (ladder_\<alpha> \<alpha> D L 1)"
           by (meson LeftDerives1_implies_Derives1 \<beta> splits_at_combine_dest)
         then show ?thesis
           using f1 by (metis (no_types) LeftDerives1_implies_Derives1 \<beta> ladder_stepdown_\<alpha>_0_altdef ldl length_L n)
       qed       
     have ladder_i_L'_0: "ladder_i L' 0 = ladder_i L 1 + ladder_ix L 1"
       using L' ladder_stepdown_i_0 length_L by blast
     have derivation_eq: "(take (ladder_n L' 0) (drop (ladder_stepdown_diff L) D)) = 
       (drop (Suc n) (take m D))" using n m
       by (metis L' L'_nonempty One_nat_def drop_take ladder_stepdown_diff_def ladder_stepdown_n
         length_L length_greater_0_conv)  
     have ladder_j_L'_0: "ladder_j L' 0 = ladder_j L 1"
       using L' L'_nonempty ladder_stepdown_j length_L by auto  
     have ladder_\<gamma>: "(ladder_\<gamma> (ladder_stepdown_\<alpha>_0 \<alpha> D L) (drop (ladder_stepdown_diff L) D) L' 0) =
       ladder_\<gamma> \<alpha> D L 1"
       by (metis Derivation_take_derive Derivation_unique_dest LeftDerivationFix_def 
         LeftDerivation_implies_Derivation \<beta> \<beta>_def derivation_eq ladder_\<gamma>_def ldl1)   
     from \<beta>_def \<beta> ladder_i_L'_0 derivation_eq ladder_j_L'_0 ladder_\<gamma>
     show ?thesis by auto
   qed 
   {
     fix index :: nat
     assume index_lower_bound: "Suc 0 \<le> index"
     assume index_upper_bound: "index < length L'"
     then have Suc_index_upper_bound: "Suc index < length L"
       using L' Suc_diff_Suc Suc_less_eq diff_Suc_1 ladder_stepdown_length length_L less_Suc_eq 
       by auto
     then have intros_at_Suc_index: "LeftDerivationIntrosAt \<alpha> D L (Suc index)"
       by (metis LeftDerivationIntros_def LeftDerivationLadder_def Suc_eq_plus1_left ldl le_add1)      
     from iffD1[OF LeftDerivationIntrosAt_def this] have ldintro:
       "let \<alpha>' = ladder_\<alpha> \<alpha> D L (Suc index); i = ladder_i L (Suc index); j = ladder_j L (Suc index);
        ix = ladder_ix L (Suc index); \<gamma> = ladder_\<gamma> \<alpha> D L (Suc index); n = ladder_n L (Suc index - 1);
        m = ladder_n L (Suc index); e = D ! n; E = drop (Suc n) (take m D)
        in i = fst e \<and> LeftDerivationIntro \<alpha>' i (snd e) ix E j \<gamma>" by blast
     have index_minus_Suc_0_bound: "index - Suc 0 < length L'"
       by (simp add: index_upper_bound less_imp_diff_less)
     note helpers = length_L L' index_minus_Suc_0_bound
     have ladder_i_L'_index:
       "ladder_i L' index = fst (drop (ladder_stepdown_diff L) D ! ladder_n L' (index - Suc 0))"
       apply (auto simp add: ladder_i_def)
       using index_lower_bound apply arith
       apply (simp add: ladder_stepdown_n[OF helpers] ladder_stepdown_j[OF helpers])
       apply (subst drop_at_shift)
       using LeftDerivationLadder_def Suc_index_upper_bound Suc_leI Suc_lessD is_ladder_def 
         ladder_stepdown_diff_def ldl apply presburger
       apply (metis LeftDerivationLadder_def One_nat_def Suc_eq_plus1 Suc_index_upper_bound 
         add.commute add_diff_cancel_right' ladder_n_minus_1_bound ldl le_add1)
       by (metis LeftDerivationIntrosAt_def intros_at_Suc_index diff_Suc_1 ladder_i_def nat.simps(3))
     have intro_at_index: 
       "LeftDerivationIntro (ladder_\<alpha> (ladder_stepdown_\<alpha>_0 \<alpha> D L) (drop (ladder_stepdown_diff L) D) L' index)
        (ladder_i L' index) (snd (drop (ladder_stepdown_diff L) D ! ladder_n L' (index - Suc 0)))
        (ladder_ix L' index)
        (drop (Suc (ladder_n L' (index - Suc 0)))
          (take (ladder_n L' index) (drop (ladder_stepdown_diff L) D)))
        (ladder_j L' index) (ladder_\<gamma> (ladder_stepdown_\<alpha>_0 \<alpha> D L) 
          (drop (ladder_stepdown_diff L) D) L' index)" 
     proof -
       have arg1: "(ladder_\<alpha> (ladder_stepdown_\<alpha>_0 \<alpha> D L) 
         (drop (ladder_stepdown_diff L) D) L' index) = ladder_\<alpha> \<alpha> D L (Suc index)"
         apply (auto simp add: ladder_\<alpha>_def ladder_\<gamma>_def)
         using index_lower_bound apply arith
         apply (simp add: ladder_stepdown_n[OF helpers] ladder_stepdown_\<alpha>_0_def)
         apply (subst Derive_Derive[where \<gamma>="ladder_\<gamma> \<alpha> D L index"])
         apply (metis (no_types, lifting) Derivation_take_derive LeftDerivationLadder_def 
           LeftDerivation_implies_Derivation Suc_index_upper_bound Suc_leI Suc_lessD 
           add.commute is_ladder_def ladder_\<gamma>_def ladder_stepdown_diff_def ldl 
           le_add_diff_inverse2 take_add)
         by (metis LeftDerivationLadder_def Suc_index_upper_bound Suc_leI Suc_lessD add.commute 
           is_ladder_def ladder_stepdown_diff_def ldl le_add_diff_inverse2 take_add)
       have arg2: "ladder_i L' index = ladder_i L (Suc index)"
         using L' index_lower_bound index_minus_Suc_0_bound ladder_i_def ladder_stepdown_j 
           length_L by auto
       obtain n where n: "n = ladder_n L (Suc index - 1)" by blast
       have arg3: "(snd (drop (ladder_stepdown_diff L) D ! ladder_n L' (index - Suc 0))) = 
         snd (D ! n)"
         apply (simp add: ladder_stepdown_n[OF helpers] index_lower_bound)
         apply (subst drop_at_shift)
         using index_lower_bound
         apply (metis (no_types, hide_lams) L' LeftDerivationLadder_def One_nat_def Suc_eq_plus1 
           add.commute diff_Suc_1 index_upper_bound is_ladder_def ladder_stepdown_diff_def 
           ladder_stepdown_length ldl le_add_diff_inverse2 length_L less_or_eq_imp_le n 
           nat.simps(3) neq0_conv not_less not_less_eq_eq) 
         using index_lower_bound
         apply (metis LeftDerivationLadder_def One_nat_def Suc_index_upper_bound Suc_le_lessD 
           Suc_pred diff_Suc_1 ladder_n_minus_1_bound ldl le_imp_less_Suc less_imp_le) 
         using index_lower_bound n by (simp add: Suc_diff_le) 
       have arg4: "ladder_ix L' index = ladder_ix L (Suc index)"
         using ladder_stepdown_ix L' Suc_le_lessD index_lower_bound index_upper_bound length_L 
         by auto 
       obtain m where m: "m = ladder_n L (Suc index)" by blast
       have Suc_index_Suc: "Suc (index - Suc 0) = index"
         using index_lower_bound by arith
       have arg5: "(drop (Suc (ladder_n L' (index - Suc 0))) (take (ladder_n L' index) 
         (drop (ladder_stepdown_diff L) D))) = drop (Suc n) (take m D)"
         apply (simp add: ladder_stepdown_n[OF helpers] 
           ladder_stepdown_n[OF length_L L' index_upper_bound] n m Suc_index_Suc)
         by (metis (no_types, lifting) LeftDerivationLadder_def Suc_eq_plus1_left 
           Suc_index_upper_bound Suc_leI Suc_le_lessD Suc_lessD drop_drop drop_take 
           index_lower_bound is_ladder_def ladder_stepdown_diff_def ldl le_add_diff_inverse2)
       have arg6: "ladder_j L' index = ladder_j L (Suc index)"
         using L' index_upper_bound ladder_stepdown_j length_L by blast
       have arg7: "(ladder_\<gamma> (ladder_stepdown_\<alpha>_0 \<alpha> D L) 
          (drop (ladder_stepdown_diff L) D) L' index) = ladder_\<gamma> \<alpha> D L (Suc index)"
         apply (simp add: ladder_\<gamma>_def)
         apply (simp add: ladder_stepdown_n[OF length_L L' index_upper_bound] ladder_stepdown_\<alpha>_0_def)
         apply (subst Derive_Derive[where \<gamma>="ladder_\<gamma> \<alpha> D L (Suc index)"])
         apply (metis (no_types, lifting) L' LeftDerivationLadder_def 
           LeftDerivation_implies_Derivation LeftDerivation_take_derive Suc_le_lessD 
           add_diff_inverse_nat diff_is_0_eq index_lower_bound index_upper_bound is_ladder_L' 
           is_ladder_def ladder_\<gamma>_def ladder_stepdown_n ldl le_0_eq length_L less_numeral_extra(3) 
           less_or_eq_imp_le take_add)
         by (metis (no_types, lifting) L' One_nat_def add_diff_inverse_nat diff_is_0_eq 
           index_lower_bound index_upper_bound is_ladder_L' is_ladder_def ladder_stepdown_n le_0_eq 
           le_neq_implies_less length_L less_numeral_extra(3) less_or_eq_imp_le take_add zero_less_one)
       from ldintro arg1 arg2 arg3 arg4 arg5 arg6 arg7 show ?thesis
         by (metis m n)
     qed            
     have "LeftDerivationIntrosAt (ladder_stepdown_\<alpha>_0 \<alpha> D L) (drop (ladder_stepdown_diff L) D) 
       L' index"
       apply (auto simp add: LeftDerivationIntrosAt_def Let_def)
       using ladder_i_L'_index apply blast
       using intro_at_index by blast
   }  
   note introsAt = this
   show ?thesis
     apply (rule_tac x="L'" in exI)
     apply auto
     defer 1
     using L' ladder_stepdown_length length_L apply auto[1]
     using ladder_stepdown_i_0 length_L L' apply auto[1]
     using ladder_stepdown_last_j L' length_L apply auto[1]
     apply (auto simp add: LeftDerivationLadder_def)
     using ldl1 apply blast
     using is_ladder_L' apply blast
     using ldfix apply blast
     apply (auto simp add: LeftDerivationIntros_def)
     apply (simp add: introsAt)
     done
 qed
 
 fun ladder_shift_j :: "nat \<Rightarrow> ladder \<Rightarrow> ladder" where 
   "ladder_shift_j d [] = []"
 | "ladder_shift_j d ((n, j, i)#L) = ((n, j - d, i)#(ladder_shift_j d L))" 
 
 definition ladder_cut_prefix :: "nat \<Rightarrow> ladder \<Rightarrow> ladder"
 where
   "ladder_cut_prefix d L = 
     (ladder_shift_j d L)[0 := (ladder_n L 0, ladder_j L 0 - d, ladder_i L 0 - d)]"
 
 lemma ladder_shift_j_length: 
   "length (ladder_shift_j d L) = length L"
   by (induct L, auto)
 
 lemma ladder_cut_prefix_length:
   shows "length (ladder_cut_prefix d L) = length L"
 apply (simp add: ladder_cut_prefix_def)
 apply (simp add: ladder_shift_j_length)
 done
 
 lemma ladder_shift_j_cons: "ladder_shift_j d (x#L) = (fst x, fst (snd x) - d, snd(snd x))#
   (ladder_shift_j d L)"
   apply (induct L)
   by (cases x, simp)+
 
 lemma deriv_j_ladder_shift_j: 
   "index < length L \<Longrightarrow> deriv_j (ladder_shift_j d L ! index) = deriv_j (L ! index) - d"
 proof (induct L arbitrary: index)
   case Nil
     then show ?case by auto
 next
   case (Cons x L)
     show ?case
       apply (subst ladder_shift_j_cons)
       apply (cases index)
       using Cons by (auto simp add: deriv_j_def)
 qed     
 
 lemma deriv_n_ladder_shift_j: 
   "index < length L \<Longrightarrow> deriv_n (ladder_shift_j d L ! index) = deriv_n (L ! index)"
 proof (induct L arbitrary: index)
   case Nil
     then show ?case by auto
 next
   case (Cons x L)
     show ?case
       apply (subst ladder_shift_j_cons)
       apply (cases index)
       using Cons by (auto simp add: deriv_n_def)
 qed     
 
 lemma deriv_ix_ladder_shift_j: 
   "index < length L \<Longrightarrow> deriv_ix (ladder_shift_j d L ! index) = deriv_ix (L ! index)"
 proof (induct L arbitrary: index)
   case Nil
     then show ?case by auto
 next
   case (Cons x L)
     show ?case
       apply (subst ladder_shift_j_cons)
       apply (cases index)
       using Cons by (auto simp add: deriv_ix_def)
 qed     
 
 lemma ladder_cut_prefix_j: 
   assumes index_bound: "index < length L"
   assumes length_L: "length L > 0"
   shows "ladder_j (ladder_cut_prefix d L) index = ladder_j L index - d"
   apply (simp add: ladder_j_def ladder_cut_prefix_def)
   apply (cases index)
   apply (auto simp add: length_L)
   apply (subst nth_list_update_eq)
   apply (simp only: ladder_shift_j_length length_L)
   apply (simp add: deriv_j_def)
   apply (subst deriv_j_ladder_shift_j)
   using index_bound apply arith
   by blast  
 
 lemma hd_0_subst: "length L > 0 \<Longrightarrow> hd (L [0 := x]) = x"
   using hd_conv_nth by (simp add: upd_conv_take_nth_drop) 
 
 lemma ladder_cut_prefix_i: 
   assumes index_bound: "index < length L"
   assumes length_L: "length L > 0"
   shows "ladder_i (ladder_cut_prefix d L) index = ladder_i L index - d"
   apply (simp add: ladder_i_def ladder_cut_prefix_def)
   apply (cases index)
   apply auto[1]
   apply (subst hd_0_subst)
   using length_L ladder_shift_j_length apply metis 
   apply (auto simp add: deriv_i_def)
   apply (case_tac nat)
   apply (simp add: ladder_j_def deriv_j_def)
   apply auto
   apply (subst nth_list_update_eq)
   using length_L ladder_shift_j_length apply auto[1]
   apply simp
   apply (simp add: ladder_j_def)
   apply (subst deriv_j_ladder_shift_j)
   using index_bound apply arith
   apply simp
   done  
 
 lemma ladder_cut_prefix_n: 
   assumes index_bound: "index < length L"
   assumes length_L: "length L > 0"
   shows "ladder_n (ladder_cut_prefix d L) index = ladder_n L index"
   apply (simp add: ladder_cut_prefix_def)
   apply (cases index)
   apply (auto simp add: ladder_n_def)
   apply (subst nth_list_update_eq)
   apply (simp add: ladder_shift_j_length)
   using length_L apply blast
   apply (simp add: deriv_n_def )
   apply (rule_tac deriv_n_ladder_shift_j)
   using index_bound by arith
 
 lemma ladder_cut_prefix_ix: 
   assumes index_bound: "index < length L"
   assumes length_L: "length L > 0"
   shows "ladder_ix (ladder_cut_prefix d L) index = ladder_ix L index"
   apply (simp add: ladder_cut_prefix_def)
   apply (cases index)
   apply (auto simp add: ladder_ix_def)
   apply (rule_tac deriv_ix_ladder_shift_j)
   using index_bound by arith
 
 lemma LeftDerivationFix_derivation_ge_is_nonterminal:
   assumes ldfix: "LeftDerivationFix \<alpha> i D j \<gamma>"
   assumes derivation_ge_d: "derivation_ge D d"
   assumes is_nonterminal: "is_nonterminal (\<gamma> ! j)"
   shows "(D = [] \<and> \<alpha> = \<gamma> \<and> i = j) \<or> (i > d \<and> j \<ge> d)"
 proof -
   have "is_nonterminal (\<alpha> ! i)" using ldfix is_nonterminal
     by (simp add: LeftDerivationFix_def)  
   from LeftDerivationFix_splits_at_nonterminal[OF ldfix this] obtain U a1 a2 b1 where U:
     "splits_at \<alpha> i a1 U a2 \<and> splits_at \<gamma> j b1 U a2 \<and> LeftDerivation a1 D b1" by blast
   have "D = [] \<or> D \<noteq> []" by auto
   then show ?thesis
   proof (induct rule: disjCases2)
     case 1
       then have "a1 = b1" using U by auto
       then have i_eq_j: "i = j" using U
         by (metis dual_order.strict_implies_order length_take min.absorb2 splits_at_def) 
       from 1 have "\<alpha> = \<gamma>" using ldfix LeftDerivationFix_def by auto
       with 1 i_eq_j show ?case by blast
   next
     case 2
       have "\<exists> a1'. LeftDerives1 a1 (fst (hd D)) (snd (hd D)) a1'" using U 2
         by (metis LeftDerivation.elims(2) list.sel(1))
       then obtain a1' where a1': "LeftDerives1 a1 (fst (hd D)) (snd (hd D)) a1'" by blast
       then have "(fst (hd D)) < length a1" using Derives1_bound LeftDerives1_implies_Derives1 by blast 
       then have fst_less_i: "(fst (hd D)) < i" using U
         by (simp add: leD min.absorb2 nat_le_linear splits_at_def) 
       have d_le_fst: "d \<le> fst (hd D)" using derivation_ge_d 2 by (simp add: derivation_ge_def)  
       with fst_less_i have d_less_i: "d < i" using le_less_trans by blast 
       have "\<exists> b1'. LeftDerives1 b1' (fst (last D)) (snd (last D)) b1" using U 2
         by (metis Derive LeftDerivation_Derive_take_LeftDerives1 LeftDerivation_implies_Derivation 
           last_conv_nth length_0_conv order_refl take_all)
       then obtain b1' where b1': "LeftDerives1 b1' (fst (last D)) (snd (last D)) b1" by blast
       then have "fst (last D) \<le> length b1" 
         using Derives1_bound' LeftDerives1_implies_Derives1 by blast 
       then have fst_le_j: "fst (last D) \<le> j" using U splits_at_def by auto   
       have "d \<le> fst (last D)" using derivation_ge_d 2 using derivation_ge_def last_in_set by blast 
       with fst_le_j have "d \<le> j" using order.trans by blast       
       with d_less_i show ?thesis by auto
   qed
 qed
 
 lemma LeftDerivationFix_derivation_ge:
   assumes ldfix: "LeftDerivationFix \<alpha> i D j \<gamma>"
   assumes derivation_ge_d: "derivation_ge D d"
   shows "i = j \<or> (i > d \<and> j \<ge> d)"
 proof -
   from LeftDerivationFix_splits_at_symbol[OF ldfix] obtain U a1 a2 b1 b2 n where U:
     "splits_at \<alpha> i a1 U a2 \<and>
      splits_at \<gamma> j b1 U b2 \<and>
      n \<le> length D \<and>
      LeftDerivation a1 (take n D) b1 \<and>
      derivation_ge (drop n D) (Suc (length b1)) \<and>
      LeftDerivation a2 (derivation_shift (drop n D) (Suc (length b1)) 0) b2 \<and>
      (n = length D \<or> n < length D \<and> is_word (b1 @ [U]))" by blast
   have "n = 0 \<or> n > 0" by auto
   then show ?thesis
   proof (induct rule: disjCases2)
     case 1
       then have "a1 = b1" using U by auto
       then have i_eq_j: "i = j" using U
         by (metis dual_order.strict_implies_order length_take min.absorb2 splits_at_def) 
       then show ?case by blast
   next
     case 2
       obtain E where E: "E = take n D" by blast
       have E_nonempty: "E \<noteq> []" using E 2
         using U less_nat_zero_code list.size(3) take_eq_Nil by auto 
       have "\<exists> a1'. LeftDerives1 a1 (fst (hd E)) (snd (hd E)) a1'" using U E E_nonempty
         by (metis LeftDerivation.simps(2) list.exhaust list.sel(1))        
       then obtain a1' where a1': "LeftDerives1 a1 (fst (hd E)) (snd (hd E)) a1'" by blast
       then have "(fst (hd E)) < length a1" using Derives1_bound LeftDerives1_implies_Derives1 by blast 
       then have fst_less_i: "(fst (hd E)) < i" using U
         by (simp add: leD min.absorb2 nat_le_linear splits_at_def) 
       have d_le_fst: "d \<le> fst (hd E)" using derivation_ge_d E_nonempty E
         by (simp add: LeftDerivation.elims(2) U derivation_ge_def hd_conv_nth)
       with fst_less_i have d_less_i: "d < i" using le_less_trans by blast 
       have "\<exists> b1'. LeftDerives1 b1' (fst (last E)) (snd (last E)) b1" using E_nonempty U E
         by (metis LeftDerivation_append1 append_butlast_last_id prod.collapse)                
       then obtain b1' where b1': "LeftDerives1 b1' (fst (last E)) (snd (last E)) b1" by blast
       then have "fst (last E) \<le> length b1" 
         using Derives1_bound' LeftDerives1_implies_Derives1 by blast 
       then have fst_le_j: "fst (last E) \<le> j" using U splits_at_def by auto   
       have "d \<le> fst (last E)" using derivation_ge_d E_nonempty E 
         using derivation_ge_d last_in_set by (metis derivation_ge_def set_take_subset subsetCE) 
       with fst_le_j have "d \<le> j" using order.trans by blast       
       with d_less_i show ?thesis by auto
   qed
 qed
 
 lemma LeftDerivationIntro_derivation_ge:
   assumes ldintro: "LeftDerivationIntro \<alpha> i r ix D j \<gamma>"
   assumes i_ge_d: "i \<ge> d"
   assumes derivation_ge_d: "derivation_ge D d"
   shows "j \<ge> d"
 proof -
   from iffD1[OF LeftDerivationIntro_def ldintro] obtain \<beta> where \<beta>:
     "LeftDerives1 \<alpha> i r \<beta> \<and> ix < length (snd r) \<and> snd r ! ix = \<gamma> ! j \<and> 
      LeftDerivationFix \<beta> (i + ix) D j \<gamma>" by blast
   then have "(i + ix = j) \<or> (i + ix > d \<and> j \<ge> d)"
     using LeftDerivationFix_derivation_ge derivation_ge_d by blast    
   then show ?thesis
   proof (induct rule: disjCases2)
     case 1 then show ?case using i_ge_d trans_le_add1 by blast
   next
     case 2 then show ?case by simp
   qed
 qed
 
 lemma derivation_ge_LeftDerivationLadder:
   assumes derivation_ge_d: "derivation_ge D d"
   assumes ladder: "LeftDerivationLadder \<alpha> D L \<gamma>"
   assumes ladder_i_0: "ladder_i L 0 \<ge> d"
   shows "index < length L \<Longrightarrow> ladder_i L index \<ge> d \<and> ladder_j L index \<ge> d"
 proof (induct index)
   case 0
     from iffD1[OF LeftDerivationLadder_def ladder]
     have ldfix: "LeftDerivationFix \<alpha> (ladder_i L 0)
       (take (ladder_n L 0) D) (ladder_j L 0) (ladder_\<gamma> \<alpha> D L 0)" by blast
     have "derivation_ge (take (ladder_n L 0) D) d"
       using derivation_ge_d by (metis append_take_drop_id derivation_ge_append) 
     from ladder_i_0 derivation_ge_d LeftDerivationFix_derivation_ge[OF ldfix this]
     show ?case by linarith
 next
   case (Suc n)
     have ladder_i_Suc: "ladder_i L (Suc n) \<ge> d" 
       apply (auto simp add: ladder_i_def)
       using Suc by auto
     from iffD1[OF LeftDerivationLadder_def ladder] have "LeftDerivationIntros \<alpha> D L"
       by blast
     then have "LeftDerivationIntrosAt \<alpha> D L (Suc n)"
       using Suc.prems
       by (metis LeftDerivationIntros_def Suc_eq_plus1_left le_add1)
     from iffD1[OF LeftDerivationIntrosAt_def this]
     show ?case using ladder_i_Suc LeftDerivationIntro_derivation_ge
       by (metis append_take_drop_id derivation_ge_append derivation_ge_d)
 qed        
 
 lemma derivation_shift_append:
   "derivation_shift (A@B) left right = 
     (derivation_shift A left right) @ (derivation_shift B left right)"
 by (induct A, simp+)
 
 lemma derivation_shift_right_left_subtract: 
   "right \<ge> left \<Longrightarrow> derivation_shift (derivation_shift L 0 right) left 0 = 
   derivation_shift L 0 (right - left)"
 by (induct L, simp+)
 
 lemma LeftDerivationFix_cut_prefix:
   assumes "LeftDerivationFix (\<delta>@\<alpha>) i D j \<gamma>"
   assumes "derivation_ge D (length \<delta>)"
   assumes "i \<ge> length \<delta>"
   assumes is_word_\<delta>: "is_word \<delta>"
   shows "\<exists> \<gamma>'. \<gamma> = \<delta> @ \<gamma>' \<and> 
     LeftDerivationFix \<alpha> (i - length \<delta>) (derivation_shift D (length \<delta>) 0) (j - length \<delta>) \<gamma>'"
 proof -
   have j_ge_d: "j \<ge> length \<delta>" 
     using assms(3) LeftDerivationFix_derivation_ge[OF assms(1) assms(2)] by arith
   obtain \<gamma>' where \<gamma>': "\<gamma>' = drop (length \<delta>) \<gamma>" by blast
   from iffD1[OF LeftDerivationFix_def assms(1)] obtain E F where EF:
    "is_sentence (\<delta> @ \<alpha>) \<and>
     is_sentence \<gamma> \<and>
     LeftDerivation (\<delta> @ \<alpha>) D \<gamma> \<and>
     i < length (\<delta> @ \<alpha>) \<and>
     j < length \<gamma> \<and>
     (\<delta> @ \<alpha>) ! i = \<gamma> ! j \<and>
     D = E @ derivation_shift F 0 (Suc j) \<and>
     LeftDerivation (take i (\<delta> @ \<alpha>)) E (take j \<gamma>) \<and>
     LeftDerivation (drop (Suc i) (\<delta> @ \<alpha>)) F (drop (Suc j) \<gamma>)" by blast
   then have "LeftDerivation (\<delta> @ \<alpha>) D \<gamma>" by blast
   from LeftDerivation_skip_prefixword_ex[OF this is_word_\<delta>]
   obtain \<gamma>' where \<gamma>': "\<gamma> = \<delta> @ \<gamma>' \<and> LeftDerivation \<alpha> (derivation_shift D (length \<delta>) 0) \<gamma>'" by blast
   have ldf1: "is_sentence \<alpha>" using EF is_sentence_concat by blast 
   have ldf2: "is_sentence \<gamma>'" using EF \<gamma>' is_sentence_concat by blast 
   have ldf3: "i - length \<delta> < length \<alpha>"
     by (metis EF append_Nil assms(3) drop_append drop_eq_Nil not_le) 
   have ldf4: "j - length \<delta> < length \<gamma>'"
     by (metis EF append_Nil j_ge_d \<gamma>' drop_append drop_eq_Nil not_le) 
   have ldf5: "\<alpha> ! (i - length \<delta>) = \<gamma>' ! (j - length \<delta>)"
     by (metis \<gamma>' EF assms(3) j_ge_d leD nth_append)
   have D_split: "D = E @ derivation_shift F 0 (Suc j)" using EF by blast
   show ?thesis
     apply (rule_tac x=\<gamma>' in exI)
     apply (auto simp add: \<gamma>')
     apply (auto simp add: LeftDerivationFix_def)
     using ldf1 apply blast
     using ldf2 apply blast
     using \<gamma>' apply blast
     using ldf3 apply blast
     using ldf4 apply blast
     using ldf5 apply blast
     apply (rule_tac x="derivation_shift E (length \<delta>) 0" in exI)
     apply (rule_tac x="F" in exI)
     apply auto
     apply (subst D_split)
     apply (simp add: derivation_shift_append)
     apply (subst derivation_shift_right_left_subtract)
     apply (simp add: j_ge_d le_Suc_eq)
     using j_ge_d apply (simp add: Suc_diff_le)
     apply (metis EF LeftDerivation_implies_Derivation LeftDerivation_skip_prefix \<gamma>' 
       append_eq_conv_conj assms(3) drop_take is_word_Derivation_derivation_ge is_word_\<delta> 
       take_all take_append)
     using EF Suc_diff_le \<gamma>' assms(3) j_ge_d by auto 
 qed
 
 lemma LeftDerives1_propagate_prefix:
   "LeftDerives1 (\<delta> @ \<alpha>) i r \<beta> \<Longrightarrow> i \<ge> length \<delta> \<Longrightarrow> is_prefix \<delta> \<beta>"
 proof -
   assume a1: "LeftDerives1 (\<delta> @ \<alpha>) i r \<beta>"
   assume a2: "length \<delta> \<le> i"
   have f3: "take i (\<delta> @ \<alpha>) = take i \<beta>"
     using a1 Derives1_take LeftDerives1_implies_Derives1 by blast
   then have f4: "length (take i \<beta>) = i"
     using a1 by (metis (no_types) Derives1_bound LeftDerives1_implies_Derives1 dual_order.strict_implies_order length_take min.absorb2)
   have "take (length \<delta>) (take i \<beta>) = \<delta>"
     using f3 a2 by (simp add: append_eq_conv_conj)
   then show ?thesis
     using f4 a2 by (metis (no_types) append_Nil2 append_eq_conv_conj diff_is_0_eq' is_prefix_take take_0 take_append)
 qed
 
 lemma LeftDerivationIntro_cut_prefix:
   assumes "LeftDerivationIntro (\<delta>@\<alpha>) i r ix D j \<gamma>"
   assumes "derivation_ge D (length \<delta>)"
   assumes "i \<ge> length \<delta>"
   assumes is_word_\<delta>: "is_word \<delta>"
   shows "\<exists> \<gamma>'. \<gamma> = \<delta> @ \<gamma>' \<and> 
     LeftDerivationIntro \<alpha> (i - length \<delta>) r ix (derivation_shift D (length \<delta>) 0) (j - length \<delta>) \<gamma>'"
 proof -
   from iffD1[OF LeftDerivationIntro_def assms(1)] obtain \<beta> where \<beta>:
     "LeftDerives1 (\<delta> @ \<alpha>) i r \<beta> \<and>
      ix < length (snd r) \<and> snd r ! ix = \<gamma> ! j \<and> LeftDerivationFix \<beta> (i + ix) D j \<gamma>" by blast
   have "\<exists> \<beta>'. \<beta> = \<delta> @ \<beta>'" 
     using LeftDerives1_propagate_prefix \<beta> assms(3) by (metis append_dropped_prefix) 
   then obtain \<beta>' where \<beta>': "\<beta> = \<delta> @ \<beta>'" by blast
   with \<beta> have "LeftDerives1 (\<delta> @ \<alpha>) i r (\<delta> @ \<beta>')" by simp
   from LeftDerives1_skip_prefix[OF assms(3) this] 
   have \<alpha>_\<beta>': "LeftDerives1 \<alpha> (i - length \<delta>) r \<beta>'" by blast
   have ldfix: "LeftDerivationFix (\<delta> @ \<beta>') (i + ix) D j \<gamma>" using \<beta> \<beta>' by auto
   have \<delta>_le_i_plus_ix: "length \<delta> \<le> i + ix" using assms(3) by arith
   from LeftDerivationFix_cut_prefix[OF ldfix assms(2) \<delta>_le_i_plus_ix assms(4)]
   obtain \<gamma>' where \<gamma>': "\<gamma> = \<delta> @ \<gamma>' \<and>
      LeftDerivationFix \<beta>' (i + ix - length \<delta>) (derivation_shift D (length \<delta>) 0) (j - length \<delta>) \<gamma>'"
      by blast
   have same_symbol: "\<gamma> ! j = \<gamma>' ! (j - length \<delta>)"
     by (metis LeftDerivationFix_def \<beta> \<beta>' \<delta>_le_i_plus_ix \<gamma>' leD nth_append)
   have \<beta>'_\<gamma>': "LeftDerivationFix \<beta>' (i - length \<delta> + ix) 
     (derivation_shift D (length \<delta>) 0) (j - length \<delta>) \<gamma>'" by (simp add: \<gamma>' assms(3))   
   show ?thesis
     apply (simp add: LeftDerivationIntro_def)
     apply (rule_tac x=\<gamma>' in exI)
     apply (auto simp add: \<gamma>')
     apply (rule_tac x=\<beta>' in exI)
     by (auto simp add: \<beta> \<alpha>_\<beta>' same_symbol \<beta>'_\<gamma>')
 qed    
 
 lemma LeftDerivationLadder_implies_LeftDerivation_at_index:
   assumes "LeftDerivationLadder \<alpha> D L \<gamma>"
   assumes "index < length L"
   shows "LeftDerivation \<alpha> (take (ladder_n L index) D) (ladder_\<gamma> \<alpha> D L index)"
 using LeftDerivationLadder_def LeftDerivation_take_derive assms(1) ladder_\<gamma>_def by auto
 
 lemma LeftDerivationLadder_cut_prefix_propagate:
   assumes ladder: "LeftDerivationLadder (\<delta>@\<alpha>) D L \<gamma>"
   assumes is_word_\<delta>: "is_word \<delta>"
   assumes derivation_ge_\<delta>: "derivation_ge D (length \<delta>)"
   assumes ladder_i_0: "ladder_i L 0 \<ge> length \<delta>"
   assumes L': "L' = ladder_cut_prefix (length \<delta>) L"
   assumes D': "D' = derivation_shift D (length \<delta>) 0"
   shows "index < length L \<Longrightarrow> 
     LeftDerivation \<alpha> (take (ladder_n L' index) D') (ladder_\<gamma> \<alpha> D' L' index) \<and>
     ladder_\<alpha> (\<delta>@\<alpha>) D L index = \<delta>@(ladder_\<alpha> \<alpha> D' L' index) \<and>
     ladder_\<gamma> (\<delta>@\<alpha>) D L index = \<delta>@(ladder_\<gamma> \<alpha> D' L' index)"
 proof (induct index) 
   case 0
     have ladder_\<alpha>: "ladder_\<alpha> (\<delta>@\<alpha>) D L 0 = \<delta>@(ladder_\<alpha> \<alpha> D' L' 0)"
       by (simp add: ladder_\<alpha>_def)
     have ldfix: "LeftDerivationFix (\<delta>@\<alpha>) (ladder_i L 0) (take (ladder_n L 0) D) 
       (ladder_j L 0) (ladder_\<gamma> (\<delta>@\<alpha>) D L 0)" using ladder LeftDerivationLadder_def by blast
     have dge_take: "derivation_ge (take (ladder_n L 0) D) (length \<delta>)"
       using derivation_ge_\<delta> by (metis append_take_drop_id derivation_ge_append) 
     from LeftDerivationFix_cut_prefix[OF ldfix dge_take ladder_i_0 is_word_\<delta>] 
     obtain \<gamma>' where \<gamma>': "ladder_\<gamma> (\<delta> @ \<alpha>) D L 0 = \<delta> @ \<gamma>' \<and>
       LeftDerivationFix \<alpha> (ladder_i L 0 - length \<delta>) (derivation_shift (take (ladder_n L 0) D) (length \<delta>) 0)
       (ladder_j L 0 - length \<delta>) \<gamma>'" by blast
     have ladder_\<gamma>: "ladder_\<gamma> (\<delta>@\<alpha>) D L 0 = \<delta>@(ladder_\<gamma> \<alpha> D' L' 0)"
       using \<gamma>' by (metis "0.prems" D' Derive L' LeftDerivationFix_def 
         LeftDerivation_implies_Derivation ladder_\<gamma>_def ladder_cut_prefix_n take_derivation_shift)
     have "LeftDerivation \<alpha> (take (ladder_n L' 0) D') (ladder_\<gamma> \<alpha> D' L' 0)" 
     proof -
       have "LeftDerivation (\<delta>@\<alpha>) (take (ladder_n L 0) D) (ladder_\<gamma> (\<delta>@\<alpha>) D L 0)"
         using LeftDerivationLadder_implies_LeftDerivation_at_index ladder "0.prems" by blast
       then show ?thesis
         by (metis D' LeftDerivationLadder_def LeftDerivation_skip_prefix 
           LeftDerivation_take_derive derivation_ge_\<delta> ladder ladder_\<gamma>_def)
     qed        
     then show ?case using ladder_\<alpha> ladder_\<gamma> by auto
 next
   case (Suc index)
     have index_less_L: "index < length L" using Suc(2) by arith
     then have induct: "ladder_\<gamma> (\<delta>@\<alpha>) D L index = \<delta>@(ladder_\<gamma> \<alpha> D' L' index)"
       using Suc by blast
     then have ladder_\<alpha>: "ladder_\<alpha> (\<delta>@\<alpha>) D L (Suc index) = \<delta>@(ladder_\<alpha> \<alpha> D' L' (Suc index))"
       by (simp add: ladder_\<alpha>_def)
     have introsAt: "LeftDerivationIntrosAt (\<delta>@\<alpha>) D L (Suc index)"
       using Suc(2) ladder
       by (metis LeftDerivationIntros_def LeftDerivationLadder_def Suc_eq_plus1_left le_add1) 
     obtain n m e E where n: "n = ladder_n L (Suc index - 1)" and
       m: "m = ladder_n L (Suc index)" and e: "e = D ! n" and E: "E = drop (Suc n) (take m D)"
       by blast
     from iffD1[OF LeftDerivationIntrosAt_def introsAt] have 
       "LeftDerivationIntro (ladder_\<alpha> (\<delta> @ \<alpha>) D L (Suc index)) (ladder_i L (Suc index)) (snd e) 
        (ladder_ix L (Suc index)) E (ladder_j L (Suc index)) (ladder_\<gamma> (\<delta> @ \<alpha>) D L (Suc index))"
       using n m e E Let_def by meson 
     then have ldintro:
       "LeftDerivationIntro (\<delta>@(ladder_\<alpha> \<alpha> D' L' (Suc index))) (ladder_i L (Suc index)) (snd e) 
        (ladder_ix L (Suc index)) E (ladder_j L (Suc index)) (ladder_\<gamma> (\<delta> @ \<alpha>) D L (Suc index))"
       by (simp add: ladder_\<alpha>)
     have dge_E_\<delta>: "derivation_ge E (length \<delta>)"
       apply (simp add: E)
       using derivation_ge_\<delta>
       by (metis append_take_drop_id derivation_ge_append) 
     have ladder_i_Suc: "length \<delta> \<le> ladder_i L (Suc index)"
       using Suc.prems derivation_ge_LeftDerivationLadder derivation_ge_\<delta> ladder ladder_i_0 
       by blast
     from LeftDerivationIntro_cut_prefix[OF ldintro dge_E_\<delta> ladder_i_Suc is_word_\<delta>]
     obtain \<gamma>' where \<gamma>': "ladder_\<gamma> (\<delta> @ \<alpha>) D L (Suc index) = \<delta> @ \<gamma>' \<and>
       LeftDerivationIntro (ladder_\<alpha> \<alpha> D' L' (Suc index)) (ladder_i L (Suc index) - length \<delta>) (snd e)
       (ladder_ix L (Suc index)) (derivation_shift E (length \<delta>) 0) (ladder_j L (Suc index) - length \<delta>) \<gamma>'"
       by blast
     then have "LeftDerivation (ladder_\<alpha> \<alpha> D' L' (Suc index)) 
       ((ladder_i L (Suc index) - length \<delta>, snd e) # (derivation_shift E (length \<delta>) 0)) \<gamma>'"
       using LeftDerivationIntro_implies_LeftDerivation by blast
     then have "LeftDerivation (ladder_\<gamma> \<alpha> D' L' index) 
       ((ladder_i L (Suc index) - length \<delta>, snd e) # (derivation_shift E (length \<delta>) 0)) \<gamma>'"
       by (auto simp add: ladder_\<alpha>_def)
     have ld: "LeftDerivation \<alpha> (take (ladder_n L' (Suc index)) D') (ladder_\<gamma> \<alpha> D' L' (Suc index))" 
     proof -
       have "LeftDerivation (\<delta>@\<alpha>) (take (ladder_n L (Suc index)) D) (ladder_\<gamma> (\<delta>@\<alpha>) D L (Suc index))"
         using LeftDerivationLadder_implies_LeftDerivation_at_index ladder Suc.prems by blast
       then show ?thesis
         by (metis D' LeftDerivationLadder_def LeftDerivation_skip_prefix 
           LeftDerivation_take_derive derivation_ge_\<delta> ladder ladder_\<gamma>_def)
     qed        
     then show ?case
       using \<gamma>' D' Derive L' LeftDerivationIntro_def n m e E ld
         LeftDerivation_implies_Derivation ladder_\<gamma>_def ladder_cut_prefix_n take_derivation_shift
       by (metis (no_types, lifting) LeftDerivationLadder_implies_LeftDerivation_at_index 
         LeftDerivation_skip_prefixword_ex Suc.prems Suc_leI index_less_L is_word_\<delta> ladder 
         ladder_\<alpha> le_0_eq neq0_conv)
 qed       
 
 theorem LeftDerivationLadder_cut_prefix:
   assumes ladder: "LeftDerivationLadder (\<delta>@\<alpha>) D L \<gamma>"
   assumes is_word_\<delta>: "is_word \<delta>"
   assumes ladder_i_0: "ladder_i L 0 \<ge> length \<delta>"
   shows "\<exists> D' L' \<gamma>'. \<gamma> = \<delta> @ \<gamma>' \<and> 
     LeftDerivationLadder \<alpha> D' L' \<gamma>' \<and>
     D' = derivation_shift D (length \<delta>) 0 \<and>
     length L' = length L \<and> ladder_i L' 0 + length \<delta> = ladder_i L 0 \<and>
     ladder_last_j L' + length \<delta> = ladder_last_j L"
 proof -
   obtain D' where D': "D' = derivation_shift D (length \<delta>) 0" by blast
   obtain L' where L': "L' = ladder_cut_prefix (length \<delta>) L" by blast
   obtain \<gamma>' where \<gamma>': "\<gamma>' = drop (length \<delta>) \<gamma>" by blast 
   have ladder_last_j_upper_bound: "ladder_last_j L < length \<gamma>" using ladder
     using ladder_last_j_bound by blast 
   have derivation_ge_\<delta>: "derivation_ge D (length \<delta>)" using is_word_\<delta> LeftDerivationLadder_def 
     LeftDerivation_implies_Derivation is_word_Derivation_derivation_ge ladder by blast 
   note derivation_ge_ladder =  
     derivation_ge_LeftDerivationLadder[OF derivation_ge_\<delta> ladder ladder_i_0]  
   have ladder_last_j_lower_bound: "ladder_last_j L \<ge> length \<delta>"
     using LeftDerivationLadder_def derivation_ge_ladder is_ladder_def ladder 
       ladder_last_j_def by auto 
   from ladder_last_j_upper_bound ladder_last_j_lower_bound 
   have \<delta>_less_\<gamma>: "length \<delta> < length \<gamma>" by arith
   then have \<gamma>_def: "\<gamma> = \<delta> @ \<gamma>'"
     by (metis LeftDerivation.simps(1) LeftDerivationLadder_def LeftDerivation_ge_take \<gamma>' 
       append_eq_conv_conj derivation_ge_\<delta> ladder)
   have length_L_nonzero: "length L \<noteq> 0"
      using LeftDerivationLadder_def is_ladder_def ladder by auto
   have ladder_i_L'_thm: "\<And> index. index < length L \<Longrightarrow> ladder_i L' index + length \<delta> = ladder_i L index"
     apply (simp add: L')
     apply (subst ladder_cut_prefix_i)
     apply simp
     using length_L_nonzero apply blast
     using derivation_ge_ladder by auto   
   have ladder_j_L'_thm: "\<And> index. index < length L \<Longrightarrow> ladder_j L' index + length \<delta> = ladder_j L index"
     apply (simp add: L')
     apply (subst ladder_cut_prefix_j)
     using LeftDerivationLadder_def is_ladder_def ladder apply blast 
     using LeftDerivationLadder_def is_ladder_def ladder apply blast 
     using derivation_ge_ladder by auto
   have length_L': "length L' = length L" using L' ladder_cut_prefix_length by simp 
   have \<alpha>_\<gamma>': "LeftDerivation \<alpha> D' \<gamma>'"
     using D' LeftDerivationLadder_def LeftDerivation_skip_prefix \<gamma>' derivation_ge_\<delta> ladder 
     by blast
   have length_D': "length D' = length D" by (simp add: D')   
   have is_ladder_D_L: "is_ladder D L" using LeftDerivationLadder_def ladder by blast 
   {
     fix u :: nat
     assume u_bound_L': "u < length L'"
     have u_bound_L: "u < length L" using length_L' using u_bound_L' by simp
     have "ladder_n L' u \<le> length D'"
       apply (simp add: length_D' L')
       apply (subst ladder_cut_prefix_n)
       apply (simp add: u_bound_L)
       using length_L_nonzero apply arith
       using u_bound_L is_ladder_D_L
       by (simp add: is_ladder_def)
   }
   note is_ladder_1 = this 
   {
     fix u :: nat
     fix v :: nat
     assume u_less_v: "u < v"
     assume v_bound_L': "v < length L'"
     then have v_bound_L: "v < length L" by (simp add: length_L')
     with u_less_v have u_bound_L: "u < length L" by arith
     have "ladder_n L' u < ladder_n L' v"
       apply (simp add: L')
       apply (subst ladder_cut_prefix_n)
       using u_bound_L apply blast
       using length_L_nonzero apply blast
       apply (subst ladder_cut_prefix_n)
       using v_bound_L apply blast
       using length_L_nonzero apply blast
       using u_less_v v_bound_L is_ladder_D_L by (simp add: is_ladder_def)
   }      
   note is_ladder_2 = this
   have is_ladder_3: "ladder_last_n L' = length D'"
     apply (simp add: length_D' ladder_last_n_def L')
     apply (subst ladder_cut_prefix_n)
     apply (simp add: ladder_cut_prefix_length)
     using length_L_nonzero apply auto[1]
     using length_L_nonzero apply blast
     apply (simp add: ladder_cut_prefix_length)
     using is_ladder_D_L by (simp add: is_ladder_def ladder_last_n_def) 
   have is_ladder_4: "LeftDerivationFix \<alpha> (ladder_i L' 0) (take (ladder_n L' 0) D') 
     (ladder_j L' 0) (ladder_\<gamma> \<alpha> D' L' 0)"
   proof -
     have ldfix: "LeftDerivationFix (\<delta>@\<alpha>) (ladder_i L 0) (take (ladder_n L 0) D) 
     (ladder_j L 0) (ladder_\<gamma> (\<delta>@\<alpha>) D L 0)"
     using ladder LeftDerivationLadder_def by blast 
     have dge: "derivation_ge (take (ladder_n L 0) D) (length \<delta>)"
       using derivation_ge_\<delta> by (metis append_take_drop_id derivation_ge_append) 
     from LeftDerivationFix_cut_prefix[OF ldfix dge ladder_i_0 is_word_\<delta>] 
     obtain \<gamma>' where \<gamma>': "ladder_\<gamma> (\<delta> @ \<alpha>) D L 0 = \<delta> @ \<gamma>' \<and>
       LeftDerivationFix \<alpha> (ladder_i L 0 - length \<delta>) (derivation_shift (take (ladder_n L 0) D) (length \<delta>) 0)
       (ladder_j L 0 - length \<delta>) \<gamma>'" by blast
     then show ?thesis
       using LeftDerivationLadder_cut_prefix_propagate D' L' append_eq_conv_conj derivation_ge_\<delta> 
         is_word_\<delta> ladder ladder_cut_prefix_i ladder_cut_prefix_j ladder_cut_prefix_n ladder_i_0 
         length_0_conv length_L_nonzero length_greater_0_conv take_derivation_shift by auto 
   qed  
   {
     fix index :: nat
     assume index_lower_bound: "Suc 0 \<le> index"
     assume index_upper_bound: "index < length L'"
     have introsAt: "LeftDerivationIntrosAt (\<delta>@\<alpha>) D L index"
       by (metis LeftDerivationIntros_def LeftDerivationLadder_def One_nat_def index_lower_bound 
         index_upper_bound ladder length_L')    
     then have ladder_i_L: "ladder_i L index = fst (D ! ladder_n L (index - Suc 0))"
       by (metis LeftDerivationIntrosAt_def One_nat_def \<open>LeftDerivationIntrosAt (\<delta> @ \<alpha>) D L index\<close>)
     have ladder_i_L'_as_L: "ladder_i L' index = ladder_i L index - (length \<delta>)"
       using ladder_cut_prefix_i L' index_upper_bound is_ladder_D_L is_ladder_not_empty length_L' 
         length_greater_0_conv by auto 
     have length_L_gr_0: "length L > 0" using length_L' length_L_nonzero by arith
     have index_Suc_upper_bound_L: "index - Suc 0 < length L" using index_upper_bound length_L' by arith
     have "fst (D' ! ladder_n L' (index - Suc 0)) =  fst (D ! ladder_n L (index - Suc 0)) - (length \<delta>)"
       apply (subst D', subst L')
       apply (subst ladder_cut_prefix_n[OF index_Suc_upper_bound_L length_L_gr_0])
       apply (simp add: derivation_shift_def)
       using index_lower_bound index_upper_bound is_ladder_D_L ladder_n_minus_1_bound length_L' by auto
     then have ladder_i_L': "ladder_i L' index = fst (D' ! ladder_n L' (index - Suc 0))" 
       using ladder_i_L ladder_i_L'_as_L by auto
     have "LeftDerivationIntro (ladder_\<alpha> \<alpha> D' L' index) (ladder_i L' index)
       (snd (D' ! ladder_n L' (index - Suc 0))) (ladder_ix L' index)
       (drop (Suc (ladder_n L' (index - Suc 0))) (take (ladder_n L' index) D')) (ladder_j L' index)
       (ladder_\<gamma> \<alpha> D' L' index)"
     proof -
       have "LeftDerivationIntro (ladder_\<alpha> (\<delta>@\<alpha>) D L index) (ladder_i L index)
         (snd (D ! ladder_n L (index - Suc 0))) (ladder_ix L index)
         (drop (Suc (ladder_n L (index - Suc 0))) (take (ladder_n L index) D)) (ladder_j L index)
         (ladder_\<gamma> (\<delta>@\<alpha>) D L index)" using introsAt
         by (metis LeftDerivationIntrosAt_def One_nat_def)
       then have ldintro: "LeftDerivationIntro (\<delta>@(ladder_\<alpha> \<alpha> D' L' index)) (ladder_i L index)
         (snd (D ! ladder_n L (index - Suc 0))) (ladder_ix L index)
         (drop (Suc (ladder_n L (index - Suc 0))) (take (ladder_n L index) D)) (ladder_j L index)
         (ladder_\<gamma> (\<delta>@\<alpha>) D L index)"
         using D' L' LeftDerivationLadder_cut_prefix_propagate derivation_ge_\<delta> index_upper_bound 
           is_word_\<delta> ladder ladder_i_0 length_L' by auto 
       have dge: "derivation_ge (drop (Suc (ladder_n L (index - Suc 0))) 
         (take (ladder_n L index) D)) (length \<delta>)" using derivation_ge_\<delta>
         by (metis append_take_drop_id derivation_ge_append)
       have \<delta>_le_i_L: "length \<delta> \<le> ladder_i L index"
         using derivation_ge_ladder index_upper_bound length_L' by auto        
       from LeftDerivationIntro_cut_prefix[OF ldintro dge \<delta>_le_i_L is_word_\<delta>] obtain \<gamma>' where \<gamma>':
          "ladder_\<gamma> (\<delta> @ \<alpha>) D L index = \<delta> @ \<gamma>' \<and>
            LeftDerivationIntro (ladder_\<alpha> \<alpha> D' L' index) (ladder_i L index - length \<delta>)
            (snd (D ! ladder_n L (index - Suc 0))) (ladder_ix L index)
            (derivation_shift (drop (Suc (ladder_n L (index - Suc 0))) (take (ladder_n L index) D)) 
            (length \<delta>) 0) (ladder_j L index - length \<delta>) \<gamma>'" by blast
       have h1: "ladder_i L' index = ladder_i L index - length \<delta>"
         using L' ladder_cut_prefix_i ladder_i_L'_as_L by blast 
       have h2: "(snd (D' ! ladder_n L' (index - Suc 0))) = (snd (D ! ladder_n L (index - Suc 0)))"
         apply (subst L', subst ladder_cut_prefix_n)
         apply (simp add: index_Suc_upper_bound_L)
         using length_L_gr_0 apply auto[1]
         apply (subst D')
         apply (simp add: derivation_shift_def)
         using index_lower_bound index_upper_bound is_ladder_D_L ladder_n_minus_1_bound 
           length_L' by auto
       have h3: "ladder_ix L' index = ladder_ix L index"
         using ladder_cut_prefix_ix L' index_upper_bound length_L' length_L_gr_0 by auto 
       have h4: "(drop (Suc (ladder_n L' (index - Suc 0))) (take (ladder_n L' index) D')) = 
         (derivation_shift (drop (Suc (ladder_n L (index - Suc 0))) (take (ladder_n L index) D)) 
            (length \<delta>) 0)"
         apply (subst D')
         apply (subst L')+
         apply (subst ladder_cut_prefix_n, simp add: index_Suc_upper_bound_L)
         using length_L_gr_0 apply blast
         apply (subst ladder_cut_prefix_n)
         using index_upper_bound length_L' apply arith
         using length_L_gr_0 apply blast
         apply (simp add: derivation_shift_def)
         by (simp add: drop_map take_map)
       have h5: "ladder_j L' index = ladder_j L index - length \<delta>"
         using ladder_cut_prefix_j L' index_upper_bound length_L' length_L_gr_0 by auto 
       have h6: "ladder_\<gamma> \<alpha> D' L' index = \<gamma>'"
         using D' L' LeftDerivationLadder_cut_prefix_propagate \<gamma>' derivation_ge_\<delta> index_upper_bound 
           is_word_\<delta> ladder ladder_i_0 length_L' by auto    
       show ?thesis using h1 h2 h3 h4 h5 h6 \<gamma>' by simp
     qed
     then have "LeftDerivationIntrosAt \<alpha> D' L' index"
       apply (auto simp add: LeftDerivationIntrosAt_def Let_def)
       using ladder_i_L' by blast
   }
   note is_ladder_5 = this
   show ?thesis
     apply (rule_tac x="D'" in exI)
     apply (rule_tac x="L'" in exI)
     apply (rule_tac x="\<gamma>'" in exI)
     apply auto
     using \<gamma>_def apply blast
     defer 1
     using D' apply blast
     using L' ladder_cut_prefix_length apply auto[1]
     apply (subst ladder_i_L'_thm)
     using LeftDerivationLadder_def is_ladder_def ladder apply blast 
     apply simp
     apply (simp add: ladder_last_j_def)
     apply (subst ladder_j_L'_thm)
     apply (simp add: length_L')
     using length_L_nonzero apply arith
     apply (simp add: length_L')
     apply (auto simp add: LeftDerivationLadder_def)
     using \<alpha>_\<gamma>' apply blast
     apply (auto simp add: is_ladder_def)
     using length_L_nonzero length_L' apply auto[1]
     using is_ladder_1 apply blast
     using is_ladder_2 apply blast
     using is_ladder_3 apply blast
     using is_ladder_4 apply blast
     by (auto simp add: LeftDerivationIntros_def is_ladder_5)
 qed
 
 end
 
 end
diff --git a/thys/LocalLexing/TheoremD10.thy b/thys/LocalLexing/TheoremD10.thy
--- a/thys/LocalLexing/TheoremD10.thy
+++ b/thys/LocalLexing/TheoremD10.thy
@@ -1,540 +1,540 @@
 theory TheoremD10
 imports TheoremD9 Ladder
 begin
 
 context LocalLexing begin
 
 lemma \<P>_wellformed: "p \<in> \<P> k u \<Longrightarrow> wellformed_tokens p"
 using \<P>_are_admissible admissible_wellformed_tokens by blast
 
 lemma \<X>_token_length: "t \<in> \<X> k \<Longrightarrow> k + length (chars_of_token t) \<le> length Doc"
-by (metis Nat.le_diff_conv2 \<X>_is_prefix add.commute chars_of_token_def empty_\<X> 
+by (metis le_diff_conv2 \<X>_is_prefix add.commute chars_of_token_def empty_\<X> 
   empty_iff is_prefix_length le_neq_implies_less length_drop linear)
 
 lemma mono_Scan: "mono (Scan T k)"
   by (simp add: Scan_regular regular_implies_mono)
 
 lemma \<pi>_apply_setmonotone: "x \<in> I \<Longrightarrow> x \<in> \<pi> k T I"
 using Complete_subset_\<pi> LocalLexing.Complete_def LocalLexing_axioms by blast
 
 lemma Scan_apply_setmonotone: "x \<in> I \<Longrightarrow> x \<in> Scan T k I"
   by (simp add: Scan_def)
   
   
 lemma leftderives_padfront:
   assumes "leftderives \<alpha> \<beta>"
   assumes "is_word u"
   shows "leftderives (u@\<alpha>) (u@\<beta>)"
 using LeftDerivation_append_prefix LeftDerivation_implies_leftderives assms(1) assms(2) 
   leftderives_implies_LeftDerivation by blast
 
 lemma leftderives_padback:
   assumes "leftderives \<alpha> \<beta>"
   assumes "is_sentence u"
   shows "leftderives (\<alpha>@u) (\<beta>@u)"
 using LeftDerivation_append_suffix LeftDerivation_implies_leftderives assms(1) assms(2) 
   leftderives_implies_LeftDerivation by blast
 
 lemma leftderives_pad:
   assumes \<alpha>_\<beta>: "leftderives \<alpha> \<beta>"
   assumes is_word: "is_word u"
   assumes is_sentence: "is_sentence v"
   shows "leftderives (u@\<alpha>@v) (u@\<beta>@v)"
 by (simp add: \<alpha>_\<beta> is_sentence is_word leftderives_padback leftderives_padfront)    
 
 lemma leftderives_rule:
   assumes "(N, w) \<in> \<RR>"
   shows "leftderives [N] w"
 by (metis append_Nil append_Nil2 assms is_sentence_def is_word_terminals leftderives1_def 
   leftderives1_implies_leftderives list.pred_inject(1) terminals_empty wellformed_tokens_empty_path)
 
 lemma leftderives_rule_step:
   assumes ld: "leftderives a (u@[N]@v)"
   assumes rule: "(N, w) \<in> \<RR>"
   assumes is_word: "is_word u"
   assumes is_sentence: "is_sentence v"
   shows "leftderives a (u@w@v)"
 proof -
   have N_w: "leftderives [N] w" using rule leftderives_rule by blast
   then have "leftderives (u@[N]@v) (u@w@v)" using leftderives_pad is_word is_sentence by blast
   then show "leftderives a (u@w@v)" using leftderives_trans ld by blast    
 qed
 
 lemma leftderives_trans_step:
   assumes ld: "leftderives a (u@b@v)"
   assumes rule: "leftderives b c"
   assumes is_word: "is_word u"
   assumes is_sentence: "is_sentence v"
   shows "leftderives a (u@c@v)"
 proof -
   have "leftderives (u@b@v) (u@c@v)" using leftderives_pad ld rule is_word is_sentence by blast
   then show ?thesis using leftderives_trans ld by blast
 qed
 
 lemma charslength_of_prefix:
   assumes "is_prefix a b"
   shows "charslength a \<le> charslength b"
 by (simp add: assms is_prefix_chars is_prefix_length)
 
 lemma item_rhs_simp[simp]: "item_rhs (Item (N, \<alpha>) d i j) = \<alpha>"
   by (simp add: item_rhs_def)
 
 definition Prefixes :: "'a list \<Rightarrow> 'a list set"
 where
   "Prefixes p = { q . is_prefix q p }"
 
 lemma \<PP>_wellformed: "p \<in> \<PP> \<Longrightarrow> wellformed_tokens p"
   by (simp add: \<PP>_are_admissible admissible_wellformed_tokens)
     
 lemma Prefixes_reflexive[simp]: "p \<in> Prefixes p"
   by (simp add: Prefixes_def is_prefix_def)
 
 lemma Prefixes_is_prefix: "q \<in> Prefixes p = is_prefix q p"
   by (simp add: Prefixes_def)
 
 lemma prefixes_are_paths': "p \<in> \<PP> \<Longrightarrow> is_prefix q p \<Longrightarrow> q \<in> \<PP>"
   using \<P>.simps(3) \<PP>_def prefixes_are_paths by blast
 
 lemma thmD10_ladder:
   "p \<in> \<PP> \<Longrightarrow> 
    charslength p = k \<Longrightarrow> 
    X \<in> T \<Longrightarrow> 
    T \<subseteq> \<X> k \<Longrightarrow> 
    (N, \<alpha>@\<beta>) \<in> \<RR> \<Longrightarrow>
    r \<le> length p \<Longrightarrow> 
    leftderives [\<SS>] ((terminals (take r p))@[N]@\<gamma>) \<Longrightarrow>
    LeftDerivationLadder \<alpha> D L (terminals ((drop r p)@[X])) \<Longrightarrow> 
    ladder_last_j L = length (drop r p) \<Longrightarrow> 
    k' = k + length (chars_of_token X) \<Longrightarrow>
    x = Item (N, \<alpha>@\<beta>) (length \<alpha>) (charslength (take r p)) k' \<Longrightarrow>
    I = items_le k' (\<pi> k' {} (Scan T k (Gen (Prefixes p)))) 
    \<Longrightarrow> x \<in> I"
 proof (induct "length L" arbitrary: N \<alpha> \<beta> r \<gamma> D L x rule: less_induct)
   case less
     have item_origin_x_def: "item_origin x = (charslength (take r p))"
       by (simp add: less.prems(11)) 
     then have x_k: "item_origin x \<le> k"
       using charslength.simps is_prefix_chars is_prefix_length is_prefix_take less.prems(2) by force 
     have item_end_x_def: "item_end x = k'" by (simp add: less.prems(11)) 
     have item_dot_x_def: "item_dot x = length \<alpha>" by (simp add: less.prems(11))  
     have k'_upperbound: "k' \<le> length Doc"
       using \<X>_token_length less.prems(10) less.prems(3) less.prems(4) by blast 
     note item_def = less.prems(11) 
     note k' = less.prems(10)
     note rule_dom = less.prems(5)
     note p_charslength = less.prems(2)
     note p_dom = less.prems(1)
     note r = less.prems(6)
     note leftderives_start = less.prems(7)
     note X_dom = less.prems(3)
     have wellformed_x: "wellformed_item x"
       apply (auto simp add: wellformed_item_def item_def rule_dom p_charslength)
       apply (subst k')
       apply (subst charslength.simps[symmetric])
       apply (subst p_charslength[symmetric])
       using item_origin_x_def p_charslength x_k apply linarith
       apply (rule k'_upperbound)
       done
     have  leftderives_\<alpha>: "leftderives \<alpha> (terminals ((drop r p)@[X]))"
       using LeftDerivationLadder_def LeftDerivation_implies_leftderives less.prems(8) by blast  
     have is_sentence_drop_pX: "is_sentence (drop r (terminals p) @ [terminal_of_token X])"
       by (metis derives_is_sentence is_sentence_concat leftderives_\<alpha> leftderives_implies_derives 
         rule_\<alpha>_type rule_dom terminals_append terminals_drop terminals_singleton)
     have snd_item_rule_x: "snd (item_rule x) = \<alpha>@\<beta>" by (simp add: item_def)
     from less have "is_ladder D L" using LeftDerivationLadder_def by blast 
     then have "length L \<noteq> 0" by (simp add: is_ladder_not_empty) 
     then have "length L = 1 \<or> length L > 1" by arith
     then show ?case 
     proof (induct rule: disjCases2)
       case 1
         have "\<exists> i. LeftDerivationFix \<alpha> i D (length (drop r p)) (terminals ((drop r p)@[X]))"
           using "1.hyps" LeftDerivationLadder_L_0 less.prems(8) less.prems(9) by fastforce 
         then obtain i where LDF:
           "LeftDerivationFix \<alpha> i D (length (drop r p)) (terminals ((drop r p)@[X]))" by blast
         from LeftDerivationFix_splits_at_derives[OF this] obtain U a1 a2 b1 b2 where decompose:
           "splits_at \<alpha> i a1 U a2 \<and> splits_at (terminals (drop r p @ [X])) 
             (length (drop r p)) b1 U b2 \<and> derives a1 b1 \<and> derives a2 b2" by blast
         then have b1: "b1 = terminals (drop r p)"
           by (simp add: append_eq_conv_conj splits_at_def)
         with decompose have U: "U = fst X"
           by (metis length_terminals nth_append_length splits_at_def terminal_of_token_def 
             terminals_append terminals_singleton)
         from decompose b1 U have b2: "b2 = []"
           by (simp add: splits_at_combine splits_at_def)
         have D: "LeftDerivation \<alpha> D (terminals ((drop r p)@[X]))" 
           using LDF LeftDerivationLadder_def less.prems(8) by blast 
         let ?y = "Item (item_rule x) (length a1) (item_origin x) k"
         have wellformed_y: "wellformed_item ?y"
           using wellformed_x
           apply (auto simp add: wellformed_item_def x_k)
           using k' k'_upperbound apply arith
           apply (simp add: item_rhs_def snd_item_rule_x)
           using decompose splits_at_def
           by (simp add: is_prefix_length trans_le_add1) 
         have y_nonterminal: "item_nonterminal ?y = N"
           by (simp add: item_def item_nonterminal_def)   
         have item_\<alpha>_y: "item_\<alpha> ?y = a1"
           by (metis append_assoc append_eq_conv_conj append_take_drop_id decompose item.sel(1) 
             item.sel(2) item_\<alpha>_def item_rhs_def snd_item_rule_x splits_at_def)    
         have pvalid_y: "pvalid p ?y"
           apply (auto simp add: pvalid_def)
           using p_dom \<PP>_wellformed apply blast
           using wellformed_y apply auto[1]
           apply (rule_tac x=r in exI)
           apply (auto simp add: r)
           using p_charslength apply simp
           using item_def apply simp
           apply (rule_tac x=\<gamma> in exI)
           using y_nonterminal apply simp
           using is_derivation_def leftderives_start apply auto[1]
           apply (simp add: item_\<alpha>_y)
           using b1 decompose by auto
         let ?z = "inc_item ?y k'"
         have item_rhs_y: "item_rhs ?y = \<alpha>@\<beta>"
           by (simp add: item_def item_rhs_def)
         have split_\<alpha>: "\<alpha> = a1@[U]@a2" using decompose splits_at_combine by blast 
         have next_symbol_y: "next_symbol ?y = Some(fst X)"  
           by (auto simp add: next_symbol_def is_complete_def item_rhs_y split_\<alpha> U)
         have z_in_Scan_y: "?z \<in> Scan T k {?y}" 
           apply (simp add: Scan_def)
           apply (rule disjI2)
           apply (rule_tac x="?y" in exI)
           apply (rule_tac x="fst X" in exI)
           apply (rule_tac x="snd X" in exI)
           apply (auto simp add: bin_def X_dom)
           using k' chars_of_token_def apply simp
           using next_symbol_y apply simp
           done
         from pvalid_y have "?y \<in> Gen(Prefixes p)"
           apply (simp add: Gen_def)
           apply (rule_tac x=p in exI)
           by (auto simp add: paths_le_def p_dom)
         then have "Scan T k {?y} \<subseteq> Scan T k (Gen(Prefixes p))"
           apply (rule_tac monoD[OF mono_Scan])
           apply blast
           done
         with z_in_Scan_y have z_in_Scan_Gen: "?z \<in> Scan T k (Gen(Prefixes p))"
           using rev_subsetD by blast
         have wellformed_z: "wellformed_item ?z"
           using k' k'_upperbound next_symbol_y wellformed_inc_item wellformed_y by auto
         have item_\<beta>_z: "item_\<beta> ?z = a2@\<beta>"
           apply (simp add: item_\<beta>_def)
           apply (simp add: item_rhs_y split_\<alpha>)
           done
         have item_end_z: "item_end ?z = k'" by simp
         have x_via_z: "x = inc_dot (length a2) ?z"
           by (simp add: inc_dot_def less.prems(11) split_\<alpha>)
         have x_in_z: "x \<in> \<pi> k' {} {?z}"
           apply (subst x_via_z)
           apply (rule_tac thmD6[OF wellformed_z item_\<beta>_z item_end_z])
           using decompose b2 by blast  
         have "\<pi> k' {} {?z} \<subseteq> \<pi> k' {} (Scan T k (Gen(Prefixes p)))"
           apply (rule_tac monoD[OF mono_\<pi>])
           using z_in_Scan_Gen using empty_subsetI insert_subset by blast 
         then have x_in_Scan_Gen: "x \<in> \<pi> k' {} (Scan T k (Gen(Prefixes p)))"
           using x_in_z by blast
         have "item_end x = k'" by (simp add: item_end_x_def)
         with x_in_Scan_Gen show ?case
           using items_le_def less.prems(12) mem_Collect_eq nat_le_linear by blast
     next
       case 2
         obtain i where i: "i = ladder_i L 0" by blast
         obtain i' where i': "i' = ladder_j L 0" by blast
         obtain \<alpha>' where \<alpha>': "\<alpha>' = ladder_\<gamma> \<alpha> D L 0" by blast
         obtain n where n: "n = ladder_n L 0" by blast
         have ldfix: "LeftDerivationFix \<alpha> i (take n D)  i' \<alpha>'"
           using LeftDerivationLadder_def \<alpha>' i i' n less.prems(8) by blast 
         have \<alpha>'_alt: "\<alpha>' = ladder_\<alpha> \<alpha> D L 1" using 2 by (simp add: \<alpha>' ladder_\<alpha>_def) 
         have i'_alt: "i' = ladder_i L 1" using 2 by (simp add: i' ladder_i_def)
         obtain e where e: "e = D ! n" by blast
         obtain ix where ix: "ix = ladder_ix L 1" by blast
         obtain m where m: "m = ladder_n L 1" by blast
         obtain E where E: "E = drop (Suc n) (take m D)" by blast
         have ldintro: "LeftDerivationIntro \<alpha>' i' (snd e) ix E (ladder_j L 1) (ladder_\<gamma> \<alpha> D L 1)"
           by (metis "2.hyps" LeftDerivationIntrosAt_def LeftDerivationIntros_def 
             LeftDerivationLadder_def One_nat_def \<alpha>'_alt E diff_Suc_1 e i'_alt ix leI 
             less.prems(8) m n not_less_eq zero_less_one)
         have is_nonterminal_\<alpha>'_at_i': "is_nonterminal (\<alpha>' ! i')"
           using LeftDerivationIntro_implies_nonterminal ldintro by blast   
         then have is_nonterminal_\<alpha>_at_i: "is_nonterminal (\<alpha> ! i)" 
           using LeftDerivationFix_def ldfix by auto
         then have "\<exists> A a1 a2 a1'. splits_at \<alpha> i a1 A a2 \<and> splits_at \<alpha>' i' a1' A a2 \<and>
           LeftDerivation a1 (take n D) a1'"
           using LeftDerivationFix_splits_at_nonterminal ldfix by auto
         then obtain A a1 a2 a1' where A: "splits_at \<alpha> i a1 A a2 \<and> splits_at \<alpha>' i' a1' A a2 \<and>
           LeftDerivation a1 (take n D) a1'" by blast
         have A_def: "A = \<alpha>' ! i'" using A splits_at_def by blast 
         have is_nonterminal_A: "is_nonterminal A" using A_def is_nonterminal_\<alpha>'_at_i' by blast
         have "\<exists> rule. e = (i', rule)"
           by (metis e "2.hyps" LeftDerivationIntrosAt_def LeftDerivationIntros_def 
             LeftDerivationLadder_def One_nat_def Suc_leI diff_Suc_1 i'_alt less.prems(8) 
             n prod.collapse zero_less_one) 
         then obtain rule where rule: "e = (i', rule)" by blast
         obtain w where w: "w = snd rule" by blast
         obtain \<alpha>'' where \<alpha>'': "\<alpha>'' = a1' @ w @ a2" by blast
         have \<alpha>'_\<alpha>'': "LeftDerives1 \<alpha>' i' rule \<alpha>''"
           by (metis A w LeftDerivationFix_is_sentence LeftDerivationIntro_def 
             LeftDerivationIntro_examine_rule LeftDerives1_def \<alpha>'' ldfix ldintro prod.collapse 
             rule snd_conv splits_at_implies_Derives1) 
         then have is_word_a1': "is_word a1'" using LeftDerives1_splits_at_is_word A by blast
         have A_eq_fst_rule: "A = fst rule"
           using A LeftDerivationIntro_examine_rule ldintro rule by fastforce 
         have ix_bound: "ix < length w" using ix w rule ldintro LeftDerivationIntro_def snd_conv 
           by auto      
         then have "\<exists> w1 W w2. splits_at w ix w1 W w2" using splits_at_def by blast 
         then obtain w1 W w2 where W: "splits_at w ix w1 W w2" by blast
         have a1'_w_a2: "a1'@w@a2 = ladder_stepdown_\<alpha>_0 \<alpha> D L" 
           using ladder_stepdown_\<alpha>_0_altdef "2.hyps" A \<alpha>'_alt e i'_alt less.prems(8) n rule 
           snd_conv w by force 
         from LeftDerivationLadder_stepdown[OF less.prems(8) 2] obtain L' where L':
           "LeftDerivationLadder (a1'@(w@a2)) (drop (ladder_stepdown_diff L) D) L'
            (terminals (drop r p @ [X])) \<and>
            length L' = length L - 1 \<and>
            ladder_i L' 0 = ladder_i L 1 + ladder_ix L 1 \<and> ladder_last_j L' = ladder_last_j L"
           using a1'_w_a2 by auto
         have ladder_i_L'_0: "ladder_i L' 0 = i' + ix" using L' i'_alt ix by auto
         have ladder_last_j_L': "ladder_last_j L' = length (drop r p)" using L' less.prems by auto
         from L' have this1: "LeftDerivationLadder (a1'@(w@a2)) (drop (ladder_stepdown_diff L) D) L'
            (terminals (drop r p @ [X]))" by blast
         have this2: "length a1' \<le> ladder_i L' 0" using A ladder_i_L'_0 splits_at_def by auto     
         from LeftDerivationLadder_cut_prefix[OF this1 is_word_a1' this2]
         obtain D' L'' \<gamma>' where L'':
           "terminals (drop r p @ [X]) = a1' @ \<gamma>' \<and>
             LeftDerivationLadder (w @ a2) D' L'' \<gamma>' \<and>
             D' = derivation_shift (drop (ladder_stepdown_diff L) D) (length a1') 0 \<and>
             length L'' = length L' \<and>
             ladder_i L'' 0 + length a1' = ladder_i L' 0 \<and> 
             ladder_last_j L'' + length a1' = ladder_last_j L'" by blast
         have length_a1'_bound: "length a1' \<le> length (drop r p)" using L'' ladder_last_j_L' 
           by linarith
         then have is_prefix_a1'_drop_r_p: "is_prefix a1' (terminals (drop r p))"
         proof -
           have f1: "\<forall>ss ssa ssb. \<not> is_prefix (ss::symbol list) (ssa @ ssb) \<or> is_prefix ss ssa \<or> (\<exists>ssc. ssc \<noteq> [] \<and> is_prefix ssc ssb \<and> ss = ssa @ ssc)"
             by (simp add: is_prefix_of_append)
           have f2: "\<And>ss ssa. is_prefix ((ss::symbol list) @ ssa) ss \<or> \<not> is_prefix ssa []"
             by (metis (no_types) append_Nil2 is_prefix_cancel)
           have f3: "\<And>ss. is_prefix ss [] \<or> \<not> is_prefix (terminals (drop r p) @ ss) a1'"
             by (metis (no_types) drop_eq_Nil is_prefix_append length_a1'_bound length_terminals)
           have "is_prefix a1' (a1' @ \<gamma>') \<and> is_prefix a1' a1'"
             by (metis (no_types) append_Nil2 is_prefix_cancel is_prefix_empty)
           then show ?thesis
             using f3 f2 f1 by (metis L'' terminals_append)
         qed 
         obtain r' where r': "r' = r + i'" by blast
         have length_a1'_eq_i': "length a1' = i'"
           using A less_or_eq_imp_le min.absorb2 splits_at_def by auto      
         have a1'_r': "r \<le> r' \<and> r' \<le> length p \<and> 
           terminals (drop r p) = a1' @ (terminals (drop r' p))"
           using is_prefix_a1'_drop_r_p r'
         proof -
           have "\<exists> q. terminals (drop r p) = a1' @ q"
             using is_prefix_a1'_drop_r_p by (metis is_prefix_unsplit)
           then obtain q where q: "terminals (drop r p) = a1' @ q" by blast
           have "q = drop i' (terminals (drop r p))"
             using length_a1'_eq_i' q by (simp add: append_eq_conv_conj)
           then have "q = terminals (drop i' (drop r p))" by simp
           then have "q = terminals (drop r' p)" by (simp add: r' add.commute)
           with q show ?thesis
             using add.commute diff_add_inverse le_Suc_ex le_add1 le_diff_conv length_a1'_bound 
               length_a1'_eq_i' length_drop r r' by auto
         qed    
         have ladder_i_L'': "ladder_i L'' 0 = ix" using L'' ladder_i_L'_0 length_a1'_eq_i' 
           add.commute add_left_cancel by linarith 
         have L''_ladder: "LeftDerivationLadder (w @ a2) D' L'' \<gamma>'" using L'' by blast
         have "ladder_i L'' 0 < length w" using ladder_i_L'' ix_bound by blast 
         from LeftDerivationLadder_cut_appendix[OF L''_ladder this] 
         obtain E' F' \<gamma>1' \<gamma>2' L''' where L''':
           "D' = E' @ F' \<and>
            \<gamma>' = \<gamma>1' @ \<gamma>2' \<and>
            LeftDerivationLadder w E' L''' \<gamma>1' \<and>
            derivation_ge F' (length \<gamma>1') \<and>
            LeftDerivation a2 (derivation_shift F' (length \<gamma>1') 0) \<gamma>2' \<and>
            length L''' = length L'' \<and> ladder_i L''' 0 = ladder_i L'' 0 \<and> 
            ladder_last_j L''' = ladder_last_j L''"
           by blast
         obtain z where z: "z = Item (A, w) (length w) (charslength (take r' p)) k'" by blast       
         have z1: "length L''' < length L" using "2.hyps" L' L'' L''' by linarith
         have z2: "p \<in> \<PP>" by (simp add: p_dom) 
         have z3: "charslength p = k" using p_charslength by auto 
         have z4: "X \<in> T" by (simp add: X_dom) 
         have z5: "T \<subseteq> \<X> k" by (simp add: less.prems(4)) 
         have "rule \<in> \<RR>"
           using Derives1_rule LeftDerives1_implies_Derives1 \<alpha>'_\<alpha>'' by blast 
         then have z6: "(A, w @ []) \<in> \<RR>" using w A_eq_fst_rule by auto
         have z7: "r' \<le> length p" using a1'_r' by linarith
         have "leftderives [\<SS>] ((terminals (take r p))@[N]@\<gamma>)"
           using leftderives_start by blast 
         then have "leftderives [\<SS>] ((terminals (take r p))@(\<alpha>@\<beta>)@\<gamma>)"
           by (metis \<PP>_wellformed is_derivation_def is_derivation_is_sentence is_sentence_concat 
             is_word_terminals_take leftderives_implies_derives leftderives_rule_step p_dom rule_dom)
         then have "leftderives [\<SS>] ((terminals (take r p))@a1@([A]@a2@\<beta>)@\<gamma>)"
           using A splits_at_combine append_assoc by fastforce 
         then have z8_helper: "leftderives [\<SS>] ((terminals (take r p))@a1'@([A]@a2@\<beta>)@\<gamma>)"
           by (meson A LeftDerivation_implies_leftderives \<PP>_wellformed is_derivation_def 
             is_derivation_is_sentence is_sentence_concat is_word_terminals_take 
             leftderives_implies_derives leftderives_trans_step p_dom)
         have join_terminals: "(terminals (take r p))@a1' = terminals (take r' p)"
           by (metis is_prefix_a1'_drop_r_p length_a1'_eq_i' r' take_add take_prefix 
             terminals_drop terminals_take)  
         from z8_helper join_terminals have z8: 
           "leftderives [\<SS>] (terminals (take r' p) @ [A] @ a2 @ \<beta> @ \<gamma>)"
           by (metis append_assoc) 
         have \<gamma>'_altdef: "\<gamma>' = terminals (drop r' p @ [X])"
           using L'' a1'_r' by auto
         have "ladder_last_j L''' + length a1' = length (drop r p)"
           using L'' L''' ladder_last_j_L' by linarith 
         then have ladder_last_j_L'''_\<gamma>': "ladder_last_j L''' = length \<gamma>' - 1"
           by (simp add: \<gamma>'_altdef length_a1'_eq_i' r')
         then have "length \<gamma>' - 1 < length \<gamma>1'"
           using L''' ladder_last_j_bound by fastforce 
         then have "length \<gamma>1' + length \<gamma>2' - 1 < length \<gamma>1'" 
           using L''' by simp
         then have "length \<gamma>2' = 0" by arith
         then have \<gamma>2': "\<gamma>2' = []" by simp
         then have \<gamma>1': "\<gamma>1' = terminals (drop r' p @ [X])" using \<gamma>'_altdef L''' by auto   
         then have z9: "LeftDerivationLadder w E' L''' (terminals (drop r' p @ [X]))"
           using L''' by blast
         have z10: "ladder_last_j L''' = length (drop r' p)" 
           using \<gamma>'_altdef ladder_last_j_L'''_\<gamma>' by auto
         note z11 = k'
         have z12: "z = Item (A, w @ []) (length w) (charslength (take r' p)) k'"
           using z by simp
         note z13 = less.prems(12)
         note induct = less.hyps(1)[of L''' A w "[]" r' "a2@\<beta>@\<gamma>" E' z]
         note z_in_I = induct[OF z1 z2 z3 z4 z5 z6 z7 z8 z9 z10 z11 z12 z13]
         have a2_derives_empty: "derives a2 []" using L''' \<gamma>2'
           using LeftDerivation_implies_leftderives leftderives_implies_derives by blast 
         obtain x1 where x1: "x1 = Item (N, \<alpha>@\<beta>) (length a1) 
           (charslength (take r p)) (charslength (take r' p))" by blast
         obtain q where q: "q = take r' p" by blast
         then have is_prefix_q_p: "is_prefix q p" by simp 
         then have q_in_Prefixes: "q \<in> Prefixes p" using Prefixes_is_prefix by blast
         then have wellformed_q: "wellformed_tokens q"
           using p_dom is_prefix_q_p prefixes_are_paths' \<PP>_wellformed by blast   
         have item_rule_x1: "item_rule x1 = (N, \<alpha>@\<beta>)" 
           using x1 by simp
         have is_prefix_r_r': "is_prefix (take r p) (take r' p)"
           by (metis append_eq_conv_conj is_prefix_take r' take_add)          
         then have charslength_le_r_r': "charslength (take r p) \<le> charslength (take r' p)"
           using charslength_of_prefix by blast
         have "is_prefix (take r' p) p" by auto
         then have charslength_r'_p: "charslength (take r' p) \<le> charslength p"
           using charslength_of_prefix by blast
         have "charslength p \<le> length Doc"
           using less.prems(1) add_leE k' k'_upperbound z3 by blast
         with charslength_r'_p have charslength_r'_Doc: 
           "charslength (take r' p) \<le> length Doc" by arith
         have \<alpha>_decompose: "\<alpha> = a1 @ [A] @ a2" using A splits_at_combine by blast 
         have wellformed_x1: "wellformed_item x1"
           apply (auto simp add: wellformed_item_def)
           using item_rule_x1 less.prems apply auto[1]
           using charslength_le_r_r' x1 apply auto[1]
           using charslength_r'_Doc x1 apply auto[1]
           using x1 \<alpha>_decompose by simp
         have item_nonterminal_x1: "item_nonterminal x1 = N"
           by (simp add: x1 item_nonterminal_def)
         have r_q_p: "take r (terminals q) = terminals (take r p)"
           by (metis q is_prefix_r_r' length_take min.absorb2 r take_prefix terminals_take) 
         have item_\<alpha>_x1: "item_\<alpha> x1 = a1" by (simp add: \<alpha>_decompose item_\<alpha>_def x1)
         have a1': "a1' = drop r (terminals q)"
           by (metis append_eq_conv_conj join_terminals length_take length_terminals min.absorb2 q r)         
         have pvalid_q_x1: "pvalid q x1"
           apply (simp add: pvalid_def wellformed_q wellformed_x1 item_nonterminal_x1)
           apply (rule_tac x=r in exI)
           apply auto
           apply (simp add: a1'_r' min.absorb2 q)
           apply (simp add: q x1)
           apply (simp add: q x1 r')
           using r_q_p less.prems(7) append_Cons is_leftderivation_def 
             leftderivation_implies_derivation apply fastforce 
           apply (simp add: item_\<alpha>_x1)
           using a1' A LeftDerivation_implies_leftderives leftderives_implies_derives by blast 
         have item_end_x1_le_k': "item_end x1 \<le> k'"
           using charslength_r'_p
           apply (simp add: x1)
           using less.prems by auto
         have x1_in_I: "x1 \<in> I"
           apply (subst less.prems(12))
           apply (auto simp add: items_le_def item_end_x1_le_k')
           apply (rule \<pi>_apply_setmonotone)
           apply (rule Scan_apply_setmonotone)
           apply (simp add: Gen_def)
           apply (rule_tac x=q in exI)
           by (simp add: pvalid_q_x1 paths_le_def q_in_Prefixes)
         obtain x2 where x2: "x2 = inc_item x1 k'" by blast
         have x1_in_bin: "x1 \<in> bin I (item_origin z)"
           using bin_def x1 x1_in_I z12 by auto           
         have x2_in_Complete: "x2 \<in> Complete k' I"
           apply (simp add: Complete_def)
           apply (rule disjI2)
           apply (rule_tac x=x1 in exI)
           apply (simp add: x2)
           apply (rule_tac x=z in exI)
           apply auto
           using x1_in_bin apply blast
           using bin_def z12 z_in_I apply auto[1]
           apply (simp add: is_complete_def z12)
           by (simp add: \<alpha>_decompose is_complete_def item_nonterminal_def next_symbol_def x1 z12)
         have wf_I': "wellformed_items (\<pi> k' {} (Scan T k (Gen (Prefixes p))))"
           by (simp add: wellformed_items_Gen wellformed_items_Scan wellformed_items_\<pi> z5)
         from items_le_Complete[OF this] x2_in_Complete
         have x2_in_I: "x2 \<in> I" by (metis Complete_\<pi>_fix z13) 
         have "wellformed_items I"
           using wf_I' items_le_is_filter wellformed_items_def z13 by auto
         with x2_in_I have wellformed_x2: "wellformed_item x2" 
           by (simp add: wellformed_items_def)
         have item_dot_x2: "item_dot x2 = Suc (length a1)"
           by (simp add: x2 x1)
         have item_\<beta>_x2: "item_\<beta> x2 = a2 @ \<beta>"
           apply (simp add: item_\<beta>_def item_dot_x2)
           apply (simp add: item_rhs_def x2 x1 \<alpha>_decompose)
           done  
         have item_end_x2: "item_end x2 = k'" by (simp add: x2)
         note inc_dot_x2_by_a2 = thmD6[OF wellformed_x2 item_\<beta>_x2 item_end_x2 a2_derives_empty]
         have "x = inc_dot (length a2) x2"
           by (simp add: \<alpha>_decompose inc_dot_def less.prems(11) x1 x2)
         with inc_dot_x2_by_a2 have "x \<in> \<pi> k' {} {x2}" by auto
         then have "x \<in> \<pi> k' {} I" using x2_in_I
           by (meson contra_subsetD empty_subsetI insert_subset monoD mono_\<pi>)
         then show "x \<in> I"
           by (metis (no_types, lifting) \<pi>_subset_elem_trans dual_order.refl item_end_x_def 
             items_le_def items_le_is_filter mem_Collect_eq z13) 
     qed
 qed       
 
 theorem thmD10:
   assumes p_dom: "p \<in> \<PP>"
   assumes p_charslength: "charslength p = k"
   assumes X_dom: "X \<in> T"
   assumes T_dom: "T \<subseteq> \<X> k"
   assumes rule_dom: "(N, \<alpha>@\<beta>) \<in> \<RR>"
   assumes r: "r \<le> length p"
   assumes leftderives_start: "leftderives [\<SS>] ((terminals (take r p))@[N]@\<gamma>)"
   assumes leftderives_\<alpha>: "leftderives \<alpha> (terminals ((drop r p)@[X]))"
   assumes k': "k' = k + length (chars_of_token X)"
   assumes item_def: "x = Item (N, \<alpha>@\<beta>) (length \<alpha>) (charslength (take r p)) k'"
   assumes I: "I = items_le k' (\<pi> k' {} (Scan T k (Gen (Prefixes p))))"
   shows "x \<in> I"
 proof -
   have "\<exists> D. LeftDerivation \<alpha> D (terminals ((drop r p)@[X]))"
     using leftderives_\<alpha> leftderives_implies_LeftDerivation by blast
   then obtain D where D: "LeftDerivation \<alpha> D (terminals ((drop r p)@[X]))" by blast
   have is_sentence: "is_sentence (terminals (drop r p @ [X]))"
     using derives_is_sentence is_sentence_concat leftderives_\<alpha> leftderives_implies_derives 
       rule_\<alpha>_type rule_dom by blast
   have "\<exists> L. LeftDerivationLadder \<alpha> D L  (terminals ((drop r p)@[X])) \<and>
          ladder_last_j L = length (drop r p)"
     apply (rule LeftDerivationLadder_exists)
     apply (rule D)
     apply (rule is_sentence)
     by auto
   then obtain L where L: "LeftDerivationLadder \<alpha> D L  (terminals ((drop r p)@[X]))" and
     L_ladder_last_j: "ladder_last_j L = length (drop r p)" by blast
   from thmD10_ladder[OF assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7)
     L L_ladder_last_j k' item_def I]
   show ?thesis .
 qed
 
 end
 
 end
diff --git a/thys/Probabilistic_Timed_Automata/PTA_Reachability.thy b/thys/Probabilistic_Timed_Automata/PTA_Reachability.thy
--- a/thys/Probabilistic_Timed_Automata/PTA_Reachability.thy
+++ b/thys/Probabilistic_Timed_Automata/PTA_Reachability.thy
@@ -1,2268 +1,2268 @@
 theory PTA_Reachability
   imports PTA
 begin
 
 section \<open>Classifying Regions for Divergence\<close>
 
 subsection \<open>Pairwise\<close>
 
 coinductive pairwise :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a stream \<Rightarrow> bool" for P where
   "P a b \<Longrightarrow> pairwise P (b ## xs) \<Longrightarrow> pairwise P (a ## b ## xs)"
 
 lemma pairwise_Suc:
   "pairwise P xs \<Longrightarrow> P (xs !! i) (xs !! (Suc i))"
   by (induction i arbitrary: xs) (force elim: pairwise.cases)+
 
 lemma Suc_pairwise:
   "\<forall> i. P (xs !! i) (xs !! (Suc i)) \<Longrightarrow> pairwise P xs"
   apply (coinduction arbitrary: xs)
   apply (subst stream.collapse[symmetric])
   apply (rewrite in "stl _" stream.collapse[symmetric])
   apply (intro exI conjI, rule HOL.refl)
    apply (erule allE[where x = 0]; simp; fail)
   by simp (metis snth.simps(2))
 
 lemma pairwise_iff:
   "pairwise P xs \<longleftrightarrow> (\<forall> i. P (xs !! i) (xs !! (Suc i)))"
 using pairwise_Suc Suc_pairwise by blast
 
 lemma pairwise_stlD:
   "pairwise P xs \<Longrightarrow> pairwise P (stl xs)"
 by (auto elim: pairwise.cases)
 
 lemma pairwise_pairD:
   "pairwise P xs \<Longrightarrow> P (shd xs) (shd (stl xs))"
 by (auto elim: pairwise.cases)
 
 lemma pairwise_mp:
   assumes "pairwise P xs" and lift: "\<And> x y. x \<in> sset xs \<Longrightarrow> y \<in> sset xs \<Longrightarrow> P x y \<Longrightarrow> Q x y"
   shows "pairwise Q xs" using assms
  apply (coinduction arbitrary: xs)
  subgoal for xs
  apply (subst stream.collapse[symmetric])
  apply (rewrite in "stl _" stream.collapse[symmetric])
  apply (intro exI conjI)
   apply (rule HOL.refl)
  by (auto intro: stl_sset dest: pairwise_pairD pairwise_stlD)
 done
 
 lemma pairwise_sdropD:
   "pairwise P (sdrop i xs)" if "pairwise P xs"
   using that
 proof (coinduction arbitrary: i xs)
   case (pairwise i xs)
   then show ?case
     apply (inst_existentials "shd (sdrop i xs)" "shd (stl (sdrop i xs))" "stl (stl (sdrop i xs))")
     subgoal
       by (auto dest: pairwise_Suc) (metis sdrop_simps(1) sdrop_stl stream.collapse)
     subgoal
       by (inst_existentials "i - 1" "stl xs") (auto dest: pairwise_Suc pairwise_stlD)
     by (metis sdrop_simps(2) stream.collapse)
 qed
 
 
 subsection \<open>Regions\<close>
 
 (* XXX Move. Rename? *)
 lemma gt_GreaterD:
   assumes "u \<in> region X I r" "valid_region X k I r" "c \<in> X" "u c > k c"
   shows "I c = Greater (k c)"
 proof -
   from assms have "intv_elem c u (I c)" "valid_intv (k c) (I c)" by auto
   with assms(4) show ?thesis by (cases "I c") auto
 qed
 
 lemma const_ConstD:
   assumes "u \<in> region X I r" "valid_region X k I r" "c \<in> X" "u c = d" "d \<le> k c"
   shows "I c = Const d"
 proof -
   from assms have "intv_elem c u (I c)" "valid_intv (k c) (I c)" by auto
   with assms(4,5) show ?thesis by (cases "I c") auto
 qed
 
 lemma not_Greater_bounded:
   assumes "I x \<noteq> Greater (k x)" "x \<in> X" "valid_region X k I r" "u \<in> region X I r"
   shows "u x \<le> k x"
 proof -
   from assms have "intv_elem x u (I x)" "valid_intv (k x) (I x)" by auto
   with assms(1) show "u x \<le> k x" by (cases "I x") auto
 qed
 
 lemma Greater_closed:
   fixes t :: "real"
   assumes "u \<in> region X I r" "valid_region X k I r" "c \<in> X" "I c = Greater (k c)" "t > k c"
   shows "u(c := t) \<in> region X I r"
   using assms
   apply (intro region.intros)
      apply (auto; fail)
     apply standard
   subgoal for x
     by (cases "x = c"; cases "I x"; force intro!: intv_elem.intros)
   by auto
 
 lemma Greater_unbounded_aux:
   assumes "finite X" "valid_region X k I r" "c \<in> X" "I c = Greater (k c)"
   shows "\<exists> u \<in> region X I r. u c > t"
 using assms Greater_closed[OF _ assms(2-4)] 
 proof -
   let ?R = "region X I r"
   let ?t = "if t > k c then t + 1 else k c + 1"
   have t: "?t > k c" by auto
   from region_not_empty[OF assms(1,2)] obtain u where u: "u \<in> ?R" by auto
   from Greater_closed[OF this assms(2-4) t] have "u(c:=?t) \<in> ?R" by auto
   with t show ?thesis by (inst_existentials "u(c:=?t)") auto
 qed
 
 
 subsection \<open>Unbounded and Zero Regions\<close>
 
 definition "unbounded x R \<equiv> \<forall> t. \<exists> u \<in> R. u x > t"
 
 definition "zero x R \<equiv> \<forall> u \<in> R. u x = 0"
 
 lemma Greater_unbounded:
   assumes "finite X" "valid_region X k I r" "c \<in> X" "I c = Greater (k c)"
   shows "unbounded c (region X I r)"
 using Greater_unbounded_aux[OF assms] unfolding unbounded_def by blast
 
 lemma unbounded_Greater:
   assumes "valid_region X k I r" "c \<in> X" "unbounded c (region X I r)"
   shows "I c = Greater (k c)"
 using assms unfolding unbounded_def by (auto intro: gt_GreaterD)
 
 lemma Const_zero:
   assumes "c \<in> X" "I c = Const 0"
   shows "zero c (region X I r)"
 using assms unfolding zero_def by force
 
 lemma zero_Const:
   assumes "finite X" "valid_region X k I r" "c \<in> X" "zero c (region X I r)"
   shows "I c = Const 0"
 proof -
   from assms obtain u where "u \<in> region X I r" by atomize_elim (auto intro: region_not_empty)
   with assms show ?thesis unfolding zero_def by (auto intro: const_ConstD)
 qed
 
 lemma zero_all:
   assumes "finite X" "valid_region X k I r" "c \<in> X" "u \<in> region X I r" "u c = 0"
   shows "zero c (region X I r)"
 proof -
   from assms have "intv_elem c u (I c)" "valid_intv (k c) (I c)" by auto
   then have "I c = Const 0" using assms(5) by cases auto
   with assms have "u' c = 0" if "u' \<in> region X I r" for u' using that by force
   then show ?thesis unfolding zero_def by blast
 qed
 
 
 section \<open>Reachability\<close>
 
 subsection \<open>Definitions\<close>
 
 locale Probabilistic_Timed_Automaton_Regions_Reachability =
   Probabilistic_Timed_Automaton_Regions k v n not_in_X A
     for k v n not_in_X and A :: "('c, t, 's) pta" +
   fixes \<phi> \<psi> :: "('s * ('c, t) cval) \<Rightarrow> bool" fixes s
   assumes \<phi>: "\<And> x y. x \<in> S \<Longrightarrow> x ~ y \<Longrightarrow> \<phi> x \<longleftrightarrow> \<phi> y"
   assumes \<psi>: "\<And> x y. x \<in> S \<Longrightarrow> x ~ y \<Longrightarrow> \<psi> x \<longleftrightarrow> \<psi> y"
   assumes s[intro, simp]: "s \<in> S"
 begin
 
 definition "\<phi>' \<equiv> absp \<phi>"
 definition "\<psi>' \<equiv> absp \<psi>"
 definition "s' \<equiv> abss s"
 
 lemma s_s'_cfg_on[intro]:
   assumes "cfg \<in> MDP.cfg_on s"
   shows "absc cfg \<in> R_G.cfg_on s'"
 proof -
   from assms s have "cfg \<in> valid_cfg" unfolding MDP.valid_cfg_def by auto
   then have "absc cfg \<in> R_G.cfg_on (state (absc cfg))" by (auto intro: R_G.valid_cfgD)
   with assms show ?thesis unfolding s'_def by (auto simp: state_absc)
 qed
 
 lemma s'_\<S>[simp, intro]:
   "s' \<in> \<S>"
   unfolding s'_def using s by auto
 
 lemma s'_s_cfg_on[intro]:
   assumes "cfg \<in> R_G.cfg_on s'"
   shows "repcs s cfg \<in> MDP.cfg_on s"
 proof -
   from assms s have "cfg \<in> R_G.valid_cfg" unfolding R_G.valid_cfg_def by auto
   with assms have "repcs s cfg \<in> valid_cfg" by (auto simp: s'_def intro: R_G.valid_cfgD)
   then show ?thesis by (auto dest: MDP.valid_cfgD)
 qed
 
 lemma (in Probabilistic_Timed_Automaton_Regions) compatible_stream:
   assumes \<phi>: "\<And> x y. x \<in> S \<Longrightarrow> x ~ y \<Longrightarrow> \<phi> x \<longleftrightarrow> \<phi> y"
   assumes "pred_stream (\<lambda>s. s \<in> S) xs"
       and [intro]: "x \<in> S"
     shows "pred_stream (\<lambda>s. \<phi> (reps (abss s)) = \<phi> s) (x ## xs)"
 unfolding stream.pred_set proof clarify
   fix l u
   assume A: "(l, u) \<in> sset (x ## xs)"
   from assms have "pred_stream (\<lambda>s. s \<in> S) (x ## xs)" by auto
   with A have "(l, u) \<in> S" by (fastforce simp: stream.pred_set)
   then have "abss (l, u) \<in> \<S>" by auto
   then have "reps (abss (l, u)) ~ (l, u)" by simp
   with \<phi> \<open>(l, u) \<in> S\<close> show "\<phi> (reps (abss (l, u))) = \<phi> (l, u)" by blast
 qed
 
 lemma \<phi>_stream':
   "pred_stream (\<lambda>s. \<phi> (reps (abss s)) = \<phi> s) (x ## xs)" if "pred_stream (\<lambda>s. s \<in> S) xs" "x \<in> S"
   using compatible_stream[of \<phi>, OF \<phi> that] .
 
 lemma \<psi>_stream':
   "pred_stream (\<lambda>s. \<psi> (reps (abss s)) = \<psi> s) (x ## xs)" if "pred_stream (\<lambda>s. s \<in> S) xs" "x \<in> S"
   using compatible_stream[of \<psi>, OF \<psi> that] .
 
 lemmas \<phi>_stream = compatible_stream[of \<phi>, OF \<phi>]
 lemmas \<psi>_stream = compatible_stream[of \<psi>, OF \<psi>]
 
 subsection \<open>Easier Result on All Configurations\<close>
 
 (* TODO: Rename *)
 lemma suntil_reps:
   assumes
     "\<forall>s\<in>sset (smap abss y). s \<in> \<S>"
     "(holds \<phi>' suntil holds \<psi>') (s' ## smap abss y)"
   shows "(holds \<phi> suntil holds \<psi>) (s ## y)"
   using assms
   by (subst region_compatible_suntil[symmetric]; (intro \<phi>_stream \<psi>_stream)?)
      (auto simp: \<phi>'_def \<psi>'_def absp_def stream.pred_set \<S>_abss_S s'_def comp_def)
 
 (* TODO: Rename *)
 lemma suntil_abss:
   assumes
     "\<forall>s\<in>sset y. s \<in> S"
     "(holds \<phi> suntil holds \<psi>) (s ## y)"
   shows
     "(holds \<phi>' suntil holds \<psi>') (s' ## smap abss y)"
   using assms
   by (subst (asm) region_compatible_suntil[symmetric]; (intro \<phi>_stream \<psi>_stream)?)
      (auto simp: \<phi>'_def \<psi>'_def absp_def stream.pred_set s'_def comp_def)
 
 (* TODO: Generalize to CTL formulae *)
 theorem P_sup_sunitl_eq:
   notes [measurable] = in_space_UNIV and [iff] = pred_stream_iff
   shows
     "(MDP.P_sup s  (\<lambda>x. (holds \<phi> suntil holds \<psi>)   (s  ## x)))
    = (R_G.P_sup s' (\<lambda>x. (holds \<phi>' suntil holds \<psi>') (s' ## x)))"
   unfolding MDP.P_sup_def R_G.P_sup_def
 proof (rule SUP_eq, goal_cases)
   case prems: (1 cfg)
   let ?cfg' = "absc cfg"
   from prems have "cfg \<in> valid_cfg" by (auto intro: MDP.valid_cfgI)
   then have "?cfg' \<in> R_G.valid_cfg" by (auto intro: R_G.valid_cfgI)
   from \<open>cfg \<in> valid_cfg\<close> have alw_S: "almost_everywhere (MDP.T cfg) (pred_stream (\<lambda>s. s \<in> S))"
     by (rule MDP.alw_S)
   from \<open>?cfg'\<in> R_G.valid_cfg\<close> have alw_\<S>: "almost_everywhere (R_G.T ?cfg') (pred_stream (\<lambda>s. s \<in> \<S>))"
     by (rule R_G.alw_S)
   have "emeasure (MDP.T cfg) {x \<in> space MDP.St. (holds \<phi> suntil holds \<psi>) (s ## x)}
        = emeasure (R_G.T ?cfg') {x \<in> space R_G.St. (holds \<phi>' suntil holds \<psi>') (s' ## x)}"
     apply (rule path_measure_eq_absc1_new[symmetric, where P = "pred_stream (\<lambda> s. s \<in> \<S>)"
           and Q = "pred_stream (\<lambda> s. s \<in> S)"]
         )
     using prems alw_S alw_\<S> apply (auto intro: MDP.valid_cfgI simp: )[7]
     by (auto simp: S_abss_\<S> intro: \<S>_abss_S intro!: suntil_abss suntil_reps, measurable)
   with prems show ?case by (inst_existentials ?cfg') auto
 next
   case prems: (2 cfg)
   let ?cfg' = "repcs s cfg"
   have "s = state ?cfg'" by simp
   from prems have "s' = state cfg" by auto
   have "pred_stream (\<lambda>s. \<phi> (reps (abss s)) = \<phi> s) (state (repcs s cfg) ## x)"
     if "pred_stream (\<lambda>s. s \<in> S) x" for x
     using prems that by (intro \<phi>_stream) auto
   moreover
   have "pred_stream (\<lambda>s. \<psi> (reps (abss s)) = \<psi> s) (state (repcs s cfg) ## x)"
     if "pred_stream (\<lambda>s. s \<in> S) x" for x
     using prems that by (intro \<psi>_stream) auto
   ultimately
   have "emeasure (R_G.T cfg) {x \<in> space R_G.St. (holds \<phi>' suntil holds \<psi>') (s' ## x)}
     = emeasure (MDP.T (repcs s cfg)) {x \<in> space MDP.St. (holds \<phi> suntil holds \<psi>) (s ## x)}"
     apply (rewrite in "s ## _" \<open>s = _\<close>)
     apply (subst \<open>s' = _\<close>)
     unfolding \<phi>'_def \<psi>'_def s'_def
     apply (rule path_measure_eq_repcs''_new)
     using prems by (auto 4 3 simp: s'_def intro: R_G.valid_cfgI MDP.valid_cfgI)
   with prems show ?case by (inst_existentials ?cfg') auto
 qed
 
 end (* PTA Reachability Problem *)
 
 
 subsection \<open>Divergent Adversaries\<close>
 
 context Probabilistic_Timed_Automaton
 begin
 
   definition "elapsed u u' \<equiv> Max ({u' c - u c | c. c \<in> \<X>} \<union> {0})"
 
   definition "eq_elapsed u u' \<equiv> elapsed u u' > 0 \<longrightarrow> (\<forall> c \<in> \<X>. u' c - u c = elapsed u u')"
 
   fun dur :: "('c, t) cval stream \<Rightarrow> nat \<Rightarrow> t" where
     "dur _ 0 = 0" |
     "dur (x ## y ## xs) (Suc i) = elapsed x y + dur (y ## xs) i"
 
   definition "divergent \<omega> \<equiv> \<forall> t. \<exists> n. dur \<omega> n > t"
 
   definition "div_cfg cfg \<equiv> AE \<omega> in MDP.MC.T cfg. divergent (smap (snd o state) \<omega>)"
 
   definition "\<R>_div \<omega> \<equiv>
     \<forall>x \<in> \<X>. (\<forall> i. (\<exists> j \<ge> i. zero x (\<omega> !! j)) \<and> (\<exists> j \<ge> i. \<not> zero x (\<omega> !! j)))
       \<or> (\<exists> i. \<forall> j \<ge> i. unbounded x (\<omega> !! j))"
 
   definition "R_G_div_cfg cfg \<equiv> AE \<omega> in MDP.MC.T cfg. \<R>_div (smap (snd o state) \<omega>)"
 
 end
 
 context Probabilistic_Timed_Automaton_Regions
 begin
 
 definition "cfg_on_div st \<equiv> MDP.cfg_on st \<inter> {cfg. div_cfg cfg}"
 
 definition "R_G_cfg_on_div st \<equiv> R_G.cfg_on st \<inter> {cfg. R_G_div_cfg cfg}"
 
 lemma measurable_\<R>_div[measurable]: "Measurable.pred MDP.MC.S \<R>_div"
   unfolding \<R>_div_def
   by (intro
         pred_intros_finite[OF beta_interp.finite]
         pred_intros_logic pred_intros_countable
         measurable_count_space_const measurable_compose[OF measurable_snth]
      ) measurable
 
 lemma elapsed_ge0[simp]: "elapsed x y \<ge> 0"
   unfolding elapsed_def using finite(1) by auto
 
 lemma dur_pos:
   "dur xs i \<ge> 0"
  apply (induction i arbitrary: xs)
  apply (auto; fail)
  subgoal for i xs
    apply (subst stream.collapse[symmetric])
    apply (rewrite at "stl xs" stream.collapse[symmetric])
    apply (subst dur.simps)
  by simp
 done
 
 lemma dur_mono:
   "i \<le> j \<Longrightarrow> dur xs i \<le> dur xs j"
 proof (induction i arbitrary: xs j)
   case 0 show ?case by (auto intro: dur_pos)
 next
   case (Suc i xs j)
   obtain x y ys where xs: "xs = x ## y ## ys" using stream.collapse by metis
   from Suc obtain j' where j': "j = Suc j'" by (cases j) auto
   with xs have "dur xs j = elapsed x y + dur (y ## ys) j'" by auto
   also from Suc j' have "\<dots> \<ge> elapsed x y + dur (y ## ys) i" by auto
   also have "elapsed x y + dur (y ## ys) i = dur xs (Suc i)" by (simp add: xs)
   finally show ?case .
 qed
 
 lemma dur_monoD:
   assumes "dur xs i < dur xs j"
   shows "i < j" using assms
  by - (rule ccontr; auto 4 4 dest: leI dur_mono[where xs = xs])
 
 lemma elapsed_0D:
   assumes "c \<in> \<X>" "elapsed u u' \<le> 0"
   shows "u' c - u c \<le> 0"
 proof -
   from assms have "u' c - u c \<in> {u' c - u c | c. c \<in> \<X>} \<union> {0}" by auto
   with finite(1) have "u' c - u c \<le> Max ({u' c - u c | c. c \<in> \<X>} \<union> {0})" by auto
   with assms(2) show ?thesis unfolding elapsed_def by auto
 qed
 
 lemma elapsed_ge:
   assumes "eq_elapsed u u'" "c \<in> \<X>"
   shows "elapsed u u' \<ge> u' c - u c"
   using assms unfolding eq_elapsed_def by (auto intro: elapsed_ge0 order.trans[OF elapsed_0D])
 
 lemma elapsed_eq:
   assumes "eq_elapsed u u'" "c \<in> \<X>" "u' c - u c \<ge> 0"
   shows "elapsed u u' = u' c - u c"
   using elapsed_ge[OF assms(1,2)] assms unfolding eq_elapsed_def by auto
 
 lemma dur_shift:
   "dur \<omega> (i + j) = dur \<omega> i + dur (sdrop i \<omega>) j"
  apply (induction i arbitrary: \<omega>)
   apply simp
  subgoal for i \<omega>
   apply simp
   apply (subst stream.collapse[symmetric])
   apply (rewrite at "stl \<omega>" stream.collapse[symmetric])
   apply (subst dur.simps)
   apply (rewrite in "dur \<omega>" stream.collapse[symmetric])
   apply (rewrite in "dur (_ ## \<hole>) (Suc _)" stream.collapse[symmetric])
   apply (subst dur.simps)
   apply simp
  done
 done
 
 lemma dur_zero:
   assumes
     "\<forall> i. xs !! i \<in> \<omega> !! i" "\<forall> j \<le> i. zero x (\<omega> !! j)" "x \<in> \<X>"
     "\<forall> i. eq_elapsed (xs !! i) (xs !! Suc i)"
   shows "dur xs i = 0" using assms
 proof (induction i arbitrary: xs \<omega>)
   case 0
   then show ?case by simp
 next
   case (Suc i xs \<omega>)
   let ?x = "xs !! 0"
   let ?y = "xs !! 1"
   let ?ys = "stl (stl xs)"
   have xs: "xs = ?x ## ?y ## ?ys" by auto
   from Suc.prems have
     "\<forall> i. (?y ## ?ys) !! i \<in> stl \<omega> !! i" "\<forall> j \<le> i. zero x (stl \<omega> !! j)"
     "\<forall> i. eq_elapsed (stl xs !! i) (stl xs !! Suc i)"
     by (metis snth.simps(2) | auto)+
   from Suc.IH[OF this(1,2) \<open>x \<in> _\<close>] this(3) have [simp]: "dur (stl xs) i = 0" by auto
   from Suc.prems(1,2) have "?y x = 0" "?x x = 0" unfolding zero_def by force+
   then have *: "?y x - ?x x = 0" by simp
   have "dur xs (Suc i) = elapsed ?x ?y"
     apply (subst xs)
     apply (subst dur.simps)
     by simp
   also have "\<dots> = 0"
     apply (subst elapsed_eq[OF _ \<open>x \<in> _\<close>])
     unfolding One_nat_def using Suc.prems(4) apply blast
     using * by auto
   finally show ?case .
 qed
 
 lemma dur_zero_tail:
   assumes "\<forall> i. xs !! i \<in> \<omega> !! i" "\<forall> k \<ge> i. k \<le> j \<longrightarrow> zero x (\<omega> !! k)" "x \<in> \<X>" "j \<ge> i"
           "\<forall> i. eq_elapsed (xs !! i) (xs !! Suc i)"
   shows "dur xs j = dur xs i"
 proof -
   from \<open>j \<ge> i\<close> dur_shift[of xs i "j - i"] have
     "dur xs j = dur xs i + dur (sdrop i xs) (j - i)"
   by simp
   also have "\<dots> = dur xs i"
     using assms
     by (rewrite in "dur (sdrop _ _) _" dur_zero[where \<omega> = "sdrop i \<omega>"])
        (auto dest: prop_nth_sdrop_pair[of eq_elapsed] prop_nth_sdrop prop_nth_sdrop_pair[of "(\<in>)"])
   finally show ?thesis .
 qed
 
 lemma elapsed_ge_pos:
   fixes u :: "('c, t) cval"
   assumes "eq_elapsed u u'" "c \<in> \<X>" "u \<in> V" "u' \<in> V"
   shows "elapsed u u' \<le> u' c"
 proof (cases "elapsed u u' = 0")
   case True
   with assms show ?thesis by (auto simp: V_def)
 next
   case False
   from \<open>u \<in> V\<close> \<open>c \<in> \<X> \<close> have "u c \<ge> 0" by (auto simp: V_def)
   from False assms have "elapsed u u' = u' c - u c"
     unfolding eq_elapsed_def by (auto simp add: less_le)
   also from \<open>u c \<ge> 0\<close> have "\<dots> \<le> u' c" by simp
   finally show ?thesis .
 qed
 
 lemma dur_Suc:
   "dur xs (Suc i) - dur xs i = elapsed (xs !! i) (xs !! Suc i)"
  apply (induction i arbitrary: xs)
   apply simp
   apply (subst stream.collapse[symmetric])
   apply (rewrite in "stl _" stream.collapse[symmetric])
   apply (subst dur.simps)
   apply simp
  apply simp
  subgoal for i xs
   apply (subst stream.collapse[symmetric])
   apply (rewrite in "stl _" stream.collapse[symmetric])
   apply (subst dur.simps)
   apply simp
   apply (rewrite in "dur xs (Suc _)" stream.collapse[symmetric])
   apply (rewrite at "stl xs" in "_ ## stl xs" stream.collapse[symmetric])
   apply (subst dur.simps)
   apply simp
  done
 done
 
 inductive trans where
   succ: "t \<ge> 0 \<Longrightarrow> u' = u \<oplus> t \<Longrightarrow> trans u u'" |
   reset: "set l \<subseteq> \<X> \<Longrightarrow> u' = clock_set l 0 u \<Longrightarrow> trans u u'" |
   id: "u = u' \<Longrightarrow> trans u u'"
 
 abbreviation "stream_trans \<equiv> pairwise trans"
 
 lemma K_cfg_trans:
   assumes "cfg \<in> MDP.cfg_on (l, R)" "cfg' \<in> K_cfg cfg" "state cfg' = (l', R')"
   shows "trans R R'"
 using assms
  apply (simp add: set_K_cfg)
  apply (drule MDP.cfg_onD_action)
  apply (cases rule: K.cases)
     apply (auto intro: trans.intros)
 using admissible_targets_clocks(2) by (blast intro: trans.intros(2))
 
 lemma enabled_stream_trans:
   assumes "cfg \<in> valid_cfg" "MDP.MC.enabled cfg xs"
   shows "stream_trans (smap (snd o state) xs)"
   using assms
 proof (coinduction arbitrary: cfg xs)
   case prems: (pairwise cfg xs)
   let ?xs = "stl (stl xs)" let ?x = "shd xs" let ?y = "shd (stl xs)"
   from MDP.pred_stream_cfg_on[OF prems] have *:
     "pred_stream (\<lambda>cfg. state cfg \<in> S \<and> cfg \<in> MDP.cfg_on (state cfg)) xs" .
   obtain l R l' R' where eq: "state ?x = (l, R)" "state ?y = (l', R')" by force
   moreover from * have "?x \<in> MDP.cfg_on (state ?x)" "?x \<in> valid_cfg"
     by (auto intro: MDP.valid_cfgI simp: stream.pred_set)
   moreover from prems(2) have "?y \<in> K_cfg ?x" by (auto elim: MDP.MC.enabled.cases)
   ultimately have "trans R R'"
     by (intro K_cfg_trans[where cfg = ?x and cfg' = ?y and l = l and l' = l']) metis+
   with \<open>?x \<in> valid_cfg\<close> prems(2) show ?case
     apply (inst_existentials R R' "smap (snd o state) ?xs")
       apply (simp add: eq; fail)+
     apply (rule disjI1, inst_existentials ?x "stl xs")
     by (auto simp: eq elim: MDP.MC.enabled.cases)
 qed
 
 lemma stream_trans_trans:
   assumes "stream_trans xs"
   shows "trans (xs !! i) (stl xs !! i)"
 using pairwise_Suc assms by auto
 
 lemma trans_eq_elapsed:
   assumes "trans u u'" "u \<in> V"
   shows "eq_elapsed u u'"
 using assms
 proof cases
   case (succ t)
   with finite(1) show ?thesis by (auto simp: cval_add_def elapsed_def max_def eq_elapsed_def)
 next
   case prems: (reset l)
   then have "u' c - u c \<le> 0" if "c \<in> \<X>" for c
   using that \<open>u \<in> V\<close> by (cases "c \<in> set l") (auto simp: V_def)
   then have "elapsed u u' = 0" unfolding elapsed_def using finite(1)
    apply simp
    apply (subst Max_insert2)
   by auto
   then show ?thesis by (auto simp: eq_elapsed_def)
 next
   case id
   then show ?thesis
     using finite(1) by (auto simp: Max_gr_iff elapsed_def eq_elapsed_def)
 qed
 
 lemma pairwise_trans_eq_elapsed:
   assumes "stream_trans xs" "pred_stream (\<lambda> u. u \<in> V) xs"
   shows "pairwise eq_elapsed xs"
 using trans_eq_elapsed assms by (auto intro: pairwise_mp simp: stream.pred_set)
 
 lemma not_reset_dur:
   assumes "\<forall>k>i. k \<le> j \<longrightarrow> \<not> zero c ([xs !! k]\<^sub>\<R>)" "j \<ge> i" "c \<in> \<X>" "stream_trans xs"
     "\<forall> i. eq_elapsed (xs !! i) (xs !! Suc i)" "\<forall> i. xs !! i \<in> V"
   shows "dur xs j - dur xs i = (xs !! j) c - (xs !! i) c"
   using assms
 proof (induction j)
   case 0 then show ?case by simp
 next
   case (Suc j)
   from stream_trans_trans[OF Suc.prems(4)] have trans: "trans (xs !! j) (xs !! Suc j)" by auto
   from Suc.prems have *:
     "\<not> zero c ([xs !! Suc j]\<^sub>\<R>)" "eq_elapsed (xs !! j) (xs !! Suc j)" if "Suc j > i"
     using that by auto
   from Suc.prems(6) have "xs !! j \<in> V" "xs !! Suc j \<in> V" by blast+
   then have regions: "[xs !! j]\<^sub>\<R> \<in> \<R>" "[xs !! Suc j]\<^sub>\<R> \<in> \<R>" by auto
   from trans have "(xs !! Suc j) c - (xs !! j) c \<ge> 0" if "Suc j > i"
   proof (cases)
     case succ
     with regions show ?thesis by (auto simp: cval_add_def)
   next
     case prems: (reset l)
     show ?thesis
     proof (cases "c \<in> set l")
       case False
       with prems show ?thesis by auto
     next
       case True
       with prems have "(xs !! Suc j) c = 0" by auto
       moreover from assms have "xs !! Suc j \<in> [xs !! Suc j]\<^sub>\<R>" by blast
       ultimately have
         "zero c ([xs !! Suc j]\<^sub>\<R>)"
         using zero_all[OF finite(1) _ \<open>c \<in> \<X>\<close>] regions(2) by (auto simp: \<R>_def)
       with * that show ?thesis by auto
     qed
   next
     case id then show ?thesis by simp
   qed
   with * \<open>c \<in> \<X>\<close> elapsed_eq have
     *: "elapsed (xs !! j) (xs !! Suc j) = (xs !! Suc j) c - (xs !! j) c"
     if "Suc j > i"
     using that by blast
   show ?case
   proof (cases "i = Suc j")
     case False
     with Suc have
       "dur xs (Suc j) - dur xs i = dur xs (Suc j) - dur xs j + (xs !! j) c - (xs !! i) c"
       by auto
     also have "\<dots> = elapsed (xs !! j) (xs !! Suc j) + (xs !! j) c - (xs !! i) c"
       by (simp add: dur_Suc)
     also have
       "\<dots> = (xs !! Suc j) c - (xs !! j) c  + (xs !! j) c - (xs !! i) c"
       using * False Suc.prems by auto
     also have "\<dots> = (xs !! Suc j) c - (xs !! i) c" by simp
     finally show ?thesis by auto
   next
     case True
     then show ?thesis by simp
   qed
 qed
 
 lemma not_reset_dur':
   assumes "\<forall>j\<ge>i. \<not> zero c ([xs !! j]\<^sub>\<R>)" "j \<ge> i" "c \<in> \<X>" "stream_trans xs"
           "\<forall> i. eq_elapsed (xs !! i) (xs !! Suc i)" "\<forall> j. xs !! j \<in> V"
   shows "dur xs j - dur xs i = (xs !! j) c - (xs !! i) c"
 using assms not_reset_dur by auto
 
 lemma not_reset_unbounded:
   assumes "\<forall>j\<ge>i. \<not> zero c ([xs !! j]\<^sub>\<R>)" "j \<ge> i" "c \<in> \<X>" "stream_trans xs"
           "\<forall> i. eq_elapsed (xs !! i) (xs !! Suc i)" "\<forall> j. xs !! j \<in> V"
           "unbounded c ([xs !! i]\<^sub>\<R>)"
   shows "unbounded c ([xs !! j]\<^sub>\<R>)"
 proof -
   let ?u = "xs !! i" let ?u' = "xs !! j" let ?R = "[xs !! i]\<^sub>\<R>"
   from assms have "?u \<in> ?R" by auto
   from assms(6) have "?R \<in> \<R>" by auto
   then obtain I r where "?R = region \<X> I r" "valid_region \<X> k I r" unfolding \<R>_def by auto
   with assms(3,7) unbounded_Greater \<open>?u \<in> ?R\<close> have "?u c > k c" by force
   also from not_reset_dur'[OF assms(1-6)] dur_mono[OF \<open>j \<ge> i\<close>, of xs] have "?u' c \<ge> ?u c" by auto
   finally have "?u' c > k c" by auto
   let ?R' = "[xs !! j]\<^sub>\<R>"
   from assms have "?u' \<in> ?R'" by auto
   from assms(6) have "?R' \<in> \<R>" by auto
   then obtain I r where "?R' = region \<X> I r" "valid_region \<X> k I r" unfolding \<R>_def by auto
   moreover with \<open>?u' c > _\<close> \<open>?u' \<in> _\<close> gt_GreaterD \<open>c \<in> \<X>\<close> have "I c = Greater (k c)" by auto
   ultimately show ?thesis using Greater_unbounded[OF finite(1) _ \<open>c \<in> \<X>\<close>] by auto
 qed
 
 lemma gt_unboundedD:
   assumes "u \<in> R"
     and "R \<in> \<R>"
     and "c \<in> \<X>"
     and "real (k c) < u c"
   shows "unbounded c R"
 proof -
   from assms obtain I r where "R = region \<X> I r" "valid_region \<X> k I r"
     unfolding \<R>_def by auto
   with Greater_unbounded[of \<X> k I r c] gt_GreaterD[of u \<X> I r k c] assms finite(1) show ?thesis
     by auto
 qed
 
 definition trans' :: "('c, t) cval \<Rightarrow> ('c, t) cval \<Rightarrow> bool" where
   "trans' u u' \<equiv>
     ((\<forall> c \<in> \<X>. u c > k c \<and> u' c > k c \<and> u \<noteq> u') \<longrightarrow> u' = u \<oplus> 0.5) \<and>
     ((\<exists> c \<in> \<X>. u c = 0 \<and> u' c > 0 \<and> (\<forall>c\<in>\<X>. \<nexists>d. d \<le> k c \<and> u' c = real d))
     \<longrightarrow> u' = delayedR ([u']\<^sub>\<R>) u)"
 
 (* XXX Move *)
 lemma zeroI:
   assumes "c \<in> \<X>" "u \<in> V" "u c = 0"
   shows "zero c ([u]\<^sub>\<R>)"
 proof -
   from assms have "u \<in> [u]\<^sub>\<R>" "[u]\<^sub>\<R> \<in> \<R>" by auto
   then obtain I r where "[u]\<^sub>\<R> = region \<X> I r" "valid_region \<X> k I r" unfolding \<R>_def by auto
   with zero_all[OF finite(1) this(2) \<open>c \<in> \<X>\<close>] \<open>u \<in> [u]\<^sub>\<R>\<close> \<open>u c = 0\<close> show ?thesis by auto
 qed
 
 (* XXX Move, rename *)
 lemma zeroD:
   "u x = 0" if "zero x ([u]\<^sub>\<R>)" "u \<in> V"
   using that by (metis regions_part_ex(1) zero_def)
 
 lemma not_zeroD:
   assumes "\<not> zero x ([u]\<^sub>\<R>)" "u \<in> V" "x \<in> \<X>"
   shows "u x > 0"
 proof -
   from zeroI assms have "u x \<noteq> 0" by auto
   moreover from assms have "u x \<ge> 0" unfolding V_def by auto
   ultimately show ?thesis by auto
 qed
 
 (* XXX Move *)
 lemma not_const_intv:
   assumes "u \<in> V" "\<forall>c\<in>\<X>. \<nexists>d. d \<le> k c \<and> u c = real d"
   shows "\<forall>c\<in>\<X>. \<forall>u \<in> [u]\<^sub>\<R>. \<nexists>d. d \<le> k c \<and> u c = real d"
 proof -
   from assms have "u \<in> [u]\<^sub>\<R>" "[u]\<^sub>\<R> \<in> \<R>" by auto
   then obtain I r where I: "[u]\<^sub>\<R> = region \<X> I r" "valid_region \<X> k I r" unfolding \<R>_def by auto
   have "\<nexists>d. d \<le> k c \<and> u' c = real d" if "c \<in> \<X>" "u' \<in> [u]\<^sub>\<R>" for c u'
   proof safe
     fix d assume A: "d \<le> k c" "u' c = real d"
     from I that have "intv_elem c u' (I c)" "valid_intv (k c) (I c)" by auto
     then show False
       using A I \<open>u \<in> [u]\<^sub>\<R>\<close> \<open>c \<in> \<X>\<close> assms(2) by (cases; fastforce)
   qed
   then show ?thesis by auto
 qed
 
 lemma K_cfg_trans':
   assumes "repcs (l, u) cfg \<in> MDP.cfg_on (l, u)" "cfg' \<in> K_cfg (repcs (l, u) cfg)"
           "state cfg' = (l', u')" "(l, u) \<in> S" "cfg \<in> R_G.valid_cfg" "abss (l, u) = state cfg"
   shows "trans' u u'"
 using assms
  apply (simp add: set_K_cfg)
  apply (drule MDP.cfg_onD_action)
  apply (cases rule: K.cases)
  apply assumption
 proof goal_cases
   case prems: (1 l u t)
   from assms \<open>_ = (l, u)\<close> have "repcs (l, u) cfg \<in> valid_cfg" by (auto intro: MDP.valid_cfgI)
   then have "absc (repcs (l, u) cfg) \<in> R_G.valid_cfg" by auto
   from prems have *: "rept (l, u) (action cfg) = return_pmf (l, u \<oplus> t)" unfolding repcs_def by auto
   from \<open>abss _ = _\<close> \<open>_ = (l, u)\<close> \<open>cfg \<in> R_G.valid_cfg\<close> have
     "action cfg \<in> \<K> (abss (l, u))"
   by (auto dest: R_G_I)
   from abst_rept_id[OF this] * have "action cfg = abst (return_pmf (l, u \<oplus> t))" by auto
   with prems have **: "action cfg = return_pmf (l, [u \<oplus> t]\<^sub>\<R>)" unfolding abst_def by auto
   show ?thesis
   proof (cases "\<forall> c \<in> \<X>. u c > k c")
     case True
     from prems have "u \<oplus> t \<in> [u]\<^sub>\<R>" by (auto intro: upper_right_closed[OF True])
     with prems have "[u \<oplus> t]\<^sub>\<R> = [u]\<^sub>\<R>" by (auto dest: alpha_interp.region_unique_spec)
     with ** have "action cfg = return_pmf (l, [u]\<^sub>\<R>)" by simp
     with True have "rept (l, u) (action cfg) = return_pmf (l, u \<oplus> 0.5)" 
     unfolding rept_def using prems by auto
     with * have "u \<oplus> t = u \<oplus> 0.5" by auto
     moreover from prems have "u' = u \<oplus> t" by auto
     moreover from prems True have "\<forall> c \<in> \<X>. u' c > k c" by (auto simp: cval_add_def)
     ultimately show ?thesis using True \<open>_ = (l, u)\<close> unfolding trans'_def by auto
   next
     case F: False
     show ?thesis
     proof (cases "\<exists>c\<in>\<X>. u c = 0 \<and> 0 < u' c \<and> (\<forall>c\<in>\<X>. \<nexists>d. d \<le> k c \<and> u' c = real d)")
       case True
       from prems have "u' \<in> [u']\<^sub>\<R>" by auto
       from prems have "[u \<oplus> t]\<^sub>\<R> \<in> Succ \<R> ([u]\<^sub>\<R>)" by auto
       from True obtain c where "c \<in> \<X>" "u c = 0" "u' c > 0" by auto
       with zeroI prems have "zero c ([u]\<^sub>\<R>)" by auto
       moreover from \<open>u' \<in> _\<close> \<open>u' c > 0\<close> have "\<not> zero c ([u']\<^sub>\<R>)" unfolding zero_def by fastforce
       ultimately have "[u \<oplus> t]\<^sub>\<R> \<noteq> [u]\<^sub>\<R>" using prems by auto
       moreover from True not_const_intv prems have
         "\<forall> u \<in> [u \<oplus> t]\<^sub>\<R>. \<forall>c\<in>\<X>. \<nexists>d. d \<le> k c \<and> u c = real d"
       by auto
       ultimately have "\<exists>R'. (l, u) \<in> S \<and>
                      action cfg = return_pmf (l, R') \<and>
                      R' \<in> Succ \<R> ([u]\<^sub>\<R>) \<and> [u]\<^sub>\<R> \<noteq> R' \<and> (\<forall>u\<in>R'. \<forall>c\<in>\<X>. \<nexists>d. d \<le> k c \<and> u c = real d)"
        apply -
        apply (rule exI[where x = "[u \<oplus> t]\<^sub>\<R>"])
        apply safe
       using prems ** by auto
       then have
         "rept (l, u) (action cfg)
        = return_pmf (l, delayedR (SOME R'. action cfg = return_pmf (l, R')) u)" 
       unfolding rept_def by auto
       with * ** prems have "u' = delayedR ([u \<oplus> t]\<^sub>\<R>) u" by auto
       with F True prems show ?thesis unfolding trans'_def by auto
     next
       case False
       with F \<open>_ = (l, u)\<close> show ?thesis unfolding trans'_def by auto
     qed
   qed
 next
   case prems: (2 _ _ \<tau> \<mu>)
   then obtain X where X: "u' = ([X := 0]u)" "(X, l') \<in> set_pmf \<mu>" by auto
   from \<open>_ \<in> S\<close> have "u \<in> V" by auto
   let ?r = "SOME r. set r = X"
   show ?case
   proof (cases "X = {}")
     case True
     with X have "u = u'" by auto
     with non_empty show ?thesis unfolding trans'_def by auto
   next
     case False
     then obtain x where "x \<in> X" by auto
     moreover have "X \<subseteq> \<X>" using admissible_targets_clocks(1)[OF prems(10) X(2)] by auto
     ultimately have "x \<in> \<X>" by auto
     from \<open>X \<subseteq> \<X>\<close> finite(1) obtain r where "set r = X" using finite_list finite_subset by blast
     then have r: "set ?r = X" by (rule someI)
     with \<open>x \<in> X\<close> X have "u' x = 0" by auto
     from X r \<open>u \<in> V\<close> \<open>X \<subseteq> \<X>\<close> have "u' x \<le> u x" for x
       by (cases "x \<in> X"; auto simp: V_def)
     have False if "u' x > 0 \<and> u x = 0" for x
       using \<open>u' _ \<le> _\<close>[of x] that by auto
     with \<open>u' x = 0\<close> show ?thesis using \<open>x \<in> \<X>\<close> unfolding trans'_def by auto
   qed
 next
   case 3
   with non_empty show ?case unfolding trans'_def by auto
 qed
 
 coinductive enabled_repcs where
   "enabled_repcs (shd xs) (stl xs) \<Longrightarrow> shd xs = repcs st' cfg' \<Longrightarrow> st' \<in> rept st (action cfg)
   \<Longrightarrow> abss st' = state cfg'
   \<Longrightarrow> cfg' \<in> R_G.valid_cfg
   \<Longrightarrow> enabled_repcs (repcs st cfg) xs"
 
 (* XXX Move *)
 lemma K_cfg_rept_in:
 assumes "cfg \<in> R_G.valid_cfg"
     and "abss st = state cfg"
     and "cfg' \<in> K_cfg cfg"
   shows "(THE s'. s' \<in> set_pmf (rept st (action cfg)) \<and> abss s' = state cfg')
          \<in> set_pmf (rept st (action cfg))"
 proof -
   from assms(1,2) have "action cfg \<in> \<K> (abss st)" by (auto simp: R_G_I)
   from \<open>cfg' \<in> _\<close> have
     "cfg' = cont cfg (state cfg')" "state cfg' \<in> action cfg"
   by (auto simp: set_K_cfg)
   with abst_rept_id[OF \<open>action _ \<in> _\<close>] pmf.set_map have
     "state cfg' \<in> abss ` set_pmf (rept st (action cfg))" unfolding abst_def  by metis
   then obtain st' where
     "st' \<in> rept st (action cfg)" "abss st' = state cfg'"
   unfolding abst_def by auto
   with K_cfg_rept_aux[OF assms(1,2) this(1)] show ?thesis by auto
 qed
 
 lemma enabled_repcsI:
   assumes "cfg \<in> R_G.valid_cfg" "abss st = state cfg" "MDP.MC.enabled (repcs st cfg) xs"
   shows "enabled_repcs (repcs st cfg) xs" using assms
 proof (coinduction arbitrary: cfg xs st)
   case prems: (enabled_repcs cfg xs st)
   let ?x = "shd xs" and ?y = "shd (stl xs)"
   let ?st = "THE s'. s' \<in> set_pmf (rept st (action cfg)) \<and> abss s' = state (absc ?x)"
   from prems(3) have "?x \<in> K_cfg (repcs st cfg)" by cases
   with K_cfg_map_repcs[OF prems(1,2)] obtain cfg' where
     "cfg' \<in> K_cfg cfg" "?x = repcs (THE s'. s' \<in> rept st (action cfg) \<and> abss s' = state cfg') cfg'"
     by auto
   let ?st = "THE s'. s' \<in> rept st (action cfg) \<and> abss s' = state cfg'"
   from K_cfg_rept_action[OF prems(1,2) \<open>cfg' \<in> _\<close>] have "abss ?st = state cfg'" .
   moreover from K_cfg_rept_in[OF prems(1,2) \<open>cfg' \<in> _\<close>] have "?st \<in> rept st (action cfg)" .
   moreover have "cfg' \<in> R_G.valid_cfg" using \<open>cfg' \<in> K_cfg cfg\<close> prems(1) by blast 
   moreover from absc_repcs_id[OF this \<open>abss ?st = state cfg'\<close>] \<open>?x = _\<close> have "absc ?x = cfg'"
     by auto
   moreover from prems(3) have "MDP.MC.enabled (shd xs) (stl xs)" by cases
   ultimately show ?case
     using \<open>?x = _\<close> by (inst_existentials xs ?st "absc ?x" st cfg) fastforce+
 qed
 
 lemma repcs_eq_rept:
   "rept st (action cfg) = rept st'' (action cfg'')" if "repcs st cfg = repcs st'' cfg''"
    by (metis (mono_tags, lifting) action_cfg_corec old.prod.case repcs_def that)
 
 lemma enabled_stream_trans':
   assumes "cfg \<in> R_G.valid_cfg" "abss st = state cfg" "MDP.MC.enabled (repcs st cfg) xs"
   shows "pairwise trans' (smap (snd o state) xs)"
 using assms
 proof (coinduction arbitrary: cfg xs st)
   case prems: (pairwise cfg xs)
   let ?xs = "stl xs"
   from prems have A: "enabled_repcs (repcs st cfg) xs" by (auto intro: enabled_repcsI)
   then obtain st' cfg' where
     "enabled_repcs (shd xs) (stl xs)" "shd xs = repcs st' cfg'" "st' \<in> rept st (action cfg)"
     "abss st' = state cfg'" "cfg' \<in> R_G.valid_cfg"
    apply atomize_elim
    apply (cases rule: enabled_repcs.cases)
    apply assumption
    subgoal for st' cfg' st'' cfg''
      by (inst_existentials st' cfg') (auto dest: repcs_eq_rept)
   done
   then obtain st'' cfg'' where
     "enabled_repcs (shd ?xs) (stl ?xs)"
     "shd ?xs = repcs st'' cfg''" "st'' \<in> rept st' (action cfg')" "abss st'' = state cfg''"
     by atomize_elim (subst (asm)enabled_repcs.simps, fastforce dest: repcs_eq_rept)
   let ?x = "shd xs" let ?y = "shd (stl xs)"
   let ?cfg = "repcs st cfg"
   from prems have "?cfg \<in> valid_cfg" by auto
   from MDP.pred_stream_cfg_on[OF \<open>?cfg \<in> valid_cfg\<close> prems(3)] have *:
     "pred_stream (\<lambda>cfg. state cfg \<in> S \<and> cfg \<in> MDP.cfg_on (state cfg)) xs" .
   obtain l u l' u' where eq: "st' = (l, u)" "st'' = (l', u')"
     by force
   moreover from * have
     "?x \<in> MDP.cfg_on (state ?x)" "?x \<in> valid_cfg"
     by (auto intro: MDP.valid_cfgI simp: stream.pred_set)
   moreover from prems(3) have "?y \<in> K_cfg ?x" by (auto elim: MDP.MC.enabled.cases)
   ultimately have "trans' u u'"
     using \<open>?x = _\<close> \<open>?y = _\<close> \<open>cfg' \<in> _\<close> \<open>abss st' = _\<close>
     by (intro K_cfg_trans') (auto dest: MDP.valid_cfg_state_in_S)
   with \<open>?x \<in> valid_cfg\<close> \<open>cfg' \<in> R_G.valid_cfg\<close> prems(3) \<open>abss _ = state cfg'\<close> show ?case
     apply (inst_existentials u u' "smap (snd o state) (stl ?xs)")
     apply (simp add: eq \<open>?x = _\<close> \<open>?y = _\<close>; fail)+
     by ((intro disjI1 exI)?; auto simp: \<open>?x = _\<close> \<open>?y = _\<close> eq elim: MDP.MC.enabled.cases)
 qed
 
 lemma divergent_\<R>_divergent:
   assumes in_S: "pred_stream (\<lambda> u. u \<in> V) xs"
      and  div:  "divergent xs"
      and trans: "stream_trans xs"
   shows "\<R>_div (smap (\<lambda> u. [u]\<^sub>\<R>) xs)" (is "\<R>_div ?\<omega>")
 unfolding \<R>_div_def proof (safe, simp_all)
   fix x i
   assume x: "x \<in> \<X>" and bounded: "\<forall>i. \<exists>j\<ge>i. \<not> unbounded x ([xs !! j]\<^sub>\<R>)"
   from in_S have xs_\<omega>: "\<forall>i. xs !! i \<in> ?\<omega> !! i" by (auto simp: stream.pred_set)
   from trans in_S have elapsed:
     "\<forall> i. eq_elapsed (xs !! i) (xs !! Suc i)"
     by (fastforce intro: pairwise_trans_eq_elapsed pairwise_Suc[where P = eq_elapsed])
   { assume A: "\<forall>j \<ge> i. \<not> zero x ([xs !! j]\<^sub>\<R>)"
     let ?t = "dur xs i + k x"
     from div obtain j where j: "dur xs j > dur xs i + k x" unfolding divergent_def by auto
     then have "k x < dur xs j - dur xs i" by auto
     also with not_reset_dur'[OF A less_imp_le[OF dur_monoD], of xs] \<open>x \<in> \<X>\<close> assms elapsed have
       "\<dots> = (xs !! j) x - (xs !! i) x"
       by (auto simp: stream.pred_set)
     also have "\<dots> \<le> (xs !! j) x"
       using assms(1) \<open>x \<in> \<X>\<close> unfolding V_def by (auto simp: stream.pred_set)
     finally have "unbounded x ([xs !! j]\<^sub>\<R>)"
       using assms \<open>x \<in> \<X>\<close> by (intro gt_unboundedD) (auto simp: stream.pred_set)
     moreover from dur_monoD[of xs i j] j A have "\<forall>j' \<ge> j. \<not> zero x ([xs !! j']\<^sub>\<R>)" by auto
     ultimately have "\<forall>i\<ge>j. unbounded x ([xs !! i]\<^sub>\<R>)"
       using elapsed assms x by (auto intro: not_reset_unbounded simp: stream.pred_set)
     with bounded have False by auto
   }
   then show "\<exists>j\<ge>i. zero x ([xs !! j]\<^sub>\<R>)" by auto
   { assume A: "\<forall>j \<ge> i. zero x ([xs !! j]\<^sub>\<R>)"
     from div obtain j where j: "dur xs j > dur xs i" unfolding divergent_def by auto
     then have "j \<ge> i" by (auto dest: dur_monoD)
     from A have "\<forall>j \<ge> i. zero x (?\<omega> !! j)" by auto
     with dur_zero_tail[OF xs_\<omega> _ x \<open>i \<le> j\<close> elapsed] j have False by simp
   }
   then show "\<exists>j\<ge>i. \<not> zero x ([xs !! j]\<^sub>\<R>)" by auto
 qed
 
 lemma (in -)
   fixes f :: "nat \<Rightarrow> real"
   assumes "\<forall> i. f i \<ge> 0" "\<forall> i. \<exists> j \<ge> i. f j > d" "d > 0"
   shows "\<exists> n. (\<Sum> i \<le> n. f i) > t"
   oops
 
 (* TODO: Reduce this proof to a more general theorem *)
 lemma dur_ev_exceedsI:
   assumes "\<forall> i. \<exists> j \<ge> i. dur xs j - dur xs i \<ge> d" and "d > 0"
   obtains i where "dur xs i > t"
 proof -
   have base: "\<exists> i. dur xs i > t" if "t < d" for t
   proof -
     from assms obtain j where "dur xs j - dur xs 0 \<ge> d" by fastforce
     with dur_pos[of xs 0] have "dur xs j \<ge> d" by simp
     with \<open>d > 0\<close> \<open>t < d\<close> show ?thesis by - (rule exI[where x = j]; auto)
   qed
   have base2: "\<exists> i. dur xs i > t" if "t \<le> d" for t
   proof (cases "t = d")
     case False
     with \<open>t \<le> d\<close> base show ?thesis by simp
   next
     case True
     from base \<open>d > 0\<close> obtain i where "dur xs i > 0" by auto
     moreover from assms obtain j where "dur xs j - dur xs i \<ge> d" by auto
     ultimately have "dur xs j > d" by auto
     with \<open>t = d\<close> show ?thesis by auto
   qed
   show ?thesis
   proof (cases "t \<ge> 0")
     case False
     with dur_pos have "dur xs 0 > t" by auto
     then show ?thesis by (fastforce intro: that)
   next
     case True
     let ?m = "nat \<lceil>t / d\<rceil>"
     from True have "\<exists> i. dur xs i > ?m * d"
     proof (induction ?m arbitrary: t)
       case 0
       with base[OF \<open>0 < d\<close>] show ?case by simp
     next
       case (Suc n t)
       let ?t = "t - d"
       show ?case
       proof (cases "t \<ge> d")
         case True
         have "?t / d = t / d - 1"
         (* Generated by sledgehammer *)
         (* Alternative: by (smt assms(2) diff_divide_distrib divide_self_if) *)
         proof -
           have "t / d + - 1 * ((t + - 1 * d) / d) + - 1 * (d / d) = 0"
             by (simp add: diff_divide_distrib)
           then have "t / d + - 1 * ((t + - 1 * d) / d) = 1"
             using assms(2) by fastforce
           then show ?thesis
             by algebra
         qed
         then have "\<lceil>?t / d\<rceil> = \<lceil>t / d\<rceil> - 1" by simp
         with \<open>Suc n = _\<close> have "n = nat \<lceil>?t / d\<rceil>" by simp
         with Suc \<open>t \<ge> d\<close> obtain i where "nat \<lceil>?t / d\<rceil> * d < dur xs i" by fastforce
         from assms obtain j where "dur xs j - dur xs i \<ge> d" "j \<ge> i" by auto
         with \<open>dur xs i > _\<close> have "nat \<lceil>?t / d\<rceil> * d + d < dur xs j" by simp
         with True have "dur xs j > nat \<lceil>t / d\<rceil> * d"
         by (metis Suc.hyps(2) \<open>n = nat \<lceil>(t - d) / d\<rceil>\<close> add.commute distrib_left mult.commute 
                   mult.right_neutral of_nat_Suc) 
         then show ?thesis by blast
       next
         case False
         with \<open>t \<ge> 0\<close> \<open>d > 0\<close> have "nat \<lceil>t / d\<rceil> \<le> 1" by simp
         then have "nat \<lceil>t / d\<rceil> * d \<le> d"
         by (metis One_nat_def \<open>Suc n = _\<close> Suc_leI add.right_neutral le_antisym mult.commute
                   mult.right_neutral of_nat_0 of_nat_Suc order_refl zero_less_Suc) 
         with base2 show ?thesis by auto
       qed
     qed
     then obtain i where "dur xs i > ?m * d" by atomize_elim
     moreover from \<open>t \<ge> 0\<close> \<open>d > 0\<close> have "?m * d \<ge> t"
       using pos_divide_le_eq real_nat_ceiling_ge by blast
     ultimately show ?thesis using that[of i] by simp
   qed
 qed
 
 lemma not_reset_mono:
   assumes "stream_trans xs" "shd xs c1 \<ge> shd xs c2" "stream_all (\<lambda> u. u \<in> V) xs" "c2 \<in> \<X>"
   shows "(holds (\<lambda> u. u c1 \<ge> u c2) until holds (\<lambda> u. u c1 = 0)) xs" using assms
 proof (coinduction arbitrary: xs)
   case prems: (UNTIL xs)
   let ?xs = "stl xs"
   let ?x = "shd xs"
   let ?y = "shd ?xs"
   show ?case
   proof (cases "?x c1 = 0")
     case False
     show ?thesis
     proof (cases "?y c1 = 0")
       case False
       from prems have "trans ?x ?y" by (intro pairwise_pairD[of trans])
       then have "?y c1 \<ge> ?y c2"
       proof cases
         case A: (reset t)
         show ?thesis
         proof (cases "c1 \<in> set t")
           case True
           with A False show ?thesis by auto
         next
           case False
           from prems have "?x c2 \<ge> 0" by (auto simp: V_def)
           with A have "?y c2 \<le> ?x c2" by (cases "c2 \<in> set t") auto
           with A False \<open>?x c1 \<ge> ?x c2\<close> show ?thesis by auto
         qed
       qed (use prems in \<open>auto simp: cval_add_def\<close>)
       moreover from prems have "stream_trans ?xs" "stream_all (\<lambda> u. u \<in> V) ?xs"
         by (auto intro: pairwise_stlD stl_sset)
       ultimately show ?thesis
         using prems by auto
     qed (use prems in \<open>auto intro: UNTIL.base\<close>)
   qed auto
 qed
 
 lemma \<R>_divergent_divergent_aux:
   fixes xs :: "('c, t) cval stream"
   assumes "stream_trans xs" "stream_all (\<lambda> u. u \<in> V) xs"
           "(xs !! i) c1 = 0" "\<exists> k > i. k \<le> j \<and> (xs !! k) c2 = 0"
           "\<forall> k > i. k \<le> j \<longrightarrow> (xs !! k) c1 \<noteq> 0"
           "c1 \<in> \<X>" "c2 \<in> \<X>"
   shows "(xs !! j) c1 \<ge> (xs !! j) c2"
 proof -
   from assms obtain k where k: "k > i" "k \<le> j" "(xs !! k) c2 = 0" by auto
   with assms(5) \<open>k \<le> j\<close> have "(xs !! k) c1 \<noteq> 0" by auto
   moreover from assms(2) \<open>c1 \<in> \<X>\<close> have "(xs !! k) c1 \<ge> 0" by (auto simp: V_def)
   ultimately have "(xs !! k) c1 > 0" by auto
   with \<open>(xs !! k) c2 = 0\<close> have "shd (sdrop k xs) c1 \<ge> shd (sdrop k xs) c2" by auto
   from not_reset_mono[OF _ this] assms have
     "(holds (\<lambda>u. u c2 \<le> u c1) until holds (\<lambda>u. u c1 = 0)) (sdrop k xs)"
   by (auto intro: sset_sdrop pairwise_sdropD)
   from assms(5) k(2) \<open>k > i\<close> have "\<forall> m \<le> j - k. (sdrop k xs !! m) c1 \<noteq> 0" by simp
   with holds_untilD[OF \<open>(_ until _) _\<close>, of "j - k"] have
     "(sdrop k xs !! (j - k)) c2 \<le> (sdrop k xs !! (j - k)) c1" .
   then show "(xs !! j) c2 \<le> (xs !! j) c1" using k(1,2) by simp
 qed
 
 lemma unbounded_all:
   assumes "R \<in> \<R>" "u \<in> R" "unbounded x R" "x \<in> \<X>"
   shows "u x > k x"
 proof -
   from assms obtain I r where R: "R = region \<X> I r" "valid_region \<X> k I r" unfolding \<R>_def by auto
   with unbounded_Greater \<open>x \<in> \<X>\<close> assms(3) have "I x = Greater (k x)" by simp
   with \<open>u \<in> R\<close> R \<open>x \<in> \<X>\<close> show ?thesis by force
 qed
 
 lemma trans_not_delay_mono:
   "u' c \<le> u c" if "trans u u'" "u \<in> V" "x \<in> \<X>" "u' x = 0" "c \<in> \<X>"
   using \<open>trans u u'\<close>
 proof (cases)
   case (reset l)
   with that show ?thesis by (cases "c \<in> set l") (auto simp: V_def)
 qed (use that in \<open>auto simp: cval_add_def V_def add_nonneg_eq_0_iff\<close>)
 
 lemma dur_reset:
   assumes "pairwise eq_elapsed xs" "pred_stream (\<lambda> u. u \<in> V) xs" "zero x ([xs !! Suc i]\<^sub>\<R>)" "x \<in> \<X>"
   shows "dur xs (Suc i) - dur xs i = 0"
 proof -
   from assms(2) have in_V: "xs !! Suc i \<in> V"
     unfolding stream.pred_set by auto (metis snth.simps(2) snth_sset)
   with elapsed_ge_pos[of "xs !! i" "xs !! Suc i" x] pairwise_Suc[OF assms(1)] assms(2-) have
     "elapsed (xs !! i) (xs !! Suc i) \<le> (xs !! Suc i) x"
     unfolding stream.pred_set by auto
   with in_V assms(3) have "elapsed (xs !! i) (xs !! Suc i) \<le> 0" by (auto simp: zeroD)
   with elapsed_ge0[of "xs !! i" "xs !! Suc i"] have "elapsed (xs !! i) (xs !! Suc i) = 0"
     by linarith
   then show ?thesis by (subst dur_Suc)
 qed
 
 lemma resets_mono_0':
   assumes "pairwise eq_elapsed xs" "stream_all (\<lambda> u. u \<in> V) xs" "stream_trans xs"
           "\<forall> j \<le> i. zero x ([xs !! j]\<^sub>\<R>)" "x \<in> \<X>" "c \<in> \<X>"
   shows "(xs !! i) c = (xs !! 0) c \<or> (xs !! i) c = 0"
 using assms proof (induction i)
   case 0
   then show ?case by auto
 next        
   case (Suc i)
   from Suc.prems have *: "(xs !! Suc i) x = 0" "(xs !! i) x = 0"
     by (blast intro: zeroD snth_sset, force intro: zeroD snth_sset)
   from pairwise_Suc[OF Suc.prems(3)] have "trans (xs !! i) (xs !! Suc i)" .
   then show ?case
   proof cases
     case prems: (succ t)
     with * have "t = 0" unfolding cval_add_def by auto
     with prems have "(xs !! Suc i) c = (xs !! i) c" unfolding cval_add_def by auto
     with Suc show ?thesis by auto
   next
     case prems: (reset l)
     then have "(xs !! Suc i) c = 0 \<or> (xs !! Suc i) c = (xs !! i) c" by (cases "c \<in> set l") auto
     with Suc show ?thesis by auto
   next
     case id
     with Suc show ?thesis by auto
   qed
 qed
 
 lemma resets_mono':
   assumes "pairwise eq_elapsed xs" "pred_stream (\<lambda> u. u \<in> V) xs" "stream_trans xs"
           "\<forall> k \<ge> i. k \<le> j \<longrightarrow> zero x ([xs !! k]\<^sub>\<R>)" "x \<in> \<X>" "c \<in> \<X>" "i \<le> j"
   shows "(xs !! j) c = (xs !! i) c \<or> (xs !! j) c = 0" using assms
 proof -
   from assms have 1: "stream_all (\<lambda> u. u \<in> V) (sdrop i xs)"
     using sset_sdrop unfolding stream.pred_set by force
   from assms have 2: "pairwise eq_elapsed (sdrop i xs)" by (intro pairwise_sdropD)
   from assms have 3: "stream_trans (sdrop i xs)" by (intro pairwise_sdropD)
   from assms have 4:
     "\<forall>k\<le>j - i. zero x ([sdrop i xs !! k]\<^sub>\<R>)"
-  by (simp add: Nat.le_diff_conv2 assms(6))
+  by (simp add: le_diff_conv2 assms(6))
   from resets_mono_0'[OF 2 1 3 4 assms(5,6)] \<open>i \<le> j\<close> show ?thesis by simp
 qed
 
 lemma resets_mono:
   assumes "pairwise eq_elapsed xs" "pred_stream (\<lambda> u. u \<in> V) xs" "stream_trans xs"
           "\<forall> k \<ge> i. k \<le> j \<longrightarrow> zero x ([xs !! k]\<^sub>\<R>)" "x \<in> \<X>" "c \<in> \<X>" "i \<le> j"
   shows "(xs !! j) c \<le> (xs !! i) c" using assms
   using assms by (auto simp: V_def dest: resets_mono'[where c = c] simp: stream.pred_set)
 
 lemma \<R>_divergent_divergent_aux2:
   fixes M :: "(nat \<Rightarrow> bool) set"
   assumes "\<forall> i. \<forall> P \<in> M. \<exists> j \<ge> i. P j" "M \<noteq> {}" "finite M"
   shows "\<forall>i.\<exists>j\<ge>i.\<exists>k>j.\<exists> P \<in> M. P j \<and> P k \<and> (\<forall> m < k. j < m \<longrightarrow> \<not> P m)
        \<and> (\<forall> Q \<in> M. \<exists> m \<le> k. j < m \<and> Q m)"
 proof
   fix i
   let ?j1 = "Max {LEAST m. m > i \<and> P m | P. P \<in> M}"
   from \<open>M \<noteq> {}\<close> obtain P where "P \<in> M" by auto
   let ?m = "LEAST m. m > i \<and> P m"
   from assms(1) \<open>P \<in> M\<close> obtain j where "j \<ge> Suc i" "P j" by auto
   then have "j > i" "P j" by auto
   with \<open>P \<in> M\<close> have "?m > i \<and> P ?m" by - (rule LeastI; auto)
   moreover with \<open>finite M\<close> \<open>P \<in> M\<close> have "?j1 \<ge> ?m" by - (rule Max_ge; auto)
   ultimately have "?j1 \<ge> i" by simp
   moreover have "\<exists> m > i. m \<le> ?j1 \<and> P m" if "P \<in> M" for P
   proof -
     let ?m = "LEAST m. m > i \<and> P m"
     from assms(1) \<open>P \<in> M\<close> obtain j where "j \<ge> Suc i" "P j" by auto
     then have "j > i" "P j" by auto
     with \<open>P \<in> M\<close> have "?m > i \<and> P ?m" by - (rule LeastI; auto)
     moreover with \<open>finite M\<close> \<open>P \<in> M\<close> have "?j1 \<ge> ?m" by - (rule Max_ge; auto)
     ultimately show ?thesis by auto
   qed
   ultimately obtain j1 where j1: "j1 \<ge> i" "\<forall> P \<in> M. \<exists> m > i. j1 \<ge> m \<and> P m" by auto
   define k where "k Q = (LEAST k. k > j1 \<and> Q k)" for Q
   let ?k = "Max {k Q | Q. Q \<in> M}"
   let ?P = "SOME P. P \<in> M \<and> k P = ?k"
   let ?j = "Max {j. i \<le> j \<and> j \<le> j1 \<and> ?P j}"
   have "?k \<in> {k Q | Q. Q \<in> M}" using assms by - (rule Max_in; auto)
   then obtain P where P: "k P = ?k" "P \<in> M" by auto
   have "?k \<ge> k Q" if "Q \<in> M" for Q using assms that by - (rule Max_ge; auto)
   have *: "?P \<in> M \<and> k ?P = ?k" using P by - (rule someI[where x = P]; auto)
   with j1 have "\<exists> m > i. j1 \<ge> m \<and> ?P m" by auto
   with \<open>finite _\<close> have "?j \<in> {j. i \<le> j \<and> j \<le> j1 \<and> ?P j}" by - (rule Max_in; auto)
   have k: "k Q > j1 \<and> Q (k Q)" if "Q \<in> M" for Q
   proof -
     from assms(1) \<open>Q \<in> M\<close> obtain m where "m \<ge> Suc j1" "Q m" by auto
     then have "m > j1" "Q m" by auto
     then show "k Q > j1 \<and> Q (k Q)" unfolding k_def by - (rule LeastI; blast)
   qed
   with * \<open>?j \<in> _\<close> have "?P ?k" "?j < ?k" by fastforce+
   have "\<not> ?P m" if "?j < m" "m < ?k" for m
   proof (rule ccontr, simp)
     assume "?P m"
     have "m > j1"
     proof (rule ccontr)
       assume "\<not> j1 < m"
       with \<open>?j < m\<close> \<open>?j \<in> _\<close> have "i \<le> m" "m \<le> j1" by auto
       with \<open>?P m\<close> \<open>finite _\<close> have "?j \<ge> m" by - (rule Max_ge; auto)
       with \<open>?j < m\<close> show False by simp
     qed
     with \<open>?P m\<close> \<open>finite _\<close> have "k ?P \<le> m" unfolding k_def by (auto intro: Least_le)
     with * \<open>m < ?k\<close> show False by auto
   qed
   moreover have "\<exists> m \<le> ?k. ?j < m \<and> Q m" if "Q \<in> M" for Q
   proof -
     from k[OF \<open>Q \<in> M\<close>] have "k Q > j1 \<and> Q (k Q)" .
     moreover with \<open>finite _\<close> \<open>Q \<in> M\<close> have "k Q \<le> ?k" by - (rule Max_ge; auto)
     moreover with \<open>?j \<in> _\<close> \<open>k Q > _ \<and> _\<close> have "?j < k Q" by auto
     ultimately show ?thesis by auto
   qed
   ultimately show
     "\<exists>j\<ge>i.\<exists>k>j.\<exists> P \<in> M. P j \<and> P k \<and> (\<forall> m < k. j < m \<longrightarrow> \<not> P m)
        \<and> (\<forall> Q \<in> M. \<exists> m \<le> k. j < m \<and> Q m)"
     using \<open>?j < ?k\<close> \<open>?j \<in> _\<close> \<open>?P ?k\<close> * by (inst_existentials ?j ?k ?P; blast)
 qed
 
 lemma \<R>_divergent_divergent:
   assumes in_S: "pred_stream (\<lambda> u. u \<in> V) xs"
     and div: "\<R>_div (smap (\<lambda> u. [u]\<^sub>\<R>) xs)"
     and trans: "stream_trans xs"
     and trans': "pairwise trans' xs"
     and unbounded_not_const:
     "\<forall>u. (\<forall>c\<in>\<X>. real (k c) < u c) \<longrightarrow> \<not> ev (alw (\<lambda>xs. shd xs = u)) xs"
   shows "divergent xs"
   unfolding divergent_def proof
   fix t
   from pairwise_trans_eq_elapsed[OF trans in_S] have eq_elapsed: "pairwise eq_elapsed xs" .
   define X1 where "X1 = {x. x \<in> \<X> \<and> (\<exists>i. \<forall> j \<ge> i. unbounded x ([xs !! j]\<^sub>\<R>))}"
   let ?i = "Max {(SOME i. \<forall> j \<ge> i. unbounded x ([xs !! j]\<^sub>\<R>)) | x. x \<in> \<X>}"
   from finite(1) non_empty have
     "?i \<in> {(SOME i. \<forall> j \<ge> i. unbounded x ([xs !! j]\<^sub>\<R>)) | x. x \<in> \<X>}"
     by (intro Max_in) auto
   have "unbounded x ([xs !! j]\<^sub>\<R>)" if "x \<in> X1" "j \<ge> ?i" for x j
   proof -
     have "X1 \<subseteq> \<X>" unfolding X1_def by auto
     with finite(1) non_empty \<open>x \<in> X1\<close> have *:
       "?i \<ge> (SOME i. \<forall> j \<ge> i. unbounded x ([xs !! j]\<^sub>\<R>))" (is "?i \<ge> ?k")
       by (intro Max_ge) auto
     from \<open>x \<in> X1\<close> have "\<exists> k. \<forall> j \<ge> k. unbounded x ([xs !! j]\<^sub>\<R>)" by (auto simp: X1_def)
     then have "\<forall> j \<ge> ?k. unbounded x ([xs !! j]\<^sub>\<R>)" by (rule someI_ex)
     moreover from \<open>j \<ge> ?i\<close> \<open>?i \<ge> _\<close> have "j \<ge> ?k" by auto
     ultimately show ?thesis by blast
   qed
   then obtain i where unbounded: "\<forall> x \<in> X1. \<forall> j \<ge> i. unbounded x ([xs !! j]\<^sub>\<R>)"
     using finite by auto
   show "\<exists> n. t < dur xs n"
   proof (cases "\<forall> x \<in> \<X>. (\<exists>i. \<forall> j \<ge> i. unbounded x ([xs !! j]\<^sub>\<R>))")
     case True
     then have "X1 = \<X>" unfolding X1_def by auto
     have "\<exists>k\<ge>j. 0.5 \<le> dur xs k - dur xs j" for j
     proof -
       let ?u = "xs !! max i j"
       from in_S have "?u \<in> [?u]\<^sub>\<R>" "[?u]\<^sub>\<R> \<in> \<R>"
         by (auto simp: stream.pred_set)
       moreover from unbounded \<open>X1 = \<X>\<close> have
         "\<forall> x \<in> \<X>. unbounded x ([?u]\<^sub>\<R>)"
         by force
       ultimately have "\<forall> x \<in> \<X>. ?u x > k x"
         by (auto intro: unbounded_all)
       with unbounded_not_const have "\<not> ev (alw (HLD {?u})) xs"
         unfolding HLD_iff by simp
       then obtain r where
         "r \<ge> max i j" "xs !! r \<noteq> xs !! Suc r"
         apply atomize_elim
         apply (simp add: not_ev_iff not_alw_iff)
         apply (drule alw_sdrop[where n = "max i j"])
         apply (drule alwD)
         apply (subst (asm) (3) stream.collapse[symmetric])
         apply simp
         apply (drule ev_neq_start_implies_ev_neq[simplified comp_def])
         using stream.collapse[of "sdrop (max i j) xs"] by (auto 4 3 elim: ev_sdropD)
       let ?k = "Suc r"
       from in_S have "xs !! ?k \<in> V" using snth_sset unfolding stream.pred_set by blast
       with in_S have *:
         "xs !! r \<in> [xs !! r]\<^sub>\<R>" "[xs !! r]\<^sub>\<R> \<in> \<R>"
         "xs !! ?k \<in> [xs !! ?k]\<^sub>\<R>" "[xs !! ?k]\<^sub>\<R> \<in> \<R>"
         by (auto simp: stream.pred_set)
       from \<open>r \<ge> _\<close> have "r \<ge> i" "?k \<ge> i" by auto
       with unbounded \<open>X1 = \<X>\<close> have
         "\<forall> x \<in> \<X>. unbounded x ([xs !! r]\<^sub>\<R>)" "\<forall> x \<in> \<X>. unbounded x ([xs !! ?k]\<^sub>\<R>)"
         by (auto simp del: snth.simps(2))
       with in_S have "\<forall> x \<in> \<X>. (xs !! r) x > k x" "\<forall> x \<in> \<X>. (xs !! ?k) x > k x"
         using * by (auto intro: unbounded_all)
       moreover from trans' have "trans' (xs !! r) (xs !! ?k)"
         using pairwise_Suc by auto
       ultimately have "(xs !! ?k) = (xs !! r) \<oplus> 0.5"
         unfolding trans'_def using \<open>xs !! r \<noteq> _\<close> by auto
       moreover from pairwise_Suc[OF eq_elapsed] have "eq_elapsed (xs !! r) (xs !! ?k)"
         by auto
       ultimately have 
         "dur xs ?k - dur xs r = 0.5"
         using non_empty by (auto simp: cval_add_def dur_Suc elapsed_eq)
       with dur_mono[of j r xs] \<open>r \<ge> max i j\<close> have "dur xs ?k - dur xs j \<ge> 0.5"
         by auto
       with \<open>r \<ge> max i j\<close> show ?thesis by - (rule exI[where x = ?k]; auto)
     qed
     then show ?thesis by - (rule dur_ev_exceedsI[where d = "0.5"]; auto)
   next
     case False
     define X2 where "X2 = \<X> - X1"
     from False have "X2 \<noteq> {}" unfolding X1_def X2_def by fastforce
     have inf_resets:
       "\<forall>i. (\<exists>j\<ge>i. zero x ([xs !! j]\<^sub>\<R>)) \<and> (\<exists>j\<ge>i. \<not> zero x ([xs !! j]\<^sub>\<R>))" if "x \<in> X2" for x
       using that div unfolding X1_def X2_def \<R>_div_def by fastforce
     have "\<exists> j \<ge> i. \<exists> k > j. \<exists> x \<in> X2. zero x ([xs !! j]\<^sub>\<R>) \<and> zero x ([xs !! k]\<^sub>\<R>)
           \<and> (\<forall> m. j < m \<and> m < k \<longrightarrow> \<not> zero x ([xs !! m]\<^sub>\<R>))
           \<and> (\<forall> x \<in> X2. \<exists> m. j < m \<and> m \<le> k \<and> zero x ([xs !! m]\<^sub>\<R>))
           \<and> (\<forall> x \<in> X1. \<forall> m \<ge> j. unbounded x ([xs !! m]\<^sub>\<R>))" for i
     proof -
       from unbounded obtain i' where i': "\<forall> x \<in> X1. \<forall> m \<ge> i'. unbounded x ([xs !! m]\<^sub>\<R>)" by auto
       then obtain i' where i':
         "i' \<ge> i" "\<forall> x \<in> X1. \<forall> m \<ge> i'. unbounded x ([xs !! m]\<^sub>\<R>)"
         by (cases "i' \<ge> i"; auto)
       from finite(1) have "finite X2" unfolding X2_def by auto
       with \<open>X2 \<noteq> {}\<close> \<R>_divergent_divergent_aux2[where M = "{\<lambda> i. zero x ([xs !! i]\<^sub>\<R>) | x. x \<in> X2}"]
         inf_resets
       have "\<exists>j\<ge>i'. \<exists>k>j. \<exists>P\<in>{\<lambda>i. zero x ([xs !! i]\<^sub>\<R>) |x. x \<in> X2}. P j \<and> P k
         \<and> (\<forall>m<k. j < m \<longrightarrow> \<not> P m) \<and> (\<forall>Q\<in>{\<lambda>i. zero x ([xs !! i]\<^sub>\<R>) |x. x \<in> X2}. \<exists>m\<le>k. j < m \<and> Q m)"
         by force
       then obtain j k x where
         "j \<ge> i'" "k > j" "x \<in> X2" "zero x ([xs !! j]\<^sub>\<R>)" "zero x ([xs !! k]\<^sub>\<R>)"
         "\<forall>m. j < m \<and> m < k \<longrightarrow> \<not> zero x ([xs !! m]\<^sub>\<R>)"
         "\<forall>Q\<in>{\<lambda>i. zero x ([xs !! i]\<^sub>\<R>) |x. x \<in> X2}. \<exists>m\<le>k. j < m \<and> Q m"
         by auto
       moreover from this(7) have "\<forall>x\<in>X2. \<exists>m \<le> k. j < m \<and> zero x ([xs !! m]\<^sub>\<R>)" by auto
       ultimately show ?thesis using i'
         by (inst_existentials j k x) auto
     qed
     moreover have "\<exists> j' \<ge> j. dur xs j' - dur xs i \<ge> 0.5"
       if  x: "x \<in> X2" "i < j" "zero x ([xs !! i]\<^sub>\<R>)" "zero x ([xs !! j]\<^sub>\<R>)"
         and not_reset: "\<forall> m. i < m \<and> m < j \<longrightarrow> \<not> zero x ([xs !! m]\<^sub>\<R>)"
         and X2: "\<forall> x \<in> X2. \<exists> m. i < m \<and> m \<le> j \<and> zero x ([xs !! m]\<^sub>\<R>)"
         and X1: "\<forall> x \<in> X1. \<forall> m \<ge> i. unbounded x ([xs !! m]\<^sub>\<R>)"
       for x i j
     proof -
       have "\<exists>j'>j. \<not> zero x ([xs !! j']\<^sub>\<R>)"
       proof -
         from inf_resets[OF x(1)] obtain j' where "j' \<ge> Suc j" "\<not> zero x ([xs !! j']\<^sub>\<R>)" by auto
         then show ?thesis by - (rule exI[where x = j']; auto)
       qed
       from inf_resets[OF x(1)] obtain j' where "j' \<ge> Suc j" "\<not> zero x ([xs !! j']\<^sub>\<R>)" by auto
       with nat_eventually_critical_path[OF x(4) this(2)]
       obtain j' where j':
         "j' > j" "\<not> zero x ([xs !! j']\<^sub>\<R>)" "\<forall> m \<ge> j. m < j' \<longrightarrow> zero x ([xs !! m]\<^sub>\<R>)"
         by auto
       from \<open>x \<in> X2\<close> have "x \<in> \<X>" unfolding X2_def by simp
       with \<open>i < j\<close> not_reset not_reset_dur \<open>stream_trans _\<close> in_S pairwise_Suc[OF eq_elapsed] have
         "dur xs (j - 1) - dur xs i = (xs !! (j - 1)) x - (xs !! i) x" (is "?d1 = ?d2")
         by (auto simp: stream.pred_set)
       moreover from \<open>zero x ([xs !! i]\<^sub>\<R>)\<close> in_S have "(xs !! i) x = 0"
         by (auto intro: zeroD simp: stream.pred_set)
       ultimately have
         "dur xs (j - 1) - dur xs i = (xs !! (j - 1)) x" (is "?d1 = ?d2")
         by simp
       show ?thesis
       proof (cases "?d1 \<ge> 0.5")
         case True
           (* XXX Fix SMT *)
         with dur_mono[of "j - 1" j xs] have
           "5 / 10 \<le> dur xs j - dur xs i"
           by simp
         then show ?thesis by blast
       next
         case False
         have j_c_bound: "(xs !! j) c \<le> ?d2" if "c \<in> X2" for c
         proof (cases "(xs !! j) c = 0")
           case True
           from in_S \<open>j > _\<close> True \<open>x \<in> \<X>\<close> show ?thesis by (auto simp: V_def stream.pred_set)
         next
           case False
           from X2 \<open>c \<in> X2\<close> in_S have "\<exists>k>i. k \<le> j \<and> (xs !! k) c = 0"
             by (force simp: zeroD stream.pred_set)
           with False have
             "\<exists>k>i. k \<le> j - Suc 0 \<and> (xs !! k) c = 0"
             by (metis Suc_le_eq Suc_pred linorder_neqE_nat not_less not_less_zero)
           moreover from that have "c \<in> \<X>" by (auto simp: X2_def)
           moreover from not_reset in_S \<open>x \<in> \<X>\<close> have
             "\<forall>k>i. k \<le> j - 1 \<longrightarrow> (xs !! k) x \<noteq> 0"
             by (auto simp: zeroI stream.pred_set)
           ultimately have
             "(xs !! (j - 1)) c \<le> ?d2"
             using trans in_S \<open>_ x = 0\<close> \<open>x \<in> \<X>\<close>
             by (auto intro: \<R>_divergent_divergent_aux that simp: stream.pred_set)
           moreover from
             trans_not_delay_mono[OF pairwise_Suc[OF trans], of "j - 1"]
             \<open>x \<in> \<X>\<close> \<open>c \<in> \<X>\<close> \<open>j > _\<close> in_S x(4)
           have "(xs !! j) c \<le> (xs !! (j - 1)) c" by (auto simp: zeroD stream.pred_set)
           ultimately show ?thesis by auto
         qed
         moreover from False \<open>?d1 = ?d2\<close> have "?d2 < 1" by auto
         moreover from in_S have "(xs !! j) c \<ge> 0" if "c \<in> \<X>" for c
           using that by (auto simp: V_def stream.pred_set)
         ultimately have frac_bound: "frac ((xs !! j) c) \<le> ?d2" if "c \<in> X2" for c
           using that frac_le_1I by (force simp: X2_def)
 
         let ?u = "(xs !! j)"
         from in_S have "[xs !! j]\<^sub>\<R> \<in> \<R>" by (auto simp: stream.pred_set)
         then obtain I r where region:
           "[xs !! j]\<^sub>\<R> = region \<X> I r" "valid_region \<X> k I r"
           unfolding \<R>_def by auto
         let ?S = "{frac (?u c) | c. c \<in> \<X> \<and> isIntv (I c)}"
         have \<X>_X2: "c \<in> X2" if "c \<in> \<X>" "isIntv (I c)" for c
         proof -
           from X1 \<open>j > i\<close> have "\<forall>x\<in>X1. unbounded x ([xs !! j]\<^sub>\<R>)" by auto
           with unbounded_Greater[OF region(2) \<open>c \<in> \<X>\<close>] region(1) that(2) have "c \<notin> X1" by auto
           with \<open>c \<in> \<X>\<close> show "c \<in> X2" unfolding X2_def by auto
         qed
         have frac_bound: "frac ((xs !! j) c) \<le> ?d2" if "c \<in> \<X>" "isIntv (I c)" for c
           using frac_bound[OF \<X>_X2] that .
         have "dur xs (j' - 1) = dur xs j" using j' \<open>x \<in> \<X>\<close> in_S eq_elapsed
           by (subst dur_zero_tail[where \<omega> = "smap (\<lambda> u. [u]\<^sub>\<R>) xs"])
             (auto dest: pairwise_Suc simp: stream.pred_set)
         moreover from dur_reset[OF eq_elapsed in_S, of x "j - 1"] \<open>x \<in> \<X>\<close> x(4) \<open>j > _\<close> have
           "dur xs j = dur xs (j - 1)"
           by (auto simp: stream.pred_set)
         ultimately have "dur xs (j' - 1) = dur xs (j - 1)" by auto
         moreover have "dur xs j' - dur xs (j' - 1) \<ge> (1 - ?d2) / 2"
         proof -
           from \<open>j' > _\<close> have "j' > 0" by auto
           with pairwise_Suc[OF trans', of "j' - 1"] have
             "trans' (xs !! (j' - 1)) (xs !! j')"
             by auto
           moreover from j' have
             "(xs !! (j' - 1)) x = 0" "(xs !! j') x > 0"
             using in_S \<open>x \<in> \<X>\<close> by (force intro: zeroD dest: not_zeroD simp: stream.pred_set)+
           moreover note delayedR_aux = calculation
           obtain t where
             "(xs !! j') = (xs !! (j' - 1)) \<oplus> t" "t \<ge> (1 - ?d2) / 2" "t \<ge> 0"
           proof -
             from in_S have "[xs !! j']\<^sub>\<R> \<in> \<R>" by (auto simp: stream.pred_set)
             then obtain I' r' where region':
               "[xs !! j']\<^sub>\<R> = region \<X> I' r'" "valid_region \<X> k I' r'"
               unfolding \<R>_def by auto            
             let ?S' = "{frac ((xs !! (j' - 1)) c) |c. c \<in> \<X> \<and> Regions.isIntv (I' c)}"
 
             from finite(1) have "?d2 \<ge> Max (?S' \<union> {0})"
               apply -
               apply (rule Max.boundedI)
                 apply fastforce
                apply fastforce
               apply safe
               subgoal premises prems for _ c d
               proof -
                 from j' have "(xs !! (j' - 1)) c = ?u c \<or> (xs !! (j' - 1)) c = 0"
                   by (intro resets_mono'[OF eq_elapsed in_S trans _ \<open>x \<in> \<X>\<close> \<open>c \<in> \<X>\<close>]; auto)
                 then show ?thesis
                 proof (standard, goal_cases)
                   case A: 1
                   show ?thesis
                   proof (cases "c \<in> X1")
                     case True
                     with X1 \<open>j' > j\<close> \<open>j > i\<close> have "unbounded c ([xs !! j']\<^sub>\<R>)" by auto
                     with region' \<open>c \<in> \<X>\<close> have "I' c = Greater (k c)"
                       by (auto intro: unbounded_Greater)
                     with prems show ?thesis by auto
                   next
                     case False
                     with \<open>c \<in> \<X>\<close> have "c \<in> X2" unfolding X2_def by auto
                     with j_c_bound have mono: "(xs !! j) c \<le> (xs !! (j - 1)) x" .
                     from in_S \<open>c \<in> \<X>\<close> have "(xs !! (j' - 1)) c \<ge> 0"
                       unfolding V_def stream.pred_set by auto
                     then have
                       "frac ((xs !! (j' - 1)) c) \<le> (xs !! (j' - 1)) c"
                       using frac_le_self by auto
                     with A mono show ?thesis by auto
                   qed
                 next
                   case prems: 2
                     (* XXX *)
                   have "frac (0 :: real) = (0 :: real)" by auto
                   then have "frac (0 :: real) \<le> (0 :: real)" by linarith
                   moreover from in_S \<open>x \<in> \<X>\<close> have "(xs !! (j - 1)) x \<ge> 0"
                     unfolding V_def stream.pred_set by auto
                   ultimately show ?thesis using prems by auto
                 qed
               qed
               using in_S \<open>x \<in> \<X>\<close> by (auto simp: V_def stream.pred_set)
             then have le: "(1 - ?d2) / 2 \<le> (1 - Max (?S' \<union> {0})) / 2" by simp
 
             let ?u = "xs !! j'"
             let ?u' = "xs !! (j' - 1)"
             from in_S have *: "?u' \<in> V" "[?u']\<^sub>\<R> \<in> \<R>" "?u \<in> V" "[?u]\<^sub>\<R> \<in> \<R>"
               by (auto simp: stream.pred_set)
             from pairwise_Suc[OF trans, of "j' - 1"] \<open>j' > j\<close> have
               "trans (xs !! (j' - 1)) (xs !! j')"
               by auto
             then have Succ:
               "[xs !! j']\<^sub>\<R> \<in> Succ \<R> ([xs !! (j' - 1)]\<^sub>\<R>) \<and> (\<exists> t\<ge> 0. ?u = ?u' \<oplus> t)"
             proof cases
               case prems: (succ t)
               from * have "?u' \<in> [?u']\<^sub>\<R>" by auto
               with prems * show ?thesis by auto
             next
               case (reset l)
               with \<open>?u' \<in> V\<close> have "?u x \<le> ?u' x" by (cases "x \<in> set l") (auto simp: V_def)
               from j' have "zero x ([?u']\<^sub>\<R>)" by auto
               with \<open>?u' \<in> V\<close> have "?u' x = 0" unfolding zero_def by auto
               with \<open>?u x \<le> _\<close> \<open>?u x > 0\<close> show ?thesis by auto
             next
               case id
               with * Succ_refl[of \<R> \<X> k, folded \<R>_def, OF _ finite(1)] show ?thesis
                 unfolding cval_add_def by auto
             qed
             then obtain t where t: "?u = xs !! (j' - 1) \<oplus> t" "t \<ge> 0" by auto
             note Succ = Succ[THEN conjunct1]
 
             show ?thesis
             proof (cases "\<exists> c \<in> X2. \<exists> d :: nat. ?u c = d")
               case True
               from True obtain c and d :: nat where c:
                 "c \<in> \<X>" "c \<in> X2" "?u c = d"
                 by (auto simp: X2_def)
               have "?u x > 0" by fact
               from pairwise_Suc[OF eq_elapsed, of "j' - 1"] \<open>j' > j\<close> have
                 "eq_elapsed (xs !! (j' - 1)) ?u"
                 by auto
               moreover from
                 elapsed_eq[OF this \<open>x \<in> \<X>\<close>] \<open>(xs !! (j' - 1)) x = 0\<close> \<open>(xs !! j') x > 0\<close>
               have "elapsed (xs !! (j' - 1)) (xs !! j') > 0"
                 by auto
               ultimately have
                 "?u c - (xs !! (j' - 1)) c > 0"
                 using \<open>c \<in> \<X>\<close> unfolding eq_elapsed_def by auto
               moreover from in_S have "xs !! (j' - 1) \<in> V" by (auto simp: stream.pred_set)
               ultimately have "?u c > 0" using \<open>c \<in> \<X>\<close> unfolding V_def by auto
               from region' in_S \<open>c \<in> \<X>\<close> have "intv_elem c ?u (I' c)"
                 by (force simp: stream.pred_set)
               with \<open>?u c = d\<close> \<open>?u c > 0\<close> have "?u c \<ge> 1" by auto
               moreover have "(xs !! (j' - 1)) c \<le> 0.5"
               proof -
                 have "(xs !! (j' - 1)) c \<le> (xs !! j) c"
                   (* XXX This proof is duplicated at least once above *)
                   using j'(1,3)
                   by (auto intro: resets_mono[OF eq_elapsed in_S trans _ \<open>x \<in> \<X>\<close> \<open>c \<in> \<X>\<close>])
                 also have "\<dots> \<le> ?d2" using j_c_bound[OF \<open>c \<in> X2\<close>] .
                 also from \<open>?d1 = ?d2\<close> \<open>\<not> 5 / 10 \<le> _\<close> have "\<dots> \<le> 0.5" by simp
                 finally show ?thesis .
               qed
               moreover have "?d2 \<ge> 0" using in_S \<open>x \<in> \<X>\<close> by (auto simp: V_def stream.pred_set)
               ultimately have "?u c - (xs !! (j' - 1)) c \<ge> (1 - ?d2) / 2" by auto
               with t have "t \<ge> (1 - ?d2) / 2" unfolding cval_add_def by auto
               with t show ?thesis by (auto intro: that)
             next
               case F: False
               have not_const: "\<not> isConst (I' c)" if "c \<in> \<X>" for c
               proof (rule ccontr, simp)
                 assume A: "isConst (I' c)"
                 show False
                 proof (cases "c \<in> X1")
                   case True
                   with X1 \<open>j' > j\<close> \<open>j > _\<close> have "unbounded c ([xs !! j']\<^sub>\<R>)" by auto
                   with unbounded_Greater \<open>c \<in> \<X>\<close> region' have "isGreater (I' c)" by force
                   with A show False by auto
                 next
                   case False
                   with \<open>c \<in> \<X>\<close> have "c \<in> X2" unfolding X2_def by auto
                   from region' in_S \<open>c \<in> \<X>\<close> have "intv_elem c ?u (I' c)"
                     unfolding stream.pred_set  by force
                   with \<open>c \<in> X2\<close> A False F show False by auto
                 qed
               qed
               have "\<nexists>x. x \<le> k c \<and> (xs !! j') c = real x" if "c \<in> \<X>" for c
               proof (cases "c \<in> X2"; safe)
                 fix d
                 assume "c \<in> X2" "(xs !! j') c = real d"
                 with F show False by auto
               next
                 fix d
                 assume "c \<notin> X2" 
                 with that have "c \<in> X1" unfolding X2_def by auto
                 with X1 \<open>j' > j\<close> \<open>j > i\<close> have "unbounded c ([?u]\<^sub>\<R>)" by auto
                 from unbounded_all[OF _ _ this] \<open>c \<in> \<X>\<close> in_S have "?u c > k c"
                   by (force simp: stream.pred_set)
                 moreover assume "?u c = real d" "d \<le> k c"
                 ultimately show False by auto
               qed
               with delayedR_aux have
                 "(xs !! j') = delayedR ([xs !! j']\<^sub>\<R>) (xs !! (j' - 1))"
                 using \<open>x \<in> \<X>\<close> unfolding trans'_def by auto
               from not_const region'(1)  in_S Succ(1) have
                 "\<exists>t\<ge>0. delayedR ([xs !! j']\<^sub>\<R>) (xs !! (j' - 1)) = xs !! (j' - 1) \<oplus> t \<and>
                       (1 - Max (?S' \<union> {0})) / 2 \<le> t"
                 apply simp
                 apply (rule delayedR_correct(2)[OF _ _ region'(2), simplified])
                 by (auto simp: stream.pred_set)
               with le \<open>_ = delayedR _ _\<close> show ?thesis by (auto intro: that)
             qed
           qed
           moreover from pairwise_Suc[OF eq_elapsed, of "j' - 1"] \<open>j' > 0\<close> have
             "eq_elapsed (xs !! (j' - 1)) (xs !! j')"
             by auto
           ultimately show "dur xs j' - dur xs (j' - 1) \<ge> (1 - ?d2) / 2" 
             using \<open>j' > 0\<close> dur_Suc[of _ "j' - 1"] \<open>x \<in> \<X>\<close> by (auto simp: cval_add_def elapsed_eq)
         qed
         moreover from dur_mono[of i "j - 1" xs] \<open>i < j\<close> have "dur xs i \<le> dur xs (j - 1)" by simp
         ultimately have "dur xs j' - dur xs i \<ge> 0.5" unfolding \<open>?d1 = ?d2\<close>[symmetric] by auto
         then show ?thesis using \<open>j < j'\<close> by - (rule exI[where x = j']; auto)
       qed
     qed
     moreover
     have "\<exists> j' \<ge> i. dur xs j' - dur xs i \<ge> 0.5" for i
     proof -
       from calculation(1)[of i] obtain j k x where
         "j\<ge>i" "k>j" "x\<in>X2" "zero x ([xs !! j]\<^sub>\<R>)"
         "zero x ([xs !! k]\<^sub>\<R>)"
         "\<forall>m. j < m \<and> m < k \<longrightarrow> \<not> zero x ([xs !! m]\<^sub>\<R>)"
         "\<forall>x\<in>X2. \<exists>m>j. m \<le> k \<and> zero x ([xs !! m]\<^sub>\<R>)"
         "\<forall>x\<in>X1. \<forall>m\<ge>j. unbounded x ([xs !! m]\<^sub>\<R>)"
         by auto
       from calculation(2)[OF this(3,2,4-8)] obtain j' where
         "j'\<ge>k" "5 / 10 \<le> dur xs j' - dur xs j"
         by auto
       with dur_mono[of i j xs] \<open>j \<ge> i\<close> \<open>k > j\<close> show ?thesis by (intro exI[where x = j']; auto)
     qed
     then show ?thesis by - (rule dur_ev_exceedsI[where d = "0.5"]; auto)
   qed
 qed
 
 lemma cfg_on_div_absc:
   notes in_space_UNIV[measurable]
   assumes "cfg \<in> cfg_on_div st" "st \<in> S"
   shows "absc cfg \<in> R_G_cfg_on_div (abss st)"
 proof -
   from assms have *: "cfg \<in> MDP.cfg_on st" "state cfg = st" "div_cfg cfg"
     unfolding cfg_on_div_def by auto
   with assms have "cfg \<in> valid_cfg" by (auto intro: MDP.valid_cfgI)
   have "almost_everywhere (MDP.MC.T cfg) (MDP.MC.enabled cfg)"
     by (rule MDP.MC.AE_T_enabled)
   moreover from * have "AE x in MDP.MC.T cfg. divergent (smap (snd \<circ> state) x)"
     by (simp add: div_cfg_def)
   ultimately have "AE x in MDP.MC.T cfg. \<R>_div (smap (snd \<circ> state) (smap absc x))"
   proof eventually_elim
     case (elim \<omega>)
     let ?xs = "smap (snd o state) \<omega>"
     from MDP.pred_stream_cfg_on[OF \<open>_ \<in> valid_cfg\<close> \<open>MDP.MC.enabled _ _\<close>] have *:
       "pred_stream (\<lambda> x. x \<in> S) (smap state \<omega>)"
       by (auto simp: stream.pred_set)
     have "[snd (state x)]\<^sub>\<R> = snd (abss (state x))" if "x \<in> sset \<omega>" for x
     proof -
       from * that have "state x \<in> S" by (auto simp: stream.pred_set)
       then have "snd (abss (state x)) = [snd (state x)]\<^sub>\<R>" by (metis abss_S snd_conv surj_pair)
       then show ?thesis ..
     qed
     then have "smap (\<lambda>z. [snd (state z)]\<^sub>\<R>) \<omega> = (smap (\<lambda>z. snd (abss (state z))) \<omega>)" by auto
     from * have  "pred_stream (\<lambda> u. u \<in> V) ?xs"
       apply (simp add: map_def stream.pred_set)
       apply (subst (asm) surjective_pairing)
       using S_V by blast
     moreover have "stream_trans ?xs"
       by (rule enabled_stream_trans \<open>_ \<in> valid_cfg\<close> \<open>MDP.MC.enabled _ _\<close>)+
     ultimately show ?case using \<open>divergent _\<close> \<open>smap _ \<omega> = _\<close>
       by - (drule divergent_\<R>_divergent, auto simp add: stream.map_comp state_absc)
   qed
   with \<open>cfg \<in> valid_cfg\<close> have "R_G_div_cfg (absc cfg)" unfolding R_G_div_cfg_def
     by (subst absc_distr_self) (auto intro: MDP.valid_cfgI simp: AE_distr_iff)
   with R_G.valid_cfgD \<open>cfg \<in> valid_cfg\<close> * show ?thesis unfolding R_G_cfg_on_div_def by auto force
 qed
 
 definition
   "alternating cfg = (AE \<omega> in MDP.MC.T cfg.
       alw (ev (HLD {cfg. \<forall>cfg' \<in> K_cfg cfg. fst (state cfg') = fst (state cfg)})) \<omega>)"
 
 lemma K_cfg_same_loc_iff:
   "(\<forall>cfg'\<in> K_cfg cfg. fst (state cfg') = fst (state cfg))
   \<longleftrightarrow> (\<forall>cfg'\<in> K_cfg (absc cfg). fst (state cfg') = fst (state (absc cfg)))"
   if "cfg \<in> valid_cfg"
   using that by (auto simp: state_absc fst_abss K_cfg_map_absc)
 
 lemma (in -) stream_all2_flip:
   "stream_all2 (\<lambda>a b. R b a) xs ys = stream_all2 R ys xs"
   by (standard; coinduction arbitrary: xs ys; auto dest: sym)
 
 (* TODO: Lots of duplication here, e.g. with path_measure_eq_repcs1_new *)
 lemma AE_alw_ev_same_loc_iff:
   assumes "cfg \<in> valid_cfg"
   shows "alternating cfg \<longleftrightarrow> alternating (absc cfg)"
   unfolding alternating_def
   apply (simp add: MDP.MC.T.AE_iff_emeasure_eq_1)
   subgoal
   proof -
     show ?thesis (is "(?x = 1) = (?y = 1)")
     proof -
       have *: "stream_all2 (\<lambda>s t. t = absc s) x y = stream_all2 (=) y (smap absc x)" for x y
         by (subst stream_all2_flip) simp
       have "?x = ?y"
         apply (rule T_eq_rel_half[where f = absc and S = valid_cfg, OF HOL.refl, rotated 2])
         subgoal
           apply (simp add: space_stream_space rel_set_strong_def)
           apply (intro allI impI)
           apply (frule stream.rel_mono_strong[where Ra = "\<lambda>s t. t = absc s"])
           by (auto simp: * stream.rel_eq stream_all2_refl alw_holds_pred_stream_iff[symmetric]
               K_cfg_same_loc_iff HLD_def elim!: alw_ev_cong)
         subgoal
           by (rule rel_funI) (auto intro!: rel_pmf_reflI simp: pmf.rel_map(2) K_cfg_map_absc)
         using \<open>cfg \<in> valid_cfg\<close> by simp+
       then show ?thesis
         by simp
     qed
   qed
   done
 
 lemma AE_alw_ev_same_loc_iff':
   assumes "cfg \<in> R_G.cfg_on (abss st)" "st \<in> S"
   shows "alternating cfg \<longleftrightarrow> alternating (repcs st cfg)"
 proof -
   from assms have "cfg \<in> R_G.valid_cfg"
     by (auto intro: R_G.valid_cfgI)
   with assms show ?thesis
     by (subst AE_alw_ev_same_loc_iff) (auto simp: absc_repcs_id)
 qed
 
 lemma (in -) cval_add_non_id:
   False if "b \<oplus> d = b" "d > 0" for d :: real
 proof -
   from that(1) have "(b \<oplus> d) x = b x"
     by (rule fun_cong)
   with \<open>d > 0\<close> show False
     unfolding cval_add_def by simp
 qed
 
 lemma repcs_unbounded_AE_non_loop_end_strong:
   assumes "cfg \<in> R_G.cfg_on (abss st)" "st \<in> S"
     and "alternating cfg"
   shows "AE \<omega> in MDP.MC.T (repcs st cfg).
       (\<forall> u :: ('c \<Rightarrow> real). (\<forall> c \<in> \<X>. u c > real (k c)) \<longrightarrow>
       \<not> (ev (alw (\<lambda> xs. shd xs = u))) (smap (snd o state) \<omega>))" (is "AE \<omega> in ?M. ?P \<omega>")
 proof -
   from assms have "cfg \<in> R_G.valid_cfg"
     by (auto intro: R_G.valid_cfgI)
   with assms(1) have "repcs st cfg \<in> valid_cfg"
     by auto
   from R_G.valid_cfgD[OF \<open>cfg \<in> R_G.valid_cfg\<close>] have "cfg \<in> R_G.cfg_on (state cfg)" .
   let ?U = "\<lambda> u. \<Union> l \<in> L. {\<mu> \<in> K (l, u). \<mu> \<noteq> return_pmf (l, u) \<and> (\<forall> x \<in> \<mu>. fst x = l)}"
   let ?r = "\<lambda> u. Sup ({0} \<union> (\<lambda> \<mu>. measure_pmf \<mu> {x. snd x = u}) ` ?U u)"
   have lt_1: "?r u < 1" for u
   proof -
     have *: "emeasure (measure_pmf \<mu>) {x. snd x = u} < 1"
       if "\<mu> \<noteq> return_pmf (l, u)" "\<forall>x\<in>set_pmf \<mu>. fst x = l" for \<mu> and l :: 's
     proof (rule ccontr)
       assume "\<not> emeasure (measure_pmf \<mu>) {x. snd x = u} < 1"
       then have "1 = emeasure (measure_pmf \<mu>) {x. snd x = u}"
         using measure_pmf.emeasure_ge_1_iff by force
       also from that(2) have "\<dots> \<le> emeasure (measure_pmf \<mu>) {(l, u)}"
         by (subst emeasure_Int_set_pmf[symmetric]) (auto intro!: emeasure_mono)
       finally show False
         by (simp add: measure_pmf.emeasure_ge_1_iff measure_pmf_eq_1_iff that(1))
     qed
     let ?S =
       "{map_pmf (\<lambda> (X, l). (l, ([X := 0]u))) \<mu> | \<mu> l g. (l, g, \<mu>) \<in> trans_of A}"
     have "(\<lambda> \<mu>. measure_pmf \<mu> {x. snd x = u}) ` ?U u
       \<subseteq> {0, 1} \<union> (\<lambda> \<mu>. measure_pmf \<mu> {x. snd x = u}) ` ?S"
       by (force elim!: K.cases)
     moreover have "finite ?S"
     proof -
       have "?S \<subseteq> (\<lambda> (l, g, \<mu>). map_pmf (\<lambda> (X, l). (l, ([X := 0]u))) \<mu>) ` trans_of A"
         by force
       also from finite(3) have "finite \<dots>" ..
       finally show ?thesis .
     qed
     ultimately have "finite ((\<lambda> \<mu>. measure_pmf \<mu> {x. snd x = u}) ` ?U u)"
       by (auto intro: finite_subset)
     then show ?thesis
       by (fastforce intro: * finite_imp_Sup_less)
   qed
   { fix l :: 's and u :: "'c \<Rightarrow> real" and cfg :: "('s \<times> ('c \<Rightarrow> real) set) cfg"
     assume unbounded: "\<forall> c \<in> \<X>. u c > k c" and "cfg \<in> R_G.cfg_on (abss (l, u))" "abss (l, u) \<in> \<S>"
       and same_loc: "\<forall> cfg' \<in> K_cfg cfg. fst (state cfg') = l"
     then have "cfg \<in> R_G.valid_cfg" "repcs (l, u) cfg \<in> valid_cfg"
       by (auto intro: R_G.valid_cfgI)
     then have cfg_on: "repcs (l, u) cfg \<in> MDP.cfg_on (l, u)"
       by (auto dest: MDP.valid_cfgD)
     from \<open>cfg \<in> R_G.cfg_on _\<close> have "action cfg \<in> \<K> (abss (l, u))"
       by (rule R_G.cfg_onD_action)
         (* TODO: Pull out? *)
     have K_cfg_rept: "state ` K_cfg (repcs (l, u) cfg) = rept (l, u) (action cfg)"
       unfolding K_cfg_def by (force simp: action_repcs)
     have "l \<in> L"
       using MDP.valid_cfg_state_in_S \<open>repcs (l, u) cfg \<in> MDP.valid_cfg\<close> by fastforce
     moreover have "rept (l, u) (action cfg) \<noteq> return_pmf (l, u)"
     proof (rule ccontr, simp)
       assume "rept (l, u) (action cfg) = return_pmf (l, u)"
       then have "action cfg = return_pmf (abss (l, u))"
         using abst_rept_id[OF \<open>action cfg \<in> _\<close>]
         by (simp add: abst_def)
       moreover have "(l, u) \<in> S"
         using \<open>_ \<in> \<S>\<close> by (auto dest: \<S>_abss_S)
       moreover have "abss (l, u) = (l, [u]\<^sub>\<R>)"
         by (metis abss_S calculation(2))
       ultimately show False
         using \<open>rept (l, u) _ = _\<close> unbounded unfolding rept_def by (auto dest: cval_add_non_id)
     qed
     moreover have "rept (l, u) (action cfg) \<in> K (l, u)"
     proof -
       have "action (repcs (l, u) cfg) \<in> K (l, u)"
         using cfg_on by blast
       then show ?thesis
         by (simp add: repcs_def)
     qed
     moreover have "\<forall>x\<in>set_pmf (rept (l, u) (action cfg)). fst x = l"
       using same_loc K_cfg_same_loc_iff[of "repcs (l, u) cfg"]
         \<open>repcs (l, u) _ \<in> valid_cfg\<close> \<open>cfg \<in> R_G.valid_cfg\<close> \<open>cfg \<in> R_G.cfg_on _\<close>
       by (simp add: absc_repcs_id fst_abss K_cfg_rept[symmetric])
     ultimately have "rept (l, u) (action cfg) \<in> ?U u"
       by blast
     then have "measure_pmf (rept (l, u) (action cfg)) {x. snd x = u} \<le> ?r u"
       by (fastforce intro: Sup_upper)
     moreover have "rept (l, u) (action cfg) = action (repcs (l, u) cfg)"
       by (simp add: repcs_def)
     ultimately have "measure_pmf (action (repcs (l, u) cfg)) {x. snd x = u} \<le> ?r u"
       by auto
   }
   note * = this
   let ?S = "{cfg. \<exists> cfg' s. cfg' \<in> R_G.valid_cfg \<and> cfg = repcs s cfg' \<and> abss s = state cfg'}"
   have start: "repcs st cfg \<in> ?S"
     using \<open>cfg \<in> R_G.valid_cfg\<close> assms unfolding R_G_cfg_on_div_def
     by clarsimp (inst_existentials cfg "fst st" "snd st", auto)
   have step: "y \<in> ?S" if "y \<in> K_cfg x" "x \<in> ?S" for x y
     using that apply safe
     subgoal for cfg' l u
       apply (inst_existentials "absc y" "state y")
       subgoal
         by blast
       subgoal
         by (metis
             K_cfg_valid_cfgD R_G.valid_cfgD R_G.valid_cfg_state_in_S absc_repcs_id cont_absc_1
             cont_repcs1 repcs_valid
             )
       subgoal
         by (simp add: state_absc)
       done
     done
   have **: "x \<in> ?S" if "(repcs st cfg, x) \<in> MDP.MC.acc" for x
   proof -
     from MDP.MC.acc_relfunD[OF that] obtain n where "((\<lambda> a b. b \<in> K_cfg a) ^^ n) (repcs st cfg) x" .
     then show ?thesis
     proof (induction n arbitrary: x) (* XXX Extract induction rule *)
       case 0
       with start show ?case
         by simp
     next
       case (Suc n)
       from this(2)[simplified] show ?case
         apply (rule relcomppE)
         apply (erule step)
         apply (erule Suc.IH)
         done
     qed
   qed
   have ***: "almost_everywhere (MDP.MC.T (repcs st cfg)) (alw (HLD ?S))"
     by (rule AE_mp[OF MDP.MC.AE_T_reachable]) (fastforce dest: ** simp: HLD_iff elim: alw_mono)
 
   from \<open>alternating cfg\<close> assms have "alternating (repcs st cfg)"
     by (simp add: AE_alw_ev_same_loc_iff'[of _ st])
   then have alw_ev_same2: "almost_everywhere (MDP.MC.T (repcs st cfg))
      (alw (\<lambda>\<omega>. HLD (state -` snd -` {u}) \<omega> \<longrightarrow>
       ev (HLD {cfg. \<forall>cfg'\<in>set_pmf (K_cfg cfg). fst (state cfg') = fst (state cfg)}) \<omega>))"
     for u unfolding alternating_def by (auto elim: alw_mono)
 
   let ?X = "{cfg :: ('s \<times> ('c \<Rightarrow> real)) cfg. \<forall> c \<in> \<X>. snd (state cfg) c > k c}"
   let ?Y = "{cfg. \<forall> cfg' \<in> K_cfg cfg. fst (state cfg') = fst (state cfg)}"
 
   have "(AE \<omega> in ?M. ?P \<omega>) \<longleftrightarrow>
     (AE \<omega> in ?M. \<forall> u :: ('c \<Rightarrow> real).
       (\<forall> c \<in> \<X>. u c > k c) \<and> u \<in> snd ` state ` (MDP.MC.acc `` {repcs st cfg}) \<longrightarrow>
       \<not> (ev (alw (\<lambda> xs. shd xs = u))) (smap (snd o state) \<omega>))" (is "?L \<longleftrightarrow> ?R")
   proof
     assume ?L
     then show ?R
       by eventually_elim auto
   next
     assume ?R
     with MDP.MC.AE_T_reachable[of "repcs st cfg"] show ?L
     proof (eventually_elim, intro allI impI notI, goal_cases)
       case (1 \<omega> u)
       then show ?case
         by - (intro alw_HLD_smap alw_disjoint_ccontr[where
               S = "(snd o state) ` MDP.MC.acc `` {repcs st cfg}"
               and R = "{u}" and \<omega> = "smap (snd o state) \<omega>"
               ]; auto simp: HLD_iff)
     qed
   qed
 
   also have "\<dots> \<longleftrightarrow>
       (\<forall> u :: ('c \<Rightarrow> real).
         (\<forall> c \<in> \<X>. u c > k c) \<and> u \<in> snd ` state ` (MDP.MC.acc `` {repcs st cfg}) \<longrightarrow>
         (AE \<omega> in ?M. \<not> (ev (alw (\<lambda> xs. shd xs = u))) (smap (snd o state) \<omega>)))"
     using MDP.MC.countable_reachable[of "repcs st cfg"]
     by - (rule AE_all_imp_countable,
         auto intro: countable_subset[where B = "snd ` state ` MDP.MC.acc `` {repcs st cfg}"])
   also show ?thesis
     unfolding calculation
     apply clarsimp
     subgoal for l u x
       apply (rule
           MDP.non_loop_tail_strong[simplified, of snd "snd (state x)" ?Y ?S "?r (snd (state x))"]
           )
       subgoal
         apply safe
         subgoal premises prems for cfg l1 u1 _ cfg' l2 u2
         proof -
           have [simp]: "l2 = l1" "u2 = u1"
             subgoal
               by (metis MDP.cfg_onD_state Pair_inject prems(4) state_repcs)
             subgoal
               by (metis MDP.cfg_onD_state prems(4) snd_conv state_repcs)
             done
           with prems have [simp]: "u2 = u"
             by (metis \<open>(l, u) = state x\<close> \<open>snd (l1, u1) = snd (state x)\<close> \<open>u2 = u1\<close> snd_conv)
           have [simp]: "snd -` {snd (state x)} = {y. snd y = snd (state x)}"
             by (simp add: vimage_def)
           from prems show ?thesis
             apply simp
             apply (erule *[simplified])
             subgoal
               using prems(1) prems(2)[symmetric] prems(3-) by (auto simp: R_G.valid_cfg_def)
             subgoal
               using prems(1) prems(2)[symmetric] prems(3-) by (auto simp: R_G.valid_cfg_def)
             subgoal
               using K_cfg_same_loc_iff[of "repcs (l1, snd (state x)) cfg'"]
               by (simp add: absc_repcs_id) (metis fst_abss fst_conv repcs_valid)
             done
         qed
         done
       subgoal
         by (auto intro: lt_1[simplified])
         apply (rule MDP.valid_cfgD[OF \<open>repcs st cfg \<in> valid_cfg\<close>]; fail)
       subgoal
         using *** unfolding alw_holds_pred_stream_iff[symmetric] HLD_def .
       subgoal
         by (rule alw_ev_same2)
       done
     done
 qed
 
 lemma cfg_on_div_repcs_strong:
   notes in_space_UNIV[measurable]
   assumes "cfg \<in> R_G_cfg_on_div (abss st)" "st \<in> S" and "alternating cfg"
   shows "repcs st cfg \<in> cfg_on_div st"
 proof -
   let ?st = "abss st"
   let ?cfg = "repcs st cfg"
   from assms have *:
     "cfg \<in> R_G.cfg_on ?st" "state cfg = ?st" "R_G_div_cfg cfg"
     unfolding R_G_cfg_on_div_def by auto
   with assms have "cfg \<in> R_G.valid_cfg" by (auto intro: R_G.valid_cfgI)
   with \<open>st \<in> S\<close> \<open>_ = ?st\<close> have "?cfg \<in> valid_cfg" by auto
   from *(1) \<open>st \<in> S\<close> \<open>alternating cfg\<close> have
     "AE \<omega> in MDP.MC.T ?cfg. \<forall>u. (\<forall>c\<in>\<X>. real (k c) < u c) \<longrightarrow>
                           \<not> ev (alw (\<lambda>xs. shd xs = u)) (smap (snd \<circ> state) \<omega>)"
     by (rule repcs_unbounded_AE_non_loop_end_strong)
   \<comment> \<open>Move to lower level\<close>
   moreover from *(2,3) have "AE \<omega> in MDP.MC.T ?cfg. \<R>_div (smap (snd \<circ> state) (smap absc \<omega>))"
     unfolding R_G_div_cfg_def
     by (subst (asm) R_G_trace_space_distr_eq[OF \<open>cfg \<in> R_G.valid_cfg\<close>]; simp add: AE_distr_iff)
   ultimately have "div_cfg ?cfg"
     unfolding div_cfg_def using MDP.MC.AE_T_enabled[of ?cfg]
   proof eventually_elim
     case prems: (elim \<omega>)
       let ?xs = "smap (snd o state) \<omega>"
       from MDP.pred_stream_cfg_on[OF \<open>_ \<in> valid_cfg\<close> \<open>MDP.MC.enabled _ _\<close>] have *:
         "pred_stream (\<lambda> x. x \<in> S) (smap state \<omega>)"
         by (auto simp: stream.pred_set)
       have "[snd (state x)]\<^sub>\<R> = snd (abss (state x))" if "x \<in> sset \<omega>" for x
       proof -
         from * that have "state x \<in> S" by (auto simp: stream.pred_set)
         then have "snd (abss (state x)) = [snd (state x)]\<^sub>\<R>" by (metis abss_S snd_conv surj_pair)
         then show ?thesis ..
       qed
       then have "smap (\<lambda>z. [snd (state z)]\<^sub>\<R>) \<omega> = (smap (\<lambda>z. snd (abss (state z))) \<omega>)" by auto
       from * have  "pred_stream (\<lambda> u. u \<in> V) ?xs"
         by (simp add: map_def stream.pred_set, subst (asm) surjective_pairing, blast)
       moreover have "stream_trans ?xs"
         by (rule enabled_stream_trans \<open>_ \<in> valid_cfg\<close> \<open>MDP.MC.enabled _ _\<close>)+
       moreover have "pairwise trans' ?xs"
         using \<open>_ \<in> R_G.valid_cfg\<close> \<open>state cfg = _\<close>[symmetric] \<open>MDP.MC.enabled _ _\<close>
         by (rule enabled_stream_trans')
       moreover from prems(1) have
         "\<forall>u. (\<forall>c\<in>\<X>. real (k c) < u c) \<longrightarrow> \<not> ev (alw (\<lambda>xs. snd (shd xs) = u)) (smap state \<omega>)"
         by simp
       ultimately show ?case using \<open>\<R>_div _\<close>
         by (simp add: stream.map_comp state_absc \<open>smap _ \<omega> = _\<close> \<R>_divergent_divergent)
     qed
   with MDP.valid_cfgD \<open>cfg \<in> R_G.valid_cfg\<close> * show ?thesis unfolding cfg_on_div_def by auto force
 qed
 
 lemma repcs_unbounded_AE_non_loop_end:
   assumes "cfg \<in> R_G.cfg_on (abss st)" "st \<in> S"
   shows "AE \<omega> in MDP.MC.T (repcs st cfg).
       (\<forall> s :: ('s \<times> ('c \<Rightarrow> real)). (\<forall> c \<in> \<X>. snd s c > k c) \<longrightarrow>
       \<not> (ev (alw (\<lambda> xs. shd xs = s))) (smap state \<omega>))" (is "AE \<omega> in ?M. ?P \<omega>")
 proof -
   from assms have "cfg \<in> R_G.valid_cfg"
     by (auto intro: R_G.valid_cfgI)
   with assms(1) have "repcs st cfg \<in> valid_cfg"
     by auto
   from R_G.valid_cfgD[OF \<open>cfg \<in> R_G.valid_cfg\<close>] have "cfg \<in> R_G.cfg_on (state cfg)" .
   let ?K = "\<lambda> x. {\<mu> \<in> K x. \<mu> \<noteq> return_pmf x}"
   let ?r = "\<lambda> x. Sup ((\<lambda> \<mu>. measure_pmf \<mu> {x}) ` ?K x)"
   have lt_1: "?r x < 1" if "\<mu> \<in> ?K x" for \<mu> x
   proof -
     have *: "emeasure (measure_pmf \<mu>) {x} < 1" if "\<mu> \<noteq> return_pmf x" for \<mu>
     proof (rule ccontr)
       assume "\<not> emeasure (measure_pmf \<mu>) {x} < 1"
       then have "emeasure (measure_pmf \<mu>) {x} = 1"
         using measure_pmf.emeasure_ge_1_iff by force
       with that show False
         by (simp add: measure_pmf_eq_1_iff)
     qed
     let ?S =
       "{map_pmf (\<lambda> (X, l). (l, ([X := 0]u))) \<mu> | \<mu> l u g.
           x = (l, u) \<and> (l, g, \<mu>) \<in> trans_of A}"
     have "(\<lambda> \<mu>. measure_pmf \<mu> {x}) ` ?K x
       \<subseteq> {0, 1} \<union> (\<lambda> \<mu>. measure_pmf \<mu> {x}) ` ?S"
       by (force elim!: K.cases)
     moreover have "finite ?S"
     proof -
       have "?S \<subseteq> (\<lambda> (l, g, \<mu>). map_pmf (\<lambda> (X, l). (l, ([X := 0](snd x)))) \<mu>) ` trans_of A"
         by force
       also from finite(3) have "finite \<dots>" ..
       finally show ?thesis .
     qed
     ultimately have "finite ((\<lambda> \<mu>. measure_pmf \<mu> {x}) ` ?K x)"
       by (auto intro: finite_subset)
     then show ?thesis
       using that by (auto intro: * finite_imp_Sup_less)
   qed
   { fix s :: "'s \<times> ('c \<Rightarrow> real)" and cfg :: "('s \<times> ('c \<Rightarrow> real) set) cfg"
     assume unbounded: "\<forall> c \<in> \<X>. snd s c > k c" and "cfg \<in> R_G.cfg_on (abss s)" "abss s \<in> \<S>"
     then have "repcs s cfg \<in> valid_cfg"
       by (auto intro: R_G.valid_cfgI)
     then have cfg_on: "repcs s cfg \<in> MDP.cfg_on s"
       by (auto dest: MDP.valid_cfgD)
     from \<open>cfg \<in> _\<close> have "action cfg \<in> \<K> (abss s)"
       by (rule R_G.cfg_onD_action)
     have "rept s (action cfg) \<noteq> return_pmf s"
     proof (rule ccontr, simp)
       assume "rept s (action cfg) = return_pmf s"
       then have "action cfg = return_pmf (abss s)"
         using abst_rept_id[OF \<open>action cfg \<in> _\<close>]
         by (simp add: abst_def)
       moreover have "(fst s, snd s) \<in> S"
         using \<open>_ \<in> \<S>\<close> by (auto dest: \<S>_abss_S)
       moreover have "abss s = (fst s, [snd s]\<^sub>\<R>)"
         by (metis abss_S calculation(2) prod.collapse)
       ultimately show False
         using \<open>rept s _ = _\<close> unbounded unfolding rept_def by (cases s) (auto dest: cval_add_non_id)
     qed
     moreover have "rept s (action cfg) \<in> K s"
     proof -
       have "action (repcs s cfg) \<in> K s"
         using cfg_on by blast
       then show ?thesis
         by (simp add: repcs_def)
     qed
     ultimately have "rept s (action cfg) \<in> ?K s"
       by blast
     then have "measure_pmf (rept s (action cfg)) {s} \<le> ?r s"
       by (auto intro: Sup_upper)
     moreover have "rept s (action cfg) = action (repcs s cfg)"
       by (simp add: repcs_def)
     ultimately have "measure_pmf (action (repcs s cfg)) {s} \<le> ?r s"
       by auto
     note this \<open>rept s (action cfg) \<in> ?K s\<close>
   }
   note * = this
   let ?S = "{cfg. \<exists> cfg' s. cfg' \<in> R_G.valid_cfg \<and> cfg = repcs s cfg' \<and> abss s = state cfg'}"
   have start: "repcs st cfg \<in> ?S"
     using \<open>cfg \<in> R_G.valid_cfg\<close> assms unfolding R_G_cfg_on_div_def
     by clarsimp (inst_existentials cfg "fst st" "snd st", auto)
   have step: "y \<in> ?S" if "y \<in> K_cfg x" "x \<in> ?S" for x y
     using that apply safe
     subgoal for cfg' l u
       apply (inst_existentials "absc y" "state y")
       subgoal
         by blast
       subgoal
         by (metis
             K_cfg_valid_cfgD R_G.valid_cfgD R_G.valid_cfg_state_in_S absc_repcs_id cont_absc_1
             cont_repcs1 repcs_valid
             )
       subgoal
         by (simp add: state_absc)
       done
     done
   have **: "x \<in> ?S" if "(repcs st cfg, x) \<in> MDP.MC.acc" for x
   proof -
     from MDP.MC.acc_relfunD[OF that] obtain n where "((\<lambda> a b. b \<in> K_cfg a) ^^ n) (repcs st cfg) x" .
     then show ?thesis
     proof (induction n arbitrary: x) (* XXX Extract induction rule *)
       case 0
       with start show ?case
         by simp
     next
       case (Suc n)
       from this(2)[simplified] show ?case
         by (elim relcomppE step Suc.IH)
     qed
   qed
   have ***: "almost_everywhere (MDP.MC.T (repcs st cfg)) (alw (HLD ?S))"
     by (rule AE_mp[OF MDP.MC.AE_T_reachable]) (fastforce dest: ** simp: HLD_iff elim: alw_mono)
 
   have "(AE \<omega> in ?M. ?P \<omega>) \<longleftrightarrow>
     (AE \<omega> in ?M. \<forall> s :: ('s \<times> ('c \<Rightarrow> real)).
       (\<forall> c \<in> \<X>. snd s c > k c) \<and> s \<in> state ` (MDP.MC.acc `` {repcs st cfg}) \<longrightarrow>
       \<not> (ev (alw (\<lambda> xs. shd xs = s))) (smap state \<omega>))" (is "?L \<longleftrightarrow> ?R")
   proof
     assume ?L
     then show ?R
       by eventually_elim auto
   next
     assume ?R
     with MDP.MC.AE_T_reachable[of "repcs st cfg"] show ?L
     proof (eventually_elim, intro allI impI notI, goal_cases)
       case (1 \<omega> s)
       from this(1,2,5,6) show ?case
         by (intro alw_HLD_smap alw_disjoint_ccontr[where
               S = "state ` MDP.MC.acc `` {repcs st cfg}" and R = "{s}" and \<omega> = "smap state \<omega>"
               ]; simp add: HLD_iff; blast)
     qed
   qed
 
   also have "\<dots> \<longleftrightarrow>
       (\<forall> s :: ('s \<times> ('c \<Rightarrow> real)).
         (\<forall> c \<in> \<X>. snd s c > k c) \<and> s \<in> state ` (MDP.MC.acc `` {repcs st cfg}) \<longrightarrow>
         (AE \<omega> in ?M. \<not> (ev (alw (\<lambda> xs. shd xs = s))) (smap state \<omega>)))"
     using MDP.MC.countable_reachable[of "repcs st cfg"]
     by - (rule AE_all_imp_countable,
         auto intro: countable_subset[where B = "state ` MDP.MC.acc `` {repcs st cfg}"])
   also show ?thesis
     unfolding calculation
     apply clarsimp
     subgoal for l u x
       apply (rule MDP.non_loop_tail'[simplified, of "state x" ?S "?r (state x)"])
       subgoal
         apply safe
         subgoal premises prems for cfg cfg' l' u'
         proof -
           from prems have "state x = (l', u')"
             by (metis MDP.cfg_onD_state state_repcs)
           with \<open>_ = state x\<close> have [simp]: "l = l'" "u = u'"
             by auto
           show ?thesis
             unfolding \<open>state x = _\<close> using prems(1,3-) by (auto simp: R_G.valid_cfg_def intro: *)
         qed
         done
       subgoal
         apply (drule **)
         apply clarsimp
         apply (rule lt_1)
         apply (rule *)
         apply (auto dest: R_G.valid_cfg_state_in_S R_G.valid_cfgD)
         done
        apply (rule MDP.valid_cfgD[OF \<open>repcs st cfg \<in> valid_cfg\<close>]; fail)
       using *** unfolding alw_holds_pred_stream_iff[symmetric] HLD_def .
     done
 qed
 
 end (* PTA Regions *)
 
 
 subsection \<open>Main Result\<close> text_raw \<open> \label{thm:minmax} \<close>
 
 context Probabilistic_Timed_Automaton_Regions_Reachability
 begin
 
 lemma R_G_cfg_on_valid:
   "cfg \<in> R_G.valid_cfg" if "cfg \<in> R_G_cfg_on_div s'"
   using that unfolding R_G_cfg_on_div_def R_G.valid_cfg_def by auto
 
 lemma cfg_on_valid:
   "cfg \<in> valid_cfg" if "cfg \<in> cfg_on_div s"
   using that unfolding cfg_on_div_def MDP.valid_cfg_def by auto
 
 abbreviation "path_measure P cfg \<equiv> emeasure (MDP.T cfg) {x\<in>space MDP.St. P x}"
 abbreviation "R_G_path_measure P cfg \<equiv> emeasure (R_G.T cfg) {x\<in>space R_G.St. P x}"
 abbreviation "progressive st \<equiv> cfg_on_div st \<inter> {cfg. alternating cfg}"
 abbreviation "R_G_progressive st \<equiv> R_G_cfg_on_div st \<inter> {cfg. alternating cfg}"
 
 text \<open>Summary of our results on divergent configurations:\<close>
 lemma absc_valid_cfg_eq:
   "absc ` progressive s = R_G_progressive s'"
   apply safe
   subgoal
     unfolding s'_def by (rule cfg_on_div_absc) auto
   subgoal
     by (simp add: AE_alw_ev_same_loc_iff cfg_on_valid)
   subgoal for cfg
     unfolding s'_def
     by (frule cfg_on_div_repcs_strong)
        (auto 4 4
           simp: s'_def R_G_cfg_on_div_def AE_alw_ev_same_loc_iff'[symmetric]
           intro: R_G_cfg_on_valid absc_repcs_id[symmetric]
        )
   done
 
 text \<open>Main theorem:\<close>
 theorem Min_Max_reachability:
   notes in_space_UNIV[measurable] and [iff] = pred_stream_iff
   shows
   "(\<Squnion>cfg\<in> progressive s.      path_measure     (\<lambda> x. (holds \<phi>  suntil holds \<psi>)  (s  ## x)) cfg)
  = (\<Squnion>cfg\<in> R_G_progressive s'. R_G_path_measure (\<lambda> x. (holds \<phi>' suntil holds \<psi>') (s' ## x)) cfg)
  \<and> (\<Sqinter>cfg\<in> progressive s.      path_measure     (\<lambda> x. (holds \<phi>  suntil holds \<psi>)  (s  ## x)) cfg)
  = (\<Sqinter>cfg\<in> R_G_progressive s'. R_G_path_measure (\<lambda> x. (holds \<phi>' suntil holds \<psi>') (s' ## x)) cfg)"
 proof (rule SUP_eq_and_INF_eq; rule bexI[rotated]; erule IntE)
   fix cfg assume cfg_div: "cfg \<in> R_G_cfg_on_div s'" and "cfg \<in> Collect alternating"
   then have "alternating cfg"
     by auto
   let ?cfg' = "repcs s cfg"
   from \<open>alternating cfg\<close> cfg_div have "alternating ?cfg'"
     by (simp add: R_G_cfg_on_div_def s'_def AE_alw_ev_same_loc_iff'[of _ s])
   with cfg_div \<open>alternating cfg\<close> show "?cfg' \<in> cfg_on_div s \<inter> Collect alternating"
     by (auto intro: cfg_on_div_repcs_strong simp: s'_def)
   show "emeasure (R_G.T cfg)   {x \<in> space R_G.St. (holds \<phi>' suntil holds \<psi>') (s' ## x)}
       = emeasure (MDP.T ?cfg') {x \<in> space MDP.St. (holds \<phi> suntil holds \<psi>)   (s ## x)}"
      (is "?a = ?b")
   proof -
     from cfg_div have "cfg \<in> R_G.valid_cfg"
       by (rule R_G_cfg_on_valid)
     from cfg_div have "cfg \<in> R_G.cfg_on s'"
       unfolding R_G_cfg_on_div_def by auto
     then have "state cfg = s'"
       by auto
     have "?a = ?b"
       apply (rule
           path_measure_eq_repcs''_new[
             of s cfg \<phi> \<psi>, folded \<phi>'_def \<psi>'_def, unfolded \<open>_ = s'\<close> state_repcs
             ]
           )
       subgoal
         unfolding s'_def ..
       subgoal
         by fact
       subgoal
         using \<open>?cfg' \<in> cfg_on_div s \<inter> _\<close> by (blast intro: cfg_on_valid)
       subgoal premises prems for xs
         using prems s by (intro \<phi>_stream)
       subgoal premises prems
         using prems s by (intro \<psi>_stream)
       done
     then show ?thesis
       by simp
   qed
 next
   fix cfg assume cfg_div: "cfg \<in> cfg_on_div s" and "cfg \<in> Collect alternating"
   with absc_valid_cfg_eq show "absc cfg \<in> R_G_cfg_on_div s' \<inter> Collect alternating"
     by auto
   show "emeasure (MDP.T cfg)        {x \<in> space MDP.St. (holds \<phi> suntil holds \<psi>)   (s ## x)}
       = emeasure (R_G.T (absc cfg)) {x \<in> space R_G.St. (holds \<phi>' suntil holds \<psi>') (s' ## x)}"
     (is "?a = ?b")
   proof -
     have "absc cfg \<in> R_G.valid_cfg"
       using R_G_cfg_on_valid \<open>absc cfg \<in> R_G_cfg_on_div s' \<inter> _\<close> by blast
     from cfg_div have "cfg \<in> valid_cfg"
       by (simp add: cfg_on_valid)
     with \<open>absc cfg \<in> R_G.valid_cfg\<close> have "?b = ?a"
       by (intro MDP.alw_S R_G.alw_S path_measure_eq_absc1_new
             [where P = "pred_stream (\<lambda>s. s \<in> \<S>)" and Q = "pred_stream (\<lambda>s. s \<in> S)"]
          )
          (auto simp: S_abss_\<S> intro: \<S>_abss_S intro!: suntil_abss suntil_reps, measurable)
     then show "?a = ?b"
       by simp
   qed
 qed
 
 end (* PTA Reachability Problem *)
 
 end (* Theory *)
diff --git a/thys/Probabilistic_Timed_Automata/library/Basic.thy b/thys/Probabilistic_Timed_Automata/library/Basic.thy
--- a/thys/Probabilistic_Timed_Automata/library/Basic.thy
+++ b/thys/Probabilistic_Timed_Automata/library/Basic.thy
@@ -1,95 +1,95 @@
 (* Author: Julian Brunner *)
 (* This is originally a part of the CAVA model checker *)
 theory Basic
 imports
   Main
 begin
 
   abbreviation (input) "const x \<equiv> \<lambda> _. x"
 
   lemma infinite_subset[trans]: "infinite A \<Longrightarrow> A \<subseteq> B \<Longrightarrow> infinite B" using infinite_super by this
   lemma finite_subset[trans]: "A \<subseteq> B \<Longrightarrow> finite B \<Longrightarrow> finite A" using finite_subset by this
 
   declare infinite_coinduct[case_names infinite, coinduct pred: infinite]
   lemma infinite_psubset_coinduct[case_names infinite, consumes 1]:
     assumes "R A"
     assumes "\<And> A. R A \<Longrightarrow> \<exists> B \<subset> A. R B"
     shows "infinite A"
   proof
     assume "finite A"
     then show "False" using assms by (induct rule: finite_psubset_induct) (auto)
   qed
 
   lemma GreatestI:
     fixes k :: nat
     assumes "P k" "\<And> k. P k \<Longrightarrow> k \<le> l"
     shows "P (GREATEST k. P k)"
-  proof (rule GreatestI_nat, safe)
+  proof (rule GreatestI_nat)
     show "P k" using assms(1) by this
     show "k \<le> l" if "P k" for k using assms(2) that by force
   qed
   lemma Greatest_le:
     fixes k :: nat
     assumes "P k" "\<And> k. P k \<Longrightarrow> k \<le> l"
     shows "k \<le> (GREATEST k. P k)"
-  proof (rule Greatest_le_nat, safe)
+  proof (rule Greatest_le_nat)
     show "P k" using assms(1) by this
     show "k \<le> l" if "P k" for k using assms(2) that by force
   qed
   lemma Greatest_not_less:
     fixes k :: nat
     assumes "k > (GREATEST k. P k)" "\<And> k. P k \<Longrightarrow> k \<le> l"
     shows "\<not> P k"
   proof
     assume 1: "P k"
     have 2: "k \<le> (GREATEST k. P k)" using Greatest_le 1 assms(2) by this
     show "False" using assms(1) 2 by auto
   qed
 
   lemma finite_set_of_finite_maps':
     assumes "finite A" "finite B"
     shows "finite {m. dom m \<subseteq> A \<and> ran m \<subseteq> B}"
   proof -
     have "{m. dom m \<subseteq> A \<and> ran m \<subseteq> B} = (\<Union> \<A> \<in> Pow A. {m. dom m = \<A> \<and> ran m \<subseteq> B})" by auto
     also have "finite \<dots>" using finite_subset assms by (auto intro: finite_set_of_finite_maps)
     finally show ?thesis by this
   qed
 
   primrec alternate :: "('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> ('a \<Rightarrow> 'a)" where
     "alternate f g 0 = id" | "alternate f g (Suc k) = alternate g f k \<circ> f"
 
   lemma alternate_Suc[simp]: "alternate f g (Suc k) = (if even k then f else g) \<circ> alternate f g k"
   proof (induct k arbitrary: f g)
     case (0)
     show ?case by simp
   next
     case (Suc k)
     have "alternate f g (Suc (Suc k)) = alternate g f (Suc k) \<circ> f" by auto
     also have "\<dots> = (if even k then g else f) \<circ> (alternate g f k \<circ> f)" unfolding Suc by auto
     also have "\<dots> = (if even (Suc k) then f else g) \<circ> alternate f g (Suc k)" by auto
     finally show ?case by this
   qed
 
   declare alternate.simps(2)[simp del]
 
   lemma alternate_antimono:
     assumes "\<And> x. f x \<le> x" "\<And> x. g x \<le> x"
     shows "antimono (alternate f g)"
   proof
     fix k l :: nat
     assume 1: "k \<le> l"
     obtain n where 2: "l = k + n" using le_Suc_ex 1 by auto
     have 3: "alternate f g (k + n) \<le> alternate f g k"
     proof (induct n)
       case (0)
       show ?case by simp
     next
       case (Suc n)
       have "alternate f g (k + Suc n) \<le> alternate f g (k + n)" using assms by (auto intro: le_funI)
       also have "\<dots> \<le> alternate f g k" using Suc by this
       finally show ?case by this
     qed
     show "alternate f g l \<le> alternate f g k" using 3 unfolding 2 by this
   qed
 
 end
diff --git a/thys/QR_Decomposition/Gram_Schmidt.thy b/thys/QR_Decomposition/Gram_Schmidt.thy
--- a/thys/QR_Decomposition/Gram_Schmidt.thy
+++ b/thys/QR_Decomposition/Gram_Schmidt.thy
@@ -1,913 +1,913 @@
 (*  
     Title:      Gram_Schmidt.thy
     Author:     Jose Divasón <jose.divasonm at unirioja.es>
     Author:     Jesús Aransay <jesus-maria.aransay at unirioja.es>
 *)
 
 section\<open>The Gram-Schmidt algorithm\<close>
 
 theory Gram_Schmidt
 imports
  Miscellaneous_QR
  Projections
 begin
 
 subsection\<open>Gram-Schmidt algorithm\<close>
 
 text\<open>
 The algorithm is used to orthogonalise a set of vectors. The Gram-Schmidt process takes a set of vectors \<open>S\<close>
 and generates another orthogonal set that spans the same subspace as \<open>S\<close>.
 
 We present three ways to compute the Gram-Schmidt algorithm.
 
 \begin{enumerate}
 \item The fist one has been developed thinking about the simplicity of its formalisation.
     Given a list of vectors, the output is another list of orthogonal vectors with the same span.
     Such a list is constructed following the Gram-Schmidt process presented in any book, but in 
     the reverse order (starting the process from the last element of the input list).
 
 \item Based on previous formalization, another function has been defined
   to compute the process of the Gram-Schmidt algorithm in the natural order 
   (starting from the first element of the input list).
 
 \item The third way has as input and output a matrix. The algorithm is applied to the columns of a
   matrix, obtaining a matrix whose columns are orthogonal and where the column space is kept. 
   This will be a previous step to compute the QR decomposition.
 \end{enumerate}
 
 Every function can be executed with arbitrary precision (using rational numbers).
 \<close>
 
 subsubsection\<open>First way\<close>
 
 definition Gram_Schmidt_step :: "('a::{real_inner}^'b) => ('a^'b) list => ('a^'b) list"
   where "Gram_Schmidt_step a ys = ys @ [(a - proj_onto a (set ys))]"
 
 definition "Gram_Schmidt xs = foldr Gram_Schmidt_step xs []"
 
 lemma Gram_Schmidt_cons:
   "Gram_Schmidt (a#xs) = Gram_Schmidt_step a (Gram_Schmidt xs)"
   unfolding Gram_Schmidt_def by auto
 
 lemma basis_orthogonal':
   fixes xs::"('a::{real_inner}^'b) list"
   shows "length (Gram_Schmidt xs) = length (xs) \<and>
         span (set (Gram_Schmidt xs)) = span (set xs) \<and>
         pairwise orthogonal (set (Gram_Schmidt xs))"
 proof (induct xs)
   case Nil
   show ?case unfolding Gram_Schmidt_def pairwise_def by fastforce
 next
   case (Cons a xs)
   have l: "length (Gram_Schmidt xs) = length xs"
     and s: "span (set (Gram_Schmidt xs)) = span (set xs)"
     and p: "pairwise orthogonal (set (Gram_Schmidt xs))" using Cons.hyps by auto
   show "length (Gram_Schmidt (a # xs)) = length (a # xs) \<and>
     span (set (Gram_Schmidt (a # xs))) = span (set (a # xs))
     \<and> pairwise orthogonal (set (Gram_Schmidt (a # xs)))"
   proof 
     show "length (Gram_Schmidt (a # xs)) = length (a # xs)"
       unfolding Gram_Schmidt_cons unfolding Gram_Schmidt_step_def using l by auto 
     show "span (set (Gram_Schmidt (a # xs))) 
       = span (set (a # xs)) \<and> pairwise orthogonal (set (Gram_Schmidt (a # xs)))"
     proof
       have set_rw1: "set (a # xs) = insert a (set xs)" by simp
       have set_rw2: "set (Gram_Schmidt (a # xs)) 
         = (insert (a - (\<Sum>x\<in>set (Gram_Schmidt xs). (a \<bullet> x / (x \<bullet> x)) *\<^sub>R x)) (set (Gram_Schmidt xs)))"
         unfolding Gram_Schmidt_cons Gram_Schmidt_step_def proj_onto_def proj_def[abs_def] by auto
       define C where "C = set (Gram_Schmidt xs)"
       have finite_C: "finite C" unfolding C_def by auto
       {   
         fix x k
         have th0: "!!(a::'a^'b) b c. a - (b - c) = c + (a - b)"
           by (simp add: field_simps)
         have "x - k *\<^sub>R (a - (\<Sum>x\<in>C. (a \<bullet> x / (x \<bullet>  x)) *\<^sub>R x)) \<in> span C 
           \<longleftrightarrow> x - k *\<^sub>R a \<in> span C"
           apply (simp only: scaleR_right_diff_distrib th0)
           apply (rule span_add_eq)
           apply (rule span_mul)
           apply (rule span_sum)
           apply (rule span_mul)
           apply (rule span_base)
           apply assumption
           done
       }
       then show "span (set (Gram_Schmidt (a # xs))) = span (set (a # xs))"
         unfolding set_eq_iff set_rw2 set_rw1 span_breakdown_eq C_def s[symmetric]
         by auto
       with p show "pairwise orthogonal (set (Gram_Schmidt (a # xs)))"
         using pairwise_orthogonal_proj_set[OF finite_C]
         unfolding set_rw2 unfolding C_def proj_def[symmetric] proj_onto_def[symmetric] by simp
     qed
   qed
 qed
 
 
 lemma card_Gram_Schmidt:
   fixes xs::"('a::{real_inner}^'b) list"
   assumes "distinct xs"
   shows "card(set (Gram_Schmidt xs)) \<le> card (set (xs))"
   using assms
 proof (induct xs)
   case Nil show ?case unfolding Gram_Schmidt_def by simp
 next
   case (Cons x xs)
   define b where "b = (\<Sum>xa\<in>set (Gram_Schmidt xs). (x \<bullet> xa / (xa \<bullet> xa)) *\<^sub>R xa)"
   have distinct_xs: "distinct xs" using Cons.prems by auto
   show ?case
   proof (cases "x - b \<notin> set (Gram_Schmidt xs)")
     case True
     have "card (set (Gram_Schmidt (x # xs))) = card (insert (x - b) (set (Gram_Schmidt xs)))"
       unfolding Gram_Schmidt_cons Gram_Schmidt_step_def b_def 
       unfolding proj_onto_def proj_def[abs_def] by simp
     also have "... = Suc (card (set (Gram_Schmidt xs)))"
     proof (rule card_insert_disjoint)
       show "finite (set (Gram_Schmidt xs))" by simp
       show "x - b \<notin> set (Gram_Schmidt xs)" using True .
     qed
     also have "... \<le> Suc (card (set xs))" using Cons.hyps[OF distinct_xs]  by simp
     also have "... = Suc (length (remdups xs))" unfolding List.card_set ..
     also have "... \<le> (length (remdups (x # xs)))"
       by (metis Cons.prems distinct_xs impossible_Cons not_less_eq_eq remdups_id_iff_distinct)
     also have "... \<le> (card (set (x # xs)))" 
       by (metis dual_order.refl length_remdups_card_conv)
     finally show ?thesis .
   next
     case False
     have x_b_in: "x - b \<in> set (Gram_Schmidt xs)" using False by simp
     have "card (set (Gram_Schmidt (x # xs))) = card (insert (x - b) (set (Gram_Schmidt xs)))"
       unfolding Gram_Schmidt_cons Gram_Schmidt_step_def b_def
       unfolding proj_onto_def proj_def[abs_def] by simp
     also have "... = (card (set (Gram_Schmidt xs)))" by (metis False insert_absorb)
     also have "... \<le> (card (set xs))" using Cons.hyps[OF distinct_xs] .
     also have "... \<le> (card (set (x # xs)))" unfolding List.card_set by simp
     finally show ?thesis .
   qed
 qed
 
 lemma orthogonal_basis_exists:
   fixes V :: "(real^'b) list"
   assumes B: "is_basis (set V)"
   and d: "distinct V"
   shows "vec.independent (set (Gram_Schmidt V)) \<and> (set V) \<subseteq> vec.span (set (Gram_Schmidt V)) 
   \<and> (card (set (Gram_Schmidt V)) = vec.dim (set V)) \<and> pairwise orthogonal (set (Gram_Schmidt V))"
 proof -
   have "(set V) \<subseteq> vec.span (set (Gram_Schmidt V))"
     using basis_orthogonal'[of V]
     using vec.span_superset[where ?'a=real, where ?'b='b]
     by (auto simp: span_vec_eq)
   moreover have "pairwise orthogonal (set (Gram_Schmidt V))"
     using basis_orthogonal'[of V] by blast
   moreover have c: "(card (set (Gram_Schmidt V)) = vec.dim (set V))"
   proof -
     have card_eq_dim: "card (set V) = vec.dim (set V)" 
       by (metis B independent_is_basis vec.dim_span vec.indep_card_eq_dim_span)
     have "vec.dim (set V) \<le> (card (set (Gram_Schmidt V)))" using B unfolding is_basis_def
       using vec.independent_span_bound[of "(set (Gram_Schmidt V))" "set V"]
       using basis_orthogonal'[of V]
       by (simp add: calculation(1) local.card_eq_dim)
     moreover have "(card (set (Gram_Schmidt V))) \<le> vec.dim (set V)"
       using card_Gram_Schmidt[OF d] card_eq_dim by auto
     ultimately show ?thesis by auto
   qed
   moreover have "vec.independent (set (Gram_Schmidt V))"
   proof (rule vec.card_le_dim_spanning[of _ "UNIV::(real^'b) set"])
     show "set (Gram_Schmidt V) \<subseteq> (UNIV::(real^'b) set)" by simp
     show "UNIV \<subseteq> vec.span (set (Gram_Schmidt V))"
       using basis_orthogonal'[of V] using B unfolding is_basis_def
       by (simp add: span_vec_eq)
     show "finite (set (Gram_Schmidt V))" by simp
     show "card (set (Gram_Schmidt V)) \<le> vec.dim (UNIV::(real^'b) set)"
       by (metis c top_greatest vec.dim_subset)
   qed
   ultimately show ?thesis by simp
 qed
 
 
 corollary orthogonal_basis_exists':
   fixes V :: "(real^'b) list"
   assumes B: "is_basis (set V)"
   and d: "distinct V"
   shows "is_basis (set (Gram_Schmidt V)) 
   \<and> distinct (Gram_Schmidt V) \<and> pairwise orthogonal (set (Gram_Schmidt V))"
   using B orthogonal_basis_exists basis_orthogonal' card_distinct d 
     vec.dim_unique distinct_card is_basis_def subset_refl
   by (metis span_vec_eq)
 
 
 subsubsection\<open>Second way\<close>
 
 text\<open>This definition applies the Gram Schmidt process starting from the first element of the list.\<close>
 
 definition "Gram_Schmidt2 xs = Gram_Schmidt (rev xs)"
 
 lemma basis_orthogonal2:
   fixes xs::"('a::{real_inner}^'b) list"
   shows "length (Gram_Schmidt2 xs) = length (xs)
   \<and> span (set (Gram_Schmidt2 xs)) = span (set xs)
   \<and> pairwise orthogonal (set (Gram_Schmidt2 xs))"
   by (metis Gram_Schmidt2_def basis_orthogonal' length_rev set_rev)
 
 lemma card_Gram_Schmidt2:
   fixes xs::"('a::{real_inner}^'b) list"
   assumes "distinct xs"
   shows "card(set (Gram_Schmidt2 xs)) \<le> card (set (xs))"
   by (metis Gram_Schmidt2_def assms card_Gram_Schmidt distinct_rev set_rev)
 
 lemma orthogonal_basis_exists2:
   fixes V :: "(real^'b) list"
   assumes B: "is_basis (set V)"
   and d: "distinct V"
   shows "vec.independent (set (Gram_Schmidt2 V)) \<and> (set V) \<subseteq> vec.span (set (Gram_Schmidt2 V)) 
   \<and> (card (set (Gram_Schmidt2 V)) = vec.dim (set V)) \<and> pairwise orthogonal (set (Gram_Schmidt2 V))"
   by (metis Gram_Schmidt.orthogonal_basis_exists Gram_Schmidt2_def distinct_rev set_rev
       B basis_orthogonal2 d)
 
 subsubsection\<open>Third way\<close>
 
 text\<open>The following definitions applies the Gram Schmidt process in the columns of a given matrix.
   It is previous step to the computation of the QR decomposition.\<close>
 
 definition Gram_Schmidt_column_k :: "'a::{real_inner}^'cols::{mod_type}^'rows \<Rightarrow> nat 
   \<Rightarrow> 'a^'cols::{mod_type}^'rows" 
   where "Gram_Schmidt_column_k A k 
   = (\<chi> a. (\<chi> b. (if b = from_nat k 
   then (column b A - (proj_onto (column b A) {column i A|i. i < b})) 
   else (column b A)) $ a))"
 
 definition "Gram_Schmidt_upt_k A k = foldl Gram_Schmidt_column_k A [0..<(Suc k)]"
 definition "Gram_Schmidt_matrix A = Gram_Schmidt_upt_k A (ncols A - 1)"
 
 text\<open>Some definitions and lemmas in order to get execution.\<close>
 
 definition "Gram_Schmidt_column_k_row A k a = 
   vec_lambda(\<lambda>b. (if b = from_nat k then 
   (column b A - (\<Sum>x\<in>{column i A|i. i < b}. ((column b A) \<bullet> x / (x \<bullet> x)) *\<^sub>R x)) 
   else (column b A)) $ a)"
 
 lemma Gram_Schmidt_column_k_row_code[code abstract]:
   "vec_nth (Gram_Schmidt_column_k_row A k a) 
   = (%b. (if b = from_nat k 
   then (column b A - (\<Sum>x\<in>{column i A|i. i < b}. ((column b A) \<bullet> x / (x \<bullet> x)) *\<^sub>R x)) 
   else (column b A)) $ a)"
   unfolding Gram_Schmidt_column_k_row_def
   by (metis (lifting) vec_lambda_beta)
 
 lemma Gram_Schmidt_column_k_code[code abstract]:
   "vec_nth (Gram_Schmidt_column_k A k) = Gram_Schmidt_column_k_row A k"
   unfolding Gram_Schmidt_column_k_def unfolding Gram_Schmidt_column_k_row_def[abs_def]
   unfolding proj_onto_def proj_def[abs_def]
   by fastforce
 
 text\<open>Proofs\<close>
 
 lemma Gram_Schmidt_upt_k_suc: 
   "Gram_Schmidt_upt_k A (Suc k) = (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k))"
 proof -
   have rw: "[0..<Suc (Suc k)] = [0..<Suc k] @ [(Suc k)]" by simp
   show ?thesis unfolding Gram_Schmidt_upt_k_def 
     unfolding rw unfolding foldl_append unfolding foldl.simps ..
 qed
 
 lemma column_Gram_Schmidt_upt_k_preserves:
   fixes A::"'a::{real_inner}^'cols::{mod_type}^'rows"
   assumes i_less_suc: "to_nat i<(Suc k)"
   and suc_less_card: "Suc k < CARD ('cols)"
   shows "column i (Gram_Schmidt_upt_k A (Suc k)) = column i (Gram_Schmidt_upt_k A k)"
 proof -
   have "column i (Gram_Schmidt_upt_k A (Suc k)) 
     = column i (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k))"
     unfolding Gram_Schmidt_upt_k_suc ..
   also have "... = column i (Gram_Schmidt_upt_k A k)" unfolding Gram_Schmidt_column_k_def
     column_def using i_less_suc by (auto simp add: to_nat_from_nat_id[OF suc_less_card])
   finally show ?thesis .
 qed
 
 lemma column_set_Gram_Schmidt_upt_k:
   fixes A::"'a::{real_inner}^'cols::{mod_type}^'rows"
   assumes k: "Suc k < CARD ('cols)"
   shows "{column i (Gram_Schmidt_upt_k A (Suc k)) |i. to_nat i\<le>(Suc k)} =
   {column i (Gram_Schmidt_upt_k A k) |i. to_nat i\<le>k} \<union> {column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k)
   - (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A k) |i. to_nat i\<le>k}. (x \<bullet> (column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k)) / (x \<bullet> x)) *\<^sub>R x)}" 
 proof -
   have set_rw: "{\<chi> ia. Gram_Schmidt_upt_k A k $ ia $ i |i.
     i < from_nat (Suc k)} = {\<chi> ia. Gram_Schmidt_upt_k A k $ ia $ i |i. to_nat i \<le> k}"
   proof (auto, vector, metis less_Suc_eq_le to_nat_le)
     fix i::'cols
     assume "to_nat i \<le> k"
     hence "to_nat i < Suc k" by simp
     hence i_less_suc: "i < from_nat (Suc k)" using from_nat_le[OF _ k] by simp
     show "\<exists>l. (\<lambda>j. Gram_Schmidt_upt_k A k $ j $ i) = (\<lambda>j'. Gram_Schmidt_upt_k A k $ j' $ l) \<and>  l < mod_type_class.from_nat (Suc k)"
       by (rule exI[of _ i], simp add: i_less_suc)
   qed
   have rw: "[0..<Suc (Suc k)] = [0..<Suc k] @ [(Suc k)]" by simp
   have "{column i (Gram_Schmidt_upt_k A (Suc k)) |i. to_nat i\<le>(Suc k)} 
     = {column i (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k)) |i. to_nat i \<le> Suc k}"
     unfolding Gram_Schmidt_upt_k_def 
     unfolding rw unfolding foldl_append unfolding foldl.simps ..
   also have "... = {column i (Gram_Schmidt_upt_k A k) |i. to_nat i\<le>k} \<union> {column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k)
     - (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A k) |i. to_nat i\<le>k}. (x \<bullet> (column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k)) / (x \<bullet> x)) *\<^sub>R x)}"
   proof (auto)
     fix i::'cols
     assume ik: "to_nat i \<le> k"
     show "\<exists>ia. column i (Gram_Schmidt_upt_k A k) 
       = column ia (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k)) \<and> to_nat ia \<le> Suc k"
     proof (rule exI[of _ i], rule conjI)
       have i_less_suc: "to_nat i < Suc k" using ik by auto
       thus "to_nat i \<le> Suc k" by simp
       show  "column i (Gram_Schmidt_upt_k A k) = column i (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k))"
         using column_Gram_Schmidt_upt_k_preserves[OF i_less_suc k, of A]
         unfolding Gram_Schmidt_upt_k_suc ..
     qed
   next
     show "\<exists>a. column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) -
       (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A k) |i.
       to_nat i \<le> k}. (x \<bullet> column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) / (x \<bullet> x)) *\<^sub>R x) =
       column a (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k)) \<and>
       to_nat a \<le> Suc k"
     proof (rule exI[of _ "from_nat (Suc k)::'cols"], rule conjI)
 
       show "to_nat (from_nat (Suc k)::'cols) \<le> Suc k" unfolding to_nat_from_nat_id[OF k] ..
       show "column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) -
         (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A k) |i.
         to_nat i \<le> k}. (x \<bullet> column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) / (x \<bullet> x)) *\<^sub>R x) =
         column (from_nat (Suc k)) (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k))"
         unfolding Gram_Schmidt_column_k_def column_def apply auto unfolding set_rw 
         unfolding vector_scaleR_component[symmetric]
         unfolding sum_component[symmetric]
         unfolding proj_onto_def proj_def[abs_def]
         unfolding proj_onto_sum_rw
         by vector 
     qed
   next
     fix i
     assume col_not_eq: "column i (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k)) \<noteq>
       column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) -
       (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A k) |i.
       to_nat i \<le> k}. (x \<bullet> column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) / (x \<bullet> x)) *\<^sub>R x)"
       and i: "to_nat i \<le> Suc k"
     have i_not_suc_k: "i \<noteq> from_nat (Suc k)"
     proof (rule ccontr, simp)
       assume i2: "i = from_nat (Suc k)"
       have "column i (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k)) =
         column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) -
         (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A k) |i.
         to_nat i \<le> k}. (x \<bullet> column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) / (x \<bullet> x)) *\<^sub>R x)"
         unfolding i2  Gram_Schmidt_column_k_def column_def 
         apply auto
         unfolding set_rw
         unfolding vector_scaleR_component[symmetric]
         unfolding sum_component[symmetric]
         unfolding proj_onto_def proj_def[abs_def]
         unfolding proj_onto_sum_rw
         by vector
       thus False using col_not_eq by contradiction
     qed
     show "\<exists>ia. column i (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k)) 
       = column ia (Gram_Schmidt_upt_k A k) \<and> to_nat ia \<le> k"
     proof (rule exI[of _ i], rule conjI, unfold Gram_Schmidt_upt_k_suc[symmetric], rule column_Gram_Schmidt_upt_k_preserves)
       show "to_nat i < Suc k" using i i_not_suc_k by (metis le_imp_less_or_eq from_nat_to_nat_id)
       thus "to_nat i \<le> k" using less_Suc_eq_le by simp
       show "Suc k < CARD('cols)" using k .
     qed
   qed
   finally show ?thesis .
 qed
 
 
 lemma orthogonal_Gram_Schmidt_upt_k:
   assumes s: "k < ncols A"
   shows "pairwise orthogonal ({column i (Gram_Schmidt_upt_k A k) |i. to_nat i\<le>k})"
   using s
 proof (induct k)
   case 0
   have set_rw: "{column i (Gram_Schmidt_upt_k A 0) |i. to_nat i \<le> 0} =  {column 0 (Gram_Schmidt_upt_k A 0)}"
     by (simp add: to_nat_eq_0)
   show ?case unfolding set_rw unfolding pairwise_def by auto
 next
   case (Suc k)
   have rw: "[0..<Suc (Suc k)] = [0..<Suc k] @ [(Suc k)]" by simp
   show ?case
     unfolding column_set_Gram_Schmidt_upt_k[OF Suc.prems[unfolded ncols_def], of A]
     unfolding proj_onto_sum_rw
     by (auto simp add: proj_def[symmetric] proj_onto_def[symmetric])
        (rule pairwise_orthogonal_proj_set, auto simp add: Suc.hyps Suc.prems Suc_lessD)
 qed
 
 
 lemma columns_Gram_Schmidt_matrix_rw: 
   "{column i (Gram_Schmidt_matrix A) |i. i \<in> UNIV} 
   = {column i (Gram_Schmidt_upt_k A (ncols A - 1)) |i. to_nat i\<le> (ncols A - 1)}"
 proof (auto)
   fix i
   show "\<exists>ia. column i (Gram_Schmidt_matrix A) 
     = column ia (Gram_Schmidt_upt_k A (ncols A - Suc 0)) \<and> to_nat ia \<le> ncols A - Suc 0"
     apply (rule exI[of _ i]) unfolding Gram_Schmidt_matrix_def using to_nat_less_card[of i]
     unfolding ncols_def by fastforce
   show "\<exists>ia. column i (Gram_Schmidt_upt_k A (ncols A - Suc 0)) = column ia (Gram_Schmidt_matrix A)"
     unfolding Gram_Schmidt_matrix_def by auto
 qed
 
 
 corollary orthogonal_Gram_Schmidt_matrix:
   shows "pairwise orthogonal ({column i (Gram_Schmidt_matrix A) |i. i \<in> UNIV})"
   unfolding columns_Gram_Schmidt_matrix_rw
   by (rule orthogonal_Gram_Schmidt_upt_k, simp add: ncols_def)
 
 corollary orthogonal_Gram_Schmidt_matrix2:
   shows "pairwise orthogonal (columns (Gram_Schmidt_matrix A))"
   unfolding columns_def using orthogonal_Gram_Schmidt_matrix .
 
 lemma column_Gram_Schmidt_column_k:
   fixes A::"'a::{real_inner}^'n::{mod_type}^'m::{mod_type}"
   shows "column k (Gram_Schmidt_column_k A (to_nat k)) = 
   (column k A) - (\<Sum>x\<in>{column i A|i. i < k}. (x \<bullet> (column k A) / (x \<bullet> x)) *\<^sub>R x)"
   unfolding Gram_Schmidt_column_k_def column_def
   unfolding from_nat_to_nat_id 
   unfolding proj_onto_def proj_def[abs_def]
   unfolding proj_onto_sum_rw
   by vector
 
 
 lemma column_Gram_Schmidt_column_k':
   fixes A::"'a::{real_inner}^'n::{mod_type}^'m::{mod_type}"
   assumes i_not_k: "i\<noteq>k"
   shows "column i (Gram_Schmidt_column_k A (to_nat k)) = (column i A)"
   using i_not_k
   unfolding Gram_Schmidt_column_k_def column_def
   unfolding from_nat_to_nat_id by vector
 
 
 definition "cols_upt_k A k = {column i A|i. i\<le>from_nat k}"
 
 lemma cols_upt_k_insert:
   fixes A::"'a^'n::{mod_type}^'m::{mod_type}"
   assumes k: "(Suc k)<ncols A"
   shows "cols_upt_k A (Suc k) = (insert (column (from_nat (Suc k)) A) (cols_upt_k A k))"
 proof (unfold cols_upt_k_def, auto)
   fix i::'n
   assume i: "i \<le> from_nat (Suc k)" and "column i A \<noteq> column (from_nat (Suc k)) A"
   hence i_not_suc_k: "i \<noteq> from_nat (Suc k)" by auto
   have i_le:  "i \<le> from_nat k"
   proof -
     have "i < from_nat (Suc k)" by (metis le_imp_less_or_eq i i_not_suc_k)
     thus ?thesis by (metis Suc_eq_plus1 from_nat_suc le_Suc not_less)
   qed
   thus "\<exists>ia. column i A = column ia A \<and> ia \<le> from_nat k" by auto
 next
   fix i::'n
   assume i: "i \<le> from_nat k"
   also have "... < from_nat (Suc k)"
     by (rule from_nat_mono[OF _ k[unfolded ncols_def]], simp)
   finally have "i \<le> from_nat (Suc k)" by simp
   thus "\<exists>ia. column i A = column ia A \<and> ia \<le> from_nat (Suc k)" by auto
 qed
 
 
 lemma columns_eq_cols_upt_k:
   fixes A::"'a^'cols::{mod_type}^'rows::{mod_type}"
   shows "cols_upt_k A (ncols A - 1) = columns A"
 proof (unfold cols_upt_k_def columns_def, auto)
   fix i 
   show "\<exists>ia. column i A = column ia A \<and> ia \<le> from_nat (ncols A - Suc 0)"
   proof (rule exI[of _ i], simp)
     have "to_nat i < ncols A" using to_nat_less_card[of i] unfolding ncols_def by simp
     hence "to_nat i \<le> (ncols A - 1)" by simp
     hence "to_nat i \<le> to_nat (from_nat (ncols A - 1)::'cols)"
       using to_nat_from_nat_id[of "ncols A - 1", where ?'a='cols] unfolding ncols_def by simp
     thus "i \<le> from_nat (ncols A - Suc 0)" 
       by (metis One_nat_def less_le_not_le linear to_nat_mono)
   qed
 qed
 
 
 lemma span_cols_upt_k_Gram_Schmidt_column_k:
   fixes A::"'a::{real_inner}^'n::{mod_type}^'m::{mod_type}"
   assumes "k < ncols A"
   and "j < ncols A"
   shows "span (cols_upt_k A k) = span (cols_upt_k (Gram_Schmidt_column_k A j) k)"
   using assms
 proof (induct k)
   case 0
   have set_rw: "{\<chi> ia. A $ ia $ i |i. i < 0} = {}" using least_mod_type not_less by auto
   have set_rw2: "{column i (Gram_Schmidt_column_k A j) |i. i \<le> 0} = {column 0 (Gram_Schmidt_column_k A j)}"
     by (auto, metis eq_iff least_mod_type)
   have set_rw3: "{column i A |i. i \<le> 0} ={column 0 A}"  by (auto, metis eq_iff least_mod_type)
   have col_0_eq: "column 0 (Gram_Schmidt_column_k A j) = column 0 A"
     unfolding Gram_Schmidt_column_k_def column_def
     unfolding proj_onto_def proj_def[abs_def]
     by (simp add: set_rw)
   show ?case unfolding cols_upt_k_def from_nat_0 unfolding set_rw2 set_rw3 unfolding col_0_eq ..
 next
   case (Suc k)
   have hyp: "span (cols_upt_k A k) = span (cols_upt_k (Gram_Schmidt_column_k A j) k)" 
     using Suc.prems Suc.hyps by auto
   have set_rw1: "(cols_upt_k A (Suc k)) = insert (column (from_nat (Suc k)) A) (cols_upt_k A k)"
     using cols_upt_k_insert
     by (auto intro!: cols_upt_k_insert[OF Suc.prems(1)])
   have set_rw2: "(cols_upt_k (Gram_Schmidt_column_k A j) (Suc k)) = 
     insert (column (from_nat (Suc k)) (Gram_Schmidt_column_k A j)) (cols_upt_k (Gram_Schmidt_column_k A j) k)"
     using cols_upt_k_insert  Suc.prems(1) unfolding ncols_def by auto
   show ?case
   proof (cases "j=Suc k")
     case False
     have suc_not_k: "from_nat (Suc k) \<noteq> (from_nat j::'n)"
     proof (rule ccontr, simp)
       assume "from_nat (Suc k) = (from_nat j::'n)"
       hence "Suc k = j" apply (rule from_nat_eq_imp_eq) using Suc.prems unfolding ncols_def .
       thus False using False by simp
     qed
     have tnfnj: "to_nat (from_nat j::'n) = j" using to_nat_from_nat_id[OF Suc.prems(2)[unfolded ncols_def]] .
     let ?a_suc_k = "column (from_nat (Suc k)) A"
     have col_eq: "column (from_nat (Suc k)) (Gram_Schmidt_column_k A j) = ?a_suc_k"
       using column_Gram_Schmidt_column_k'[OF suc_not_k] unfolding tnfnj .
     have k: "k<CARD('n)" using Suc.prems(1)[unfolded ncols_def] by simp
     show ?thesis unfolding set_rw1 set_rw2 col_eq unfolding span_insert unfolding hyp ..
   next
     case True
     define C where "C = cols_upt_k A k"
     define B where "B = cols_upt_k (Gram_Schmidt_column_k A j) k"
     define a where "a = column (from_nat (Suc k)) A"
     let ?a="a - sum (\<lambda>x. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x) C"
     let ?C="insert ?a C"
     have col_rw: "{column i A |i. i \<le> from_nat k} = {column i A |i. i < from_nat (Suc k)}" 
     proof (auto)
       fix i::'n assume i: "i \<le> from_nat k"
       also have "... < from_nat (Suc k)" by (rule from_nat_mono[OF _ Suc.prems(1)[unfolded ncols_def]], simp)
       finally show "\<exists>ia. column i A = column ia A \<and> ia < from_nat (Suc k)" by auto
     next
       fix i::'n
       assume i: "i < from_nat (Suc k)"
       hence "i\<le> from_nat k" unfolding Suc_eq_plus1 unfolding from_nat_suc by (metis le_Suc not_less)
       thus " \<exists>ia. column i A = column ia A \<and> ia \<le> from_nat k" by auto
     qed
     have rw: "column (from_nat (Suc k)) (Gram_Schmidt_column_k A j) = (a - (\<Sum>x\<in>cols_upt_k A k. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x))"
       unfolding Gram_Schmidt_column_k_def True  unfolding cols_upt_k_def a_def C_def
       unfolding  column_def apply auto 
       unfolding column_def[symmetric] col_rw minus_vec_def
       unfolding column_def vec_lambda_beta
       unfolding proj_onto_def proj_def[abs_def]
       unfolding proj_onto_sum_rw
       by auto
     have finite_C: "finite C" unfolding C_def cols_upt_k_def by auto
     {
       fix x b
       have th0: "!!(a::'a^'m::{mod_type}) b c. a - (b - c) = c + (a - b)"
         by (simp add: field_simps)
       have "x - b *\<^sub>R  (a - (\<Sum>x\<in>C. (x \<bullet> a / (x \<bullet> x))  *\<^sub>R  x)) \<in> span C \<longleftrightarrow> x - b  *\<^sub>R  a \<in> span C"
         apply (simp only: scaleR_right_diff_distrib th0)
         apply (rule span_add_eq)
         apply (rule span_mul)
         apply (rule span_sum)
         apply (rule span_mul)
         apply (rule span_base)
         apply assumption
         done
     } 
     thus ?thesis unfolding set_eq_iff
       unfolding C_def B_def unfolding set_rw1 unfolding set_rw2
       unfolding span_breakdown_eq unfolding hyp
       by (metis (mono_tags) B_def a_def rw)
   qed
 qed
 
 
 corollary span_Gram_Schmidt_column_k:
   fixes A::"'a::{real_inner}^'n::{mod_type}^'m::{mod_type}"
   assumes "k<ncols A"
   shows "span (columns A) = span (columns (Gram_Schmidt_column_k A k))"
   unfolding columns_eq_cols_upt_k[symmetric] 
   using span_cols_upt_k_Gram_Schmidt_column_k[of "ncols A - 1" A k]
   using assms unfolding ncols_def by auto
 
 
 corollary span_Gram_Schmidt_upt_k:
   fixes A::"'a::{real_inner}^'n::{mod_type}^'m::{mod_type}"
   assumes "k<ncols A"
   shows "span (columns A) = span (columns (Gram_Schmidt_upt_k A k))"
   using assms
 proof (induct k)
   case 0
   have "columns (Gram_Schmidt_column_k A 0) = columns A"    
   proof (unfold columns_def, auto)
     fix i 
     have set_rw: "{\<chi> ia. A $ ia $ i |i. i < from_nat 0} = {}"
       by (auto, metis less_le_not_le least_mod_type from_nat_0)
     thus "\<exists>ia. column i (Gram_Schmidt_column_k A 0) = column ia A" 
       unfolding Gram_Schmidt_column_k_def column_def
       unfolding proj_onto_def proj_def[abs_def] by auto
     show "\<exists>ia. column i A = column ia (Gram_Schmidt_column_k A 0)"
       using set_rw unfolding Gram_Schmidt_column_k_def column_def 
       unfolding from_nat_0 
       unfolding proj_onto_def proj_def[abs_def]
       by force
   qed
   thus ?case unfolding Gram_Schmidt_upt_k_def by auto
 next
   case (Suc k)
   have hyp: "span (columns A) = span (columns (Gram_Schmidt_upt_k A k))" 
     using Suc.prems Suc.hyps by auto
   have "span (columns (Gram_Schmidt_upt_k A (Suc k))) 
     = span (columns (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k)))"
     unfolding Gram_Schmidt_upt_k_suc ..
   also have "... = span (columns (Gram_Schmidt_upt_k A k))"
     using span_Gram_Schmidt_column_k[of "Suc k" "(Gram_Schmidt_upt_k A k)"]
     using Suc.prems unfolding ncols_def by auto
   finally show ?case using hyp by auto
 qed
 
 corollary span_Gram_Schmidt_matrix:
   fixes A::"'a::{real_inner}^'n::{mod_type}^'m::{mod_type}"
   shows "span (columns A) = span (columns (Gram_Schmidt_matrix A))"
   unfolding Gram_Schmidt_matrix_def
   by (simp add: span_Gram_Schmidt_upt_k ncols_def)
 
 lemma is_basis_columns_Gram_Schmidt_matrix:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes b: "is_basis (columns A)"
   and c: "card (columns A) = ncols A"
   shows "is_basis (columns (Gram_Schmidt_matrix A)) 
   \<and> card (columns (Gram_Schmidt_matrix A)) = ncols A"
 proof -
   have span_UNIV: "vec.span (columns (Gram_Schmidt_matrix A)) = (UNIV::(real^'m::{mod_type}) set)" 
     using span_Gram_Schmidt_matrix b unfolding is_basis_def
     by (metis span_vec_eq)
   moreover have c_eq: "card (columns (Gram_Schmidt_matrix A)) = ncols A" 
   proof -
     have "card (columns A) \<le> card (columns (Gram_Schmidt_matrix A))"
       by (metis b is_basis_def finite_columns vec.independent_span_bound span_UNIV top_greatest)
     thus ?thesis using c using card_columns_le_ncols by (metis le_antisym ncols_def)
   qed
   moreover have "vec.independent (columns (Gram_Schmidt_matrix A))"
   proof (rule vec.card_le_dim_spanning[of _ "UNIV::(real^'m::{mod_type}) set"])
     show "columns (Gram_Schmidt_matrix A) \<subseteq> UNIV" by simp
     show "UNIV \<subseteq> vec.span (columns (Gram_Schmidt_matrix A))" using span_UNIV by auto
     show "finite (columns (Gram_Schmidt_matrix A))" using finite_columns .
     show "card (columns (Gram_Schmidt_matrix A)) \<le> vec.dim (UNIV::(real^'m::{mod_type}) set)"
       by (metis b c c_eq eq_iff is_basis_def vec.dim_span_eq_card_independent)
   qed
   ultimately show ?thesis unfolding is_basis_def by simp
 qed
 
 
 text\<open>From here on, we present some lemmas that will be useful for the formalisation of the QR
   decomposition.\<close> 
 
 lemma column_gr_k_Gram_Schmidt_upt:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes "i>k"
   and i: "i<ncols A"
   shows "column (from_nat i) (Gram_Schmidt_upt_k A k) = column (from_nat i) A"
   using assms(1)
 proof (induct k)
   assume "0 < i"
   hence "(from_nat i::'n) \<noteq> 0" 
     unfolding from_nat_0[symmetric] using bij_from_nat[where ?'a='n] unfolding bij_betw_def
     by (metis from_nat_eq_imp_eq gr_implies_not0 i ncols_def neq0_conv)
   thus "column (from_nat i) (Gram_Schmidt_upt_k A 0) = column (from_nat i) A"
     unfolding Gram_Schmidt_upt_k_def 
     by (simp add: Gram_Schmidt_column_k_def from_nat_0 column_def)  
 next
   case (Suc k)
   have hyp: "column (from_nat i) (Gram_Schmidt_upt_k A k) = column (from_nat i) A"
     using Suc.hyps Suc.prems by auto
   have to_nat_from_nat_suc_k: "(to_nat (from_nat (Suc k)::'n)) = Suc k"
     by (metis Suc.prems dual_order.strict_trans from_nat_not_eq i ncols_def)
   have "column (from_nat i) (Gram_Schmidt_upt_k A (Suc k)) 
     = column (from_nat i) (Gram_Schmidt_column_k (Gram_Schmidt_upt_k A k) (Suc k))"
     unfolding Gram_Schmidt_upt_k_suc .. 
   also have "... =  column (from_nat i) (Gram_Schmidt_upt_k A k)"
   proof (rule column_Gram_Schmidt_column_k'
       [of "from_nat i" "from_nat (Suc k)" " (Gram_Schmidt_upt_k A k)", unfolded to_nat_from_nat_suc_k])
     show "from_nat i \<noteq> (from_nat (Suc k)::'n)" 
       by (metis Suc.prems not_less_iff_gr_or_eq
         from_nat_not_eq i ncols_def to_nat_from_nat_suc_k)
   qed
   finally show ?case unfolding hyp .
 qed
 
 lemma columns_Gram_Schmidt_upt_k_rw:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes k: "Suc k < ncols A"
   shows "{column i (Gram_Schmidt_upt_k A (Suc k)) |i. i < from_nat (Suc k)} 
   = {column i (Gram_Schmidt_upt_k A k) |i. i < from_nat (Suc k)}"
 proof (auto)
   fix i::'n assume i: "i < from_nat (Suc k)"
   have to_nat_from_nat_k: "to_nat (from_nat (Suc k)::'n) = Suc k" 
     using to_nat_from_nat_id k unfolding ncols_def by auto
   show "\<exists>ia. column i (Gram_Schmidt_upt_k A (Suc k)) = column ia (Gram_Schmidt_upt_k A k) \<and> ia < from_nat (Suc k)"
     by (metis column_Gram_Schmidt_upt_k_preserves i k ncols_def to_nat_le)
   show "\<exists>ia. column i (Gram_Schmidt_upt_k A k) = column ia (Gram_Schmidt_upt_k A (Suc k)) \<and> ia < from_nat (Suc k)"
     by (metis column_Gram_Schmidt_upt_k_preserves i k ncols_def to_nat_le)
 qed
 
 
 lemma column_Gram_Schmidt_upt_k:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes "k<ncols A"
   shows "column (from_nat k) (Gram_Schmidt_upt_k A k) = 
   (column (from_nat k) A) - (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A k)|i. i < (from_nat k)}. (x \<bullet> (column (from_nat k) A) / (x \<bullet> x)) *\<^sub>R x)"
   using assms
 proof (induct k, unfold from_nat_0)
   have set_rw: "{column i (Gram_Schmidt_upt_k A 0) |i. i < 0} = {}" by (auto, metis least_mod_type not_le)
   have set_rw2: "{column i A |i. i < 0} = {}"  by (auto, metis least_mod_type not_le)
   have col_rw: "column 0 A = column 0 (Gram_Schmidt_upt_k A 0)"
     unfolding Gram_Schmidt_upt_k_def apply auto unfolding Gram_Schmidt_column_k_def from_nat_0
     unfolding column_def
     using set_rw2 unfolding proj_onto_def proj_def[abs_def]
     by vector
   show "column 0 (Gram_Schmidt_upt_k A 0) 
     = column 0 A - (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A 0) |i. i < 0}. (x \<bullet> column 0 A / (x \<bullet> x)) *\<^sub>R x)"
     unfolding set_rw col_rw by simp
 next
   case (Suc k)
   let ?ak="column (from_nat k) A"
   let ?uk="column (from_nat k) (Gram_Schmidt_upt_k A k)"
   let ?a_suck= "column (from_nat (Suc k)) A"
   let ?u_suck="column (from_nat (Suc k)) (Gram_Schmidt_upt_k A (Suc k))"
   have to_nat_from_nat_k: "to_nat (from_nat (Suc k)::'n) = (Suc k)" 
     using to_nat_from_nat_id Suc.prems unfolding ncols_def by auto
   have a_suc_rw: "column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) = ?a_suck"
     by (rule column_gr_k_Gram_Schmidt_upt, auto simp add: Suc.prems)
   have set_rw: "{column i (Gram_Schmidt_upt_k A (Suc k)) |i. i < from_nat (Suc k)} 
     = {column i (Gram_Schmidt_upt_k A k) |i. i < from_nat (Suc k)}"
     by (rule columns_Gram_Schmidt_upt_k_rw[OF Suc.prems])
   have "?u_suck = column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) -
     (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A k) |i.
     i < from_nat (Suc k)}. (x \<bullet> column (from_nat (Suc k)) (Gram_Schmidt_upt_k A k) / (x \<bullet> x)) *\<^sub>R x)" 
     unfolding Gram_Schmidt_upt_k_suc
     using column_Gram_Schmidt_column_k[of "from_nat (Suc k)" "(Gram_Schmidt_upt_k A k)"]
     unfolding to_nat_from_nat_k by auto
   also have "... = ?a_suck -
     (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A k) |i.
     i < from_nat (Suc k)}. (x \<bullet> ?a_suck / (x \<bullet> x)) *\<^sub>R x)" unfolding a_suc_rw ..
   finally show "?u_suck = ?a_suck - (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A (Suc k)) |i.
     i < from_nat (Suc k)}. (x \<bullet> ?a_suck / (x \<bullet> x)) *\<^sub>R x)" 
     unfolding set_rw .
 qed
 
 
 
 lemma column_Gram_Schmidt_upt_k_preserves2:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes "a\<le>(from_nat i)"
   and "i \<le> j"
   and "j<ncols A"
   shows "column a (Gram_Schmidt_upt_k A i) = column a (Gram_Schmidt_upt_k A j)"
   using assms
 proof (induct j)
   case 0
   show "column a (Gram_Schmidt_upt_k A i) = column a (Gram_Schmidt_upt_k A 0)" by (metis "0.prems"(2) le_0_eq)
 next
   case (Suc j)
   show ?case
   proof (cases "a=from_nat (Suc j)")
     case False note a_not_suc_j=False
     have rw1: "(to_nat (from_nat (Suc j)::'n)) = Suc j"
       using to_nat_from_nat_id Suc.prems unfolding ncols_def by auto
     show ?thesis unfolding Gram_Schmidt_upt_k_suc using column_Gram_Schmidt_column_k'[OF a_not_suc_j] unfolding rw1
       by (metis Gram_Schmidt_upt_k_suc Suc.hyps Suc.prems(2) Suc.prems(3) Suc_le_lessD assms(1) le_Suc_eq nat_less_le)
   next
     case True
     have "(from_nat i::'n) \<le> from_nat (Suc j)" by (rule from_nat_mono'[OF Suc.prems(2) Suc.prems(3)[unfolded ncols_def]])
     hence "from_nat i = (from_nat (Suc j)::'n)" using Suc.prems(1) unfolding True by simp
     hence i_eq_suc: "i=Suc j" apply (rule from_nat_eq_imp_eq) using Suc.prems unfolding ncols_def by auto
     show ?thesis unfolding True i_eq_suc ..
   qed
 qed
 
 
 
 lemma set_columns_Gram_Schmidt_matrix: 
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   shows "{column i (Gram_Schmidt_matrix A)|i. i < k} = {column i (Gram_Schmidt_upt_k A (to_nat k))|i. i < k}"
 proof (auto)
   fix i assume i: "i<k"
   show "\<exists>ia. column i (Gram_Schmidt_matrix A) = column ia (Gram_Schmidt_upt_k A (to_nat k)) \<and> ia < k"
   proof (rule exI[of _ i], rule conjI)
     show "column i (Gram_Schmidt_matrix A) = column i (Gram_Schmidt_upt_k A (to_nat k))"
       unfolding Gram_Schmidt_matrix_def 
     proof (rule column_Gram_Schmidt_upt_k_preserves2[symmetric])
       show "i \<le> from_nat (to_nat k)" using i unfolding from_nat_to_nat_id by auto
       show "to_nat k \<le> ncols A - 1" unfolding ncols_def using to_nat_less_card[of k] by auto
       show "ncols A - 1 < ncols A" unfolding ncols_def by simp
     qed
     show "i < k" using i .
   qed
   show "\<exists>ia. column i (Gram_Schmidt_upt_k A (to_nat k)) = column ia (Gram_Schmidt_matrix A) \<and> ia < k"
   proof (rule exI[of _ i], rule conjI)
     show "column i (Gram_Schmidt_upt_k A (to_nat k)) = column i (Gram_Schmidt_matrix A)"
       unfolding Gram_Schmidt_matrix_def 
     proof (rule column_Gram_Schmidt_upt_k_preserves2)
       show "i \<le> from_nat (to_nat k)" using i unfolding from_nat_to_nat_id by auto
       show "to_nat k \<le> ncols A - 1" unfolding ncols_def using to_nat_less_card[of k] by auto
       show "ncols A - 1 < ncols A" unfolding ncols_def by simp
     qed
     show "i < k" using i .
   qed
 qed
 
 
 
 lemma column_Gram_Schmidt_matrix:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   shows "column k (Gram_Schmidt_matrix A) 
   = (column k A) - (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A)|i. i < k}. (x \<bullet> (column k A) / (x \<bullet> x)) *\<^sub>R x)"
 proof -
   have k: "to_nat k < ncols A" using to_nat_less_card[of k] unfolding ncols_def by simp
   have "column k (Gram_Schmidt_matrix A) = column k (Gram_Schmidt_upt_k A (ncols A - 1))"
     unfolding Gram_Schmidt_matrix_def ..
   also have "... = column k (Gram_Schmidt_upt_k A (to_nat k))"
   proof (rule column_Gram_Schmidt_upt_k_preserves2[symmetric])
     show "k \<le> from_nat (to_nat k)" unfolding from_nat_to_nat_id ..
     show "to_nat k \<le> ncols A - 1" unfolding ncols_def using to_nat_less_card[where ?'a='n]
-      by (metis Nat.le_diff_conv2 add_leE less_diff_conv less_imp_le_nat  less_le_not_le
+      by (metis le_diff_conv2 add_leE less_diff_conv less_imp_le_nat  less_le_not_le
         nat_le_linear suc_not_zero to_nat_plus_one_less_card')
     show "ncols A - 1 < ncols A" unfolding ncols_def by auto
   qed
   also have "... = column k A - (\<Sum>x\<in>{column i (Gram_Schmidt_upt_k A (to_nat k)) |i. i < k}. (x \<bullet> column k A / (x \<bullet> x)) *\<^sub>R x)"
     using column_Gram_Schmidt_upt_k[OF k] unfolding from_nat_to_nat_id by auto
   also have "... = column k A - (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i. i < k}. (x \<bullet> column k A / (x \<bullet> x)) *\<^sub>R x)"
     unfolding set_columns_Gram_Schmidt_matrix[symmetric] ..
   finally show ?thesis .
 qed
 
 
 corollary column_Gram_Schmidt_matrix2:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   shows "(column k A) = column k (Gram_Schmidt_matrix A) 
   + (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A)|i. i < k}. (x \<bullet> (column k A) / (x \<bullet> x)) *\<^sub>R x)"
   using column_Gram_Schmidt_matrix[of k A] by simp
 
 
 
 lemma independent_columns_Gram_Schmidt_matrix:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes b: "vec.independent (columns A)"
   and c: "card (columns A) = ncols A"
   shows "vec.independent (columns (Gram_Schmidt_matrix A)) \<and> card (columns (Gram_Schmidt_matrix A)) = ncols A"
   using  b c card_columns_le_ncols vec.card_eq_dim_span_indep vec.dim_span eq_iff finite_columns 
     vec.independent_span_bound ncols_def span_Gram_Schmidt_matrix
   by (metis (no_types, lifting) vec.card_ge_dim_independent vec.dim_span_eq_card_independent span_vec_eq)
 
 
 lemma column_eq_Gram_Schmidt_matrix:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   and c: "column i (Gram_Schmidt_matrix A) = column ia (Gram_Schmidt_matrix A)"
   shows "i = ia"
 proof (rule ccontr)
   assume i_not_ia: "i \<noteq> ia"
   have "columns (Gram_Schmidt_matrix A) = (\<lambda>x. column x (Gram_Schmidt_matrix A))` (UNIV::('n::{mod_type}) set)"
     unfolding columns_def by auto
   also have "... = (\<lambda>x. column x (Gram_Schmidt_matrix A))` ((UNIV::('n::{mod_type}) set)-{ia})"
   proof (unfold image_def, auto)  
     fix xa
     show "\<exists>x\<in>UNIV - {ia}. column xa (Gram_Schmidt_matrix A) = column x (Gram_Schmidt_matrix A)"
     proof (cases "xa = ia")
       case True thus ?thesis using c i_not_ia by (metis DiffI UNIV_I empty_iff insert_iff)
     next
       case False thus ?thesis by auto
     qed
   qed
   finally have columns_rw: "columns (Gram_Schmidt_matrix A) = (\<lambda>x. column x (Gram_Schmidt_matrix A)) ` (UNIV - {ia})" .
   have "ncols A = card (columns (Gram_Schmidt_matrix A))"
     by (metis full_rank_imp_is_basis2 independent_columns_Gram_Schmidt_matrix r)
   also have "... \<le> card (UNIV - {ia})" unfolding columns_rw by (rule card_image_le, simp)
   also have "... = card (UNIV::'n set) - 1" by (simp add: card_Diff_singleton)
   finally show False unfolding ncols_def
-    by (metis Nat.add_0_right Nat.le_diff_conv2 One_nat_def Suc_n_not_le_n add_Suc_right one_le_card_finite)
+    by (metis Nat.add_0_right le_diff_conv2 One_nat_def Suc_n_not_le_n add_Suc_right one_le_card_finite)
 qed
 
 lemma scaleR_columns_Gram_Schmidt_matrix:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes "i \<noteq> j"
   and "rank A = ncols A"
   shows "column j (Gram_Schmidt_matrix A) \<bullet> column i (Gram_Schmidt_matrix A) = 0"
 proof -
   have "column j (Gram_Schmidt_matrix A) \<noteq> column i (Gram_Schmidt_matrix A)"
     using column_eq_Gram_Schmidt_matrix assms by auto
   thus ?thesis using orthogonal_Gram_Schmidt_matrix2 unfolding pairwise_def orthogonal_def columns_def
     by blast
 qed
 
 
 subsubsection\<open>Examples of execution\<close>
 
 text\<open>Code lemma\<close>
 lemmas Gram_Schmidt_step_def[unfolded proj_onto_def proj_def[abs_def],code]
 
 value "let a = map (list_to_vec::real list=> real^4) [[4,-2,-1,2], 
   [-6,3,4,-8], [5,-5,-3,-4]] in 
   map vec_to_list (Gram_Schmidt a)"
 
 value "let a = map (list_to_vec::real list=> real^4) [[4,-2,-1,2], 
   [-6,3,4,-8], [5,-5,-3,-4]] in 
   map vec_to_list (Gram_Schmidt2 a)"
 
 value "let A = list_of_list_to_matrix [[4,-2,-1,2], 
   [-6,3,4,-8], [5,-5,-3,-4]]::real^4^3 in 
   matrix_to_list_of_list (Gram_Schmidt_matrix A)"
 
 
 end
diff --git a/thys/QR_Decomposition/QR_Decomposition.thy b/thys/QR_Decomposition/QR_Decomposition.thy
--- a/thys/QR_Decomposition/QR_Decomposition.thy
+++ b/thys/QR_Decomposition/QR_Decomposition.thy
@@ -1,754 +1,754 @@
 (*  
     Title:      QR_Decomposition.thy
     Author:     Jose Divasón <jose.divasonm at unirioja.es>
     Author:     Jesús Aransay <jesus-maria.aransay at unirioja.es>
 *)
 
 section\<open>QR Decomposition\<close>
 
 theory QR_Decomposition
 imports Gram_Schmidt
 begin
  
 subsection\<open>The QR Decomposition of a matrix\<close>
 
 text\<open>
 First of all, it's worth noting what an orthogonal matrix is. In linear algebra, 
 an orthogonal matrix is a square matrix with real entries whose columns and rows are orthogonal 
 unit vectors.
 
 Although in some texts the QR decomposition is presented over square matrices, it can be applied to any matrix.
 There are some variants of the algorithm, depending on the properties that the output matrices 
 satisfy (see for instance, @{url "http://inst.eecs.berkeley.edu/~ee127a/book/login/l_mats_qr.html"}). 
 We present two of them below.
 
 Let A be a matrix with m rows and n columns (A is \<open>m \<times> n\<close>).
 
 Case 1: Starting with a matrix whose column rank is maximum. We can define the QR decomposition
 to obtain:
 
 \begin{itemize}
   \item @{term "A = Q ** R"}.
   \item Q has m rows and n columns. Its columns are orthogonal unit vectors 
         and @{term "(transpose Q) * Q = mat 1"}. In addition, if A is a square matrix, then Q
         will be an orthonormal matrix.
   \item R is \<open>n \<times> n\<close>, invertible and upper triangular.
 \end{itemize}
 
 Case 2: The called full QR decomposition. We can obtain:
 \begin{itemize}
  \item @{term "A = Q ** R"}
  \item Q is an orthogonal matrix (Q is \<open>m \<times> m\<close>).
  \item R is \<open>m \<times> n\<close> and upper triangular, but it isn't invertible.
 \end{itemize}
 
 We have decided to formalise the first one, because it's the only useful for solving 
 the linear least squares problem (@{url "http://math.mit.edu/linearalgebra/ila0403.pdf"}).
 
 If we have an unsolvable system \<open>A *v x = b\<close>, we can try to find an approximate solution.
 A plausible choice (not the only one) is to seek an \<open>x\<close> with the property that
 \<open>\<parallel>A ** x - y\<parallel>\<close> (the magnitude of the error) is as small as possible. That \<open>x\<close>
 is the least squares approximation.
 
 We will demostrate that the best approximation (the solution for the linear least squares problem)
 is the \<open>x\<close> that satisfies:
 
 \<open>(transpose A) ** A *v x = (transpose A) *v b\<close>
 
 Now we want to compute that x.
 
 If we are working with the first case, \<open>A\<close> can be substituted by \<open>Q**R\<close> and then
 obtain the solution of the least squares approximation by means of the QR decomposition:
 
 \<open>x = (inverse R)**(transpose Q) *v b\<close>
 
 On the contrary, if we are working with the second case after 
 substituting \<open>A\<close> by \<open>Q**R\<close> we obtain:
 
 \<open>(transpose R) ** R *v x = (transpose R) ** (transpose Q) *v b\<close>
 
 But the \<open>R\<close> matrix is not invertible (so neither is \<open>transpose R\<close>). The left part
 of the equation \<open>(transpose R) ** R\<close> is not going to be an upper triangular matrix, 
 so it can't either be solved using backward-substitution.
 \<close>
 
 
 subsubsection\<open>Divide a vector by its norm\<close>
 
 text\<open>An orthogonal matrix is a matrix whose rows (and columns) are orthonormal vectors. So, in order to 
 obtain the QR decomposition, we have to normalise (divide by the norm) 
 the vectors obtained with the Gram-Schmidt algorithm.\<close>
 
 definition "divide_by_norm A  = (\<chi> a b. normalize (column b A) $ a)"
 
 text\<open>Properties\<close>
 
 lemma norm_column_divide_by_norm:
   fixes A::"'a::{real_inner}^'cols^'rows"
   assumes a: "column a A \<noteq> 0"
   shows "norm (column a (divide_by_norm A)) = 1"
 proof -
   have not_0: "norm (\<chi> i. A $ i $ a) \<noteq> 0" by (metis a column_def norm_eq_zero)
   have "column a (divide_by_norm A) = (\<chi> i. (1 / norm (\<chi> i. A $ i $ a)) *\<^sub>R A $ i $ a)" 
     unfolding divide_by_norm_def column_def normalize_def by auto
   also have "... =  (1 / norm (\<chi> i. A $ i $ a)) *\<^sub>R (\<chi> i.  A $ i $ a)"
     unfolding vec_eq_iff by auto
   finally have "norm (column a (divide_by_norm A)) = norm ((1 / norm (\<chi> i. A $ i $ a)) *\<^sub>R (\<chi> i.  A $ i $ a))"
     by simp
   also have "... = \<bar>1 / norm (\<chi> i. A $ i $ a)\<bar> * norm (\<chi> i. A $ i $ a)"
     unfolding norm_scaleR ..
   also have "... = (1 / norm (\<chi> i. A $ i $ a)) * norm (\<chi> i. A $ i $ a)"
     by auto
   also have "... = 1" using not_0 by auto
   finally show ?thesis .
 qed
 
 lemma span_columns_divide_by_norm:
   shows "span (columns A) = span (columns (divide_by_norm A))"
   unfolding real_vector.span_eq
 proof (auto)
   fix x assume x: "x \<in> columns (divide_by_norm A)"
   from this obtain i where x_col_i: "x=column i (divide_by_norm A)" unfolding columns_def by blast
   also have "... = (1/norm (column i  A)) *\<^sub>R (column i A)" 
     unfolding divide_by_norm_def column_def normalize_def by vector
   finally have x_eq: "x=(1/norm (column i A)) *\<^sub>R (column i A)" .
   show "x \<in> span (columns A)"
     by (unfold x_eq, rule span_mul, rule span_base, auto simp add: columns_def)
 next
   fix x
   assume x: "x \<in> columns A"
   show "x \<in> span (columns (divide_by_norm A))"
   proof (cases "x=0")
     case True show ?thesis by (metis True span_0)
   next
     case False
     from x obtain i where x_col_i: "x=column i A" unfolding columns_def by blast
     have "x=column i A" using x_col_i .
     also have "... = norm (column i A) *\<^sub>R column i (divide_by_norm A)"
       using False unfolding x_col_i columns_def divide_by_norm_def column_def normalize_def by vector
     finally have x_eq: "x = norm (column i A) *\<^sub>R column i (divide_by_norm A)" .
     show "x \<in> span (columns (divide_by_norm A))"
       by (unfold x_eq, rule span_mul, rule span_base,
         auto simp add: columns_def Let_def)
   qed
 qed
 
 text\<open>Code lemmas\<close>
 
 definition "divide_by_norm_row A a = vec_lambda(% b. ((1 / norm (column b A)) *\<^sub>R column b A) $ a)"
 
 lemma divide_by_norm_row_code[code abstract]:
   "vec_nth (divide_by_norm_row A a) = (% b. ((1 / norm (column b A)) *\<^sub>R column b A) $ a)"
   unfolding divide_by_norm_row_def by (metis (lifting) vec_lambda_beta)
 
 lemma divide_by_norm_code [code abstract]:
   "vec_nth (divide_by_norm A) = divide_by_norm_row A"
   unfolding divide_by_norm_def unfolding divide_by_norm_row_def[abs_def]
   unfolding normalize_def
   by fastforce
 
 subsubsection\<open>The QR Decomposition\<close>
 
 text\<open>The QR decomposition. Given a real matrix @{term "A"}, the algorithm will return a pair @{term "(Q,R)"}
   where @{term "Q"} is an matrix whose columns are orthogonal unit vectors, @{term "R"} 
   is upper triangular and @{term "A=Q**R"}.\<close>
 
 definition "QR_decomposition A = (let Q = divide_by_norm (Gram_Schmidt_matrix A) in (Q, (transpose Q) ** A))"
 
 lemma is_basis_columns_fst_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes b: "is_basis (columns A)"
   and c: "card (columns A) = ncols A"
   shows "is_basis (columns (fst (QR_decomposition A))) 
   \<and> card (columns (fst (QR_decomposition A))) = ncols A"
 proof (rule conjI, unfold is_basis_def, rule conjI)
   have "vec.span (columns (fst (QR_decomposition A))) = vec.span (columns (Gram_Schmidt_matrix A))"
     unfolding vec.span_eq
   proof (auto)
     fix x show "x \<in> vec.span (columns (Gram_Schmidt_matrix A))"
       using assms(1) assms(2) is_basis_columns_Gram_Schmidt_matrix is_basis_def by auto
   next
     fix x
     assume x: "x \<in> columns (Gram_Schmidt_matrix A)"
     from this obtain i where x_col_i: "x=column i (Gram_Schmidt_matrix A)" unfolding columns_def by blast
     have zero_not_in: "x \<noteq> 0" using is_basis_columns_Gram_Schmidt_matrix[OF b c] unfolding is_basis_def
       using vec.dependent_zero[of "(columns (Gram_Schmidt_matrix A))"] x by auto
     have "x=column i (Gram_Schmidt_matrix A)" using x_col_i .
     also have "... = norm (column i (Gram_Schmidt_matrix A)) *\<^sub>R column i (divide_by_norm (Gram_Schmidt_matrix A))"
       using zero_not_in unfolding x_col_i columns_def divide_by_norm_def column_def normalize_def by vector
     finally have x_eq: "x = norm (column i (Gram_Schmidt_matrix A)) *\<^sub>R column i (divide_by_norm (Gram_Schmidt_matrix A))" .
     show "x \<in> vec.span (columns (fst (QR_decomposition A)))"
       unfolding x_eq span_vec_eq
       apply (rule subspace_mul)
       apply (auto simp add: columns_def QR_decomposition_def Let_def subspace_span intro: span_superset)
       using span_superset by force
   qed
   thus s: "vec.span (columns (fst (QR_decomposition A))) = (UNIV::(real^'m::{mod_type}) set)"
     using is_basis_columns_Gram_Schmidt_matrix[OF b c] unfolding is_basis_def by simp
   thus "card (columns (fst (QR_decomposition A))) = ncols A"
     by (metis (hide_lams, mono_tags) b c card_columns_le_ncols vec.card_le_dim_spanning 
       finite_columns vec.indep_card_eq_dim_span is_basis_def ncols_def top_greatest)
   thus "vec.independent (columns (fst (QR_decomposition A)))"
     by (metis s b c vec.card_eq_dim_span_indep finite_columns vec.indep_card_eq_dim_span is_basis_def)
 qed
 
 
 lemma orthogonal_fst_QR_decomposition:
   shows "pairwise orthogonal (columns (fst (QR_decomposition A)))"
   unfolding pairwise_def columns_def
 proof (auto)
   fix i ia
   assume col_not_eq: "column i (fst (QR_decomposition A)) \<noteq> column ia (fst (QR_decomposition A))"
   hence i_not_ia: "i \<noteq> ia" by auto
   from col_not_eq obtain a 
     where "(fst (QR_decomposition A)) $ a $ i \<noteq> (fst (QR_decomposition A)) $ a $ ia"
     unfolding column_def by force
   hence col_not_eq2: " (column i (Gram_Schmidt_matrix A)) \<noteq> (column ia (Gram_Schmidt_matrix A))"
     using col_not_eq unfolding QR_decomposition_def Let_def fst_conv 
     by (metis (lifting) divide_by_norm_def vec_lambda_beta)
   have d1: "column i (fst (QR_decomposition A))
     = (1 / norm (\<chi> ia. Gram_Schmidt_matrix A $ ia $ i)) *\<^sub>R (column i (Gram_Schmidt_matrix A))"
     unfolding QR_decomposition_def Let_def fst_conv
     unfolding divide_by_norm_def column_def normalize_def unfolding vec_eq_iff by auto
   have d2: "column ia (fst (QR_decomposition A))
     = (1 / norm (\<chi> i. Gram_Schmidt_matrix A $ i $ ia)) *\<^sub>R (column ia (Gram_Schmidt_matrix A))"
     unfolding QR_decomposition_def Let_def fst_conv
     unfolding divide_by_norm_def column_def normalize_def unfolding vec_eq_iff by auto
   show "orthogonal (column i (fst (QR_decomposition A))) (column ia (fst (QR_decomposition A)))"
     unfolding d1 d2 apply (rule orthogonal_mult) using orthogonal_Gram_Schmidt_matrix[of A]
     unfolding pairwise_def using col_not_eq2 by auto
 qed
 
 
 lemma qk_uk_norm:
   "(1/(norm (column k ((Gram_Schmidt_matrix A))))) *\<^sub>R (column k ((Gram_Schmidt_matrix A))) 
   = column k (fst(QR_decomposition A))"
   unfolding QR_decomposition_def Let_def fst_conv divide_by_norm_def
   unfolding column_def normalize_def by vector
 
 
 lemma norm_columns_fst_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes "rank A = ncols A"
   shows "norm (column i (fst (QR_decomposition A))) = 1"
 proof -
   have "vec.independent (columns (Gram_Schmidt_matrix A))"
     by (metis assms full_rank_imp_is_basis2 independent_columns_Gram_Schmidt_matrix)
   hence "column i (Gram_Schmidt_matrix A) \<noteq> 0" 
     using vec.dependent_zero[of "columns (Gram_Schmidt_matrix A)"]
     unfolding columns_def by auto
   thus "norm (column i (fst (QR_decomposition A))) = 1"
     unfolding QR_decomposition_def Let_def fst_conv 
     by (rule norm_column_divide_by_norm)
 qed
 
 
 
 corollary span_fst_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   shows "vec.span (columns A) = vec.span (columns (fst (QR_decomposition A)))"
   unfolding span_Gram_Schmidt_matrix[of A]
   unfolding QR_decomposition_def Let_def fst_conv
   by (metis \<open>span (columns A) = span (columns (Gram_Schmidt_matrix A))\<close> span_columns_divide_by_norm span_vec_eq)
 
 corollary col_space_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   shows "col_space A = col_space (fst (QR_decomposition A))"
   unfolding col_space_def using span_fst_QR_decomposition
   by auto
 
 
 lemma independent_columns_fst_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes b: "vec.independent (columns A)"
   and c: "card (columns A) = ncols A"
   shows "vec.independent (columns (fst (QR_decomposition A))) 
   \<and> card (columns (fst (QR_decomposition A))) = ncols A"
 proof -
   have r: "rank A = ncols A" thm is_basis_imp_full_rank
   proof -
     have "rank A = col_rank A" unfolding rank_col_rank ..
     also have "... = vec.dim (col_space A)" unfolding col_rank_def ..
     also have "... = card (columns A)"
       unfolding col_space_def using b
       by (rule vec.dim_span_eq_card_independent)
     also have "... = ncols A" using c .
     finally show ?thesis .
   qed
   have "vec.independent (columns (fst (QR_decomposition A)))" 
     by (metis b c col_rank_def col_space_QR_decomposition col_space_def 
       full_rank_imp_is_basis2 vec.indep_card_eq_dim_span ncols_def rank_col_rank)
   moreover have "card (columns (fst (QR_decomposition A))) = ncols A" 
     by (metis col_space_QR_decomposition full_rank_imp_is_basis2 ncols_def r rank_eq_dim_col_space')
   ultimately show ?thesis by simp
 qed
 
 
 lemma orthogonal_matrix_fst_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "transpose (fst (QR_decomposition A)) ** (fst (QR_decomposition A)) = mat 1"
 proof (unfold vec_eq_iff, clarify, unfold mat_1_fun, auto)
   define Q where "Q = fst (QR_decomposition A)"
   have n: "\<forall>i. norm (column i Q) = 1" unfolding Q_def using norm_columns_fst_QR_decomposition[OF r] by auto
   have c: "card (columns Q) = ncols A" unfolding Q_def
     by (metis full_rank_imp_is_basis2 independent_columns_fst_QR_decomposition r)
   have p: "pairwise orthogonal (columns Q)" by (metis Q_def orthogonal_fst_QR_decomposition)
   fix ia
   have "(transpose Q ** Q) $ ia $ ia = column ia Q \<bullet> column ia Q"
     unfolding matrix_matrix_mult_inner_mult unfolding row_transpose ..
   also have "... = 1" using n norm_eq_1 by blast
   finally show "(transpose Q ** Q) $ ia $ ia = 1" .
   fix i
   assume i_not_ia: "i \<noteq> ia"
   have column_i_not_ia: "column i Q \<noteq> column ia Q"
   proof (rule ccontr, simp)
     assume col_i_ia: "column i Q = column ia Q"
     have rw: "(\<lambda>i. column i Q)` (UNIV-{ia}) = {column i Q|i. i\<noteq>ia}" unfolding columns_def by auto
     have "card (columns Q) = card ({column i Q|i. i\<noteq>ia})"
       by (rule bij_betw_same_card[of id], unfold bij_betw_def columns_def, auto, metis col_i_ia i_not_ia)
     also have "... = card ((\<lambda>i. column i Q)` (UNIV-{ia}))" unfolding rw ..
     also have "... \<le> card (UNIV - {ia})" by (metis card_image_le finite_code)
     also have "... < CARD ('n)" by simp
     finally show False using c unfolding ncols_def by simp
   qed
   hence oia: "orthogonal (column i Q) (column ia Q)"
     using p unfolding pairwise_def unfolding columns_def by auto
   have "(transpose Q ** Q) $ i $ ia = column i Q \<bullet> column ia Q"
     unfolding matrix_matrix_mult_inner_mult unfolding row_transpose ..
   also have "... = 0" using oia unfolding orthogonal_def .
   finally show "(transpose Q ** Q) $ i $ ia = 0" .
 qed
 
 corollary orthogonal_matrix_fst_QR_decomposition':
   fixes A::"real^'n::{mod_type}^'n::{mod_type}"
   assumes "rank A = ncols A"
   shows "orthogonal_matrix (fst (QR_decomposition A))"
   by (metis assms orthogonal_matrix orthogonal_matrix_fst_QR_decomposition)
 
 
 lemma column_eq_fst_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   and c: "column i (fst (QR_decomposition A)) = column ia (fst (QR_decomposition A))"
   shows "i = ia"
 proof (rule ccontr)
   assume i_not_ia: "i \<noteq> ia"
   have "columns  (fst (QR_decomposition A)) = (\<lambda>x. column x  (fst (QR_decomposition A)))` (UNIV::('n::{mod_type}) set)"
     unfolding columns_def by auto
   also have "... = (\<lambda>x. column x  (fst (QR_decomposition A)))` ((UNIV::('n::{mod_type}) set)-{ia})"
   proof (unfold image_def, auto)  
     fix xa
     show "\<exists>x\<in>UNIV - {ia}. column xa  (fst (QR_decomposition A)) = column x  (fst (QR_decomposition A))"
     proof (cases "xa = ia")
       case True thus ?thesis using c i_not_ia by (metis DiffI UNIV_I empty_iff insert_iff)
     next
       case False thus ?thesis by auto
     qed
   qed
   finally have columns_rw: "columns  (fst (QR_decomposition A)) 
     = (\<lambda>x. column x  (fst (QR_decomposition A))) ` (UNIV - {ia})" .
   have "ncols A = card (columns  (fst (QR_decomposition A)))"
     by (metis full_rank_imp_is_basis2 independent_columns_fst_QR_decomposition r)
   also have "... \<le> card (UNIV - {ia})" unfolding columns_rw by (rule card_image_le, simp)
   also have "... = card (UNIV::'n set) - 1" by (simp add: card_Diff_singleton)
   finally show False unfolding ncols_def
-    by (metis Nat.add_0_right Nat.le_diff_conv2 One_nat_def Suc_n_not_le_n add_Suc_right one_le_card_finite)
+    by (metis Nat.add_0_right le_diff_conv2 One_nat_def Suc_n_not_le_n add_Suc_right one_le_card_finite)
 qed
 
 corollary column_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "column k ((Gram_Schmidt_matrix A)) 
   = (column k A) - (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i < k}. (x \<bullet> (column k A) / (x \<bullet> x)) *\<^sub>R x)"
 proof -
   let ?uk="column k ((Gram_Schmidt_matrix A))"
   let ?qk="column k (fst(QR_decomposition A))"
   let ?ak="(column k A)"
   define f where "f x = (1/norm x) *\<^sub>R x" for x :: "real^'m::{mod_type}"
   let ?g="\<lambda>x::real^'m::{mod_type}. (x \<bullet> (column k A) / (x \<bullet> x)) *\<^sub>R x"
   have set_rw: "{column i (fst (QR_decomposition A))|i. i < k} = f`{column i (Gram_Schmidt_matrix A)|i. i < k}"
   proof (auto)
     fix i 
     assume i: "i < k"
     have col_rw: "column i (fst (QR_decomposition A)) = 
       (1/norm (column i (Gram_Schmidt_matrix A))) *\<^sub>R (column i (Gram_Schmidt_matrix A))"
       unfolding QR_decomposition_def Let_def fst_conv divide_by_norm_def column_def normalize_def by vector
     thus "column i (fst (QR_decomposition A)) \<in> f ` {column i (Gram_Schmidt_matrix A) |i. i < k}"
       unfolding f_def using i
       by auto
     show "\<exists>ia. f (column i (Gram_Schmidt_matrix A)) = column ia (fst (QR_decomposition A)) \<and> ia < k"
       by (rule exI[of _ i], simp add: f_def col_rw i)
   qed
   have "(\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x) 
     = (\<Sum>x\<in>(f`{column i (Gram_Schmidt_matrix A)|i. i < k}). (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)" 
     unfolding set_rw ..
   also have "... = sum (?g  \<circ> f) {column i (Gram_Schmidt_matrix A)|i. i < k}"
   proof (rule sum.reindex, unfold inj_on_def, auto)
     fix i ia assume i: "i < k" and ia: "ia < k"
       and f_eq: "f (column i (Gram_Schmidt_matrix A)) = f (column ia (Gram_Schmidt_matrix A))"
     have fi: "f (column i (Gram_Schmidt_matrix A)) = column i (fst (QR_decomposition A))"
       unfolding f_def QR_decomposition_def Let_def fst_conv divide_by_norm_def column_def normalize_def
       by vector
     have fia: "f (column ia (Gram_Schmidt_matrix A)) = column ia (fst (QR_decomposition A))"
       unfolding f_def QR_decomposition_def Let_def fst_conv divide_by_norm_def column_def normalize_def
       by vector
     have "i = ia" using column_eq_fst_QR_decomposition[OF r] f_eq unfolding fi fia by simp
     thus "column i (Gram_Schmidt_matrix A) = column ia (Gram_Schmidt_matrix A)" by simp
   qed
   also have "... =  (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i.
     i < k}. ((1 / norm x) *\<^sub>R x \<bullet> ?ak / ((1 / norm x) *\<^sub>R x \<bullet> (1 / norm x) *\<^sub>R x)) *\<^sub>R (1 / norm x) *\<^sub>R x)" unfolding o_def f_def ..
   also have "... =  (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i.
     i < k}. ((1 / norm x) *\<^sub>R x \<bullet> ?ak)  *\<^sub>R (1 / norm x) *\<^sub>R x)"
   proof (rule sum.cong, simp)
     fix x assume x: "x \<in> {column i (Gram_Schmidt_matrix A) |i. i < k}"
     have "vec.independent {column i (Gram_Schmidt_matrix A) |i. i < k}"
     proof (rule vec.independent_mono[of "columns (Gram_Schmidt_matrix A)"])
       show "vec.independent (columns (Gram_Schmidt_matrix A))"
         using full_rank_imp_is_basis2[of "(Gram_Schmidt_matrix A)"]
         by (metis full_rank_imp_is_basis2 independent_columns_Gram_Schmidt_matrix r)
       show "{column i (Gram_Schmidt_matrix A) |i. i < k} \<subseteq> columns (Gram_Schmidt_matrix A)"
         unfolding columns_def by auto
     qed
     hence "x \<noteq> 0" using vec.dependent_zero[of " {column i (Gram_Schmidt_matrix A) |i. i < k}"] x
       by blast
     hence "((1 / norm x) *\<^sub>R x \<bullet> (1 / norm x) *\<^sub>R x) = 1" by (metis inverse_eq_divide norm_eq_1 norm_sgn sgn_div_norm)
     thus "((1 / norm x) *\<^sub>R x \<bullet> ?ak / ((1 / norm x) *\<^sub>R x \<bullet> (1 / norm x) *\<^sub>R x)) *\<^sub>R (1 / norm x) *\<^sub>R x =
       ((1 / norm x) *\<^sub>R x \<bullet> column k A) *\<^sub>R (1 / norm x) *\<^sub>R x" by auto
   qed
   also have "... = (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i. i < k}. (((x \<bullet> ?ak)) / (x \<bullet> x)) *\<^sub>R x)"
   proof (rule sum.cong, simp)
     fix x
     assume x: "x \<in> {column i (Gram_Schmidt_matrix A) |i. i < k}"
     show "((1 / norm x) *\<^sub>R x \<bullet> column k A) *\<^sub>R (1 / norm x) *\<^sub>R x = (x \<bullet> column k A / (x \<bullet> x)) *\<^sub>R x"
       by (metis (hide_lams, no_types) mult.right_neutral inner_commute inner_scaleR_right 
         norm_cauchy_schwarz_eq scaleR_one scaleR_scaleR times_divide_eq_right times_divide_times_eq)
   qed
   finally have "?ak - (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)
     = ?ak - (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i. i < k}. (((x \<bullet> ?ak)) / (x \<bullet> x)) *\<^sub>R x)" by auto
   also have "... = ?uk" using column_Gram_Schmidt_matrix[of k A] by auto
   finally show ?thesis ..
 qed
 
 lemma column_QR_decomposition':
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "(column k A) = column k ((Gram_Schmidt_matrix A)) 
   + (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i < k}. (x \<bullet> (column k A) / (x \<bullet> x)) *\<^sub>R x)"
   using column_QR_decomposition[OF r] by simp
 
 
 lemma norm_uk_eq:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "norm (column k ((Gram_Schmidt_matrix A))) = ((column k (fst(QR_decomposition A))) \<bullet> (column k A))"
 proof -
   let ?uk="column k ((Gram_Schmidt_matrix A))"
   let ?qk="column k (fst(QR_decomposition A))"
   let ?ak="(column k A)"
   have sum_rw: "(?uk \<bullet> (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)) = 0"
   proof -
     have "(?uk \<bullet> (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x))
       = ((\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i. i < k}. ?uk \<bullet> ((x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)))" 
       unfolding inner_sum_right ..
     also have "... = (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i. i < k}. ((x \<bullet> ?ak / (x \<bullet> x)) * (?uk \<bullet> x)))"
       unfolding inner_scaleR_right ..
     also have "... = 0"
     proof (rule sum.neutral, clarify)
       fix x i assume "i<k" 
       hence "?uk \<bullet> column i (Gram_Schmidt_matrix A) = 0" 
         by (metis less_irrefl r scaleR_columns_Gram_Schmidt_matrix)
       thus "column i (Gram_Schmidt_matrix A) \<bullet> ?ak / (column i (Gram_Schmidt_matrix A) \<bullet> column i (Gram_Schmidt_matrix A)) *
         (?uk \<bullet> column i (Gram_Schmidt_matrix A)) = 0" by auto
     qed
     finally show ?thesis .
   qed
   have "?qk \<bullet> ?ak = ((1/(norm ?uk)) *\<^sub>R ?uk) \<bullet> ?ak" unfolding qk_uk_norm ..
   also have "... = (1/(norm ?uk)) * (?uk \<bullet> ?ak)" unfolding inner_scaleR_left ..
   also have "... = 
     (1/(norm ?uk)) * (?uk \<bullet> (?uk + (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)))"
     using column_Gram_Schmidt_matrix2[of k A] by auto
   also have "... = (1/(norm ?uk)) * ((?uk \<bullet> ?uk) + (?uk \<bullet> (\<Sum>x\<in>{column i (Gram_Schmidt_matrix A) |i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)))"
     unfolding inner_add_right ..
   also have "... = (1/(norm ?uk)) * (?uk \<bullet> ?uk)" unfolding sum_rw by auto
   also have "... = norm ?uk"
     by (metis abs_of_nonneg divide_eq_imp div_by_0 inner_commute inner_ge_zero inner_real_def 
       norm_mult_vec real_inner_1_right real_norm_def times_divide_eq_right)
   finally show ?thesis ..
 qed
 
 corollary column_QR_decomposition2:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "(column k A) 
   = (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i \<le> k}. (x \<bullet> (column k A)) *\<^sub>R x)"
 proof -
   let ?uk="column k ((Gram_Schmidt_matrix A))"
   let ?qk="column k (fst(QR_decomposition A))"
   let ?ak="(column k A)"
   have set_rw: "{column i (fst (QR_decomposition A))|i. i \<le> k} 
     = insert (column k (fst (QR_decomposition A))) {column i (fst (QR_decomposition A))|i. i < k}"
     by (auto, metis less_linear not_less)
   have uk_norm_uk_qk: "?uk = norm ?uk *\<^sub>R ?qk"
   proof -
     have "vec.independent (columns (Gram_Schmidt_matrix A))"
       by (metis full_rank_imp_is_basis2 independent_columns_Gram_Schmidt_matrix r)
     moreover have "?uk \<in> columns (Gram_Schmidt_matrix A)" unfolding columns_def by auto
     ultimately have "?uk \<noteq> 0"
       using vec.dependent_zero[of "columns (Gram_Schmidt_matrix A)"] unfolding columns_def by auto    
     hence norm_not_0: "norm ?uk \<noteq> 0" unfolding norm_eq_zero .
     have "norm (?uk) *\<^sub>R ?qk = (norm ?uk) *\<^sub>R ((1 / norm ?uk) *\<^sub>R ?uk)" using qk_uk_norm[of k A] by simp
     also have "... = ((norm ?uk) * (1 / norm ?uk)) *\<^sub>R ?uk" unfolding scaleR_scaleR ..
     also have "... = ?uk" using norm_not_0 by auto
     finally show ?thesis ..
   qed
   have norm_qk_1: "?qk  \<bullet> ?qk = 1" 
     using norm_eq_1 norm_columns_fst_QR_decomposition[OF r]
     by auto
   have "?ak = ?uk + (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)"
     using column_QR_decomposition'[OF r] by auto
   also have "... = (norm ?uk *\<^sub>R ?qk)  + (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)"
     using uk_norm_uk_qk by simp
   also have "... = ((?qk \<bullet> ?ak) *\<^sub>R ?qk)  
     + (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)"
     unfolding norm_uk_eq[OF r] ..
   also have "... = ((?qk \<bullet> ?ak)/(?qk \<bullet> ?qk)) *\<^sub>R ?qk
     + (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)" using norm_qk_1 by fastforce
   also have "... = (\<Sum>x\<in>insert ?qk {column i (fst (QR_decomposition A))|i. i < k}. (x \<bullet> ?ak / (x \<bullet> x)) *\<^sub>R x)"
   proof (rule sum.insert[symmetric])
     show "finite {column i (fst (QR_decomposition A)) |i. i < k}" by simp
     show "column k (fst (QR_decomposition A)) \<notin> {column i (fst (QR_decomposition A)) |i. i < k}"
     proof (rule ccontr, simp)
       assume "\<exists>i. column k (fst (QR_decomposition A)) = column i (fst (QR_decomposition A)) \<and> i < k"
       from this obtain i where col_eq: "column k (fst (QR_decomposition A)) = column i (fst (QR_decomposition A))"
         and i_less_k: "i < k" by blast
       show False using column_eq_fst_QR_decomposition[OF r col_eq] i_less_k by simp
     qed
   qed
   also have "... = (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i \<le> k}. (x \<bullet> (column k A)) *\<^sub>R x)"
   proof (rule sum.cong, simp add: set_rw)
     fix x assume x: "x \<in> {column i (fst (QR_decomposition A)) |i. i \<le> k}"
     from this obtain i where i: "x=column i (fst (QR_decomposition A))" by blast
     hence "(x \<bullet> x) = 1" using norm_eq_1 norm_columns_fst_QR_decomposition[OF r]
       by auto
     thus "(x \<bullet> column k A / (x \<bullet> x)) *\<^sub>R x = (x \<bullet> column k A) *\<^sub>R x" by simp
   qed
   finally show ?thesis .
 qed
 
 
 lemma orthogonal_columns_fst_QR_decomposition:
   assumes i_not_ia: "(column i (fst (QR_decomposition A))) \<noteq> (column ia (fst (QR_decomposition A)))"
   shows "(column i (fst (QR_decomposition A)) \<bullet> column ia (fst (QR_decomposition A))) = 0"
 proof -
   have i: "column i (fst (QR_decomposition A)) \<in> columns (fst (QR_decomposition A))" unfolding columns_def by auto
   have ia: "column ia (fst (QR_decomposition A)) \<in> columns (fst (QR_decomposition A))" unfolding columns_def by auto
   show ?thesis
     using orthogonal_fst_QR_decomposition[of A] i ia i_not_ia unfolding pairwise_def orthogonal_def
     by auto
 qed
 
 lemma scaler_column_fst_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes i: "i>j"
   and r: "rank A = ncols A"
   shows "column i (fst (QR_decomposition A)) \<bullet> column j A = 0"
 proof -
   have "column i (fst(QR_decomposition A)) \<bullet> column j A 
     = column i (fst (QR_decomposition A)) \<bullet> (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i \<le> j}. (x \<bullet> (column j A)) *\<^sub>R x)"
     using column_QR_decomposition2[OF r] by presburger
   also have "... = (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i \<le> j}. 
     column i (fst (QR_decomposition A)) \<bullet> (x \<bullet> (column j A)) *\<^sub>R x)" unfolding real_inner_class.inner_sum_right ..
   also have "... = (\<Sum>x\<in>{column i (fst (QR_decomposition A))|i. i \<le> j}. 
     (x \<bullet> (column j A)) *(column i (fst (QR_decomposition A)) \<bullet> x))" unfolding real_inner_class.inner_scaleR_right ..
   also have "... = 0"
   proof (rule sum.neutral, clarify)
     fix ia assume ia: "ia \<le> j"
     have i_not_ia: "i \<noteq> ia" using i ia by simp
     hence "(column i (fst (QR_decomposition A)) \<noteq> column ia (fst (QR_decomposition A)))"
       by (metis column_eq_fst_QR_decomposition r)
     hence "(column i (fst (QR_decomposition A)) \<bullet> column ia (fst (QR_decomposition A))) = 0" 
       by (rule orthogonal_columns_fst_QR_decomposition)
     thus "column ia (fst (QR_decomposition A)) \<bullet> column j A * (column i (fst (QR_decomposition A)) \<bullet> column ia (fst (QR_decomposition A))) = 0"
       by auto
   qed
   finally show ?thesis .
 qed
 
 lemma R_Qi_Aj:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   shows "(snd (QR_decomposition A)) $ i $ j = column i (fst (QR_decomposition A)) \<bullet> column j A"
   unfolding QR_decomposition_def Let_def snd_conv matrix_matrix_mult_inner_mult 
   unfolding row_transpose by auto
 
 lemma sums_columns_Q_0:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "(\<Sum>x\<in>{column i (fst (QR_decomposition A)) |i. i>b}. x \<bullet> column b A * x $ a) = 0"
 proof (rule sum.neutral, auto) 
   fix i assume "b<i"
   thus "column i (fst (QR_decomposition A)) \<bullet> column b A = 0"
     by (rule scaler_column_fst_QR_decomposition, simp add: r)
 qed
 
 lemma QR_decomposition_mult:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "A = (fst (QR_decomposition A)) ** (snd (QR_decomposition A))"
 proof -
   have "\<forall>b. column b A = column b ((fst (QR_decomposition A)) ** (snd (QR_decomposition A)))"
   proof (clarify)
     fix b
     have "(fst (QR_decomposition A) ** snd (QR_decomposition A))  
       =  (\<chi> i j. \<Sum>k\<in>UNIV. fst (QR_decomposition A) $ i $ k * (column k (fst (QR_decomposition A)) \<bullet> column j A))"
       unfolding matrix_matrix_mult_def R_Qi_Aj by auto
     hence "column b ((fst (QR_decomposition A) ** snd (QR_decomposition A))) = 
       column b ((\<chi> i j. \<Sum>k\<in>UNIV. fst (QR_decomposition A) $ i $ k * (column k (fst (QR_decomposition A)) \<bullet> column j A)))"
       by auto
     also have "... = (\<Sum>x\<in>{column i (fst (QR_decomposition A)) |i. i \<le> b}. (x \<bullet> column b A) *\<^sub>R x)"
     proof (subst column_def, subst vec_eq_iff, auto)
       fix a 
       define f where "f i = column i (fst (QR_decomposition A))" for i
       define g where "g x = (THE i. x = column i (fst (QR_decomposition A)))" for x
       have f_eq: "f`UNIV = {column i (fst (QR_decomposition A)) |i. i\<in>UNIV}" unfolding f_def by auto
       have inj_f: "inj f"
         by (metis inj_on_def f_def column_eq_fst_QR_decomposition r)
       have "(\<Sum>x\<in>{column i (fst (QR_decomposition A)) |i. i \<le> b}. x \<bullet> column b A * x $ a) 
         = (\<Sum>x\<in>{column i (fst (QR_decomposition A)) |i. i\<in>UNIV}. x \<bullet> column b A * x $ a)"
       proof -
         let ?c= "{column i (fst (QR_decomposition A)) |i. i\<in>UNIV}"
         let ?d= "{column i (fst (QR_decomposition A)) |i. i\<le>b}"
         let ?f = "{column i (fst (QR_decomposition A)) |i. i>b}"
         have set_rw: "?c = ?d \<union> ?f" by force
         have "(\<Sum>x\<in>?c. x \<bullet> column b A * x $ a) 
           = (\<Sum>x\<in>(?d \<union> ?f). x \<bullet> column b A * x $ a)" using set_rw by simp
         also have "... = (\<Sum>x\<in>?d. x \<bullet> column b A * x $ a) + (\<Sum>x\<in>?f. x \<bullet> column b A * x $ a)" 
           by (rule sum.union_disjoint, auto, metis f_def inj_eq inj_f not_le)
         also have "... = (\<Sum>x\<in>?d. x \<bullet> column b A * x $ a)" using sums_columns_Q_0[OF r] by auto
         finally show ?thesis ..
       qed
       also have "... = (\<Sum>x\<in>f`UNIV. x \<bullet> column b A * x $ a)" using f_eq by auto
       also have "... = (\<Sum>k\<in>UNIV. fst (QR_decomposition A) $ a $ k * (column k (fst (QR_decomposition A)) \<bullet> column b A))"
         unfolding sum.reindex[OF inj_f] unfolding f_def column_def by (rule sum.cong, simp_all)
       finally show " (\<Sum>k\<in>UNIV. fst (QR_decomposition A) $ a $ k * (column k (fst (QR_decomposition A)) \<bullet> column b A)) =
         (\<Sum>x\<in>{column i (fst (QR_decomposition A)) |i. i \<le> b}. x \<bullet> column b A * x $ a)" ..
     qed
     also have "... = column b A"
       using column_QR_decomposition2[OF r] by simp
     finally show "column b A = column b (fst (QR_decomposition A) ** snd (QR_decomposition A))" ..
   qed
   thus ?thesis unfolding column_def vec_eq_iff by auto
 qed
 
 
 lemma upper_triangular_snd_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "upper_triangular (snd (QR_decomposition A))"
 proof (unfold upper_triangular_def, auto)
   fix i j::'n
   assume j_less_i: "j < i"
   have "snd (QR_decomposition A) $ i $ j = column i (fst (QR_decomposition A)) \<bullet> column j A"
     unfolding QR_decomposition_def Let_def fst_conv snd_conv
     unfolding matrix_matrix_mult_inner_mult row_transpose ..
   also have "... = 0" using scaler_column_fst_QR_decomposition[OF j_less_i r] .
   finally show "snd (QR_decomposition A) $ i $ j = 0" by auto
 qed
 
 
 lemma upper_triangular_invertible:
   fixes A :: "real^'n::{finite,wellorder}^'n::{finite,wellorder}"
   assumes u: "upper_triangular A"
   and d: "\<forall>i. A $ i $ i \<noteq> 0" 
   shows "invertible A"
 proof -
   have det_R: "det A = (prod (\<lambda>i. A$i$i) (UNIV::'n set))"
     using det_upperdiagonal u unfolding upper_triangular_def by blast
   also have "... \<noteq> 0" using d by auto
   finally show ?thesis by (metis invertible_det_nz)
 qed
 
 
 lemma invertible_snd_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "invertible (snd (QR_decomposition A))"
 proof (rule upper_triangular_invertible)
   show "upper_triangular (snd (QR_decomposition A))"
     using upper_triangular_snd_QR_decomposition[OF r] .
   show "\<forall>i. snd (QR_decomposition A) $ i $ i \<noteq> 0"
   proof (rule allI)
     fix i
     have ind: "vec.independent (columns (Gram_Schmidt_matrix A))"
       by (metis full_rank_imp_is_basis2
         independent_columns_Gram_Schmidt_matrix r)
     hence zero_not_in: "0 \<notin> (columns (Gram_Schmidt_matrix A))" by (metis vec.dependent_zero)
     hence c:"column i (Gram_Schmidt_matrix A) \<noteq> 0" unfolding columns_def by simp
     have "snd (QR_decomposition A) $ i $ i = column i (fst (QR_decomposition A)) \<bullet> column i A"
       unfolding QR_decomposition_def Let_def snd_conv fst_conv
       unfolding matrix_matrix_mult_inner_mult
       unfolding row_transpose ..
     also have "... = norm (column i (Gram_Schmidt_matrix A))"
       unfolding norm_uk_eq[OF r, symmetric] ..
     also have "... \<noteq> 0" by (rule ccontr, simp add: c)
     finally show "snd (QR_decomposition A) $ i $ i \<noteq> 0" .
   qed
 qed
 
 lemma QR_decomposition:
   fixes A::"real^'n::{mod_type}^'m::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "A = fst (QR_decomposition A) ** snd (QR_decomposition A) \<and>
   pairwise orthogonal (columns (fst (QR_decomposition A))) \<and> 
   (\<forall>i. norm (column i (fst (QR_decomposition A))) = 1) \<and>
   (transpose (fst (QR_decomposition A))) ** (fst (QR_decomposition A)) = mat 1 \<and>
   vec.independent (columns (fst (QR_decomposition A))) \<and> 
   col_space A = col_space (fst (QR_decomposition A)) \<and>
   card (columns A) = card (columns (fst (QR_decomposition A))) \<and>
   invertible (snd (QR_decomposition A)) \<and>
   upper_triangular (snd (QR_decomposition A))"
   by (metis QR_decomposition_mult col_space_def full_rank_imp_is_basis2 
     independent_columns_fst_QR_decomposition invertible_snd_QR_decomposition 
     norm_columns_fst_QR_decomposition orthogonal_fst_QR_decomposition 
     orthogonal_matrix_fst_QR_decomposition r span_fst_QR_decomposition 
     upper_triangular_snd_QR_decomposition)
 
 
 lemma QR_decomposition_square:
   fixes A::"real^'n::{mod_type}^'n::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "A = fst (QR_decomposition A) ** snd (QR_decomposition A) \<and>
   orthogonal_matrix (fst (QR_decomposition A)) \<and>
   upper_triangular (snd (QR_decomposition A)) \<and>
   invertible (snd (QR_decomposition A)) \<and>    
   pairwise orthogonal (columns (fst (QR_decomposition A))) \<and> 
   (\<forall>i. norm (column i (fst (QR_decomposition A))) = 1) \<and>      
   vec.independent (columns (fst (QR_decomposition A))) \<and> 
   col_space A = col_space (fst (QR_decomposition A)) \<and>
   card (columns A) = card (columns (fst (QR_decomposition A)))"
   by (metis QR_decomposition orthogonal_matrix_fst_QR_decomposition' r)
 
 
 text\<open>QR for computing determinants\<close>
 
 lemma det_QR_decomposition:
   fixes A::"real^'n::{mod_type}^'n::{mod_type}"
   assumes r: "rank A = ncols A"
   shows "\<bar>det A\<bar> = \<bar>(prod (\<lambda>i. snd(QR_decomposition A)$i$i) (UNIV::'n set))\<bar>"
 proof -
   let ?Q="fst(QR_decomposition A)"
   let ?R="snd(QR_decomposition A)"
   have det_R: "det ?R = (prod (\<lambda>i. snd(QR_decomposition A)$i$i) (UNIV::'n set))"
     apply (rule det_upperdiagonal)
     using upper_triangular_snd_QR_decomposition[OF r]
     unfolding upper_triangular_def by simp
   have "\<bar>det A\<bar> = \<bar>det ?Q * det ?R\<bar>" by (metis QR_decomposition_mult det_mul r)
   also have "... = \<bar>det ?Q\<bar> * \<bar>det ?R\<bar>" unfolding abs_mult ..
   also have "... = 1 * \<bar>det ?R\<bar>" using det_orthogonal_matrix[OF orthogonal_matrix_fst_QR_decomposition'[OF r]]
     by auto
   also have "... = \<bar>det ?R\<bar>" by simp
   also have "... = \<bar>(prod (\<lambda>i. snd(QR_decomposition A)$i$i) (UNIV::'n set))\<bar>" unfolding det_R ..
   finally show ?thesis .  
 qed
 
 end
diff --git a/thys/TortoiseHare/Brent.thy b/thys/TortoiseHare/Brent.thy
--- a/thys/TortoiseHare/Brent.thy
+++ b/thys/TortoiseHare/Brent.thy
@@ -1,232 +1,232 @@
 (*<*)
 theory Brent
 imports
   Basis
 begin
 (*>*)
 section\<open> Brent's algorithm \label{sec:brent} \<close>
 
 text\<open>
 
 @{cite "Brent:1980"} improved on the Tortoise and Hare algorithm and
 used it to factor large primes. In practice it makes significantly
 fewer calls to the function \<open>f\<close> before detecting a loop.
 
 We begin by defining the base-2 logarithm.
 
 \<close>
 
 fun lg :: "nat \<Rightarrow> nat" where
 [simp del]: "lg x = (if x \<le> 1 then 0 else 1 + lg (x div 2))"
 
 lemma lg_safe:
   "lg 0 = 0"
   "lg (Suc 0) = 0"
   "lg (Suc (Suc 0)) = 1"
   "0 < x \<Longrightarrow> lg (x + x) = 1 + lg x"
 by (simp_all add: lg.simps)
 
 lemma lg_inv:
   "0 < x \<Longrightarrow> lg (2 ^ x) = x"
 proof(induct x)
   case (Suc x) then show ?case
     by (cases x, simp_all add: lg.simps Suc_lessI not_le)
 qed simp
 
 lemma lg_inv2:
   "2 ^ i = x \<Longrightarrow> 2 ^ lg x = x"
 by (induct i arbitrary: x) (auto simp: lg.simps, arith)
 
 lemmas lg_simps = lg_safe lg_inv lg_inv2
 
 subsection\<open> Finding \<open>lambda\<close> \<close>
 
 text (in properties) \<open>
 
 Imagine now that the Tortoise carries an unbounded number of carrots,
 which he passes to the Hare when they meet, and the Hare has a
 teleporter. The Hare eats a carrot each time she waits for the
 function @{term "f"} to execute, and initially has just one. If she
 runs out of carrots before meeting the Tortoise again, she teleports
 him to her position, and he gives her twice as many carrots as the
 last time they met (tracked by the variable \<open>carrots\<close>). By
 counting how many carrots she has eaten from when she last teleported
 the Tortoise (recorded in \<open>l\<close>) until she finally has surplus
 carrots when she meets him again, the Hare directly discovers @{term
 "lambda"}.
 
 \<close>
 
 record 'a state =
   m :: nat  \<comment> \<open>\<open>\<mu>\<close>\<close>
   l :: nat  \<comment> \<open>\<open>\<lambda>\<close>\<close>
   carrots :: nat
   hare :: "'a"
   tortoise :: "'a"
 
 context properties
 begin
 
 definition (in fx0) find_lambda :: "'a state \<Rightarrow> 'a state" where
   "find_lambda \<equiv>
     (\<lambda>s. s\<lparr> carrots := 1, l := 1, tortoise := x0, hare := f x0 \<rparr>) ;;
     while (hare \<^bold>\<noteq> tortoise)
           ( ( \<^bold>if carrots \<^bold>= l \<^bold>then (\<lambda>s. s\<lparr> tortoise := hare s, carrots := 2 * carrots s, l := 0 \<rparr>)
                              \<^bold>else SKIP ) ;;
             (\<lambda>s. s\<lparr> hare := f (hare s), l := l s + 1 \<rparr>) )"
 
 text\<open>
 
 The termination argument goes intuitively as follows. The Hare eats as
 many carrots as it takes to teleport the Tortoise into the
 loop. Afterwards she continues the teleportation dance until the
 Tortoise has given her enough carrots to make it all the way around
 the loop and back to him.
 
 We can calculate the Tortoise's position as a function of \<open>carrots\<close>.
 
 \<close>
 
 definition carrots_total :: "nat \<Rightarrow> nat" where
   "carrots_total c \<equiv> \<Sum>i<lg c. 2 ^ i"
 
 lemma carrots_total_simps:
   "carrots_total (Suc 0) = 0"
   "carrots_total (Suc (Suc 0)) = 1"
   "2 ^ i = c \<Longrightarrow> carrots_total (c + c) = c + carrots_total c"
 by (auto simp: carrots_total_def lg_simps)
 
 definition find_lambda_measures :: "( (nat \<times> nat) \<times> (nat \<times> nat) ) set" where
   "find_lambda_measures \<equiv>
     measures [\<lambda>(l, c). mu - carrots_total c,
               \<lambda>(l, c). LEAST i. lambda \<le> c * 2^i,
               \<lambda>(l, c). c - l]"
 
 lemma find_lambda_measures_wellfounded:
   "wf find_lambda_measures"
 by (simp add: find_lambda_measures_def)
 
 lemma find_lambda_measures_decreases1:
   assumes "c = 2 ^ i"
   assumes "mu \<le> carrots_total c \<longrightarrow> c \<le> lambda"
   assumes "seq (carrots_total c) \<noteq> seq (carrots_total c + c)"
   shows "( (c', 2 * c), (c, c) ) \<in> find_lambda_measures"
 proof(cases "mu \<le> carrots_total c")
   case False with assms show ?thesis
     by (auto simp: find_lambda_measures_def carrots_total_simps mult_2 field_simps diff_less_mono2)
 next
   case True
   { fix x assume x: "(0::nat) < x" have "\<exists>n. lambda \<le> x * 2 ^ n"
     proof(induct lambda)
       case (Suc i)
       then obtain n where "i \<le> x * 2 ^ n" by blast
       with x show ?case
         by (clarsimp intro!: exI[where x="Suc n"] simp: field_simps mult_2)
-           (metis Nat.add_0_right Suc_leI linorder_neqE_nat mult_eq_0_iff nat_add_left_cancel not_le numeral_2_eq_2 old.nat.distinct(2) power_not_zero trans_le_add2)
+           (metis Nat.add_0_right Suc_leI linorder_neqE_nat mult_eq_0_iff add_left_cancel not_le numeral_2_eq_2 old.nat.distinct(2) power_not_zero trans_le_add2)
     qed simp } note ex = this
   have "(LEAST j. lambda \<le> 2 ^ (i + 1) * 2 ^ j) < (LEAST j. lambda \<le> 2 ^ i * 2 ^ j)"
   proof(rule LeastI2_wellorder_ex[OF ex, rotated], rule LeastI2_wellorder_ex[OF ex, rotated])
     fix x y
     assume "lambda \<le> 2 ^ i * 2 ^ y"
            "lambda \<le> 2 ^ (i + 1) * 2 ^ x"
            "\<forall>z. lambda \<le> 2 ^ (i + 1) * 2 ^ z \<longrightarrow> x \<le> z"
     with True assms properties_loop[where i="carrots_total c" and j=1]
     show "x < y" by (cases y, auto simp: less_Suc_eq_le)
   qed simp_all
   with True \<open>c = 2 ^ i\<close> show ?thesis
     by (clarsimp simp: find_lambda_measures_def mult_2 carrots_total_simps field_simps power_add)
 qed
 
 lemma find_lambda_measures_decreases2:
   assumes "ls < c"
   shows "( (Suc ls, c), (ls, c) ) \<in> find_lambda_measures"
 using assms by (simp add: find_lambda_measures_def)
 
 lemma find_lambda:
   "\<lbrace>\<langle>True\<rangle>\<rbrace> find_lambda \<lbrace>l \<^bold>= \<langle>lambda\<rangle>\<rbrace>"
 apply (simp add: find_lambda_def)
 apply (rule hoare_pre)
 apply (rule whileI[where I="\<langle>0\<rangle> \<^bold>< l \<^bold>\<and> l \<^bold>\<le> carrots \<^bold>\<and> (\<langle>mu\<rangle> \<^bold>\<le> carrots_total \<circ> carrots \<^bold>\<longrightarrow> l \<^bold>\<le> \<langle>lambda\<rangle>) \<^bold>\<and> (\<^bold>\<exists>i. carrots \<^bold>= \<langle>2^i\<rangle>)
                            \<^bold>\<and> tortoise \<^bold>= seq \<circ> carrots_total \<circ> carrots \<^bold>\<and> hare \<^bold>= seq \<circ> (l \<^bold>+ (carrots_total \<circ> carrots))"
                       and r="inv_image find_lambda_measures (l \<^bold>\<bowtie> carrots)"]
             wp_intro)+
    using properties_lambda_gt_0
    apply (clarsimp simp: field_simps mult_2_right carrots_total_simps)
    apply (intro conjI impI)
       apply (metis mult_2 power_Suc)
      apply (case_tac "mu \<le> carrots_total (l s)")
       apply (cut_tac i="carrots_total (l s)" and j="l s" in properties_distinct_contrapos, simp_all add: field_simps)[1]
      apply (cut_tac i="carrots_total (l s)" and j="l s" in properties_loops_ge_mu, simp_all add: field_simps)[1]
     apply (cut_tac i="carrots_total (2 ^ x)" and j=1 in properties_loop, simp)
     apply (fastforce simp: le_eq_less_or_eq field_simps)
    apply (cut_tac i="carrots_total (2 ^ x)" and j="l s" in properties_loops_ge_mu, simp_all add: field_simps)[1]
    apply (cut_tac i="carrots_total (2 ^ x)" and j="l s" in properties_distinct_contrapos, simp_all add: field_simps)[1]
   apply (simp add: find_lambda_measures_wellfounded)
  apply (clarsimp simp: add.commute find_lambda_measures_decreases1 find_lambda_measures_decreases2)
 apply (rule wp_intro)
 using properties_lambda_gt_0
 apply (simp add: carrots_total_simps exI[where x=0])
 done
 
 subsection\<open> Finding \<open>mu\<close> \<close>
 
 text\<open>
 
 With @{term "lambda"} in hand, we can find \<open>mu\<close> using the same
 approach as for the Tortoise and Hare (\S\ref{sec:th-finding-mu}),
 after we first move the Hare to @{term "lambda"}.
 
 \<close>
 
 definition (in fx0) find_mu :: "'a state \<Rightarrow> 'a state" where
   "find_mu \<equiv>
     (\<lambda>s. s\<lparr> m := 0, tortoise := x0, hare := seq (l s) \<rparr>) ;;
     while (hare \<^bold>\<noteq> tortoise)
           (\<lambda>s. s\<lparr> tortoise := f (tortoise s), hare := f (hare s), m := m s + 1 \<rparr>)"
 
 lemma find_mu:
   "\<lbrace>l \<^bold>= \<langle>lambda\<rangle>\<rbrace> find_mu \<lbrace>l \<^bold>= \<langle>lambda\<rangle> \<^bold>\<and> m \<^bold>= \<langle>mu\<rangle>\<rbrace>"
 apply (simp add: find_mu_def)
 apply (rule hoare_pre)
 apply (rule whileI[where I="l \<^bold>= \<langle>lambda\<rangle> \<^bold>\<and> m \<^bold>\<le> \<langle>mu\<rangle> \<^bold>\<and> tortoise \<^bold>= seq \<circ> m \<^bold>\<and> hare \<^bold>= seq \<circ> (m \<^bold>+ l)"
                       and r="measure (\<langle>mu\<rangle> \<^bold>- m)"]
             wp_intro)+
    using properties_lambda_gt_0 properties_loop[where i=mu and j=1]
    apply (fastforce simp: le_less dest: properties_loops_ge_mu)
   apply simp
  using properties_loop[where i=mu and j=1, simplified]
  apply (fastforce simp: le_eq_less_or_eq)
 apply (rule wp_intro)
 apply simp
 done
 
 
 subsection\<open> Top level \<close>
 
 definition (in fx0) brent :: "'a state \<Rightarrow> 'a state" where
   "brent \<equiv> find_lambda ;; find_mu"
 
 theorem brent:
   "\<lbrace>\<langle>True\<rangle>\<rbrace> brent \<lbrace>l \<^bold>= \<langle>lambda\<rangle> \<^bold>\<and> m \<^bold>= \<langle>mu\<rangle>\<rbrace>"
 unfolding brent_def
 by (rule find_lambda find_mu wp_intro)+
 
 end
 
 corollary brent_correct:
   assumes s': "s' = fx0.brent f x arbitrary"
   shows "fx0.properties f x (l s') (m s')"
 using assms properties.brent[where f=f and ?x0.0=x]
 by (fastforce intro: fx0.properties_existence[where f=f and ?x0.0=x]
                simp:  Basis.properties_def valid_def)
 
 schematic_goal brent_code[code]:
   "fx0.brent f x = ?code"
 unfolding fx0.brent_def fx0.find_lambda_def fx0.find_mu_def fcomp_assoc[symmetric] fcomp_comp
 by (rule refl)
 
 export_code fx0.brent in SML
 (*<*)
 
 end
 (*>*)