diff --git a/thys/Dependent_SIFUM_Refinement/Examples/Eg1Eg2.thy b/thys/Dependent_SIFUM_Refinement/Examples/Eg1Eg2.thy
--- a/thys/Dependent_SIFUM_Refinement/Examples/Eg1Eg2.thy
+++ b/thys/Dependent_SIFUM_Refinement/Examples/Eg1Eg2.thy
@@ -1,197 +1,197 @@
 theory Eg1Eg2
 imports Eg1
         Eg2
         "../CompositionalRefinement"
 begin
 
 locale sifum_refinement_eg1_eg2 =
   A: sifum_example +
   C: sifum_example2
 
 primrec Eg2_var\<^sub>C_of_Eg1 :: "Eg1.var \<Rightarrow> Eg2.var\<^sub>C"
 where
   "Eg2_var\<^sub>C_of_Eg1 control_var = control_var\<^sub>C" |
   "Eg2_var\<^sub>C_of_Eg1 buffer = buffer\<^sub>C" |
   "Eg2_var\<^sub>C_of_Eg1 high_var = high_var\<^sub>C" |
   "Eg2_var\<^sub>C_of_Eg1 low_var = low_var\<^sub>C" |
   "Eg2_var\<^sub>C_of_Eg1 temp = temp\<^sub>C"
 
 sublocale sifum_refinement_eg1_eg2 \<subseteq> sifum_refinement dma dma\<^sub>C \<C>_vars \<C>_vars\<^sub>C \<C> \<C>\<^sub>C A.eval\<^sub>w C.eval\<^sub>w undefined Eg2_var\<^sub>C_of_Eg1
-  supply image_cong_simp [cong del] INF_cong_simp [cong] SUP_cong_simp [cong] subst_all [simp del] subst_all' [simp del]
+  supply image_cong_simp [cong del] INF_cong_simp [cong] SUP_cong_simp [cong] subst_all [simp del]
   apply(unfold_locales)
            apply(erule C.eval_det, simp)
           apply(rule C.Var_finite)
          apply(simp add:\<C>_vars\<^sub>C_def split:if_splits)
         apply(simp add:\<C>_vars\<^sub>C_def dma\<^sub>C_def)
        apply(simp add:\<C>_vars\<^sub>C_def dma\<^sub>C_def)
       apply(rule inj_onI, simp)
       apply(case_tac x)
           apply(case_tac y, simp+)
          apply(case_tac y, simp+)
         apply(case_tac y, simp+)
        apply(case_tac y, simp+)
       apply(case_tac y, simp+)
      apply(case_tac x\<^sub>A)
          apply(clarsimp simp:dma\<^sub>C_def dma_def dma_control_var_def dma_control_var\<^sub>C_def)+
     apply(case_tac x\<^sub>A)
         apply(clarsimp simp:\<C>_vars\<^sub>C_def \<C>_vars_def)+
    apply(rule set_eqI, clarsimp)
    apply(case_tac x, clarsimp)
         apply(rule_tac x=control_var in rev_image_eqI, clarsimp+)
        apply(case_tac xa, clarsimp+)
           apply(case_tac xb, clarsimp+)
       apply(case_tac xa, clarsimp+)
          apply(case_tac xb, clarsimp+)
      apply(case_tac xa, clarsimp+)
         apply(case_tac xb, clarsimp+)
     apply(case_tac xa, clarsimp+)
        apply(case_tac xb, clarsimp+)
    apply(case_tac xa, clarsimp+)
   apply(simp add:\<C>\<^sub>C_def)
   done
 
 context sifum_refinement_eg1_eg2
 begin
 
 
 lemma bisim_simple_\<R>:
   "bisim_simple (A.\<R> \<Gamma> \<S> P)"
   unfolding bisim_simple_def
   apply clarsimp
   apply(drule_tac lc="\<langle>c\<^sub>1\<^sub>A, mds, mem\<^sub>1\<^sub>A\<rangle>\<^sub>A" and lc'="\<langle>c\<^sub>2\<^sub>A, mds, mem\<^sub>2\<^sub>A\<rangle>\<^sub>A" in A.bisim_simple_\<R>\<^sub>u)
   by simp
 
 (* Don't know to what extent these helpers can be made generic enough to go into any parent theories.
    Again, mightn't be able to (or bother to) make some generic considering the aexp evaluator
    is going to be specific to each language. *)
 
 lemma conc_only_vars_not_visible_abs:
   "(\<forall>v\<^sub>C. v\<^sub>C \<in> range Eg2_var\<^sub>C_of_Eg1 \<longrightarrow> mem\<^sub>C v\<^sub>C = mem\<^sub>C' v\<^sub>C) \<Longrightarrow> mem\<^sub>A_of mem\<^sub>C = mem\<^sub>A_of mem\<^sub>C'"
   by (simp add: mem\<^sub>A_of_def)
 
 lemma conc_only_var_assign_not_visible_abs:
   "\<forall>v\<^sub>C e. v\<^sub>C \<notin> range Eg2_var\<^sub>C_of_Eg1 \<longrightarrow> mem\<^sub>A_of mem\<^sub>C = mem\<^sub>A_of (mem\<^sub>C(v\<^sub>C := e))"
   using conc_only_vars_not_visible_abs
   by simp
 
 lemma reg\<^sub>C_is_not_the_var\<^sub>C_of_anything:
   "reg\<^sub>C = Eg2_var\<^sub>C_of_Eg1 x \<Longrightarrow> False"
   by (induct x, clarsimp+)
 
 lemma reg\<^sub>C_not_visible_abs:
   "reg\<^sub>C \<notin> range Eg2_var\<^sub>C_of_Eg1"
   using reg\<^sub>C_is_not_the_var\<^sub>C_of_anything
   by blast
 
 (* This one's pretty specific to this refinement... *)
 lemma reg\<^sub>C_the_only_concrete_only_var:
   "v\<^sub>C \<notin> range Eg2_var\<^sub>C_of_Eg1 \<Longrightarrow> v\<^sub>C = reg\<^sub>C"
   apply(case_tac v\<^sub>C)
        apply(erule rev_notE, clarsimp, rule_tac x=control_var in range_eqI, clarsimp)
       apply(erule rev_notE, clarsimp, rule_tac x=buffer in range_eqI, clarsimp)
      apply(erule rev_notE, clarsimp, rule_tac x=high_var in range_eqI, clarsimp)
     apply(erule rev_notE, clarsimp, rule_tac x=low_var in range_eqI, clarsimp)
    apply(erule rev_notE, clarsimp, rule_tac x=temp in range_eqI, clarsimp)
   apply clarsimp
   done
 
 lemma NoRW\<^sub>A_implies_NoRW\<^sub>C:
   "x \<in> mds\<^sub>A_of mds\<^sub>C AsmNoReadOrWrite \<Longrightarrow>
    Eg2_var\<^sub>C_of_Eg1 x \<in> mds\<^sub>C AsmNoReadOrWrite"
   unfolding mds\<^sub>A_of_def
   apply clarsimp
   apply (simp only: Eg2_var\<^sub>C_of_Eg1_def)
   apply clarsimp
   apply (simp add: f_inv_into_f)
   done
 
 lemma NoWrite\<^sub>A_implies_NoWrite\<^sub>C:
   "x \<in> mds\<^sub>A_of mds\<^sub>C AsmNoWrite \<Longrightarrow>
    Eg2_var\<^sub>C_of_Eg1 x \<in> mds\<^sub>C AsmNoWrite"
   unfolding mds\<^sub>A_of_def
   apply clarsimp
   apply (simp only: Eg2_var\<^sub>C_of_Eg1_def)
   apply clarsimp
   apply (simp add: f_inv_into_f)
   done
 
 lemma assign_eval\<^sub>w_load\<^sub>A:
   shows "(\<langle>x \<leftarrow> Eg1.Load y, mds, mem\<rangle>\<^sub>A, \<langle>Stop, mds, mem (x := mem y)\<rangle>\<^sub>A) \<in> A.eval\<^sub>w"
   by (metis A.assign_eval\<^sub>w ev\<^sub>A.simps(2))
 
 lemma assign_eval\<^sub>w_load\<^sub>C:
   shows "(\<langle>x \<leftarrow> Load y, mds, mem\<rangle>\<^sub>C, \<langle>Stop, mds, mem (x := mem y)\<rangle>\<^sub>C) \<in> C.eval\<^sub>w"
   using C.unannotated[OF C.assign, where E="[]", simplified]
   apply(drule_tac x=x in meta_spec)
   apply(drule_tac x="Load y" in meta_spec)
   apply(drule_tac x=mds in meta_spec)
   apply(drule_tac x=mem in meta_spec)
   apply clarsimp
   done
 
 lemma assign_eval\<^sub>w_const\<^sub>A:
   shows "(\<langle>x \<leftarrow> Eg1.Const c, mds, mem\<rangle>, \<langle>Stop, mds, mem (x := c)\<rangle>) \<in> A.eval\<^sub>w"
   by (metis A.assign_eval\<^sub>w ev\<^sub>A.simps(1))
 
 lemma assign_eval\<^sub>w_const\<^sub>C:
   shows "(\<langle>x \<leftarrow> Const c, mds, mem\<rangle>, \<langle>Stop, mds, mem (x := c)\<rangle>) \<in> C.eval\<^sub>w"
   using C.unannotated[OF C.assign, where E="[]", simplified]
   apply(drule_tac x=x in meta_spec)
   apply(drule_tac x="Const c" in meta_spec)
   apply(drule_tac x=mds in meta_spec)
   apply(drule_tac x=mem in meta_spec)
   apply clarsimp
   done
 
 lemma if_seq_eval\<^sub>w_helper\<^sub>A:
   "(\<langle>If B T E, mds, mem\<rangle>,
     \<langle>if ev\<^sub>B mem B then T else E, mds, mem\<rangle>\<^sub>A) \<in> A.eval\<^sub>w
     \<Longrightarrow>
    (\<langle>If B T E ;; TAIL, mds, mem\<rangle>,
     \<langle>if ev\<^sub>B mem B then T ;; TAIL else E ;; TAIL, mds, mem\<rangle>\<^sub>A) \<in> A.eval\<^sub>w"
   using A.eval\<^sub>w.seq
   by auto
 
 lemma if_seq_eval\<^sub>w_helper\<^sub>C:
   "(\<langle>If B T E, mds, mem\<rangle>,
     \<langle>if ev\<^sub>B\<^sub>C mem B then T else E, mds, mem\<rangle>\<^sub>C) \<in> C.eval\<^sub>w
     \<Longrightarrow>
    (\<langle>If B T E ;; TAIL, mds, mem\<rangle>,
     \<langle>if ev\<^sub>B\<^sub>C mem B then T ;; TAIL else E ;; TAIL, mds, mem\<rangle>\<^sub>C) \<in> C.eval\<^sub>w"
   using C.eval\<^sub>w.seq
   by auto
 
 lemma mem_assign_refinement_helper_var:
   "mem\<^sub>A_of (mem\<^sub>C (Eg2_var\<^sub>C_of_Eg1 x := mem\<^sub>C (Eg2_var\<^sub>C_of_Eg1 y)))
        = (mem\<^sub>A_of mem\<^sub>C) (x := (mem\<^sub>A_of mem\<^sub>C) y)"
   apply(clarsimp simp: mem\<^sub>A_of_def)
   apply(rule ext, clarsimp)
   apply(cases x)
       apply(case_tac x\<^sub>A, clarsimp+)+
   done
 
 lemma mem_assign_refinement_helper_const:
   "mem\<^sub>A_of (mem\<^sub>C (Eg2_var\<^sub>C_of_Eg1 x := c))
        = (mem\<^sub>A_of mem\<^sub>C) (x := c)"
   apply(clarsimp simp: mem\<^sub>A_of_def)
   apply(rule ext, clarsimp)
   apply(cases x)
       apply(case_tac x\<^sub>A, clarsimp+)+
   done
 
 lemma if_true_eval\<^sub>w\<^sub>C:
   shows "mem\<^sub>C x = 0 \<longrightarrow>
      (\<langle>(If (Eq x 0) c\<^sub>C_then c\<^sub>C_else) ;; c\<^sub>C_tail, mds\<^sub>C, mem\<^sub>C\<rangle>\<^sub>C,
       \<langle>(c\<^sub>C_then ;; c\<^sub>C_tail), mds\<^sub>C, mem\<^sub>C\<rangle>\<^sub>C) \<in> C.eval\<^sub>w"
   using C.if_eval\<^sub>w C.eval\<^sub>w.seq ev\<^sub>B\<^sub>C.simps by presburger
 
 lemma if_false_eval\<^sub>w\<^sub>C:
   shows "mem\<^sub>C x \<noteq> 0 \<longrightarrow>
      (\<langle>(If (Eq x 0) c\<^sub>C_then c\<^sub>C_else) ;; c\<^sub>C_tail, mds\<^sub>C, mem\<^sub>C\<rangle>\<^sub>C,
       \<langle>(c\<^sub>C_else ;; c\<^sub>C_tail), mds\<^sub>C, mem\<^sub>C\<rangle>\<^sub>C) \<in> C.eval\<^sub>w"
   using C.if_eval\<^sub>w C.eval\<^sub>w.seq ev\<^sub>B\<^sub>C.simps by presburger
 
 
 end
 
 end
diff --git a/thys/Flyspeck-Tame/FaceDivisionProps.thy b/thys/Flyspeck-Tame/FaceDivisionProps.thy
--- a/thys/Flyspeck-Tame/FaceDivisionProps.thy
+++ b/thys/Flyspeck-Tame/FaceDivisionProps.thy
@@ -1,4955 +1,4955 @@
 (*  Author:  Gertrud Bauer, Tobias Nipkow  *)
 
 section\<open>Properties of Face Division\<close>
 
 theory FaceDivisionProps
 imports Plane EnumeratorProps
 begin
 
 subsection\<open>Finality\<close>
 
 (********************* makeFaceFinal ****************************)
 
 lemma vertices_makeFaceFinal: "vertices(makeFaceFinal f g) = vertices g"
 by(induct g)(simp add:vertices_graph_def makeFaceFinal_def)
 
 lemma edges_makeFaceFinal: "\<E> (makeFaceFinal f g) = \<E> g"
 proof -
   { fix fs
     have "(\<Union>\<^bsub>f\<in>set (makeFaceFinalFaceList f fs)\<^esub> edges f) = (\<Union>\<^bsub>f\<in> set fs\<^esub> edges f)"
     apply(unfold makeFaceFinalFaceList_def)
     apply(induct f)
     by(induct fs) simp_all }
   thus ?thesis by(simp add:edges_graph_def makeFaceFinal_def)
 qed
 
 
 lemma in_set_repl_setFin:
   "f \<in> set fs \<Longrightarrow> final f \<Longrightarrow> f \<in> set (replace f' [setFinal f'] fs)"
 by (induct fs) auto
 
 lemma in_set_repl:  "f \<in> set fs \<Longrightarrow> f \<noteq> f' \<Longrightarrow> f \<in> set (replace f' fs' fs)"
 by (induct fs) auto
 
 lemma makeFaceFinals_preserve_finals:
   "f \<in> set (finals g) \<Longrightarrow> f \<in> set (finals (makeFaceFinal f' g))"
 by (induct g)
    (simp add:makeFaceFinal_def finals_def makeFaceFinalFaceList_def
              in_set_repl_setFin)
 
 
 lemma len_faces_makeFaceFinal[simp]:
  "|faces (makeFaceFinal f g)| = |faces g|"
 by(simp add:makeFaceFinal_def makeFaceFinalFaceList_def)
 
 lemma len_finals_makeFaceFinal:
  "f \<in> \<F> g \<Longrightarrow> \<not> final f \<Longrightarrow> |finals (makeFaceFinal f g)| = |finals g| + 1"
 by(simp add:makeFaceFinal_def finals_def makeFaceFinalFaceList_def
             length_filter_replace1)
 
 lemma len_nonFinals_makeFaceFinal:
  "\<lbrakk> \<not> final f; f \<in> \<F> g\<rbrakk>
   \<Longrightarrow> |nonFinals (makeFaceFinal f g)| = |nonFinals g| - 1"
 by(simp add:makeFaceFinal_def nonFinals_def makeFaceFinalFaceList_def
             length_filter_replace2)
 
 
 lemma set_finals_makeFaceFinal[simp]: "distinct(faces g) \<Longrightarrow> f \<in> \<F> g \<Longrightarrow>
   set(finals (makeFaceFinal f g)) = insert (setFinal f) (set(finals g))"
 by(auto simp:finals_def makeFaceFinal_def makeFaceFinalFaceList_def
                 distinct_set_replace)
 
 
 lemma splitFace_preserve_final:
   "f \<in> set (finals g) \<Longrightarrow> \<not> final f' \<Longrightarrow>
    f \<in> set (finals (snd (snd (splitFace g i j f' ns))))"
   by (induct g) (auto simp add: splitFace_def finals_def split_def
                       intro: in_set_repl)
 
 lemma splitFace_nonFinal_face:
   "\<not> final (fst (snd (splitFace g i j f' ns)))"
   by (simp add: splitFace_def split_def split_face_def)
 
 
 lemma subdivFace'_preserve_finals:
   "\<And>n i f' g. f \<in> set (finals g) \<Longrightarrow>  \<not> final f' \<Longrightarrow>
    f \<in> set (finals (subdivFace' g f' i n is))"
 proof (induct "is")
   case Nil then show ?case by(simp add:makeFaceFinals_preserve_finals)
 next
   case (Cons j "js") then show ?case
   proof (cases j)
     case None with Cons show ?thesis by simp
   next
     case (Some sj)
     with Cons show ?thesis
       by (auto simp: splitFace_preserve_final splitFace_nonFinal_face split_def)
   qed
 qed
 
 lemma subdivFace_pres_finals:
   "f \<in> set (finals g) \<Longrightarrow> \<not> final f' \<Longrightarrow>
    f \<in> set (finals (subdivFace g f' is))"
 by(simp add:subdivFace_def subdivFace'_preserve_finals)
 
 
 declare Nat.diff_is_0_eq' [simp del]
 
 (********************* section is_prefix ****************************)
 subsection \<open>\<open>is_prefix\<close>\<close>
 
 definition is_prefix :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" where
 "is_prefix ls vs \<equiv>  (\<exists> bs. vs = ls @ bs)"
 
 lemma is_prefix_add:
   "is_prefix ls vs \<Longrightarrow> is_prefix (as @ ls) (as @ vs)" by (simp add: is_prefix_def)
 
 lemma is_prefix_hd[simp]:
   "is_prefix [l] vs = (l = hd vs \<and> vs \<noteq> [])"
   apply (rule iffI) apply (auto simp: is_prefix_def)
   apply (intro exI) apply (subgoal_tac "vs = hd vs # tl vs") apply assumption by auto
 
 lemma is_prefix_f[simp]:
   "is_prefix (a#as) (a#vs) = is_prefix as vs" by (auto simp: is_prefix_def)
 
 lemma splitAt_is_prefix: "ram \<in> set vs \<Longrightarrow> is_prefix (fst (splitAt ram vs) @ [ram]) vs"
 by (auto dest!: splitAt_ram simp: is_prefix_def)
 
 
 (******************** section is_sublist *********************************)
 subsection \<open>\<open>is_sublist\<close>\<close>
 
 definition is_sublist :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" where
 "is_sublist ls vs \<equiv>  (\<exists> as bs. vs = as @ ls @ bs)"
 
 lemma is_prefix_sublist:
   "is_prefix ls vs \<Longrightarrow> is_sublist ls vs" by (auto simp: is_prefix_def is_sublist_def)
 
 lemma is_sublist_trans: "is_sublist as bs \<Longrightarrow> is_sublist bs cs \<Longrightarrow> is_sublist as cs"
   apply (simp add: is_sublist_def) apply (elim exE)
   apply (subgoal_tac "cs = (asaa @ asa) @ as @ (bsa @ bsaa)")
   apply (intro exI)  apply assumption by force
 
 lemma is_sublist_add: "is_sublist as bs \<Longrightarrow> is_sublist as (xs @ bs @ ys)"
   apply (simp add: is_sublist_def) apply (elim exE)
   apply (subgoal_tac "xs @ bs @ ys = (xs @ asa) @ as @ (bsa @ ys)")
   apply (intro exI) apply assumption by auto
 
 
 lemma is_sublist_rec:
 "is_sublist xs ys =
  (if length xs > length ys then False else
   if xs = take (length xs) ys then True else is_sublist xs (tl ys))"
 proof (simp add:is_sublist_def, goal_cases)
   case 1 show ?case
   proof (standard, goal_cases)
     case 1 show ?case
     proof (standard, goal_cases)
       case xs: 1
       show ?case
       proof (standard, goal_cases)
         case 1 show ?case by auto
       next
         case 2 show ?case
         proof (standard, goal_cases)
           case 1
           have "ys = take |xs| ys @ drop |xs| ys" by simp
           also have "\<dots> = [] @ xs @ drop |xs| ys" by(simp add:xs[symmetric])
           finally show ?case by blast
         qed
       qed
     qed
   next
     case 2 show ?case
     proof (standard, goal_cases)
       case xs_neq: 1
       show ?case
       proof (standard, goal_cases)
         case 1 show ?case by auto
       next
         case 2 show ?case
         proof (standard, goal_cases)
           case not_less: 1 show ?case
           proof (standard, goal_cases)
             case 1
             then obtain as bs where ys: "ys = as @ xs @ bs" by blast
             have "as \<noteq> []" using xs_neq ys by auto
             then obtain a as' where "as = a # as'"
               by (simp add:neq_Nil_conv) blast
             hence "tl ys = as' @ xs @ bs" by(simp add:ys)
             thus ?case by blast
           next
             case 2
             then obtain as bs where ys: "tl ys = as @ xs @ bs" by blast
             have "ys \<noteq> []" using xs_neq not_less by auto
             then obtain y ys' where "ys = y # ys'"
               by (simp add:neq_Nil_conv) blast
             hence "ys = (y#as) @ xs @ bs" using ys by simp
             thus ?case by blast
           qed
         qed
       qed
     qed
   qed
 qed
 
 
 lemma not_sublist_len[simp]:
  "|ys| < |xs| \<Longrightarrow> \<not> is_sublist xs ys"
 by(simp add:is_sublist_rec)
 
 lemma is_sublist_simp[simp]: "a \<noteq> v \<Longrightarrow> is_sublist (a#as) (v#vs) = is_sublist (a#as) vs"
 proof
   assume av: "a \<noteq> v" and subl: "is_sublist (a # as) (v # vs)"
   then obtain rs ts where vvs: "v#vs = rs @ (a # as) @ ts" by (auto simp: is_sublist_def)
   with av have "rs \<noteq> []" by auto
   with vvs have "tl (v#vs) = tl rs @ a # as @ ts" by auto
   then have "vs = tl rs @ a # as @ ts" by auto
   then show "is_sublist (a # as) vs" by (auto simp: is_sublist_def)
 next
   assume av: "a \<noteq> v" and subl: "is_sublist (a # as) vs"
   then show "is_sublist (a # as) (v # vs)" apply (auto simp: is_sublist_def)  apply (intro exI)
     apply (subgoal_tac "v # asa @ a # as @ bs = (v # asa) @ a # as @ bs") apply assumption by auto
 qed
 
 lemma is_sublist_id[simp]: "is_sublist vs vs" apply (auto simp: is_sublist_def) apply (intro exI)
   apply (subgoal_tac "vs = [] @ vs @ []") by (assumption) auto
 
 lemma is_sublist_in: "is_sublist (a#as) vs \<Longrightarrow> a \<in> set vs" by (auto simp: is_sublist_def)
 
 lemma is_sublist_in1: "is_sublist [x,y] vs \<Longrightarrow> y \<in> set vs" by (auto simp: is_sublist_def)
 
 lemma is_sublist_notlast[simp]: "distinct vs \<Longrightarrow> x = last vs \<Longrightarrow> \<not> is_sublist [x,y] vs"
 proof
   assume dvs: "distinct vs" and xl: "x = last vs" and subl:"is_sublist [x, y] vs"
   then obtain rs ts where vs: "vs = rs @ x # y # ts" by (auto simp: is_sublist_def)
   define as where "as = rs @ [x]"
   define bs where "bs = y # ts"
   then have bsne: "bs \<noteq> []" by auto
   from as_def bs_def have vs2: "vs = as @ bs" using vs by auto
   with as_def have xas: "x \<in> set as" by auto
   from bsne vs2 have "last vs = last bs" by auto
   with xl have "x = last bs" by auto
   with bsne have "bs = (butlast bs) @ [x]" by auto
   then have "x \<in> set bs" by (induct bs) auto
   with xas vs2 dvs show False by auto
 qed
 
 lemma is_sublist_nth1: "is_sublist [x,y] ls \<Longrightarrow>
   \<exists> i j. i < length ls \<and> j < length ls \<and> ls!i = x \<and> ls!j = y \<and> Suc i = j"
 proof -
   assume subl: "is_sublist [x,y] ls"
   then obtain as bs where "ls = as @ x # y # bs" by (auto simp: is_sublist_def)
   then have "(length as) < length ls \<and> (Suc (length as)) < length ls \<and> ls!(length as) = x
        \<and> ls!(Suc (length as)) = y \<and> Suc (length as) = (Suc (length as))"
     apply auto apply hypsubst_thin apply (induct as) by auto
   then show ?thesis by auto
 qed
 
 lemma is_sublist_nth2: "\<exists> i j. i < length ls \<and> j < length ls \<and> ls!i = x \<and> ls!j = y \<and> Suc i = j \<Longrightarrow>
  is_sublist [x,y] ls "
 proof -
   assume "\<exists> i j. i < length ls \<and> j < length ls \<and> ls!i = x \<and> ls!j = y \<and> Suc i = j"
   then obtain i j where vors: "i < length ls \<and> j < length ls \<and> ls!i = x \<and> ls!j = y \<and> Suc i = j" by auto
   then have "ls = take (Suc (Suc i)) ls @ drop (Suc (Suc i)) ls" by auto
   with vors have "ls = take (Suc i) ls @ [ls! (Suc i)] @ drop (Suc (Suc i)) ls"
     by (auto simp: take_Suc_conv_app_nth)
   with vors have "ls = take i ls @ [ls!i] @ [ls! (Suc i)] @ drop (Suc (Suc i)) ls"
    by (auto simp: take_Suc_conv_app_nth)
   with vors show ?thesis by (auto simp: is_sublist_def)
 qed
 
 lemma is_sublist_tl: "is_sublist (a # as) vs \<Longrightarrow> is_sublist as vs" apply (simp add: is_sublist_def)
   apply (elim exE) apply (intro exI)
   apply (subgoal_tac "vs = (asa @ [a]) @ as @ bs") apply assumption by auto
 
 lemma is_sublist_hd: "is_sublist (a # as) vs \<Longrightarrow> is_sublist [a] vs" apply (simp add: is_sublist_def) by auto
 
 lemma is_sublist_hd_eq[simp]: "(is_sublist [a] vs) = (a \<in> set vs)" apply (rule_tac iffI)
   apply (simp add: is_sublist_def) apply force
   apply (simp add: is_sublist_def) apply (induct vs) apply force apply (case_tac "a = aa") apply force
   apply (subgoal_tac "a \<in> set vs") apply simp apply (elim exE) apply (intro exI)
   apply (subgoal_tac "aa # vs = (aa # as) @ a # bs") apply (assumption) by auto
 
 lemma is_sublist_distinct_prefix:
   "is_sublist (v#as) (v # vs) \<Longrightarrow> distinct (v # vs) \<Longrightarrow> is_prefix as vs"
 proof -
   assume d:  "distinct (v # vs)" and subl: "is_sublist (v # as) (v # vs)"
   from subl obtain rs ts where v_vs: "v # vs = rs @ (v # as) @ ts" by (simp add: is_sublist_def) auto
   from d have v: "v \<notin> set vs" by auto
   then have "\<not> is_sublist (v # as) vs" by (auto dest: is_sublist_hd)
   with v_vs have "rs = []" apply (cases rs) by (auto simp: is_sublist_def)
   with v_vs show "is_prefix as vs" by (auto simp: is_prefix_def)
 qed
 
 lemma is_sublist_distinct[intro]:
   "is_sublist as vs \<Longrightarrow> distinct vs \<Longrightarrow> distinct as" by (auto simp: is_sublist_def)
 
 lemma is_sublist_y_hd: "distinct vs \<Longrightarrow> y = hd vs \<Longrightarrow> \<not> is_sublist [x,y] vs"
 proof
   assume d: "distinct vs" and yh: "y = hd vs" and subl: "is_sublist [x, y] vs"
   then obtain rs ts where vs: "vs = rs @ x # y # ts" by (auto simp: is_sublist_def)
   define as where "as = rs @ [x]"
   then have asne: "as \<noteq> []" by auto
   define bs where "bs = y # ts"
   then have bsne: "bs \<noteq> []" by auto
   from as_def bs_def have vs2: "vs = as @ bs" using vs by auto
   from bs_def have xbs: "y \<in> set bs" by auto
   from vs2 asne have "hd vs = hd as" by simp
   with yh have "y = hd as" by auto
   with asne have "y \<in> set as" by (induct as) auto
   with d xbs vs2 show False by auto
 qed
 
 lemma is_sublist_at1: "distinct (as @ bs) \<Longrightarrow> is_sublist [x,y] (as @ bs) \<Longrightarrow> x \<noteq> (last as)  \<Longrightarrow>
   is_sublist [x,y] as \<or> is_sublist [x,y] bs"
 proof (cases "x \<in> set as")
   assume d: "distinct (as @ bs)"  and subl: "is_sublist [x, y] (as @ bs)" and xnl: "x \<noteq> last as"
   define vs where "vs = as @ bs"
   with d have dvs: "distinct vs" by auto
   case True
   with xnl subl have ind: "is_sublist (as@bs) vs \<Longrightarrow> is_sublist [x, y] as"
   proof (induct as)
     case Nil
     then show ?case by force
   next
     case (Cons a as)
     assume ih: "\<lbrakk>is_sublist (as@bs) vs; x \<noteq> last as; is_sublist [x,y] (as @ bs); x \<in> set as\<rbrakk> \<Longrightarrow>
       is_sublist [x, y] as" and subl_aas_vs: "is_sublist ((a # as) @ bs) vs"
       and xnl2: "x \<noteq> last (a # as)" and subl2: "is_sublist [x, y] ((a # as) @ bs)"
       and x: "x \<in> set (a # as)"
     then have rule1: "x \<noteq> a \<Longrightarrow> is_sublist [x,y] as" apply (cases "as = []") apply simp
       apply (rule_tac ih) by (auto dest: is_sublist_tl)
 
     from dvs subl_aas_vs have daas: "distinct (a # as @ bs)" apply (rule_tac is_sublist_distinct) by auto
     from xnl2 have asne: "x = a \<Longrightarrow> as \<noteq> []" by auto
     with subl2 daas have yhdas: "x = a \<Longrightarrow> y = hd as" apply simp apply (drule_tac is_sublist_distinct_prefix) by auto
     with asne have "x = a \<Longrightarrow> as = y # tl as" by auto
     with asne yhdas have "x = a \<Longrightarrow> is_prefix [x,y] (a # as)" by auto
     then have rule2: "x = a \<Longrightarrow> is_sublist [x,y] (a # as)" by (simp add: is_prefix_sublist)
 
     from rule1 rule2 show ?case by (cases "x = a") auto
   qed
   from vs_def d have "is_sublist [x, y] as" by (rule_tac ind) auto
   then show ?thesis by auto
 next
   assume d: "distinct (as @ bs)"  and subl: "is_sublist [x, y] (as @ bs)" and xnl: "x \<noteq> last as"
   define ars where "ars = as"
   case False
   with ars_def have xars: "x \<notin> set ars" by auto
   from subl have ind: "is_sublist as ars \<Longrightarrow> is_sublist [x, y] bs"
   proof (induct as)
     case Nil
     then show ?case by auto
   next
     case (Cons a as)
     assume ih: "\<lbrakk>is_sublist as ars; is_sublist [x, y] (as @ bs)\<rbrakk> \<Longrightarrow> is_sublist [x, y] bs"
       and subl_aasbsvs: "is_sublist (a # as) ars" and subl2: "is_sublist [x, y] ((a # as) @ bs)"
     from subl_aasbsvs ars_def False have "x \<noteq> a" by (auto simp:is_sublist_in)
     with subl_aasbsvs subl2 show ?thesis apply (rule_tac ih) by (auto dest: is_sublist_tl)
   qed
   from ars_def have "is_sublist [x, y] bs" by (rule_tac ind) auto
   then show ?thesis by auto
 qed
 
 lemma is_sublist_at4: "distinct (as @ bs) \<Longrightarrow> is_sublist [x,y] (as @ bs) \<Longrightarrow>
   as \<noteq> [] \<Longrightarrow> x = last as \<Longrightarrow> y = hd bs"
 proof -
   assume d: "distinct (as @ bs)" and subl: "is_sublist [x,y] (as @ bs)"
     and asne: "as \<noteq> []" and xl: "x = last as"
   define vs where "vs = as @ bs"
   with subl have "is_sublist [x,y] vs" by auto
   then obtain rs ts where vs2: "vs = rs @ x # y # ts" by (auto simp: is_sublist_def)
   from vs_def d have dvs:"distinct vs" by auto
   from asne xl have as:"as = butlast as @ [x]" by auto
   with vs_def have vs3: "vs = butlast as @ x # bs" by auto
   from dvs vs2 vs3 have "rs = butlast as" apply (rule_tac dist_at1) by auto
   then have "rs @ [x] = butlast as @ [x]" by auto
   with as have "rs @ [x] = as" by auto
   then have "as = rs @ [x]" by auto
   with vs2 vs_def have "bs = y # ts" by auto
   then show ?thesis by auto
 qed
 
 lemma is_sublist_at5: "distinct (as @ bs) \<Longrightarrow> is_sublist [x,y] (as @ bs) \<Longrightarrow>
   is_sublist [x,y] as \<or> is_sublist [x,y] bs \<or> x = last as \<and> y = hd bs"
   apply (case_tac "as = []") apply simp apply (cases "x = last as")
   apply (subgoal_tac "y = hd bs") apply simp
   apply (rule is_sublist_at4) apply assumption+  (*apply force+ *)
   apply (drule_tac is_sublist_at1) by auto
 
 lemma is_sublist_rev: "is_sublist [a,b] (rev zs) = is_sublist [b,a] zs"
   apply (simp add: is_sublist_def)
     apply (intro iffI) apply (elim exE) apply (intro exI)
     apply (subgoal_tac "zs = (rev bs) @ b # a # rev as") apply assumption
     apply (subgoal_tac "rev (rev zs) = rev (as @ a # b # bs)")
       apply (thin_tac "rev zs = as @ a # b # bs") apply simp
       apply simp
     apply (elim exE) apply (intro exI) by force
 
 lemma is_sublist_at5'[simp]:
  "distinct as \<Longrightarrow> distinct bs \<Longrightarrow> set as \<inter> set bs = {} \<Longrightarrow> is_sublist [x,y] (as @ bs) \<Longrightarrow>
  is_sublist [x,y] as \<or> is_sublist [x,y] bs \<or> x = last as \<and> y = hd bs"
 apply (subgoal_tac "distinct (as @ bs)") apply (drule is_sublist_at5) by auto
 
 lemma splitAt_is_sublist1R[simp]: "ram \<in> set vs \<Longrightarrow> is_sublist (fst (splitAt ram vs) @ [ram]) vs"
 apply (auto dest!: splitAt_ram simp: is_sublist_def) apply (intro exI)
 apply (subgoal_tac "vs = [] @ fst (splitAt ram vs) @ ram # snd (splitAt ram vs)") apply assumption by simp
 
 lemma splitAt_is_sublist2R[simp]: "ram \<in> set vs \<Longrightarrow> is_sublist (ram # snd (splitAt ram vs)) vs"
 apply (auto dest!: splitAt_ram splitAt_no_ram simp: is_sublist_def) apply (intro exI)
 apply (subgoal_tac "vs = fst (splitAt ram vs) @ ram # snd (splitAt ram vs) @ []") apply assumption by auto
 
 
 
 (*********************** section is_nextElem *****************************)
 subsection \<open>\<open>is_nextElem\<close>\<close>
 
 definition is_nextElem :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" where
  "is_nextElem xs x y \<equiv> is_sublist [x,y] xs \<or> xs \<noteq> [] \<and> x = last xs \<and> y = hd xs"
 
 lemma is_nextElem_a[intro]: "is_nextElem vs a b \<Longrightarrow> a \<in> set vs"
   by (auto simp: is_nextElem_def is_sublist_def)
 lemma is_nextElem_b[intro]: "is_nextElem vs a b \<Longrightarrow> b \<in> set vs"
   by (auto simp: is_nextElem_def is_sublist_def)
 lemma is_nextElem_last_hd[intro]: "distinct vs \<Longrightarrow> is_nextElem vs x y \<Longrightarrow>
   x = last vs \<Longrightarrow> y = hd vs"
   by (auto simp: is_nextElem_def)
 lemma is_nextElem_last_ne[intro]: "distinct vs \<Longrightarrow> is_nextElem vs x y \<Longrightarrow>
   x = last vs \<Longrightarrow> vs \<noteq> []"
   by (auto simp: is_nextElem_def)
 lemma is_nextElem_sublistI: "is_sublist [x,y] vs \<Longrightarrow> is_nextElem vs x y"
   by (auto simp: is_nextElem_def)
 
 lemma is_nextElem_nth1: "is_nextElem ls x y \<Longrightarrow> \<exists> i j. i < length ls
   \<and> j < length ls \<and> ls!i = x \<and> ls!j = y \<and> (Suc i) mod (length ls) = j"
 proof (cases "is_sublist [x,y] ls")
   assume is_nextElem: "is_nextElem ls x y"
   case True then show ?thesis apply (drule_tac is_sublist_nth1) by auto
 next
   assume is_nextElem: "is_nextElem ls x y"
   case False with is_nextElem have hl: "ls \<noteq> [] \<and> last ls = x \<and> hd ls = y"
     by (auto simp: is_nextElem_def)
   then have j: "ls!0 = y" by (cases ls) auto
   from hl have i: "ls!(length ls - 1) = x" by (cases ls rule: rev_exhaust)  auto
   from i j hl have "(length ls - 1) < length ls \<and> 0 < length ls \<and> ls!(length ls - 1) = x
     \<and> ls!0 = y \<and> (Suc (length ls - 1)) mod (length ls) = 0" by auto
   then show ?thesis apply (intro exI) .
 qed
 
 lemma is_nextElem_nth2: " \<exists> i j. i < length ls \<and> j < length ls \<and> ls!i = x \<and> ls!j = y
    \<and> (Suc i) mod (length ls) = j \<Longrightarrow> is_nextElem ls x y"
 proof -
   assume "\<exists> i j. i < length ls \<and> j < length ls \<and> ls!i = x \<and> ls!j = y \<and> (Suc i) mod (length ls) = j"
   then obtain i j where vors: "i < length ls \<and> j < length ls \<and> ls!i = x \<and> ls!j = y
     \<and> (Suc i) mod (length ls) = j" by auto
   then show ?thesis
   proof (cases "Suc i = length ls")
     case True with vors have "j = 0" by auto
       (*ls ! i = last ls*)
     with True vors show ?thesis apply (auto simp: is_nextElem_def)
      apply (cases ls rule: rev_exhaust) apply auto apply (cases ls) by auto
   next
     case False with vors have "is_sublist [x,y] ls"
     apply (rule_tac is_sublist_nth2) by auto
     then show ?thesis by (simp add: is_nextElem_def)
   qed
 qed
 
 lemma is_nextElem_rotate1_aux:
   "is_nextElem (rotate m ls) x y \<Longrightarrow> is_nextElem ls x y"
 proof -
   assume is_nextElem: "is_nextElem (rotate m ls) x y"
   define n where "n = m mod length ls"
   then have rot_eq: "rotate m ls = rotate n ls"
     by (auto intro: rotate_conv_mod)
   with is_nextElem have "is_nextElem (rotate n ls) x y"
     by simp
   then obtain i j where vors:"i < length (rotate n ls) \<and> j < length (rotate n ls) \<and>
     (rotate n ls)!i = x \<and> (rotate n ls)!j = y \<and>
     (Suc i) mod (length (rotate n ls)) = j"
     by (drule_tac is_nextElem_nth1) auto
   then have lls: "0 < length ls"
     by auto
   define k where "k = (i+n) mod (length ls)"
   with lls have sk: "k < length ls"
     by simp
   from k_def lls vors have "ls!k = (rotate n ls)!(i mod (length ls))"
     by (simp add: nth_rotate)
   with vors have lsk: "ls!k = x"
     by simp
   define l where "l = (j+n) mod (length ls)"
   with lls have sl: "l < length ls"
     by simp
   from l_def lls vors have "ls!l = (rotate n ls)!(j mod (length ls))"
     by (simp add: nth_rotate)
   with vors have lsl: "ls!l = y"
     by simp
   from vors k_def l_def
   have "(Suc i) mod length ls = j"
     by simp
   then have "(Suc i) mod length ls = j mod length ls"
     by auto
   then have "((Suc i) mod length ls + n mod (length ls)) mod length ls
     = (j mod length ls + n mod (length ls)) mod length ls"
     by simp
   then have "((Suc i) + n) mod length ls = (j + n) mod length ls"
     by (simp add: mod_simps)
   with vors k_def l_def have "(Suc k) mod (length ls) = l"
     by (simp add: mod_simps)
   with sk lsk sl lsl
   show ?thesis
     by (auto intro: is_nextElem_nth2)
 qed
 
 lemma is_nextElem_rotate_eq[simp]: "is_nextElem (rotate m ls) x y = is_nextElem ls x y"
   apply (auto dest: is_nextElem_rotate1_aux) apply (rule is_nextElem_rotate1_aux)
   apply (subgoal_tac   "is_nextElem (rotate (length ls - m mod length ls) (rotate m ls)) x y")
   apply assumption by simp
 
 lemma is_nextElem_congs_eq: "ls \<cong> ms \<Longrightarrow> is_nextElem ls x y = is_nextElem ms x y"
 by (auto simp: congs_def)
 
 lemma is_nextElem_rev[simp]: "is_nextElem (rev zs) a b = is_nextElem zs b a"
   apply (simp add: is_nextElem_def is_sublist_rev)
   apply (case_tac "zs = []") apply simp apply simp
   apply (case_tac "a = hd zs") apply (case_tac "zs")  apply simp  apply simp apply simp
   apply (case_tac "a = last (rev zs) \<and> b = last zs") apply simp
     apply (case_tac "zs" rule: rev_exhaust) apply simp
     apply (case_tac "ys") apply simp apply simp by force
 
 
 lemma is_nextElem_circ:
   "\<lbrakk> distinct xs; is_nextElem xs a b; is_nextElem xs b a \<rbrakk> \<Longrightarrow> |xs| \<le> 2"
 apply(drule is_nextElem_nth1)
 apply(drule is_nextElem_nth1)
 apply (clarsimp)
 apply(rename_tac i j)
 apply(frule_tac i=j and j = "Suc i mod |xs|" in nth_eq_iff_index_eq)
   apply assumption+
 apply(frule_tac j=i and i = "Suc j mod |xs|" in nth_eq_iff_index_eq)
   apply assumption+
 apply(rule ccontr)
 apply(simp add: distinct_conv_nth mod_Suc)
 done
 
 
 subsection\<open>\<open>nextElem, sublist, is_nextElem\<close>\<close>
 
 lemma is_sublist_eq: "distinct vs \<Longrightarrow> c \<noteq> y \<Longrightarrow>
  (nextElem vs c x = y) = is_sublist [x,y] vs"
 proof -
   assume d: "distinct vs" and c: "c \<noteq> y"
   have r1: "nextElem vs c x = y \<Longrightarrow> is_sublist [x,y] vs"
   proof -
     assume fn: "nextElem vs c x = y"
     with c show ?thesis by(drule_tac nextElem_cases)(auto simp: is_sublist_def)
   qed
   with d have r2: "is_sublist [x,y] vs \<Longrightarrow> nextElem vs c x = y"
   apply (simp add: is_sublist_def) apply (elim exE) by auto
   show ?thesis apply (intro iffI r1) by (auto intro: r2)
 qed
 
 lemma is_nextElem1: "distinct vs \<Longrightarrow> x \<in> set vs \<Longrightarrow> nextElem vs (hd vs) x = y \<Longrightarrow> is_nextElem vs x y"
 proof -
   assume d: "distinct vs" and x: "x \<in> set vs" and fn: "nextElem vs (hd vs) x = y"
   from x have r0: "vs \<noteq> []" by auto
   from d fn have r1: "x = last vs \<Longrightarrow> y = hd vs" by (auto)
   from d fn have r3: "hd vs \<noteq> y \<Longrightarrow> (\<exists> a b. vs = a @ [x,y] @ b)" by (drule_tac nextElem_cases) auto
 
   from x obtain n where xn:"x = vs!n" and nl: "n < length vs" by (auto simp: in_set_conv_nth)
   define as where "as = take n vs"
   define bs where "bs = drop (Suc n) vs"
   from as_def bs_def xn nl have vs:"vs = as @ [x] @ bs" by (auto intro: id_take_nth_drop)
   then have r2: "x \<noteq> last vs \<Longrightarrow> y \<noteq> hd vs"
   proof -
     assume notx: "x \<noteq> last vs"
     from vs notx have "bs \<noteq> []" by auto
     with vs have r2: "vs = as @ [x, hd bs] @ tl bs" by auto
     with d have ineq: "hd bs \<noteq> hd vs" by (cases as) auto
     from d fn r2 have "y = hd bs" by auto
     with ineq show ?thesis by auto
   qed
   from r0 r1 r2 r3 show ?thesis apply (simp add:is_nextElem_def is_sublist_def)
    apply (cases "x = last vs") by auto
 qed
 
 lemma is_nextElem2: "distinct vs \<Longrightarrow> x \<in> set vs \<Longrightarrow> is_nextElem vs x y \<Longrightarrow> nextElem vs (hd vs) x = y"
 proof -
   assume d: "distinct vs" and x: "x \<in> set vs" and is_nextElem: "is_nextElem vs x y"
   then show ?thesis apply (simp add: is_nextElem_def) apply (cases "is_sublist [x,y] vs")
     apply (cases "y = hd vs")
     apply (simp add: is_sublist_def) apply (force dest: distinct_hd_not_cons)
     apply (subgoal_tac "hd vs \<noteq> y")  apply (simp add: is_sublist_eq) by auto
 qed
 
 lemma nextElem_is_nextElem:
  "distinct xs \<Longrightarrow> x \<in> set xs \<Longrightarrow>
    is_nextElem xs x y = (nextElem xs (hd xs) x = y)"
   by (auto intro!: is_nextElem1 is_nextElem2)
 
 lemma nextElem_congs_eq: "xs \<cong> ys \<Longrightarrow> distinct xs \<Longrightarrow> x \<in> set xs  \<Longrightarrow>
    nextElem xs (hd xs) x = nextElem ys (hd ys) x"
 proof -
   assume eq: "xs \<cong> ys" and dist: "distinct xs" and x: "x \<in> set xs"
   define y where "y = nextElem xs (hd xs) x"
   then have f1:"nextElem xs (hd xs) x = y" by auto
   with dist x have "is_nextElem xs x y" by (auto intro: is_nextElem1)
   with eq have "is_nextElem ys x y" by (simp add:is_nextElem_congs_eq)
   with eq dist x have f2:"nextElem ys (hd ys) x = y"
     by (auto simp: congs_distinct intro: is_nextElem2)
   from f1 f2 show ?thesis by auto
 qed
 
 
 lemma is_sublist_is_nextElem: "distinct vs \<Longrightarrow> is_nextElem vs x y \<Longrightarrow> is_sublist as vs \<Longrightarrow> x \<in> set as \<Longrightarrow> x \<noteq> last as \<Longrightarrow> is_sublist [x,y] as"
 proof -
   assume d: "distinct vs" and is_nextElem: "is_nextElem vs x y" and subl: "is_sublist as vs" and xin: "x \<in> set as" and xnl: "x \<noteq> last as"
   from xin have asne: "as \<noteq> []" by auto
   with subl have vsne: "vs \<noteq> []" by (auto simp: is_sublist_def)
   from subl obtain rs ts where vs: "vs = rs @ as @ ts"  apply (simp add: is_sublist_def) apply (elim exE) by auto
   with d xnl asne have "x \<noteq> last vs"
   proof (cases "ts = []")
     case True
     with d xnl asne vs show ?thesis by force
   next
     define lastvs where "lastvs = last ts"
     case False
     with vs lastvs_def have vs2: "vs = rs @ as @ butlast ts @ [lastvs]" by auto
     with d have "lastvs \<notin> set as" by auto
     with xin have "lastvs \<noteq> x" by auto
     with vs2 show ?thesis by auto
   qed
   with is_nextElem have subl_vs: "is_sublist [x,y] vs" by (auto simp: is_nextElem_def)
   from d xin vs have "\<not> is_sublist [x] rs" by auto
   then have nrs: "\<not> is_sublist [x,y] rs" by (auto dest: is_sublist_hd)
   from d xin vs have "\<not> is_sublist [x] ts" by auto
   then have nts: "\<not> is_sublist [x,y] ts" by (auto dest: is_sublist_hd)
   from d xin vs have xnrs: "x \<notin> set rs" by auto
   then have notrs: "\<not> is_sublist [x,y] rs" by (auto simp:is_sublist_in)
   from xnrs have xnlrs: "rs \<noteq> [] \<Longrightarrow> x \<noteq> last rs" by (induct rs) auto
   from d xin vs have xnts: "x \<notin> set ts" by auto
   then have notts: "\<not> is_sublist [x,y] ts"  by (auto simp:is_sublist_in)
   from d vs subl_vs have "is_sublist [x,y] rs \<or> is_sublist [x,y] (as@ts)" apply (cases "rs = []") apply simp apply (rule_tac is_sublist_at1) by (auto intro!: xnlrs)
   with notrs have "is_sublist [x,y] (as@ts)" by auto
   with d vs xnl have "is_sublist [x,y] as \<or> is_sublist [x,y] ts" apply (rule_tac is_sublist_at1) by auto
   with notts show "is_sublist [x,y] as"  by auto
 qed
 
 
 subsection \<open>\<open>before\<close>\<close>
 
 definition before :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" where
 "before vs ram1 ram2 \<equiv> \<exists> a b c. vs = a @ ram1 # b @ ram2 # c"
 
 lemma before_dist_fst_fst[simp]: "before vs ram1 ram2 \<Longrightarrow> distinct vs \<Longrightarrow> fst (splitAt ram2 (fst (splitAt ram1 vs))) = fst (splitAt ram1 (fst (splitAt ram2 vs)))"
   apply (simp add: before_def) apply (elim exE)
   apply (drule splitAt_dist_ram_all) by (auto dest!: pairD)
 
 lemma before_dist_fst_snd[simp]: "before vs ram1 ram2 \<Longrightarrow> distinct vs \<Longrightarrow> fst (splitAt ram2 (snd (splitAt ram1 vs))) = snd (splitAt ram1 (fst (splitAt ram2 vs)))"
   apply (simp add: before_def) apply (elim exE)
   apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)
 
 lemma before_dist_snd_fst[simp]: "before vs ram1 ram2 \<Longrightarrow> distinct vs \<Longrightarrow> snd (splitAt ram2 (fst (splitAt ram1 vs))) = snd (splitAt ram1 (snd (splitAt ram2 vs)))"
   apply (simp add: before_def) apply (elim exE)
   apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)
 
 lemma before_dist_snd_snd[simp]: "before vs ram1 ram2 \<Longrightarrow> distinct vs \<Longrightarrow> snd (splitAt ram2 (snd (splitAt ram1 vs))) = fst (splitAt ram1 (snd (splitAt ram2 vs)))"
   apply (simp add: before_def) apply (elim exE)
   apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)
 
 lemma before_dist_snd[simp]: "before vs ram1 ram2 \<Longrightarrow> distinct vs \<Longrightarrow> fst (splitAt ram1 (snd (splitAt ram2 vs))) = snd (splitAt ram2 vs)"
   apply (simp add: before_def) apply (elim exE)
   apply (drule_tac splitAt_dist_ram_all)   by (auto dest!: pairD)
 
 lemma before_dist_fst[simp]: "before vs ram1 ram2 \<Longrightarrow> distinct vs \<Longrightarrow> fst (splitAt ram1 (fst (splitAt ram2 vs))) = fst (splitAt ram1 vs)"
   apply (simp add: before_def) apply (elim exE)
   apply (drule_tac splitAt_dist_ram_all)   by (auto dest!: pairD)
 
 lemma before_or: "ram1 \<in> set vs \<Longrightarrow> ram2 \<in> set vs \<Longrightarrow> ram1 \<noteq> ram2 \<Longrightarrow> before vs ram1 ram2 \<or> before vs ram2 ram1"
 proof -
   assume r1: "ram1 \<in> set vs" and r2: "ram2 \<in> set vs" and r12: "ram1 \<noteq> ram2"
   then show ?thesis
     proof (cases "ram2 \<in> set (snd (splitAt ram1 vs))")
       define a where "a = fst (splitAt ram1 vs)"
       define b where "b = fst (splitAt ram2 (snd (splitAt ram1 vs)))"
       define c where "c = snd (splitAt ram2 (snd (splitAt ram1 vs)))"
       case True with r1 a_def b_def c_def have "vs = a @ [ram1] @ b @ [ram2] @ c"
         by (auto dest!: splitAt_ram)
       then show ?thesis apply (simp add: before_def) by auto
     next
       define ab where "ab = fst (splitAt ram1 vs)"
       case False
       with r1 r2 r12 ab_def have r2': "ram2 \<in> set ab" by (auto intro: splitAt_ram3)
       define a where "a = fst (splitAt ram2 ab)"
       define b where "b = snd (splitAt ram2 ab)"
       define c where "c = snd (splitAt ram1 vs)"
       from r1 ab_def c_def have "vs = ab @ [ram1] @ c" by (auto dest!: splitAt_ram)
       with r2' a_def b_def have "vs = (a @ [ram2] @ b) @ [ram1] @ c" by (drule_tac splitAt_ram) simp
       then show ?thesis apply (simp add: before_def) apply (rule disjI2) by auto
     qed
   qed
 
 lemma before_r1:
   "before vs r1 r2 \<Longrightarrow> r1 \<in> set vs" by (auto simp: before_def)
 
 lemma before_r2:
   "before vs r1 r2 \<Longrightarrow> r2 \<in> set vs" by (auto simp: before_def)
 
 lemma before_dist_r2:
   "distinct vs \<Longrightarrow> before vs r1 r2 \<Longrightarrow> r2 \<in> set (snd (splitAt r1 vs))"
 proof -
   assume d: "distinct vs" and b: "before vs r1 r2"
   from d b have ex1: "\<exists>! s. (vs = (fst s) @ r1 # snd (s))" apply (drule_tac before_r1) apply (rule distinct_unique1)  by auto
   from d b ex1 show ?thesis apply (unfold before_def)
     proof (elim exE ex1E)
       fix a b c s
       assume vs: "vs = a @ r1 # b @ r2 # c" and "\<forall>y. vs = fst y @ r1 # snd y \<longrightarrow> y = s"
       then have  "\<And> y. vs = fst y @ r1 # snd y \<longrightarrow> y = s" by (clarify, hypsubst_thin, auto)
       then have single: "\<And> y. vs = fst y @ r1 # snd y \<Longrightarrow> y = s" by auto
       define bc where "bc = b @ r2 # c"
       with vs have vs2: "vs = a @ r1 # bc" by auto
       from bc_def have  r2: "r2 \<in> set bc" by auto
       define t where "t = (a,bc)"
       with vs2 have vs3: "vs = fst (t) @ r1 # snd (t)" by auto
       with single have ts: "t = s" by (rule_tac single) auto
       from b have "splitAt r1 vs = s" apply (drule_tac before_r1) apply (drule_tac splitAt_ram) by (rule single) auto
       with ts have "t = splitAt r1 vs" by simp
       with t_def have "bc = snd(splitAt r1 vs)" by simp
       with r2 show ?thesis by simp
     qed
   qed
 
 lemma before_dist_not_r2[intro]:
   "distinct vs \<Longrightarrow> before vs r1 r2 \<Longrightarrow> r2 \<notin>  set (fst (splitAt r1 vs))" apply (frule before_dist_r2) by (auto dest: splitAt_distinct_fst_snd)
 
 lemma before_dist_r1:
   "distinct vs \<Longrightarrow> before vs r1 r2 \<Longrightarrow> r1 \<in> set (fst (splitAt r2 vs))"
 proof -
   assume d: "distinct vs" and b: "before vs r1 r2"
   from d b have ex1: "\<exists>! s. (vs = (fst s) @ r2 # snd (s))" apply (drule_tac before_r2) apply (rule distinct_unique1)  by auto
   from d b ex1 show ?thesis apply (unfold before_def)
     proof (elim exE ex1E)
       fix a b c s
       assume vs: "vs = a @ r1 # b @ r2 # c" and "\<forall>y. vs = fst y @ r2 # snd y \<longrightarrow> y = s"
       then have  "\<And> y. vs = fst y @ r2 # snd y \<longrightarrow> y = s" by (clarify, hypsubst_thin, auto)
       then have single: "\<And> y. vs = fst y @ r2 # snd y \<Longrightarrow> y = s" by auto
       define ab where "ab = a @ r1 # b"
       with vs have vs2: "vs = ab @ r2 # c" by auto
       from ab_def have  r1: "r1 \<in> set ab" by auto
       define t where "t = (ab,c)"
       with vs2 have vs3: "vs = fst (t) @ r2 # snd (t)" by auto
       with single have ts: "t = s" by (rule_tac single) auto
       from b have "splitAt r2 vs = s" apply (drule_tac before_r2) apply (drule_tac splitAt_ram) by (rule single) auto
       with ts have "t = splitAt r2 vs" by simp
       with t_def have "ab = fst(splitAt r2 vs)" by simp
       with r1 show ?thesis by simp
     qed
   qed
 
 lemma before_dist_not_r1[intro]:
   "distinct vs \<Longrightarrow> before vs r1 r2 \<Longrightarrow> r1 \<notin>  set (snd (splitAt r2 vs))" apply (frule before_dist_r1) by (auto dest: splitAt_distinct_fst_snd)
 
 lemma before_snd:
   "r2 \<in> set (snd (splitAt r1 vs)) \<Longrightarrow> before vs r1 r2"
 proof -
   assume r2: "r2 \<in> set (snd (splitAt r1 vs))"
   from r2 have r1: "r1 \<in> set vs" apply (rule_tac ccontr) apply (drule splitAt_no_ram) by simp
   define a where "a = fst (splitAt r1 vs)"
   define bc where "bc = snd (splitAt r1 vs)"
   define b where "b = fst (splitAt r2 bc)"
   define c where "c = snd (splitAt r2 bc)"
   from r1 a_def bc_def have vs: "vs = a @ [r1] @ bc" by (auto dest: splitAt_ram)
   from r2 bc_def have r2: "r2 \<in> set bc" by simp
   with b_def c_def have "bc = b @ [r2] @ c" by (auto dest: splitAt_ram)
   with vs show ?thesis by (simp add: before_def) auto
 qed
 
 lemma before_fst:
 "r2 \<in> set vs \<Longrightarrow> r1 \<in> set (fst (splitAt r2 vs)) \<Longrightarrow> before vs r1 r2"
 proof -
   assume r2: "r2 \<in> set vs" and r1: "r1 \<in> set (fst (splitAt r2 vs))"
   define ab where "ab = fst (splitAt r2 vs)"
   define c where "c = snd (splitAt r2 vs)"
   define a where "a = fst (splitAt r1 ab)"
   define b where "b = snd (splitAt r1 ab)"
   from r2 ab_def c_def have vs: "vs = ab @ [r2] @ c" by (auto dest: splitAt_ram)
   from r1 ab_def have r1: "r1 \<in> set ab" by simp
   with a_def b_def have "ab = a @ [r1] @ b" by (auto dest: splitAt_ram)
   with vs show ?thesis by (simp add: before_def) auto
 qed
 
 (* usefule simplifier rules *)
 lemma before_dist_eq_fst:
 "distinct vs \<Longrightarrow> r2 \<in> set vs \<Longrightarrow> r1 \<in> set (fst (splitAt r2 vs)) = before vs r1 r2"
   by (auto intro: before_fst before_dist_r1)
 
 lemma before_dist_eq_snd:
 "distinct vs \<Longrightarrow> r2 \<in> set (snd (splitAt r1 vs)) = before vs r1 r2"
   by (auto intro: before_snd before_dist_r2)
 
 lemma before_dist_not1:
   "distinct vs \<Longrightarrow> before vs ram1 ram2 \<Longrightarrow> \<not> before vs ram2 ram1"
 proof
    assume d: "distinct vs" and b1: "before vs ram2 ram1" and b2: "before vs ram1 ram2"
    from b2 have r1: "ram1 \<in> set vs" by (drule_tac before_r1)
    from d b1 have r2: "ram2 \<in> set (fst (splitAt ram1 vs))" by (rule before_dist_r1)
    from d b2 have r2':"ram2 \<in> set (snd (splitAt ram1 vs))" by (rule before_dist_r2)
    from d r1 r2 r2' show "False" by (drule_tac splitAt_distinct_fst_snd) auto
 qed
 
 lemma before_dist_not2:
   "distinct vs \<Longrightarrow> ram1 \<in> set vs \<Longrightarrow> ram2 \<in> set vs \<Longrightarrow> ram1 \<noteq> ram2 \<Longrightarrow> \<not> (before vs ram1 ram2) \<Longrightarrow> before vs ram2 ram1"
 proof -
   assume "distinct vs" "ram1 \<in> set vs " "ram2 \<in> set vs" "ram1 \<noteq> ram2" "\<not> before vs ram1 ram2"
   then show "before vs ram2 ram1" apply (frule_tac before_or) by auto
 qed
 
 lemma before_dist_eq:
   "distinct vs \<Longrightarrow> ram1 \<in> set vs \<Longrightarrow> ram2 \<in> set vs \<Longrightarrow> ram1 \<noteq> ram2 \<Longrightarrow> ( \<not> (before vs ram1 ram2)) = before vs ram2 ram1"
   by (auto intro: before_dist_not2 dest: before_dist_not1)
 
 lemma before_vs:
  "distinct vs \<Longrightarrow> before vs ram1 ram2 \<Longrightarrow> vs = fst (splitAt ram1 vs) @ ram1 # fst (splitAt ram2 (snd (splitAt ram1 vs))) @ ram2 # snd (splitAt ram2 vs)"
 proof -
   assume d: "distinct vs" and b: "before vs ram1 ram2"
   define s where "s = snd (splitAt ram1 vs)"
   from b have  "ram1 \<in> set vs" by (auto simp: before_def)
   with s_def have vs: "vs = fst (splitAt ram1 vs) @ [ram1] @ s" by (auto dest: splitAt_ram)
   from d b s_def have "ram2 \<in> set s" by (auto intro: before_dist_r2)
   then have snd: "s = fst (splitAt ram2 s) @ [ram2] @  snd (splitAt ram2 s)"
     by (auto dest: splitAt_ram)
   with vs have "vs = fst (splitAt ram1 vs) @ [ram1] @ fst (splitAt ram2 s) @ [ram2] @  snd (splitAt ram2 s)" by auto
   with d b s_def show ?thesis by auto
 qed
 
 
 
 
 (************************ between lemmas *************************************)
 subsection \<open>@{const between}\<close>
 
 definition pre_between :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" where
 "pre_between vs ram1 ram2 \<equiv>
    distinct vs \<and> ram1 \<in> set vs \<and> ram2 \<in> set vs \<and> ram1 \<noteq> ram2"
 
 declare pre_between_def [simp]
 
 lemma pre_between_dist[intro]:
   "pre_between vs ram1 ram2 \<Longrightarrow> distinct vs" by (auto simp: pre_between_def)
 
 lemma pre_between_r1[intro]:
   "pre_between vs ram1 ram2 \<Longrightarrow> ram1 \<in> set vs" by auto
 
 lemma pre_between_r2[intro]:
   "pre_between vs ram1 ram2 \<Longrightarrow> ram2 \<in> set vs" by auto
 
 lemma pre_between_r12[intro]:
   "pre_between vs ram1 ram2 \<Longrightarrow> ram1 \<noteq> ram2" by auto
 
 lemma pre_between_symI:
   "pre_between vs ram1 ram2 \<Longrightarrow> pre_between vs ram2 ram1" by auto
 
 lemma pre_between_before[dest]:
   "pre_between vs ram1 ram2 \<Longrightarrow> before vs ram1 ram2 \<or> before vs ram2 ram1" by (rule_tac before_or) auto
 
 lemma pre_between_rotate1[intro]:
   "pre_between vs ram1 ram2 \<Longrightarrow> pre_between (rotate1 vs) ram1 ram2" by auto
 
 lemma pre_between_rotate[intro]:
   "pre_between vs ram1 ram2 \<Longrightarrow> pre_between (rotate n vs) ram1 ram2" by auto
 
 lemma(*<*) before_xor: (*>*)
  "pre_between vs ram1 ram2 \<Longrightarrow> (\<not> before vs ram1 ram2) = before vs ram2 ram1"
   by (simp add: before_dist_eq)
 
 declare pre_between_def [simp del]
 
 lemma between_simp1[simp]:
 "before vs ram1 ram2 \<Longrightarrow> pre_between vs ram1 ram2 \<Longrightarrow>
 between vs ram1 ram2 = fst (splitAt ram2 (snd (splitAt ram1 vs)))"
 by (simp add: pre_between_def between_def split_def before_dist_eq_snd)
 
 
 lemma between_simp2[simp]:
 "before vs ram1 ram2 \<Longrightarrow> pre_between vs ram1 ram2 \<Longrightarrow>
   between vs ram2 ram1 = snd (splitAt ram2 vs) @  fst (splitAt ram1 vs)"
 proof -
   assume b: "before vs ram1 ram2" and p: "pre_between vs ram1 ram2"
   from p b have b2: "\<not> before vs ram2 ram1" apply (simp add: pre_between_def) by (auto dest: before_dist_not1)
   with p have "ram2 \<notin> set (fst (splitAt ram1 vs))" by (simp add: pre_between_def before_dist_eq_fst)
   then have "fst (splitAt ram1 vs) = fst (splitAt ram2 (fst (splitAt ram1 vs)))" by (auto dest: splitAt_no_ram)
   then have "fst (splitAt ram2 (fst (splitAt ram1 vs))) = fst (splitAt ram1 vs)" by auto
   with b2 b p show ?thesis apply (simp add: pre_between_def between_def split_def)
     by (auto dest: before_dist_not_r1)
 qed
 
 lemma between_not_r1[intro]:
   "distinct vs \<Longrightarrow> ram1 \<notin> set (between vs ram1 ram2)"
 proof (cases "pre_between vs ram1 ram2")
   assume d: "distinct vs"
   case True then have p: "pre_between vs ram1 ram2" by auto
   then show "ram1 \<notin> set (between vs ram1 ram2)"
   proof (cases "before vs ram1 ram2")
     case True with d p show ?thesis by (auto del: notI)
   next
     from p have p2: "pre_between vs ram2 ram1" by (auto intro: pre_between_symI)
     case False with p have "before vs ram2 ram1" by auto
     with d p2 show ?thesis  by (auto del: notI)
   qed
 next
   assume d:"distinct vs"
   case False then have p: "\<not> pre_between vs ram1 ram2" by auto
   then show ?thesis
   proof (cases "ram1 = ram2")
     case True with d have h1:"ram2 \<notin> set (snd (splitAt ram2 vs))" by (auto del: notI)
     from True d have h2: "ram2 \<notin> set (fst (splitAt ram2 (fst (splitAt ram2 vs))))" by (auto del: notI)
     with True d h1 show ?thesis by (auto simp: between_def split_def)
   next
     case False then have neq: "ram1 \<noteq> ram2" by auto
     then show ?thesis
     proof (cases "ram1 \<notin> set vs")
       case True with d show ?thesis by (auto dest: splitAt_no_ram splitAt_in_fst simp: between_def split_def)
     next
       case False then have r1in: "ram1 \<in> set vs" by auto
       then show ?thesis
       proof (cases "ram2 \<notin> set vs")
         from d have h1: "ram1 \<notin> set (fst (splitAt ram1 vs))" by (auto del: notI)
         case True with d h1 show ?thesis
         by (auto dest: splitAt_not1 splitAt_in_fst splitAt_ram
         splitAt_no_ram simp: between_def split_def del: notI)
       next
         case False then have r2in: "ram2 \<in> set vs" by auto
         with d neq r1in have "pre_between vs ram1 ram2"
           by (auto simp: pre_between_def)
         with p show ?thesis by auto
       qed
     qed
   qed
 qed
 
 lemma between_not_r2[intro]:
   "distinct vs \<Longrightarrow> ram2 \<notin> set (between vs ram1 ram2)"
 proof (cases "pre_between vs ram1 ram2")
   assume d: "distinct vs"
   case True then have p: "pre_between vs ram1 ram2" by auto
   then show "ram2 \<notin> set (between vs ram1 ram2)"
   proof (cases "before vs ram1 ram2")
     from d have "ram2 \<notin> set (fst (splitAt ram2 vs))" by (auto del: notI)
     then have h1: "ram2 \<notin> set (snd (splitAt ram1 (fst (splitAt ram2 vs))))"
       by (auto dest: splitAt_in_fst)
     case True with d p h1 show ?thesis by (auto del: notI)
   next
     from p have p2: "pre_between vs ram2 ram1" by (auto intro: pre_between_symI)
     case False with p have "before vs ram2 ram1" by auto
     with d p2 show ?thesis  by (auto del: notI)
   qed
 next
   assume d:"distinct vs"
   case False then have p: "\<not> pre_between vs ram1 ram2" by auto
   then show ?thesis
   proof (cases "ram1 = ram2")
     case True with d have h1:"ram2 \<notin> set (snd (splitAt ram2 vs))" by (auto del: notI)
     from True d have h2: "ram2 \<notin> set (fst (splitAt ram2 (fst (splitAt ram2 vs))))" by (auto del: notI)
     with True d h1 show ?thesis by (auto simp: between_def split_def)
   next
     case False then have neq: "ram1 \<noteq> ram2" by auto
     then show ?thesis
     proof (cases "ram2 \<notin> set vs")
       case True with d show ?thesis
         by (auto dest: splitAt_no_ram splitAt_in_fst
          splitAt_in_fst simp: between_def split_def)
     next
       case False then have r1in: "ram2 \<in> set vs" by auto
       then show ?thesis
       proof (cases "ram1 \<notin> set vs")
         from d have h1: "ram1 \<notin> set (fst (splitAt ram1 vs))" by (auto del: notI)
         case True with d h1 show ?thesis by  (auto dest: splitAt_ram splitAt_no_ram simp: between_def split_def del: notI)
       next
         case False then have r2in: "ram1 \<in> set vs" by auto
         with d neq r1in have "pre_between vs ram1 ram2" by (auto simp: pre_between_def)
         with p show ?thesis by auto
       qed
     qed
   qed
 qed
 
 lemma between_distinct[intro]:
   "distinct vs \<Longrightarrow> distinct (between vs ram1 ram2)"
 proof -
   assume vs: "distinct vs"
   define a where "a = fst (splitAt ram1 vs)"
   define b where "b = snd (splitAt ram1 vs)"
   from a_def b_def have ab: "(a,b) = splitAt ram1 vs" by auto
   with vs have ab_disj:"set a \<inter> set b = {}" by (drule_tac splitAt_distinct_ab)  auto
   define c where "c = fst (splitAt ram2 a)"
   define d where "d = snd (splitAt ram2 a)"
   from c_def d_def have c_d: "(c,d) = splitAt ram2 a" by auto
   with ab_disj have "set c \<inter> set b = {}" by (drule_tac splitAt_subset_ab) auto
   with vs a_def b_def c_def show ?thesis
     by (auto simp: between_def split_def splitAt_no_ram dest: splitAt_ram intro: splitAt_distinct_fst splitAt_distinct_snd)
 qed
 
 lemma between_distinct_r12:
   "distinct vs \<Longrightarrow> ram1 \<noteq> ram2 \<Longrightarrow> distinct (ram1 # between vs ram1 ram2 @ [ram2])" by (auto del: notI)
 
 lemma between_vs:
   "before vs ram1 ram2 \<Longrightarrow> pre_between vs ram1 ram2 \<Longrightarrow>
   vs = fst (splitAt ram1 vs) @ ram1 # (between vs ram1 ram2) @ ram2 # snd (splitAt ram2 vs)"
   apply (simp) apply (frule pre_between_dist) apply (drule before_vs) by auto
 
 lemma between_in:
   "before vs ram1 ram2 \<Longrightarrow> pre_between vs ram1 ram2 \<Longrightarrow> x \<in> set vs \<Longrightarrow> x = ram1 \<or> x \<in> set (between vs ram1 ram2) \<or> x = ram2 \<or> x \<in> set (between vs ram2 ram1)"
 proof -
   assume b: "before vs ram1 ram2" and p: "pre_between vs ram1 ram2" and xin: "x \<in> set vs"
   define a where "a = fst (splitAt ram1 vs)"
   define b where "b = between vs ram1 ram2"
   define c where "c = snd (splitAt ram2 vs)"
   from p have "distinct vs" by auto
   from p b a_def b_def c_def have "vs = a @ ram1 # b @ ram2 # c" apply (drule_tac between_vs)  by auto
   with xin have "x \<in> set (a @ ram1 # b @ ram2 # c)" by auto
   then have "x \<in> set (a) \<or> x \<in> set (ram1 #b) \<or> x \<in> set (ram2 # c)" by auto
   then have "x \<in> set (a) \<or> x = ram1 \<or> x \<in> set b \<or> x = ram2 \<or> x \<in> set c" by auto
   then have "x \<in> set c \<or> x \<in> set (a) \<or> x = ram1 \<or> x \<in> set b \<or> x = ram2" by auto
   then have "x \<in> set (c @ a) \<or> x = ram1 \<or> x \<in> set b \<or> x = ram2" by auto
   with b p a_def b_def c_def show ?thesis by auto
 qed
 
 lemma
   "before vs ram1 ram2 \<Longrightarrow> pre_between vs ram1 ram2 \<Longrightarrow>
   hd vs \<noteq> ram1 \<Longrightarrow> (a,b) = splitAt (hd vs) (between vs ram2 ram1) \<Longrightarrow>
   vs = [hd vs] @ b @ [ram1] @ (between vs ram1 ram2) @ [ram2] @ a"
 proof -
   assume b: "before vs ram1 ram2" and p: "pre_between vs ram1 ram2" and vs: "hd vs \<noteq> ram1" and ab: "(a,b) = splitAt (hd vs) (between vs ram2 ram1)"
   from p have dist_b: "distinct (between vs ram2 ram1)" by (auto intro: between_distinct simp: pre_between_def)
   with ab have "distinct a \<and> distinct b" by (auto intro: splitAt_distinct_a splitAt_distinct_b)
   define r where "r = snd (splitAt ram1 vs)"
   define btw where "btw = between vs ram2 ram1"
   from p r_def have vs2: "vs = fst (splitAt ram1 vs) @ [ram1] @ r" by (auto dest: splitAt_ram simp: pre_between_def)
   then have "fst (splitAt ram1 vs) = [] \<Longrightarrow> hd vs = ram1" by auto
   with vs have neq: "fst (splitAt ram1 vs) \<noteq> []" by auto
   with vs2 have vs_fst: "hd vs = hd (fst (splitAt ram1 vs))" by (induct ("fst (splitAt ram1 vs)")) auto
   with neq have "hd vs \<in> set (fst (splitAt ram1 vs))"  by auto
   with b p have "hd vs \<in> set (between vs ram2 ram1)" by auto
   with btw_def have help1: "btw =  fst (splitAt (hd vs) btw) @ [hd vs] @ snd (splitAt (hd vs) btw)" by (auto dest: splitAt_ram)
   from p b btw_def have "btw = snd (splitAt ram2 vs) @  fst (splitAt ram1 vs)" by auto
   with neq have "btw = snd (splitAt ram2 vs) @ hd (fst (splitAt ram1 vs)) # tl (fst (splitAt ram1 vs))" by auto
   with vs_fst have "btw = snd (splitAt ram2 vs) @ [hd vs] @ tl (fst (splitAt ram1 vs))" by auto
   with help1 have eq: "snd (splitAt ram2 vs) @ [hd vs] @ tl (fst (splitAt ram1 vs)) = fst (splitAt (hd vs) btw) @ [hd vs] @ snd (splitAt (hd vs) btw)" by auto
   from dist_b btw_def help1 have "distinct (fst (splitAt (hd vs) btw) @ [hd vs] @ snd (splitAt (hd vs) btw))" by auto
   with eq have  eq2: "snd (splitAt ram2 vs) = fst (splitAt (hd vs) btw) \<and> tl (fst (splitAt ram1 vs)) = snd (splitAt (hd vs) btw)" apply (rule_tac dist_at) by auto
   with btw_def ab have a: "a = snd (splitAt ram2 vs)" by (auto dest: pairD)
   from eq2 vs_fst have "hd (fst (splitAt ram1 vs)) # tl (fst (splitAt ram1 vs)) = hd vs # snd (splitAt (hd vs) btw)" by auto
   with ab btw_def neq have hdb: "hd vs # b = fst (splitAt ram1 vs)"  by (auto dest: pairD)
 
   from b p have "vs = fst (splitAt ram1 vs) @ [ram1] @ fst (splitAt ram2 (snd (splitAt ram1 vs))) @ [ram2] @ snd (splitAt ram2 vs)" apply simp
     apply (rule_tac before_vs) by (auto simp: pre_between_def)
   with hdb have "vs = (hd vs # b) @ [ram1] @ fst (splitAt ram2 (snd (splitAt ram1 vs))) @ [ram2] @ snd (splitAt ram2 vs)" by auto
   with a b p show ?thesis by (simp)
 qed
 
 lemma between_congs: "pre_between vs ram1 ram2 \<Longrightarrow> vs \<cong> vs' \<Longrightarrow> between vs ram1 ram2 = between vs' ram1 ram2"
 proof -
   have "\<And> us. pre_between us ram1 ram2 \<Longrightarrow> before us ram1 ram2 \<Longrightarrow> between us ram1 ram2 = between (rotate1 us) ram1 ram2"
   proof -
     fix us
     assume vors: "pre_between us ram1 ram2"  "before us ram1 ram2"
     then have pb2: "pre_between (rotate1 us) ram1 ram2" by auto
     with vors show "between us ram1 ram2 = between (rotate1 us) ram1 ram2"
     proof (cases "us")
       case Nil then show ?thesis by auto
     next
       case (Cons u' us')
       with vors pb2 show ?thesis apply (auto simp: before_def)
         apply (case_tac "a") apply auto
         by (simp_all add: between_def split_def pre_between_def)
     qed
   qed
 
   moreover have "\<And> us. pre_between us ram1 ram2 \<Longrightarrow> before us ram2 ram1 \<Longrightarrow> between us ram1 ram2 = between (rotate1 us) ram1 ram2"
   proof -
     fix us
     assume vors: " pre_between us ram1 ram2"  "before us ram2 ram1"
     then have pb2: "pre_between (rotate1 us) ram1 ram2" by auto
     with vors show "between us ram1 ram2 = between (rotate1 us) ram1 ram2"
     proof (cases "us")
       case Nil then show ?thesis by auto
     next
       case (Cons u' us')
       with vors pb2 show ?thesis apply (auto simp: before_def)
         apply (case_tac "a") apply auto
         by (simp_all add: between_def split_def pre_between_def)
     qed
   qed
 
   ultimately have "help": "\<And> us. pre_between us ram1 ram2 \<Longrightarrow> between us ram1 ram2 = between (rotate1 us) ram1 ram2"
     apply (subgoal_tac "before us ram1 ram2 \<or> before us ram2 ram1") by auto
 
   assume "vs \<cong> vs'" and pre_b: "pre_between vs ram1 ram2"
   then obtain n where vs': "vs' = rotate n vs" by (auto simp: congs_def)
   have "between vs ram1 ram2 = between (rotate n vs) ram1 ram2"
   proof (induct n)
     case 0 then show ?case by auto
   next
     case (Suc m) then show ?case apply simp
       apply (subgoal_tac " between (rotate1 (rotate m vs)) ram1 ram2 = between (rotate m vs) ram1 ram2")
       by (auto intro: "help" [symmetric] pre_b)
   qed
   with vs' show ?thesis by auto
 qed
 
 lemma between_inter_empty:
  "pre_between vs ram1 ram2 \<Longrightarrow>
   set (between vs ram1 ram2) \<inter> set (between vs ram2 ram1) = {}"
 apply (case_tac "before vs ram1 ram2")
  apply (simp add: pre_between_def)
  apply (elim conjE)
  apply (frule (1) before_vs)
  apply (subgoal_tac "distinct (fst (splitAt ram1 vs) @
           ram1 # fst (splitAt ram2 (snd (splitAt ram1 vs))) @ ram2 # snd (splitAt ram2 vs))")
   apply (thin_tac "vs = fst (splitAt ram1 vs) @
           ram1 # fst (splitAt ram2 (snd (splitAt ram1 vs))) @ ram2 # snd (splitAt ram2 vs)")
   apply (frule (1) before_dist_fst_snd)
   apply(simp)
   apply blast
  apply (simp only:)
 apply (simp add: before_xor)
 apply (subgoal_tac "pre_between vs ram2 ram1")
  apply (simp add: pre_between_def)
  apply (elim conjE)
  apply (frule (1) before_vs)
  apply (subgoal_tac "distinct (fst (splitAt ram2 vs) @
           ram2 # fst (splitAt ram1 (snd (splitAt ram2 vs))) @ ram1 # snd (splitAt ram1 vs))")
   apply (thin_tac "vs = fst (splitAt ram2 vs) @
           ram2 # fst (splitAt ram1 (snd (splitAt ram2 vs))) @ ram1 # snd (splitAt ram1 vs)")
   apply simp
   apply blast
  apply (simp only:)
 by (rule pre_between_symI)
 
 
 (*********************** between - is_nextElem *************************)
 subsubsection \<open>\<open>between is_nextElem\<close>\<close>
 
 
 
 lemma is_nextElem_or1: "pre_between vs ram1 ram2 \<Longrightarrow>
   is_nextElem vs x y \<Longrightarrow> before vs ram1 ram2 \<Longrightarrow>
   is_sublist [x,y] (ram1 # between vs ram1 ram2 @ [ram2])
  \<or>  is_sublist [x,y] (ram2 # between vs ram2 ram1 @ [ram1])"
 proof -
   assume p: "pre_between vs ram1 ram2" and is_nextElem: "is_nextElem vs x y" and b: "before vs ram1 ram2"
   from p have r1: "ram1 \<in> set vs" by (auto simp: pre_between_def)
   define bs where "bs = [ram1] @ (between vs ram1 ram2) @ [ram2]"
   have rule1: "x \<in> set (ram1 # (between vs ram1 ram2)) \<Longrightarrow> is_sublist [x,y] bs"
   proof -
     assume xin:"x \<in> set (ram1 # (between vs ram1 ram2))"
     with bs_def have xin2: "x \<in> set bs" by auto
     define s where "s = snd (splitAt ram1 vs)"
     from r1 s_def have sub1:"is_sublist (ram1 # s) vs" by (auto intro: splitAt_is_sublist2R)
     from b p s_def have "ram2 \<in> set s" by (auto intro!: before_dist_r2 simp: pre_between_def)
     then have "is_prefix (fst (splitAt ram2 s) @ [ram2]) s" by (auto intro!: splitAt_is_prefix)
     then have "is_prefix ([ram1] @ ((fst (splitAt ram2 s)) @ [ram2])) ([ram1] @ s)" by (rule_tac is_prefix_add) auto
     with sub1 have "is_sublist (ram1 # (fst (splitAt ram2 s)) @ [ram2]) vs" apply (rule_tac is_sublist_trans) apply (rule is_prefix_sublist)
       by simp_all
     with p b s_def bs_def have subl: "is_sublist bs vs" by (auto)
     with p have db: "distinct bs" by (auto simp: pre_between_def)
     with xin bs_def have xnlb:"x \<noteq> last bs" by auto
     with p is_nextElem subl xin2 show "is_sublist [x,y] bs" apply (rule_tac is_sublist_is_nextElem) by (auto simp: pre_between_def)
   qed
   define bs2 where "bs2 = [ram2] @ (between vs ram2 ram1) @ [ram1]"
   have rule2: "x \<in> set (ram2 # (between vs ram2 ram1)) \<Longrightarrow> is_sublist [x,y] bs2"
   proof -
     assume xin:"x \<in> set (ram2 # (between vs ram2 ram1))"
     with bs2_def have xin2: "x \<in> set bs2" by auto
     define cs1 where "cs1 = ram2 # snd (splitAt ram2 vs)"
     then have cs1ne: "cs1 \<noteq> []" by auto
     define cs2 where "cs2 = fst (splitAt ram1 vs)"
     define cs2ram1 where "cs2ram1 = cs2 @ [ram1]"
     from cs1_def cs2_def bs2_def p b have bs2: "bs2 = cs1 @ cs2 @ [ram1]" by (auto simp: pre_between_def)
     have "x \<in> set cs1 \<Longrightarrow> x \<noteq> last cs1 \<Longrightarrow> is_sublist [x,y] cs1"
     proof-
       assume xin2: "x \<in> set cs1" and xnlcs1: "x \<noteq> last cs1"
       from cs1_def p have "is_sublist cs1 vs" by (simp add: pre_between_def)
       with p is_nextElem xnlcs1  xin2 show ?thesis  apply (rule_tac is_sublist_is_nextElem) by (auto simp: pre_between_def)
     qed
     with bs2 have incs1nl: "x \<in> set cs1 \<Longrightarrow> x \<noteq> last cs1 \<Longrightarrow> is_sublist [x,y] bs2"
       apply (auto simp: is_sublist_def) apply (intro exI)
       apply (subgoal_tac "as @ x # y # bs @ cs2 @ [ram1] = as @ x # y # (bs @ cs2 @ [ram1])")
       apply assumption by auto
     have "x = last cs1 \<Longrightarrow> y = hd (cs2 @ [ram1])"
     proof -
       assume xl: "x = last cs1"
       from p have "distinct vs" by auto
       with p have "vs = fst (splitAt ram2 vs) @ ram2 # snd (splitAt ram2 vs)" by (auto intro: splitAt_ram)
       with cs1_def have "last vs = last (fst (splitAt ram2 vs) @ cs1)" by auto
       with cs1ne have "last vs = last cs1" by auto
       with xl have "x = last vs" by auto
       with p is_nextElem have yhd: "y = hd vs" by auto
       from p have "vs = fst (splitAt ram1 vs) @ ram1 # snd (splitAt ram1 vs)" by (auto intro: splitAt_ram)
       with yhd cs2ram1_def cs2_def have yhd2: "y = hd (cs2ram1 @ snd (splitAt ram1 vs))" by auto
       from cs2ram1_def have "cs2ram1 \<noteq> []" by auto
       then have "hd (cs2ram1 @ snd(splitAt ram1 vs)) = hd (cs2ram1)" by auto
       with yhd2 cs2ram1_def show ?thesis by auto
     qed
     with bs2 cs1ne have "x = last cs1 \<Longrightarrow> is_sublist [x,y] bs2"
       apply (auto simp: is_sublist_def) apply (intro exI)
       apply (subgoal_tac "cs1 @ cs2 @ [ram1] = butlast cs1 @ last cs1 # hd (cs2 @ [ram1]) # tl (cs2 @ [ram1])")
       apply assumption by auto
     with incs1nl have incs1: "x \<in> set cs1 \<Longrightarrow> is_sublist [x,y] bs2" by auto
     have "x \<in> set cs2 \<Longrightarrow> is_sublist [x,y] (cs2 @ [ram1])"
     proof-
       assume xin2': "x \<in> set cs2"
       then have xin2: "x \<in> set (cs2 @ [ram1])" by auto
       define fr2 where "fr2 = snd (splitAt ram1 vs)"
       from p have "vs = fst (splitAt ram1 vs) @ ram1 # snd (splitAt ram1 vs)" by (auto intro: splitAt_ram)
       with fr2_def cs2_def have "vs = cs2 @ [ram1] @ fr2" by simp
       with p xin2'  have "x \<noteq> ram1" by (auto simp: pre_between_def)
       then have  xnlcs2: "x \<noteq> last (cs2 @ [ram1])" by auto
       from cs2_def p have "is_sublist (cs2 @ [ram1]) vs" by (simp add: pre_between_def)
       with p is_nextElem xnlcs2  xin2 show ?thesis  apply (rule_tac is_sublist_is_nextElem) by (auto simp: pre_between_def)
     qed
     with bs2 have "x \<in> set cs2 \<Longrightarrow> is_sublist [x,y] bs2"
       apply (auto simp: is_sublist_def) apply (intro exI)
       apply (subgoal_tac "cs1 @ as @ x # y # bs = (cs1 @ as) @ x # y # bs")
       apply assumption by auto
     with p b cs1_def cs2_def incs1 xin show ?thesis by auto
   qed
   from is_nextElem have "x \<in> set vs" by auto
   with b p have "x = ram1 \<or> x \<in> set (between vs ram1 ram2) \<or> x = ram2 \<or> x \<in> set (between vs ram2 ram1)" by (rule_tac between_in) auto
   then have "x \<in> set (ram1 # (between vs ram1 ram2)) \<or> x \<in> set (ram2 # (between vs ram2 ram1))" by auto
   with rule1 rule2 bs_def bs2_def show ?thesis by auto
 qed
 
 
 lemma is_nextElem_or: "pre_between vs ram1 ram2 \<Longrightarrow> is_nextElem vs x y \<Longrightarrow>
   is_sublist [x,y] (ram1 # between vs ram1 ram2 @ [ram2]) \<or>  is_sublist [x,y] (ram2 # between vs ram2 ram1 @ [ram1])"
 proof (cases "before vs ram1 ram2")
   case True
   assume "pre_between vs ram1 ram2" "is_nextElem vs x y"
   with True show ?thesis by (rule_tac is_nextElem_or1)
 next
   assume p: "pre_between vs ram1 ram2" and is_nextElem: "is_nextElem vs x y"
   from p have p': "pre_between vs ram2 ram1" by (auto intro: pre_between_symI)
   case False with p have "before vs ram2 ram1" by auto
   with p' is_nextElem show ?thesis apply (drule_tac is_nextElem_or1) apply assumption+ by auto
 qed
 
 
 lemma(*<*) between_eq2: (*>*)
   "pre_between vs ram1 ram2 \<Longrightarrow>
   before vs ram2 ram1 \<Longrightarrow>
    \<exists>as bs cs. between vs ram1 ram2 = cs @ as \<and> vs = as @[ram2] @ bs @ [ram1] @ cs"
   apply (subgoal_tac "pre_between vs ram2 ram1")
   apply auto apply (intro exI conjI) apply simp  apply (simp add: pre_between_def) apply auto
   apply (frule_tac before_vs) apply auto by (auto simp: pre_between_def)
 
 lemma is_sublist_same_len[simp]:
  "length xs = length ys \<Longrightarrow> is_sublist xs ys = (xs = ys)"
 apply(cases xs)
  apply simp
 apply(rename_tac a as)
 apply(cases ys)
  apply simp
 apply(rename_tac b bs)
 apply(case_tac "a = b")
  apply(subst is_sublist_rec)
  apply simp
 apply simp
 done
 
 
 lemma is_nextElem_between_empty[simp]:
  "distinct vs \<Longrightarrow> is_nextElem vs a b \<Longrightarrow> between vs a b = []"
 apply (simp add: is_nextElem_def between_def split_def)
 apply (cases "vs") apply simp+
 apply (simp split: if_split_asm)
 apply (case_tac "b = aa")
  apply (simp add: is_sublist_def)
  apply (erule disjE)
   apply (elim exE)
   apply (case_tac "as")
    apply simp
   apply simp
  apply simp
  apply (case_tac "list" rule: rev_exhaust)
   apply simp
  apply simp
 apply simp
 apply (subgoal_tac "aa # list = vs")
  apply (thin_tac "vs = aa # list")
  apply simp
  apply (subgoal_tac "distinct vs")
   apply (simp add: is_sublist_def)
   apply (elim exE)
   by auto
 
 
 lemma is_nextElem_between_empty': "between vs a b = [] \<Longrightarrow> distinct vs \<Longrightarrow> a \<in> set vs \<Longrightarrow> b \<in> set vs  \<Longrightarrow>
   a \<noteq> b \<Longrightarrow> is_nextElem vs a b"
 apply (simp add: is_nextElem_def between_def split_def split: if_split_asm)
  apply (case_tac vs) apply simp
  apply simp
  apply (rule conjI)
   apply (rule impI)
   apply simp
  apply (case_tac "aa = b")
   apply simp
   apply (rule impI)
   apply (case_tac "list" rule: rev_exhaust)
    apply simp
   apply simp
   apply (case_tac "a = y") apply simp
   apply simp
   apply (elim conjE)
   apply (drule split_list_first)
   apply (elim exE)
   apply simp
  apply (rule impI)
  apply (subgoal_tac "b \<noteq> aa")
   apply simp
   apply (case_tac "a = aa")
    apply simp
    apply (case_tac "list") apply simp
    apply simp
    apply (case_tac "aaa = b") apply (simp add: is_sublist_def) apply force
    apply simp
   apply simp
   apply (drule split_list_first)
   apply (elim exE)
   apply simp
   apply (case_tac "zs") apply simp
   apply simp
   apply (case_tac "aaa = b")
    apply simp
    apply (simp add: is_sublist_def) apply force
   apply simp
  apply force
 apply (case_tac vs) apply simp
 apply simp
 apply (rule conjI)
  apply (rule impI) apply simp
 apply (rule impI)
 apply (case_tac "b = aa")
  apply simp
  apply (case_tac "list" rule: rev_exhaust) apply simp
  apply simp
  apply (case_tac "a = y") apply simp
  apply simp
  apply (drule split_list_first)
  apply (elim exE)
  apply simp
 apply simp apply (case_tac "a = aa") by auto
 
 
 lemma between_nextElem: "pre_between vs u v \<Longrightarrow>
  between vs u (nextElem vs (hd vs) v) = between vs u v @ [v]"
 apply(subgoal_tac "pre_between vs v u")
  prefer 2 apply (clarsimp simp add:pre_between_def)
 apply(case_tac "before vs u v")
 apply(drule (1) between_eq2)
  apply(clarsimp simp:pre_between_def hd_append split:list.split)
  apply(simp add:between_def split_def)
  apply(fastforce simp:neq_Nil_conv)
 apply (simp only:before_xor)
 apply(drule (1) between_eq2)
 apply(clarsimp simp:pre_between_def hd_append split:list.split)
 apply (simp add: append_eq_Cons_conv)
 apply(fastforce simp:between_def split_def)
 done
 
 
 
 (******************** section split_face ********************************)
 
 lemma nextVertices_in_face[simp]: "v \<in> \<V> f \<Longrightarrow> f\<^bsup>n\<^esup> \<bullet> v \<in> \<V> f"
 proof -
   assume v: "v \<in> \<V> f"
   then have f: "vertices f \<noteq> []" by auto
   show ?thesis apply (simp add: nextVertices_def)
     apply (induct n) by (auto simp: f v)
 qed
 
 
 
 subsubsection \<open>\<open>is_nextElem edges\<close> equivalence\<close>
 
 
 lemma is_nextElem_edges1: "distinct (vertices f) \<Longrightarrow> (a,b) \<in> edges (f::face) \<Longrightarrow> is_nextElem (vertices f) a b" apply (simp add: edges_face_def nextVertex_def) apply (rule is_nextElem1) by auto
 
 
 lemma is_nextElem_edges2:
  "distinct (vertices f) \<Longrightarrow> is_nextElem (vertices f) a b \<Longrightarrow>
  (a,b) \<in> edges (f::face)"
 apply (auto simp add: edges_face_def nextVertex_def)
 apply (rule sym)
 apply (rule is_nextElem2) by (auto  intro: is_nextElem_a)
 
 lemma is_nextElem_edges_eq[simp]:
  "distinct (vertices (f::face)) \<Longrightarrow>
  (a,b) \<in> edges f = is_nextElem (vertices f) a b"
 by (auto intro: is_nextElem_edges1 is_nextElem_edges2)
 
 
 
 (*********************** nextVertex *****************************)
 subsubsection \<open>@{const nextVertex}\<close>
 
 lemma nextElem_suc2: "distinct (vertices f) \<Longrightarrow> last (vertices f) = v \<Longrightarrow> v \<in> set (vertices f) \<Longrightarrow> f \<bullet> v = hd (vertices f)"
 proof -
   assume dist: "distinct (vertices f)" and last: "last (vertices f) = v" and v: "v \<in> set (vertices f)"
   define ls where "ls = vertices f"
   have ind: "\<And> c. distinct ls \<Longrightarrow> last ls = v \<Longrightarrow> v \<in> set ls \<Longrightarrow> nextElem ls c v = c"
   proof (induct ls)
     case Nil then show ?case by auto
   next
     case (Cons m ms)
     then show ?case
     proof (cases "m = v")
       case True with Cons have "ms = []"  apply (cases ms rule: rev_exhaust) by auto
       then show ?thesis by auto
     next
       case False with Cons have a1: "v \<in> set ms" by auto
       then have ms: "ms \<noteq> []" by auto
 
       with False Cons ms have "nextElem ms c v = c" apply (rule_tac Cons) by simp_all
       with False ms show ?thesis by simp
     qed
   qed
   from dist ls_def last v have "nextElem ls (hd ls) v = hd ls" apply (rule_tac ind) by auto
   with ls_def show ?thesis by (simp add: nextVertex_def)
 qed
 
 
 (*********************** split_face ****************************)
 subsection \<open>@{const split_face}\<close>
 
 
 definition pre_split_face :: "face \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> bool" where
 "pre_split_face oldF ram1 ram2 newVertexList \<equiv>
    distinct (vertices oldF) \<and> distinct (newVertexList)
   \<and> \<V> oldF \<inter> set newVertexList = {}
   \<and> ram1 \<in> \<V> oldF \<and> ram2 \<in> \<V> oldF \<and> ram1 \<noteq> ram2"
 
 declare pre_split_face_def [simp]
 
 
 lemma pre_split_face_p_between[intro]:
   "pre_split_face oldF ram1 ram2 newVertexList \<Longrightarrow> pre_between (vertices oldF) ram1 ram2"  by (simp add: pre_between_def)
 
 lemma pre_split_face_symI:
   "pre_split_face oldF ram1 ram2 newVertexList \<Longrightarrow> pre_split_face oldF ram2 ram1 newVertexList" by auto
 
 
 lemma pre_split_face_rev[intro]:
   "pre_split_face oldF ram1 ram2 newVertexList \<Longrightarrow> pre_split_face oldF ram1 ram2 (rev newVertexList)" by auto
 
 lemma split_face_distinct1:
   "(f12, f21) = split_face oldF ram1 ram2 newVertexList \<Longrightarrow> pre_split_face oldF ram1 ram2 newVertexList \<Longrightarrow>
     distinct (vertices f12)"
 proof -
   assume split: "(f12, f21) = split_face oldF ram1 ram2 newVertexList" and p: "pre_split_face oldF ram1 ram2 newVertexList"
   define old_vs where "old_vs = vertices oldF"
   with p have d_old_vs: "distinct old_vs" by auto
   from p have p2: "pre_between (vertices oldF) ram1 ram2" by auto
   have rule1: "before old_vs ram1 ram2 \<Longrightarrow> distinct (vertices f12)"
   proof -
     assume b: "before old_vs ram1 ram2"
     with split p have "f12 = Face (rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) Nonfinal" by (simp add: split_face_def)
     then have h1:"vertices f12 = rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]" by auto
     from p have d1: "distinct(ram1 # between (vertices oldF) ram1 ram2 @ [ram2])" by (auto del: notI)
     from b p p2 old_vs_def have d2: "set (ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) \<inter> set newVertexList = {}"
       by (auto dest!: splitAt_in_fst splitAt_in_snd)
     with h1 d1 p show ?thesis by auto
   qed
   have rule2: "before old_vs ram2 ram1 \<Longrightarrow> distinct (vertices f12)"
   proof -
     assume b: "before old_vs ram2 ram1"
     from p have p3: "pre_split_face oldF ram1 ram2 newVertexList"
        by (auto intro: pre_split_face_symI)
     then have p4: "pre_between (vertices oldF) ram2 ram1" by auto
     with split p have
      "f12 = Face (rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) Nonfinal"
       by (simp add: split_face_def)
     then have h1:"vertices f12 = rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]"
       by auto
     from p3 have d1: "distinct(ram1 # between (vertices oldF) ram1 ram2 @ [ram2])"
     by (auto del: notI)
     from b p3 p4 old_vs_def
     have d2: "set (ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) \<inter> set newVertexList = {}"
       by auto
     with h1 d1 p show ?thesis by auto
   qed
   from p2 rule1 rule2 old_vs_def show ?thesis by auto
 qed
 
 lemma split_face_distinct1'[intro]:
   "pre_split_face oldF ram1 ram2 newVertexList \<Longrightarrow>
     distinct (vertices (fst(split_face oldF ram1 ram2 newVertexList)))"
 apply (rule_tac split_face_distinct1)
   by (auto simp del: pre_split_face_def simp: split_face_def)
 
 lemma split_face_distinct2:
   "(f12, f21) = split_face oldF ram1 ram2 newVertexList \<Longrightarrow>
    pre_split_face oldF ram1 ram2 newVertexList \<Longrightarrow> distinct (vertices f21)"
 proof -
   assume split: "(f12, f21) = split_face oldF ram1 ram2 newVertexList"
     and p: "pre_split_face oldF ram1 ram2 newVertexList"
   define old_vs where "old_vs = vertices oldF"
   with p have d_old_vs: "distinct old_vs" by auto
   with p have p1: "pre_split_face oldF ram1 ram2 newVertexList" by auto
   from p have p2: "pre_between (vertices oldF) ram1 ram2" by auto
   have rule1: "before old_vs ram1 ram2 \<Longrightarrow> distinct (vertices f21)"
   proof -
     assume b: "before old_vs ram1 ram2"
     with split p
     have "f21 = Face (ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList) Nonfinal"
       by (simp add: split_face_def)
     then have h1:"vertices f21 = ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList"
       by auto
     from p have d1: "distinct(ram1 # between (vertices oldF) ram2 ram1 @ [ram2])"
        by (auto del: notI)
     from b p1 p2 old_vs_def
     have d2: "set (ram2 # between (vertices oldF) ram2 ram1 @ [ram1]) \<inter> set newVertexList = {}"
       by auto
     with h1 d1 p1 show ?thesis by auto
   qed
   have rule2: "before old_vs ram2 ram1 \<Longrightarrow> distinct (vertices f21)"
   proof -
     assume b: "before old_vs ram2 ram1"
     from p have p3: "pre_split_face oldF ram1 ram2 newVertexList"
       by (auto intro: pre_split_face_symI)
     then have p4: "pre_between (vertices oldF) ram2 ram1" by auto
     with split p
     have "f21 = Face (ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList) Nonfinal"
       by (simp add: split_face_def)
     then have h1:"vertices f21 = ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList"
       by auto
     from p3 have d1: "distinct(ram2 # between (vertices oldF) ram2 ram1 @ [ram1])"
       by (auto del: notI)
     from b p3 p4 old_vs_def
     have d2: "set (ram2 # between (vertices oldF) ram2 ram1 @ [ram1]) \<inter> set newVertexList = {}"
       by auto
     with h1 d1 p1 show ?thesis by auto
   qed
   from p2 rule1 rule2 old_vs_def show ?thesis by auto
 qed
 
 lemma split_face_distinct2'[intro]:
   "pre_split_face oldF ram1 ram2 newVertexList \<Longrightarrow> distinct (vertices (snd(split_face oldF ram1 ram2 newVertexList)))"
 apply (rule_tac split_face_distinct2) by (auto simp del: pre_split_face_def simp: split_face_def)
 
 
 declare pre_split_face_def [simp del]
 
 lemma split_face_edges_or: "(f12, f21) = split_face oldF ram1 ram2 newVertexList \<Longrightarrow> pre_split_face oldF ram1 ram2 newVertexList \<Longrightarrow> (a, b) \<in> edges oldF \<Longrightarrow> (a,b) \<in> edges f12 \<or> (a,b) \<in> edges f21"
 proof -
   assume nf: "(f12, f21) = split_face oldF ram1 ram2 newVertexList" and p: "pre_split_face oldF ram1 ram2 newVertexList" and old:"(a, b) \<in> edges oldF"
   from p have d1:"distinct (vertices oldF)" by auto
   from nf p have d2: "distinct (vertices f12)" by (auto dest: pairD)
   from nf p have d3: "distinct (vertices f21)" by (auto dest: pairD)
   from p have p': "pre_between (vertices oldF) ram1 ram2" by auto
   from old d1 have is_nextElem: "is_nextElem (vertices oldF) a b" by simp
   with p have "is_sublist [a,b] (ram1 # (between (vertices oldF) ram1 ram2) @ [ram2]) \<or> is_sublist [a,b] (ram2 # (between (vertices oldF) ram2 ram1) @ [ram1])" apply (rule_tac is_nextElem_or) by auto
   then have "is_nextElem (rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) a b
     \<or> is_nextElem (ram2 # between (vertices oldF) ram2 ram1 @ ram1 # newVertexList) a b"
   proof (cases "is_sublist [a,b] (ram1 # (between (vertices oldF) ram1 ram2) @ [ram2])")
     case True then show ?thesis by (auto dest: is_sublist_add intro!: is_nextElem_sublistI)
   next
     case False
     assume "is_sublist [a,b] (ram1 # (between (vertices oldF) ram1 ram2) @ [ram2])
       \<or> is_sublist [a,b] (ram2 # (between (vertices oldF) ram2 ram1) @ [ram1])"
     with False have "is_sublist [a,b] (ram2 # (between (vertices oldF) ram2 ram1) @ [ram1])" by auto
     then show ?thesis apply (rule_tac disjI2) apply (rule_tac is_nextElem_sublistI)
       apply (subgoal_tac "is_sublist [a, b] ([] @ (ram2 # between (vertices oldF) ram2 ram1 @ [ram1]) @ newVertexList)") apply force by (frule is_sublist_add)
   qed
   with nf d1 d2 d3 show ?thesis by (simp add: split_face_def)
 qed
 
 
 subsection \<open>\<open>verticesFrom\<close>\<close>
 
 definition verticesFrom :: "face \<Rightarrow> vertex \<Rightarrow> vertex list" where
  "verticesFrom f \<equiv> rotate_to (vertices f)"
 
 lemmas verticesFrom_Def = verticesFrom_def rotate_to_def
 
 lemma len_vFrom[simp]:
  "v \<in> \<V> f \<Longrightarrow> |verticesFrom f v| = |vertices f|"
 apply(drule split_list_first)
 apply(clarsimp simp: verticesFrom_Def)
 done
 
 lemma verticesFrom_empty[simp]:
  "v \<in> \<V> f \<Longrightarrow> (verticesFrom f v = []) = (vertices f = [])"
 by(clarsimp simp: verticesFrom_Def)
 
 lemma verticesFrom_congs:
  "v \<in> \<V> f \<Longrightarrow> (vertices f) \<cong> (verticesFrom f v)"
 by(simp add:verticesFrom_def cong_rotate_to)
 
 lemma verticesFrom_eq_if_vertices_cong:
   "\<lbrakk>distinct(vertices f); distinct(vertices f'); 
     vertices f \<cong> vertices f'; x \<in> \<V> f \<rbrakk> \<Longrightarrow>
    verticesFrom f x = verticesFrom f' x"
 by(clarsimp simp:congs_def verticesFrom_Def splitAt_rotate_pair_conv)
 
 
 lemma verticesFrom_in[intro]: "v \<in> \<V> f \<Longrightarrow> a \<in> \<V> f \<Longrightarrow> a \<in> set (verticesFrom f v)"
 by (auto dest: verticesFrom_congs congs_pres_nodes)
 
 lemma verticesFrom_in': "a \<in> set (verticesFrom f v) \<Longrightarrow> a \<noteq> v \<Longrightarrow> a \<in> \<V> f"
   apply (cases "v \<in> \<V> f") apply (auto dest: verticesFrom_congs congs_pres_nodes)
   by (simp add: verticesFrom_Def)
 
 lemma set_verticesFrom:
  "v \<in> \<V> f \<Longrightarrow> set (verticesFrom f v) = \<V> f"
 apply(auto)
 apply (auto simp add: verticesFrom_Def)
 done
 
 lemma verticesFrom_hd: "hd (verticesFrom f v) = v" by (simp add: verticesFrom_Def)
 
 lemma verticesFrom_distinct[simp]: "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow> distinct (verticesFrom f v)" apply (frule_tac verticesFrom_congs) by (auto simp: congs_distinct)
 
 lemma verticesFrom_nextElem_eq:
  "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow> u \<in> \<V> f \<Longrightarrow>
  nextElem (verticesFrom f v) (hd (verticesFrom f v)) u
  = nextElem (vertices f) (hd (vertices f)) u" apply (subgoal_tac "(verticesFrom f v) \<cong> (vertices f)")
  apply (rule nextElem_congs_eq) apply (auto simp: verticesFrom_congs congs_pres_nodes) apply (rule congs_sym)
  by (simp add: verticesFrom_congs)
 
 lemma nextElem_vFrom_suc1: "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow> i < length (vertices f) \<Longrightarrow> last (verticesFrom f v) \<noteq> u \<Longrightarrow> (verticesFrom f v)!i = u \<Longrightarrow> f \<bullet> u = (verticesFrom f v)!(Suc i)"
 proof -
   assume dist: "distinct (vertices f)" and ith: "(verticesFrom f v)!i = u" and small_i: "i < length (vertices f)" and notlast: "last (verticesFrom f v) \<noteq> u" and v: "v \<in> \<V> f"
   hence eq: "(vertices f) \<cong> (verticesFrom f v)" by (auto simp: verticesFrom_congs)
   from ith eq small_i have "u \<in> set (verticesFrom f v)" by (auto simp: congs_length)
   with eq have u: "u \<in> \<V> f" by (auto simp: congs_pres_nodes)
   define ls where "ls = verticesFrom f v"
   with dist ith have "ls!i = u" by auto
   have ind: "\<And> c i. i < length ls \<Longrightarrow> distinct ls \<Longrightarrow> last ls \<noteq> u \<Longrightarrow> ls!i = u \<Longrightarrow> u \<in> set ls \<Longrightarrow>
      nextElem ls c u = ls ! Suc i"
   proof (induct ls)
     case Nil then show ?case by auto
   next
     case (Cons m ms)
     then show ?case
     proof (cases "m = u")
       case True with Cons have "u \<notin> set ms" by auto
       with Cons True have i: "i = 0" apply (induct i) by auto
       with Cons show ?thesis  apply (simp split: if_split_asm) apply (cases ms) by simp_all
     next
       case False with Cons have a1: "u \<in> set ms" by auto
       then have ms: "ms \<noteq> []" by auto
       from False Cons have i: "0 < i" by auto
       define i' where "i' = i - 1"
       with i have i': "i = Suc i'" by auto
       with False Cons i' ms have "nextElem ms c u = ms ! Suc i'" apply (rule_tac Cons) by simp_all
       with False Cons i' ms show ?thesis by simp
     qed
   qed
   from eq dist ith ls_def small_i notlast v
   have "nextElem ls (hd ls) u = ls ! Suc i"
     apply (rule_tac ind) by (auto simp: congs_length)
   with dist u v ls_def show ?thesis by (simp add: nextVertex_def verticesFrom_nextElem_eq)
 qed
 
 lemma verticesFrom_nth: "distinct (vertices f) \<Longrightarrow> d < length (vertices f) \<Longrightarrow>
   v \<in> \<V> f \<Longrightarrow> (verticesFrom f v)!d = f\<^bsup>d\<^esup> \<bullet> v"
 proof (induct d)
   case 0 then show ?case by (simp add: verticesFrom_Def nextVertices_def)
 next
   case (Suc n)
   then have dist2: "distinct (verticesFrom f v)"
      apply (frule_tac verticesFrom_congs) by (auto simp: congs_distinct)
   from Suc have in2: "v \<in> set (verticesFrom f v)"
      apply (frule_tac verticesFrom_congs) by (auto dest: congs_pres_nodes)
   then have vFrom: "(verticesFrom f v) = butlast (verticesFrom f v) @ [last (verticesFrom f v)]"
     apply (cases "(verticesFrom f v)" rule: rev_exhaust) by auto
   from Suc show ?case
   proof (cases "last (verticesFrom f v) = f\<^bsup>n\<^esup> \<bullet> v")
     case True with Suc have "verticesFrom f v ! n = f\<^bsup>n\<^esup> \<bullet> v" by (rule_tac Suc) auto
     with True have "last (verticesFrom f v) = verticesFrom f v ! n" by auto
     with Suc dist2 in2 have "Suc n = length (verticesFrom f v)"
       apply (rule_tac nth_last_Suc_n) by auto
     with Suc show ?thesis by auto
   next
     case False with Suc show ?thesis apply (simp add: nextVertices_def) apply (rule sym)
     apply (rule_tac nextElem_vFrom_suc1) by simp_all
   qed
 qed
 
 
 lemma verticesFrom_length: "distinct (vertices f) \<Longrightarrow> v \<in> set (vertices f) \<Longrightarrow>
   length (verticesFrom f v) = length (vertices f)"
 by (auto intro: congs_length verticesFrom_congs)
 
 lemma verticesFrom_between: "v' \<in> \<V> f \<Longrightarrow> pre_between (vertices f) u v \<Longrightarrow>
   between (vertices f) u v = between (verticesFrom f v') u v"
 by (auto intro!: between_congs verticesFrom_congs)
 
 
 lemma verticesFrom_is_nextElem: "v \<in> \<V> f \<Longrightarrow>
    is_nextElem (vertices f) a b = is_nextElem (verticesFrom f v) a b"
     apply (rule is_nextElem_congs_eq) by (rule verticesFrom_congs)
 
 lemma verticesFrom_is_nextElem_last: "v' \<in> \<V> f \<Longrightarrow> distinct (vertices f)
   \<Longrightarrow> is_nextElem (verticesFrom f v') (last (verticesFrom f v')) v  \<Longrightarrow> v = v'"
 apply (subgoal_tac "distinct (verticesFrom f v')")
 apply (subgoal_tac "last (verticesFrom f v') \<in> set (verticesFrom f v')")
 apply (simp add: nextElem_is_nextElem)
 apply (simp add: verticesFrom_hd)
 apply (cases "(verticesFrom f v')" rule: rev_exhaust) apply (simp add: verticesFrom_Def)
 by auto
 
 lemma  verticesFrom_is_nextElem_hd: "v' \<in> \<V> f \<Longrightarrow> distinct (vertices f)
   \<Longrightarrow> is_nextElem (verticesFrom f v') u v' \<Longrightarrow> u = last (verticesFrom f v')"
 apply (subgoal_tac "distinct (verticesFrom f v')")
 apply (thin_tac "distinct (vertices f)") apply (auto simp: is_nextElem_def)
 apply (drule is_sublist_y_hd) apply (simp add: verticesFrom_hd)
 by auto
 
 lemma verticesFrom_pres_nodes1: "v \<in> \<V> f \<Longrightarrow> \<V> f = set(verticesFrom f v)"
 proof -
   assume "v \<in> \<V> f"
   then have "fst (splitAt v (vertices f)) @ [v] @ snd (splitAt v (vertices f)) = vertices f"
     apply (drule_tac splitAt_ram) by simp
   moreover have "set (fst (splitAt v (vertices f)) @ [v] @ snd (splitAt v (vertices f))) = set (verticesFrom f v)"
     by (auto simp: verticesFrom_Def)
   ultimately show ?thesis by simp
 qed
 
 lemma verticesFrom_pres_nodes: "v \<in> \<V> f \<Longrightarrow> w \<in> \<V> f \<Longrightarrow> w \<in> set (verticesFrom f v)"
 by (auto dest: verticesFrom_pres_nodes1)
 
 
 lemma before_verticesFrom: "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow> w \<in> \<V> f \<Longrightarrow>
   v \<noteq> w \<Longrightarrow> before (verticesFrom f v) v w"
 proof -
   assume v: "v \<in> \<V> f" and w: "w \<in> \<V> f" and neq: "v \<noteq> w"
   have "hd (verticesFrom f v) = v" by (rule verticesFrom_hd)
   with v have vf:"verticesFrom f v = v # tl (verticesFrom f v)"
     apply (frule_tac verticesFrom_pres_nodes1)
     apply (cases "verticesFrom f v") by auto
   moreover with v w have "w \<in> set (verticesFrom f v)" by (auto simp: verticesFrom_pres_nodes)
   ultimately have "w \<in> set (v # tl (verticesFrom f v))" by auto
   with neq have "w \<in> set (tl (verticesFrom f v))" by auto
   with vf have "verticesFrom f v =
     [] @ v # fst (splitAt w (tl (verticesFrom f v))) @ w # snd (splitAt w (tl (verticesFrom f v)))"
     by (auto dest: splitAt_ram)
   then show ?thesis apply (unfold before_def) by (intro exI)
 qed
 
 lemma last_vFrom:
  "\<lbrakk> distinct(vertices f); x \<in> \<V> f \<rbrakk> \<Longrightarrow> last(verticesFrom f x) = f\<^bsup>-1\<^esup> \<bullet> x"
 apply(frule split_list)
 apply(clarsimp simp:prevVertex_def verticesFrom_Def split:list.split)
 done
 
 
 lemma rotate_before_vFrom:
   "\<lbrakk> distinct(vertices f); r \<in> \<V> f; r\<noteq>u \<rbrakk> \<Longrightarrow>
    before (verticesFrom f r) u v \<Longrightarrow> before (verticesFrom f v) r u"
 using [[linarith_neq_limit = 1]]
 apply(frule split_list)
 apply(clarsimp simp:verticesFrom_Def)
 apply(rename_tac as bs)
 apply(clarsimp simp:before_def)
 apply(rename_tac xs ys zs)
 apply(subst (asm) Cons_eq_append_conv)
 apply clarsimp
 apply(rename_tac bs')
 apply(subst (asm) append_eq_append_conv2)
 apply clarsimp
 apply(rename_tac as')
 apply(erule disjE)
  defer
  apply clarsimp
  apply(rule_tac x = "v#zs" in exI)
  apply(rule_tac x = "bs@as'" in exI)
  apply simp
 apply clarsimp
 apply(subst (asm) append_eq_Cons_conv)
 apply(erule disjE)
 apply clarsimp
 apply(rule_tac x = "v#zs" in exI)
 apply simp apply blast
 apply clarsimp
 apply(rename_tac ys')
 apply(subst (asm) append_eq_append_conv2)
 apply clarsimp
 apply(rename_tac vs')
 apply(erule disjE)
  apply clarsimp
  apply(subst (asm) append_eq_Cons_conv)
  apply(erule disjE)
   apply clarsimp
   apply(rule_tac x = "v#zs" in exI)
   apply simp apply blast
  apply clarsimp
  apply(rule_tac x = "v#ys'@as" in exI)
  apply simp apply blast
 apply clarsimp
 apply(rule_tac x = "v#zs" in exI)
 apply simp apply blast
 done
 
 lemma before_between:
  "\<lbrakk> before(verticesFrom f x) y z; distinct(vertices f); x \<in> \<V> f; x \<noteq> y \<rbrakk> \<Longrightarrow>
   y \<in> set(between (vertices f) x z)"
 apply(induct f)
 apply(clarsimp simp:verticesFrom_Def before_def)
 apply(frule split_list)
 apply(clarsimp simp:Cons_eq_append_conv)
 apply(subst (asm) append_eq_append_conv2)
 apply clarsimp
 apply(erule disjE)
  apply(clarsimp simp:append_eq_Cons_conv)
  prefer 2 apply(clarsimp simp add:between_def split_def)
 apply(erule disjE)
  apply (clarsimp simp:between_def split_def)
 apply clarsimp
 apply(subst (asm) append_eq_append_conv2)
 apply clarsimp
 apply(erule disjE)
  prefer 2 apply(clarsimp simp add:between_def split_def)
 apply(clarsimp simp:append_eq_Cons_conv)
 apply(fastforce simp:between_def split_def)
 done
 
 lemma before_between2:
  "\<lbrakk> before (verticesFrom f u) v w; distinct(vertices f); u \<in> \<V> f \<rbrakk>
   \<Longrightarrow> u = v \<or> u \<in> set (between (vertices f) w v)"
 apply(subgoal_tac "pre_between (vertices f) v w")
  apply(subst verticesFrom_between)
    apply assumption
   apply(erule pre_between_symI)
  apply(frule pre_between_r1)
  apply(drule (1) verticesFrom_distinct)
  using verticesFrom_hd[of f u]
  apply(clarsimp simp add:before_def between_def split_def hd_append
                 split:if_split_asm)
 apply(frule (1) verticesFrom_distinct)
 apply(clarsimp simp:pre_between_def before_def simp del:verticesFrom_distinct)
 apply(rule conjI)
  apply(cases "v = u")
   apply simp
  apply(rule verticesFrom_in'[of v f u])apply simp apply assumption
 apply(cases "w = u")
  apply simp
 apply(rule verticesFrom_in'[of w f u])apply simp apply assumption
 done
 
 
 (************************** splitFace ********************************)
 
 
 subsection \<open>@{const splitFace}\<close>
 
 
 definition pre_splitFace :: "graph \<Rightarrow> vertex \<Rightarrow> vertex \<Rightarrow> face \<Rightarrow> vertex list \<Rightarrow> bool" where
   "pre_splitFace g ram1 ram2 oldF nvs \<equiv>
   oldF \<in> \<F> g \<and> \<not> final oldF \<and> distinct (vertices oldF) \<and> distinct nvs
   \<and> \<V> g \<inter> set nvs = {}
   \<and> \<V> oldF \<inter> set nvs = {}
   \<and> ram1 \<in> \<V> oldF \<and> ram2 \<in> \<V> oldF
   \<and> ram1 \<noteq> ram2
   \<and> (((ram1,ram2) \<notin> edges oldF \<and> (ram2,ram1) \<notin> edges oldF
      \<and> (ram1, ram2) \<notin> edges g \<and> (ram2, ram1) \<notin> edges g) \<or> nvs \<noteq> [])"
 
 declare pre_splitFace_def [simp]
 
 lemma pre_splitFace_pre_split_face[simp]:
   "pre_splitFace g ram1 ram2 oldF nvs \<Longrightarrow> pre_split_face oldF ram1 ram2 nvs"
  by (simp add: pre_splitFace_def pre_split_face_def)
 
 lemma pre_splitFace_oldF[simp]:
   "pre_splitFace g ram1 ram2 oldF nvs \<Longrightarrow> oldF \<in> \<F> g"
   apply (unfold pre_splitFace_def) by force
 
 declare pre_splitFace_def [simp del]
 
 lemma splitFace_split_face:
      "oldF \<in> \<F> g \<Longrightarrow>
      (f\<^sub>1, f\<^sub>2, newGraph) = splitFace g ram\<^sub>1 ram\<^sub>2 oldF newVs \<Longrightarrow>
      (f\<^sub>1, f\<^sub>2) = split_face oldF ram\<^sub>1 ram\<^sub>2 newVs"
   by (simp add: splitFace_def split_def)
 
 
 (* split_face *)
 lemma split_face_empty_ram2_ram1_in_f12:
   "pre_split_face oldF ram1 ram2 [] \<Longrightarrow>
   (f12, f21) = split_face oldF ram1 ram2 [] \<Longrightarrow> (ram2, ram1) \<in> edges f12"
 proof -
   assume split: "(f12, f21) = split_face oldF ram1 ram2 []"
   "pre_split_face oldF ram1 ram2 []"
   then have "ram2 \<in> \<V> f12" by (simp add: split_face_def)
   moreover with split have "f12 \<bullet> ram2 = hd (vertices f12)"
    apply (rule_tac nextElem_suc2)
    apply (simp add: pre_split_face_def split_face_distinct1)
    by (simp add: split_face_def)
   with split have "ram1 = f12 \<bullet> ram2"
    by (simp add: split_face_def)
   ultimately show ?thesis by (simp add: edges_face_def)
 qed
 
 lemma split_face_empty_ram2_ram1_in_f12':
   "pre_split_face oldF ram1 ram2 [] \<Longrightarrow>
   (ram2, ram1) \<in> edges (fst (split_face oldF ram1 ram2 []))"
 proof -
   assume split: "pre_split_face oldF ram1 ram2 []"
   define f12 where "f12 = fst (split_face oldF ram1 ram2 [])"
   define f21 where "f21 = snd (split_face oldF ram1 ram2 [])"
   then have "(f12, f21) = split_face oldF ram1 ram2 []" by (simp add: f12_def f21_def)
   with split have "(ram2, ram1) \<in> edges f12"
     by (rule split_face_empty_ram2_ram1_in_f12)
   with f12_def show ?thesis by simp
 qed
 
 lemma splitFace_empty_ram2_ram1_in_f12:
   "pre_splitFace g ram1 ram2 oldF [] \<Longrightarrow>
   (f12, f21, newGraph) = splitFace g ram1 ram2 oldF [] \<Longrightarrow>
   (ram2, ram1) \<in> edges f12"
 proof -
   assume pre: "pre_splitFace g ram1 ram2 oldF []"
   then have oldF: "oldF \<in> \<F> g" by (unfold pre_splitFace_def) simp
   assume sp: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF []"
   with oldF have "(f12, f21) = split_face oldF ram1 ram2 []"
     by (rule splitFace_split_face)
 
   with pre sp show ?thesis
   apply (unfold  splitFace_def pre_splitFace_def)
   apply (simp add: split_def)
   apply (rule split_face_empty_ram2_ram1_in_f12')
   apply (rule pre_splitFace_pre_split_face)
   apply (rule pre)
   done
 qed
 
 lemma splitFace_f12_new_vertices:
   "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs \<Longrightarrow>
   v \<in> set  newVs \<Longrightarrow> v \<in> \<V> f12"
   apply (unfold splitFace_def)
   apply (simp add: split_def)
   apply (unfold split_face_def Let_def)
   by simp
 
 
 lemma splitFace_add_vertices_direct[simp]:
 "vertices (snd (snd (splitFace g ram1 ram2 oldF [countVertices g ..< countVertices g + n])))
   = vertices g @ [countVertices g ..< countVertices g + n]"
   apply (auto simp: splitFace_def split_def) apply (cases g)
   apply auto  apply (induct n) by auto
 
 lemma splitFace_delete_oldF:
 " (f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVertexList \<Longrightarrow>
  oldF \<noteq> f12 \<Longrightarrow> oldF \<noteq> f21 \<Longrightarrow> distinct (faces g) \<Longrightarrow>
  oldF \<notin> \<F> newGraph"
 by (simp add: splitFace_def split_def distinct_set_replace)
 
 lemma splitFace_faces_1:
 "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVertexList \<Longrightarrow>
 oldF \<in> \<F> g \<Longrightarrow>
 set (faces newGraph) \<union> {oldF} = {f12, f21} \<union> set (faces g)"
 (is "?oldF \<Longrightarrow> ?C \<Longrightarrow> ?A = ?B")
 proof (intro equalityI subsetI)
   fix x
   assume "x \<in> ?A" and "?C" and "?oldF"
   then show "x \<in> ?B" apply (simp add: splitFace_def split_def) by (auto dest: replace1)
 next
   fix x
   assume "x \<in> ?B" and "?C" and "?oldF"
   then show "x \<in> ?A" apply (simp add: splitFace_def split_def)
     apply (cases "x = oldF") apply simp_all
     apply (cases "x = f12")  apply simp_all
     apply (cases "x = f21")  by (auto intro: replace3 replace4)
 qed
 
 
 lemma splitFace_distinct1[intro]:"pre_splitFace g ram1 ram2 oldF newVertexList \<Longrightarrow>
   distinct (vertices (fst (snd (splitFace g ram1 ram2 oldF newVertexList))))"
   apply (unfold  splitFace_def split_def)
   by (auto simp add: split_def)
 
 lemma splitFace_distinct2[intro]:"pre_splitFace g ram1 ram2 oldF newVertexList \<Longrightarrow>
   distinct (vertices (fst (splitFace g ram1 ram2 oldF newVertexList)))"
   apply (unfold  splitFace_def split_def)
   by (auto simp add: split_def)
 
 
 lemma splitFace_add_f21': "f' \<in> \<F> g' \<Longrightarrow> fst (snd (splitFace g' v a f' nvl))
            \<in> \<F> (snd (snd (splitFace g' v a f' nvl)))"
 apply (simp add: splitFace_def split_def) apply (rule disjI2)
 apply (rule replace3) by simp_all
 
 lemma split_face_help[simp]: "Suc 0 < |vertices (fst (split_face f' v a nvl))|"
   by (simp add: split_face_def)
 
 lemma split_face_help'[simp]: "Suc 0 < |vertices (snd (split_face f' v a nvl))|"
  by (simp add: split_face_def)
 
 lemma splitFace_split: "f \<in> \<F> (snd (snd (splitFace g v a f' nvl))) \<Longrightarrow>
   f \<in> \<F> g
   \<or>  f = fst (splitFace g v a f' nvl)
   \<or>  f = (fst (snd (splitFace g v a f' nvl)))"
  apply (simp add: splitFace_def split_def)
  apply safe by (frule replace5)  simp
 
 lemma pre_FaceDiv_between1: "pre_splitFace g' ram1 ram2 f [] \<Longrightarrow>
   \<not> between (vertices f) ram1 ram2 = []"
 proof -
   assume pre_f: "pre_splitFace g' ram1 ram2 f []"
   then have pre_bet: "pre_between (vertices f) ram1 ram2" apply (unfold pre_splitFace_def)
     by (simp add: pre_between_def)
   then have pre_bet': "pre_between (verticesFrom f ram1) ram1 ram2"
     by (simp add: pre_between_def set_verticesFrom)
   from pre_f have dist': "distinct (verticesFrom f ram1)" apply (unfold pre_splitFace_def) by simp
   from pre_f have ram2: "ram2 \<in> \<V> f" apply (unfold pre_splitFace_def) by simp
   from pre_f have "\<not> is_nextElem (vertices f) ram1 ram2" apply (unfold pre_splitFace_def) by auto
   with pre_f have "\<not> is_nextElem (verticesFrom f ram1) ram1 ram2" apply (unfold pre_splitFace_def)
     by (simp add: verticesFrom_is_nextElem [symmetric])
   moreover
   from pre_f have "ram2 \<in> set (verticesFrom f ram1)" apply (unfold pre_splitFace_def) by auto
   moreover
   from pre_f have "ram2 \<noteq>  ram1" apply (unfold pre_splitFace_def) by auto
   ultimately have ram2_not: "ram2 \<noteq>  hd (snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))"
     apply (simp add: is_nextElem_def verticesFrom_Def)
     apply (cases "snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f))")
     apply simp apply simp
     apply (simp add: is_sublist_def) by auto
 
 
   from pre_f have before: "before (verticesFrom f ram1) ram1 ram2" apply (unfold pre_splitFace_def)
     apply safe apply (rule before_verticesFrom) by auto
   have "fst (splitAt ram2 (snd (splitAt ram1 (verticesFrom f ram1)))) = [] \<Longrightarrow> False"
   proof -
     assume  "fst (splitAt ram2 (snd (splitAt ram1 (verticesFrom f ram1)))) = []"
     moreover
     from ram2 pre_f have "ram2 \<in> set (verticesFrom f ram1)"apply (unfold pre_splitFace_def)
       by auto
     with pre_f have "ram2 \<in> set (snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))"
       apply (simp add: verticesFrom_Def)
       apply (unfold pre_splitFace_def)  by auto
     moreover
     note dist'
     ultimately  have "ram2 = hd (snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))"
       apply (rule_tac ccontr)
       apply (cases "(snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))")
       apply simp
       apply simp
       by (simp add: verticesFrom_Def del: distinct_append)
     with ram2_not show ?thesis by auto
   qed
   with before pre_bet' have  "between (verticesFrom f ram1) ram1 ram2 \<noteq>  []" by auto
   with pre_f pre_bet show ?thesis apply (unfold pre_splitFace_def) apply safe
   by (simp add: verticesFrom_between)
 qed
 
 lemma pre_FaceDiv_between2: "pre_splitFace g' ram1 ram2 f [] \<Longrightarrow>
   \<not> between (vertices f) ram2 ram1 = []"
 proof -
   assume pre_f: "pre_splitFace g' ram1 ram2 f []"
   then have "pre_splitFace g' ram2 ram1 f []" apply (unfold pre_splitFace_def) by auto
   then show ?thesis by (rule pre_FaceDiv_between1)
 qed
 
 
 (********************** Edges *******************)
 
 definition Edges :: "vertex list \<Rightarrow> (vertex \<times> vertex) set" where
 "Edges vs \<equiv> {(a,b). is_sublist [a,b] vs}"
 
 lemma Edges_Nil[simp]: "Edges [] = {}"
 by(simp add:Edges_def is_sublist_def)
 
 lemma Edges_rev:
  "Edges (rev (zs::vertex list)) = {(b,a). (a,b) \<in> Edges zs}"
   by (auto simp add: Edges_def is_sublist_rev)
 
 lemma in_Edges_rev[simp]:
  "((a,b) : Edges (rev (zs::vertex list))) = ((b,a) \<in> Edges zs)"
 by (simp add: Edges_rev)
 
 lemma notinset_notinEdge1: "x \<notin> set xs \<Longrightarrow> (x,y) \<notin> Edges xs"
 by(unfold Edges_def)(blast intro:is_sublist_in)
 
 lemma notinset_notinEdge2: "y \<notin> set xs \<Longrightarrow> (x,y) \<notin> Edges xs"
 by(unfold Edges_def)(blast intro:is_sublist_in1)
 
 lemma in_Edges_in_set: "(x,y) : Edges vs \<Longrightarrow> x \<in> set vs \<and> y \<in> set vs"
 by(unfold Edges_def)(blast intro:is_sublist_in is_sublist_in1)
 
 
 lemma edges_conv_Edges:
   "distinct(vertices(f::face)) \<Longrightarrow> \<E> f =
    Edges (vertices f) \<union>
   (if vertices f = [] then {} else {(last(vertices f), hd(vertices f))})"
 by(induct f) (auto simp: Edges_def is_nextElem_def)
 
 
 lemma Edges_Cons: "Edges(x#xs) =
   (if xs = [] then {} else Edges xs \<union> {(x,hd xs)})"
 apply(auto simp:Edges_def)
    apply(rule ccontr)
    apply(simp)
   apply(erule thin_rl)
   apply(erule contrapos_np)
   apply(clarsimp simp:is_sublist_def Cons_eq_append_conv)
   apply(rename_tac as bs)
   apply(erule disjE)
    apply simp
   apply(clarsimp)
   apply(rename_tac cs)
   apply(rule_tac x = cs in exI)
   apply(rule_tac x = bs in exI)
   apply(rule HOL.refl)
  apply(clarsimp simp:neq_Nil_conv)
  apply(subst is_sublist_rec)
  apply simp
 apply(simp add:is_sublist_def)
 apply(erule exE)+
 apply(rename_tac as bs)
 apply simp
 apply(rule_tac x = "x#as" in exI)
 apply(rule_tac x = bs in exI)
 apply simp
 done
 
 lemma Edges_append: "Edges(xs @ ys) =
   (if xs = [] then Edges ys else
    if ys = [] then Edges xs else
    Edges xs \<union> Edges ys \<union> {(last xs, hd ys)})"
 apply(induct xs)
  apply simp
 apply (simp add:Edges_Cons)
 apply blast
 done
 
 
 lemma Edges_rev_disj: "distinct xs \<Longrightarrow> Edges(rev xs) \<inter> Edges(xs) = {}"
 apply(induct xs)
  apply simp
 apply(auto simp:Edges_Cons Edges_append last_rev
       notinset_notinEdge1 notinset_notinEdge2)
 done
 
 lemma disj_sets_disj_Edges:
  "set xs \<inter> set ys = {} \<Longrightarrow> Edges xs \<inter> Edges ys = {}"
 by(unfold Edges_def)(blast intro:is_sublist_in is_sublist_in1)
 
 lemma disj_sets_disj_Edges2:
  "set ys \<inter> set xs = {} \<Longrightarrow> Edges xs \<inter> Edges ys = {}"
 by(blast intro!:disj_sets_disj_Edges)
 
 
 lemma finite_Edges[iff]: "finite(Edges xs)"
 by(induct xs)(simp_all add:Edges_Cons)
 
 
 lemma Edges_compl:
  "\<lbrakk> distinct vs; x \<in> set vs; y \<in> set vs; x \<noteq> y \<rbrakk> \<Longrightarrow>
  Edges(x # between vs x y @ [y]) \<inter> Edges(y # between vs y x @ [x]) = {}"
 using [[linarith_neq_limit = 1]]
 apply(subgoal_tac
  "\<And>xs (ys::vertex list). xs \<noteq> [] \<Longrightarrow> set xs \<inter> set ys = {} \<Longrightarrow> hd xs \<notin> set ys")
  prefer 2 apply(drule hd_in_set) apply(blast)
 apply(frule split_list[of  x])
 apply clarsimp
 apply(erule disjE)
  apply(frule split_list[of y])
  apply(clarsimp simp add:between_def split_def)
  apply (clarsimp simp add:Edges_Cons Edges_append
     notinset_notinEdge1 notinset_notinEdge2
     disj_sets_disj_Edges disj_sets_disj_Edges2
     Int_Un_distrib Int_Un_distrib2)
  apply(fastforce)
 apply(frule split_list[of y])
 apply(clarsimp simp add:between_def split_def)
 apply (clarsimp simp add:Edges_Cons Edges_append notinset_notinEdge1
  notinset_notinEdge2 disj_sets_disj_Edges disj_sets_disj_Edges2
  Int_Un_distrib Int_Un_distrib2)
 apply fastforce
 done
 
 lemma Edges_disj:
  "\<lbrakk> distinct vs; x \<in> set vs; z \<in> set vs; x \<noteq> y; y \<noteq> z;
     y \<in> set(between vs x z) \<rbrakk> \<Longrightarrow>
  Edges(x # between vs x y @ [y]) \<inter> Edges(y # between vs y z @ [z]) = {}"
 apply(subgoal_tac
  "\<And>xs (ys::vertex list). xs \<noteq> [] \<Longrightarrow> set xs \<inter> set ys = {} \<Longrightarrow> hd xs \<notin> set ys")
  prefer 2 apply(drule hd_in_set) apply(blast)
 apply(frule split_list[of x])
 apply clarsimp
 apply(erule disjE)
  apply simp
  apply(drule inbetween_inset)
  apply(rule Edges_compl)
     apply simp
    apply simp
   apply simp
  apply simp
 apply(erule disjE)
  apply(frule split_list[of z])
  apply(clarsimp simp add:between_def split_def)
  apply(erule disjE)
   apply(frule split_list[of y])
   apply clarsimp
   apply (clarsimp simp add:Edges_Cons Edges_append
     notinset_notinEdge1 notinset_notinEdge2
     disj_sets_disj_Edges disj_sets_disj_Edges2
     Int_Un_distrib Int_Un_distrib2)
   apply fastforce
  apply(frule split_list[of y])
  apply clarsimp
  apply (clarsimp simp add:Edges_Cons Edges_append notinset_notinEdge1
  notinset_notinEdge2 disj_sets_disj_Edges disj_sets_disj_Edges2
  Int_Un_distrib Int_Un_distrib2)
  apply fastforce
 apply(frule split_list[of z])
 apply(clarsimp simp add:between_def split_def)
 apply(frule split_list[of y])
 apply clarsimp
 apply (clarsimp simp add:Edges_Cons Edges_append notinset_notinEdge1
  notinset_notinEdge2 disj_sets_disj_Edges disj_sets_disj_Edges2
  Int_Un_distrib Int_Un_distrib2)
 apply fastforce
 done
 
 lemma edges_conv_Un_Edges:
  "\<lbrakk> distinct(vertices(f::face)); x \<in> \<V> f; y \<in> \<V> f; x \<noteq> y \<rbrakk> \<Longrightarrow>
   \<E> f = Edges(x # between (vertices f) x y @ [y]) \<union>
            Edges(y # between (vertices f) y x @ [x])"
 apply(simp add:edges_conv_Edges)
 apply(rule conjI)
  apply clarsimp
 apply clarsimp
 apply(frule split_list[of  x])
 apply clarsimp
 apply(erule disjE)
  apply(frule split_list[of y])
  apply(clarsimp simp add:between_def split_def)
  apply (clarsimp simp add:Edges_Cons Edges_append
     notinset_notinEdge1 notinset_notinEdge2
     disj_sets_disj_Edges disj_sets_disj_Edges2
     Int_Un_distrib Int_Un_distrib2)
  apply(fastforce)
 apply(frule split_list[of y])
 apply(clarsimp simp add:between_def split_def)
 apply (clarsimp simp add:Edges_Cons Edges_append
     notinset_notinEdge1 notinset_notinEdge2
     disj_sets_disj_Edges disj_sets_disj_Edges2
     Int_Un_distrib Int_Un_distrib2)
 apply(fastforce)
 done
 
 
 lemma Edges_between_edges:
   "\<lbrakk> (a,b) \<in> Edges (u # between (vertices(f::face)) u v @ [v]);
     pre_split_face f u v vs \<rbrakk> \<Longrightarrow> (a,b) \<in> \<E> f"
 apply(simp add:pre_split_face_def)
 apply(induct f)
 apply(simp add:edges_conv_Edges Edges_Cons)
 apply clarify
 apply(rename_tac list)
 apply(case_tac "between list u v = []")
  apply simp
  apply(drule (4) is_nextElem_between_empty')
  apply(simp add:Edges_def)
 apply(subgoal_tac "pre_between list u v")
  prefer 2 apply (simp add:pre_between_def)
 apply(subgoal_tac "pre_between list v u")
  prefer 2 apply (simp add:pre_between_def)
 apply(case_tac "before list u v")
  apply(drule (1) between_eq2)
  apply clarsimp
  apply(erule disjE)
   apply (clarsimp simp:neq_Nil_conv)
   apply(rule is_nextElem_sublistI)
   apply(simp (no_asm) add:is_sublist_def)
   apply blast
  apply(rule is_nextElem_sublistI)
  apply(clarsimp simp add:Edges_def is_sublist_def)
  apply(rename_tac as bs cs xs ys)
  apply(rule_tac x = "as @ u # xs" in exI)
  apply(rule_tac x = "ys @ cs" in exI)
  apply simp
 apply (simp only:before_xor)
 apply(drule (1) between_eq2)
 apply clarsimp
 apply(rename_tac as bs cs)
 apply(erule disjE)
  apply (clarsimp simp:neq_Nil_conv)
  apply(case_tac cs)
   apply clarsimp
   apply(simp add:is_nextElem_def)
  apply simp
  apply(rule is_nextElem_sublistI)
  apply(simp (no_asm) add:is_sublist_def)
  apply(rule_tac x = "as @ v # bs" in exI)
  apply simp
 apply(rule_tac m1 = "|as|+1" in is_nextElem_rotate_eq[THEN iffD1])
 apply simp
 apply(simp add:rotate_drop_take)
 apply(rule is_nextElem_sublistI)
 apply(clarsimp simp add:Edges_def is_sublist_def)
 apply(rename_tac xs ys)
 apply(rule_tac x = "bs @ u # xs" in exI)
 apply simp
 done
 
 
 (******************** split_face_edges ********************************)
 
 
 (* split_face *)
 
 lemma edges_split_face1: "pre_split_face f u v vs \<Longrightarrow>
  \<E>(fst(split_face f u v vs)) =
  Edges(v # rev vs @ [u]) \<union> Edges(u # between (vertices f) u v @ [v])"
 apply(simp add: edges_conv_Edges split_face_distinct1')
 apply(auto simp add:split_face_def Edges_Cons Edges_append)
 done
 
 lemma edges_split_face2: "pre_split_face f u v vs \<Longrightarrow>
  \<E>(snd(split_face f u v vs)) =
  Edges(u # vs @ [v]) \<union> Edges(v # between (vertices f) v u @ [u])"
 apply(simp add: edges_conv_Edges split_face_distinct2')
 apply(auto simp add:split_face_def Edges_Cons Edges_append)
 done
 
 lemma split_face_empty_ram1_ram2_in_f21:
   "pre_split_face oldF ram1 ram2 [] \<Longrightarrow>
   (f12, f21) = split_face oldF ram1 ram2 [] \<Longrightarrow> (ram1, ram2) \<in> edges f21"
 proof -
   assume split: "(f12, f21) = split_face oldF ram1 ram2 []"
   "pre_split_face oldF ram1 ram2 []"
   then have "ram1 \<in> \<V> f21" by (simp add: split_face_def)
   moreover with split have "f21 \<bullet> ram1 = hd (vertices f21)"
    apply (rule_tac nextElem_suc2)
    apply (simp add: pre_split_face_def split_face_distinct2)
    by (simp add: split_face_def)
   with split have "ram2 = f21 \<bullet> ram1"
    by (simp add: split_face_def)
   ultimately show ?thesis by (simp add: edges_face_def)
 qed
 
 lemma split_face_empty_ram1_ram2_in_f21':
   "pre_split_face oldF ram1 ram2 [] \<Longrightarrow>
   (ram1, ram2) \<in> edges (snd (split_face oldF ram1 ram2 []))"
 proof -
   assume split: "pre_split_face oldF ram1 ram2 []"
   define f12 where "f12 = fst (split_face oldF ram1 ram2 [])"
   define f21 where "f21 = snd (split_face oldF ram1 ram2 [])"
   then have "(f12, f21) = split_face oldF ram1 ram2 []" by (simp add: f12_def f21_def)
   with split have "(ram1, ram2) \<in> edges f21"
     by (rule split_face_empty_ram1_ram2_in_f21)
   with f21_def show ?thesis by simp
 qed
 
 lemma splitFace_empty_ram1_ram2_in_f21:
   "pre_splitFace g ram1 ram2 oldF [] \<Longrightarrow>
   (f12, f21, newGraph) = splitFace g ram1 ram2 oldF [] \<Longrightarrow>
   (ram1, ram2) \<in> edges f21"
 proof -
   assume pre: "pre_splitFace g ram1 ram2 oldF []"
   then have oldF: "oldF \<in> \<F> g" by (unfold pre_splitFace_def) simp
   assume sp: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF []"
   with oldF have "(f12, f21) = split_face oldF ram1 ram2 []"
     by (rule splitFace_split_face)
 
   with pre sp show ?thesis
   apply (unfold  splitFace_def pre_splitFace_def)
   apply (simp add: split_def)
   apply (rule split_face_empty_ram1_ram2_in_f21')
   apply (rule pre_splitFace_pre_split_face)
   apply (rule pre)
   done
 qed
 
 lemma splitFace_f21_new_vertices:
   "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs \<Longrightarrow>
   v \<in> set  newVs \<Longrightarrow> v \<in> \<V> f21"
   apply (unfold splitFace_def)
   apply (simp add: split_def)
   apply (unfold split_face_def)
   by simp
 
 lemma split_face_edges_f12:
 assumes vors: "pre_split_face f ram1 ram2 vs"
               "(f12, f21) = split_face f ram1 ram2 vs"
               "vs \<noteq> []" "vs1 = between (vertices f) ram1 ram2" "vs1 \<noteq> []"
 shows "edges f12 =
       {(hd vs, ram1) , (ram1, hd vs1), (last vs1, ram2), (ram2, last vs)} \<union>
       Edges(rev vs) \<union> Edges vs1" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
   from x vors show "x \<in> ?rhs"
     apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
     apply (case_tac "c = ram2 \<and> d = last vs") apply simp apply simp apply (elim exE)
     apply (case_tac "c = ram1") apply simp
      apply (subgoal_tac "between (vertices f) ram1 ram2 @ [ram2] = d # bs")
       apply (case_tac "between (vertices f) ram1 ram2") apply simp apply simp
      apply (rule dist_at2) apply (rule dist_f12) apply (rule sym) apply simp  apply simp
     (* c \<noteq> ram1 *)
     apply (case_tac "c \<in> set(rev vs)")
      apply (subgoal_tac "distinct(rev vs)") apply (simp only: in_set_conv_decomp) apply (elim exE) apply simp
       apply (case_tac "zs") apply simp
        apply (subgoal_tac "ys = as") apply(drule last_rev) apply (simp)
        apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp
        apply simp
       apply (simp add:rev_swap)
       apply (subgoal_tac "ys = as")
        apply (clarsimp simp add: Edges_def is_sublist_def)
        apply (rule conjI)
         apply (subgoal_tac "\<exists>as bs. rev list @ [d, c] = as @ d # c # bs") apply simp apply (intro exI) apply simp
        apply (subgoal_tac "\<exists>asa bs. rev list @ d # c # rev as = asa @ d # c # bs") apply simp  apply (intro exI) apply simp
       apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
     apply (simp add: pre_split_face_def)
     (* c \<notin> set vs *)
     apply (case_tac "c \<in> set (between (vertices f) ram1 ram2)")
      apply (subgoal_tac "distinct (between (vertices f) ram1 ram2)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
       apply (case_tac zs) apply simp apply (subgoal_tac "rev vs @ ram1 # ys = as") apply force
        apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
       apply simp
       apply (subgoal_tac "rev vs @ ram1 # ys = as") apply (simp add: Edges_def is_sublist_def)
        apply (subgoal_tac "(rev vs @ ram1 # ys) @ c # a # list @ [ram2] = as @ c # d # bs") apply simp
         apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply (rule exI) apply force
         apply (rule impI) apply (rule disjI2)+ apply force
        apply force
       apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
      apply (thin_tac "rev vs @ ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs")
      apply (subgoal_tac "distinct (vertices f12)") apply simp
      apply (rule dist_f12)
       (* c \<notin>  set (between (vertices f) ram1 ram2) *)
     apply (subgoal_tac "c = ram2") apply simp
      apply (subgoal_tac "rev vs @ ram1 # between (vertices f) ram1 ram2 = as") apply force
      apply (rule dist_at1) apply (rule dist_f12) apply (rule sym)  apply simp apply simp
 
     (* c \<noteq> ram2 *)
     apply (subgoal_tac "c \<in> set (rev vs @ ram1 # between (vertices f) ram1 ram2 @ [ram2])")
      apply (thin_tac "rev vs @ ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs") apply simp
     by simp
 next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
   from x vors show "x \<in> ?lhs"
     apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
     apply (case_tac "c = ram2 \<and> d = last vs") apply simp
     apply (rule disjCI) apply simp
     apply (case_tac "c = hd vs \<and> d = ram1")
      apply (case_tac "vs") apply simp
      apply force
     apply simp
     apply (case_tac "c = ram1 \<and> d = hd (between (vertices f) ram1 ram2)")
      apply (case_tac "between (vertices f) ram1 ram2") apply simp apply force
     apply simp
     apply (case_tac "c = last (between (vertices f) ram1 ram2) \<and> d = ram2")
      apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp
      apply simp
      apply (intro exI) apply (subgoal_tac "rev vs @ ram1 # ys @ [y, ram2] = (rev vs @ ram1 # ys) @ y # ram2 # []")
       apply assumption
      apply simp
     apply simp
     apply (case_tac "(d,c) \<in> Edges vs") apply (simp add: Edges_def is_sublist_def)
      apply (elim exE) apply simp apply (intro exI) apply simp
     apply (simp add: Edges_def is_sublist_def)
     apply (elim exE) apply simp apply (intro exI)
     apply (subgoal_tac "rev vs @ ram1 # as @ c # d # bs @ [ram2] = (rev vs @ ram1 # as) @ c # d # bs @ [ram2]")
      apply assumption
     by simp
 qed
 
 lemma split_face_edges_f12_vs:
 assumes vors: "pre_split_face f ram1 ram2 []"
               "(f12, f21) = split_face f ram1 ram2 []"
               "vs1 = between (vertices f) ram1 ram2" "vs1 \<noteq> []"
 shows "edges f12 = {(ram2, ram1) , (ram1, hd vs1), (last vs1, ram2)} \<union>
                    Edges vs1" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
   from x vors show "x \<in> ?rhs"
     apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
     apply (case_tac " c = ram2 \<and> d = ram1") apply simp
     apply simp apply (elim exE)
     apply (case_tac "c = ram1") apply simp
      apply (subgoal_tac "as = []") apply simp
       apply (case_tac "between (vertices f) ram1 ram2") apply simp
       apply simp
      apply (rule dist_at1) apply (rule dist_f12) apply force apply (rule sym) apply simp
     (* a \<noteq> ram1 *)
     apply (case_tac "c \<in> set (between (vertices f) ram1 ram2)")
      apply (subgoal_tac "distinct (between (vertices f) ram1 ram2)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
       apply (case_tac zs) apply simp apply (subgoal_tac "ram1 # ys = as") apply force
        apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
       apply simp
       apply (subgoal_tac "ram1 # ys = as") apply (simp add: Edges_def is_sublist_def)
        apply (subgoal_tac "(ram1 # ys) @ c # a # list @ [ram2] = as @ c # d # bs") apply simp
         apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply (rule exI) apply force
         apply (rule impI) apply (rule disjI2)+ apply force
        apply force
       apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
      apply (thin_tac "ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs")
      apply (subgoal_tac "distinct (vertices f12)") apply simp
      apply (rule dist_f12)
       (* c \<notin>  set (between (vertices f) ram1 ram2) *)
     apply (subgoal_tac "c = ram2") apply simp
      apply (subgoal_tac "ram1 # between (vertices f) ram1 ram2 = as") apply force
      apply (rule dist_at1) apply (rule dist_f12) apply (rule sym)  apply simp apply simp
 
     (* c \<noteq> ram2 *)
     apply (subgoal_tac "c \<in> set (ram1 # between (vertices f) ram1 ram2 @ [ram2])")
      apply (thin_tac "ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs") apply simp
     by simp
 next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
   from x vors show "x \<in> ?lhs"
     apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
     apply (case_tac "c = ram2 \<and> d = ram1") apply simp
     apply (rule disjCI) apply simp
     apply (case_tac "c = ram1 \<and> d = hd (between (vertices f) ram1 ram2)")
      apply (case_tac "between (vertices f) ram1 ram2") apply simp
      apply force
     apply simp
     apply (case_tac "c = last (between (vertices f) ram1 ram2) \<and> d = ram2")
      apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp
      apply simp
      apply (intro exI) apply (subgoal_tac "ram1 # ys @ [y, ram2] = (ram1 # ys) @ y # ram2 # []")
       apply assumption
      apply simp
     apply simp
     apply (case_tac "(c, d) \<in> Edges vs") apply (simp add: Edges_def is_sublist_def)
      apply (elim exE) apply simp apply (intro exI)
      apply (subgoal_tac "ram1 # as @ c # d # bs @ [ram2] = (ram1 # as) @ c # d # (bs @ [ram2])") apply assumption
      apply simp
     apply (simp add: Edges_def is_sublist_def)
     apply (elim exE) apply simp apply (intro exI)
     apply (subgoal_tac "ram1 # as @ c # d # bs @ [ram2] = (ram1 # as) @ c # d # bs @ [ram2]")
      apply assumption
     by simp
 qed
 
 lemma split_face_edges_f12_bet:
 assumes vors: "pre_split_face f ram1 ram2 vs"
               "(f12, f21) = split_face f ram1 ram2 vs"
               "vs \<noteq> []" "between (vertices f) ram1 ram2 = []"
 shows "edges f12 = {(hd vs, ram1) , (ram1, ram2), (ram2, last vs)} \<union>
                    Edges(rev vs)" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
   from x vors show "x \<in> ?rhs"
     apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
     apply (case_tac " c = ram2 \<and> d = last vs") apply simp
     apply simp apply (elim exE)
     apply (case_tac "c = ram1") apply simp
      apply (subgoal_tac "rev vs = as") apply simp
      apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp  apply simp
     (* a \<noteq> ram1 *)
     apply (case_tac "c \<in> set(rev vs)")
      apply (subgoal_tac "distinct(rev vs)") apply (simp only: in_set_conv_decomp) apply (elim exE) apply simp
       apply (case_tac "zs") apply simp apply (subgoal_tac "ys = as") apply (simp add:rev_swap)
        apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp apply simp
       apply (subgoal_tac "ys = as") apply (simp add: Edges_def is_sublist_def rev_swap)
        apply (rule conjI)
         apply (subgoal_tac "\<exists>as bs. rev list @ [d, c] = as @ d # c # bs") apply simp apply (intro exI) apply simp
        apply (subgoal_tac "\<exists>asa bs. rev list @ d # c # rev as = asa @ d # c # bs") apply simp  apply (intro exI) apply simp
       apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
      apply (simp add: pre_split_face_def)
     (* c \<notin> set vs *)
     apply (subgoal_tac "c = ram2") apply simp
      apply (subgoal_tac "rev vs @ [ram1] = as") apply force
      apply (rule dist_at1) apply (rule dist_f12) apply (rule sym)  apply simp apply simp
 
     (* c \<noteq> ram2 *)
     apply (subgoal_tac "c \<in> set (rev vs @ ram1 # [ram2])")
      apply (thin_tac "rev vs @ ram1 # [ram2] = as @ c # d # bs") apply simp
     by simp
 next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
   from x vors show "x \<in> ?lhs"
     apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
     apply (case_tac "c = hd vs \<and> d = ram1")
      apply (case_tac "vs") apply simp
      apply force
     apply simp
     apply (case_tac "c = ram1 \<and> d = ram2") apply force
     apply simp
     apply (case_tac "c = ram2 \<and> d = last vs")
      apply (case_tac "vs" rule:rev_exhaust) apply simp
      apply simp
     apply (simp add: Edges_def is_sublist_def)
     apply (elim exE) apply simp apply (rule conjI)
      apply (rule impI) apply (rule disjI1) apply (intro exI)
      apply (subgoal_tac "c # d # rev as @ [ram1, ram2] = [] @ c # d # rev as @ [ram1,ram2]") apply assumption apply simp
     apply (rule impI) apply (rule disjI1) apply (intro exI) by simp
 qed
 
 lemma split_face_edges_f12_bet_vs:
 assumes vors: "pre_split_face f ram1 ram2 []"
               "(f12, f21) = split_face f ram1 ram2 []"
               "between (vertices f) ram1 ram2 = []"
 shows "edges f12 = {(ram2, ram1) , (ram1, ram2)}" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
   from x vors show "x \<in> ?rhs"
     apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
     apply (case_tac " c = ram2 \<and> d = ram1") apply force
     apply simp apply (elim exE)
     apply (case_tac "c = ram1")  apply simp
      apply (case_tac "as") apply simp
     apply (case_tac "list") apply simp apply simp
     apply (case_tac "as") apply simp apply (case_tac "list") apply simp by simp
 next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
   from x vors show "x \<in> ?lhs"
     apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
     by auto
 qed
 
 
 lemma split_face_edges_f12_subset: "pre_split_face f ram1 ram2 vs \<Longrightarrow>
   (f12, f21) = split_face f ram1 ram2 vs \<Longrightarrow> vs \<noteq> [] \<Longrightarrow>
   {(hd vs, ram1), (ram2, last vs)} \<union> Edges(rev vs) \<subseteq> edges f12"
   apply (case_tac "between (vertices f) ram1 ram2")
     apply (frule split_face_edges_f12_bet)  apply simp apply simp apply simp apply force
     apply (frule split_face_edges_f12) apply simp+ by force
 
 (*declare in_Edges_rev [simp del] rev_eq_Cons_iff [simp del]*)
 
 lemma split_face_edges_f21:
 assumes vors: "pre_split_face f ram1 ram2 vs"
               "(f12, f21) = split_face f ram1 ram2 vs"
               "vs \<noteq> []" "vs2 = between (vertices f) ram2 ram1" "vs2 \<noteq> []"
 shows "edges f21 = {(last vs2, ram1) , (ram1, hd vs), (last vs, ram2), (ram2, hd vs2)} \<union>
   Edges vs \<union> Edges vs2" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
   from x vors show "x \<in> ?rhs"
     apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
     apply (case_tac " c = last vs \<and> d = ram2") apply simp
     apply simp apply (elim exE)
     apply (case_tac "c = ram1") apply simp
      apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 = as")
       apply clarsimp
      apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
     (* a \<noteq> ram1 *)
     apply (case_tac "c \<in> set vs")
      apply (subgoal_tac "distinct vs")
       apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
       apply (case_tac "zs") apply simp
        apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # ys = as") apply force
        apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
       apply simp
       apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # ys = as")
        apply (subgoal_tac "(ram2 # between (vertices f) ram2 ram1 @ ram1 # ys) @ c # a # list = as @ c # d # bs")
         apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # ys @ c # a # list = as @ c # d # bs")
         apply (simp add: Edges_def is_sublist_def)
         apply(rule conjI)
          apply (subgoal_tac "\<exists>as bs. ys @ [c, d] = as @ c # d # bs") apply simp apply force
         apply force
        apply force
       apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
      apply (simp add: pre_split_face_def)
     (* c \<notin> set (rev vs) *)
     apply (case_tac "c \<in> set (between (vertices f) ram2 ram1)")
      apply (subgoal_tac "distinct (between (vertices f) ram2 ram1)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
       apply (case_tac zs) apply simp apply (subgoal_tac "ram2 # ys = as") apply force
        apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
       apply simp
       apply (subgoal_tac "ram2 # ys = as") apply (simp add: Edges_def is_sublist_def)
        apply (subgoal_tac "(ram2 # ys) @ c # a # list @ ram1 # vs = as @ c # d # bs")
         apply (thin_tac "ram2 # ys @ c # a # list @ ram1 # vs = as @ c # d # bs")
         apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply force
         apply (rule impI) apply (rule disjI2)+ apply force
        apply force
       apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
      apply (subgoal_tac "distinct (vertices f21)")
      apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # vs = as @ c # d # bs") apply simp
      apply (rule dist_f21)
       (* c \<notin>  set (between (vertices f) ram2 ram1) *)
     apply (subgoal_tac "c = ram2") apply simp
      apply (subgoal_tac "[] = as") apply simp apply (case_tac "between (vertices f) ram2 ram1") apply simp apply simp
      apply (rule dist_at1) apply (rule dist_f21) apply (rule sym)  apply simp apply simp
 
     (* c \<noteq> ram2 *)
     apply (subgoal_tac "c \<in> set (ram2 # between (vertices f) ram2 ram1 @ ram1 # vs)")
      apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # vs = as @ c # d # bs") apply simp
     by simp
 next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
   from x vors show "x \<in> ?lhs"
     apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
     apply (case_tac "c = ram2 \<and> d = hd (between (vertices f) ram2 ram1)") apply simp apply (rule disjI1)
      apply (intro exI) apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # vs =
        [] @ ram2 # hd (between (vertices f) ram2 ram1) # tl (between (vertices f) ram2 ram1) @ ram1 # vs") apply assumption apply simp
     apply (case_tac "c = ram1 \<and> d = hd vs") apply (rule disjI1)
      apply (case_tac "vs")  apply simp
      apply simp apply (intro exI)
      apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # a # list =
         (ram2 # between (vertices f) ram2 ram1) @ ram1 # a # list") apply assumption apply simp
     apply (case_tac "c = last vs \<and> d = ram2")
      apply (case_tac vs rule:rev_exhaust) apply simp
      apply simp
     apply simp
     apply (case_tac "c = last (between (vertices f) ram2 ram1) \<and> d = ram1") apply (rule disjI1)
      apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp
      apply (intro exI) apply simp
      apply (subgoal_tac "ram2 # ys @ y # ram1 # vs = (ram2 # ys) @ y # ram1 # vs")
       apply assumption
      apply simp
     apply simp
     apply (case_tac "(c, d) \<in> Edges vs") apply (simp add: Edges_def is_sublist_def)
      apply (elim exE) apply simp apply (rule conjI) apply (rule impI) apply (rule disjI1) apply (intro exI)
       apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # as @ [c, d]
         = (ram2 # between (vertices f) ram2 ram1 @ ram1 # as) @ c # d # []") apply assumption apply simp
      apply (rule impI) apply (rule disjI1) apply (intro exI)
      apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # as @ c # d # bs
         = (ram2 # between (vertices f) ram2 ram1 @ ram1 # as) @ c # d # bs") apply assumption apply simp
     apply (simp add: Edges_def is_sublist_def)
     apply (elim exE) apply simp apply (rule disjI1) apply (intro exI)
     apply (subgoal_tac "ram2 # as @ c # d # bs @ ram1 # vs = (ram2 # as) @ c # d # (bs @ ram1 # vs)")
      apply assumption by simp
 qed
 
 
 lemma split_face_edges_f21_vs:
 assumes vors: "pre_split_face f ram1 ram2 []"
               "(f12, f21) = split_face f ram1 ram2 []"
               "vs2 = between (vertices f) ram2 ram1" "vs2 \<noteq> []"
 shows "edges f21 = {(last vs2, ram1) , (ram1, ram2), (ram2, hd vs2)} \<union>
                    Edges vs2" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
   from x vors show "x \<in> ?rhs"
     apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
     apply (case_tac " c = ram1 \<and> d = ram2") apply simp apply simp  apply (elim exE)
 
     apply (case_tac "c = ram1") apply simp
     apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 = as")
     apply (subgoal_tac "(ram2 # between (vertices f) ram2 ram1) @ [ram1]  = as @ ram1 # d # bs")
     apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1]  = as @ ram1 # d # bs")
     apply simp apply force
     apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
     (* a \<noteq> ram1 *)
     apply (case_tac "c \<in> set (between (vertices f) ram2 ram1)")
     apply (subgoal_tac "distinct (between (vertices f) ram2 ram1)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
     apply (case_tac zs) apply simp apply (subgoal_tac "ram2 # ys = as") apply force
     apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp apply simp
     apply (subgoal_tac "ram2 # ys = as") apply (simp add: Edges_def is_sublist_def)
     apply (subgoal_tac "(ram2 # ys) @ c # a # list @ [ram1] = as @ c # d # bs")
     apply (thin_tac "ram2 # ys @ c # a # list @ [ram1] = as @ c # d # bs")
     apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply force
     apply (rule impI) apply (rule disjI2)+ apply force apply force
     apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
     apply (subgoal_tac "distinct (vertices f21)")
     apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1] = as @ c # d # bs") apply simp
     apply (rule dist_f21)
       (* c \<notin>  set (between (vertices f) ram2 ram1) *)
     apply (subgoal_tac "c = ram2") apply simp
     apply (subgoal_tac "[] = as") apply simp apply (case_tac "between (vertices f) ram2 ram1") apply simp apply simp
     apply (rule dist_at1) apply (rule dist_f21) apply (rule sym)  apply simp apply simp
 
     (* c \<noteq> ram2 *)
     apply (subgoal_tac "c \<in> set (ram2 # between (vertices f) ram2 ram1 @ [ram1])")
     apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1] = as @ c # d # bs") apply simp
     by simp
 next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
   from x vors show "x \<in> ?lhs"
     apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
     apply (case_tac "c = ram2 \<and> d = hd (between (vertices f) ram2 ram1)") apply simp apply (rule disjI1)
     apply (intro exI) apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1] =
        [] @ ram2 # hd (between (vertices f) ram2 ram1) # tl (between (vertices f) ram2 ram1) @ [ram1]") apply assumption apply simp
     apply (case_tac "c = ram1 \<and> d = ram2") apply (rule disjI2) apply simp apply simp
     apply (case_tac "c = last (between (vertices f) ram2 ram1) \<and> d = ram1") apply (rule disjI1)
       apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp
       apply (intro exI) apply simp
       apply (subgoal_tac "ram2 # ys @ y # [ram1] = (ram2 # ys) @ y # [ram1]")
       apply assumption apply simp apply simp
     apply (simp add: Edges_def is_sublist_def)
       apply (elim exE) apply simp apply (rule disjI1) apply (intro exI)
       apply (subgoal_tac "ram2 # as @ c # d # bs @ [ram1] = (ram2 # as) @ c # d # (bs @ [ram1])")
       apply assumption by simp
 qed
 
 
 lemma split_face_edges_f21_bet:
 assumes vors: "pre_split_face f ram1 ram2 vs"
               "(f12, f21) = split_face f ram1 ram2 vs"
               "vs \<noteq> []" "between (vertices f) ram2 ram1 = []"
 shows "edges f21 = {(ram1, hd vs), (last vs, ram2), (ram2, ram1)} \<union>
                    Edges vs" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
   from x vors show "x \<in> ?rhs"
     apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
     apply (case_tac " c = last vs \<and> d = ram2") apply simp
     apply simp apply (elim exE)
     apply (case_tac "c = ram1") apply simp
      apply (subgoal_tac "[ram2] = as") apply clarsimp
      apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
     (* a \<noteq> ram1 *)
     apply (case_tac "c \<in> set vs")
      apply (subgoal_tac "distinct vs") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
       apply (case_tac "zs") apply simp
        apply (subgoal_tac "ram2 #  ram1 # ys = as") apply force
        apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
       apply simp
       apply (subgoal_tac "ram2 # ram1 # ys = as")
        apply (subgoal_tac "(ram2 # ram1 # ys) @ c # a # list = as @ c # d # bs")
         apply (thin_tac "ram2 #  ram1 # ys @ c # a # list = as @ c # d # bs")
         apply (simp add: Edges_def is_sublist_def) apply force
        apply force
       apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
      apply (simp add: pre_split_face_def)
     (* c \<notin> set (rev vs) *)
     apply (subgoal_tac "c = ram2") apply simp
      apply (subgoal_tac "[] = as") apply simp
      apply (rule dist_at1) apply (rule dist_f21) apply (rule sym)  apply simp apply simp
     (* c \<noteq> ram2 *)
     apply (subgoal_tac "c \<in> set (ram2 # ram1 # vs)")
      apply (thin_tac "ram2 # ram1 # vs = as @ c # d # bs") apply simp
     by simp
 next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
   from x vors show "x \<in> ?lhs"
     apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
     apply (case_tac "c = ram2 \<and> d = ram1") apply simp apply (rule disjI1) apply force
     apply (case_tac "c = ram1 \<and> d = hd vs") apply (rule disjI1)
      apply (case_tac "vs")  apply simp
      apply simp apply (intro exI)
      apply (subgoal_tac "ram2 # ram1 # a # list =
         [ram2] @ ram1 # a # list") apply assumption  apply simp
     apply (case_tac "c = last vs \<and> d = ram2")
      apply (case_tac vs rule: rev_exhaust) apply simp
      apply simp
     apply (simp add: Edges_def is_sublist_def)
     apply (elim exE) apply simp apply (rule conjI) apply (rule impI) apply (rule disjI1) apply (intro exI)
      apply (subgoal_tac "ram2 # ram1 # as @ [c, d]
         = (ram2 # ram1 # as) @ c # d # []") apply assumption apply simp
     apply (rule impI) apply (rule disjI1) apply (intro exI)
     apply (subgoal_tac "ram2 #  ram1 # as @ c # d # bs
         = (ram2 # ram1 # as) @ c # d # bs") apply assumption by simp
 qed
 
 
 lemma split_face_edges_f21_bet_vs:
 assumes vors: "pre_split_face f ram1 ram2 []"
               "(f12, f21) = split_face f ram1 ram2 []"
               "between (vertices f) ram2 ram1 = []"
 shows "edges f21 = {(ram1, ram2), (ram2, ram1)}" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
   from x vors show "x \<in> ?rhs"
     apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
     apply (case_tac " c = ram1 \<and> d = ram2") apply simp  apply simp apply (elim exE)
     apply (case_tac "as") apply  simp  apply (case_tac "list") by auto
 next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
   from x vors show "x \<in> ?lhs"
     apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
     by auto
 qed
 
 lemma split_face_edges_f21_subset: "pre_split_face f ram1 ram2 vs \<Longrightarrow>
   (f12, f21) = split_face f ram1 ram2 vs \<Longrightarrow> vs \<noteq> [] \<Longrightarrow>
   {(last vs, ram2), (ram1, hd vs)} \<union> Edges vs \<subseteq> edges f21"
   apply (case_tac "between (vertices f) ram2 ram1")
     apply (frule split_face_edges_f21_bet)  apply simp apply simp apply simp apply force
     apply (frule split_face_edges_f21) apply simp+ by force
 
 lemma verticesFrom_ram1: "pre_split_face f ram1 ram2 vs \<Longrightarrow>
   verticesFrom f ram1 = ram1 # between (vertices f) ram1 ram2 @ ram2 # between (vertices f) ram2 ram1"
   apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
   apply (subgoal_tac "distinct (vertices f)")
   apply (case_tac "before (vertices f) ram1 ram2")
   apply (simp add: verticesFrom_Def)
   apply (subgoal_tac "ram2 \<in> set (snd (splitAt ram1 (vertices f)))") apply (drule splitAt_ram)
   apply (subgoal_tac "snd (splitAt ram2 (snd (splitAt ram1 (vertices f)))) = snd (splitAt ram2 (vertices f))")
   apply simp apply (thin_tac "snd (splitAt ram1 (vertices f)) =
      fst (splitAt ram2 (snd (splitAt ram1 (vertices f)))) @
      ram2 # snd (splitAt ram2 (snd (splitAt ram1 (vertices f))))")  apply simp
   apply (rule before_dist_r2) apply simp apply simp
   apply (subgoal_tac "before (vertices f) ram2 ram1")
   apply (subgoal_tac "pre_between (vertices f) ram2 ram1")
   apply (simp add: verticesFrom_Def)
   apply (subgoal_tac "ram2 \<in> set (fst (splitAt ram1 (vertices f)))") apply (drule splitAt_ram)
   apply (subgoal_tac "fst (splitAt ram2 (fst (splitAt ram1 (vertices f)))) = fst (splitAt ram2 (vertices f))")
   apply simp apply (thin_tac "fst (splitAt ram1 (vertices f)) =
      fst (splitAt ram2 (fst (splitAt ram1 (vertices f)))) @
      ram2 # snd (splitAt ram2 (fst (splitAt ram1 (vertices f))))") apply simp
   apply (rule before_dist_r1) apply simp apply simp apply (simp add: pre_between_def) apply force
   apply (simp add: pre_split_face_def) by (rule pre_split_face_p_between)
 
 lemma split_face_edges_f_vs1_vs2:
 assumes vors: "pre_split_face f ram1 ram2 vs"
               "between (vertices f) ram1 ram2 = []"
               "between (vertices f) ram2 ram1 = []"
 shows "edges f = {(ram2, ram1) , (ram1, ram2)}" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
   from x vors show "x \<in> ?rhs" apply (simp add: dist_f)
     apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
      apply (drule is_nextElem_or) apply assumption
      apply (simp add: Edges_def)
      apply (case_tac "is_sublist [c, d] [ram1, ram2]") apply (simp)
      apply (simp) apply blast
     by (rule pre_split_face_p_between)
   next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
   from x vors show "x \<in> ?lhs" apply (simp add: dist_f)
     apply (subgoal_tac "ram1 \<in> \<V> f") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
     apply (simp add: is_nextElem_def) apply blast
     by (simp add: pre_split_face_def)
 qed
 
 lemma split_face_edges_f_vs1:
 assumes vors: "pre_split_face f ram1 ram2 vs"
               "between (vertices f) ram1 ram2 = []"
               "vs2 = between (vertices f) ram2 ram1" "vs2 \<noteq> []"
 shows "edges f = {(last vs2, ram1) , (ram1, ram2), (ram2, hd vs2)} \<union>
                  Edges vs2" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
   from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
     apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
   from x vors show "x \<in> ?rhs" apply (simp add: dist_f)
     apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
      apply (drule is_nextElem_or) apply assumption
      apply (simp add: Edges_def)
      apply (case_tac "is_sublist [c, d] [ram1, ram2]")
       apply simp
      apply simp
      apply(erule disjE) apply blast
      apply (case_tac "c = ram2")
       apply (case_tac "between (vertices f) ram2 ram1") apply simp
       apply simp
       apply (drule is_sublist_distinct_prefix)
        apply (subgoal_tac "distinct (ram2 # vs2 @ [ram1])")
         apply simp
        apply (rule dist_vs2)
       apply simp
      apply (case_tac "c = ram1")
       apply (subgoal_tac "\<not> is_sublist [c, d] (ram2 # vs2 @ [ram1])")
        apply simp
       apply (rule is_sublist_notlast)
        apply (rule_tac dist_vs2)
       apply simp
      apply simp
      apply (simp add: is_sublist_def)
      apply (elim exE)
      apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp
      apply simp
      apply (case_tac "bs" rule: rev_exhaust) apply simp
      apply simp
      apply (rule disjI2)
      apply (intro exI)
      apply simp
     apply (rule pre_split_face_p_between) by simp
   next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
   from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
     apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
   from x vors show "x \<in> ?lhs" apply (simp add: dist_f)
     apply (subgoal_tac "ram1 \<in> set (vertices f)") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
     apply (simp add: is_nextElem_def)
     apply (case_tac "c = last (between (vertices f) ram2 ram1) \<and> d = ram1") apply simp apply simp apply (rule disjI1)
     apply (case_tac "c = ram1 \<and> d = ram2")  apply (simp add: is_sublist_def) apply force apply simp
     apply (case_tac "c = ram2 \<and> d = hd (between (vertices f) ram2 ram1)")
       apply (case_tac "between (vertices f) ram2 ram1") apply simp apply (simp add: is_sublist_def) apply (intro exI)
       apply (subgoal_tac "ram1 # ram2 # a # list =
         [ram1] @ ram2 # a # (list)") apply assumption apply simp
     apply simp
       apply (subgoal_tac "is_sublist [c, d] ((ram1 #
                         [ram2]) @ between (vertices f) ram2 ram1 @ [])")
       apply simp apply (rule is_sublist_add) apply (simp add: Edges_def)
     by (simp add: pre_split_face_def)
 qed
 
 
 lemma split_face_edges_f_vs2:
 assumes vors: "pre_split_face f ram1 ram2 vs"
               "vs1 = between (vertices f) ram1 ram2" "vs1 \<noteq> []"
               "between (vertices f) ram2 ram1 = []"
 shows "edges f = {(ram2, ram1) , (ram1, hd vs1), (last vs1, ram2)} \<union>
                  Edges vs1" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
   from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
     apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
   from x vors show "x \<in> ?rhs" apply (simp add: dist_f)
     apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
      apply (drule is_nextElem_or) apply assumption
      apply (simp add: Edges_def)
      apply (case_tac "is_sublist [c, d] (ram1 # between (vertices f) ram1 ram2 @ [ram2])")
       apply simp
       apply (case_tac "c = ram1")
        apply (case_tac "between (vertices f) ram1 ram2") apply simp
        apply simp
        apply (drule is_sublist_distinct_prefix)
         apply (subgoal_tac "distinct (ram1 # vs1 @ [ram2])") apply simp
         apply (rule dist_vs1)
        apply simp
       apply (case_tac "c = ram2")
        apply (subgoal_tac "\<not> is_sublist [c, d] (ram1 # vs1 @ [ram2])") apply simp
        apply (rule is_sublist_notlast) apply (rule_tac dist_vs1)
        apply simp
       apply simp
       apply (simp add: is_sublist_def)
       apply (elim exE)
       apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp
       apply simp
       apply (case_tac "bs" rule: rev_exhaust) apply simp
       apply simp
       apply (rule disjI2)
       apply (intro exI)
       apply simp
      apply simp
     apply (rule pre_split_face_p_between) by simp
   next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
   from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
     apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
   from x vors show "x \<in> ?lhs" apply (simp add: dist_f)
     apply (subgoal_tac "ram1 \<in> \<V> f") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
     apply (simp add: is_nextElem_def)
     apply (case_tac "c = ram2 \<and> d = ram1") apply simp apply simp apply (rule disjI1)
     apply (case_tac "c = ram1 \<and> d = hd (between (vertices f) ram1 ram2)")
       apply (case_tac "between (vertices f) ram1 ram2") apply simp apply (force simp: is_sublist_def) apply simp
     apply (case_tac "c = last (between (vertices f) ram1 ram2) \<and> d = ram2")
       apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp apply (simp add: is_sublist_def)
       apply (intro exI)
       apply (subgoal_tac "ram1 # ys @ [y, ram2] =
         (ram1 # ys) @ y # ram2 # []") apply assumption apply simp
     apply simp
       apply (simp add: Edges_def)
       apply (subgoal_tac "is_sublist [c, d] ([ram1] @ between (vertices f) ram1 ram2 @ [ram2])")
       apply simp apply (rule is_sublist_add) apply simp
     by (simp add: pre_split_face_def)
 qed
 
 
 lemma split_face_edges_f:
 assumes vors: "pre_split_face f ram1 ram2 vs"
               "vs1 = between (vertices f) ram1 ram2" "vs1 \<noteq> []"
               "vs2 = between (vertices f) ram2 ram1" "vs2 \<noteq> []"
 shows "edges f = {(last vs2, ram1) , (ram1, hd vs1), (last vs1, ram2), (ram2, hd vs2)} \<union>
                  Edges vs1 \<union> Edges vs2" (is "?lhs = ?rhs")
 proof (intro equalityI subsetI)
   fix x
   assume x: "x \<in> ?lhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
   from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
     apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
   from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
     apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
   from x vors show "x \<in> ?rhs" apply (simp add: dist_f)
     apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
     apply (drule is_nextElem_or) apply assumption apply (simp add: Edges_def)
     apply (case_tac "is_sublist [c, d] (ram1 # between (vertices f) ram1 ram2 @ [ram2])") apply simp
       apply (case_tac "c = ram1")
         apply (case_tac "between (vertices f) ram1 ram2") apply simp apply simp
         apply (drule is_sublist_distinct_prefix) apply (subgoal_tac "distinct (ram1 # vs1 @ [ram2])")
         apply simp apply (rule dist_vs1) apply simp
       apply (case_tac "c = ram2")
         apply (subgoal_tac "\<not> is_sublist [c, d] (ram1 # vs1 @ [ram2])") apply simp
         apply (rule is_sublist_notlast) apply (rule_tac dist_vs1) apply simp
       apply simp apply (simp add: is_sublist_def) apply (elim exE)
         apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp apply simp
         apply (case_tac "bs" rule: rev_exhaust) apply simp apply simp
         apply (rule disjI2) apply (rule disjI2) apply (rule disjI1) apply (intro exI) apply simp
     apply simp
       apply (case_tac "c = ram2")
         apply (case_tac "between (vertices f) ram2 ram1") apply simp apply simp
         apply (drule is_sublist_distinct_prefix) apply (subgoal_tac "distinct (ram2 # vs2 @ [ram1])")
         apply simp apply (rule dist_vs2) apply simp
       apply (case_tac "c = ram1")
         apply (subgoal_tac "\<not> is_sublist [c, d] (ram2 # vs2 @ [ram1])") apply simp
         apply (rule is_sublist_notlast) apply (rule_tac dist_vs2) apply simp
       apply simp apply (simp add: is_sublist_def) apply (elim exE)
         apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp apply simp
         apply (case_tac "bs" rule: rev_exhaust) apply simp apply simp
         apply (rule disjI2) apply (rule disjI2) apply (rule disjI2) apply (intro exI) apply simp
    apply (rule pre_split_face_p_between) by simp
 next
   fix x
   assume x: "x \<in> ?rhs"
   define c where "c = fst x"
   define d where "d = snd x"
   with c_def  have [simp]: "x = (c,d)" by simp
   from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
   from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
     apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
   from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
     apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
   from x vors show "x \<in> ?lhs" apply (simp add: dist_f)
     apply (subgoal_tac "ram1 \<in> \<V> f") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
     apply (simp add: is_nextElem_def)
     apply (case_tac "c = last (between (vertices f) ram2 ram1) \<and> d = ram1") apply simp apply simp apply (rule disjI1)
     apply (case_tac "c = ram1 \<and> d = hd (between (vertices f) ram1 ram2)")
       apply (case_tac "between (vertices f) ram1 ram2") apply simp apply (force simp: is_sublist_def) apply simp
     apply (case_tac "c = last (between (vertices f) ram1 ram2) \<and> d = ram2")
       apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp apply (simp add: is_sublist_def)
       apply (intro exI)
       apply (subgoal_tac "ram1 # ys @ y # ram2 # between (vertices f) ram2 ram1 =
         (ram1 # ys) @ y # ram2 # (between (vertices f) ram2 ram1)") apply assumption apply simp apply simp
     apply (case_tac "c = ram2 \<and> d = hd (between (vertices f) ram2 ram1)")
       apply (case_tac "between (vertices f) ram2 ram1") apply simp apply (simp add: is_sublist_def) apply (intro exI)
       apply (subgoal_tac "ram1 # between (vertices f) ram1 ram2 @ ram2 # a # list =
         (ram1 # between (vertices f) ram1 ram2) @ ram2 # a # (list)") apply assumption apply simp apply simp
     apply (case_tac "(c, d) \<in> Edges (between (vertices f) ram1 ram2)") apply (simp add: Edges_def)
       apply (subgoal_tac "is_sublist [c, d] ([ram1] @ between (vertices f) ram1 ram2 @
                         (ram2 # between (vertices f) ram2 ram1))")
       apply simp apply (rule is_sublist_add) apply simp
     apply simp
       apply (subgoal_tac "is_sublist [c, d] ((ram1 # between (vertices f) ram1 ram2 @
                         [ram2]) @ between (vertices f) ram2 ram1 @ [])")
       apply simp apply (rule is_sublist_add) apply (simp add: Edges_def)
     by (simp add: pre_split_face_def)
 qed
 
 
 lemma split_face_edges_f12_f21:
   "pre_split_face f ram1 ram2 vs \<Longrightarrow> (f12, f21) = split_face f ram1 ram2 vs \<Longrightarrow>
    vs \<noteq> []
   \<Longrightarrow> edges f12 \<union> edges f21 = edges f \<union>
      {(hd vs, ram1), (ram1, hd vs), (last vs, ram2), (ram2, last vs)} \<union>
      Edges vs \<union>
      Edges (rev vs)"
   apply (case_tac "between (vertices f) ram1 ram2 = []")
     apply (case_tac "between (vertices f) ram2 ram1 = []")
       apply (simp add: split_face_edges_f12_bet split_face_edges_f21_bet split_face_edges_f_vs1_vs2)
       apply force
     apply (simp add: split_face_edges_f12_bet split_face_edges_f21 split_face_edges_f_vs1) apply force
   apply (case_tac "between (vertices f) ram2 ram1 = []")
     apply (simp add: split_face_edges_f21_bet split_face_edges_f12 split_face_edges_f_vs2) apply force
   apply (simp add: split_face_edges_f21 split_face_edges_f12 split_face_edges_f) by force
 
 
 lemma split_face_edges_f12_f21_vs:
   "pre_split_face f ram1 ram2 [] \<Longrightarrow> (f12, f21) = split_face f ram1 ram2 []
   \<Longrightarrow> edges f12 \<union> edges f21 = edges f \<union>
      {(ram2, ram1), (ram1, ram2)}"
   apply (case_tac "between (vertices f) ram1 ram2 = []")
     apply (case_tac "between (vertices f) ram2 ram1 = []")
       apply (simp add: split_face_edges_f12_bet_vs split_face_edges_f21_bet_vs split_face_edges_f_vs1_vs2)
       apply force
     apply (simp add: split_face_edges_f12_bet_vs split_face_edges_f21_vs split_face_edges_f_vs1) apply force
   apply (case_tac "between (vertices f) ram2 ram1 = []")
     apply (simp add: split_face_edges_f21_bet_vs split_face_edges_f12_vs split_face_edges_f_vs2) apply force
   apply (simp add: split_face_edges_f21_vs split_face_edges_f12_vs split_face_edges_f) by force
 
 
 lemma split_face_edges_f12_f21_sym:
   "f \<in> \<F> g \<Longrightarrow>
   pre_split_face f ram1 ram2 vs \<Longrightarrow> (f12, f21) = split_face f ram1 ram2 vs
   \<Longrightarrow> ((a,b) \<in> edges f12 \<or> (a,b) \<in>  edges f21) =
      ((a,b) \<in> edges f  \<or>
   (((b,a) \<in> edges f12 \<or> (b,a) \<in>  edges f21) \<and>
   ((a,b) \<in> edges f12 \<or> (a,b) \<in> edges f21)))"
   apply (subgoal_tac "((a,b) \<in> edges f12 \<union> edges f21) =
      ((a,b) \<in> edges f \<or> ((b,a) \<in> edges f12 \<union> edges f21) \<and> (a,b) \<in> edges f12 \<union> edges f21)") apply force
   apply (case_tac "vs = []")
     apply (subgoal_tac "pre_split_face f ram1 ram2 []")
     apply (drule split_face_edges_f12_f21_vs) apply simp apply simp apply force apply simp
   apply (drule split_face_edges_f12_f21) apply simp apply simp
     apply simp by force
 
 lemma splitFace_edges_g'_help: "pre_splitFace g ram1 ram2 f vs \<Longrightarrow>
   (f12, f21, g') = splitFace g ram1 ram2 f vs \<Longrightarrow> vs \<noteq> [] \<Longrightarrow>
   edges g' = edges g \<union> edges f \<union> Edges vs \<union> Edges(rev vs) \<union>
   {(ram2, last vs), (hd vs, ram1), (ram1, hd vs), (last vs, ram2)}"
 proof -
   assume pre: "pre_splitFace g ram1 ram2 f vs"
     and fdg: "(f12, f21, g') = splitFace g ram1 ram2 f vs"
     and vs_neq: "vs \<noteq> []"
 
   from pre fdg have split: "(f12, f21) = split_face f ram1 ram2 vs"
     apply (unfold pre_splitFace_def) apply (elim conjE)
     by (simp add: splitFace_split_face)
 
   from fdg pre have "edges g' = (\<Union>\<^bsub>a\<in>set (replace f [f21] (faces g))\<^esub> edges a) \<union>
        edges (f12)" by(auto simp: splitFace_def split_def edges_graph_def)
   with pre vs_neq show ?thesis apply (simp add: UNION_eq) apply (rule equalityI) apply simp
     apply (rule conjI) apply (rule subsetI) apply simp apply (erule bexE) apply (drule replace5)
     apply (case_tac "xa \<in> \<F> g") apply simp
     apply (subgoal_tac "x \<in> edges g") apply simp
     apply (simp add: edges_graph_def) apply force
     apply simp
     apply (subgoal_tac "pre_split_face f ram1 ram2 vs")
     apply (case_tac "between (vertices f) ram2 ram1 = []")
       apply (frule split_face_edges_f21_bet) apply (rule split) apply simp apply simp
       apply (case_tac "between (vertices f) ram1 ram2 = []")
         apply (frule split_face_edges_f_vs1_vs2) apply simp apply simp apply simp apply force
         apply (frule split_face_edges_f_vs2) apply simp apply simp apply simp apply force
     apply (frule split_face_edges_f21) apply (rule split) apply simp apply simp apply simp
       apply (case_tac "between (vertices f) ram1 ram2 = []")
         apply (frule split_face_edges_f_vs1) apply simp apply simp apply simp apply simp apply force
         apply (frule split_face_edges_f) apply simp apply simp apply simp apply simp apply force
     apply simp
     apply (subgoal_tac "pre_split_face f ram1 ram2 vs")
     apply (case_tac "between (vertices f) ram1 ram2 = []")
       apply (frule split_face_edges_f12_bet) apply (rule split) apply simp apply simp
       apply (case_tac "between (vertices f) ram2 ram1 = []")
         apply (frule split_face_edges_f_vs1_vs2) apply simp apply simp apply simp apply force
         apply (frule split_face_edges_f_vs1) apply simp apply simp apply simp apply force
     apply (frule split_face_edges_f12) apply (rule split) apply simp apply simp apply simp
       apply (case_tac "between (vertices f) ram2 ram1 = []")
         apply (frule split_face_edges_f_vs2) apply simp apply simp apply simp apply simp apply force
         apply (frule split_face_edges_f) apply simp apply simp apply simp apply simp apply force
     apply simp
     apply simp
     apply (subgoal_tac "pre_split_face f ram1 ram2 vs")
     apply (subgoal_tac "(ram2, last vs) \<in> edges f12 \<and> (hd vs, ram1) \<in> edges f12")
       apply (rule conjI) apply simp
       apply (rule conjI) apply simp
     apply (subgoal_tac "(ram1, hd vs) \<in> edges f21 \<and> (last vs, ram2) \<in> edges f21")
       apply (rule conjI) apply (rule disjI1) apply (rule bexI) apply (elim conjE) apply simp
         apply (rule replace3) apply(erule pre_splitFace_oldF) apply simp
       apply (rule conjI) apply (rule disjI1) apply (rule bexI) apply (elim conjE) apply simp
         apply (rule replace3) apply(erule pre_splitFace_oldF)
     apply simp
     apply (subgoal_tac "edges f \<subseteq> {y. \<exists>x\<in>set (replace f [f21] (faces g)). y \<in> edges x} \<union> edges f12")
     apply (subgoal_tac "edges g \<subseteq> {y. \<exists>x\<in>set (replace f [f21] (faces g)). y \<in> edges x} \<union> edges f12")
       apply (rule conjI) apply simp
       apply (rule conjI) apply simp
     apply (subgoal_tac "Edges(rev vs) \<subseteq> edges f12") apply (rule conjI) prefer 2 apply blast
     apply (subgoal_tac "Edges vs \<subseteq> edges f21")
       apply (subgoal_tac "Edges vs \<subseteq> {y. \<exists>x\<in>set (replace f [f21] (faces g)). y \<in> edges x}") apply blast
       apply (rule subset_trans) apply  assumption apply (rule subsetI) apply simp apply (rule bexI) apply simp
       apply (rule replace3) apply(erule pre_splitFace_oldF) apply simp
     (* jetzt alle 7 subgoals aufloesen *)
     apply (frule split_face_edges_f21_subset) apply (rule split)  apply simp apply simp
     apply (frule split_face_edges_f12_subset) apply (rule split) apply simp apply simp
     apply (simp add: edges_graph_def)  apply (rule subsetI) apply simp apply (elim bexE)
       apply (case_tac "xa = f") apply simp apply blast
       apply (rule disjI1) apply (rule bexI) apply simp apply (rule replace4) apply simp apply force
     apply (rule subsetI)
       apply (subgoal_tac "\<exists> u v. x = (u,v)") apply (elim exE conjE)
       apply (frule split_face_edges_or [OF split]) apply simp
       apply (case_tac "(u, v) \<in> edges f12") apply simp apply simp
       apply (rule bexI) apply (thin_tac "(u, v) \<in> edges f")  apply assumption
       apply (rule replace3) apply(erule pre_splitFace_oldF) apply simp apply simp
     apply (frule split_face_edges_f21_subset) apply (rule split) apply simp apply simp
     apply (frule split_face_edges_f12_subset) apply (rule split) apply simp apply simp
   by simp
 qed
 
 lemma pre_splitFace_edges_f_in_g: "pre_splitFace g ram1 ram2 f vs \<Longrightarrow> edges f \<subseteq> edges g"
   apply (simp add: edges_graph_def) by (force)
 
 lemma pre_splitFace_edges_f_in_g2: "pre_splitFace g ram1 ram2 f vs \<Longrightarrow> x \<in> edges f \<Longrightarrow> x \<in> edges g"
   apply (simp add: edges_graph_def) by (force)
 
 lemma splitFace_edges_g': "pre_splitFace g ram1 ram2 f vs \<Longrightarrow>
   (f12, f21, g') = splitFace g ram1 ram2 f vs \<Longrightarrow> vs \<noteq> [] \<Longrightarrow>
   edges g' = edges g \<union> Edges vs \<union> Edges(rev vs) \<union>
   {(ram2, last vs), (hd vs, ram1), (ram1, hd vs), (last vs, ram2)}"
   apply (subgoal_tac "edges g \<union> edges f = edges g")
   apply (frule splitFace_edges_g'_help) apply simp apply simp apply simp
   apply (frule pre_splitFace_edges_f_in_g) by blast
 
 
 lemma splitFace_edges_g'_vs: "pre_splitFace g ram1 ram2 f [] \<Longrightarrow>
   (f12, f21, g') = splitFace g ram1 ram2 f []  \<Longrightarrow>
   edges g' = edges g \<union> {(ram1, ram2), (ram2, ram1)}"
 proof -
   assume pre: "pre_splitFace g ram1 ram2 f []"
     and fdg: "(f12, f21, g') = splitFace g ram1 ram2 f []"
 
   from pre fdg have split: "(f12, f21) = split_face f ram1 ram2 []"
     apply (unfold pre_splitFace_def) apply (elim conjE)
     by (simp add: splitFace_split_face)
 
   from fdg pre have "edges g' = (\<Union>\<^bsub>a\<in>set (replace f [f21] (faces g))\<^esub> edges a) \<union>
        edges (f12)" by (auto simp: splitFace_def split_def edges_graph_def)
   with pre show ?thesis apply (simp add: UNION_eq) apply (rule equalityI) apply simp
     apply (rule conjI) apply (rule subsetI) apply simp apply (erule bexE) apply (drule replace5)
     apply (case_tac "xa \<in> \<F> g") apply simp
     apply (subgoal_tac "x \<in> edges g") apply simp
     apply (simp add: edges_graph_def) apply force
     apply simp
     apply (subgoal_tac "pre_split_face f ram1 ram2 []")
     apply (case_tac "between (vertices f) ram2 ram1 = []") apply (simp add: pre_FaceDiv_between2)
       apply (frule split_face_edges_f21_vs) apply (rule split) apply simp apply simp apply simp
       apply (case_tac "x = (ram1, ram2)") apply simp apply simp apply (rule disjI2)
       apply (rule pre_splitFace_edges_f_in_g2)  apply simp
       apply (subgoal_tac "pre_split_face f ram1 ram2 []")
       apply (frule split_face_edges_f) apply simp apply simp apply (rule pre_FaceDiv_between1) apply simp apply simp
       apply simp apply force  apply simp apply simp
 
     apply (rule subsetI) apply simp
     apply (subgoal_tac "pre_split_face f ram1 ram2 []")
     apply (case_tac "between (vertices f) ram1 ram2 = []") apply (simp add: pre_FaceDiv_between1)
       apply (frule split_face_edges_f12_vs) apply (rule split) apply simp apply simp apply simp
       apply (case_tac "x = (ram2, ram1)") apply simp apply simp apply (rule disjI2)
       apply (rule pre_splitFace_edges_f_in_g2)  apply simp
       apply (subgoal_tac "pre_split_face f ram1 ram2 []")
       apply (frule split_face_edges_f) apply simp apply simp apply simp apply (rule pre_FaceDiv_between2) apply simp
       apply simp apply force apply simp apply simp
    apply simp
    apply (subgoal_tac "pre_split_face f ram1 ram2 []")
    apply (subgoal_tac "(ram1, ram2) \<in> edges f21")
    apply (rule conjI) apply (rule disjI1) apply (rule bexI) apply simp apply (force)
    apply (subgoal_tac "(ram2, ram1) \<in> edges f12")
    apply (rule conjI) apply force
    apply (rule subsetI) apply (simp add: edges_graph_def) apply (elim bexE)
      apply (case_tac "xa = f") apply simp
      apply (subgoal_tac "\<exists> u v. x = (u,v)") apply (elim exE conjE)
      apply (subgoal_tac "pre_split_face f ram1 ram2 []")
      apply (frule split_face_edges_or [OF split]) apply simp
      apply (case_tac "(u, v) \<in> edges f12") apply simp apply simp apply force apply simp  apply simp
      apply (rule disjI1) apply (rule bexI) apply simp apply (rule replace4) apply simp apply force
    apply (frule split_face_edges_f12_vs) apply simp apply (rule split) apply simp
      apply (rule pre_FaceDiv_between1) apply simp apply simp
    apply (frule split_face_edges_f21_vs) apply simp apply (rule split) apply simp
      apply (rule pre_FaceDiv_between2) apply simp apply simp
    by simp
 qed
 
 
 lemma splitFace_edges_incr:
  "pre_splitFace g ram1 ram2 f vs \<Longrightarrow>
   (f\<^sub>1, f\<^sub>2, g') = splitFace g ram1 ram2 f vs  \<Longrightarrow>
   edges g \<subseteq> edges g'"
 apply(cases vs)
  apply(simp add:splitFace_edges_g'_vs)
  apply blast
 apply(simp add:splitFace_edges_g')
 apply blast
 done
 
 lemma snd_snd_splitFace_edges_incr:
  "pre_splitFace g v\<^sub>1 v\<^sub>2 f vs \<Longrightarrow>
   edges g \<subseteq> edges(snd(snd(splitFace g v\<^sub>1 v\<^sub>2 f vs)))"
 apply(erule splitFace_edges_incr
  [where f\<^sub>1 = "fst(splitFace g v\<^sub>1 v\<^sub>2 f vs)"
   and f\<^sub>2 = "fst(snd(splitFace g v\<^sub>1 v\<^sub>2 f vs))"])
 apply(auto)
 done
 
 
 (********************* Vorbereitung für subdivFace *****************)
 
 (**** computes the list of ram vertices **********)
 subsection \<open>\<open>removeNones\<close>\<close>
 
 definition removeNones :: "'a option list \<Rightarrow> 'a list" where
 "removeNones vOptionList \<equiv> [the x. x \<leftarrow> vOptionList, x \<noteq> None]"
 
 (* "removeNones vOptionList \<equiv> map the [x \<in> vOptionList. x \<noteq> None]" *)
 
 declare  removeNones_def [simp]
 lemma removeNones_inI[intro]: "Some a \<in> set ls \<Longrightarrow> a \<in> set (removeNones ls)" by (induct ls)  auto
 lemma removeNones_hd[simp]: "removeNones ( Some a # ls) = a # removeNones ls" by auto
 lemma removeNones_last[simp]: "removeNones (ls @ [Some a]) = removeNones ls @ [a]" by auto
 lemma removeNones_in[simp]: "removeNones (as @ Some a # bs) = removeNones as @ a # removeNones bs" by auto
 lemma removeNones_none_hd[simp]: "removeNones ( None # ls) = removeNones ls" by auto
 lemma removeNones_none_last[simp]: "removeNones (ls @ [None]) = removeNones ls" by auto
 lemma removeNones_none_in[simp]: "removeNones (as @ None # bs) = removeNones (as @ bs)" by auto
 lemma removeNones_empty[simp]: "removeNones [] = []" by auto
 declare removeNones_def [simp del]
 
 
 
 
 
 (************* natToVertexList ************)
 subsection\<open>\<open>natToVertexList\<close>\<close>
 
 (* Hilfskonstrukt natToVertexList *)
 primrec natToVertexListRec ::
   "nat \<Rightarrow> vertex \<Rightarrow> face \<Rightarrow> nat list \<Rightarrow> vertex option list"
 where
   "natToVertexListRec old v f [] = []" |
   "natToVertexListRec old v f (i#is) =
     (if i = old then None#natToVertexListRec i v f is
      else Some (f\<^bsup>i\<^esup> \<bullet> v)
           # natToVertexListRec i v f is)"
 
 primrec natToVertexList ::
   "vertex \<Rightarrow> face \<Rightarrow> nat list \<Rightarrow> vertex option list"
 where
   "natToVertexList v f [] = []" |
   "natToVertexList v f (i#is) =
     (if i = 0 then (Some v)#(natToVertexListRec i v f is) else [])"
 
 
 subsection \<open>@{const indexToVertexList}\<close>
 
 lemma  nextVertex_inj:
  "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow>
  i < length (vertices (f::face)) \<Longrightarrow> a < length (vertices f) \<Longrightarrow>
  f\<^bsup>a\<^esup>\<bullet>v = f\<^bsup>i\<^esup>\<bullet>v \<Longrightarrow> i = a"
 proof -
   assume d: "distinct (vertices f)" and v: "v \<in> \<V> f" and i: "i < length (vertices (f::face))"
     and a: "a < length (vertices f)" and eq:" f\<^bsup>a\<^esup>\<bullet>v = f\<^bsup>i\<^esup>\<bullet>v"
   then have eq: "(verticesFrom f v)!a = (verticesFrom f v)!i " by (simp add: verticesFrom_nth)
   define xs where "xs = verticesFrom f v"
   with eq have eq: "xs!a = xs!i" by auto
   from d v have z: "distinct (verticesFrom f v)" by auto
   moreover
   from xs_def a v d have "(verticesFrom f v) = take a xs @ xs ! a # drop (Suc a) xs"
     by (auto intro: id_take_nth_drop simp: verticesFrom_length)
   with eq have "(verticesFrom f v) = take a xs @ xs ! i # drop (Suc a) xs" by simp
   moreover
   from xs_def i v d have "(verticesFrom f v) = take i xs @ xs ! i # drop (Suc i) xs"
     by (auto intro: id_take_nth_drop simp: verticesFrom_length)
   ultimately have "take a xs = take i xs" by (rule dist_at1)
   moreover
   from v d have vertFrom[simp]: "length (vertices f) = length (verticesFrom f v)"
     by (auto simp: verticesFrom_length)
   from xs_def a i have "a < length xs" "i < length xs" by auto
   moreover
   have "\<And> a i. a < length xs \<Longrightarrow> i < length xs \<Longrightarrow> take a xs = take i xs \<Longrightarrow> a = i"
   proof (induct xs)
     case Nil then show ?case by auto
   next
     case (Cons x xs) then show ?case
       apply (cases a) apply auto
       apply (cases i) apply auto
       apply (cases i) by auto
   qed
   ultimately show ?thesis by simp
 qed
 
 lemma a: "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow> (\<forall>i \<in> set is. i < length (vertices f)) \<Longrightarrow>
  (\<And>a. a < length (vertices f) \<Longrightarrow> hideDupsRec ((f \<bullet> ^^ a) v) [(f \<bullet> ^^ k) v. k \<leftarrow> is] = natToVertexListRec a v f is)"
 proof (induct "is")
   case Nil then show ?case by simp
 next
   case (Cons i "is") then show ?case
    by (auto simp: nextVertices_def intro: nextVertex_inj)
 qed
 
 lemma indexToVertexList_natToVertexList_eq: "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow>
   (\<forall>i \<in> set is. i < length (vertices f)) \<Longrightarrow> is \<noteq> [] \<Longrightarrow>
  hd is = 0 \<Longrightarrow> indexToVertexList f v is = natToVertexList v f is"
 apply (cases "is") by (auto simp: a [where a = 0, simplified] indexToVertexList_def nextVertices_def)
 
 
 
 (********************* Einschub Ende ***************************************)
 
 
 (******** natToVertexListRec ************)
 
 lemma nvlr_length: "\<And> old.  (length (natToVertexListRec old v f ls)) = length ls"
 apply (induct ls) by auto
 
 lemma nvl_length[simp]: "hd e = 0 \<Longrightarrow> length (natToVertexList v f e) = length e"
 apply (cases "e")
 by (auto intro: nvlr_length)
 
 
 lemma natToVertexListRec_length[simp]: "\<And> e f. length (natToVertexListRec e v f es) = length es"
 by (induct es) auto
 
 lemma natToVertexList_length[simp]: "incrIndexList es (length es) (length (vertices f)) \<Longrightarrow>
 length (natToVertexList v f es) = length es" apply (case_tac es) by simp_all
 
 
 lemma  natToVertexList_nth_Suc: "incrIndexList es (length es) (length (vertices f)) \<Longrightarrow> Suc n < length es \<Longrightarrow>
 (natToVertexList v f es)!(Suc n) = (if (es!n = es!(Suc n)) then None else Some (f\<^bsup>(es!Suc n)\<^esup> \<bullet> v))"
 proof -
   assume incr: "incrIndexList es (length es) (length (vertices f))" and n: "Suc n < length es"
   have rec: "\<And> old n. Suc n < length es \<Longrightarrow>
     (natToVertexListRec old v f es)!(Suc n) = (if (es!n = es!(Suc n)) then None else Some (f\<^bsup>(es!Suc n)\<^esup> \<bullet> v))"
   proof (induct es)
     case Nil then show ?case by auto
   next
     case (Cons e es)
     note cons1 = this
     then show ?case
     proof (cases es)
       case Nil with cons1 show ?thesis by simp
     next
       case (Cons e' es')
       with cons1 show ?thesis
       proof (cases n)
         case 0 with Cons cons1 show ?thesis by simp
       next
         case (Suc m) with Cons cons1
         have "\<And> old. natToVertexListRec old v f es ! Suc m = (if es ! m = es ! Suc m then None else Some (f\<^bsup>es ! Suc m\<^esup> \<bullet> v))"
           by (rule_tac cons1) auto
         then show ?thesis apply (cases "e = old") by (simp_all add: Suc)
       qed
     qed
   qed
   with  n have "natToVertexListRec 0 v f es ! Suc n = (if es ! n = es ! Suc n then None else Some (f\<^bsup>es ! Suc n\<^esup> \<bullet> v))" by (rule_tac rec) auto
   with incr show ?thesis by (cases es) auto
 qed
 
 lemma  natToVertexList_nth_0: "incrIndexList es (length es) (length (vertices f)) \<Longrightarrow> 0 < length es \<Longrightarrow>
 (natToVertexList v f es)!0 = Some (f\<^bsup>(es!0)\<^esup> \<bullet> v)"
  apply (cases es) 
  apply (simp_all add: nextVertices_def)
  by (subgoal_tac "a = 0")  auto
 
 lemma  natToVertexList_hd[simp]:
   "incrIndexList es (length es) (length (vertices f)) \<Longrightarrow> hd (natToVertexList v f es) = Some v"
   apply (cases es) by (simp_all add: nextVertices_def)
 
 lemma nth_last[intro]: "Suc i = length xs \<Longrightarrow>  xs!i = last xs"
 by (cases xs rule: rev_exhaust)  auto
 
 
 declare incrIndexList_help4 [simp del]
 
 lemma natToVertexList_last[simp]:
   "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow> incrIndexList es (length es) (length (vertices f)) \<Longrightarrow> last (natToVertexList v f es) = Some (last (verticesFrom f v))"
 proof -
   assume vors: "distinct (vertices f)" "v \<in> \<V> f" and incr: "incrIndexList es (length es) (length (vertices f))"
   define n' where "n' = length es - 2"
   from incr have "1 < length es" by auto
   with n'_def have n'l: "Suc (Suc n') = length es" by arith
   from incr n'l have last_ntvl: "(natToVertexList v f es)!(Suc n') = last (natToVertexList v f es)" by auto
   from n'l have last_es: "es!(Suc n') = last es" by auto
   from n'l  have "es!n' = last (butlast es)" apply (cases es rule: rev_exhaust) by (auto simp: nth_append)
   with last_es incr have less: "es!n' < es!(Suc n')" by auto
   from n'l have "Suc n' < length es" by arith
   with incr less have "(natToVertexList v f es)!(Suc n') = (Some (f\<^bsup>(es!Suc n')\<^esup> \<bullet> v))" by (auto dest: natToVertexList_nth_Suc)
   with incr last_ntvl last_es have rule1: "last (natToVertexList v f es) = Some (f\<^bsup>((length (vertices f)) - (Suc 0))\<^esup> \<bullet> v)" by auto
 
   from incr have lvf: "1 < length (vertices f)" by auto
   with vors have rule2: "verticesFrom f v ! ((length (vertices f)) - (Suc 0)) = f\<^bsup>((length (vertices f)) - (Suc 0))\<^esup> \<bullet> v" by (auto intro!: verticesFrom_nth)
 
   from vors lvf have "verticesFrom f v ! ((length (vertices f)) - (Suc 0)) = last (verticesFrom f v)"
     apply (rule_tac nth_last)
     by (auto simp: verticesFrom_length)
   with rule1 rule2 show ?thesis by auto
 qed
 
 lemma indexToVertexList_last[simp]:
   "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow> incrIndexList es (length es) (length (vertices f)) \<Longrightarrow> last (indexToVertexList f v es) = Some (last (verticesFrom f v))"
 apply (subgoal_tac "indexToVertexList f v es = natToVertexList v f es") apply simp
 apply (rule indexToVertexList_natToVertexList_eq) by auto
 
 lemma nths_take: "\<And> n iset. \<forall> i \<in> iset. i < n \<Longrightarrow> nths (take n xs) iset = nths xs iset"
 proof (induct xs)
   case Nil then show ?case by simp
 next
   case (Cons x xs) then show ?case apply (simp add: nths_Cons) apply (cases n) apply simp apply (simp add: nths_Cons) apply (rule Cons) by auto
 qed
 
 
 lemma nths_reduceIndices: "\<And> iset. nths xs iset = nths xs {i. i < length xs \<and> i \<in> iset}"
 proof (induct xs)
   case Nil then show ?case by simp
 next
   case (Cons x xs) then
   have "nths xs {j. Suc j \<in> iset} = nths xs {i. i < length xs \<and> i \<in> {j. Suc j \<in> iset}}" by (rule_tac Cons)
   then show ?case by (simp add: nths_Cons)
 qed
 
 lemma natToVertexList_nths1: "distinct (vertices f) \<Longrightarrow>
   v \<in> \<V> f \<Longrightarrow> vs = verticesFrom f v \<Longrightarrow>
   incrIndexList es (length es) (length vs) \<Longrightarrow> n \<le>  length es \<Longrightarrow>
   nths (take (Suc (es!(n - 1))) vs) (set (take n es))
   = removeNones (take n (natToVertexList v f es))"
 proof (induct n)
   case 0 then show ?case by simp
 next
   case (Suc n)
   then have "nths (take (Suc (es ! (n - Suc 0))) (verticesFrom f v)) (set (take n es)) = removeNones (take n (natToVertexList v f es))"
     "distinct (vertices f)" "v \<in> \<V> f" "vs = verticesFrom f v" "incrIndexList es (length es) (length (verticesFrom f v))" "Suc n \<le> length es" by auto  (* does this improve the performance? *)
   note suc1 = this
   then have lvs: "length vs = length (vertices f)" by (auto intro: verticesFrom_length)
   with suc1 have vsne: "vs \<noteq> []" by auto
   with suc1 show ?case
   proof (cases "natToVertexList v f es ! n")
     case None then show ?thesis
     proof (cases n)
       case 0 with None suc1 lvs show ?thesis by (simp add: take_Suc_conv_app_nth natToVertexList_nth_0)
     next
       case (Suc n')
       with None suc1 lvs have esn: "es!n = es!n'" by (simp add: natToVertexList_nth_Suc split: if_split_asm)
       from Suc have n': "n - Suc 0 = n'" by auto
       show ?thesis
       proof (cases "Suc n = length es")
         case True then
         have small_n: "n < length es" by auto
         from True have "take (Suc n) es = es" by auto
         with small_n have "take n es @ [es!n] = es" by (simp add: take_Suc_conv_app_nth)
         then have esn_simps: "take n es = butlast es \<and>  es!n = last es" by (cases es rule: rev_exhaust) auto
 
         from True Suc have n'l: "Suc n' = length (butlast es)" by auto
         then have small_n': "n' < length (butlast es)" by auto
 
         from Suc small_n have take_n': "take (Suc n') (butlast es @ [last es]) = take (Suc n') (butlast es)" by auto
         
         from small_n have es_exh: "es = butlast es @ [last es]" by (cases es rule: rev_exhaust) auto
         
         from n'l have "take (Suc n') (butlast es @ [last es]) = butlast es" by auto
         with es_exh have "take (Suc n') es = butlast es" by auto
         with small_n Suc have "take n' es @ [es!n'] = (butlast es)" by (simp add: take_Suc_conv_app_nth)
         with small_n' have esn'_simps: "take n' es = butlast (butlast es) \<and>  es!n' = last (butlast es)"
           by (cases "butlast es" rule: rev_exhaust) auto
 
         from suc1 have "last (butlast es) < last es" by auto
         with esn esn_simps esn'_simps have False by auto (* have "last (butlast es) = last es" by auto  *)
         then show ?thesis by auto
       next
         case False with suc1 have le: "Suc n < length es" by auto
         from suc1 le have "es = take (Suc n) es @ es!(Suc n) # drop (Suc (Suc n)) es" by (auto intro: id_take_nth_drop)
         with suc1 have "increasing (take (Suc n) es @ es!(Suc n) # drop (Suc (Suc n)) es)" by auto
         then have "\<forall> i \<in> (set (take (Suc n) es)). i \<le>  es ! (Suc n)" by (auto intro: increasing2)
         with suc1 have  "\<forall> i \<in> (set (take n es)). i \<le>  es ! (Suc n)" by (simp add: take_Suc_conv_app_nth)
         then have seq: "nths (take (Suc (es ! Suc n)) (verticesFrom f v)) (set (take n es))
           = nths (verticesFrom f v) (set (take n es))"
           apply (rule_tac nths_take) by auto
         from suc1 have "es = take n es @ es!n # drop (Suc n) es" by (auto intro: id_take_nth_drop)
         with suc1 have "increasing (take n es @ es!n # drop (Suc n) es)" by auto
         then have "\<forall> i \<in> (set (take n es)). i \<le>  es ! n" by (auto intro: increasing2)
         with suc1 esn have  "\<forall> i \<in> (set (take n es)). i \<le>  es ! n'" by (simp add: take_Suc_conv_app_nth)
         with Suc have seq2: "nths (take (Suc (es ! n')) (verticesFrom f v)) (set (take n es))
          = nths  (verticesFrom f v) (set (take n es))"
           apply (rule_tac nths_take) by auto
         from Suc suc1 have "(insert (es ! n') (set (take n es))) = set (take n es)"
         apply auto by (simp add: take_Suc_conv_app_nth)
         with esn None suc1 seq seq2 n' show ?thesis by (simp add: take_Suc_conv_app_nth)
       qed
     qed
   next
     case (Some v') then show ?thesis
     proof (cases n)
       case 0
       from suc1 lvs have "verticesFrom f v \<noteq> []" by auto
       then have "verticesFrom f v = hd (verticesFrom f v) # tl (verticesFrom f v)" by auto
       then have "verticesFrom f v = v # tl (verticesFrom f v)" by (simp add: verticesFrom_hd)
       then obtain z where "verticesFrom f v = v # z" by auto
       then have sub: "nths (verticesFrom f v) {0} = [v]" by (auto simp: nths_Cons)
       from 0 suc1 have "es!0 = 0" by (cases es)  auto
       with 0 Some suc1 lvs sub vsne show ?thesis
         by (simp add: take_Suc_conv_app_nth natToVertexList_nth_0 nextVertices_def take_Suc
         nths_Cons verticesFrom_hd del:verticesFrom_empty)
     next
       case (Suc n')
       with Some suc1 lvs have esn: "es!n \<noteq> es!n'" by (simp add: natToVertexList_nth_Suc split: if_split_asm)
       from suc1 Suc have "Suc n' < length es" by auto
       with suc1 lvs esn  have "natToVertexList v f es !(Suc n') = Some (f\<^bsup>(es!(Suc n'))\<^esup> \<bullet> v)"
       apply (simp add: natToVertexList_nth_Suc)
         by (simp add: Suc)
       with Suc have "natToVertexList v f es ! n = Some (f\<^bsup>(es!n)\<^esup> \<bullet> v)" by auto
       with Some have v': "v' = f\<^bsup>(es!n)\<^esup> \<bullet> v" by simp
       from Suc have n': "n - Suc 0 = n'" by auto
       from suc1 Suc have "es = take (Suc n') es @ es!n # drop (Suc n) es" by (auto intro: id_take_nth_drop)
       with suc1 have  "increasing (take (Suc n') es @ es!n # drop (Suc n) es)" by auto
       with suc1 Suc have "es!n' \<le>  es!n" apply (auto intro!: increasing2)
       by (auto simp: take_Suc_conv_app_nth)
       with esn have smaller_n: "es!n' < es!n" by auto
       from suc1 lvs have smaller: "(es!n) < length vs" by auto
       from suc1 smaller lvs have "(verticesFrom f v)!(es!n) =  f\<^bsup>(es!n)\<^esup> \<bullet> v" by (auto intro: verticesFrom_nth)
       with v' have "(verticesFrom f v)!(es!n) = v'" by auto
       then have sub1: "nths ([((verticesFrom f v)!(es!n))])
           {j. j + (es!n) : (insert (es ! n) (set (take n es)))} = [v']" by auto
 
       from suc1 smaller lvs have len: "length (take (es ! n) (verticesFrom f v)) = es!n" by auto
 
       have "\<And>x. x \<in> (set (take n es)) \<Longrightarrow> x < (es ! n)"
       proof -
         fix x
         assume x: "x \<in> set (take n es)"
         from suc1 Suc have "es = take n' es @ es!n' # drop (Suc n') es" by (auto intro: id_take_nth_drop)
         with suc1 have "increasing (take n' es @ es!n' # drop (Suc n') es)" by auto
         then have "\<And> x. x \<in> set (take n' es) \<Longrightarrow> x \<le> es!n'" by (auto intro!: increasing2)
         with x Suc suc1 have "x \<le> es!n'" by (auto simp: take_Suc_conv_app_nth)
         with smaller_n show "x < es!n" by auto
       qed
       then have "{i. i < es ! n \<and> i \<in> set (take n es)} = (set (take n es))" by auto
       then have elim_insert: "{i. i < es ! n \<and> i \<in> insert (es ! n) (set (take n es))} = (set (take n es))" by auto
 
       have "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
         nths (take (es ! n) (verticesFrom f v)) {i. i < length (take (es ! n) (verticesFrom f v))
          \<and> i \<in> (insert (es ! n) (set (take n es)))}" by (rule nths_reduceIndices)
       with len have "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
         nths (take (es ! n) (verticesFrom f v)) {i. i < (es ! n) \<and> i \<in> (insert (es ! n) (set (take n es)))}"
         by simp
       with elim_insert have sub2: "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
         nths (take (es ! n) (verticesFrom f v)) (set (take n es))" by simp
 
       define m where "m = es!n - es!n'"
       with smaller_n have mgz: "0 < m" by auto
       with m_def have esn: "es!n = (es!n') + m" by auto
 
       have helper: "\<And>x. x \<in> (set (take n es)) \<Longrightarrow> x \<le>  (es ! n')"
       proof -
         fix x
         assume x: "x \<in> set (take n es)"
         from suc1 Suc have "es = take n' es @ es!n' # drop (Suc n') es" by (auto intro: id_take_nth_drop)
         with suc1 have "increasing (take n' es @ es!n' # drop (Suc n') es)" by auto
         then have "\<And> x. x \<in> set (take n' es) \<Longrightarrow> x \<le> es!n'" by (auto intro!: increasing2)
         with x Suc suc1 show "x \<le> es!n'" by (auto simp: take_Suc_conv_app_nth)
       qed
 
       define m' where "m' = m - 1"
       define Suc_es_n' where "Suc_es_n' = Suc (es!n')"
 
       from smaller smaller_n have "Suc (es!n') < length vs" by auto
       then have "min (length vs) (Suc (es ! n')) = Suc (es!n')" by arith
       with Suc_es_n'_def have empty: "{j. j + length (take Suc_es_n' vs) \<in> set (take n es)} = {}"
         apply auto apply (frule helper) by arith
 
 
       from Suc_es_n'_def mgz esn m'_def have esn': "es!n = Suc_es_n' + m'" by auto
 
       with smaller have "(take (Suc_es_n' + m') vs) = take (Suc_es_n') vs @ take m' (drop (Suc_es_n') vs)"
         by (auto intro: take_add)
       with esn' have "nths (take (es ! n) vs) (set (take n es))
          = nths (take (Suc_es_n') vs @ take m' (drop (Suc_es_n') vs)) (set (take n es))" by auto
       then have "nths (take (es ! n) vs) (set (take n es)) =
         nths (take (Suc_es_n') vs) (set (take n es)) @
         nths (take m' (drop (Suc_es_n') vs)) {j. j + length (take (Suc_es_n') vs) : (set (take n es))}"
         by (simp add: nths_append)
       with empty Suc_es_n'_def have "nths (take (es ! n) vs) (set (take n es)) =
         nths (take (Suc (es!n')) vs) (set (take n es))" by simp
       with suc1 sub2 have sub3: "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
         nths (take (Suc (es!n')) (verticesFrom f v)) (set (take n es))" by simp
         
       from smaller suc1 have "take (Suc (es ! n)) (verticesFrom f v)
        = take (es ! n) (verticesFrom f v) @ [((verticesFrom f v)!(es!n))]"
        by (auto simp: take_Suc_conv_app_nth)
       with suc1 smaller have
         "nths (take (Suc (es ! n)) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
          nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es)))
          @ nths ([((verticesFrom f v)!(es!n))])  {j. j + (es!n) : (insert (es ! n) (set (take n es)))}"
         by (auto simp: nths_append)
       with sub1 sub3 have "nths (take (Suc (es ! n)) (verticesFrom f v)) (insert (es ! n) (set (take n es)))
        = nths (take (Suc (es ! n')) (verticesFrom f v)) (set (take n es)) @ [v']" by auto
       with Some suc1 lvs n' show ?thesis by (simp add: take_Suc_conv_app_nth)
     qed
   qed
 qed
 
 lemma natToVertexList_nths: "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow>
   incrIndexList es (length es) (length (vertices f)) \<Longrightarrow>
   nths (verticesFrom f v) (set es) = removeNones (natToVertexList v f es)"
 proof -
   assume vors1: "distinct (vertices f)" "v \<in> \<V> f"
      "incrIndexList es (length es) (length (vertices f))"
   define vs where "vs = verticesFrom f v"
   with vors1 have lvs: "length vs = length (vertices f)"  by (auto intro: verticesFrom_length)
   with vors1 vs_def have vors: "distinct (vertices f)" "v \<in> \<V> f"
     "vs = verticesFrom f v"  "incrIndexList es (length es) (length vs)" by auto
 
   with lvs have vsne: "vs \<noteq> []" by auto
   define n where "n = length es"
   then have "es!(n - 1) = last es"
   proof (cases n)
     case 0 with n_def vors show ?thesis by (cases es)  auto
   next
     case (Suc n')
     with n_def have small_n': "n' < length es" by arith
     from Suc n_def have "take (Suc n') es = es" by auto
     with small_n' have "take n' es @ [es!n'] = es" by (simp add: take_Suc_conv_app_nth)
     then have "es!n' = last es" by (cases es rule: rev_exhaust) auto
     with Suc show ?thesis by auto
   qed
   with vors have "es!(n - 1) = (length vs) - 1" by auto
   with vsne have "Suc (es! (n - 1)) = (length vs)" by auto
   then have take_vs: "take (Suc (es!(n - 1))) vs = vs" by auto
 
   from n_def vors have "n =  length (natToVertexList v f es)" by auto
   then have take_nTVL: "take n (natToVertexList v f es) = natToVertexList v f es" by auto
 
   from n_def have take_es: "take n es = es" by auto
 
   from n_def have "n \<le> length es" by auto
   with vors   have "nths (take (Suc (es!(n - 1))) vs) (set (take n es))
     = removeNones (take n (natToVertexList v f es))" by (rule natToVertexList_nths1)
   with take_vs take_nTVL take_es vs_def show ?thesis by simp
 qed
 
 
 lemma filter_Cons2:
  "x \<notin> set ys \<Longrightarrow> [y\<leftarrow>ys.  y = x \<or> P y] = [y\<leftarrow>ys. P y]"
  by (induct ys) (auto)
 
 lemma natToVertexList_removeNones:
   "distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow>
   incrIndexList es (length es) (length (vertices f)) \<Longrightarrow>
   [x\<leftarrow>verticesFrom f v. x \<in> set (removeNones (natToVertexList v f es))]
  = removeNones (natToVertexList v f es)"
 proof -
   assume vors: "distinct (vertices f)" "v \<in> \<V> f"
     "incrIndexList es (length es) (length (vertices f))"
   then have dist: "distinct (verticesFrom f v)" by auto
   from vors have sub_eq: "nths (verticesFrom f v) (set es)
     = removeNones (natToVertexList v f es)" by (rule natToVertexList_nths)
   from dist have "[x \<leftarrow> verticesFrom f v.
     x \<in> set (nths (verticesFrom f v) (set es))] = removeNones (natToVertexList v f es)"
   apply (simp add: filter_in_nths)
     by (simp add: sub_eq)
   with sub_eq show ?thesis by simp
 qed
 
 (**************************** invalidVertexList ************)
 
 definition is_duplicateEdge :: "graph \<Rightarrow> face \<Rightarrow> vertex \<Rightarrow> vertex \<Rightarrow> bool" where
  "is_duplicateEdge g f a b \<equiv>
    ((a, b) \<in> edges g \<and> (a, b) \<notin> edges f \<and> (b, a) \<notin> edges f)
  \<or> ((b, a) \<in> edges g \<and> (b, a) \<notin> edges f \<and> (a, b) \<notin> edges f)"
 
 definition invalidVertexList :: "graph \<Rightarrow> face \<Rightarrow> vertex option list \<Rightarrow> bool" where
  "invalidVertexList g f vs \<equiv>
      \<exists>i < |vs|- 1.
          case vs!i of None \<Rightarrow> False
              | Some a \<Rightarrow> case vs!(i+1) of None \<Rightarrow> False
              | Some b \<Rightarrow> is_duplicateEdge g f a b"
 
 
 (**************************** subdivFace **********************)
 
 subsection \<open>\<open>pre_subdivFace(')\<close>\<close>
 
 definition pre_subdivFace_face :: "face \<Rightarrow> vertex \<Rightarrow> vertex option list \<Rightarrow> bool" where
 "pre_subdivFace_face f v' vOptionList \<equiv>
      [v \<leftarrow> verticesFrom f v'. v \<in> set (removeNones vOptionList)]
        = (removeNones vOptionList)
   \<and> \<not> final f \<and> distinct (vertices f)
   \<and> hd (vOptionList) = Some v'
   \<and> v' \<in> \<V> f
   \<and> last (vOptionList) =  Some (last (verticesFrom f v'))
   \<and> hd (tl (vOptionList)) \<noteq> last (vOptionList)
   \<and> 2 < | vOptionList |
   \<and> vOptionList \<noteq>  []
   \<and> tl (vOptionList) \<noteq> []"
 
 definition pre_subdivFace :: "graph \<Rightarrow> face \<Rightarrow> vertex \<Rightarrow> vertex option list \<Rightarrow> bool" where
 "pre_subdivFace g f v' vOptionList \<equiv>
   pre_subdivFace_face f v' vOptionList \<and> \<not> invalidVertexList g f vOptionList"
 
 (* zu teilende Fläche, ursprüngliches v, erster Ram-Punkt, Anzahl der überlaufenen NOnes, rest der vol *)
 definition pre_subdivFace' :: "graph \<Rightarrow> face \<Rightarrow> vertex \<Rightarrow> vertex \<Rightarrow> nat \<Rightarrow> vertex option list \<Rightarrow> bool" where
 "pre_subdivFace' g f v' ram1 n vOptionList \<equiv>
   \<not> final f \<and> v' \<in> \<V> f \<and> ram1 \<in> \<V> f
   \<and> v' \<notin> set (removeNones vOptionList)
   \<and> distinct (vertices f)
   \<and> (
     [v \<leftarrow> verticesFrom f v'. v \<in> set (removeNones vOptionList)]
         =  (removeNones vOptionList)
   \<and> before (verticesFrom f v') ram1 (hd (removeNones vOptionList))
   \<and> last (vOptionList) =  Some (last (verticesFrom f v'))
   \<and> vOptionList \<noteq>  []
   \<and> ((v' = ram1 \<and> (0 < n)) \<or> ((v' = ram1 \<and> (hd (vOptionList) \<noteq> Some (last (verticesFrom f v'))))  \<or> (v' \<noteq> ram1)))
   \<and> \<not> invalidVertexList g f vOptionList
   \<and> (n = 0 \<and> hd (vOptionList) \<noteq> None \<longrightarrow>  \<not> is_duplicateEdge g f ram1 (the (hd (vOptionList))))
   \<or> (vOptionList = [] \<and> v' \<noteq> ram1)
   )"
 
 
 lemma pre_subdivFace_face_in_f[intro]: "pre_subdivFace_face f v ls \<Longrightarrow> Some a \<in> set ls \<Longrightarrow> a \<in> set (verticesFrom f v)"
   apply (subgoal_tac "a \<in> set (removeNones ls)") apply (auto  simp: pre_subdivFace_face_def)
   apply (subgoal_tac "a \<in> set [v\<leftarrow>verticesFrom f v . v \<in> set (removeNones ls)]")
   apply (thin_tac "[v\<leftarrow>verticesFrom f v . v \<in> set (removeNones ls)] = removeNones ls") by auto
 
 lemma pre_subdivFace_in_f[intro]: "pre_subdivFace g f v ls \<Longrightarrow> Some a \<in> set ls \<Longrightarrow> a \<in> set (verticesFrom f v)"
  by (auto simp: pre_subdivFace_def)
 
 
 lemma pre_subdivFace_face_in_f'[intro]: "pre_subdivFace_face f v ls \<Longrightarrow> Some a \<in> set ls \<Longrightarrow> a \<in> \<V> f"
   apply (cases "a = v") apply (force simp: pre_subdivFace_face_def)
  apply (rule verticesFrom_in') apply (rule pre_subdivFace_face_in_f)
 by auto
 
 
 lemma filter_congs_shorten1: "distinct (verticesFrom f v) \<Longrightarrow> [v\<leftarrow>verticesFrom f v . v = a \<or> v \<in> set vs] = (a # vs)
     \<Longrightarrow> [v\<leftarrow>verticesFrom f v . v \<in> set vs] = vs"
 proof -
   assume dist: "distinct (verticesFrom f v)" and eq: "[v\<leftarrow>verticesFrom  f v . v = a \<or> v \<in> set vs] = (a # vs)"
   have rule1: "\<And> vs a ys. distinct vs \<Longrightarrow> [v\<leftarrow>vs . v = a \<or> v \<in> set ys] = a # ys \<Longrightarrow> [v\<leftarrow>vs. v \<in> set ys] = ys"
   proof -
     fix vs a ys
     assume dist: "distinct vs" and ays:  "[v\<leftarrow>vs . v = a \<or> v \<in> set ys] = a # ys"
     then have "distinct ([v\<leftarrow>vs . v = a \<or> v \<in> set ys])" by (rule_tac distinct_filter)
     with ays have distys: "distinct (a # ys)" by simp
     from dist distys ays show "[v\<leftarrow>vs. v \<in> set ys] = ys"
      apply (induct vs) by (auto  split: if_split_asm simp: filter_Cons2)
   qed
 
   from dist eq show ?thesis  by (rule_tac rule1)
 qed
 
 lemma ovl_shorten: "distinct (verticesFrom f v) \<Longrightarrow>
   [v\<leftarrow>verticesFrom f v . v \<in> set (removeNones (va # vol))] = (removeNones (va # vol))
     \<Longrightarrow> [v\<leftarrow>verticesFrom f v . v \<in> set (removeNones (vol))] =  (removeNones (vol))"
 proof -
   assume dist: "distinct (verticesFrom f v)"
   and vors: "[v\<leftarrow>verticesFrom f v . v \<in> set (removeNones (va # vol))] = (removeNones (va # vol))"
   then show ?thesis
   proof (cases va)
     case None with vors Cons show ?thesis by auto
   next
     case (Some a) with vors dist show ?thesis by (auto intro!: filter_congs_shorten1)
   qed
 qed
 
 lemma pre_subdivFace_face_distinct: "pre_subdivFace_face f v vol \<Longrightarrow> distinct (removeNones vol)"
   apply (auto dest!: verticesFrom_distinct simp: pre_subdivFace_face_def)
   apply (subgoal_tac "distinct ([v\<leftarrow>verticesFrom f v . v \<in> set (removeNones vol)])") apply simp
   apply (thin_tac "[v\<leftarrow>verticesFrom f v . v \<in> set (removeNones vol)] = removeNones vol") by auto
 
 lemma invalidVertexList_shorten: "invalidVertexList g f vol \<Longrightarrow> invalidVertexList g f (v # vol)"
 apply (simp add: invalidVertexList_def) apply auto apply (rule exI) apply safe
 apply (subgoal_tac "(Suc i) < | vol |") apply assumption apply arith
 apply auto apply (case_tac "vol!i") by auto
 
 lemma pre_subdivFace_pre_subdivFace': "v \<in> \<V> f \<Longrightarrow> pre_subdivFace g f v (vo # vol) \<Longrightarrow>
   pre_subdivFace' g f v v 0 (vol)"
 proof -
   assume vors:  "v \<in> \<V> f"  "pre_subdivFace g f v (vo # vol)"
   then have vors': "v \<in> \<V> f" "pre_subdivFace_face f v (vo # vol)" "\<not> invalidVertexList g f (vo # vol)"
     by (auto simp: pre_subdivFace_def)
   then have r: "removeNones vol \<noteq> []" apply (cases "vol" rule: rev_exhaust) by  (auto  simp: pre_subdivFace_face_def)
   then have "Some (hd (removeNones vol)) \<in> set vol" apply (induct vol) apply auto apply (case_tac a) by auto
   then have "Some (hd (removeNones vol)) \<in> set (vo # vol)" by auto
   with vors' have hd: "hd (removeNones vol) \<in> \<V> f" by (rule_tac pre_subdivFace_face_in_f')
 
   from vors' have "Some v = vo" by (auto  simp: pre_subdivFace_face_def)
   with vors'  have "v \<notin> set (tl (removeNones (vo # vol)))" apply (drule_tac pre_subdivFace_face_distinct) by auto
   with vors' r have ne: "v \<noteq> hd (removeNones vol)" by (cases  "removeNones vol")  (auto  simp: pre_subdivFace_face_def)
 
   from vors' have dist: "distinct (removeNones (vo # vol))"  apply (rule_tac pre_subdivFace_face_distinct) .
 
   from vors' have invalid: "\<not> invalidVertexList g f vol" by (auto simp: invalidVertexList_shorten)
 
 
   from ne hd vors' invalid dist show ?thesis apply (unfold pre_subdivFace'_def)
     apply (simp add: pre_subdivFace'_def pre_subdivFace_face_def)
     apply safe
         apply (rule ovl_shorten)
          apply (simp add: pre_subdivFace_face_def) apply assumption
        apply (rule before_verticesFrom)
           apply simp+
     apply (simp add: invalidVertexList_def)
     apply (erule allE)
     apply (erule impE)
     apply (subgoal_tac "0 <  |vol|")
       apply (thin_tac "Suc 0 < | vol |")
       apply  assumption
      apply simp
     apply (simp)
     apply (case_tac "vol") apply simp by (simp add: is_duplicateEdge_def)
 qed
 
 
 lemma pre_subdivFace'_distinct: "pre_subdivFace' g f v' v n vol \<Longrightarrow> distinct (removeNones vol)"
   apply (unfold pre_subdivFace'_def)
   apply (cases vol) apply simp+
   apply (elim conjE)
   apply (drule_tac verticesFrom_distinct) apply assumption
   apply (subgoal_tac "distinct [v\<leftarrow>verticesFrom f v' . v \<in> set (removeNones (a # list))]") apply force
   apply (thin_tac "[v\<leftarrow>verticesFrom f v' . v \<in> set (removeNones (a # list))] = removeNones (a # list)")
   by auto
 
 
 lemma natToVertexList_pre_subdivFace_face:
  "\<not> final f \<Longrightarrow> distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow> 2 < |es| \<Longrightarrow>
  incrIndexList es (length es) (length (vertices f)) \<Longrightarrow>
  pre_subdivFace_face f v (natToVertexList v f es)"
 proof -
   assume vors: "\<not> final f" "distinct (vertices f)" "v \<in> \<V> f" "2 < |es|"
      "incrIndexList es (length es) (length (vertices f))"
   then have lastOvl: "last (natToVertexList v f es) =  Some (last (verticesFrom f v))" by auto
 
   from vors have nvl_l: "2 < | natToVertexList v f es |"
     by auto
 
   from vors have "distinct [x\<leftarrow>verticesFrom f v . x \<in> set (removeNones (natToVertexList v f es))]" by auto
   with vors have "distinct (removeNones (natToVertexList v f es))" by (simp add: natToVertexList_removeNones)
   with nvl_l lastOvl have hd_last: "hd (tl (natToVertexList v f es)) \<noteq> last (natToVertexList v f es)" apply auto
     apply (cases "natToVertexList v f es") apply simp
     apply (case_tac "list" rule: rev_exhaust) apply simp
     apply (case_tac "ys") apply simp
     apply (case_tac "a") apply simp by simp
 
   from vors lastOvl hd_last nvl_l show ?thesis
     apply (auto intro: natToVertexList_removeNones simp: pre_subdivFace_face_def)
     apply (cases es) apply auto
     apply (cases es) apply auto
     apply (subgoal_tac "0 < length list") apply (case_tac list) by (auto split: if_split_asm)
 qed
 
 
 lemma indexToVertexList_pre_subdivFace_face:
  "\<not> final f \<Longrightarrow> distinct (vertices f) \<Longrightarrow> v \<in> \<V> f \<Longrightarrow> 2 < |es| \<Longrightarrow>
  incrIndexList es (length es) (length (vertices f)) \<Longrightarrow>
  pre_subdivFace_face f v (indexToVertexList f v es)"
 apply (subgoal_tac "indexToVertexList f v es = natToVertexList v f es") apply simp
 apply (rule natToVertexList_pre_subdivFace_face) apply assumption+
 apply (rule indexToVertexList_natToVertexList_eq) by auto
 
 lemma subdivFace_subdivFace'_eq: "pre_subdivFace g f v vol \<Longrightarrow>  subdivFace g f vol = subdivFace' g f v 0 (tl vol)"
 by (simp_all add: subdivFace_def pre_subdivFace_def pre_subdivFace_face_def)
 
 lemma pre_subdivFace'_None:
  "pre_subdivFace' g f v' v n (None # vol) \<Longrightarrow>
   pre_subdivFace' g f v' v (Suc n) vol"
 by(auto simp: pre_subdivFace'_def dest:invalidVertexList_shorten
         split:if_split_asm)
 
 declare verticesFrom_between [simp del]
 
 
 (* zu zeigen:
  1. vol \<noteq> [] \<Longrightarrow> [v\<in>verticesFrom f21 v' . v \<in> set (removeNones vol)] = removeNones vol
  2. vol \<noteq> [] \<Longrightarrow> before (verticesFrom f21 v') u (hd (removeNones vol))
  3. vol \<noteq> [] \<Longrightarrow> distinct (vertices f21)
  4. vol \<noteq> [] \<Longrightarrow> last vol = Some (last (verticesFrom f21 v'))
 *)
 
 lemma verticesFrom_split: "v # tl (verticesFrom f v) = verticesFrom f v" by (auto simp: verticesFrom_Def)
 
 lemma verticesFrom_v: "distinct (vertices f) \<Longrightarrow> vertices f = a @ v # b \<Longrightarrow> verticesFrom f v = v # b @ a"
 by (simp add: verticesFrom_Def)
 
 
 lemma splitAt_fst[simp]: "distinct xs \<Longrightarrow> xs = a @ v # b \<Longrightarrow> fst (splitAt v xs) = a"
 by auto
 
 lemma splitAt_snd[simp]: "distinct xs \<Longrightarrow> xs = a @ v # b \<Longrightarrow> snd (splitAt v xs) = b"
 by auto
 
 lemma verticesFrom_splitAt_v_fst[simp]:
   "distinct (verticesFrom f v) \<Longrightarrow> fst (splitAt v (verticesFrom f v)) = []"
   by (simp add: verticesFrom_Def)
 lemma verticesFrom_splitAt_v_snd[simp]:
   "distinct (verticesFrom f v) \<Longrightarrow> snd (splitAt v (verticesFrom f v)) = tl (verticesFrom f v)"
   by (simp add: verticesFrom_Def)
 
 
 lemma filter_distinct_at:
   "distinct xs \<Longrightarrow> xs = (as @ u # bs) \<Longrightarrow> [v\<leftarrow>xs. v = u \<or> P v] = u # us \<Longrightarrow>
   [v\<leftarrow>bs. P v] = us \<and> [v\<leftarrow>as. P v] = []"
 apply (subgoal_tac "filter P as @ u # filter P bs = [] @ u # us")
 apply (drule local_help')  by (auto simp: filter_Cons2)
 
 lemma filter_distinct_at3: "distinct xs \<Longrightarrow> xs = (as @ u # bs) \<Longrightarrow>
   [v\<leftarrow>xs. v = u \<or> P v] = u # us \<Longrightarrow> \<forall> z \<in> set zs. z \<in> set as \<or> \<not> ( P z) \<Longrightarrow>
   [v\<leftarrow>zs@bs. P v] = us"
 apply (drule filter_distinct_at) apply assumption+ apply simp
 by (induct zs) auto
 
 lemma filter_distinct_at4: "distinct xs \<Longrightarrow> xs = (as @ u # bs)
   \<Longrightarrow> [v\<leftarrow>xs. v = u \<or> v \<in> set us] = u # us
   \<Longrightarrow> set zs \<inter> set us \<subseteq> {u} \<union> set as
   \<Longrightarrow> [v \<leftarrow> zs@bs. v \<in> set us] = us"
 proof -
   assume vors: "distinct xs" "xs = (as @ u # bs)"
     "[v\<leftarrow>xs. v = u \<or> v \<in> set us] = u # us"
     "set zs \<inter> set us \<subseteq> {u} \<union> set as"
   then have "distinct ([v\<leftarrow>xs. v = u \<or> v \<in> set us])"  apply (rule_tac distinct_filter) by simp
   with vors have dist: "distinct (u # us)" by auto
   with vors show ?thesis
   apply (rule_tac filter_distinct_at3) by assumption+  auto
 qed
 
 lemma filter_distinct_at5: "distinct xs \<Longrightarrow> xs = (as @ u # bs)
   \<Longrightarrow> [v\<leftarrow>xs. v = u \<or> v \<in> set us] = u # us
   \<Longrightarrow> set zs \<inter> set xs \<subseteq> {u} \<union> set as
   \<Longrightarrow> [v \<leftarrow> zs@bs. v \<in> set us] = us"
 proof -
   assume vors: "distinct xs" "xs = (as @ u # bs)"
     "[v\<leftarrow>xs. v = u \<or> v \<in> set us] = u # us"
     "set zs \<inter> set xs \<subseteq> {u} \<union> set as"
   have "set ([v\<leftarrow>xs. v = u \<or> v \<in> set us]) \<subseteq> set xs" by auto
   with vors have "set (u # us) \<subseteq> set xs" by simp
   then have "set us \<subseteq> set xs" by simp
   with vors have "set zs \<inter> set us \<subseteq> set zs \<inter> insert u (set as \<union> set bs)" by auto
   with vors show ?thesis apply (rule_tac filter_distinct_at4) apply assumption+ by auto
 qed
 
 lemma filter_distinct_at6: "distinct xs \<Longrightarrow> xs = (as @ u # bs)
   \<Longrightarrow> [v\<leftarrow>xs. v = u \<or> v \<in> set us] = u # us
   \<Longrightarrow> set zs \<inter> set xs \<subseteq> {u} \<union> set as
   \<Longrightarrow> [v \<leftarrow> zs@bs. v \<in> set us] = us \<and> [v \<leftarrow> bs. v \<in> set us] = us"
 proof -
   assume vors: "distinct xs" "xs = (as @ u # bs)"
     "[v \<leftarrow> xs. v = u \<or> v \<in> set us] = u # us"
     "set zs \<inter> set xs \<subseteq> {u} \<union> set as"
   then show ?thesis apply (rule_tac conjI)  apply (rule_tac filter_distinct_at5) apply assumption+
   apply (drule filter_distinct_at) apply assumption+ by auto
 qed
 
 lemma filter_distinct_at_special:
   "distinct xs \<Longrightarrow> xs = (as @ u # bs)
   \<Longrightarrow> [v\<leftarrow>xs. v = u \<or> v \<in> set us] = u # us
   \<Longrightarrow> set zs \<inter> set xs \<subseteq> {u} \<union> set as
   \<Longrightarrow> us = hd_us # tl_us
   \<Longrightarrow> [v \<leftarrow> zs@bs. v \<in> set us] = us \<and> hd_us \<in> set bs"
 proof -
   assume vors: "distinct xs" "xs = (as @ u # bs)"
     "[v\<leftarrow>xs. v = u \<or> v \<in> set us] = u # us"
     "set zs \<inter> set xs \<subseteq> {u} \<union> set as"
     "us = hd_us # tl_us"
   then have "[v \<leftarrow> zs@bs. v \<in> set us] = us \<and> [v\<leftarrow>bs. v \<in> set us] = us"
     by (rule_tac filter_distinct_at6)
   with vors show ?thesis apply (rule_tac conjI) apply safe apply simp
     apply (subgoal_tac "set (hd_us # tl_us) \<subseteq> set bs") apply simp
     apply (subgoal_tac "set [v\<leftarrow>bs . v = hd_us \<or> v \<in> set tl_us] \<subseteq> set bs")  apply simp
     by (rule_tac filter_is_subset)
 qed
 
 
 
 
 (* später ggf. pre_splitFace eliminieren *)
 (* nein, Elimination nicht sinnvoll *)
 lemma pre_subdivFace'_Some1':
 assumes pre_add: "pre_subdivFace' g f v' v n ((Some u) # vol)"
     and pre_fdg: "pre_splitFace g v u f ws"
     and fdg:  "f21 = fst (snd (splitFace g v u f ws))"
     and g': "g' =  snd (snd (splitFace g v u f ws))"
 shows "pre_subdivFace' g' f21 v' u 0 vol"
 proof (cases "vol = []")
   case True then show ?thesis using pre_add fdg pre_fdg
     apply(unfold pre_subdivFace'_def pre_splitFace_def)
     apply (simp add: splitFace_def split_face_def split_def del:distinct.simps)
     apply (rule conjI)
      apply(clarsimp)
      apply(rule before_between)
         apply(erule (5) rotate_before_vFrom)
      apply(erule not_sym)
     apply (clarsimp simp:between_distinct between_not_r1 between_not_r2)
     apply(blast dest:inbetween_inset)
     done
 next
   case False
   with pre_add
   have "removeNones vol \<noteq> []" apply (cases "vol" rule: rev_exhaust) by (auto simp: pre_subdivFace'_def)
   then have removeNones_split: "removeNones vol = hd (removeNones vol) # tl (removeNones vol)" by auto
 
 
   from pre_add have dist: "distinct (removeNones ((Some u) # vol))" by (rule_tac pre_subdivFace'_distinct)
 
   from pre_add have v': "v' \<in> \<V> f" by (auto simp: pre_subdivFace'_def)
   hence "(vertices f) \<cong> (verticesFrom f v')" by (rule verticesFrom_congs)
   hence set_eq: "set (verticesFrom f v') = \<V> f"
      apply (rule_tac sym) by (rule congs_pres_nodes)
 
   from pre_fdg fdg have dist_f21: "distinct (vertices f21)" by auto
 
   from pre_add have pre_bet': "pre_between (verticesFrom f v') u v"
     apply (simp add: pre_between_def pre_subdivFace'_def)
     apply (elim conjE) apply (thin_tac "n = 0 \<longrightarrow> \<not> is_duplicateEdge g f v u")
     apply (thin_tac "v' = v \<and> 0 < n \<or> v' = v \<and> u \<noteq> last (verticesFrom f v') \<or> v' \<noteq> v")
     apply (auto simp add: before_def)
     apply (subgoal_tac "distinct (verticesFrom f v')")  apply simp
     apply (rule_tac verticesFrom_distinct) by auto
 
   with pre_add have pre_bet: "pre_between (vertices f) u v"
     apply (subgoal_tac "(vertices f) \<cong> (verticesFrom f v')")
      apply (simp add: pre_between_def pre_subdivFace'_def)
     by (auto dest: congs_pres_nodes intro: verticesFrom_congs simp: pre_subdivFace'_def)
 
    from pre_bet pre_add have bet_eq[simp]: "between (vertices f) u v = between (verticesFrom f v') u v"
     by (auto intro: verticesFrom_between simp: pre_subdivFace'_def)
 
   from fdg have f21_split_face: "f21 = snd (split_face f v u ws)"
     by (simp add: splitFace_def split_def)
   then have f21: "f21 = Face (u # between (vertices f) u v @ v # ws) Nonfinal"
     by (simp add: split_face_def)
   with pre_add pre_bet'
   have vert_f21: "vertices f21
    = u # snd (splitAt u (verticesFrom f v')) @ fst (splitAt v (verticesFrom f v')) @ v # ws"
     apply (drule_tac pre_between_symI)
     by (auto simp: pre_subdivFace'_def between_simp2 intro: pre_between_symI)
 
   moreover
   from pre_add have "v \<in> set (verticesFrom f v')" by (auto simp: pre_subdivFace'_def before_def)
   then have "verticesFrom f v' =
    fst (splitAt v (verticesFrom f v')) @ v # snd (splitAt v (verticesFrom f v'))"
    by (auto dest: splitAt_ram)
   then have m: "v' # tl (verticesFrom f v')
     =  fst (splitAt v (verticesFrom f v')) @ v # snd (splitAt v (verticesFrom f v'))"
     by (simp add: verticesFrom_split)
 
   then have vv': "v \<noteq> v' \<Longrightarrow> fst (splitAt v (verticesFrom f v'))
     = v' # tl (fst (splitAt v (verticesFrom f v')))"
    by (cases "fst (splitAt v (verticesFrom f v'))") auto
 
   ultimately have "v \<noteq> v' \<Longrightarrow> vertices f21
     = u # snd (splitAt u (verticesFrom f v')) @ v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws"
     by auto
 
   moreover
   with f21 have rule2: "v' \<in> \<V> f21" by auto
   with dist_f21 have dist_f21_v': "distinct (verticesFrom f21 v')" by auto
 
   ultimately have m1: "v \<noteq> v' \<Longrightarrow> verticesFrom f21 v'
      = v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ u # snd (splitAt u (verticesFrom f v'))"
     apply auto
     apply (subgoal_tac "snd (splitAt v' (vertices f21)) = tl (fst (splitAt v (verticesFrom f v'))) @ v # ws")
      apply (subgoal_tac "fst (splitAt v' (vertices f21)) = u # snd (splitAt u (verticesFrom f v'))")
       apply (subgoal_tac "verticesFrom f21 v' = v' # snd (splitAt v' (vertices f21)) @ fst (splitAt v' (vertices f21))")
        apply simp
       apply (intro verticesFrom_v dist_f21) apply force
      apply (subgoal_tac "distinct (vertices f21)") apply simp
      apply (rule_tac dist_f21)
     apply (subgoal_tac "distinct (vertices f21)") apply simp
     by (rule_tac dist_f21)
 
   from pre_add have dist_vf_v': "distinct (verticesFrom f v')" by (simp add: pre_subdivFace'_def)
   with  vert_f21 have m2: "v = v' \<Longrightarrow> verticesFrom f21 v' = v' # ws @ u # snd (splitAt u (verticesFrom f v'))"
     apply auto apply (intro verticesFrom_v dist_f21) by simp
 
   from pre_add have u: "u \<in> set (verticesFrom f v')" by (fastforce simp: pre_subdivFace'_def before_def)
   then have split_u: "verticesFrom f v'
     = fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))"
     by (auto dest!: splitAt_ram)
 
   then have rule1': "[v \<leftarrow> snd (splitAt u (verticesFrom f v')) . v \<in> set (removeNones vol)] = removeNones vol"
   proof -
     from split_u have "v' # tl (verticesFrom f v')
        =  fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))"
       by (simp add: verticesFrom_split)
     have "help": "set [] \<inter> set (verticesFrom f v') \<subseteq> {u} \<union> set (fst (splitAt u (verticesFrom f v')))" by auto
     from split_u  dist_vf_v'  pre_add
     have "[v \<leftarrow> [] @ snd (splitAt u (verticesFrom f v')) . v \<in> set (removeNones vol)] = removeNones vol"
       apply (rule_tac filter_distinct_at5) apply assumption+
       apply (simp add: pre_subdivFace'_def) by (rule "help")
     then show ?thesis by auto
   qed
   then have inSnd_u: "\<And> x. x \<in> set (removeNones vol) \<Longrightarrow> x \<in> set (snd (splitAt u (verticesFrom f v')))"
     apply (subgoal_tac "x \<in> set [v \<leftarrow> snd (splitAt u (verticesFrom f v')) . v \<in> set (removeNones vol)] \<Longrightarrow>
       x \<in> set (snd (splitAt u (verticesFrom f v')))")
     apply force apply (thin_tac "[v \<leftarrow> snd (splitAt u (verticesFrom f v')) . v \<in> set (removeNones vol)] = removeNones vol")
     by simp
 
   from split_u dist_vf_v' have notinFst_u: "\<And> x. x \<in> set (removeNones vol) \<Longrightarrow>
       x \<notin> set ((fst (splitAt u (verticesFrom f v'))) @ [u])" apply (drule_tac inSnd_u)
     apply (subgoal_tac "distinct ( fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v')))")
     apply (thin_tac "verticesFrom f v'
        = fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))")
     apply simp apply safe
     apply (subgoal_tac "x \<in> set (fst (splitAt u (verticesFrom f v'))) \<inter> set (snd (splitAt u (verticesFrom f v')))")
     apply simp
     apply (thin_tac "set (fst (splitAt u (verticesFrom f v'))) \<inter> set (snd (splitAt u (verticesFrom f v'))) = {}")
     apply simp
     by (simp only:)
 
   from rule2 v' have "\<And> a b. is_nextElem (vertices f) a b \<and> a \<in> set (removeNones vol) \<and> b \<in> set (removeNones vol)  \<Longrightarrow>
    is_nextElem (vertices f21) a b"
   proof -
     fix a b
     assume vors: "is_nextElem (vertices f) a b \<and> a \<in> set (removeNones vol) \<and> b \<in> set (removeNones vol)"
     define vor_u where "vor_u = fst (splitAt u (verticesFrom f v'))"
     define nach_u where "nach_u = snd (splitAt u (verticesFrom f v'))"
     from vors v' have "is_nextElem (verticesFrom f v') a b"  by (simp add: verticesFrom_is_nextElem)
     moreover
     from vors inSnd_u nach_u_def have "a \<in> set (nach_u)" by auto
     moreover
     from vors inSnd_u nach_u_def have "b \<in> set (nach_u)" by auto
     moreover
     from split_u vor_u_def nach_u_def have "verticesFrom f v' = vor_u @ u # nach_u" by auto
     moreover
     note dist_vf_v'
     ultimately have "is_sublist [a,b] (nach_u)" apply (simp add: is_nextElem_def split:if_split_asm)
       apply (subgoal_tac "b \<noteq> hd (vor_u @ u # nach_u)")
        apply simp
        apply (subgoal_tac "distinct (vor_u @ (u # nach_u))")
         apply (drule is_sublist_at5)
          apply simp
         apply simp
         apply (erule disjE)
          apply (drule is_sublist_in1)+
          apply (subgoal_tac "b \<in> set vor_u \<inter> set nach_u") apply simp
          apply (thin_tac "set vor_u \<inter> set nach_u = {}")
          apply simp
         apply (erule disjE)
          apply (subgoal_tac "distinct ([u] @ nach_u)")
           apply (drule is_sublist_at5)
            apply simp
           apply simp
           apply (erule disjE)
            apply simp
           apply simp
          apply simp
         apply (subgoal_tac "distinct (vor_u @ (u # nach_u))")
          apply (drule is_sublist_at5) apply simp
         apply (erule disjE)
          apply (drule is_sublist_in1)+
          apply simp
         apply (erule disjE)
          apply  (drule is_sublist_in1)+ apply simp
         apply simp
        apply simp
       apply simp
      apply (cases "vor_u") by auto
 
     with nach_u_def have "is_sublist [a,b] (snd (splitAt u (verticesFrom f v')))" by auto
     then have "is_sublist [a,b] (verticesFrom f21 v')"
       apply (cases "v = v'") apply (simp_all add: m1 m2)
       apply (subgoal_tac "is_sublist [a, b] ((v' # ws @ [u]) @ snd (splitAt u (verticesFrom f v')) @ [])")
       apply simp apply (rule is_sublist_add) apply simp
       apply (subgoal_tac "is_sublist [a, b]
        ((v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ [u]) @ (snd (splitAt u (verticesFrom f v'))) @ [])")
       apply simp apply (rule is_sublist_add) by simp
     with rule2 show "is_nextElem (vertices f) a b \<and> a \<in> set (removeNones vol) \<and> b \<in> set (removeNones vol)  \<Longrightarrow>
       is_nextElem (vertices f21) a b" apply (simp add: verticesFrom_is_nextElem) by (auto simp: is_nextElem_def)
   qed
   with pre_add dist_f21 have rule5':
      "\<And> a b. (a,b) \<in> edges f \<and> a \<in> set (removeNones vol) \<and> b \<in> set (removeNones vol) \<Longrightarrow> (a, b) \<in> edges f21"
     by (simp add:  is_nextElem_edges_eq pre_subdivFace'_def)
 
 
   have rule1: "[v\<leftarrow>verticesFrom f21 v' . v \<in> set (removeNones vol)]
     = removeNones vol \<and> hd (removeNones vol) \<in> set (snd (splitAt u (verticesFrom f v')))"
   proof (cases "v = v'")
     case True
     from split_u have "v' # tl (verticesFrom f v')
       =  fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))"
       by (simp add: verticesFrom_split)
     then have "u \<noteq> v' \<Longrightarrow> fst (splitAt u (verticesFrom f v'))
       = v' # tl (fst (splitAt u (verticesFrom f v')))" by (cases "fst (splitAt u (verticesFrom f v'))") auto
     moreover
     have "v' \<in> set (v' # tl (fst (splitAt u (verticesFrom f v'))))" by simp
     ultimately have "u \<noteq> v' \<Longrightarrow> v' \<in> set (fst (splitAt u (verticesFrom f v')))" by simp
     moreover
     from pre_fdg have "set (v' # ws @ [u]) \<inter> set (verticesFrom f v') \<subseteq>  {v', u}"
       apply (simp add: set_eq)
       by (unfold pre_splitFace_def) auto
     ultimately have "help": "set (v' # ws @ [u]) \<inter> set (verticesFrom f v')
       \<subseteq> {u} \<union> set (fst (splitAt u (verticesFrom f v')))" apply (rule_tac subset_trans)
       apply assumption apply (cases "u = v'") by simp_all
     from split_u dist_vf_v' pre_add pre_fdg removeNones_split have
       "[v \<leftarrow> (v' # ws @ [u]) @ snd (splitAt u (verticesFrom f v')) . v \<in> set (removeNones vol)]
       = removeNones vol \<and> hd (removeNones vol) \<in> set (snd (splitAt u (verticesFrom f v')))"
       apply (rule_tac filter_distinct_at_special) apply assumption+
       apply (simp add: pre_subdivFace'_def) apply (rule "help") .
     with True m2 show ?thesis by auto
   next
     case False
 
     with m1 dist_f21_v' have ne_uv': "u \<noteq> v'" by auto
     define fst_u where "fst_u = fst (splitAt u (verticesFrom f v'))"
     define fst_v where "fst_v = fst (splitAt v (verticesFrom f v'))"
 
     from pre_add u dist_vf_v' have "v \<in> set (fst (splitAt u (verticesFrom f v')))"
       apply (rule_tac before_dist_r1) by (auto  simp: pre_subdivFace'_def)
     with fst_u_def have "fst_u = fst (splitAt v (fst (splitAt u (verticesFrom f v'))))
          @ v # snd (splitAt v (fst (splitAt u (verticesFrom f v'))))"
       by (auto dest: splitAt_ram)
     with pre_add fst_v_def pre_bet' have fst_u':"fst_u
       = fst_v @ v # snd (splitAt v (fst (splitAt u (verticesFrom f v'))))" by (simp add: pre_subdivFace'_def)
 
     from pre_fdg have "set (v # ws @ [u]) \<inter> set (verticesFrom f v') \<subseteq>  {v, u}" apply (simp add: set_eq)
       by (unfold pre_splitFace_def) auto
 
     with fst_u' have "set (v # ws @ [u]) \<inter> set (verticesFrom f v') \<subseteq> {u} \<union> set fst_u" by auto
     moreover
     from fst_u' have "set fst_v \<subseteq> set fst_u" by auto
     ultimately
     have "(set (v # ws @ [u]) \<union> set fst_v) \<inter> set (verticesFrom f v') \<subseteq> {u} \<union> set fst_u" by auto
     with fst_u_def fst_v_def
     have "set (fst (splitAt v (verticesFrom f v')) @ v # ws @ [u]) \<inter> set (verticesFrom f v')
       \<subseteq> {u} \<union> set (fst (splitAt u (verticesFrom f v')))" by auto
     moreover
     with False vv' have  "v' # tl (fst (splitAt v (verticesFrom f v')))
       = fst (splitAt v (verticesFrom f v'))" by auto
     ultimately have "set ((v' # tl (fst (splitAt v (verticesFrom f v')))) @ v # ws @ [u]) \<inter> set (verticesFrom f v')
       \<subseteq> {u} \<union> set (fst (splitAt u (verticesFrom f v')))"
      by (simp only:)
     then have "help": "set (v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ [u]) \<inter> set (verticesFrom f v')
       \<subseteq> {u} \<union> set (fst (splitAt u (verticesFrom f v')))" by auto
 
 
     from split_u dist_vf_v' pre_add pre_fdg removeNones_split have
       "[v \<leftarrow> (v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ [u])
           @ snd (splitAt u (verticesFrom f v')) . v \<in> set (removeNones vol)]
        = removeNones vol \<and> hd (removeNones vol) \<in> set (snd (splitAt u (verticesFrom f v')))"
       apply (rule_tac filter_distinct_at_special) apply assumption+
       apply (simp add: pre_subdivFace'_def) apply (rule "help") .
     with False m1 show ?thesis by auto
   qed
 
 
   from rule1 have "(hd (removeNones vol)) \<in> set (snd (splitAt u (verticesFrom f v')))" by auto
   with m1 m2  dist_f21_v' have rule3: "before (verticesFrom f21 v') u (hd (removeNones vol))"
   proof -
     assume hd_ram: "(hd (removeNones vol)) \<in> set (snd (splitAt u (verticesFrom f v')))"
     from m1 m2 dist_f21_v' have "distinct (snd (splitAt u (verticesFrom f v')))" apply (cases "v = v'")
       by auto
     moreover
     define z1 where "z1 = fst (splitAt (hd (removeNones vol)) (snd (splitAt u (verticesFrom f v'))))"
     define z2 where "z2 = snd (splitAt (hd (removeNones vol)) (snd (splitAt u (verticesFrom f v'))))"
     note z1_def z2_def hd_ram
     ultimately have "snd (splitAt u (verticesFrom f v')) = z1 @ (hd (removeNones vol)) # z2"
       by (auto intro: splitAt_ram)
     with m1 m2 show ?thesis apply (cases "v = v'") apply (auto simp: before_def)
       apply (intro exI )
       apply (subgoal_tac "v' # ws @ u # z1 @ hd (removeNones vol) # z2 = (v' # ws) @ u # z1 @ hd (removeNones vol) # z2")
       apply assumption apply simp
       apply (intro exI )
       apply (subgoal_tac "v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ u # z1 @ hd (removeNones vol) # z2 =
         (v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws) @ u # z1 @ hd (removeNones vol) # z2")
       apply assumption by simp
   qed
 
   from rule1 have ne:"(hd (removeNones vol)) \<in> set (snd (splitAt u (verticesFrom f v')))" by auto
   with m1 m2  have "last (verticesFrom f21 v') = last (snd (splitAt u (verticesFrom f v')))"
     apply (cases "snd (splitAt u (verticesFrom f v'))" rule: rev_exhaust) apply simp_all
     apply (cases "v = v'") by simp_all
   moreover
   from ne have "last (fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v')))
     = last (snd (splitAt u (verticesFrom f v')))" by auto
   moreover
   note split_u
   ultimately  have rule4: "last (verticesFrom f v') = last (verticesFrom f21 v')" by simp
 
 
   have l: "\<And> a b f v. v \<in> set (vertices f) \<Longrightarrow> is_nextElem (vertices f) a b = is_nextElem (verticesFrom f v) a b "
     apply (rule is_nextElem_congs_eq) by (rule verticesFrom_congs)
 
   define f12 where "f12 = fst (split_face f v u ws)"
   then have f12_fdg: "f12 = fst (splitFace g v u f ws)"
     by (simp add: splitFace_def split_def)
 
    from pre_bet pre_add have bet_eq2[simp]: "between (vertices f) v u = between (verticesFrom f v') v u"
      apply (drule_tac pre_between_symI)
      by (auto intro: verticesFrom_between simp: pre_subdivFace'_def)
 
 
   from f12_fdg have f12_split_face: "f12 = fst (split_face f v u ws)"
     by (simp add: splitFace_def split_def)
   then have f12: "f12 = Face (rev ws @ v # between (verticesFrom f v') v u @ [u]) Nonfinal"
     by (simp add: split_face_def)
   then have "vertices f12 = rev ws @ v # between (verticesFrom f v') v u @ [u]" by simp
   with pre_add pre_bet' have vert_f12: "vertices f12
      = rev ws @ v # snd (splitAt v (fst (splitAt u (verticesFrom f v')))) @ [u]"
     apply (subgoal_tac "between (verticesFrom f v') v u = fst (splitAt u (snd (splitAt v (verticesFrom f v'))))")
      apply (simp  add: pre_subdivFace'_def)
     apply (rule between_simp1)
      apply (simp add: pre_subdivFace'_def)
     apply (rule pre_between_symI) .
   with dist_f21_v' have removeNones_vol_not_f12: "\<And> x. x \<in> set (removeNones vol) \<Longrightarrow> x \<notin> set (vertices f12)"
     apply (frule_tac notinFst_u) apply (drule inSnd_u) apply simp
     apply (case_tac "v = v'") apply (simp add: m1 m2)
     apply (rule conjI) apply force
     apply (rule conjI) apply (rule ccontr)  apply simp
     apply (subgoal_tac "x \<in> set ws \<inter> set (snd (splitAt u (verticesFrom f v')))")
     apply simp apply (elim conjE)
     apply (thin_tac "set ws \<inter> set (snd (splitAt u (verticesFrom f v'))) = {}")
     apply simp
     apply force
 
     apply (simp add: m1 m2)
     apply (rule conjI) apply force
     apply (rule conjI) apply (rule ccontr) apply simp
     apply (subgoal_tac "x \<in> set ws \<inter> set (snd (splitAt u (verticesFrom f v')))")
     apply simp apply (elim conjE)
     apply (thin_tac "set ws \<inter> set (snd (splitAt u (verticesFrom f v'))) = {}") apply simp
     by force
 
   from pre_fdg f12_split_face have dist_f12: "distinct (vertices f12)" by (auto intro: split_face_distinct1')
 
   then have removeNones_vol_edges_not_f12: "\<And> x y. x \<in> set (removeNones vol) \<Longrightarrow> (x,y) \<notin> edges f12" (* ? *)
     apply (drule_tac removeNones_vol_not_f12) by auto
   from dist_f12 have removeNones_vol_edges_not_f12': "\<And> x y. y \<in> set (removeNones vol) \<Longrightarrow> (x,y) \<notin> edges f12"
     apply (drule_tac removeNones_vol_not_f12) by auto
 
   from f12_fdg pre_fdg g' fdg have face_set_eq: "\<F> g' \<union> {f} = {f12, f21} \<union> \<F> g"
     apply (rule_tac splitFace_faces_1)
     by (simp_all)
 
   have rule5'': "\<And> a b. (a,b) \<in> edges g' \<and> (a,b) \<notin> edges g
      \<and> a \<in> set (removeNones vol) \<and> b \<in> set (removeNones vol) \<Longrightarrow> (a, b) \<in> edges f21" (* ? *)
     apply (simp add: edges_graph_def) apply safe
     apply (case_tac "x = f") apply simp apply (rule rule5') apply safe
     apply (subgoal_tac "x \<in> \<F> g' \<union> {f}") apply (thin_tac "x \<noteq> f")
     apply (thin_tac "x \<in> set (faces g')") apply (simp only: add: face_set_eq)
     apply safe apply (drule removeNones_vol_edges_not_f12) by auto
  have rule5''': "\<And> a b. (a,b) \<in> edges g' \<and> (a,b) \<notin> edges g
      \<and> a \<in> set (removeNones vol) \<and> b \<in> set (removeNones vol) \<Longrightarrow> (a, b) \<in> edges f21" (* ? *)
 
     apply (simp add: edges_graph_def) apply safe
     apply (case_tac "x = f") apply simp apply (rule rule5') apply safe
     apply (subgoal_tac "x \<in> \<F> g' \<union> {f}") apply (thin_tac "x \<noteq> f")
     apply (thin_tac "x \<in> \<F> g'") apply (simp only: add: face_set_eq)
     apply safe apply (drule removeNones_vol_edges_not_f12) by auto
 
 
  from pre_fdg fdg f12_fdg  g' have edges_g'1: "ws \<noteq> [] \<Longrightarrow> edges g' = edges g \<union> Edges ws \<union> Edges(rev ws) \<union>
    {(u, last ws), (hd ws, v), (v, hd ws), (last ws, u)}"
    apply (rule_tac splitFace_edges_g') apply simp
    apply (subgoal_tac "(f12, f21, g') = splitFace g v u f ws")  apply assumption by auto
 
  from pre_fdg fdg f12_fdg  g' have edges_g'2: "ws = [] \<Longrightarrow> edges g' = edges g \<union>
    {(v, u), (u, v)}"
    apply (rule_tac splitFace_edges_g'_vs) apply simp
    apply (subgoal_tac "(f12, f21, g') = splitFace g v u f []")  apply assumption by auto
 
 
  from f12_split_face f21_split_face have split: "(f12,f21) = split_face f v u ws" by simp
 
 
   from pre_add have "\<not> invalidVertexList g f vol"
     by (auto simp: pre_subdivFace'_def dest: invalidVertexList_shorten)
   then have rule5: "\<not> invalidVertexList g' f21 vol"
 
     apply (simp add: invalidVertexList_def)
     apply (intro allI impI)
     apply (case_tac "vol!i")  apply simp+
     apply (case_tac "vol!Suc i") apply simp+
     apply (subgoal_tac "\<not> is_duplicateEdge g f a aa")
      apply (thin_tac "\<forall>i<|vol| - Suc 0. \<not> (case vol ! i of None \<Rightarrow> False
         | Some a \<Rightarrow> case_option False (is_duplicateEdge g f a) (vol ! (i+1)))")
      apply (simp add: is_duplicateEdge_def)
      apply (subgoal_tac "a \<in> set (removeNones vol) \<and> aa \<in> set (removeNones vol)")
       apply (rule conjI)
        apply (rule impI)
        apply (case_tac "(a, aa) \<in> edges f")
         apply simp
         apply (subgoal_tac "pre_split_face f v u ws")
          apply (frule split_face_edges_or [OF split]) apply simp
          apply (simp add:  removeNones_vol_edges_not_f12)
         apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
        apply (case_tac "(aa, a) \<in> edges f")
         apply simp
         apply (subgoal_tac "pre_split_face f v u ws")
          apply (frule split_face_edges_or [OF split]) apply simp
          apply (simp add:  removeNones_vol_edges_not_f12)
         apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
        apply simp
        apply (case_tac "ws = []") apply (frule edges_g'2)  apply simp
         apply (subgoal_tac "pre_split_face f v u []")
          apply (subgoal_tac "(f12, f21) = split_face f v u ws")
           apply (case_tac "between (vertices f) u v = []")
            apply (frule split_face_edges_f21_bet_vs) apply simp apply simp
            apply simp
           apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
           apply (case_tac "a = v \<and> aa = u") apply simp apply simp
          apply (rule split)
         apply (subgoal_tac "pre_split_face f v u ws") apply simp
         apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
        apply (frule edges_g'1) apply simp
        apply (subgoal_tac "pre_split_face f v u ws")
         apply (subgoal_tac "(f12, f21) = split_face f v u ws")
          apply (case_tac "between (vertices f) u v = []")
           apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
           apply simp
           apply (case_tac "a = u \<and> aa = last ws") apply simp apply simp
           apply (case_tac "a = hd ws \<and> aa = v") apply simp apply simp
           apply (case_tac "a = v \<and> aa = hd ws") apply simp apply simp
           apply (case_tac "a = last ws \<and> aa = u") apply simp apply simp
           apply (case_tac "(a, aa) \<in> Edges ws") apply simp
           apply simp
          apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
          apply (force)
         apply (rule split)
        apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
       apply (rule impI)
       apply (case_tac "(aa,a) \<in> edges f") apply simp
        apply (subgoal_tac "pre_split_face f v u ws")
         apply (frule split_face_edges_or [OF split]) apply simp
         apply (simp add:  removeNones_vol_edges_not_f12)
        apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
       apply (case_tac "(a,aa) \<in> edges f") apply simp
        apply (subgoal_tac "pre_split_face f v u ws")
         apply (frule split_face_edges_or [OF split]) apply simp
         apply (simp add:  removeNones_vol_edges_not_f12)
        apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
       apply simp
       apply (case_tac "ws = []") apply (frule edges_g'2) apply simp
        apply (subgoal_tac "pre_split_face f v u []")
         apply (subgoal_tac "(f12, f21) = split_face f v u ws")
          apply (case_tac "between (vertices f) u v = []")
           apply (frule split_face_edges_f21_bet_vs) apply simp apply simp
           apply simp
          apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
          apply force
         apply (rule split)
        apply (subgoal_tac "pre_split_face f v u ws") apply simp
        apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
       apply (frule edges_g'1) apply simp
       apply (subgoal_tac "pre_split_face f v u ws")
        apply (subgoal_tac "(f12, f21) = split_face f v u ws")
         apply (case_tac "between (vertices f) u v = []")
          apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
          apply (force)
         apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
         apply (force)
        apply (rule split)
       apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
      apply (rule conjI)
       apply (subgoal_tac "Some a \<in> set vol") apply (induct vol) apply simp apply force
       apply (subgoal_tac "vol ! i \<in> set vol") apply simp
       apply (rule nth_mem) apply arith
      apply (subgoal_tac "Some aa \<in> set vol") apply (induct vol) apply simp apply force
      apply (subgoal_tac "vol ! (Suc i) \<in> set vol") apply simp apply (rule nth_mem) apply arith
     by auto
 
 
   from pre_fdg dist_f21 v' have dists: "distinct (vertices f)"  "distinct (vertices f12)"
      "distinct (vertices f21)"  "v' \<in> \<V> f"
     apply auto defer
     apply (drule splitFace_distinct2) apply (simp add: f12_fdg)
     apply (unfold pre_splitFace_def) by simp
   with pre_fdg have edges_or: "\<And> a b. (a,b) \<in> edges f \<Longrightarrow> (a,b) \<in> edges f12 \<or> (a,b) \<in> edges f21"
     apply (rule_tac split_face_edges_or) apply (simp add: f12_split_face f21_split_face)
    by simp+
 
  from pre_fdg have dist_f: "distinct (vertices f)" apply (unfold pre_splitFace_def) by simp
 
 (* lemma *)
  from g' have edges_g': "edges g'
     = (UN h:set(replace f [snd (split_face f v u ws)] (faces g)). edges h)
     \<union> edges (fst (split_face f v u ws))"
   by (auto simp add: splitFace_def split_def edges_graph_def)
 
 
 (* lemma *)
  from pre_fdg edges_g' have edges_g'_or:
    "\<And> a b. (a,b) \<in> edges g' \<Longrightarrow>
     (a,b) \<in> edges g \<or> (a,b) \<in> edges f12 \<or> (a,b) \<in> edges f21"
    apply simp apply (case_tac "(a, b) \<in> edges (fst (split_face f v u ws))")
    apply (simp add:f12_split_face) apply simp
    apply (elim bexE) apply (simp add: f12_split_face) apply (case_tac "x \<in> \<F> g")
    apply (induct g) apply (simp  add: edges_graph_def) apply (rule disjI1)
    apply (rule bexI) apply simp apply simp
    apply (drule replace1) apply simp by (simp add: f21_split_face)
 
   have rule6: "0 < |vol| \<Longrightarrow> \<not> invalidVertexList g f (Some u # vol) \<Longrightarrow>
     (\<exists>y. hd vol = Some y) \<longrightarrow> \<not> is_duplicateEdge g' f21 u (the (hd vol))"
 
     apply (rule impI)
     apply (erule exE) apply simp apply (case_tac vol) apply simp+
     apply (simp add: invalidVertexList_def) apply (erule allE) apply (erule impE) apply force
     apply (simp)
     apply (subgoal_tac "y \<notin> \<V> f12") defer apply (rule removeNones_vol_not_f12) apply simp
     apply (simp add: is_duplicateEdge_def)
     apply (subgoal_tac "y \<in> set (removeNones vol)")
      apply (rule conjI)
       apply (rule impI)
       apply (case_tac "(u, y) \<in> edges f") apply simp
        apply (subgoal_tac "pre_split_face f v u ws")
         apply (frule split_face_edges_or [OF split]) apply simp
         apply (simp add:  removeNones_vol_edges_not_f12')
        apply (rule pre_splitFace_pre_split_face) apply simp  apply (rule pre_fdg)
       apply (case_tac "(y, u) \<in> edges f") apply simp
        apply (subgoal_tac "pre_split_face f v u ws")
         apply (frule split_face_edges_or [OF split]) apply simp
         apply (simp add:  removeNones_vol_edges_not_f12)
        apply (rule pre_splitFace_pre_split_face) apply simp  apply (rule pre_fdg)
       apply simp
       apply (case_tac "ws = []") apply (frule edges_g'2)  apply simp
        apply (subgoal_tac "pre_split_face f v u []")
         apply (subgoal_tac "(f12, f21) = split_face f v u ws")
          apply (case_tac "between (vertices f) u v = []")
           apply (frule split_face_edges_f21_bet_vs) apply simp apply simp apply simp
          apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
          apply force
         apply (rule split)
        apply (subgoal_tac "pre_split_face f v u ws") apply simp
        apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
       apply (frule edges_g'1) apply simp
       apply (subgoal_tac "pre_split_face f v u ws")
        apply (subgoal_tac "(f12, f21) = split_face f v u ws")
         apply (case_tac "between (vertices f) u v = []")
          apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
          apply (force)
         apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
         apply (force)
        apply (rule split)
       apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
      apply (rule impI)
      apply (case_tac "(u, y) \<in> edges f") apply simp
      apply (subgoal_tac "pre_split_face f v u ws")
       apply (frule split_face_edges_or [OF split]) apply simp apply (simp add:  removeNones_vol_edges_not_f12')
       apply (rule pre_splitFace_pre_split_face) apply simp  apply (rule pre_fdg)
      apply (case_tac "(y, u) \<in> edges f") apply simp
       apply (subgoal_tac "pre_split_face f v u ws")
        apply (frule split_face_edges_or [OF split]) apply simp apply (simp add:  removeNones_vol_edges_not_f12)
       apply (rule pre_splitFace_pre_split_face) apply simp  apply (rule pre_fdg)
      apply simp
      apply (case_tac "ws = []") apply (frule edges_g'2)  apply simp
       apply (subgoal_tac "pre_split_face f v u []")
        apply (subgoal_tac "(f12, f21) = split_face f v u ws")
         apply (case_tac "between (vertices f) u v = []")
          apply (frule split_face_edges_f21_bet_vs) apply simp apply simp
          apply simp
         apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
         apply force
        apply (rule split)
       apply (subgoal_tac "pre_split_face f v u ws") apply simp
       apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
      apply (frule edges_g'1) apply simp
      apply (subgoal_tac "pre_split_face f v u ws")
       apply (subgoal_tac "(f12, f21) = split_face f v u ws")
        apply (case_tac "between (vertices f) u v = []")
         apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
         apply (force)
        apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
        apply (force)
       apply (rule split)
      apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
     by simp
   have u21: "u \<in> \<V> f21" by(simp add:f21)
   from fdg have "\<not> final f21"
     by(simp add:splitFace_def split_face_def split_def)
   with pre_add rule1 rule2 rule3 rule4 rule5 rule6 dist_f21 False dist u21
   show ?thesis by (simp_all add: pre_subdivFace'_def l)
 qed
 
 
 lemma before_filter: "\<And>  ys. filter P xs = ys \<Longrightarrow> distinct xs \<Longrightarrow> before ys  u v \<Longrightarrow> before xs u v"
-  using subst_all subst_all' [simp del]
+  supply subst_all [simp del]
   apply (subgoal_tac "P u")
   apply (subgoal_tac "P v")
   apply (subgoal_tac "pre_between xs u v")
   apply (rule ccontr) apply (simp add: before_xor)
   apply (subgoal_tac "before ys v u")
   apply (subgoal_tac "\<not> before ys v u")
   apply simp
   apply (rule before_dist_not1) apply force apply simp
   apply (simp add: before_def) apply (elim exE) apply simp
   apply (subgoal_tac "a @ u # b @ v # c = filter P aa @ v # filter P ba @ u # filter P ca")
   apply (intro exI) apply assumption
   apply simp
   apply (subgoal_tac "u \<in> set ys \<and> v \<in> set ys \<and> u \<noteq> v") apply (simp add: pre_between_def) apply force
   apply (subgoal_tac "distinct ys")
   apply (simp add: before_def) apply (elim exE) apply simp
   apply force
   apply (subgoal_tac "v \<in> set (filter P xs)") apply force
   apply (simp add: before_def) apply (elim exE) apply simp
   apply (subgoal_tac "u \<in> set (filter P xs)") apply force
   apply (simp add: before_def) apply (elim exE) by simp
 
 
 lemma pre_subdivFace'_Some2: "pre_subdivFace' g f v' v 0 ((Some u) # vol) \<Longrightarrow> pre_subdivFace' g f v' u 0 vol"
 apply (cases "vol = []")
  apply (simp add: pre_subdivFace'_def)
   apply (cases "u = v'") apply simp
  apply(rule verticesFrom_in')
   apply(rule last_in_set)
   apply(simp add:verticesFrom_Def)
  apply clarsimp
 apply (simp add: pre_subdivFace'_def)
 apply (elim conjE)
 apply (thin_tac "v' = v \<and> u \<noteq> last (verticesFrom f v') \<or> v' \<noteq> v")
 apply auto
     apply(rule verticesFrom_in'[where v = v'])
      apply(clarsimp simp:before_def)
     apply simp
    apply (rule ovl_shorten) apply simp
    apply (subgoal_tac "[v \<leftarrow> verticesFrom f v' . v \<in> set (removeNones ((Some u) # vol))] = removeNones ((Some u) # vol)")
     apply assumption
    apply simp
   apply (rule before_filter)
     apply assumption
    apply simp
   apply (simp add: before_def)
   apply (intro exI)
   apply (subgoal_tac "u # removeNones vol = [] @ u # [] @ hd (removeNones vol) # tl (removeNones vol)") apply assumption
   apply simp
   apply (subgoal_tac "removeNones vol \<noteq> []") apply simp
   apply (cases vol rule: rev_exhaust) apply simp_all
  apply (simp add: invalidVertexList_shorten)
 apply (simp add: is_duplicateEdge_def)
 apply (case_tac "vol") apply simp
 apply simp
 apply (simp add: invalidVertexList_def)
 apply (elim allE)
 apply (rotate_tac -1)
 apply (erule impE)
  apply (subgoal_tac "0 < Suc |list|")
   apply assumption
  apply simp
 apply simp
 by (simp add: is_duplicateEdge_def)
 
 lemma pre_subdivFace'_preFaceDiv: "pre_subdivFace' g f v' v n ((Some u) # vol)
   \<Longrightarrow> f \<in> \<F> g \<Longrightarrow> (f \<bullet> v = u \<longrightarrow> n \<noteq> 0) \<Longrightarrow> \<V> f \<subseteq> \<V> g
   \<Longrightarrow> pre_splitFace g v u f [countVertices g ..< countVertices g + n]"
 proof -
   assume pre_add: "pre_subdivFace' g f v' v n ((Some u) # vol)" and f: "f \<in> \<F> g"
   and nextVert: "(f \<bullet> v = u \<longrightarrow> n \<noteq> 0)" and subset: "\<V> f \<subseteq> \<V> g"
   have "distinct [countVertices g ..< countVertices g + n]" by (induct n) auto
   moreover
   have "\<V> g \<inter> set [countVertices g ..< countVertices g + n] = {}"
     apply (cases g) by auto
   with subset have "\<V> f \<inter> set [countVertices g ..< countVertices g + n] = {}" by auto
   moreover
   from pre_add have "\<V> f = set (verticesFrom f v')" apply (intro congs_pres_nodes verticesFrom_congs)
     by (simp add: pre_subdivFace'_def)
   with pre_add have "help": "v \<in> \<V> f \<and> u \<in> \<V> f \<and> v \<noteq> u"
     apply (simp add: pre_subdivFace'_def before_def)
     apply (elim conjE exE)
     apply (subgoal_tac "distinct (verticesFrom f v')") apply force
     apply (rule verticesFrom_distinct) by simp_all
   moreover
   from "help" pre_add nextVert have help1: "is_nextElem (vertices f) v u \<Longrightarrow> 0 < n" apply auto
     apply (simp add: nextVertex_def)
     by (simp add: nextElem_is_nextElem pre_subdivFace'_def)
   moreover
  have help2: "before (verticesFrom f v') v u \<Longrightarrow> distinct (verticesFrom f v') \<Longrightarrow> v \<noteq> v' \<Longrightarrow> \<not> is_nextElem (verticesFrom f v') u v"
    apply (simp add: before_def is_nextElem_def verticesFrom_hd is_sublist_def) apply safe
    apply (frule dist_at)
    apply simp
    apply (thin_tac "verticesFrom f v' = a @ v # b @ u # c")
    apply (subgoal_tac "verticesFrom f v' = (as @ [u]) @ v # bs") apply assumption
    apply simp apply (subgoal_tac "distinct (a @ v # b @ u # c)") apply force by simp
   note pre_add f
   moreover(*
   have "\<And> m. {k. k < m} \<inter> {k. m \<le> k \<and> k < (m + n)} = {}" by auto
   moreover*)
 
   from pre_add f help2 help1 "help" have "[countVertices g..<countVertices g + n] = [] \<Longrightarrow> (v, u) \<notin> edges f \<and> (u, v) \<notin> edges f"
     apply (cases "0 < n") apply (induct g) apply simp+
     apply (simp add: pre_subdivFace'_def)
     apply (rule conjI) apply force
     apply (simp split: if_split_asm)
      apply (rule ccontr)  apply simp
      apply (subgoal_tac "v = v'") apply simp  apply (elim conjE) apply (simp only:)
      apply (rule verticesFrom_is_nextElem_last) apply force apply force
      apply (simp add: verticesFrom_is_nextElem [symmetric])
     apply (cases "v = v'") apply simp
      apply (subgoal_tac "v' \<in> \<V> f")
       apply (thin_tac "u \<in> \<V> f")
 
       apply (simp add: verticesFrom_is_nextElem)
       apply (rule ccontr) apply simp
       apply (subgoal_tac "v' \<in> \<V> f")
        apply (drule verticesFrom_is_nextElem_hd) apply simp+
 
     apply (elim conjE) apply (drule help2)
       apply simp apply simp
     apply (subgoal_tac "is_nextElem (vertices f) u v = is_nextElem (verticesFrom f v') u v")
      apply simp
     apply (rule verticesFrom_is_nextElem) by simp
   ultimately
 
   show ?thesis
     apply (simp add: pre_subdivFace'_def)
     apply (unfold pre_splitFace_def)
     apply simp
     apply (cases "0 < n") apply (induct g) apply (simp add: ivl_disj_int)
     apply (auto simp: invalidVertexList_def is_duplicateEdge_def)
     done
 qed
 
 
 lemma pre_subdivFace'_Some1:
   "pre_subdivFace' g f v' v n ((Some u) # vol)
   \<Longrightarrow> f \<in> \<F> g \<Longrightarrow> (f \<bullet> v = u \<longrightarrow> n \<noteq> 0) \<Longrightarrow> \<V> f \<subseteq> \<V> g
   \<Longrightarrow> f21 = fst (snd (splitFace g v u f [countVertices g ..< countVertices g + n]))
   \<Longrightarrow> g' =  snd (snd (splitFace g v u f [countVertices g ..< countVertices g + n]))
   \<Longrightarrow> pre_subdivFace' g' f21 v' u 0 vol"
   apply (subgoal_tac "pre_splitFace g v u f [countVertices g ..< countVertices g + n]")
    apply (rule pre_subdivFace'_Some1') apply assumption+
   apply (simp)
   apply (rule pre_subdivFace'_preFaceDiv)
   by auto
 
 end
diff --git a/thys/Generalized_Counting_Sort/Conservation.thy b/thys/Generalized_Counting_Sort/Conservation.thy
--- a/thys/Generalized_Counting_Sort/Conservation.thy
+++ b/thys/Generalized_Counting_Sort/Conservation.thy
@@ -1,2036 +1,2036 @@
 (*  Title:       An Efficient Generalization of Counting Sort for Large, possibly Infinite Key Ranges
     Author:      Pasquale Noce
                  Software Engineer at HID Global, Italy
                  pasquale dot noce dot lavoro at gmail dot com
                  pasquale dot noce at hidglobal dot com
 *)
 
 section "Proof of objects' conservation"
 
 theory Conservation
   imports 
     Algorithm 
     "HOL-Library.Multiset"
 begin
 
 text \<open>
 \null
 
 In this section, it is formally proven that GCsort \emph{conserves objects}, viz. that the objects'
 list returned by function @{const gcsort} contains as many occurrences of any given object as the
 input objects' list.
 
 Here below, steps 5, 6, and 7 of the proof method are accomplished. Particularly, @{text count_inv}
 is the predicate that will be shown to be invariant over inductive set @{const gcsort_set}.
 
 \null
 \<close>
 
 fun count_inv :: "('a \<Rightarrow> nat) \<Rightarrow> nat \<times> nat list \<times> 'a list \<Rightarrow> bool" where
 "count_inv f (u, ns, xs) = (\<forall>x. count (mset xs) x = f x)"
 
 lemma gcsort_count_input:
  "count_inv (count (mset xs)) (0, [length xs], xs)"
 by simp
 
 lemma gcsort_count_intro:
  "count_inv f t \<Longrightarrow> count (mset (gcsort_out t)) x = f x"
 by (cases t, simp add: gcsort_out_def)
 
 text \<open>
 \null
 
 The main task to be accomplished to prove that GCsort conserves objects is to prove that so does
 function @{const fill} in case its input offsets' list is computed via the composition of functions
 @{const offs} and @{const enum}, as happens within function @{const round}.
 
 To achieve this result, a multi-step strategy will be adopted. The first step, addressed here below,
 opens with the definition of predicate @{text offs_pred}, satisfied by an offsets' list $ns$ and an
 objects' list $xs$ just in case each bucket delimited by $ns$ is sufficiently large to accommodate
 the corresponding objects in $xs$. Then, lemma @{text offs_pred_cons} shows that this predicate, if
 satisfied initially, keeps being true if each object in $xs$ is consumed as happens within function
 @{const fill}, viz. increasing the corresponding offset in $ns$ by one.
 
 \null
 \<close>
 
 definition offs_num :: "nat \<Rightarrow> 'a list \<Rightarrow> ('a, 'b) index_sign \<Rightarrow>
   ('a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> nat \<Rightarrow> nat" where
 "offs_num n xs index key mi ma i \<equiv>
   length [x\<leftarrow>xs. index key x n mi ma = i]"
 
 abbreviation offs_set_next :: "nat list \<Rightarrow> 'a list \<Rightarrow> ('a, 'b) index_sign \<Rightarrow>
   ('a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> nat \<Rightarrow> nat set" where
 "offs_set_next ns xs index key mi ma i \<equiv>
   {k. k < length ns \<and> i < k \<and> 0 < offs_num (length ns) xs index key mi ma k}"
 
 abbreviation offs_set_prev :: "nat list \<Rightarrow> 'a list \<Rightarrow> ('a, 'b) index_sign \<Rightarrow>
   ('a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> nat \<Rightarrow> nat set" where
 "offs_set_prev ns xs index key mi ma i \<equiv>
   {k. i < length ns \<and> k < i \<and> 0 < offs_num (length ns) xs index key mi ma k}"
 
 definition offs_next :: "nat list \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> ('a, 'b) index_sign \<Rightarrow>
   ('a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> nat \<Rightarrow> nat" where
 "offs_next ns ub xs index key mi ma i \<equiv>
   if offs_set_next ns xs index key mi ma i = {}
   then ub else ns ! Min (offs_set_next ns xs index key mi ma i)"
 
 definition offs_none :: "nat list \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> ('a, 'b) index_sign \<Rightarrow>
   ('a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> nat \<Rightarrow> bool" where
 "offs_none ns ub xs index key mi ma i \<equiv>
   (\<exists>j < length ns. 0 < offs_num (length ns) xs index key mi ma j \<and>
     i \<in> {ns ! j + offs_num (length ns) xs index key mi ma j..<
       offs_next ns ub xs index key mi ma j}) \<or>
   offs_num (length ns) xs index key mi ma 0 = 0 \<and>
     i < offs_next ns ub xs index key mi ma 0 \<or>
   0 < offs_num (length ns) xs index key mi ma 0 \<and>
     i < ns ! 0"
 
 definition offs_pred :: "nat list \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> ('a, 'b) index_sign \<Rightarrow>
   ('a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" where
 "offs_pred ns ub xs index key mi ma \<equiv>
   \<forall>i < length ns. offs_num (length ns) xs index key mi ma i \<le>
     offs_next ns ub xs index key mi ma i - ns ! i"
 
 lemma offs_num_cons:
  "offs_num n (x # xs) index key mi ma i =
    (if index key x n mi ma = i then Suc else id) (offs_num n xs index key mi ma i)"
 by (simp add: offs_num_def)
 
 lemma offs_next_prev:
  "(0 < offs_num (length ns) xs index key mi ma i \<and>
     offs_set_next ns xs index key mi ma i \<noteq> {} \<and>
     Min (offs_set_next ns xs index key mi ma i) = j) =
   (0 < offs_num (length ns) xs index key mi ma j \<and>
     offs_set_prev ns xs index key mi ma j \<noteq> {} \<and>
     Max (offs_set_prev ns xs index key mi ma j) = i)"
   (is "?P = ?Q")
 proof (rule iffI, (erule_tac [!] conjE)+)
   let ?A = "offs_set_next ns xs index key mi ma i"
   let ?B = "offs_set_prev ns xs index key mi ma j"
   assume
     A: "0 < offs_num (length ns) xs index key mi ma i" and
     B: "?A \<noteq> {}" and
     C: "Min ?A = j"
   have "Min ?A \<in> ?A"
     using B by (rule_tac Min_in, simp)
   hence D: "j \<in> ?A"
     using C by simp
   hence E: "i \<in> ?B"
     using A by simp
   show ?Q
   proof (rule conjI, rule_tac [2] conjI)
     show "0 < offs_num (length ns) xs index key mi ma j"
       using D by simp
   next
     show "?B \<noteq> {}"
       using E by blast
   next
     from E show "Max ?B = i"
     proof (subst Max_eq_iff, simp, blast, simp, rule_tac allI, rule_tac impI,
      (erule_tac conjE)+, rule_tac ccontr, simp)
       fix k
       assume F: "k < j" and "j < length ns"
       hence "k < length ns" by simp
       moreover assume
        "\<not> k \<le> i" and
        "0 < offs_num (length ns) xs index key mi ma k"
       ultimately have "k \<in> ?A" by simp
       hence "Min ?A \<le> k"
         by (rule_tac Min_le, simp)
       thus False
         using C and F by simp
     qed
   qed
 next
   let ?A = "offs_set_prev ns xs index key mi ma j"
   let ?B = "offs_set_next ns xs index key mi ma i"
   assume
     A: "0 < offs_num (length ns) xs index key mi ma j" and
     B: "?A \<noteq> {}" and
     C: "Max ?A = i"
   have "Max ?A \<in> ?A"
     using B by (rule_tac Max_in, simp)
   hence D: "i \<in> ?A"
     using C by simp
   hence E: "j \<in> ?B"
     using A by simp
   show ?P
   proof (rule conjI, rule_tac [2] conjI)
     show "0 < offs_num (length ns) xs index key mi ma i"
       using D by simp
   next
     show "?B \<noteq> {}"
       using E by blast
   next
     from E show "Min ?B = j"
     proof (subst Min_eq_iff, simp, blast, simp, rule_tac allI, rule_tac impI,
      (erule_tac conjE)+, rule_tac ccontr, simp)
       fix k
       assume
        "j < length ns" and
        "\<not> j \<le> k" and
        "0 < offs_num (length ns) xs index key mi ma k"
       hence "k \<in> ?A" by simp
       hence "k \<le> Max ?A"
         by (rule_tac Max_ge, simp)
       moreover assume "i < k"
       ultimately show False
         using C by simp
     qed
   qed
 qed
 
 lemma offs_next_cons_eq:
   assumes
     A: "index key x (length ns) mi ma = i" and
     B: "i < length ns" and
     C: "0 < offs_num (length ns) (x # xs) index key mi ma j"
   shows
    "offs_set_prev ns (x # xs) index key mi ma i = {} \<or>
       Max (offs_set_prev ns (x # xs) index key mi ma i) \<noteq> j \<Longrightarrow>
     offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma j =
       offs_next ns ub (x # xs) index key mi ma j"
   (is "?P \<or> ?Q \<Longrightarrow> _")
 proof (simp only: disj_imp, cases "j < i")
   let ?A = "offs_set_prev ns (x # xs) index key mi ma i"
   let ?B = "offs_set_next (ns[i := Suc (ns ! i)]) xs index key mi ma j"
   let ?C = "offs_set_next ns (x # xs) index key mi ma j"
   case True
   hence D: "j \<in> ?A"
     using B and C by simp
   hence "j \<le> Max ?A"
     by (rule_tac Max_ge, simp)
   moreover assume "\<not> ?P \<longrightarrow> ?Q"
   hence ?Q
     using D by blast
   ultimately have E: "j < Max ?A" by simp
   have F: "Max ?A \<in> ?A"
     using D by (rule_tac Max_in, simp, blast)
   have G: "Max ?A \<in> ?B"
   proof (simp, rule conjI, rule_tac [2] conjI)
     show "Max ?A < length ns"
       using F by auto
   next
     show "j < Max ?A"
       using E .
   next
     have "0 < offs_num (length ns) (x # xs) index key mi ma (Max ?A)"
       using F by blast
     moreover have "Max ?A < i"
       using F by blast
     ultimately show "0 < offs_num (length ns) xs index key mi ma (Max ?A)"
       using A by (simp add: offs_num_cons)
   qed
   hence H: "offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma j =
     ns[i := Suc (ns ! i)] ! Min ?B"
     by (simp only: offs_next_def split: if_split, blast)
   have "Min ?B \<le> Max ?A"
     using G by (rule_tac Min_le, simp)
   moreover have "Max ?A < i"
     using F by blast
   ultimately have I: "Min ?B < i" by simp
   hence J: "offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma j =
     ns ! Min ?B"
     using H by simp
   have "Min ?B \<in> ?B"
     using G by (rule_tac Min_in, simp, blast)
   hence K: "Min ?B \<in> ?C"
     using A and I by (simp add: offs_num_cons)
   hence L: "Min ?C \<le> Min ?B"
     by (rule_tac Min_le, simp)
   have "Min ?C \<in> ?C"
     using K by (rule_tac Min_in, simp, blast)
   moreover have "Min ?C < i"
     using L and I by simp
   ultimately have "Min ?C \<in> ?B"
     using A by (simp add: offs_num_cons)
   hence "Min ?B \<le> Min ?C"
     using G by (rule_tac Min_le, simp)
   hence "Min ?B = Min ?C"
     using L by simp
   moreover have "offs_next ns ub (x # xs) index key mi ma j = ns ! Min ?C"
     using K by (simp only: offs_next_def split: if_split, blast)
   ultimately show ?thesis
     using J by simp
 next
   let ?A = "offs_set_next (ns[i := Suc (ns ! i)]) xs index key mi ma j"
   let ?B = "offs_set_next ns (x # xs) index key mi ma j"
   case False
   hence "?A = ?B"
     using A by (rule_tac set_eqI, simp add: offs_num_cons)
   thus ?thesis
   proof (simp only: offs_next_def split: if_split,
    (rule_tac conjI, blast, rule_tac impI)+)
     assume "?B \<noteq> {}"
     hence "Min ?B \<in> ?B"
       by (rule_tac Min_in, simp)
     hence "i < Min ?B"
       using False by simp
     thus "ns[i := Suc (ns ! i)] ! Min ?B = ns ! Min ?B" by simp
   qed
 qed
 
 lemma offs_next_cons_neq:
   assumes
     A: "index key x (length ns) mi ma = i" and
     B: "offs_set_prev ns (x # xs) index key mi ma i \<noteq> {}" and
     C: "Max (offs_set_prev ns (x # xs) index key mi ma i) = j"
   shows "offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma j =
     (if 0 < offs_num (length ns) xs index key mi ma i
      then Suc (ns ! i)
      else offs_next ns ub (x # xs) index key mi ma i)"
 proof (simp, rule conjI, rule_tac [!] impI)
   let ?A = "offs_set_next ns (x # xs) index key mi ma j"
   assume "0 < offs_num (length ns) xs index key mi ma i"
   with A have "offs_set_next (ns[i := Suc (ns ! i)]) xs index key mi ma j = ?A"
     by (rule_tac set_eqI, rule_tac iffI, simp_all add: offs_num_cons split:
      if_split_asm)
   moreover have "0 < offs_num (length ns) (x # xs) index key mi ma i"
     using A by (simp add: offs_num_def)
   hence "0 < offs_num (length ns) (x # xs) index key mi ma j \<and> ?A \<noteq> {} \<and>
     Min ?A = i"
     using B and C by (subst offs_next_prev, simp)
   ultimately show "offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma j =
     Suc (ns ! i)"
     using B by (simp only: offs_next_def, simp, subst nth_list_update_eq, blast,
      simp)
 next
   let ?A = "offs_set_prev ns (x # xs) index key mi ma i"
   assume "offs_num (length ns) xs index key mi ma i = 0"
   with A have "offs_set_next (ns[i := Suc (ns ! i)]) xs index key mi ma j =
     offs_set_next ns (x # xs) index key mi ma i"
   proof (rule_tac set_eqI, rule_tac iffI, simp_all add: offs_num_cons split:
    if_split_asm, rule_tac conjI, rule_tac notI, simp, rule_tac impI,
    (erule_tac [!] conjE)+, rule_tac ccontr, simp_all)
     fix k
     have "i < length ns"
       using B by blast
     moreover assume "i \<noteq> k" and "\<not> i < k"
     hence "k < i" by simp
     moreover assume "0 < offs_num (length ns) xs index key mi ma k"
     ultimately have "k \<in> ?A"
       by (simp add: offs_num_cons)
     hence "k \<le> Max ?A"
       by (rule_tac Max_ge, simp)
     moreover assume "j < k"
     ultimately show False
       using C by simp
   next
     fix k
     have "Max ?A \<in> ?A"
       using B by (rule_tac Max_in, simp_all)
     hence "j < i"
       using C by simp
     moreover assume "i < k"
     ultimately show "j < k" by simp
   qed
   with B show "offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma j =
     offs_next ns ub (x # xs) index key mi ma i"
   proof (simp only: offs_next_def split: if_split, (rule_tac conjI, rule_tac [!] impI,
    simp)+, subst nth_list_update, blast, simp (no_asm_simp))
     assume "offs_set_next ns (x # xs) index key mi ma i \<noteq> {}"
     hence "Min (offs_set_next ns (x # xs) index key mi ma i)
       \<in> offs_set_next ns (x # xs) index key mi ma i"
       by (rule_tac Min_in, simp)
     thus "i \<noteq> Min (offs_set_next ns (x # xs) index key mi ma i)" by simp
   qed
 qed
 
 lemma offs_pred_ub_aux [rule_format]:
   assumes A: "offs_pred ns ub xs index key mi ma"
   shows "i < length ns \<Longrightarrow>
     \<forall>j < length ns. i \<le> j \<longrightarrow> 0 < offs_num (length ns) xs index key mi ma j \<longrightarrow>
       ns ! j + offs_num (length ns) xs index key mi ma j \<le> ub"
 proof (erule strict_inc_induct, rule_tac [!] allI, (rule_tac [!] impI)+,
  drule le_less_Suc_eq, simp_all)
   fix i
   assume B: "length ns = Suc i"
   hence "offs_num (Suc i) xs index key mi ma i \<le>
     offs_next ns ub xs index key mi ma i - ns ! i"
     using A by (simp add: offs_pred_def)
   moreover have "offs_next ns ub xs index key mi ma i = ub"
     using B by (simp add: offs_next_def)
   ultimately have "offs_num (Suc i) xs index key mi ma i \<le> ub - ns ! i" by simp
   moreover assume "0 < offs_num (Suc i) xs index key mi ma i"
   ultimately show "ns ! i + offs_num (Suc i) xs index key mi ma i \<le> ub" by simp
 next
   fix i j
   assume "j < length ns"
   hence "offs_num (length ns) xs index key mi ma j \<le>
     offs_next ns ub xs index key mi ma j - ns ! j"
     using A by (simp add: offs_pred_def)
   moreover assume
     B: "\<forall>k < length ns. Suc i \<le> k \<longrightarrow>
       0 < offs_num (length ns) xs index key mi ma k \<longrightarrow>
       ns ! k + offs_num (length ns) xs index key mi ma k \<le> ub" and
     C: "i \<le> j"
   have "offs_next ns ub xs index key mi ma j \<le> ub"
   proof (simp only: offs_next_def split: if_split, rule conjI, simp, rule impI)
     let ?A = "offs_set_next ns xs index key mi ma j"
     assume "?A \<noteq> {}"
     hence "Min ?A \<in> ?A"
       by (rule_tac Min_in, simp)
     hence "ns ! Min ?A + offs_num (length ns) xs index key mi ma (Min ?A) \<le> ub"
       using B and C by simp
     thus "ns ! Min ?A \<le> ub" by simp
   qed
   ultimately have "offs_num (length ns) xs index key mi ma j \<le> ub - ns ! j"
     by simp
   moreover assume "0 < offs_num (length ns) xs index key mi ma j"
   ultimately show "ns ! j + offs_num (length ns) xs index key mi ma j \<le> ub"
     by simp
 qed
 
 lemma offs_pred_ub:
  "\<lbrakk>offs_pred ns ub xs index key mi ma; i < length ns;
    0 < offs_num (length ns) xs index key mi ma i\<rbrakk> \<Longrightarrow>
      ns ! i + offs_num (length ns) xs index key mi ma i \<le> ub"
 by (drule offs_pred_ub_aux, assumption+, simp)
 
 lemma offs_pred_asc_aux [rule_format]:
   assumes A: "offs_pred ns ub xs index key mi ma"
   shows "i < length ns \<Longrightarrow>
     \<forall>j k. k < length ns \<longrightarrow> i \<le> j \<longrightarrow> j < k \<longrightarrow>
       0 < offs_num (length ns) xs index key mi ma j \<longrightarrow>
       0 < offs_num (length ns) xs index key mi ma k \<longrightarrow>
       ns ! j + offs_num (length ns) xs index key mi ma j \<le> ns ! k"
 proof (erule strict_inc_induct, simp, (rule allI)+, (rule impI)+, simp)
   fix i j k
   assume
     B: "k < length ns" and
     C: "j < k"
   hence "j < length ns" by simp
   hence "offs_num (length ns) xs index key mi ma j \<le>
     offs_next ns ub xs index key mi ma j - ns ! j"
     using A by (simp add: offs_pred_def)
   moreover assume
     D: "\<forall>j k. k < length ns \<longrightarrow> Suc i \<le> j \<longrightarrow> j < k \<longrightarrow>
       0 < offs_num (length ns) xs index key mi ma j \<longrightarrow>
       0 < offs_num (length ns) xs index key mi ma k \<longrightarrow>
       ns ! j + offs_num (length ns) xs index key mi ma j \<le> ns ! k" and
     E: "i \<le> j" and
     F: "0 < offs_num (length ns) xs index key mi ma k"
   have "offs_next ns ub xs index key mi ma j \<le> ns ! k"
   proof (simp only: offs_next_def split: if_split, rule conjI, rule_tac [!] impI,
    rule ccontr, simp)
     assume "\<forall>n > j. n < length ns \<longrightarrow>
       offs_num (length ns) xs index key mi ma n = 0"
     hence "offs_num (length ns) xs index key mi ma k = 0"
       using B and C by simp
     thus False
       using F by simp
   next
     let ?A = "offs_set_next ns xs index key mi ma j"
     have G: "k \<in> ?A"
       using B and C and F by simp
     hence "Min ?A \<le> k"
       by (rule_tac Min_le, simp)
     hence "Min ?A < k \<or> Min ?A = k"
       by (simp add: le_less)
     moreover {
       have "Suc i \<le> Min ?A \<longrightarrow> Min ?A < k \<longrightarrow>
         0 < offs_num (length ns) xs index key mi ma (Min ?A) \<longrightarrow>
         ns ! Min ?A + offs_num (length ns) xs index key mi ma (Min ?A) \<le> ns ! k"
         using B and D and F by simp
       moreover assume "Min ?A < k"
       moreover have "Min ?A \<in> ?A"
         using G by (rule_tac Min_in, simp, blast)
       ultimately have "ns ! Min ?A < ns ! k"
         using E by simp
     }
     moreover {
       assume "Min ?A = k"
       hence "ns ! Min ?A = ns ! k" by simp
     }
     ultimately show "ns ! Min ?A \<le> ns ! k"
       by (simp add: le_less, blast)
   qed
   ultimately have "offs_num (length ns) xs index key mi ma j \<le> ns ! k - ns ! j"
     by simp
   moreover assume "0 < offs_num (length ns) xs index key mi ma j"
   ultimately show "ns ! j + offs_num (length ns) xs index key mi ma j \<le> ns ! k"
     by simp
 qed
 
 lemma offs_pred_asc:
  "\<lbrakk>offs_pred ns ub xs index key mi ma; i < j; j < length ns;
    0 < offs_num (length ns) xs index key mi ma i;
    0 < offs_num (length ns) xs index key mi ma j\<rbrakk> \<Longrightarrow>
      ns ! i + offs_num (length ns) xs index key mi ma i \<le> ns ! j"
 by (drule offs_pred_asc_aux, erule less_trans, assumption+, rule order_refl)
 
 lemma offs_pred_next:
   assumes
     A: "offs_pred ns ub xs index key mi ma" and
     B: "i < length ns" and
     C: "0 < offs_num (length ns) xs index key mi ma i"
   shows "ns ! i < offs_next ns ub xs index key mi ma i"
 proof (simp only: offs_next_def split: if_split, rule conjI, rule_tac [!] impI)
   have "ns ! i + offs_num (length ns) xs index key mi ma i \<le> ub"
     using A and B and C by (rule offs_pred_ub)
   thus "ns ! i < ub"
     using C by simp
 next
   assume "offs_set_next ns xs index key mi ma i \<noteq> {}"
   hence "Min (offs_set_next ns xs index key mi ma i)
     \<in> offs_set_next ns xs index key mi ma i"
     by (rule_tac Min_in, simp)
   hence "ns ! i + offs_num (length ns) xs index key mi ma i \<le>
     ns ! Min (offs_set_next ns xs index key mi ma i)"
     using C by (rule_tac offs_pred_asc [OF A], simp_all)
   thus "ns ! i < ns ! Min (offs_set_next ns xs index key mi ma i)"
     using C by simp
 qed
 
 lemma offs_pred_next_cons_less:
   assumes
     A: "offs_pred ns ub (x # xs) index key mi ma" and
     B: "index key x (length ns) mi ma = i" and
     C: "offs_set_prev ns (x # xs) index key mi ma i \<noteq> {}" and
     D: "Max (offs_set_prev ns (x # xs) index key mi ma i) = j"
   shows "offs_next ns ub (x # xs) index key mi ma j <
     offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma j"
   (is "?M < ?N")
 proof -
   have E: "0 < offs_num (length ns) (x # xs) index key mi ma i"
     using B by (simp add: offs_num_cons)
   hence "0 < offs_num (length ns) (x # xs) index key mi ma j \<and>
     offs_set_next ns (x # xs) index key mi ma j \<noteq> {} \<and>
     Min (offs_set_next ns (x # xs) index key mi ma j) = i"
     using C and D by (subst offs_next_prev, simp)
   hence F: "?M = ns ! i"
     by (simp only: offs_next_def, simp)
   have "?N = (if 0 < offs_num (length ns) xs index key mi ma i
     then Suc (ns ! i)
     else offs_next ns ub (x # xs) index key mi ma i)"
     using B and C and D by (rule offs_next_cons_neq)
   thus ?thesis
   proof (split if_split_asm)
     assume "?N = Suc (ns ! i)"
     thus ?thesis
       using F by simp
   next
     assume "?N = offs_next ns ub (x # xs) index key mi ma i"
     moreover have "ns ! i < offs_next ns ub (x # xs) index key mi ma i"
       using C by (rule_tac offs_pred_next [OF A _ E], blast)
     ultimately show ?thesis
       using F by simp
   qed
 qed
 
 lemma offs_pred_next_cons:
   assumes
     A: "offs_pred ns ub (x # xs) index key mi ma" and
     B: "index key x (length ns) mi ma = i" and
     C: "i < length ns" and
     D: "0 < offs_num (length ns) (x # xs) index key mi ma j"
   shows "offs_next ns ub (x # xs) index key mi ma j \<le>
     offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma j"
   (is "?M \<le> ?N")
 proof -
   let ?P = "offs_set_prev ns (x # xs) index key mi ma i \<noteq> {} \<and>
     Max (offs_set_prev ns (x # xs) index key mi ma i) = j"
   have "?P \<or> \<not> ?P" by blast
   moreover {
     assume ?P
     hence "?M < ?N"
       using B by (rule_tac offs_pred_next_cons_less [OF A], simp_all)
     hence ?thesis by simp
   }
   moreover {
     assume "\<not> ?P"
     hence "?N = ?M"
       by (rule_tac offs_next_cons_eq [OF B C D], blast)
     hence ?thesis by simp
   }
   ultimately show ?thesis ..
 qed
 
 lemma offs_pred_cons:
   assumes
     A: "offs_pred ns ub (x # xs) index key mi ma" and
     B: "index key x (length ns) mi ma = i" and
     C: "i < length ns"
   shows "offs_pred (ns[i := Suc (ns ! i)]) ub xs index key mi ma"
   using A
 proof (simp add: offs_pred_def, rule_tac allI, rule_tac impI, simp)
   let ?ns' = "ns[i := Suc (ns ! i)]"
   fix j
   assume
    "\<forall>j < length ns. offs_num (length ns) (x # xs) index key mi ma j \<le>
       offs_next ns ub (x # xs) index key mi ma j - ns ! j" and
    "j < length ns"
   hence D: "offs_num (length ns) (x # xs) index key mi ma j \<le>
     offs_next ns ub (x # xs) index key mi ma j - ns ! j"
     by simp
   from B and C show "offs_num (length ns) xs index key mi ma j \<le>
     offs_next ?ns' ub xs index key mi ma j - ?ns' ! j"
   proof (cases "j = i", case_tac [2] "0 < offs_num (length ns) xs index key mi ma j",
    simp_all)
     assume "j = i"
     hence "offs_num (length ns) xs index key mi ma i \<le>
       offs_next ns ub (x # xs) index key mi ma i - Suc (ns ! i)"
       using B and D by (simp add: offs_num_cons)
     moreover have "offs_next ns ub (x # xs) index key mi ma i \<le>
       offs_next ?ns' ub xs index key mi ma i"
       using B by (rule_tac offs_pred_next_cons [OF A _ C], simp_all add:
        offs_num_cons)
     ultimately show "offs_num (length ns) xs index key mi ma i \<le>
       offs_next ?ns' ub xs index key mi ma i - Suc (ns ! i)"
       by simp
   next
     assume "j \<noteq> i"
     hence "offs_num (length ns) xs index key mi ma j \<le>
       offs_next ns ub (x # xs) index key mi ma j - ns ! j"
       using B and D by (simp add: offs_num_cons)
     moreover assume "0 < offs_num (length ns) xs index key mi ma j"
     hence "offs_next ns ub (x # xs) index key mi ma j \<le>
       offs_next ?ns' ub xs index key mi ma j"
       using B by (rule_tac offs_pred_next_cons [OF A _ C], simp_all add:
        offs_num_cons)
     ultimately show "offs_num (length ns) xs index key mi ma j \<le>
       offs_next ?ns' ub xs index key mi ma j - ns ! j"
       by simp
   qed
 qed
 
 text \<open>
 \null
 
 The next step consists of proving, as done in lemma @{text fill_count_item} in what follows, that if
 certain conditions hold, particularly if offsets' list $ns$ and objects' list $xs$ satisfy predicate
 @{const offs_pred}, then function @{const fill} conserves objects if called using $xs$ and $ns$ as
 its input arguments.
 
 This lemma is proven by induction on $xs$. Hence, lemma @{thm [source] offs_pred_cons}, proven in
 the previous step, is used to remove the antecedent containing predicate @{const offs_pred} from the
 induction hypothesis, which has the form of an implication.
 
 \null
 \<close>
 
 lemma offs_next_zero:
   assumes
     A: "i < length ns" and
     B: "offs_num (length ns) xs index key mi ma i = 0" and
     C: "offs_set_prev ns xs index key mi ma i = {}"
   shows "offs_next ns ub xs index key mi ma 0 =
     offs_next ns ub xs index key mi ma i"
 proof -
   have "offs_set_next ns xs index key mi ma 0 =
     offs_set_next ns xs index key mi ma i"
   proof (rule set_eqI, rule iffI, simp_all, (erule conjE)+, rule ccontr, simp add:
    not_less)
     fix j
     assume D: "0 < offs_num (length ns) xs index key mi ma j"
     assume "j \<le> i"
     hence "j < i \<or> j = i"
       by (simp add: le_less)
     moreover {
       assume "j < i"
       hence "j \<in> offs_set_prev ns xs index key mi ma i"
         using A and D by simp
       hence False
         using C by simp
     }
     moreover {
       assume "j = i"
       hence False
         using B and D by simp
     }
     ultimately show False ..
   qed
   thus ?thesis
     by (simp only: offs_next_def)
 qed
 
 lemma offs_next_zero_cons_eq:
   assumes
     A: "index key x (length ns) mi ma = i" and
     B: "offs_num (length ns) (x # xs) index key mi ma 0 = 0" and
     C: "offs_set_prev ns (x # xs) index key mi ma i \<noteq> {}"
       (is "?A \<noteq> _")
   shows "offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma 0 =
     offs_next ns ub (x # xs) index key mi ma 0"
 proof -
   have D: "Min ?A \<in> ?A"
     using C by (rule_tac Min_in, simp)
   moreover have E: "0 < Min ?A"
   proof (rule ccontr, simp)
     assume "Min ?A = 0"
     hence "offs_num (length ns) (x # xs) index key mi ma (Min ?A) = 0"
       using B by simp
     moreover have "0 < offs_num (length ns) (x # xs) index key mi ma (Min ?A)"
       using D by auto
     ultimately show False by simp
   qed
   ultimately have "Min ?A \<in> offs_set_next ns (x # xs) index key mi ma 0"
     (is "_ \<in> ?B")
     by auto
   moreover from this have "Min ?B = Min ?A"
   proof (subst Min_eq_iff, simp, blast, simp, rule_tac allI, rule_tac impI,
    (erule_tac conjE)+, rule_tac ccontr, simp add: not_le)
     fix j
     assume F: "j < Min ?A"
     have "i < length ns"
       using D by simp
     moreover have "Min ?A < i"
       using D by auto
     hence "j < i"
       using F by simp
     moreover assume "0 < offs_num (length ns) (x # xs) index key mi ma j"
     ultimately have "j \<in> ?A" by simp
     hence "Min ?A \<le> j"
       by (rule_tac Min_le, simp)
     thus False
       using F by simp
   qed
   moreover have "Min ?A \<in> offs_set_next (ns[i := Suc (ns ! i)])
     xs index key mi ma 0"
     (is "_ \<in> ?C")
     using D and E by (auto, simp add: offs_num_cons A [symmetric])
   moreover from this have "Min ?C = Min ?A"
   proof (subst Min_eq_iff, simp, blast, simp, rule_tac allI, rule_tac impI,
    (erule_tac conjE)+, rule_tac ccontr, simp add: not_le)
     fix j
     assume F: "j < Min ?A"
     have "i < length ns"
       using D by simp
     moreover have "Min ?A < i"
       using D by auto
     hence "j < i"
       using F by simp
     moreover assume "0 < offs_num (length ns) xs index key mi ma j"
     hence "0 < offs_num (length ns) (x # xs) index key mi ma j"
       by (simp add: offs_num_cons)
     ultimately have "j \<in> ?A" by simp
     hence "Min ?A \<le> j"
       by (rule_tac Min_le, simp)
     thus False
       using F by simp
   qed
   moreover have "Min ?A < i"
     using D by auto
   ultimately show ?thesis
     by (simp only: offs_next_def split: if_split,
      (rule_tac conjI, blast, rule_tac impI)+, simp)
 qed
 
 lemma offs_next_zero_cons_neq:
   assumes
     A: "index key x (length ns) mi ma = i" and
     B: "i < length ns" and
     C: "0 < i" and
     D: "offs_set_prev ns (x # xs) index key mi ma i = {}"
   shows "offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma 0 =
     (if 0 < offs_num (length ns) xs index key mi ma i
      then Suc (ns ! i)
      else offs_next ns ub (x # xs) index key mi ma i)"
 proof (simp, rule conjI, rule_tac [!] impI)
   let ?ns' = "ns[i := Suc (ns ! i)]"
   assume "0 < offs_num (length ns) xs index key mi ma i"
   with A have "offs_set_next ?ns' xs index key mi ma 0 =
     offs_set_next ns (x # xs) index key mi ma 0"
     by (rule_tac set_eqI, rule_tac iffI, simp_all add: offs_num_cons split:
      if_split_asm)
   moreover have "i \<in> offs_set_next ns (x # xs) index key mi ma 0"
     using A and B and C by (simp add: offs_num_cons)
   moreover from this have
    "Min (offs_set_next ns (x # xs) index key mi ma 0) = i"
   proof (subst Min_eq_iff, simp, blast, simp, rule_tac allI, rule_tac impI,
    (erule_tac conjE)+, rule_tac ccontr, simp add: not_le)
     fix j
     assume "j < i" and "0 < offs_num (length ns) (x # xs) index key mi ma j"
     hence "j \<in> offs_set_prev ns (x # xs) index key mi ma i"
       using B by simp
     thus False
       using D by simp
   qed
   ultimately show "offs_next ?ns' ub xs index key mi ma 0 = Suc (ns ! i)"
     by (simp only: offs_next_def split: if_split, rule_tac conjI, rule_tac [!] impI,
      simp_all)
 next
   let ?ns' = "ns[i := Suc (ns ! i)]"
   assume "offs_num (length ns) xs index key mi ma i = 0"
   moreover have "offs_set_prev ?ns' xs index key mi ma i = {}"
     using D by (simp add: offs_num_cons split: if_split_asm, blast)
   ultimately have "offs_next ?ns' ub xs index key mi ma 0 =
     offs_next ?ns' ub xs index key mi ma i"
     using B by (rule_tac offs_next_zero, simp_all)
   moreover have "offs_next ?ns' ub xs index key mi ma i =
     offs_next ns ub (x # xs) index key mi ma i"
     using A and B and D by (rule_tac offs_next_cons_eq, simp_all add:
      offs_num_cons)
   ultimately show "offs_next ?ns' ub xs index key mi ma 0 =
     offs_next ns ub (x # xs) index key mi ma i"
     by simp
 qed
 
 lemma offs_pred_zero_cons_less:
   assumes
     A: "offs_pred ns ub (x # xs) index key mi ma" and
     B: "index key x (length ns) mi ma = i" and
     C: "i < length ns" and
     D: "0 < i" and
     E: "offs_set_prev ns (x # xs) index key mi ma i = {}"
   shows "offs_next ns ub (x # xs) index key mi ma 0 <
     offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma 0"
   (is "?M < ?N")
 proof -
   have "i \<in> offs_set_next ns (x # xs) index key mi ma 0"
     using B and C and D by (simp add: offs_num_cons)
   moreover from this have
    "Min (offs_set_next ns (x # xs) index key mi ma 0) = i"
   proof (subst Min_eq_iff, simp, blast, simp, rule_tac allI, rule_tac impI,
    (erule_tac conjE)+, rule_tac ccontr, simp add: not_le)
     fix j
     assume "j < i" and "0 < offs_num (length ns) (x # xs) index key mi ma j"
     hence "j \<in> offs_set_prev ns (x # xs) index key mi ma i"
       using C by simp
     thus False
       using E by simp
   qed
   ultimately have F: "?M = ns ! i"
     by (simp only: offs_next_def split: if_split, blast)
   have "?N = (if 0 < offs_num (length ns) xs index key mi ma i
     then Suc (ns ! i)
     else offs_next ns ub (x # xs) index key mi ma i)"
     using B and C and D and E by (rule offs_next_zero_cons_neq)
   thus ?thesis
   proof (split if_split_asm)
     assume "?N = Suc (ns ! i)"
     thus ?thesis
       using F by simp
   next
     assume "?N = offs_next ns ub (x # xs) index key mi ma i"
     moreover have "ns ! i < offs_next ns ub (x # xs) index key mi ma i"
       using B by (rule_tac offs_pred_next [OF A C], simp add: offs_num_cons)
     ultimately show ?thesis
       using F by simp
   qed
 qed
 
 lemma offs_pred_zero_cons:
   assumes
     A: "offs_pred ns ub (x # xs) index key mi ma" and
     B: "index key x (length ns) mi ma = i" and
     C: "i < length ns" and
     D: "offs_num (length ns) (x # xs) index key mi ma 0 = 0"
   shows "offs_next ns ub (x # xs) index key mi ma 0 \<le>
     offs_next (ns[i := Suc (ns ! i)]) ub xs index key mi ma 0"
   (is "?M \<le> ?N")
 proof (cases "offs_set_prev ns (x # xs) index key mi ma i = {}")
   case True
   have "0 < i"
     using B and D by (rule_tac ccontr, simp add: offs_num_cons)
   hence "?M < ?N"
     using True and B by (rule_tac offs_pred_zero_cons_less [OF A _ C])
   thus ?thesis by simp
 next
   case False
   hence "?N = ?M"
     by (rule offs_next_zero_cons_eq [OF B D])
   thus ?thesis by simp
 qed
 
 lemma replicate_count:
  "count (mset (replicate n x)) x = n"
 by (induction n, simp_all)
 
 lemma fill_none [rule_format]:
   assumes A: "index_less index key"
   shows
    "(\<forall>x \<in> set xs. key x \<in> {mi..ma}) \<longrightarrow>
     ns \<noteq> [] \<longrightarrow>
     offs_pred ns ub xs index key mi ma \<longrightarrow>
     offs_none ns ub xs index key mi ma i \<longrightarrow>
       fill xs ns index key ub mi ma ! i = None"
 proof (induction xs arbitrary: ns, simp add: offs_none_def offs_num_def offs_next_def,
  (rule impI)+, simp add: Let_def, (erule conjE)+)
   fix x xs and ns :: "nat list"
   let ?i' = "index key x (length ns) mi ma"
   let ?ns' = "ns[?i' := Suc (ns ! ?i')]"
   assume
     B: "offs_pred ns ub (x # xs) index key mi ma" and
     C: "offs_none ns ub (x # xs) index key mi ma i"
   assume
     D: "ns \<noteq> []" and "mi \<le> key x" and "key x \<le> ma"
   moreover from this have
     E: "?i' < length ns"
     using A by (simp add: index_less_def)
   hence "offs_pred ?ns' ub xs index key mi ma"
     by (rule_tac offs_pred_cons [OF B], simp)
   moreover assume "\<And>ns. ns \<noteq> [] \<longrightarrow> offs_pred ns ub xs index key mi ma \<longrightarrow>
     offs_none ns ub xs index key mi ma i \<longrightarrow>
     fill xs ns index key ub mi ma ! i = None"
   ultimately have
     F: "offs_none ?ns' ub xs index key mi ma i \<longrightarrow>
       fill xs ?ns' index key ub mi ma ! i = None"
     by simp
   show "(fill xs ?ns' index key ub mi ma)[ns ! ?i' := Some x] ! i = None"
-  proof (insert C, simp add: offs_none_def, erule disjE, erule_tac [2] disjE, simp_all del: subst_all subst_all'
+  proof (insert C, simp add: offs_none_def, erule disjE, erule_tac [2] disjE, simp_all del: subst_all
    add: offs_num_cons split: if_split_asm, erule conjE, rule case_split, drule mp,
-   assumption, simp_all del: subst_all subst_all', (erule conjE)+, (erule_tac [2] conjE)+,
+   assumption, simp_all del: subst_all, (erule conjE)+, (erule_tac [2] conjE)+,
    erule_tac [3] conjE, erule_tac [5] conjE)
     fix j
     assume
       G: "?i' = j" and
       H: "j < length ns" and
       I: "Suc (ns ! j + offs_num (length ns) xs index key mi ma j) \<le> i" and
       J: "i < offs_next ns ub (x # xs) index key mi ma j"
     show "fill xs (ns[j := Suc (ns ! j)]) index key ub mi ma ! i = None"
     proof (cases "0 < offs_num (length ns) xs index key mi ma j",
      case_tac [2] "offs_set_prev ns (x # xs) index key mi ma j \<noteq> {}",
      simp_all only: not_not not_gr0)
       have "j < length ns \<and> 0 < offs_num (length ns) xs index key mi ma j \<and>
         ?ns' ! j + offs_num (length ns) xs index key mi ma j \<le> i \<and>
         i < offs_next ?ns' ub xs index key mi ma j \<longrightarrow>
           fill xs ?ns' index key ub mi ma ! i = None"
         using F by (simp add: offs_none_def, blast)
       moreover assume "0 < offs_num (length ns) xs index key mi ma j"
       moreover have "?ns' ! j + offs_num (length ns) xs index key mi ma j \<le> i"
         using G and H and I by simp
       moreover have "0 < offs_num (length ns) (x # xs) index key mi ma j"
         using G by (simp add: offs_num_cons)
       hence "offs_next ns ub (x # xs) index key mi ma j \<le>
         offs_next ?ns' ub xs index key mi ma j"
         using G and H by (rule_tac offs_pred_next_cons [OF B], simp_all)
       hence "i < offs_next ?ns' ub xs index key mi ma j"
         using J by simp
       ultimately have "fill xs ?ns' index key ub mi ma ! i = None"
         using H by blast
       thus ?thesis
         using G by simp
     next
       let ?j' = "Max (offs_set_prev ns (x # xs) index key mi ma j)"
       have "?j' < length ns \<and> 0 < offs_num (length ns) xs index key mi ma ?j' \<and>
         ?ns' ! ?j' + offs_num (length ns) xs index key mi ma ?j' \<le> i \<and>
         i < offs_next ?ns' ub xs index key mi ma ?j' \<longrightarrow>
           fill xs ?ns' index key ub mi ma ! i = None"
         using F by (simp add: offs_none_def, blast)
       moreover assume K: "offs_set_prev ns (x # xs) index key mi ma j \<noteq> {}"
       hence "?j' \<in> offs_set_prev ns (x # xs) index key mi ma j"
         by (rule_tac Max_in, simp)
       hence L: "?j' < length ns \<and> ?j' < j \<and>
         0 < offs_num (length ns) xs index key mi ma ?j'"
         using G by (auto, subst (asm) (2) offs_num_cons, simp)
       moreover have "ns ! ?j' + offs_num (length ns) (x # xs)
         index key mi ma ?j' \<le> ns ! j"
         using G and H and L by (rule_tac offs_pred_asc [OF B], simp_all add:
          offs_num_cons)
       hence "?ns' ! ?j' + offs_num (length ns) xs index key mi ma ?j' \<le> ns ! j"
         using G and H and L by (subst nth_list_update, simp_all add: offs_num_cons)
       hence "?ns' ! ?j' + offs_num (length ns) xs index key mi ma ?j' \<le> i"
         using I by simp
       moreover assume M: "offs_num (length ns) xs index key mi ma j = 0"
       have "offs_next (ns[j := Suc (ns ! j)]) ub xs index key mi ma ?j' =
        (if 0 < offs_num (length ns) xs index key mi ma j
         then Suc (ns ! j)
         else offs_next ns ub (x # xs) index key mi ma j)"
         using G and K by (rule_tac offs_next_cons_neq, simp_all)
       hence "offs_next ?ns' ub xs index key mi ma ?j' =
         offs_next ns ub (x # xs) index key mi ma j"
         using G and M by simp
       hence "i < offs_next ?ns' ub xs index key mi ma ?j'"
         using J by simp
       ultimately have "fill xs ?ns' index key ub mi ma ! i = None" by blast
       thus ?thesis
         using G by simp
     next
       have "offs_num (length ns) xs index key mi ma 0 = 0 \<and>
         i < offs_next ?ns' ub xs index key mi ma 0 \<longrightarrow>
           fill xs ?ns' index key ub mi ma ! i = None"
         using F by (simp add: offs_none_def)
       moreover assume
         K: "offs_set_prev ns (x # xs) index key mi ma j = {}" and
         L: "offs_num (length ns) xs index key mi ma j = 0"
       have "offs_set_prev ns (x # xs) index key mi ma j =
         offs_set_prev ?ns' xs index key mi ma j"
         using G by (rule_tac set_eqI, rule_tac iffI,
          simp_all add: offs_num_cons split: if_split_asm)
       hence M: "offs_set_prev ?ns' xs index key mi ma j = {}"
         using K by simp
       hence "offs_num (length ns) xs index key mi ma 0 = 0"
         using H and L by (cases j, simp_all)
       moreover have N: "offs_next ?ns' ub xs index key mi ma 0 =
         offs_next ?ns' ub xs index key mi ma j"
         using H and L and M by (rule_tac offs_next_zero, simp_all)
       have "offs_next ?ns' ub xs index key mi ma j =
         offs_next ns ub (x # xs) index key mi ma j"
         using G and H and K by (subst offs_next_cons_eq, simp_all add:
          offs_num_cons)
       hence "i < offs_next ?ns' ub xs index key mi ma 0"
         using J and N by simp
       ultimately have "fill xs ?ns' index key ub mi ma ! i = None" by blast
       thus ?thesis
         using G by simp
     qed
   next
     fix j
     assume
       G: "?i' \<noteq> j" and
       H: "j < length ns" and
       I: "ns ! j + offs_num (length ns) xs index key mi ma j \<le> i" and
       J: "i < offs_next ns ub (x # xs) index key mi ma j" and
       K: "0 < offs_num (length ns) xs index key mi ma j"
     from G have "ns ! ?i' \<noteq> i"
     proof (rule_tac notI, cases "?i' < j", simp_all add: not_less le_less)
       assume "?i' < j"
       hence "ns ! ?i' + offs_num (length ns) (x # xs) index key mi ma ?i' \<le> ns ! j"
         using H and K by (rule_tac offs_pred_asc [OF B], simp_all add:
          offs_num_cons)
       moreover assume "ns ! ?i' = i"
       ultimately have "i < ns ! j" by (simp add: offs_num_cons)
       thus False
         using I by simp
     next
       assume "j < ?i'"
       hence L: "?i' \<in> offs_set_next ns (x # xs) index key mi ma j"
         (is "_ \<in> ?A")
         using E by (simp add: offs_num_cons)
       hence "Min ?A \<le> ?i'"
         by (rule_tac Min_le, simp)
       hence "Min ?A < ?i' \<or> Min ?A = ?i'"
         by (simp add: le_less)
       hence "ns ! Min ?A \<le> ns ! ?i'"
       proof (rule disjE, simp_all)
         assume "Min ?A < ?i'"
         moreover have "Min ?A \<in> ?A"
           using L by (rule_tac Min_in, simp, blast)
         hence "0 < offs_num (length ns) (x # xs) index key mi ma (Min ?A)"
           by simp
         ultimately have "ns ! Min ?A + offs_num (length ns) (x # xs)
           index key mi ma (Min ?A) \<le> ns ! ?i'"
           using E by (rule_tac offs_pred_asc [OF B], simp_all add: offs_num_cons)
         thus ?thesis by simp
       qed
       hence "offs_next ns ub (x # xs) index key mi ma j \<le> ns ! ?i'"
         using L by (simp only: offs_next_def split: if_split, blast)
       moreover assume "ns ! ?i' = i"
       ultimately show False
         using J by simp
     qed
     thus "(fill xs ?ns' index key ub mi ma)[ns ! ?i' := Some x] ! i = None"
     proof simp
       have "j < length ns \<and> 0 < offs_num (length ns) xs index key mi ma j \<and>
         ?ns' ! j + offs_num (length ns) xs index key mi ma j \<le> i \<and>
         i < offs_next ?ns' ub xs index key mi ma j \<longrightarrow>
           fill xs ?ns' index key ub mi ma ! i = None"
         using F by (simp add: offs_none_def, blast)
       moreover have "offs_next ns ub (x # xs) index key mi ma j \<le>
         offs_next ?ns' ub xs index key mi ma j"
         using E and K by (rule_tac offs_pred_next_cons [OF B], simp_all add:
          offs_num_cons)
       hence "i < offs_next ?ns' ub xs index key mi ma j"
         using J by simp
       ultimately show "fill xs ?ns' index key ub mi ma ! i = None"
         using G and H and I and K by simp
     qed
   next
     assume
       G: "0 < ?i'" and
       H: "offs_num (length ns) xs index key mi ma 0 = 0" and
       I: "i < offs_next ns ub (x # xs) index key mi ma 0"
     have "ns ! ?i' \<noteq> i"
     proof
       have "0 < offs_num (length ns) (x # xs) index key mi ma ?i'"
         by (simp add: offs_num_cons)
       hence L: "?i' \<in> offs_set_next ns (x # xs) index key mi ma 0"
         (is "_ \<in> ?A")
         using E and G by simp
       hence "Min ?A \<le> ?i'"
         by (rule_tac Min_le, simp)
       hence "Min ?A < ?i' \<or> Min ?A = ?i'"
         by (simp add: le_less)
       hence "ns ! Min ?A \<le> ns ! ?i'"
       proof (rule disjE, simp_all)
         assume "Min ?A < ?i'"
         moreover have "Min ?A \<in> ?A"
           using L by (rule_tac Min_in, simp, blast)
         hence "0 < offs_num (length ns) (x # xs) index key mi ma (Min ?A)"
           by simp
         ultimately have "ns ! Min ?A + offs_num (length ns) (x # xs)
           index key mi ma (Min ?A) \<le> ns ! ?i'"
           using E by (rule_tac offs_pred_asc [OF B], simp_all add: offs_num_cons)
         thus ?thesis by simp
       qed
       hence "offs_next ns ub (x # xs) index key mi ma 0 \<le> ns ! ?i'"
         using L by (simp only: offs_next_def split: if_split, blast)
       moreover assume "ns ! ?i' = i"
       ultimately show False
         using I by simp
     qed
     thus "(fill xs ?ns' index key ub mi ma)[ns ! ?i' := Some x] ! i = None"
     proof simp
       have "offs_num (length ns) xs index key mi ma 0 = 0 \<and>
         i < offs_next ?ns' ub xs index key mi ma 0 \<longrightarrow>
           fill xs ?ns' index key ub mi ma ! i = None"
         using F by (simp add: offs_none_def)
       moreover have "offs_next ns ub (x # xs) index key mi ma 0 \<le>
         offs_next ?ns' ub xs index key mi ma 0"
         using E and G and H by (rule_tac offs_pred_zero_cons [OF B],
          simp_all add: offs_num_cons)
       hence "i < offs_next ?ns' ub xs index key mi ma 0"
         using I by simp
       ultimately show "fill xs ?ns' index key ub mi ma ! i = None"
         using H by simp
     qed
   next
     assume
       G: "?i' = 0" and
       H: "i < ns ! 0"
     show "fill xs (ns[0 := Suc (ns ! 0)]) index key ub mi ma ! i = None"
     proof (cases "0 < offs_num (length ns) xs index key mi ma 0", simp_all)
       have "0 < offs_num (length ns) xs index key mi ma 0 \<and> i < ?ns' ! 0 \<longrightarrow>
         fill xs ?ns' index key ub mi ma ! i = None"
         using F by (simp add: offs_none_def)
       moreover assume "0 < offs_num (length ns) xs index key mi ma 0"
       moreover have "i < ?ns' ! 0"
         using D and G and H by simp
       ultimately show ?thesis
         using G by simp
     next
       have "offs_num (length ns) xs index key mi ma 0 = 0 \<and>
         i < offs_next ?ns' ub xs index key mi ma 0 \<longrightarrow>
           fill xs ?ns' index key ub mi ma ! i = None"
         using F by (simp add: offs_none_def)
       moreover assume "offs_num (length ns) xs index key mi ma 0 = 0"
       moreover have I: "offs_next ?ns' ub xs index key mi ma 0 =
         offs_next ns ub (x # xs) index key mi ma 0"
         using D and G by (rule_tac offs_next_cons_eq, simp_all add:
          offs_num_cons)
       have "ns ! 0 < offs_next ns ub (x # xs) index key mi ma 0"
         using D and G by (rule_tac offs_pred_next [OF B], simp_all add:
          offs_num_cons)
       hence "i < offs_next ?ns' ub xs index key mi ma 0"
         using H and I by simp
       ultimately show ?thesis
         using G by simp
     qed
   next
     assume
       G: "0 < ?i'" and
       H: "0 < offs_num (length ns) xs index key mi ma 0" and
       I: "i < ns ! 0"
     have "ns ! ?i' \<noteq> i"
     proof -
       have "ns ! 0 + offs_num (length ns) (x # xs) index key mi ma 0 \<le> ns ! ?i'"
         using H by (rule_tac offs_pred_asc [OF B G E], simp_all add:
          offs_num_cons)
       moreover have "0 < offs_num (length ns) (x # xs) index key mi ma 0"
         using H by (simp add: offs_num_cons)
       ultimately show ?thesis
         using I by simp
     qed
     thus "(fill xs ?ns' index key ub mi ma)[ns ! ?i' := Some x] ! i = None"
     proof simp
       have "0 < offs_num (length ns) xs index key mi ma 0 \<and> i < ?ns' ! 0 \<longrightarrow>
         fill xs ?ns' index key ub mi ma ! i = None"
         using F by (simp add: offs_none_def)
       moreover have "i < ?ns' ! 0"
         using G and I by simp
       ultimately show "fill xs ?ns' index key ub mi ma ! i = None"
         using H by simp
     qed
   qed
 qed
 
 lemma fill_index_none [rule_format]:
   assumes
     A: "index_less index key" and
     B: "key x \<in> {mi..ma}" and
     C: "ns \<noteq> []" and
     D: "offs_pred ns ub (x # xs) index key mi ma"
   shows "\<forall>x \<in> set xs. key x \<in> {mi..ma} \<Longrightarrow>
     fill xs (ns[(index key x (length ns) mi ma) :=
       Suc (ns ! index key x (length ns) mi ma)]) index key ub mi ma !
         (ns ! index key x (length ns) mi ma) = None"
   (is "_ \<Longrightarrow> fill _ ?ns' _ _ _ _ _ ! (_ ! ?i) = _")
   using A and B and C and D
 proof (rule_tac fill_none, simp_all, rule_tac offs_pred_cons,
  simp_all, simp add: index_less_def, cases "0 < ?i",
  cases "offs_set_prev ns (x # xs) index key mi ma ?i = {}",
  case_tac [3] "0 < offs_num (length ns) xs index key mi ma 0")
   assume
     E: "0 < ?i" and
     F: "offs_set_prev ns (x # xs) index key mi ma ?i = {}"
   have G: "?i < length ns"
     using A and B and C by (simp add: index_less_def)
   hence "offs_num (length ns) (x # xs) index key mi ma 0 = 0"
     using E and F by (rule_tac ccontr, simp)
   hence "offs_num (length ns) xs index key mi ma 0 = 0"
     by (simp add: offs_num_cons split: if_split_asm)
   moreover have "offs_next ?ns' ub xs index key mi ma 0 =
    (if 0 < offs_num (length ns) xs index key mi ma ?i
     then Suc (ns ! ?i)
     else offs_next ns ub (x # xs) index key mi ma ?i)"
     using E and F and G by (rule_tac offs_next_zero_cons_neq, simp_all)
   hence "ns ! ?i < offs_next ?ns' ub xs index key mi ma 0"
     by (simp split: if_split_asm, rule_tac offs_pred_next [OF D G], simp add:
      offs_num_cons)
   ultimately show "offs_none ?ns' ub xs index key mi ma (ns ! ?i)"
     by (simp add: offs_none_def)
 next
   assume
     E: "0 < ?i" and
     F: "offs_set_prev ns (x # xs) index key mi ma ?i \<noteq> {}"
       (is "?A \<noteq> _")
   have G: "?i < length ns"
     using A and B and C by (simp add: index_less_def)
   have H: "Max ?A \<in> ?A"
     using F by (rule_tac Max_in, simp)
   hence I: "Max ?A < ?i" by blast
   have "Max ?A < length ns"
     using H by auto
   moreover have "0 < offs_num (length ns) (x # xs) index key mi ma (Max ?A)"
     using H by auto
   hence "0 < offs_num (length ns) xs index key mi ma (Max ?A)"
     using I by (subst (asm) offs_num_cons, split if_split_asm, simp_all)
   moreover have "ns ! Max ?A + offs_num (length ns) (x # xs)
     index key mi ma (Max ?A) \<le> ns ! ?i"
     using G and H by (rule_tac offs_pred_asc [OF D], simp_all add: offs_num_cons)
   hence "?ns' ! Max ?A + offs_num (length ns) xs
     index key mi ma (Max ?A) \<le> ns ! ?i"
     using I by (simp add: offs_num_cons)
   moreover have "offs_next ?ns' ub xs index key mi ma (Max ?A) =
    (if 0 < offs_num (length ns) xs index key mi ma ?i
     then Suc (ns ! ?i)
     else offs_next ns ub (x # xs) index key mi ma ?i)"
     using F and I by (rule_tac offs_next_cons_neq, simp_all)
   hence "ns ! ?i < offs_next ?ns' ub xs index key mi ma (Max ?A)"
     by (simp split: if_split_asm, rule_tac offs_pred_next [OF D G], simp add:
      offs_num_cons)
   ultimately show "offs_none ?ns' ub xs index key mi ma (ns ! ?i)"
     by (simp add: offs_none_def, blast)
 next
   assume "0 < offs_num (length ns) xs index key mi ma 0" and "\<not> 0 < ?i"
   moreover have "?i < length ns"
     using A and B and C by (simp add: index_less_def)
   ultimately show "offs_none ?ns' ub xs index key mi ma (ns ! ?i)"
     by (simp add: offs_none_def)
 next
   assume
     E: "\<not> 0 < ?i" and
     F: "\<not> 0 < offs_num (length ns) xs index key mi ma 0"
   have G: "?i < length ns"
     using A and B and C by (simp add: index_less_def)
   have "offs_num (length ns) xs index key mi ma 0 = 0"
     using F by simp
   moreover have "offs_next ?ns' ub xs index key mi ma ?i =
     offs_next ns ub (x # xs) index key mi ma ?i"
     using E and G by (rule_tac offs_next_cons_eq, simp_all add: offs_num_cons)
   hence "ns ! ?i < offs_next ?ns' ub xs index key mi ma ?i"
     by (simp, rule_tac offs_pred_next [OF D G], simp add: offs_num_cons)
   hence "ns ! ?i < offs_next ?ns' ub xs index key mi ma 0"
     using E by simp
   ultimately show "offs_none ?ns' ub xs index key mi ma (ns ! ?i)"
     by (simp add: offs_none_def)
 qed
 
 lemma fill_count_item [rule_format]:
   assumes A: "index_less index key"
   shows
    "(\<forall>x \<in> set xs. key x \<in> {mi..ma}) \<longrightarrow>
     ns \<noteq> [] \<longrightarrow>
     offs_pred ns ub xs index key mi ma \<longrightarrow>
     length xs \<le> ub \<longrightarrow>
       count (mset (map the (fill xs ns index key ub mi ma))) x =
       count (mset xs) x + (if the None = x then ub - length xs else 0)"
 proof (induction xs arbitrary: ns, simp add: replicate_count, (rule impI)+,
  simp add: Let_def map_update del: count_add_mset mset_map split del: if_split,
  (erule conjE)+, subst add_mset_add_single, simp only: count_single count_union)
   fix y xs and ns :: "nat list"
   let ?i = "index key y (length ns) mi ma"
   let ?ns' = "ns[?i := Suc (ns ! ?i)]"
   assume
     B: "\<forall>x \<in> set xs. mi \<le> key x \<and> key x \<le> ma" and
     C: "mi \<le> key y" and
     D: "key y \<le> ma" and
     E: "ns \<noteq> []" and
     F: "offs_pred ns ub (y # xs) index key mi ma" and
     G: "Suc (length xs) \<le> ub"
   have H: "?i < length ns"
     using A and C and D and E by (simp add: index_less_def)
   assume "\<And>ns. ns \<noteq> [] \<longrightarrow> offs_pred ns ub xs index key mi ma \<longrightarrow>
     count (mset (map the (fill xs ns index key ub mi ma))) x =
     count (mset xs) x + (if the None = x then ub - length xs else 0)"
   moreover have "offs_pred ?ns' ub xs index key mi ma"
     using F and H by (rule_tac offs_pred_cons, simp_all)
   ultimately have "count (mset (map the (fill xs ?ns' index key ub mi ma))) x =
     count (mset xs) x + (if the None = x then ub - length xs else 0)"
     using E by simp
   moreover have "ns ! ?i + offs_num (length ns) (y # xs)
     index key mi ma ?i \<le> ub"
     using F and H by (rule offs_pred_ub, simp add: offs_num_cons)
   hence "ns ! ?i < ub"
     by (simp add: offs_num_cons)
   ultimately show "count (mset ((map the (fill xs ?ns' index key ub mi ma))
     [ns ! ?i := y])) x = count (mset xs) x + (if y = x then 1 else 0) +
     (if the None = x then ub - length (y # xs) else 0)"
   proof (subst mset_update, simp add: fill_length, subst add_mset_add_single, simp
    only: count_diff count_single count_union, subst nth_map, simp add: fill_length,
    subst add.assoc, subst (3) add.commute, subst add.assoc [symmetric],
    subst add_right_cancel)
     have "fill xs ?ns' index key ub mi ma ! (ns ! ?i) = None"
       using B and C and D and E by (rule_tac fill_index_none [OF A _ _ F],
        simp_all)
     thus "count (mset xs) x + (if the None = x then ub - length xs else 0) -
       (if the (fill xs ?ns' index key ub mi ma ! (ns ! ?i)) = x then 1 else 0) =
       count (mset xs) x + (if the None = x then ub - length (y # xs) else 0)"
       using G by simp
   qed
 qed
 
 text \<open>
 \null
 
 Finally, lemma @{text offs_enum_pred} here below proves that, if $ns$ is the offsets' list obtained
 by applying the composition of functions @{const offs} and @{const enum} to objects' list $xs$, then
 predicate @{const offs_pred} is satisfied by $ns$ and $xs$.
 
 This result is in turn used, together with lemma @{thm [source] fill_count_item}, to prove lemma
 @{text fill_offs_enum_count_item}, which states that function @{const fill} conserves objects if its
 input offsets' list is computed via the composition of functions @{const offs} and @{const enum}.
 
 \null
 \<close>
 
 lemma enum_offs_num:
  "i < n \<Longrightarrow> enum xs index key n mi ma ! i = offs_num n xs index key mi ma i"
 by (induction xs, simp add: offs_num_def, simp add: Let_def offs_num_cons,
  subst nth_list_update_eq, simp_all add: enum_length)
 
 lemma offs_length:
  "length (offs ns i) = length ns"
 by (induction ns arbitrary: i, simp_all)
 
 lemma offs_add [rule_format]:
  "i < length ns \<longrightarrow> offs ns k ! i = foldl (+) k (take i ns)"
 by (induction ns arbitrary: i k, simp, simp add: nth_Cons split: nat.split)
 
 lemma offs_mono_aux:
  "i \<le> j \<Longrightarrow> j < length ns \<Longrightarrow> offs ns k ! i \<le> offs ns k ! (i + (j - i))"
 by (simp only: offs_add take_add, simp add: add_le)
 
 lemma offs_mono:
  "i \<le> j \<Longrightarrow> j < length ns \<Longrightarrow> offs ns k ! i \<le> offs ns k ! j"
 by (frule offs_mono_aux, simp_all)
 
 lemma offs_update:
  "j < length ns \<Longrightarrow>
     offs (ns[i := Suc (ns ! i)]) k ! j = (if j \<le> i then id else Suc) (offs ns k ! j)"
 by (simp add: offs_add not_le take_update_swap, rule impI, subst nth_take [symmetric],
  assumption, subst add_update, simp_all)
 
 lemma offs_equal_suc:
   assumes
     A: "Suc i < length ns" and
     B: "ns ! i = 0"
   shows "offs ns m ! i = offs ns m ! Suc i"
 proof -
   have "offs ns m ! i = foldl (+) m (take i ns)"
     using A by (subst offs_add, simp_all)
   also have "\<dots> = foldl (+) m (take i ns @ [ns ! i])"
     using B by simp
   also have "\<dots> = foldl (+) m (take (Suc i) ns)"
     using A by (subst take_Suc_conv_app_nth, simp_all)
   also have "\<dots> = offs ns m ! Suc i"
     using A by (subst offs_add, simp_all)
   finally show ?thesis .
 qed
 
 lemma offs_equal [rule_format]:
  "i < j \<Longrightarrow> j < length ns \<Longrightarrow>
     (\<forall>k \<in> {i..<j}. ns ! k = 0) \<longrightarrow> offs ns m ! i = offs ns m ! j"
 proof (erule strict_inc_induct, rule_tac [!] impI, simp_all, erule offs_equal_suc, simp)
   fix i
   assume A: "i < j" and "j < length ns"
   hence "Suc i < length ns" by simp
   moreover assume "\<forall>k \<in> {i..<j}. ns ! k = 0"
   hence "ns ! i = 0"
     using A by simp
   ultimately have "offs ns m ! i = offs ns m ! Suc i"
     by (rule offs_equal_suc)
   also assume "\<dots> = offs ns m ! j"
   finally show "offs ns m ! i = offs ns m ! j" .
 qed
 
 lemma offs_enum_last [rule_format]:
   assumes
     A: "index_less index key" and
     B: "0 < n" and
     C: "\<forall>x \<in> set xs. key x \<in> {mi..ma}"
   shows "offs (enum xs index key n mi ma) k ! (n - Suc 0) +
     offs_num n xs index key mi ma (n - Suc 0) = length xs + k"
 proof -
   let ?ns = "enum xs index key n mi ma"
   from B have D: "last ?ns = offs_num n xs index key mi ma (n - Suc 0)"
     by (subst last_conv_nth, subst length_0_conv [symmetric], simp_all add:
      enum_length, subst enum_offs_num, simp_all)
   have "offs ?ns k ! (n - Suc 0) = foldl (+) k (take (n - Suc 0) ?ns)"
     using B by (rule_tac offs_add, simp add: enum_length)
   also have "\<dots> = foldl (+) k (butlast ?ns)"
     by (simp add: butlast_conv_take enum_length)
   finally have "offs ?ns k ! (n - Suc 0) + offs_num n xs index key mi ma
     (n - Suc 0) = foldl (+) k (butlast ?ns @ [last ?ns])"
     using D by simp
   also have "\<dots> = foldl (+) k ?ns"
     using B by (subst append_butlast_last_id, subst length_0_conv [symmetric],
      simp_all add: enum_length)
   also have "\<dots> = foldl (+) 0 ?ns + k"
     by (rule add_base_zero)
   also have "\<dots> = length xs + k"
     using A and B and C by (subst enum_add, simp_all)
   finally show ?thesis .
 qed
 
 lemma offs_enum_ub [rule_format]:
   assumes
     A: "index_less index key" and
     B: "i < n" and
     C: "\<forall>x \<in> set xs. key x \<in> {mi..ma}"
   shows "offs (enum xs index key n mi ma) k ! i \<le> length xs + k"
 proof -
   let ?ns = "enum xs index key n mi ma"
   have "offs ?ns k ! i \<le> offs ?ns k ! (n - Suc 0)"
     using B by (rule_tac offs_mono, simp_all add: enum_length)
   also have "\<dots> \<le> offs ?ns k ! (n - Suc 0) +
     offs_num n xs index key mi ma (n - Suc 0)"
     by simp
   also have "\<dots> = length xs + k"
     using A and B and C by (rule_tac offs_enum_last, simp_all)
   finally show ?thesis .
 qed
 
 lemma offs_enum_next_ge [rule_format]:
   assumes
     A: "index_less index key" and
     B: "i < n"
   shows "\<forall>x \<in> set xs. key x \<in> {mi..ma} \<Longrightarrow>
     offs (enum xs index key n mi ma) k ! i \<le>
       offs_next (offs (enum xs index key n mi ma) k) (length xs + k)
         xs index key mi ma i"
   (is "_ \<Longrightarrow> offs ?ns _ ! _ \<le> _")
 proof (simp only: offs_next_def split: if_split, rule conjI, rule_tac [!] impI,
  rule offs_enum_ub [OF A B], simp)
   assume "offs_set_next (offs ?ns k) xs index key mi ma i \<noteq> {}"
     (is "?A \<noteq> _")
   hence C: "Min ?A \<in> ?A"
     by (rule_tac Min_in, simp)
   hence "i \<le> Min ?A" by simp
   moreover have "Min ?A < length ?ns"
     using C by (simp add: offs_length)
   ultimately show "offs ?ns k ! i \<le> offs ?ns k ! Min ?A"
     by (rule offs_mono)
 qed
 
 lemma offs_enum_zero_aux [rule_format]:
  "\<lbrakk>index_less index key; 0 < n; \<forall>x \<in> set xs. key x \<in> {mi..ma};
    offs_num n xs index key mi ma (n - Suc 0) = 0\<rbrakk> \<Longrightarrow>
      offs (enum xs index key n mi ma) k ! (n - Suc 0) = length xs + k"
 by (subst offs_enum_last [where key = key and mi = mi and ma = ma,
  symmetric], simp+)
 
 lemma offs_enum_zero [rule_format]:
   assumes
     A: "index_less index key" and
     B: "i < n" and
     C: "\<forall>x \<in> set xs. key x \<in> {mi..ma}" and
     D: "offs_num n xs index key mi ma i = 0"
   shows "offs (enum xs index key n mi ma) k ! i =
     offs_next (offs (enum xs index key n mi ma) k) (length xs + k)
       xs index key mi ma i"
 proof (simp only: offs_next_def split: if_split, rule conjI, rule_tac [!] impI,
  cases "i = n - Suc 0", simp)
   assume "i = n - Suc 0"
   thus "offs (enum xs index key n mi ma) k ! (n - Suc 0) = length xs + k"
     using A and B and C and D by (rule_tac offs_enum_zero_aux, simp_all)
 next
   let ?ns = "enum xs index key n mi ma"
   assume E: "offs_set_next (offs ?ns k) xs index key mi ma i = {}"
     (is "?A = _")
   assume "i \<noteq> n - Suc 0"
   hence F: "i < n - Suc 0"
     using B by simp
   hence "offs ?ns k ! i = offs ?ns k ! (n - Suc 0)"
   proof (rule offs_equal, simp_all add: enum_length le_less,
    erule_tac conjE, erule_tac disjE, rule_tac ccontr, drule_tac [2] sym, simp_all)
     fix j
     assume G: "j < n - Suc 0"
     hence "j < length (offs ?ns k)"
       by (simp add: offs_length enum_length)
     moreover assume "i < j"
     moreover assume "0 < ?ns ! j"
     hence "0 < offs_num (length (offs ?ns k)) xs index key mi ma j"
       using G by (subst (asm) enum_offs_num, simp_all add:
        offs_length enum_length)
     ultimately have "j \<in> ?A" by simp
     thus False
       using E by simp
   next
     show "?ns ! i = 0"
       using B and D by (subst enum_offs_num, simp_all)
   qed
   also from A and B and C have "\<dots> = length xs + k"
   proof (rule_tac offs_enum_zero_aux, simp_all, rule_tac ccontr, simp)
     have "n - Suc 0 < length (offs ?ns k)"
       using B by (simp add: offs_length enum_length)
     moreover assume "0 < offs_num n xs index key mi ma (n - Suc 0)"
     hence "0 < offs_num (length (offs ?ns k)) xs index key mi ma (n - Suc 0)"
       by (simp add: offs_length enum_length)
     ultimately have "n - Suc 0 \<in> ?A"
       using F by simp
     thus False
       using E by simp
   qed
   finally show "offs (enum xs index key n mi ma) k ! i = length xs + k" .
 next
   let ?ns = "enum xs index key n mi ma"
   assume "offs_set_next (offs ?ns k) xs index key mi ma i \<noteq> {}"
     (is "?A \<noteq> _")
   hence "Min ?A \<in> ?A"
     by (rule_tac Min_in, simp)
   thus "offs ?ns k ! i = offs ?ns k ! Min ?A"
   proof (rule_tac offs_equal, simp_all add: le_less, simp add: offs_length,
    (erule_tac conjE)+, erule_tac disjE, rule_tac ccontr, drule_tac [2] sym, simp_all)
     fix j
     assume E: "j < Min ?A" and "Min ?A < length (offs ?ns k)"
     hence F: "j < length (offs ?ns k)" by simp
     moreover assume "i < j"
     moreover assume "0 < ?ns ! j"
     hence "0 < offs_num (length (offs ?ns k)) xs index key mi ma j"
       using F by (subst (asm) enum_offs_num, simp_all add:
        offs_length enum_length)
     ultimately have "j \<in> ?A" by simp
     hence "Min ?A \<le> j"
       by (rule_tac Min_le, simp)
     thus False
       using E by simp
   next
     show "?ns ! i = 0"
       using B and D by (subst enum_offs_num, simp_all)
   qed
 qed
 
 lemma offs_enum_next_cons [rule_format]:
   assumes
     A: "index_less index key" and
     B: "\<forall>x \<in> set xs. key x \<in> {mi..ma}"
   shows "(if i < index key x n mi ma then (\<le>) else (<))
     (offs_next (offs (enum xs index key n mi ma) k)
       (length xs + k) xs index key mi ma i)
     (offs_next (offs ((enum xs index key n mi ma) [index key x n mi ma :=
       Suc (enum xs index key n mi ma ! index key x n mi ma)]) k)
       (Suc (length xs + k)) (x # xs) index key mi ma i)"
   (is "(if i < ?i' then _ else _)
     (offs_next (offs ?ns _) _ _ _ _ _ _ _)
     (offs_next (offs ?ns' _) _ _ _ _ _ _ _)")
 proof (simp_all only: offs_next_def not_less split: if_split, (rule conjI, rule impI)+,
  simp, simp, (rule_tac [!] impI, (rule_tac [!] conjI)?)+, rule_tac [2-3] FalseE,
  rule_tac [4] conjI, rule_tac [4-5] impI)
   assume
     C: "offs_set_next (offs ?ns k) xs index key mi ma i = {}"
       (is "?A = _") and
     D: "offs_set_next (offs ?ns' k) (x # xs) index key mi ma i \<noteq> {}"
       (is "?A' \<noteq> _") and
     E: "i < ?i'"
   from C have F: "\<forall>j \<noteq> ?i'. j \<notin> ?A'"
     by (rule_tac allI, rule_tac impI, rule_tac notI, simp add: enum_length
      offs_length offs_num_cons split: if_split_asm, (erule_tac conjE)+, simp)
   from D have "Min ?A' \<in> ?A'"
     by (rule_tac Min_in, simp)
   hence G: "Min ?A' < n"
     by (simp add: offs_length enum_length)
   have H: "Min ?A' = ?i'"
   proof (rule Min_eqI, simp, rule eq_refl, erule contrapos_pp, insert F, simp)
     have "\<exists>j. j \<in> ?A'"
       using D by blast
     then obtain j where "j \<in> ?A'" ..
     moreover from this have "j = ?i'"
       by (erule_tac contrapos_pp, insert F, simp)
     ultimately show "?i' \<in> ?A'" by simp
   qed
   with G have "offs ?ns' k ! Min ?A' = offs ?ns k ! Min ?A'"
     by (subst offs_update, simp_all add: enum_length)
   also from A and B and G and H have
    "\<dots> = offs_next (offs ?ns k) (length xs + k) xs index key mi ma (Min ?A')"
   proof (rule_tac offs_enum_zero, simp_all, rule_tac ccontr, simp)
     assume "?i' < n" and "0 < offs_num n xs index key mi ma ?i'"
     hence "?i' \<in> ?A"
       using E by (simp add: offs_length enum_length)
     thus False
       using C by simp
   qed
   also have "\<dots> = length xs + k"
   proof (simp only: offs_next_def split: if_split, rule conjI, simp, rule impI,
    rule FalseE, simp, erule exE, (erule conjE)+)
     fix j
     assume "j < length (offs ?ns k)"
     moreover assume "Min ?A' < j"
     hence "i < j"
       using E and H by simp
     moreover assume "0 < offs_num (length (offs ?ns k)) xs index key mi ma j"
     ultimately have "j \<in> ?A" by simp
     thus False
       using C by simp
   qed
   finally show "length xs + k \<le> offs ?ns' k ! Min ?A'" by simp
 next
   assume
     C: "offs_set_next (offs ?ns k) xs index key mi ma i = {}"
       (is "?A = _") and
     D: "offs_set_next (offs ?ns' k) (x # xs) index key mi ma i \<noteq> {}"
       (is "?A' \<noteq> _") and
     E: "?i' \<le> i"
   have "\<exists>j. j \<in> ?A'"
     using D by blast
   then obtain j where F: "j \<in> ?A'" ..
   hence "j < length (offs ?ns k)"
     by (simp add: offs_length)
   moreover have "i < j"
     using F by simp
   moreover from this have
    "0 < offs_num (length (offs ?ns k)) xs index key mi ma j"
     using E and F by (simp add: offs_length enum_length offs_num_cons)
   ultimately have "j \<in> ?A" by simp
   thus False
     using C by simp
 next
   assume
     C: "offs_set_next (offs ?ns k) xs index key mi ma i \<noteq> {}"
       (is "?A \<noteq> _") and
     D: "offs_set_next (offs ?ns' k) (x # xs) index key mi ma i = {}"
       (is "?A' = _")
   have "\<exists>j. j \<in> ?A"
     using C by blast
   then obtain j where E: "j \<in> ?A" ..
   hence "j < length (offs ?ns' k)"
     by (simp add: offs_length)
   moreover have "i < j"
     using E by simp
   moreover have "0 < offs_num (length (offs ?ns' k)) (x # xs) index key mi ma j"
     using E by (simp add: offs_length enum_length offs_num_cons)
   ultimately have "j \<in> ?A'" by simp
   thus False
     using D by simp
 next
   assume "offs_set_next (offs ?ns k) xs index key mi ma i \<noteq> {}"
     (is "?A \<noteq> _")
   hence "Min ?A \<in> ?A"
     by (rule_tac Min_in, simp)
   hence C: "Min ?A < n"
     by (simp add: offs_length enum_length)
   assume "offs_set_next (offs ?ns' k) (x # xs) index key mi ma i \<noteq> {}"
     (is "?A' \<noteq> _")
   hence D: "Min ?A' \<in> ?A'"
     by (rule_tac Min_in, simp)
   hence E: "Min ?A' < n"
     by (simp add: offs_length enum_length)
   have "offs ?ns k ! Min ?A \<le> offs ?ns k ! Min ?A'"
   proof (cases "offs_num n xs index key mi ma (Min ?A') = 0")
     case True
     have "offs ?ns k ! Min ?A' =
       offs_next (offs ?ns k) (length xs + k) xs index key mi ma (Min ?A')"
       using A and B and E and True by (rule_tac offs_enum_zero, simp_all)
     also from A and B and C have "\<dots> \<ge> offs ?ns k ! Min ?A"
     proof (simp only: offs_next_def split: if_split, rule_tac conjI, rule_tac [!] impI,
      rule_tac offs_enum_ub, simp, simp, simp)
       assume "offs_set_next (offs ?ns k) xs index key mi ma (Min ?A') \<noteq> {}"
         (is "?B \<noteq> _")
       hence "Min ?B \<in> ?B"
         by (rule_tac Min_in, simp)
       hence "Min ?B \<in> ?A"
         using D by simp
       moreover from this have "Min ?A \<le> Min ?B"
         by (rule_tac Min_le, simp)
       ultimately show "offs ?ns k ! Min ?A \<le> offs ?ns k ! Min ?B"
         by (rule_tac offs_mono, simp_all add: offs_length)
     qed
     finally show ?thesis .
   next
     case False
     hence "Min ?A' \<in> ?A"
       using D by (simp add: offs_length enum_length)
     hence "Min ?A \<le> Min ?A'"
       by (rule_tac Min_le, simp)
     thus ?thesis
       by (rule offs_mono, simp_all add: enum_length E)
   qed
   also have "\<dots> \<le> offs ?ns' k ! Min ?A'"
     using E by (subst offs_update, simp_all add: enum_length)
   finally show "offs ?ns k ! Min ?A \<le> offs ?ns' k ! Min ?A'" .
 next
   let ?A = "offs_set_next (offs ?ns k) xs index key mi ma i"
   assume "offs_set_next (offs ?ns' k) (x # xs) index key mi ma i \<noteq> {}"
     (is "?A' \<noteq> _")
   hence C: "Min ?A' \<in> ?A'"
     by (rule_tac Min_in, simp)
   hence D: "Min ?A' < n"
     by (simp add: offs_length enum_length)
   assume "?i' \<le> i"
   hence E: "?i' < Min ?A'"
     using C by simp
   hence "0 < offs_num n xs index key mi ma (Min ?A')"
     using C by (simp add: offs_length enum_length offs_num_cons)
   hence "Min ?A' \<in> ?A"
     using C by (simp add: offs_length enum_length)
   hence "Min ?A \<le> Min ?A'"
     by (rule_tac Min_le, simp)
   hence "offs ?ns k ! Min ?A \<le> offs ?ns k ! Min ?A'"
     by (rule offs_mono, simp_all add: enum_length D)
   also have "\<dots> < offs ?ns' k ! Min ?A'"
     using E by (subst offs_update, simp_all add: enum_length D)
   finally show "offs ?ns k ! Min ?A < offs ?ns' k ! Min ?A'" .
 qed
 
 lemma offs_enum_pred [rule_format]:
   assumes A: "index_less index key"
   shows "(\<forall>x \<in> set xs. key x \<in> {mi..ma}) \<longrightarrow>
     offs_pred (offs (enum xs index key n mi ma) k) (length xs + k)
       xs index key mi ma"
 proof (induction xs, simp add: offs_pred_def offs_num_def,
  simp add: Let_def offs_pred_def offs_length enum_length, rule impI, (erule conjE)+,
  simp, rule allI, rule impI, erule allE, drule mp, assumption)
   fix x xs i
   let ?i' = "index key x n mi ma"
   let ?ns = "enum xs index key n mi ma"
   let ?ns' = "?ns[?i' := Suc (?ns ! ?i')]"
   assume
     B: "\<forall>x \<in> set xs. mi \<le> key x \<and> key x \<le> ma" and
     C: "i < n" and
     D: "offs_num n xs index key mi ma i \<le>
       offs_next (offs ?ns k) (length xs + k) xs index key mi ma i - offs ?ns k ! i"
   have E: "(if i < ?i' then (\<le>) else (<))
     (offs_next (offs ?ns k) (length xs + k) xs index key mi ma i)
     (offs_next (offs ?ns' k) (Suc (length xs + k)) (x # xs) index key mi ma i)"
     using A and B by (subst offs_enum_next_cons, simp_all)
   show "offs_num n (x # xs) index key mi ma i \<le>
     offs_next (offs ?ns' k) (Suc (length xs + k)) (x # xs) index key mi ma i -
       offs ?ns' k ! i"
   proof (subst offs_update, simp add: enum_length C, rule linorder_cases [of i ?i'],
    simp_all add: offs_num_cons)
     assume "i < ?i'"
     hence "offs_next (offs ?ns k) (length xs + k) xs index key mi ma i \<le>
       offs_next (offs ?ns' k) (Suc (length xs + k)) (x # xs) index key mi ma i"
       using E by simp
     thus "offs_num n xs index key mi ma i \<le>
       offs_next (offs ?ns' k) (Suc (length xs + k)) (x # xs) index key mi ma i -
         offs ?ns k ! i"
       using D by arith
   next
     assume F: "i = ?i'"
     hence "Suc (offs_num n xs index key mi ma ?i') \<le>
       Suc (offs_next (offs ?ns k) (length xs + k) xs index key mi ma ?i' -
         offs ?ns k ! ?i')"
       using D by simp
     also from A and B and C and F have "\<dots> =
       Suc (offs_next (offs ?ns k) (length xs + k) xs index key mi ma ?i') -
         offs ?ns k ! ?i'"
       by (rule_tac Suc_diff_le [symmetric], rule_tac offs_enum_next_ge, simp_all)
     finally have "Suc (offs_num n xs index key mi ma ?i') \<le>
       Suc (offs_next (offs ?ns k) (length xs + k) xs index key mi ma ?i') -
         offs ?ns k ! ?i'" .
     moreover have
      "Suc (offs_next (offs ?ns k) (length xs + k) xs index key mi ma ?i') \<le>
       offs_next (offs ?ns' k) (Suc (length xs + k)) (x # xs) index key mi ma ?i'"
       using E and F by simp
     ultimately show "Suc (offs_num n xs index key mi ma ?i') \<le>
       offs_next (offs ?ns' k) (Suc (length xs + k)) (x # xs) index key mi ma ?i' -
         offs ?ns k ! ?i'"
       by arith
   next
     assume "?i' < i"
     hence "Suc (offs_next (offs ?ns k) (length xs + k) xs index key mi ma i) \<le>
       offs_next (offs ?ns' k) (Suc (length xs + k)) (x # xs) index key mi ma i"
       using E by simp
     thus "offs_num n xs index key mi ma i \<le>
       offs_next (offs ?ns' k) (Suc (length xs + k)) (x # xs) index key mi ma i -
         Suc (offs ?ns k ! i)"
       using D by arith
   qed
 qed
 
 lemma fill_offs_enum_count_item [rule_format]:
  "\<lbrakk>index_less index key; \<forall>x \<in> set xs. key x \<in> {mi..ma}; 0 < n\<rbrakk> \<Longrightarrow>
     count (mset (map the (fill xs (offs (enum xs index key n mi ma) 0)
       index key (length xs) mi ma))) x =
     count (mset xs) x"
 by (subst fill_count_item, simp_all, simp only: length_greater_0_conv [symmetric]
  offs_length enum_length, insert offs_enum_pred [of index key xs mi ma n 0], simp)
 
 text \<open>
 \null
 
 Using lemma @{thm [source] fill_offs_enum_count_item}, step 9 of the proof method can now be dealt
 with. It is accomplished by proving lemma @{text gcsort_count_inv}, which states that the number of
 the occurrences of whatever object in the objects' list is still the same after any recursive round.
 
 \null
 \<close>
 
 lemma nths_count:
  "count (mset (nths xs A)) x =
     count (mset xs) x - card {i. i < length xs \<and> i \<notin> A \<and> xs ! i = x}"
 proof (induction xs arbitrary: A, simp_all add: nths_Cons)
   fix v xs A
   let ?B = "{i. i < length xs \<and> Suc i \<notin> A \<and> xs ! i = x}"
   let ?C = "\<lambda>v. {i. i < Suc (length xs) \<and> i \<notin> A \<and> (v # xs) ! i = x}"
   have A: "\<And>v. ?C v = ?C v \<inter> {0} \<union> ?C v \<inter> {i. \<exists>j. i = Suc j}"
     by (subst Int_Un_distrib [symmetric], auto, arith)
   have "\<And>v. card (?C v) = card (?C v \<inter> {0}) + card (?C v \<inter> {i. \<exists>j. i = Suc j})"
     by (subst A, rule card_Un_disjoint, simp_all, blast)
   moreover have "\<And>v. card ?B = card (?C v \<inter> {i. \<exists>j. i = Suc j})"
     by (rule bij_betw_same_card [of Suc], auto)
   ultimately show
    "(0 \<in> A \<longrightarrow>
       (v = x \<longrightarrow> Suc (count (mset xs) x - card ?B) =
         Suc (count (mset xs) x) - card (?C x)) \<and>
       (v \<noteq> x \<longrightarrow> count (mset xs) x - card ?B =
         count (mset xs) x - card (?C v))) \<and>
     (0 \<notin> A \<longrightarrow>
       (v = x \<longrightarrow> count (mset xs) x - card ?B =
         Suc (count (mset xs) x) - card (?C x)) \<and>
       (v \<noteq> x \<longrightarrow> count (mset xs) x - card ?B =
         count (mset xs) x - card (?C v)))"
   proof ((rule_tac [!] conjI, rule_tac [!] impI)+, simp_all)
     have "card ?B \<le> count (mset xs) x"
       by (simp add: count_mset length_filter_conv_card, rule card_mono,
        simp, blast)
     thus "Suc (count (mset xs) x - card ?B) = Suc (count (mset xs) x) - card ?B"
       by (rule Suc_diff_le [symmetric])
   qed
 qed
 
 lemma round_count_inv [rule_format]:
  "index_less index key \<longrightarrow> bn_inv p q t \<longrightarrow> add_inv n t \<longrightarrow> count_inv f t \<longrightarrow>
     count_inv f (round index key p q r t)"
 proof (induction index key p q r t arbitrary: n f rule: round.induct,
  (rule_tac [!] impI)+, simp, simp, simp_all only: simp_thms)
   fix index p q r u ns xs n f and key :: "'a \<Rightarrow> 'b"
   let ?t = "round index key p q r (u, ns, tl xs)"
   assume
    "\<And>n f. bn_inv p q (u, ns, tl xs) \<longrightarrow> add_inv n (u, ns, tl xs) \<longrightarrow>
       count_inv f (u, ns, tl xs) \<longrightarrow> count_inv f ?t" and
    "bn_inv p q (u, Suc 0 # ns, xs)" and
    "add_inv n (u, Suc 0 # ns, xs)" and
    "count_inv f (u, Suc 0 # ns, xs)"
   thus "count_inv f (round index key p q r (u, Suc 0 # ns, xs))"
   proof (cases ?t, simp add: add_suc, rule_tac allI, cases xs,
    simp_all add: disj_imp split: if_split_asm)
     fix y ys x and xs' :: "'a list"
     assume "\<And>n f. foldl (+) 0 ns = n \<and> length ys = n \<longrightarrow>
       (\<forall>x. count (mset ys) x = f x) \<longrightarrow> (\<forall>x. count (mset xs') x = f x)"
     moreover assume "Suc (foldl (+) 0 ns) = n" and "Suc (length ys) = n"
     ultimately have "\<And>n f. (\<forall>x. count (mset ys) x = f x) \<longrightarrow>
       (\<forall>x. count (mset xs') x = f x)"
       by blast
     moreover assume A: "\<forall>x. (y = x \<longrightarrow> Suc (count (mset ys) x) = f x) \<and>
       (y \<noteq> x \<longrightarrow> count (mset ys) x = f x)"
     have "\<forall>x. count (mset ys) x = (f(y := f y - Suc 0)) x"
       (is "\<forall>x. _ = ?f' x")
       by (simp add: A, insert spec [OF A, where x = y], simp)
     ultimately have "\<forall>x. count (mset xs') x = ?f' x" ..
     thus "(y = x \<longrightarrow> Suc (count (mset xs') x) = f x) \<and>
       (y \<noteq> x \<longrightarrow> count (mset xs') x = f x)"
       by (simp, insert spec [OF A, where x = y], rule_tac impI, simp)
   qed
 next
   fix index p q r u m ns n f and key :: "'a \<Rightarrow> 'b" and xs :: "'a list"
   let ?ws = "take (Suc (Suc m)) xs"
   let ?ys = "drop (Suc (Suc m)) xs"
   let ?r = "\<lambda>m'. round_suc_suc index key ?ws m m' u"
   let ?t = "\<lambda>r' v. round index key p q r' (v, ns, ?ys)"
   assume A: "index_less index key"
   assume
    "\<And>ws a b c d e g h i n f.
       ws = ?ws \<Longrightarrow> a = bn_comp m p q r \<Longrightarrow> (b, c) = bn_comp m p q r \<Longrightarrow>
       d = ?r b \<Longrightarrow> (e, g) = ?r b \<Longrightarrow> (h, i) = g \<Longrightarrow>
         bn_inv p q (e, ns, ?ys) \<longrightarrow> add_inv n (e, ns, ?ys) \<longrightarrow>
           count_inv f (e, ns, ?ys) \<longrightarrow> count_inv f (?t c e)" and
    "bn_inv p q (u, Suc (Suc m) # ns, xs)" and
    "add_inv n (u, Suc (Suc m) # ns, xs)" and
    "count_inv f (u, Suc (Suc m) # ns, xs)"
   thus "count_inv f (round index key p q r (u, Suc (Suc m) # ns, xs))"
   proof (simp split: prod.split, ((rule_tac allI)+, ((rule_tac impI)+)?)+,
    (erule_tac conjE)+, subst (asm) (2) add_base_zero, simp)
     fix m' r' v ms' ws' xs' x
     assume
       B: "?r m' = (v, ms', ws')" and
       C: "bn_comp m p q r = (m', r')" and
       D: "bn_valid m p q" and
       E: "Suc (Suc (foldl (+) 0 ns + m)) = n" and
       F: "length xs = n"
     assume "\<And>ws a b c d e g h i n' f.
       ws = ?ws \<Longrightarrow> a = (m', r') \<Longrightarrow> b = m' \<and> c = r' \<Longrightarrow>
       d = (v, ms', ws') \<Longrightarrow> e = v \<and> g = (ms', ws') \<Longrightarrow> h = ms' \<and> i = ws' \<Longrightarrow>
         foldl (+) 0 ns = n' \<and> n - Suc (Suc m) = n' \<longrightarrow>
           (\<forall>x. count (mset ?ys) x = f x) \<longrightarrow> (\<forall>x. count (mset xs') x = f x)"
     hence "foldl (+) 0 ns = n - Suc (Suc m) \<longrightarrow>
       (\<forall>x. count (mset xs') x = count (mset ?ys) x)"
       by simp
     hence "count (mset xs') x = count (mset ?ys) x"
       using E by simp
     moreover assume "\<forall>x. count (mset xs) x = f x"
     ultimately have "f x = count (mset ?ws) x + count (mset xs') x"
       by (subst (asm) append_take_drop_id [of "Suc (Suc m)", symmetric],
        subst (asm) mset_append, simp)
     with B [symmetric] show "count (mset ws') x + count (mset xs') x = f x"
     proof (simp add: round_suc_suc_def Let_def del: count_add_mset mset_map
      split: if_split_asm, subst (1 2) add_mset_add_single, simp
      only: count_single count_union)
       let ?nmi = "mini ?ws key"
       let ?nma = "maxi ?ws key"
       let ?xmi = "?ws ! ?nmi"
       let ?xma = "?ws ! ?nma"
       let ?mi = "key ?xmi"
       let ?ma = "key ?xma"
       let ?k = "case m of 0 \<Rightarrow> m | Suc 0 \<Rightarrow> m | Suc (Suc i) \<Rightarrow> u + m'"
       let ?zs = "nths ?ws (- {?nmi, ?nma})"
       let ?ms = "enum ?zs index key ?k ?mi ?ma"
       let ?A = "{i. i < Suc (Suc m) \<and> (i = ?nmi \<or> i = ?nma) \<and> ?ws ! i = x}"
       have G: "length ?ws = Suc (Suc m)"
         using E and F by simp
       hence H: "card ?A \<le> count (mset ?ws) x"
         by (simp add: count_mset length_filter_conv_card, rule_tac card_mono,
          simp, blast)
       show "count (mset (map the (fill ?zs (offs ?ms 0) index key m ?mi ?ma))) x
         + (if ?xma = x then 1 else 0) + (if ?xmi = x then 1 else 0) =
         count (mset ?ws) x"
       proof (cases "m = 0")
         case True
         hence I: "length ?zs = 0"
           using G by (simp add: mini_maxi_nths)
         have "count (mset ?zs) x = count (mset ?ws) x - card ?A"
           using G by (subst nths_count, simp)
         hence J: "count (mset ?ws) x = card ?A"
           using H and I by simp
         from I show ?thesis
         proof (simp, (rule_tac [!] conjI, rule_tac [!] impI)+,
          simp_all (no_asm_simp) add: True)
           assume "?xmi = x" and "?xma = x"
           with G have "?A = {?nmi, ?nma}"
             by (rule_tac set_eqI, rule_tac iffI, simp_all, erule_tac disjE,
              insert mini_less [of ?ws key], insert maxi_less [of ?ws key],
              simp_all)
           with G have "card ?A = Suc (Suc 0)"
             by (simp, subst card_insert_disjoint, simp_all,
              rule_tac mini_maxi_neq, simp)
           thus "Suc (Suc 0) = count (mset (take (Suc (Suc 0)) xs)) x"
             using True and J by simp
         next
           assume "?xmi \<noteq> x" and "?xma = x"
           with G have "?A = {?nma}"
             by (rule_tac set_eqI, rule_tac iffI, simp_all, (erule_tac conjE)+,
              erule_tac disjE, insert maxi_less [of ?ws key], simp_all)
           thus "Suc 0 = count (mset (take (Suc (Suc 0)) xs)) x"
             using True and J by simp
         next
           assume "?xmi = x" and "?xma \<noteq> x"
           with G have "?A = {?nmi}"
             by (rule_tac set_eqI, rule_tac iffI, simp_all, (erule_tac conjE)+,
              erule_tac disjE, insert mini_less [of ?ws key], simp_all)
           thus "Suc 0 = count (mset (take (Suc (Suc 0)) xs)) x"
             using True and J by simp
         next
           assume "?xmi \<noteq> x" and "?xma \<noteq> x"
           hence "?A = {}"
             by (rule_tac set_eqI, rule_tac iffI, simp_all, (erule_tac conjE)+,
              erule_tac disjE, simp_all)
           hence "count (mset ?ws) x = 0"
             using J by simp
           thus "x \<notin> set (take (Suc (Suc 0)) xs)"
             using True by simp
         qed
       next
         case False
         hence "0 < ?k"
           by (simp, drule_tac bn_comp_fst_nonzero [OF D], subst (asm) C,
            simp split: nat.split)
         hence "count (mset (map the (fill ?zs (offs ?ms 0) index key
           (length ?zs) ?mi ?ma))) x = count (mset ?zs) x"
           by (rule_tac fill_offs_enum_count_item [OF A], simp, rule_tac conjI,
            ((rule_tac mini_lb | rule_tac maxi_ub), erule_tac in_set_nthsD)+)
         with G show ?thesis
         proof (simp, (rule_tac [!] conjI, rule_tac [!] impI)+,
          simp_all add: mini_maxi_nths nths_count)
           assume "?xmi = x" and "?xma = x"
           with G have "?A = {?nmi, ?nma}"
             by (rule_tac set_eqI, rule_tac iffI, simp_all, erule_tac disjE,
              insert mini_less [of ?ws key], insert maxi_less [of ?ws key],
              simp_all)
           with G have "card ?A = Suc (Suc 0)"
             by (simp, subst card_insert_disjoint, simp_all,
              rule_tac mini_maxi_neq, simp)
           thus "Suc (Suc (count (mset ?ws) x - card ?A)) = count (mset ?ws) x"
             using H by simp
         next
           assume "?xmi \<noteq> x" and "?xma = x"
           with G have "?A = {?nma}"
             by (rule_tac set_eqI, rule_tac iffI, simp_all, (erule_tac conjE)+,
              erule_tac disjE, insert maxi_less [of ?ws key], simp_all)
           thus "Suc (count (mset ?ws) x - card ?A) = count (mset ?ws) x"
             using H by simp
         next
           assume "?xmi = x" and "?xma \<noteq> x"
           with G have "?A = {?nmi}"
             by (rule_tac set_eqI, rule_tac iffI, simp_all, (erule_tac conjE)+,
              erule_tac disjE, insert mini_less [of ?ws key], simp_all)
           thus "Suc (count (mset ?ws) x - card ?A) = count (mset ?ws) x"
             using H by simp
         next
           assume "?xmi \<noteq> x" and "?xma \<noteq> x"
           hence "?A = {}"
             by (rule_tac set_eqI, rule_tac iffI, simp_all, (erule_tac conjE)+,
              erule_tac disjE, simp_all)
           thus "count (mset ?ws) x - card ?A = count (mset ?ws) x"
             by (simp (no_asm_simp))
         qed
       qed
     qed
   qed
 qed
 
 lemma gcsort_count_inv:
   assumes
     A: "index_less index key" and
     B: "add_inv n t" and
     C: "n \<le> p"
   shows "\<lbrakk>t' \<in> gcsort_set index key p t; count_inv f t\<rbrakk> \<Longrightarrow>
     count_inv f t'"
 by (erule gcsort_set.induct, simp, drule gcsort_add_inv [OF A _ B C],
  rule round_count_inv [OF A], simp_all del: bn_inv.simps, erule conjE,
  frule sym, erule subst, rule bn_inv_intro, insert C, simp)
 
 text \<open>
 \null
 
 The only remaining task is to address step 10 of the proof method, which is done by proving theorem
 @{text gcsort_count}. It holds under the conditions that the objects' number is not larger than the
 counters' upper bound and function @{text index} satisfies predicate @{const index_less}, and states
 that for any object, function @{const gcsort} leaves unchanged the number of its occurrences within
 the input objects' list.
 
 \null
 \<close>
 
 theorem gcsort_count:
   assumes
     A: "index_less index key" and
     B: "length xs \<le> p"
   shows "count (mset (gcsort index key p xs)) x = count (mset xs) x"
 proof -
   let ?t = "(0, [length xs], xs)"
   have "count_inv (count (mset xs)) (gcsort_aux index key p ?t)"
     by (rule gcsort_count_inv [OF A _ B], rule gcsort_add_input,
      rule gcsort_aux_set, rule gcsort_count_input)
   hence "count (mset (gcsort_out (gcsort_aux index key p ?t))) x =
     (count (mset xs)) x"
     by (rule gcsort_count_intro)
   moreover have "?t = gcsort_in xs"
     by (simp add: gcsort_in_def)
   ultimately show ?thesis
     by (simp add: gcsort_def)
 qed
 
 end
diff --git a/thys/Universal_Turing_Machine/UTM.thy b/thys/Universal_Turing_Machine/UTM.thy
--- a/thys/Universal_Turing_Machine/UTM.thy
+++ b/thys/Universal_Turing_Machine/UTM.thy
@@ -1,4708 +1,4708 @@
 (* Title: thys/UTM.thy
    Author: Jian Xu, Xingyuan Zhang, and Christian Urban
    Modifications: Sebastiaan Joosten
 *)
 
 chapter \<open>Construction of a Universal Turing Machine\<close>
 
 theory UTM
   imports Recursive Abacus UF HOL.GCD Turing_Hoare
 begin
 
 section \<open>Wang coding of input arguments\<close>
 
 text \<open>
   The direct compilation of the universal function \<open>rec_F\<close> can
   not give us UTM, because \<open>rec_F\<close> is of arity 2, where the
   first argument represents the Godel coding of the TM being simulated
   and the second argument represents the right number (in Wang's
   coding) of the TM tape.  (Notice, left number is always \<open>0\<close>
   at the very beginning). However, UTM needs to simulate the execution
   of any TM which may very well take many input arguments. Therefore,
   a initialization TM needs to run before the TM compiled from \<open>rec_F\<close>, and the sequential composition of these two TMs will give
   rise to the UTM we are seeking. The purpose of this initialization
   TM is to transform the multiple input arguments of the TM being
   simulated into Wang's coding, so that it can be consumed by the TM
   compiled from \<open>rec_F\<close> as the second argument.
 
   However, this initialization TM (named \<open>t_wcode\<close>) can not be
   constructed by compiling from any recursive function, because every
   recursive function takes a fixed number of input arguments, while
   \<open>t_wcode\<close> needs to take varying number of arguments and
   tranform them into Wang's coding. Therefore, this section give a
   direct construction of \<open>t_wcode\<close> with just some parts being
   obtained from recursive functions.
 
 \newlength{\basewidth}
 \settowidth{\basewidth}{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx}
 \newlength{\baseheight}
 \settoheight{\baseheight}{$B:R$}
 \newcommand{\vsep}{5\baseheight}
 
 The TM used to generate the Wang's code of input arguments is divided into three TMs
  executed sequentially, namely $prepare$, $mainwork$ and $adjust$.
  According to the
  convention, the start state of ever TM is fixed to state $1$ while the final state is
  fixed to $0$.
 
 The input and output of $prepare$ are illustrated respectively by Figure
 \ref{prepare_input} and \ref{prepare_output}.
 
 
 \begin{figure}[h!]
 \centering
 \scalebox{1.2}{
 \begin{tikzpicture}
   [tbox/.style = {draw, thick, inner sep = 5pt}]
   \node (0) {};
   \node (1) [tbox, text height = 3.5pt, right = -0.9pt of 0] {$m$};
   \node (2) [tbox, right = -0.9pt of 1] {$0$};
   \node (3) [tbox, right = -0.9pt of 2] {$a_1$};
   \node (4) [tbox, right = -0.9pt of 3] {$0$};
   \node (5) [tbox, right = -0.9pt of 4] {$a_2$};
   \node (6) [right = -0.9pt of 5] {\ldots \ldots};
   \node (7) [tbox, right = -0.9pt of 6] {$a_n$};
   \draw [->, >=latex, thick] (1)+(0, -4\baseheight) -- (1);
 \end{tikzpicture}}
 \caption{The input of TM $prepare$} \label{prepare_input}
 \end{figure}
 
 \begin{figure}[h!]
 \centering
 \scalebox{1.2}{
 \begin{tikzpicture}
   \node (0) {};
   \node (1) [draw, text height = 3.5pt, right = -0.9pt of 0, thick, inner sep = 5pt] {$m$};
   \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {$0$};
   \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {$0$};
   \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {$a_1$};
   \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {$0$};
   \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {$a_2$};
   \node (7) [right = -0.9pt of 6] {\ldots \ldots};
   \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {$a_n$};
   \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {$0$};
   \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {$0$};
   \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {$1$};
   \draw [->, >=latex, thick] (10)+(0, -4\baseheight) -- (10);
 \end{tikzpicture}}
 \caption{The output of TM $prepare$} \label{prepare_output}
 \end{figure}
 
 As shown in Figure \ref{prepare_input}, the input of $prepare$ is the
 same as the the input of UTM, where $m$ is the Godel coding of the TM
 being interpreted and $a_1$ through $a_n$ are the $n$ input arguments
 of the TM under interpretation. The purpose of $purpose$ is to
 transform this initial tape layout to the one shown in Figure
 \ref{prepare_output}, which is convenient for the generation of Wang's
 codding of $a_1, \ldots, a_n$. The coding procedure starts from $a_n$
 and ends after $a_1$ is encoded. The coding result is stored in an
 accumulator at the end of the tape (initially represented by the $1$
 two blanks right to $a_n$ in Figure \ref{prepare_output}). In Figure
 \ref{prepare_output}, arguments $a_1, \ldots, a_n$ are separated by
 two blanks on both ends with the rest so that movement conditions can
 be implemented conveniently in subsequent TMs, because, by convention,
 two consecutive blanks are usually used to signal the end or start of
 a large chunk of data. The diagram of $prepare$ is given in Figure
 \ref{prepare_diag}.
 
 
 \begin{figure}[h!]
 \centering
 \scalebox{0.9}{
 \begin{tikzpicture}
      \node[circle,draw] (1) {$1$};
      \node[circle,draw] (2) at ($(1)+(0.3\basewidth, 0)$) {$2$};
      \node[circle,draw] (3) at ($(2)+(0.3\basewidth, 0)$) {$3$};
      \node[circle,draw] (4) at ($(3)+(0.3\basewidth, 0)$) {$4$};
      \node[circle,draw] (5) at ($(4)+(0.3\basewidth, 0)$) {$5$};
      \node[circle,draw] (6) at ($(5)+(0.3\basewidth, 0)$) {$6$};
      \node[circle,draw] (7) at ($(6)+(0.3\basewidth, 0)$) {$7$};
      \node[circle,draw] (8) at ($(7)+(0.3\basewidth, 0)$) {$0$};
 
 
      \draw [->, >=latex] (1) edge [loop above] node[above] {$S_1:L$} (1)
      ;
      \draw [->, >=latex] (1) -- node[above] {$S_0:S_1$} (2)
      ;
      \draw [->, >=latex] (2) edge [loop above] node[above] {$S_1:R$} (2)
      ;
      \draw [->, >=latex] (2) -- node[above] {$S_0:L$} (3)
      ;
      \draw [->, >=latex] (3) edge[loop above] node[above] {$S_1:S_0$} (3)
      ;
      \draw [->, >=latex] (3) -- node[above] {$S_0:R$} (4)
      ;
      \draw [->, >=latex] (4) edge[loop above] node[above] {$S_0:R$} (4)
      ;
      \draw [->, >=latex] (4) -- node[above] {$S_0:R$} (5)
      ;
      \draw [->, >=latex] (5) edge[loop above] node[above] {$S_1:R$} (5)
      ;
      \draw [->, >=latex] (5) -- node[above] {$S_0:R$} (6)
      ;
      \draw [->, >=latex] (6) edge[bend left = 50] node[below] {$S_1:R$} (5)
      ;
      \draw [->, >=latex] (6) -- node[above] {$S_0:R$} (7)
      ;
      \draw [->, >=latex] (7) edge[loop above] node[above] {$S_0:S_1$} (7)
      ;
      \draw [->, >=latex] (7) -- node[above] {$S_1:L$} (8)
      ;
  \end{tikzpicture}}
 \caption{The diagram of TM $prepare$} \label{prepare_diag}
 \end{figure}
 
 The purpose of TM $mainwork$ is to compute the Wang's encoding of $a_1, \ldots, a_n$. Every bit of $a_1, \ldots, a_n$, including the separating bits, is processed from left to right.
 In order to detect the termination condition when the left most bit of $a_1$ is reached,
 TM $mainwork$ needs to look ahead and consider three different situations at the start of
 every iteration:
 \begin{enumerate}
     \item The TM configuration for the first situation is shown in Figure \ref{mainwork_case_one_input},
         where the accumulator is stored in $r$, both of the next two bits
         to be encoded are $1$. The configuration at the end of the iteration
         is shown in Figure \ref{mainwork_case_one_output}, where the first 1-bit has been
         encoded and cleared. Notice that the accumulator has been changed to
         $(r+1) \times 2$ to reflect the encoded bit.
     \item The TM configuration for the second situation is shown in Figure
         \ref{mainwork_case_two_input},
         where the accumulator is stored in $r$, the next two bits
         to be encoded are $1$ and $0$. After the first
         $1$-bit was encoded and cleared, the second $0$-bit is difficult to detect
         and process. To solve this problem, these two consecutive bits are
         encoded in one iteration.  In this situation, only the first $1$-bit needs
         to be cleared since the second one is cleared by definition.
         The configuration at the end of the iteration
         is shown in Figure \ref{mainwork_case_two_output}.
         Notice that the accumulator has been changed to
         $(r+1) \times 4$ to reflect the two encoded bits.
     \item The third situation corresponds to the case when the last bit of $a_1$ is reached.
         The TM configurations at the start and end of the iteration are shown in
         Figure \ref{mainwork_case_three_input} and \ref{mainwork_case_three_output}
         respectively. For this situation, only the read write head needs to be moved to
         the left to prepare a initial configuration for TM $adjust$ to start with.
 \end{enumerate}
 The diagram of $mainwork$ is given in Figure \ref{mainwork_diag}. The two rectangular nodes
 labeled with $2 \times x$ and $4 \times x$ are two TMs compiling from recursive functions
 so that we do not have to design and verify two quite complicated TMs.
 
 
 \begin{figure}[h!]
 \centering
 \scalebox{1.2}{
 \begin{tikzpicture}
   \node (0) {};
   \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {$m$};
   \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {$0$};
   \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {$0$};
   \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {$a_1$};
   \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {$0$};
   \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {$a_2$};
   \node (7) [right = -0.9pt of 6] {\ldots \ldots};
   \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {$a_i$};
   \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {$1$};
   \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {$1$};
   \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {$0$};
   \node (12) [right = -0.9pt of 11] {\ldots \ldots};
   \node (13) [draw, right = -0.9pt of 12, thick, inner sep = 5pt] {$0$};
   \node (14) [draw, text height = 3.9pt, right = -0.9pt of 13, thick, inner sep = 5pt] {$r$};
   \draw [->, >=latex, thick] (13)+(0, -4\baseheight) -- (13);
 \end{tikzpicture}}
 \caption{The first situation for TM $mainwork$ to consider} \label{mainwork_case_one_input}
 \end{figure}
 
 
 \begin{figure}[h!]
 \centering
 \scalebox{1.2}{
 \begin{tikzpicture}
   \node (0) {};
   \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {$m$};
   \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {$0$};
   \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {$0$};
   \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {$a_1$};
   \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {$0$};
   \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {$a_2$};
   \node (7) [right = -0.9pt of 6] {\ldots \ldots};
   \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {$a_i$};
   \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {$1$};
   \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {$0$};
   \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {$0$};
   \node (12) [right = -0.9pt of 11] {\ldots \ldots};
   \node (13) [draw, right = -0.9pt of 12, thick, inner sep = 5pt] {$0$};
   \node (14) [draw, text height = 2.7pt, right = -0.9pt of 13, thick, inner sep = 5pt] {$(r+1) \times 2$};
   \draw [->, >=latex, thick] (13)+(0, -4\baseheight) -- (13);
 \end{tikzpicture}}
 \caption{The output for the first case of TM $mainwork$'s processing}
 \label{mainwork_case_one_output}
 \end{figure}
 
 \begin{figure}[h!]
 \centering
 \scalebox{1.2}{
 \begin{tikzpicture}
   \node (0) {};
   \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {$m$};
   \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {$0$};
   \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {$0$};
   \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {$a_1$};
   \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {$0$};
   \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {$a_2$};
   \node (7) [right = -0.9pt of 6] {\ldots \ldots};
   \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {$a_i$};
   \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {$1$};
   \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {$0$};
   \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {$1$};
   \node (12) [draw, right = -0.9pt of 11, thick, inner sep = 5pt] {$0$};
   \node (13) [right = -0.9pt of 12] {\ldots \ldots};
   \node (14) [draw, right = -0.9pt of 13, thick, inner sep = 5pt] {$0$};
   \node (15) [draw, text height = 3.9pt, right = -0.9pt of 14, thick, inner sep = 5pt] {$r$};
   \draw [->, >=latex, thick] (14)+(0, -4\baseheight) -- (14);
 \end{tikzpicture}}
 \caption{The second situation for TM $mainwork$ to consider} \label{mainwork_case_two_input}
 \end{figure}
 
 \begin{figure}[h!]
 \centering
 \scalebox{1.2}{
 \begin{tikzpicture}
   \node (0) {};
   \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {$m$};
   \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {$0$};
   \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {$0$};
   \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {$a_1$};
   \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {$0$};
   \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {$a_2$};
   \node (7) [right = -0.9pt of 6] {\ldots \ldots};
   \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {$a_i$};
   \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {$1$};
   \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {$0$};
   \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {$0$};
   \node (12) [draw, right = -0.9pt of 11, thick, inner sep = 5pt] {$0$};
   \node (13) [right = -0.9pt of 12] {\ldots \ldots};
   \node (14) [draw, right = -0.9pt of 13, thick, inner sep = 5pt] {$0$};
   \node (15) [draw, text height = 2.7pt, right = -0.9pt of 14, thick, inner sep = 5pt] {$(r+1) \times 4$};
   \draw [->, >=latex, thick] (14)+(0, -4\baseheight) -- (14);
 \end{tikzpicture}}
 \caption{The output for the second case of TM $mainwork$'s processing}
 \label{mainwork_case_two_output}
 \end{figure}
 
 \begin{figure}[h!]
 \centering
 \scalebox{1.2}{
 \begin{tikzpicture}
   \node (0) {};
   \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {$m$};
   \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {$0$};
   \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {$0$};
   \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {$1$};
   \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {$0$};
   \node (6) [right = -0.9pt of 5] {\ldots \ldots};
   \node (7) [draw, right = -0.9pt of 6, thick, inner sep = 5pt] {$0$};
   \node (8) [draw, text height = 3.9pt, right = -0.9pt of 7, thick, inner sep = 5pt] {$r$};
   \draw [->, >=latex, thick] (7)+(0, -4\baseheight) -- (7);
 \end{tikzpicture}}
 \caption{The third situation for TM $mainwork$ to consider} \label{mainwork_case_three_input}
 \end{figure}
 
 \begin{figure}[h!]
 \centering
 \scalebox{1.2}{
 \begin{tikzpicture}
   \node (0) {};
   \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {$m$};
   \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {$0$};
   \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {$0$};
   \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {$1$};
   \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {$0$};
   \node (6) [right = -0.9pt of 5] {\ldots \ldots};
   \node (7) [draw, right = -0.9pt of 6, thick, inner sep = 5pt] {$0$};
   \node (8) [draw, text height = 3.9pt, right = -0.9pt of 7, thick, inner sep = 5pt] {$r$};
   \draw [->, >=latex, thick] (3)+(0, -4\baseheight) -- (3);
 \end{tikzpicture}}
 \caption{The output for the third case of TM $mainwork$'s processing}
 \label{mainwork_case_three_output}
 \end{figure}
 
 \begin{figure}[h!]
 \centering
 \scalebox{0.9}{
 \begin{tikzpicture}
      \node[circle,draw] (1) {$1$};
      \node[circle,draw] (2) at ($(1)+(0.3\basewidth, 0)$) {$2$};
      \node[circle,draw] (3) at ($(2)+(0.3\basewidth, 0)$) {$3$};
      \node[circle,draw] (4) at ($(3)+(0.3\basewidth, 0)$) {$4$};
      \node[circle,draw] (5) at ($(4)+(0.3\basewidth, 0)$) {$5$};
      \node[circle,draw] (6) at ($(5)+(0.3\basewidth, 0)$) {$6$};
      \node[circle,draw] (7) at ($(2)+(0, -7\baseheight)$) {$7$};
      \node[circle,draw] (8) at ($(7)+(0, -7\baseheight)$) {$8$};
      \node[circle,draw] (9) at ($(8)+(0.3\basewidth, 0)$) {$9$};
      \node[circle,draw] (10) at ($(9)+(0.3\basewidth, 0)$) {$10$};
      \node[circle,draw] (11) at ($(10)+(0.3\basewidth, 0)$) {$11$};
      \node[circle,draw] (12) at ($(11)+(0.3\basewidth, 0)$) {$12$};
      \node[draw] (13) at ($(6)+(0.3\basewidth, 0)$) {$2 \times x$};
      \node[circle,draw] (14) at ($(13)+(0.3\basewidth, 0)$) {$j_1$};
      \node[draw] (15) at ($(12)+(0.3\basewidth, 0)$) {$4 \times x$};
      \node[draw] (16) at ($(15)+(0.3\basewidth, 0)$) {$j_2$};
      \node[draw] (17) at ($(7)+(0.3\basewidth, 0)$) {$0$};
 
      \draw [->, >=latex] (1) edge[loop left] node[above] {$S_0:L$} (1)
      ;
      \draw [->, >=latex] (1) -- node[above] {$S_1:L$} (2)
      ;
      \draw [->, >=latex] (2) -- node[above] {$S_1:R$} (3)
      ;
      \draw [->, >=latex] (2) -- node[left] {$S_1:L$} (7)
      ;
      \draw [->, >=latex] (3) edge[loop above] node[above] {$S_1:S_0$} (3)
      ;
      \draw [->, >=latex] (3) -- node[above] {$S_0:R$} (4)
      ;
      \draw [->, >=latex] (4) edge[loop above] node[above] {$S_0:R$} (4)
      ;
      \draw [->, >=latex] (4) -- node[above] {$S_1:R$} (5)
      ;
      \draw [->, >=latex] (5) edge[loop above] node[above] {$S_1:R$} (5)
      ;
      \draw [->, >=latex] (5) -- node[above] {$S_0:S_1$} (6)
      ;
      \draw [->, >=latex] (6) edge[loop above] node[above] {$S_1:L$} (6)
      ;
      \draw [->, >=latex] (6) -- node[above] {$S_0:R$} (13)
      ;
      \draw [->, >=latex] (13) -- (14)
      ;
      \draw (14) -- ($(14)+(0, 6\baseheight)$) -- ($(1) + (0, 6\baseheight)$) node [above,midway] {$S_1:L$}
      ;
      \draw [->, >=latex] ($(1) + (0, 6\baseheight)$) -- (1)
      ;
      \draw [->, >=latex] (7) -- node[above] {$S_0:R$} (17)
      ;
      \draw [->, >=latex] (7) -- node[left] {$S_1:R$} (8)
      ;
      \draw [->, >=latex] (8) -- node[above] {$S_0:R$} (9)
      ;
      \draw [->, >=latex] (9) -- node[above] {$S_0:R$} (10)
      ;
      \draw [->, >=latex] (10) -- node[above] {$S_1:R$} (11)
      ;
      \draw [->, >=latex] (10) edge[loop above] node[above] {$S_0:R$} (10)
      ;
      \draw [->, >=latex] (11) edge[loop above] node[above] {$S_1:R$} (11)
      ;
      \draw [->, >=latex] (11) -- node[above] {$S_0:S_1$} (12)
      ;
      \draw [->, >=latex] (12) -- node[above] {$S_0:R$} (15)
      ;
      \draw [->, >=latex] (12) edge[loop above] node[above] {$S_1:L$} (12)
      ;
      \draw [->, >=latex] (15) -- (16)
      ;
      \draw (16) -- ($(16)+(0, -4\baseheight)$) -- ($(1) + (0, -18\baseheight)$) node [below,midway] {$S_1:L$}
      ;
      \draw [->, >=latex] ($(1) + (0, -18\baseheight)$) -- (1)
      ;
  \end{tikzpicture}}
 \caption{The diagram of TM $mainwork$} \label{mainwork_diag}
 \end{figure}
 
 The purpose of TM $adjust$ is to encode the last bit of $a_1$. The initial and final configuration
 of this TM are shown in Figure \ref{adjust_initial} and \ref{adjust_final} respectively.
 The diagram of TM $adjust$ is shown in Figure \ref{adjust_diag}.
 
 
 \begin{figure}[h!]
 \centering
 \scalebox{1.2}{
 \begin{tikzpicture}
   \node (0) {};
   \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {$m$};
   \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {$0$};
   \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {$0$};
   \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {$1$};
   \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {$0$};
   \node (6) [right = -0.9pt of 5] {\ldots \ldots};
   \node (7) [draw, right = -0.9pt of 6, thick, inner sep = 5pt] {$0$};
   \node (8) [draw, text height = 3.9pt, right = -0.9pt of 7, thick, inner sep = 5pt] {$r$};
   \draw [->, >=latex, thick] (3)+(0, -4\baseheight) -- (3);
 \end{tikzpicture}}
 \caption{Initial configuration of TM $adjust$} \label{adjust_initial}
 \end{figure}
 
 \begin{figure}[h!]
 \centering
 \scalebox{1.2}{
 \begin{tikzpicture}
   \node (0) {};
   \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {$m$};
   \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {$0$};
   \node (3) [draw, text height = 2.9pt, right = -0.9pt of 2, thick, inner sep = 5pt] {$r+1$};
   \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {$0$};
   \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {$0$};
   \node (6) [right = -0.9pt of 5] {\ldots \ldots};
   \draw [->, >=latex, thick] (1)+(0, -4\baseheight) -- (1);
 \end{tikzpicture}}
 \caption{Final configuration of TM $adjust$} \label{adjust_final}
 \end{figure}
 
 
 \begin{figure}[h!]
 \centering
 \scalebox{0.9}{
 \begin{tikzpicture}
      \node[circle,draw] (1) {$1$};
      \node[circle,draw] (2) at ($(1)+(0.3\basewidth, 0)$) {$2$};
      \node[circle,draw] (3) at ($(2)+(0.3\basewidth, 0)$) {$3$};
      \node[circle,draw] (4) at ($(3)+(0.3\basewidth, 0)$) {$4$};
      \node[circle,draw] (5) at ($(4)+(0.3\basewidth, 0)$) {$5$};
      \node[circle,draw] (6) at ($(5)+(0.3\basewidth, 0)$) {$6$};
      \node[circle,draw] (7) at ($(6)+(0.3\basewidth, 0)$) {$7$};
      \node[circle,draw] (8) at ($(4)+(0, -7\baseheight)$) {$8$};
      \node[circle,draw] (9) at ($(8)+(0.3\basewidth, 0)$) {$9$};
      \node[circle,draw] (10) at ($(9)+(0.3\basewidth, 0)$) {$10$};
      \node[circle,draw] (11) at ($(10)+(0.3\basewidth, 0)$) {$11$};
      \node[circle,draw] (12) at ($(11)+(0.3\basewidth, 0)$) {$0$};
 
 
      \draw [->, >=latex] (1) -- node[above] {$S_1:R$} (2)
      ;
      \draw [->, >=latex] (1) edge[loop above] node[above] {$S_0:S_1$} (1)
      ;
      \draw [->, >=latex] (2) -- node[above] {$S_1:R$} (3)
      ;
      \draw [->, >=latex] (3) edge[loop above] node[above] {$S_0:R$} (3)
      ;
      \draw [->, >=latex] (3) -- node[above] {$S_1:R$} (4)
      ;
      \draw [->, >=latex] (4) -- node[above] {$S_1:L$} (5)
      ;
      \draw [->, >=latex] (4) -- node[right] {$S_0:L$} (8)
      ;
      \draw [->, >=latex] (5) -- node[above] {$S_0:L$} (6)
      ;
      \draw [->, >=latex] (5) edge[loop above] node[above] {$S_1:S_0$} (5)
      ;
      \draw [->, >=latex] (6) -- node[above] {$S_1:R$} (7)
      ;
      \draw [->, >=latex] (6) edge[loop above] node[above] {$S_0:L$} (6)
      ;
      \draw (7) -- ($(7)+(0, 6\baseheight)$) -- ($(2) + (0, 6\baseheight)$) node [above,midway] {$S_0:S_1$}
      ;
      \draw [->, >=latex] ($(2) + (0, 6\baseheight)$) -- (2)
      ;
      \draw [->, >=latex] (8) edge[loop left] node[left] {$S_1:S_0$} (8)
      ;
      \draw [->, >=latex] (8) -- node[above] {$S_0:L$} (9)
      ;
      \draw [->, >=latex] (9) edge[loop above] node[above] {$S_0:L$} (9)
      ;
      \draw [->, >=latex] (9) -- node[above] {$S_1:L$} (10)
      ;
      \draw [->, >=latex] (10) edge[loop above] node[above] {$S_0:L$} (10)
      ;
      \draw [->, >=latex] (10) -- node[above] {$S_0:L$} (11)
      ;
      \draw [->, >=latex] (11) edge[loop above] node[above] {$S_1:L$} (11)
      ;
      \draw [->, >=latex] (11) -- node[above] {$S_0:R$} (12)
      ;
  \end{tikzpicture}}
 \caption{Diagram of TM $adjust$} \label{adjust_diag}
 \end{figure}
 \<close>
 
 
 definition rec_twice :: "recf"
   where
     "rec_twice = Cn 1 rec_mult [id 1 0, constn 2]"
 
 definition rec_fourtimes  :: "recf"
   where
     "rec_fourtimes = Cn 1 rec_mult [id 1 0, constn 4]"
 
 definition abc_twice :: "abc_prog"
   where
     "abc_twice = (let (aprog, ary, fp) = rec_ci rec_twice in 
                        aprog [+] dummy_abc ((Suc 0)))"
 
 definition abc_fourtimes :: "abc_prog"
   where
     "abc_fourtimes = (let (aprog, ary, fp) = rec_ci rec_fourtimes in 
                        aprog [+] dummy_abc ((Suc 0)))"
 
 definition twice_ly :: "nat list"
   where
     "twice_ly = layout_of abc_twice"
 
 definition fourtimes_ly :: "nat list"
   where
     "fourtimes_ly = layout_of abc_fourtimes"
 
 definition t_twice_compile :: "instr list"
   where
     "t_twice_compile= (tm_of abc_twice @ (shift (mopup 1) (length (tm_of abc_twice) div 2)))"
 
 definition t_twice :: "instr list"
   where
     "t_twice = adjust0 t_twice_compile"
 
 definition t_fourtimes_compile :: "instr list"
   where
     "t_fourtimes_compile= (tm_of abc_fourtimes @ (shift (mopup 1) (length (tm_of abc_fourtimes) div 2)))"
 
 definition t_fourtimes :: "instr list"
   where
     "t_fourtimes = adjust0 t_fourtimes_compile"
 
 definition t_twice_len :: "nat"
   where
     "t_twice_len = length t_twice div 2"
 
 definition t_wcode_main_first_part:: "instr list"
   where
     "t_wcode_main_first_part \<equiv> 
                    [(L, 1), (L, 2), (L, 7), (R, 3),
                     (R, 4), (W0, 3), (R, 4), (R, 5),
                     (W1, 6), (R, 5), (R, 13), (L, 6),
                     (R, 0), (R, 8), (R, 9), (Nop, 8),
                     (R, 10), (W0, 9), (R, 10), (R, 11), 
                     (W1, 12), (R, 11), (R, t_twice_len + 14), (L, 12)]"
 
 definition t_wcode_main :: "instr list"
   where
     "t_wcode_main = (t_wcode_main_first_part @ shift t_twice 12 @ [(L, 1), (L, 1)]
                     @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])"
 
 fun bl_bin :: "cell list \<Rightarrow> nat"
   where
     "bl_bin [] = 0" 
   | "bl_bin (Bk # xs) = 2 * bl_bin xs"
   | "bl_bin (Oc # xs) = Suc (2 * bl_bin xs)"
 
 declare bl_bin.simps[simp del]
 
 type_synonym bin_inv_t = "cell list \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
 
 fun wcode_before_double :: "bin_inv_t"
   where
     "wcode_before_double ires rs (l, r) =
      (\<exists> ln rn. l = Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and> 
                r = Oc\<up>((Suc (Suc rs))) @ Bk\<up>(rn ))"
 
 declare wcode_before_double.simps[simp del]
 
 fun wcode_after_double :: "bin_inv_t"
   where
     "wcode_after_double ires rs (l, r) = 
      (\<exists> ln rn. l = Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
          r = Oc\<up>(Suc (Suc (Suc 2*rs))) @ Bk\<up>(rn))"
 
 declare wcode_after_double.simps[simp del]
 
 fun wcode_on_left_moving_1_B :: "bin_inv_t"
   where
     "wcode_on_left_moving_1_B ires rs (l, r) = 
      (\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # Oc # ires \<and> 
                r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and>
                ml + mr > Suc 0 \<and> mr > 0)"
 
 declare wcode_on_left_moving_1_B.simps[simp del]
 
 fun wcode_on_left_moving_1_O :: "bin_inv_t"
   where
     "wcode_on_left_moving_1_O ires rs (l, r) = 
      (\<exists> ln rn.
                l = Oc # ires \<and> 
                r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 declare wcode_on_left_moving_1_O.simps[simp del]
 
 fun wcode_on_left_moving_1 :: "bin_inv_t"
   where
     "wcode_on_left_moving_1 ires rs (l, r) = 
           (wcode_on_left_moving_1_B ires rs (l, r) \<or> wcode_on_left_moving_1_O ires rs (l, r))"
 
 declare wcode_on_left_moving_1.simps[simp del]
 
 fun wcode_on_checking_1 :: "bin_inv_t"
   where
     "wcode_on_checking_1 ires rs (l, r) = 
     (\<exists> ln rn. l = ires \<and>
               r = Oc # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wcode_erase1 :: "bin_inv_t"
   where
     "wcode_erase1 ires rs (l, r) = 
        (\<exists> ln rn. l = Oc # ires \<and> 
                  tl r = Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 declare wcode_erase1.simps [simp del]
 
 fun wcode_on_right_moving_1 :: "bin_inv_t"
   where
     "wcode_on_right_moving_1 ires rs (l, r) = 
        (\<exists> ml mr rn.        
              l = Bk\<up>(ml) @ Oc # ires \<and> 
              r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and>
              ml + mr > Suc 0)"
 
 declare wcode_on_right_moving_1.simps [simp del] 
 
 declare wcode_on_right_moving_1.simps[simp del]
 
 fun wcode_goon_right_moving_1 :: "bin_inv_t"
   where
     "wcode_goon_right_moving_1 ires rs (l, r) = 
       (\<exists> ml mr ln rn. 
             l = Oc\<up>(ml) @ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and> 
             r = Oc\<up>(mr) @ Bk\<up>(rn) \<and>
             ml + mr = Suc rs)"
 
 declare wcode_goon_right_moving_1.simps[simp del]
 
 fun wcode_backto_standard_pos_B :: "bin_inv_t"
   where
     "wcode_backto_standard_pos_B ires rs (l, r) = 
           (\<exists> ln rn. l =  Bk # Bk\<up>(ln) @ Oc # ires \<and> 
                r =  Bk # Oc\<up>((Suc (Suc rs))) @ Bk\<up>(rn ))"
 
 declare wcode_backto_standard_pos_B.simps[simp del]
 
 fun wcode_backto_standard_pos_O :: "bin_inv_t"
   where
     "wcode_backto_standard_pos_O ires rs (l, r) = 
         (\<exists> ml mr ln rn. 
             l = Oc\<up>(ml) @ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
             r = Oc\<up>(mr) @ Bk\<up>(rn) \<and>
             ml + mr = Suc (Suc rs) \<and> mr > 0)"
 
 declare wcode_backto_standard_pos_O.simps[simp del]
 
 fun wcode_backto_standard_pos :: "bin_inv_t"
   where
     "wcode_backto_standard_pos ires rs (l, r) = (wcode_backto_standard_pos_B ires rs (l, r) \<or>
                                             wcode_backto_standard_pos_O ires rs (l, r))"
 
 declare wcode_backto_standard_pos.simps[simp del]
 
 lemma bin_wc_eq: "bl_bin xs = bl2wc xs"
 proof(induct xs)
   show " bl_bin [] = bl2wc []" 
     apply(simp add: bl_bin.simps)
     done
 next
   fix a xs
   assume "bl_bin xs = bl2wc xs"
   thus " bl_bin (a # xs) = bl2wc (a # xs)"
     apply(case_tac a, simp_all add: bl_bin.simps bl2wc.simps)
      apply(simp_all add: bl2nat.simps bl2nat_double)
     done
 qed
 
 lemma tape_of_nl_append_one: "lm \<noteq> [] \<Longrightarrow>  <lm @ [a]> = <lm> @ Bk # Oc\<up>Suc a"
   apply(induct lm, auto simp: tape_of_nl_cons split:if_splits)
   done
 
 lemma tape_of_nl_rev: "rev (<lm::nat list>) = (<rev lm>)"
   apply(induct lm, simp, auto)
   apply(auto simp: tape_of_nl_cons tape_of_nl_append_one split: if_splits)
   apply(simp add: exp_ind[THEN sym])
   done
 
 lemma exp_1[simp]: "a\<up>(Suc 0) = [a]" 
   by(simp)
 
 lemma tape_of_nl_cons_app1: "(<a # xs @ [b]>) = (Oc\<up>(Suc a) @ Bk # (<xs@ [b]>))"
   apply(case_tac xs; simp add: tape_of_list_def tape_of_nat_list.simps tape_of_nat_def)
   done
 
 lemma bl_bin_bk_oc[simp]:
   "bl_bin (xs @ [Bk, Oc]) = 
   bl_bin xs + 2*2^(length xs)"
   apply(simp add: bin_wc_eq)
   using bl2nat_cons_oc[of "xs @ [Bk]"]
   apply(simp add: bl2nat_cons_bk bl2wc.simps)
   done
 
 lemma tape_of_nat[simp]: "(<a::nat>) = Oc\<up>(Suc a)"
   apply(simp add: tape_of_nat_def)
   done
 
 lemma tape_of_nl_cons_app2: "(<c # xs @ [b]>) = (<c # xs> @ Bk # Oc\<up>(Suc b))"
 proof(induct "length xs" arbitrary: xs c, simp add: tape_of_list_def)
   fix x xs c
   assume ind: "\<And>xs c. x = length xs \<Longrightarrow> <c # xs @ [b]> = 
     <c # xs> @ Bk # Oc\<up>(Suc b)"
     and h: "Suc x = length (xs::nat list)" 
   show "<c # xs @ [b]> = <c # xs> @ Bk # Oc\<up>(Suc b)"
   proof(cases xs, simp add: tape_of_list_def)
     fix a list
     assume g: "xs = a # list"
     hence k: "<a # list @ [b]> =  <a # list> @ Bk # Oc\<up>(Suc b)"
       apply(rule_tac ind)
       using h
       apply(simp)
       done
     from g and k show "<c # xs @ [b]> = <c # xs> @ Bk # Oc\<up>(Suc b)"
       apply(simp add: tape_of_list_def)
       done
   qed
 qed
 
 lemma length_2_elems[simp]: "length (<aa # a # list>) = Suc (Suc aa) + length (<a # list>)"
   apply(simp add: tape_of_list_def)
   done
 
 lemma bl_bin_addition[simp]: "bl_bin (Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista) @ [Bk, Oc]) =
               bl_bin (Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista)) + 
               2* 2^(length (Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista)))"
   using bl_bin_bk_oc[of "Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista)"]
   apply(simp)
   done
 
 declare replicate_Suc[simp del]
 
 lemma bl_bin_2[simp]: 
   "bl_bin (<aa # list>) + (4 * rs + 4) * 2 ^ (length (<aa # list>) - Suc 0)
   = bl_bin (Oc\<up>(Suc aa) @ Bk # <list @ [0]>) + rs * (2 * 2 ^ (aa + length (<list @ [0]>)))"
   apply(case_tac "list", simp add: add_mult_distrib)
   apply(simp add: tape_of_nl_cons_app2 add_mult_distrib)
   apply(simp add: tape_of_list_def)
   done
 
 lemma tape_of_nl_app_Suc: "((<list @ [Suc ab]>)) = (<list @ [ab]>) @ [Oc]"
 proof(induct list)
   case (Cons a list)
   then show ?case by(cases list;simp_all add:tape_of_list_def exp_ind)
 qed (simp add: tape_of_list_def exp_ind)
 
 lemma bl_bin_3[simp]: "bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]> @ [Oc])
               = bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>) +
               2^(length (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>))"
   apply(simp add: bin_wc_eq)
   apply(simp add: bl2nat_cons_oc bl2wc.simps)
   using bl2nat_cons_oc[of "Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>"]
   apply(simp)
   done
 lemma bl_bin_4[simp]: "bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>) + (4 * 2 ^ (aa + length (<list @ [ab]>)) +
          4 * (rs * 2 ^ (aa + length (<list @ [ab]>)))) =
        bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [Suc ab]>) +
          rs * (2 * 2 ^ (aa + length (<list @ [Suc ab]>)))"
   apply(simp add: tape_of_nl_app_Suc)
   done
 
 declare tape_of_nat[simp del]
 
 fun wcode_double_case_inv :: "nat \<Rightarrow> bin_inv_t"
   where
     "wcode_double_case_inv st ires rs (l, r) = 
           (if st = Suc 0 then wcode_on_left_moving_1 ires rs (l, r)
           else if st = Suc (Suc 0) then wcode_on_checking_1 ires rs (l, r)
           else if st = 3 then wcode_erase1 ires rs (l, r)
           else if st = 4 then wcode_on_right_moving_1 ires rs (l, r)
           else if st = 5 then wcode_goon_right_moving_1 ires rs (l, r)
           else if st = 6 then wcode_backto_standard_pos ires rs (l, r)
           else if st = 13 then wcode_before_double ires rs (l, r)
           else False)"
 
 declare wcode_double_case_inv.simps[simp del]
 
 fun wcode_double_case_state :: "config \<Rightarrow> nat"
   where
     "wcode_double_case_state (st, l, r) = 
    13 - st"
 
 fun wcode_double_case_step :: "config \<Rightarrow> nat"
   where
     "wcode_double_case_step (st, l, r) = 
       (if st = Suc 0 then (length l)
       else if st = Suc (Suc 0) then (length r)
       else if st = 3 then 
                  if hd r = Oc then 1 else 0
       else if st = 4 then (length r)
       else if st = 5 then (length r)
       else if st = 6 then (length l)
       else 0)"
 
 fun wcode_double_case_measure :: "config \<Rightarrow> nat \<times> nat"
   where
     "wcode_double_case_measure (st, l, r) = 
      (wcode_double_case_state (st, l, r), 
       wcode_double_case_step (st, l, r))"
 
 definition wcode_double_case_le :: "(config \<times> config) set"
   where "wcode_double_case_le \<equiv> (inv_image lex_pair wcode_double_case_measure)"
 
 lemma wf_lex_pair[intro]: "wf lex_pair"
   by(auto intro:wf_lex_prod simp:lex_pair_def)
 
 lemma wf_wcode_double_case_le[intro]: "wf wcode_double_case_le"
   by(auto intro:wf_inv_image simp: wcode_double_case_le_def )
 
 lemma fetch_t_wcode_main[simp]:
   "fetch t_wcode_main (Suc 0) Bk = (L, Suc 0)"
   "fetch t_wcode_main (Suc 0) Oc = (L, Suc (Suc 0))"
   "fetch t_wcode_main (Suc (Suc 0)) Oc = (R, 3)"
   "fetch t_wcode_main (Suc (Suc 0)) Bk = (L, 7)"
   "fetch t_wcode_main (Suc (Suc (Suc 0))) Bk = (R, 4)"
   "fetch t_wcode_main (Suc (Suc (Suc 0))) Oc = (W0, 3)"
   "fetch t_wcode_main 4 Bk = (R, 4)"
   "fetch t_wcode_main 4 Oc = (R, 5)"
   "fetch t_wcode_main 5 Oc = (R, 5)"
   "fetch t_wcode_main 5 Bk = (W1, 6)"
   "fetch t_wcode_main 6 Bk = (R, 13)"
   "fetch t_wcode_main 6 Oc = (L, 6)"
   "fetch t_wcode_main 7 Oc = (R, 8)"
   "fetch t_wcode_main 7 Bk = (R, 0)"
   "fetch t_wcode_main 8 Bk = (R, 9)"
   "fetch t_wcode_main 9 Bk = (R, 10)"
   "fetch t_wcode_main 9 Oc = (W0, 9)"
   "fetch t_wcode_main 10 Bk = (R, 10)"
   "fetch t_wcode_main 10 Oc = (R, 11)"
   "fetch t_wcode_main 11 Bk = (W1, 12)"
   "fetch t_wcode_main 11 Oc = (R, 11)"
   "fetch t_wcode_main 12 Oc = (L, 12)"
   "fetch t_wcode_main 12 Bk = (R, t_twice_len + 14)"
   by(auto simp: t_wcode_main_def t_wcode_main_first_part_def fetch.simps numeral)
 
 declare wcode_on_checking_1.simps[simp del]
 
 lemmas wcode_double_case_inv_simps = 
   wcode_on_left_moving_1.simps wcode_on_left_moving_1_O.simps
   wcode_on_left_moving_1_B.simps wcode_on_checking_1.simps
   wcode_erase1.simps wcode_on_right_moving_1.simps
   wcode_goon_right_moving_1.simps wcode_backto_standard_pos.simps
 
 
 lemma wcode_on_left_moving_1[simp]:
   "wcode_on_left_moving_1 ires rs (b, []) = False"
   "wcode_on_left_moving_1 ires rs (b, r) \<Longrightarrow> b \<noteq> []"
   by(auto simp: wcode_on_left_moving_1.simps wcode_on_left_moving_1_B.simps
       wcode_on_left_moving_1_O.simps)
 
 lemma wcode_on_left_moving_1E[elim]: "\<lbrakk>wcode_on_left_moving_1 ires rs (b, Bk # list);
                 tl b = aa \<and> hd b # Bk # list = ba\<rbrakk> \<Longrightarrow> 
                wcode_on_left_moving_1 ires rs (aa, ba)"
   apply(simp only: wcode_on_left_moving_1.simps wcode_on_left_moving_1_O.simps
       wcode_on_left_moving_1_B.simps)
   apply(erule_tac disjE)
    apply(erule_tac exE)+
    apply(rename_tac ml mr rn)
    apply(case_tac ml, simp)
     apply(rule_tac x = "mr - Suc (Suc 0)" in exI, rule_tac x = rn in exI)
     apply (smt One_nat_def Suc_diff_Suc append_Cons empty_replicate list.sel(3) neq0_conv replicate_Suc replicate_app_Cons_same tl_append2 tl_replicate)
    apply(rule_tac disjI1)
    apply (metis add_Suc_shift less_SucI list.exhaust_sel list.inject list.simps(3) replicate_Suc_iff_anywhere)
   by simp
 
 declare replicate_Suc[simp]
 
 lemma wcode_on_moving_1_Elim[elim]: 
   "\<lbrakk>wcode_on_left_moving_1 ires rs (b, Oc # list); tl b = aa \<and> hd b # Oc # list = ba\<rbrakk> 
     \<Longrightarrow> wcode_on_checking_1 ires rs (aa, ba)"
   apply(simp only: wcode_double_case_inv_simps)
   apply(erule_tac disjE)
    apply (metis cell.distinct(1) empty_replicate hd_append2 hd_replicate list.sel(1) not_gr_zero)
   apply force.
 
 lemma wcode_on_checking_1_Elim[elim]: "\<lbrakk>wcode_on_checking_1 ires rs (b, Oc # ba);Oc # b = aa \<and> list = ba\<rbrakk>
   \<Longrightarrow> wcode_erase1 ires rs (aa, ba)"
   apply(simp only: wcode_double_case_inv_simps)
   apply(erule_tac exE)+ by auto
 
 lemma wcode_on_checking_1_simp[simp]:
   "wcode_on_checking_1 ires rs (b, []) = False" 
   "wcode_on_checking_1 ires rs (b, Bk # list) = False"
   by(auto simp: wcode_double_case_inv_simps)
 
 lemma wcode_erase1_nonempty_snd[simp]: "wcode_erase1 ires rs (b, []) = False"
   apply(simp add: wcode_double_case_inv_simps)
   done
 
 lemma wcode_on_right_moving_1_nonempty_snd[simp]: "wcode_on_right_moving_1 ires rs (b, []) = False"
   apply(simp add: wcode_double_case_inv_simps)
   done
 
 lemma wcode_on_right_moving_1_BkE[elim]:
   "\<lbrakk>wcode_on_right_moving_1 ires rs (b, Bk # ba);  Bk # b = aa \<and> list = b\<rbrakk> \<Longrightarrow> 
   wcode_on_right_moving_1 ires rs (aa, ba)"
   apply(simp only: wcode_double_case_inv_simps)
   apply(erule_tac exE)+
   apply(rename_tac ml mr rn)
   apply(rule_tac x = "Suc ml" in exI, rule_tac x = "mr - Suc 0" in exI,
       rule_tac x = rn in exI)
   apply(simp)
   apply(case_tac mr, simp, simp)
   done
 
 lemma wcode_on_right_moving_1_OcE[elim]: 
   "\<lbrakk>wcode_on_right_moving_1 ires rs (b, Oc # ba); Oc # b = aa \<and> list = ba\<rbrakk> 
   \<Longrightarrow> wcode_goon_right_moving_1 ires rs (aa, ba)"
   apply(simp only: wcode_double_case_inv_simps)
   apply(erule_tac exE)+
   apply(rename_tac ml mr rn)
   apply(rule_tac x = "Suc 0" in exI, rule_tac x = "rs" in exI,
       rule_tac x = "ml - Suc (Suc 0)" in exI, rule_tac x = rn in exI)
   apply(case_tac mr, simp_all)
   apply(case_tac ml, simp, case_tac nat, simp, simp)
   done
 
 lemma wcode_erase1_BkE[elim]:
   assumes "wcode_erase1 ires rs (b, Bk # ba)" "Bk # b = aa \<and> list = ba" "c = Bk # ba"
   shows "wcode_on_right_moving_1 ires rs (aa, ba)"
 proof -
   from assms obtain rn ln where "b = Oc # ires"
     "tl (Bk # ba) = Bk \<up> ln @ Bk # Bk # Oc \<up> Suc rs @ Bk \<up> rn"
     unfolding wcode_double_case_inv_simps by auto
   thus ?thesis using assms(2-) unfolding wcode_double_case_inv_simps
     apply(rule_tac x = "Suc 0" in exI, rule_tac x = "Suc (Suc ln)" in exI, 
         rule_tac x = rn in exI, simp add: exp_ind del: replicate_Suc)
     done
 qed
 
 lemma wcode_erase1_OcE[elim]: "\<lbrakk>wcode_erase1 ires rs (aa, Oc # list);  b = aa \<and> Bk # list = ba\<rbrakk> \<Longrightarrow> 
   wcode_erase1 ires rs (aa, ba)"
   unfolding wcode_double_case_inv_simps
   by auto auto
 
 lemma wcode_goon_right_moving_1_emptyE[elim]:
   assumes "wcode_goon_right_moving_1 ires rs (aa, [])" "b = aa \<and> [Oc] = ba"
   shows "wcode_backto_standard_pos ires rs (aa, ba)"
 proof -
   from assms obtain ml ln rn mr where "aa = Oc \<up> ml @ Bk # Bk # Bk \<up> ln @ Oc # ires"
     "[] = Oc \<up> mr @ Bk \<up> rn" "ml + mr = Suc rs"
     by(auto simp:wcode_double_case_inv_simps)
   thus ?thesis using assms(2)
     apply(simp only: wcode_double_case_inv_simps)
     apply(rule_tac disjI2)
     apply(simp only:wcode_backto_standard_pos_O.simps)
     apply(rule_tac x = ml in exI, rule_tac x = "Suc 0" in exI, rule_tac x = ln in exI,
         rule_tac x = rn in exI, simp)
     done
 qed
 
 lemma wcode_goon_right_moving_1_BkE[elim]: 
   assumes "wcode_goon_right_moving_1 ires rs (aa, Bk # list)" "b = aa \<and> Oc # list = ba"
   shows "wcode_backto_standard_pos ires rs (aa, ba)"
 proof -
   from assms obtain ln rn where "aa = Oc \<up> Suc rs @ Bk \<up> Suc (Suc ln) @ Oc # ires"
     "Bk # list = Bk \<up> rn" "b = Oc \<up> Suc rs @ Bk \<up> Suc (Suc ln) @ Oc # ires" "ba = Oc # list"
     by(auto simp:wcode_double_case_inv_simps)
   thus ?thesis using assms(2)
     apply(simp only: wcode_double_case_inv_simps wcode_backto_standard_pos_O.simps)
     apply(rule_tac disjI2)
     apply(rule exI[of _ "Suc rs"], rule exI[of _ "Suc 0"], rule_tac x = ln in exI,
         rule_tac x = "rn - Suc 0" in exI, simp)
     apply(cases rn;auto)
     done
 qed
 
 lemma wcode_goon_right_moving_1_OcE[elim]: 
   assumes "wcode_goon_right_moving_1 ires rs (b, Oc # ba)" "Oc # b = aa \<and> list = ba"
   shows "wcode_goon_right_moving_1 ires rs (aa, ba)"
 proof -
   from assms obtain ml mr ln rn where
     "b = Oc \<up> ml @ Bk # Bk # Bk \<up> ln @ Oc # ires \<and>
        Oc # ba = Oc \<up> mr @ Bk \<up> rn \<and> ml + mr = Suc rs"
     unfolding wcode_double_case_inv_simps by auto
   with assms(2) show ?thesis unfolding wcode_double_case_inv_simps
     apply(rule_tac x = "Suc ml" in exI, rule_tac x = "mr - Suc 0" in exI, 
         rule_tac x = ln in exI, rule_tac x = rn in exI)
     apply(simp)
     apply(case_tac mr, simp, case_tac rn, simp_all)
     done
 qed
 
 
 lemma wcode_backto_standard_pos_BkE[elim]: "\<lbrakk>wcode_backto_standard_pos ires rs (b, Bk # ba); Bk # b = aa \<and> list = ba\<rbrakk> 
   \<Longrightarrow> wcode_before_double ires rs (aa, ba)"
   apply(simp only: wcode_double_case_inv_simps wcode_backto_standard_pos_B.simps
       wcode_backto_standard_pos_O.simps wcode_before_double.simps)
   apply(erule_tac disjE)
    apply(erule_tac exE)+ 
   by auto
 
 lemma wcode_backto_standard_pos_no_Oc[simp]: "wcode_backto_standard_pos ires rs ([], Oc # list) = False"
   apply(auto simp: wcode_backto_standard_pos.simps wcode_backto_standard_pos_B.simps
       wcode_backto_standard_pos_O.simps)
   done
 
 lemma wcode_backto_standard_pos_nonempty_snd[simp]: "wcode_backto_standard_pos ires rs (b, []) = False"
   apply(auto simp: wcode_backto_standard_pos.simps wcode_backto_standard_pos_B.simps
       wcode_backto_standard_pos_O.simps)
   done
 
 lemma wcode_backto_standard_pos_OcE[elim]: "\<lbrakk>wcode_backto_standard_pos ires rs (b, Oc # list); tl b = aa; hd b # Oc # list =  ba\<rbrakk>
        \<Longrightarrow> wcode_backto_standard_pos ires rs (aa, ba)"
   apply(simp only:  wcode_backto_standard_pos.simps wcode_backto_standard_pos_B.simps
       wcode_backto_standard_pos_O.simps)
   apply(erule_tac disjE)
    apply(simp)
   apply(erule_tac exE)+ 
   apply(simp)
   apply (rename_tac ml mr ln rn)
   apply(case_tac ml)
    apply(rule_tac disjI1, rule_tac conjI)
     apply(rule_tac x = ln  in exI, force, rule_tac x = rn in exI, force, force).
 
 declare nth_of.simps[simp del] fetch.simps[simp del]
 lemma wcode_double_case_first_correctness:
   "let P = (\<lambda> (st, l, r). st = 13) in 
        let Q = (\<lambda> (st, l, r). wcode_double_case_inv st ires rs (l, r)) in 
        let f = (\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp) in
        \<exists> n .P (f n) \<and> Q (f (n::nat))"
 proof -
   let ?P = "(\<lambda> (st, l, r). st = 13)"
   let ?Q = "(\<lambda> (st, l, r). wcode_double_case_inv st ires rs (l, r))"
   let ?f = "(\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp)"
   have "\<exists> n. ?P (?f n) \<and> ?Q (?f (n::nat))"
   proof(rule_tac halt_lemma2)
     show "wf wcode_double_case_le"
       by auto
   next
     show "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow>
                    ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_double_case_le"
     proof(rule_tac allI, case_tac "?f na", simp)
       fix na a b c
       show "a \<noteq> 13 \<and> wcode_double_case_inv a ires rs (b, c) \<longrightarrow>
                (case step0 (a, b, c) t_wcode_main of (st, x) \<Rightarrow> 
                    wcode_double_case_inv st ires rs x) \<and> 
                 (step0 (a, b, c) t_wcode_main, a, b, c) \<in> wcode_double_case_le"
         apply(rule_tac impI, simp add: wcode_double_case_inv.simps)
         apply(auto split: if_splits simp: step.simps, 
             case_tac [!] c, simp_all, case_tac [!] "(c::cell list)!0")
                             apply(simp_all add: wcode_double_case_inv.simps wcode_double_case_le_def
             lex_pair_def)
                       apply(auto split: if_splits)
         done
     qed
   next
     show "?Q (?f 0)"
       apply(simp add: steps.simps wcode_double_case_inv.simps 
           wcode_on_left_moving_1.simps
           wcode_on_left_moving_1_B.simps)
       apply(rule_tac disjI1)
       apply(rule_tac x = "Suc m" in exI, simp)
       apply(rule_tac x = "Suc 0" in exI, simp)
       done
   next
     show "\<not> ?P (?f 0)"
       apply(simp add: steps.simps)
       done
   qed
   thus "let P = \<lambda>(st, l, r). st = 13;
     Q = \<lambda>(st, l, r). wcode_double_case_inv st ires rs (l, r);
     f = steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main
     in \<exists>n. P (f n) \<and> Q (f n)"
     apply(simp)
     done
 qed
 
 lemma tm_append_shift_append_steps: 
   "\<lbrakk>steps0 (st, l, r) tp stp = (st', l', r'); 
   0 < st';
   length tp1 mod 2 = 0
   \<rbrakk>
   \<Longrightarrow> steps0 (st + length tp1 div 2, l, r) (tp1 @ shift tp (length tp1 div 2) @ tp2) stp 
   = (st' + length tp1 div 2, l', r')"
 proof -
   assume h: 
     "steps0 (st, l, r) tp stp = (st', l', r')"
     "0 < st'"
     "length tp1 mod 2 = 0 "
   from h have 
     "steps (st + length tp1 div 2, l, r) (tp1 @ shift tp (length tp1 div 2), 0) stp = 
                             (st' + length tp1 div 2, l', r')"
     by(rule_tac tm_append_second_steps_eq, simp_all)
   then have "steps (st + length tp1 div 2, l, r) ((tp1 @ shift tp (length tp1 div 2)) @ tp2, 0) stp = 
                             (st' + length tp1 div 2, l', r')"
     using h
     apply(rule_tac tm_append_first_steps_eq, simp_all)
     done
   thus "?thesis"
     by simp
 qed 
 
 declare start_of.simps[simp del]
 
 lemma twice_lemma: "rec_exec rec_twice [rs] = 2*rs"
   by(auto simp: rec_twice_def rec_exec.simps)
 
 lemma t_twice_correct: 
   "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
   (tm_of abc_twice @ shift (mopup (Suc 0)) ((length (tm_of abc_twice) div 2))) stp =
   (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
 proof(case_tac "rec_ci rec_twice")
   fix a b c
   assume h: "rec_ci rec_twice = (a, b, c)"
   have "\<exists>stp m l. steps0 (Suc 0, Bk # Bk # ires, <[rs]> @ Bk\<up>(n)) (tm_of abc_twice @ shift (mopup (length [rs])) 
     (length (tm_of abc_twice) div 2)) stp = (0, Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (rec_exec rec_twice [rs])) @ Bk\<up>(l))"
     thm  recursive_compile_to_tm_correct1
   proof(rule_tac recursive_compile_to_tm_correct1)
     show "rec_ci rec_twice = (a, b, c)" by (simp add: h)
   next
     show "terminate rec_twice [rs]"
       apply(rule_tac primerec_terminate, auto)
       apply(simp add: rec_twice_def, auto simp: constn.simps numeral_2_eq_2)
       by(auto)
   next
     show "tm_of abc_twice = tm_of (a [+] dummy_abc (length [rs]))"
       using h
       by(simp add: abc_twice_def)
   qed
   thus "?thesis"
     apply(simp add: tape_of_list_def tape_of_nat_def rec_exec.simps twice_lemma)
     done
 qed
 
 declare adjust.simps[simp]
 
 lemma adjust_fetch0: 
   "\<lbrakk>0 < a; a \<le> length ap div 2;  fetch ap a b = (aa, 0)\<rbrakk>
   \<Longrightarrow> fetch (adjust0 ap) a b = (aa, Suc (length ap div 2))"
   apply(case_tac b, auto simp: fetch.simps nth_of.simps nth_map
       split: if_splits)
    apply(case_tac [!] a, auto simp: fetch.simps nth_of.simps)
   done
 
 lemma adjust_fetch_norm: 
   "\<lbrakk>st > 0;  st \<le> length tp div 2; fetch ap st b = (aa, ns); ns \<noteq> 0\<rbrakk>
  \<Longrightarrow>  fetch (adjust0 ap) st b = (aa, ns)"
   apply(case_tac b, auto simp: fetch.simps nth_of.simps nth_map
       split: if_splits)
    apply(case_tac [!] st, auto simp: fetch.simps nth_of.simps)
   done
 
 declare adjust.simps[simp del]
 
 lemma adjust_step_eq: 
   assumes exec: "step0 (st,l,r) ap = (st', l', r')"
     and wf_tm: "tm_wf (ap, 0)"
     and notfinal: "st' > 0"
   shows "step0 (st, l, r) (adjust0 ap) = (st', l', r')"
   using assms
 proof -
   have "st > 0"
     using assms
     by(case_tac st, simp_all add: step.simps fetch.simps)
   moreover hence "st \<le> (length ap) div 2"
     using assms
     apply(case_tac "st \<le> (length ap) div 2", simp)
     apply(case_tac st, auto simp: step.simps fetch.simps)
     apply(case_tac "read r", simp_all add: fetch.simps 
         nth_of.simps adjust.simps tm_wf.simps split: if_splits)
      apply(auto simp: mod_ex2)
     done    
   ultimately have "fetch (adjust0 ap) st (read r) = fetch ap st (read r)"
     using assms
     apply(case_tac "fetch ap st (read r)")
     apply(drule_tac adjust_fetch_norm, simp_all)
     apply(simp add: step.simps)
     done
   thus "?thesis"
     using exec
     by(simp add: step.simps)
 qed
 
 declare adjust.simps[simp del]
 
 lemma adjust_steps_eq: 
   assumes exec: "steps0 (st,l,r) ap stp = (st', l', r')"
     and wf_tm: "tm_wf (ap, 0)"
     and notfinal: "st' > 0"
   shows "steps0 (st, l, r) (adjust0 ap) stp = (st', l', r')"
   using exec notfinal
 proof(induct stp arbitrary: st' l' r')
   case 0
   thus "?case"
     by(simp add: steps.simps)
 next
   case (Suc stp st' l' r')
   have ind: "\<And>st' l' r'. \<lbrakk>steps0 (st, l, r) ap stp = (st', l', r'); 0 < st'\<rbrakk> 
     \<Longrightarrow> steps0 (st, l, r) (adjust0 ap) stp = (st', l', r')" by fact
   have h: "steps0 (st, l, r) ap (Suc stp) = (st', l', r')" by fact
   have g:   "0 < st'" by fact
   obtain st'' l'' r'' where a: "steps0 (st, l, r) ap stp = (st'', l'', r'')"
     by (metis prod_cases3)
   hence c:"0 < st''"
     using h g
     apply(simp add: step_red)
     apply(case_tac st'', auto)
     done
   hence b: "steps0 (st, l, r) (adjust0 ap) stp = (st'', l'', r'')"
     using a
     by(rule_tac ind, simp_all)
   thus "?case"
     using assms a b h g
     apply(simp add: step_red) 
     apply(rule_tac adjust_step_eq, simp_all)
     done
 qed 
 
 lemma adjust_halt_eq:
   assumes exec: "steps0 (1, l, r) ap stp = (0, l', r')"
     and tm_wf: "tm_wf (ap, 0)" 
   shows "\<exists> stp. steps0 (Suc 0, l, r) (adjust0 ap) stp = 
         (Suc (length ap div 2), l', r')"
 proof -
   have "\<exists> stp. \<not> is_final (steps0 (1, l, r) ap stp) \<and> (steps0 (1, l, r) ap (Suc stp) = (0, l', r'))"
     using exec
     by(erule_tac before_final)
   then obtain stpa where a: 
     "\<not> is_final (steps0 (1, l, r) ap stpa) \<and> (steps0 (1, l, r) ap (Suc stpa) = (0, l', r'))" ..
   obtain sa la ra where b:"steps0 (1, l, r) ap stpa = (sa, la, ra)"  by (metis prod_cases3)
   hence c: "steps0 (Suc 0, l, r) (adjust0 ap) stpa = (sa, la, ra)"
     using assms a
     apply(rule_tac adjust_steps_eq, simp_all)
     done
   have d: "sa \<le> length ap div 2"
     using steps_in_range[of  "(l, r)" ap stpa] a tm_wf b
     by(simp)
   obtain ac ns where e: "fetch ap sa (read ra) = (ac, ns)"
     by (metis prod.exhaust)
   hence f: "ns = 0"
     using b a
     apply(simp add: step_red step.simps)
     done
   have k: "fetch (adjust0 ap) sa (read ra) = (ac, Suc (length ap div 2))"
     using a b c d e f
     apply(rule_tac adjust_fetch0, simp_all)
     done
   from a b e f k and c show "?thesis"
     apply(rule_tac x = "Suc stpa" in exI)
     apply(simp add: step_red, auto)
     apply(simp add: step.simps)
     done
 qed    
 
 declare tm_wf.simps[simp del]
 
 lemma tm_wf_t_twice_compile [simp]: "tm_wf (t_twice_compile, 0)"
   apply(simp only: t_twice_compile_def)
   apply(rule_tac wf_tm_from_abacus, simp)
   done
 
 lemma t_twice_change_term_state:
   "\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_twice stp
      = (Suc t_twice_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
 proof -
   have "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
     (tm_of abc_twice @ shift (mopup (Suc 0)) ((length (tm_of abc_twice) div 2))) stp =
     (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
     by(rule_tac t_twice_correct)
   then obtain stp ln rn where " steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
     (tm_of abc_twice @ shift (mopup (Suc 0)) ((length (tm_of abc_twice) div 2))) stp =
     (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))" by blast
   hence "\<exists> stp. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
     (adjust0 t_twice_compile) stp
      = (Suc (length t_twice_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
     apply(rule_tac stp = stp in adjust_halt_eq)
      apply(simp add: t_twice_compile_def, auto)
     done
   then obtain stpb where 
     "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
     (adjust0 t_twice_compile) stpb
      = (Suc (length t_twice_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))" ..
   thus "?thesis"
     apply(simp add: t_twice_def t_twice_len_def)
     by metis
 qed
 
 lemma length_t_wcode_main_first_part_even[intro]: "length t_wcode_main_first_part mod 2 = 0"
   apply(auto simp: t_wcode_main_first_part_def)
   done
 
 lemma t_twice_append_pre:
   "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_twice stp
   = (Suc t_twice_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))
    \<Longrightarrow> steps0 (Suc 0 + length t_wcode_main_first_part div 2, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
      (t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
       ([(L, 1), (L, 1)] @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])) stp 
     = (Suc (t_twice_len) + length t_wcode_main_first_part div 2, 
              Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
   by(rule_tac tm_append_shift_append_steps, auto)
 
 lemma t_twice_append:
   "\<exists> stp ln rn. steps0 (Suc 0 + length t_wcode_main_first_part div 2, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
      (t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
       ([(L, 1), (L, 1)] @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])) stp 
     = (Suc (t_twice_len) + length t_wcode_main_first_part div 2, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
   using t_twice_change_term_state[of ires rs n]
   apply(erule_tac exE)
   apply(erule_tac exE)
   apply(erule_tac exE)
   apply(drule_tac t_twice_append_pre)
   apply(rename_tac stp ln rn)
   apply(rule_tac x = stp in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
   apply(simp)
   done
 
 lemma mopup_mod2: "length (mopup k) mod 2  = 0"
   by(auto simp: mopup.simps)
 
 lemma fetch_t_wcode_main_Oc[simp]: "fetch t_wcode_main (Suc (t_twice_len + length t_wcode_main_first_part div 2)) Oc
      = (L, Suc 0)"
   apply(subgoal_tac "length (t_twice) mod 2 = 0")
    apply(simp add: t_wcode_main_def nth_append fetch.simps t_wcode_main_first_part_def 
       nth_of.simps t_twice_len_def, auto)
   apply(simp add: t_twice_def t_twice_compile_def)
   using mopup_mod2[of 1]
   apply(simp)
   done
 
 lemma wcode_jump1: 
   "\<exists> stp ln rn. steps0 (Suc (t_twice_len) + length t_wcode_main_first_part div 2,
                        Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(n))
      t_wcode_main stp 
     = (Suc 0, Bk\<up>(ln) @ Bk # ires, Bk # Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
   apply(rule_tac x = "Suc 0" in exI, rule_tac x = "m" in exI, rule_tac x = n in exI)
   apply(simp add: steps.simps step.simps exp_ind)
   apply(case_tac m, simp_all)
   apply(simp add: exp_ind[THEN sym])
   done
 
 lemma wcode_main_first_part_len[simp]:
   "length t_wcode_main_first_part = 24"
   apply(simp add: t_wcode_main_first_part_def)
   done
 
 lemma wcode_double_case: 
   shows "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
           (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rn))"
     (is "\<exists>stp ln rn. ?tm stp ln rn")
 proof -
   from wcode_double_case_first_correctness[of ires rs m n] obtain na ln rn where
     "steps0 (Suc 0, Bk # Bk \<up> m @ Oc # Oc # ires, Bk # Oc # Oc \<up> rs @ Bk \<up> n) t_wcode_main na
       = (13, Bk # Bk # Bk \<up> ln @ Oc # ires, Oc # Oc # Oc \<up> rs @ Bk \<up> rn)"
     by(auto simp: wcode_double_case_inv.simps wcode_before_double.simps)
   hence "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
           (13,  Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
     by(case_tac "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, 
            Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main na", auto)  
   from this obtain stpa lna rna where stp1: 
     "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa = 
     (13, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rna))" by blast
   from t_twice_append[of "Bk\<up>(lna) @ Oc # ires" "Suc rs" rna] obtain stp ln rn
     where "steps0 (Suc 0 + length t_wcode_main_first_part div 2,
                    Bk # Bk # Bk \<up> lna @ Oc # ires, Oc \<up> Suc (Suc rs) @ Bk \<up> rna)
                   (t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
                    [(L, 1), (L, 1)] @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)]) stp =
            (Suc t_twice_len + length t_wcode_main_first_part div 2, 
             Bk \<up> ln @ Bk # Bk # Bk \<up> lna @ Oc # ires, Oc \<up> Suc (2 * Suc rs) @ Bk \<up> rn)" by blast
   hence "\<exists> stp ln rn. steps0 (13, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rna)) t_wcode_main stp =
     (13 + t_twice_len, Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rn))"
     using t_twice_append[of "Bk\<up>(lna) @ Oc # ires" "Suc rs" rna]
     apply(simp)
     apply(rule_tac x = stp in exI, rule_tac x = "ln + lna" in exI, 
         rule_tac x = rn in exI)
     apply(simp add: t_wcode_main_def)
     apply(simp add: replicate_Suc[THEN sym] replicate_add [THEN sym] del: replicate_Suc)
     done
   from this obtain stpb lnb rnb where stp2: 
     "steps0 (13, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rna)) t_wcode_main stpb =
     (13 + t_twice_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires, Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnb))" by blast
   from wcode_jump1[of lnb "Oc # ires" "Suc rs" rnb] obtain stp ln rn where
     "steps0 (Suc t_twice_len + length t_wcode_main_first_part div 2, 
              Bk \<up> lnb @ Bk # Bk # Oc # ires, Oc \<up> Suc (2 * Suc rs) @ Bk \<up> rnb) t_wcode_main stp =
      (Suc 0, Bk \<up> ln @ Bk # Oc # ires, Bk # Oc \<up> Suc (2 * Suc rs) @ Bk \<up> rn)" by metis
   hence "steps0 (13 + t_twice_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires,
     Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnb)) t_wcode_main stp = 
        (Suc 0,  Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rn))"
     apply(auto simp add: t_wcode_main_def)
     apply(subgoal_tac "Bk\<up>(lnb) @ Bk # Bk # Oc # ires = Bk # Bk # Bk\<up>(lnb) @ Oc # ires", simp)
      apply(simp add: replicate_Suc[THEN sym] exp_ind[THEN sym] del: replicate_Suc)
     apply(simp)
     apply(simp add: replicate_Suc[THEN sym] exp_ind del: replicate_Suc)
     done 
   hence "\<exists>stp ln rn. steps0 (13 + t_twice_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires,
     Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnb)) t_wcode_main stp = 
        (Suc 0,  Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rn))"
     by blast
   from this obtain stpc lnc rnc where stp3: 
     "steps0 (13 + t_twice_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires,
     Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnb)) t_wcode_main stpc = 
        (Suc 0,  Bk # Bk\<up>(lnc) @ Oc # ires, Bk # Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnc))"
     by blast
   from stp1 stp2 stp3 have "?tm (stpa + stpb + stpc) lnc rnc" by simp
   thus "?thesis" by blast
 qed
 
 
 (* Begin: fourtime_case*)
 fun wcode_on_left_moving_2_B :: "bin_inv_t"
   where
     "wcode_on_left_moving_2_B ires rs (l, r) =
      (\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # Bk # Oc # ires \<and>
                  r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and> 
                  ml + mr > Suc 0 \<and> mr > 0)"
 
 fun wcode_on_left_moving_2_O :: "bin_inv_t"
   where
     "wcode_on_left_moving_2_O ires rs (l, r) =
      (\<exists> ln rn. l = Bk # Oc # ires \<and>
                r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wcode_on_left_moving_2 :: "bin_inv_t"
   where
     "wcode_on_left_moving_2 ires rs (l, r) = 
       (wcode_on_left_moving_2_B ires rs (l, r) \<or> 
       wcode_on_left_moving_2_O ires rs (l, r))"
 
 fun wcode_on_checking_2 :: "bin_inv_t"
   where
     "wcode_on_checking_2 ires rs (l, r) =
        (\<exists> ln rn. l = Oc#ires \<and> 
                  r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wcode_goon_checking :: "bin_inv_t"
   where
     "wcode_goon_checking ires rs (l, r) =
        (\<exists> ln rn. l = ires \<and>
                  r = Oc # Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wcode_right_move :: "bin_inv_t"
   where
     "wcode_right_move ires rs (l, r) = 
      (\<exists> ln rn. l = Oc # ires \<and>
                  r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wcode_erase2 :: "bin_inv_t"
   where
     "wcode_erase2 ires rs (l, r) = 
         (\<exists> ln rn. l = Bk # Oc # ires \<and>
                  tl r = Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wcode_on_right_moving_2 :: "bin_inv_t"
   where
     "wcode_on_right_moving_2 ires rs (l, r) = 
         (\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # ires \<and> 
                      r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and> ml + mr > Suc 0)"
 
 fun wcode_goon_right_moving_2 :: "bin_inv_t"
   where
     "wcode_goon_right_moving_2 ires rs (l, r) = 
         (\<exists> ml mr ln rn. l = Oc\<up>(ml) @ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
                         r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> ml + mr = Suc rs)"
 
 fun wcode_backto_standard_pos_2_B :: "bin_inv_t"
   where
     "wcode_backto_standard_pos_2_B ires rs (l, r) = 
            (\<exists> ln rn. l = Bk # Bk\<up>(ln) @ Oc # ires \<and> 
                      r = Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
 
 fun wcode_backto_standard_pos_2_O :: "bin_inv_t"
   where
     "wcode_backto_standard_pos_2_O ires rs (l, r) = 
           (\<exists> ml mr ln rn. l = Oc\<up>(ml )@ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and> 
                           r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> 
                           ml + mr = (Suc (Suc rs)) \<and> mr > 0)"
 
 fun wcode_backto_standard_pos_2 :: "bin_inv_t"
   where
     "wcode_backto_standard_pos_2 ires rs (l, r) = 
            (wcode_backto_standard_pos_2_O ires rs (l, r) \<or> 
            wcode_backto_standard_pos_2_B ires rs (l, r))"
 
 fun wcode_before_fourtimes :: "bin_inv_t"
   where
     "wcode_before_fourtimes ires rs (l, r) = 
           (\<exists> ln rn. l = Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and> 
                     r = Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
 
 declare wcode_on_left_moving_2_B.simps[simp del] wcode_on_left_moving_2.simps[simp del]
   wcode_on_left_moving_2_O.simps[simp del] wcode_on_checking_2.simps[simp del]
   wcode_goon_checking.simps[simp del] wcode_right_move.simps[simp del]
   wcode_erase2.simps[simp del]
   wcode_on_right_moving_2.simps[simp del] wcode_goon_right_moving_2.simps[simp del]
   wcode_backto_standard_pos_2_B.simps[simp del] wcode_backto_standard_pos_2_O.simps[simp del]
   wcode_backto_standard_pos_2.simps[simp del]
 
 lemmas wcode_fourtimes_invs = 
   wcode_on_left_moving_2_B.simps wcode_on_left_moving_2.simps
   wcode_on_left_moving_2_O.simps wcode_on_checking_2.simps
   wcode_goon_checking.simps wcode_right_move.simps
   wcode_erase2.simps
   wcode_on_right_moving_2.simps wcode_goon_right_moving_2.simps
   wcode_backto_standard_pos_2_B.simps wcode_backto_standard_pos_2_O.simps
   wcode_backto_standard_pos_2.simps
 
 fun wcode_fourtimes_case_inv :: "nat \<Rightarrow> bin_inv_t"
   where
     "wcode_fourtimes_case_inv st ires rs (l, r) = 
            (if st = Suc 0 then wcode_on_left_moving_2 ires rs (l, r)
             else if st = Suc (Suc 0) then wcode_on_checking_2 ires rs (l, r)
             else if st = 7 then wcode_goon_checking ires rs (l, r)
             else if st = 8 then wcode_right_move ires rs (l, r)
             else if st = 9 then wcode_erase2 ires rs (l, r)
             else if st = 10 then wcode_on_right_moving_2 ires rs (l, r)
             else if st = 11 then wcode_goon_right_moving_2 ires rs (l, r)
             else if st = 12 then wcode_backto_standard_pos_2 ires rs (l, r)
             else if st = t_twice_len + 14 then wcode_before_fourtimes ires rs (l, r)
             else False)"
 
 declare wcode_fourtimes_case_inv.simps[simp del]
 
 fun wcode_fourtimes_case_state :: "config \<Rightarrow> nat"
   where
     "wcode_fourtimes_case_state (st, l, r) = 13 - st"
 
 fun wcode_fourtimes_case_step :: "config \<Rightarrow> nat"
   where
     "wcode_fourtimes_case_step (st, l, r) = 
          (if st = Suc 0 then length l
           else if st = 9 then 
            (if hd r = Oc then 1
             else 0)
           else if st = 10 then length r
           else if st = 11 then length r
           else if st = 12 then length l
           else 0)"
 
 fun wcode_fourtimes_case_measure :: "config \<Rightarrow> nat \<times> nat"
   where
     "wcode_fourtimes_case_measure (st, l, r) = 
      (wcode_fourtimes_case_state (st, l, r), 
       wcode_fourtimes_case_step (st, l, r))"
 
 definition wcode_fourtimes_case_le :: "(config \<times> config) set"
   where "wcode_fourtimes_case_le \<equiv> (inv_image lex_pair wcode_fourtimes_case_measure)"
 
 lemma wf_wcode_fourtimes_case_le[intro]: "wf wcode_fourtimes_case_le"
   by(auto simp: wcode_fourtimes_case_le_def)
 
 lemma nonempty_snd [simp]:
   "wcode_on_left_moving_2 ires rs (b, []) = False"
   "wcode_on_checking_2 ires rs (b, []) = False"
   "wcode_goon_checking ires rs (b, []) = False"
   "wcode_right_move ires rs (b, []) = False"
   "wcode_erase2 ires rs (b, []) = False"
   "wcode_on_right_moving_2 ires rs (b, []) = False"
   "wcode_backto_standard_pos_2 ires rs (b, []) = False"
   "wcode_on_checking_2 ires rs (b, Oc # list) = False"
   by(auto simp: wcode_fourtimes_invs) 
 
 lemma wcode_on_left_moving_2[simp]:
   "wcode_on_left_moving_2 ires rs (b, Bk # list) \<Longrightarrow>  wcode_on_left_moving_2 ires rs (tl b, hd b # Bk # list)"
   apply(simp only: wcode_fourtimes_invs)
   apply(erule_tac disjE)
    apply(erule_tac exE)+
    apply(simp add: gr1_conv_Suc exp_ind replicate_app_Cons_same split:hd_repeat_cases)
    apply (auto simp add: gr0_conv_Suc[symmetric] replicate_app_Cons_same split:hd_repeat_cases)
   by force+
 
 
 lemma wcode_goon_checking_via_2 [simp]: "wcode_on_checking_2 ires rs (b, Bk # list)
        \<Longrightarrow>   wcode_goon_checking ires rs (tl b, hd b # Bk # list)"
   unfolding wcode_fourtimes_invs by auto
 
 lemma wcode_erase2_via_move [simp]: "wcode_right_move ires rs (b, Bk # list) \<Longrightarrow>  wcode_erase2 ires rs (Bk # b, list)"
   by (auto simp:wcode_fourtimes_invs ) auto
 
 lemma wcode_on_right_moving_2_via_erase2[simp]:
   "wcode_erase2 ires rs (b, Bk # list) \<Longrightarrow> wcode_on_right_moving_2 ires rs (Bk # b, list)"
   apply(auto simp:wcode_fourtimes_invs )
   apply(rule_tac x = "Suc (Suc 0)" in exI, simp add: exp_ind)
   by (metis replicate_Suc_iff_anywhere replicate_app_Cons_same)
 
 lemma wcode_on_right_moving_2_move_Bk[simp]: "wcode_on_right_moving_2 ires rs (b, Bk # list)
        \<Longrightarrow> wcode_on_right_moving_2 ires rs (Bk # b, list)"
   apply(auto simp: wcode_fourtimes_invs) apply(rename_tac ml mr rn)
   apply(rule_tac x = "Suc ml" in exI, simp)
   apply(rule_tac x = "mr - 1" in exI, case_tac mr,auto)
   done
 
 lemma wcode_backto_standard_pos_2_via_right[simp]:
   "wcode_goon_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow> 
                  wcode_backto_standard_pos_2 ires rs (b, Oc # list)"
   apply(simp add: wcode_fourtimes_invs, auto)
   by (metis add.right_neutral add_Suc_shift append_Cons list.sel(3)
       replicate.simps(1) replicate_Suc replicate_Suc_iff_anywhere self_append_conv2
       tl_replicate zero_less_Suc)
 
 lemma wcode_on_checking_2_via_left[simp]: "wcode_on_left_moving_2 ires rs (b, Oc # list) \<Longrightarrow> 
                      wcode_on_checking_2 ires rs (tl b, hd b # Oc # list)"
   by(auto simp: wcode_fourtimes_invs)
 
 lemma wcode_backto_standard_pos_2_empty_via_right[simp]:
   "wcode_goon_right_moving_2 ires rs (b, []) \<Longrightarrow>
               wcode_backto_standard_pos_2 ires rs (b, [Oc])"
   apply(simp only: wcode_fourtimes_invs)
   apply(erule_tac exE)+
   by(rule_tac disjI1,auto)
 
 lemma wcode_goon_checking_cases[simp]: "wcode_goon_checking ires rs (b, Oc # list) \<Longrightarrow>
   (b = [] \<longrightarrow> wcode_right_move ires rs ([Oc], list)) \<and>
   (b \<noteq> [] \<longrightarrow> wcode_right_move ires rs (Oc # b, list))"
   apply(simp only: wcode_fourtimes_invs)
   apply(erule_tac exE)+
   apply(auto)
   done
 
 lemma wcode_right_move_no_Oc[simp]: "wcode_right_move ires rs (b, Oc # list) = False"
   apply(auto simp: wcode_fourtimes_invs)
   done
 
 lemma wcode_erase2_Bk_via_Oc[simp]: "wcode_erase2 ires rs (b, Oc # list)
        \<Longrightarrow> wcode_erase2 ires rs (b, Bk # list)"
   apply(auto simp: wcode_fourtimes_invs)
   done
 
 lemma wcode_goon_right_moving_2_Oc_move[simp]:
   "wcode_on_right_moving_2 ires rs (b, Oc # list)
        \<Longrightarrow> wcode_goon_right_moving_2 ires rs (Oc # b, list)"
   apply(auto simp: wcode_fourtimes_invs)
   apply(rule_tac x = "Suc 0" in exI, auto)
   apply(rule_tac x = "ml - 2" in exI)
   apply(case_tac ml, simp, case_tac "ml - 1", simp_all)
   done
 
 lemma wcode_backto_standard_pos_2_exists[simp]: "wcode_backto_standard_pos_2 ires rs (b, Bk # list)
        \<Longrightarrow> (\<exists>ln. b = Bk # Bk\<up>(ln) @ Oc # ires) \<and> (\<exists>rn. list = Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
   by(simp add: wcode_fourtimes_invs)
 
 lemma wcode_goon_right_moving_2_move_Oc[simp]: "wcode_goon_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow>
        wcode_goon_right_moving_2 ires rs (Oc # b, list)"
   apply(simp only:wcode_fourtimes_invs, auto)
   apply(rename_tac ml ln mr rn)
   apply(case_tac mr;force)
   done
 
 
 lemma wcode_backto_standard_pos_2_Oc_mv_hd[simp]:
   "wcode_backto_standard_pos_2 ires rs (b, Oc # list)    
             \<Longrightarrow> wcode_backto_standard_pos_2 ires rs (tl b, hd b # Oc # list)"
   apply(simp only: wcode_fourtimes_invs)
   apply(erule_tac disjE)
    apply(erule_tac exE)+ apply(rename_tac ml mr ln rn)
   by (case_tac ml, force,force,force)
 
 lemma nonempty_fst[simp]:
   "wcode_on_left_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
   "wcode_on_checking_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
   "wcode_goon_checking ires rs (b, Bk # list) = False"
   "wcode_right_move ires rs (b, Bk # list) \<Longrightarrow> b\<noteq> []" 
   "wcode_erase2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
   "wcode_on_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
   "wcode_goon_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
   "wcode_backto_standard_pos_2 ires rs (b, Bk # list) \<Longrightarrow>  b \<noteq> []"
   "wcode_on_left_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
   "wcode_goon_right_moving_2 ires rs (b, []) \<Longrightarrow> b \<noteq> []"
   "wcode_erase2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
   "wcode_on_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
   "wcode_goon_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
   "wcode_backto_standard_pos_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
   by(auto simp: wcode_fourtimes_invs)
 
 
 lemma wcode_fourtimes_case_first_correctness:
   shows "let P = (\<lambda> (st, l, r). st = t_twice_len + 14) in 
   let Q = (\<lambda> (st, l, r). wcode_fourtimes_case_inv st ires rs (l, r)) in 
   let f = (\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp) in
   \<exists> n .P (f n) \<and> Q (f (n::nat))"
 proof -
   let ?P = "(\<lambda> (st, l, r). st = t_twice_len + 14)"
   let ?Q = "(\<lambda> (st, l, r). wcode_fourtimes_case_inv st ires rs (l, r))"
   let ?f = "(\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp)"
   have "\<exists> n . ?P (?f n) \<and> ?Q (?f (n::nat))"
   proof(rule_tac halt_lemma2)
     show "wf wcode_fourtimes_case_le"
       by auto
   next
     have "\<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow>
                   ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_fourtimes_case_le" for na
       apply(cases "?f na", rule_tac impI)
       apply(simp add: step_red step.simps)
       apply(case_tac "snd (snd (?f na))", simp, case_tac [2] "hd (snd (snd (?f na)))", simp_all)
         apply(simp_all add: wcode_fourtimes_case_inv.simps
           wcode_fourtimes_case_le_def lex_pair_def split: if_splits)
       by(auto simp: wcode_backto_standard_pos_2.simps wcode_backto_standard_pos_2_O.simps
           wcode_backto_standard_pos_2_B.simps gr0_conv_Suc)
     thus "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow>
                   ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_fourtimes_case_le" by auto
   next
     show "?Q (?f 0)"
       apply(simp add: steps.simps wcode_fourtimes_case_inv.simps)
       apply(simp add: wcode_on_left_moving_2.simps wcode_on_left_moving_2_B.simps 
           wcode_on_left_moving_2_O.simps)
       apply(rule_tac x = "Suc m" in exI, simp )
       apply(rule_tac x ="Suc 0" in exI, auto)
       done
   next
     show "\<not> ?P (?f 0)"
       apply(simp add: steps.simps)
       done
   qed
   thus "?thesis"
     apply(erule_tac exE, simp)
     done
 qed
 
 definition t_fourtimes_len :: "nat"
   where
     "t_fourtimes_len = (length t_fourtimes div 2)"
 
 lemma primerec_rec_fourtimes_1[intro]: "primerec rec_fourtimes (Suc 0)"
   apply(auto simp: rec_fourtimes_def numeral_4_eq_4 constn.simps)
   by auto
 
 lemma fourtimes_lemma: "rec_exec rec_fourtimes [rs] = 4 * rs"
   by(simp add: rec_exec.simps rec_fourtimes_def)
 
 lemma t_fourtimes_correct: 
   "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
     (tm_of abc_fourtimes @ shift (mopup 1) (length (tm_of abc_fourtimes) div 2)) stp =
        (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
 proof(case_tac "rec_ci rec_fourtimes")
   fix a b c
   assume h: "rec_ci rec_fourtimes = (a, b, c)"
   have "\<exists>stp m l. steps0 (Suc 0, Bk # Bk # ires, <[rs]> @ Bk\<up>(n)) (tm_of abc_fourtimes @ shift (mopup (length [rs])) 
     (length (tm_of abc_fourtimes) div 2)) stp = (0, Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (rec_exec rec_fourtimes [rs])) @ Bk\<up>(l))"
     thm recursive_compile_to_tm_correct1
   proof(rule_tac recursive_compile_to_tm_correct1)
     show "rec_ci rec_fourtimes = (a, b, c)" by (simp add: h)
   next
     show "terminate rec_fourtimes [rs]"
       apply(rule_tac primerec_terminate)
       by auto
   next
     show "tm_of abc_fourtimes = tm_of (a [+] dummy_abc (length [rs]))"
       using h
       by(simp add: abc_fourtimes_def)
   qed
   thus "?thesis"
     apply(simp add: tape_of_list_def tape_of_nat_def fourtimes_lemma)
     done
 qed
 
 lemma wf_fourtimes[intro]: "tm_wf (t_fourtimes_compile, 0)"
   apply(simp only: t_fourtimes_compile_def)
   apply(rule_tac wf_tm_from_abacus, simp)
   done
 
 lemma t_fourtimes_change_term_state:
   "\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_fourtimes stp
      = (Suc t_fourtimes_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
 proof -
   have "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
     (tm_of abc_fourtimes @ shift (mopup 1) ((length (tm_of abc_fourtimes) div 2))) stp =
     (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
     by(rule_tac t_fourtimes_correct)
   then obtain stp ln rn where 
     "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
     (tm_of abc_fourtimes @ shift (mopup 1) ((length (tm_of abc_fourtimes) div 2))) stp =
     (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))" by blast
   hence "\<exists> stp. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
     (adjust0 t_fourtimes_compile) stp
      = (Suc (length t_fourtimes_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
     apply(rule_tac stp = stp in adjust_halt_eq)
      apply(simp add: t_fourtimes_compile_def, auto)
     done
   then obtain stpb where 
     "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
     (adjust0 t_fourtimes_compile) stpb
      = (Suc (length t_fourtimes_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))" ..
   thus "?thesis"
     apply(simp add: t_fourtimes_def t_fourtimes_len_def)
     by metis
 qed
 
 lemma length_t_twice_even[intro]: "is_even (length t_twice)"
   by(auto simp: t_twice_def t_twice_compile_def intro!:mopup_mod2)
 
 lemma t_fourtimes_append_pre:
   "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_fourtimes stp
   = (Suc t_fourtimes_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))
    \<Longrightarrow> steps0 (Suc 0 + length (t_wcode_main_first_part @ 
               shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
        Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
      ((t_wcode_main_first_part @ 
   shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) @ 
   shift t_fourtimes (length (t_wcode_main_first_part @ 
   shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2) @ ([(L, 1), (L, 1)])) stp 
   = ((Suc t_fourtimes_len) + length (t_wcode_main_first_part @ 
   shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
   Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
   using length_t_twice_even
   by(intro tm_append_shift_append_steps, auto)
 
 lemma split_26_even[simp]: "(26 + l::nat) div 2 = l div 2 + 13" by(simp)
 
 lemma t_twice_len_plust_14[simp]: "t_twice_len + 14 =  14 + length (shift t_twice 12) div 2"
   apply(simp add: t_twice_def t_twice_len_def)
   done
 
 lemma t_fourtimes_append:
   "\<exists> stp ln rn. 
   steps0 (Suc 0 + length (t_wcode_main_first_part @ shift t_twice
   (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2, 
   Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
   ((t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
   [(L, 1), (L, 1)]) @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)]) stp 
   = (Suc t_fourtimes_len + length (t_wcode_main_first_part @ shift t_twice
   (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2, Bk\<up>(ln) @ Bk # Bk # ires,
                                                                  Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
   using t_fourtimes_change_term_state[of ires rs n]
   apply(erule_tac exE)
   apply(erule_tac exE)
   apply(erule_tac exE)
   apply(drule_tac t_fourtimes_append_pre)
   apply(rule_tac x = stp in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
   apply(simp add: t_twice_len_def)
   done
 
 lemma even_fourtimes_len: "length t_fourtimes mod 2 = 0"
   apply(auto simp: t_fourtimes_def t_fourtimes_compile_def)
   by (metis mopup_mod2)
 
 lemma t_twice_even[simp]: "2 * (length t_twice div 2) = length t_twice"
   using length_t_twice_even by arith
 
 lemma t_fourtimes_even[simp]: "2 * (length t_fourtimes div 2) = length t_fourtimes"
   using even_fourtimes_len
   by arith
 
 lemma fetch_t_wcode_14_Oc: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) Oc
              = (L, Suc 0)" 
   apply(subgoal_tac "14 = Suc 13")
    apply(simp only: fetch.simps add_Suc nth_of.simps t_wcode_main_def)
    apply(simp add:length_t_twice_even t_fourtimes_len_def nth_append)
   by arith
 
 lemma fetch_t_wcode_14_Bk: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) Bk
              = (L, Suc 0)"
   apply(subgoal_tac "14 = Suc 13")
    apply(simp only: fetch.simps add_Suc nth_of.simps t_wcode_main_def)
    apply(simp add:length_t_twice_even t_fourtimes_len_def nth_append)
   by arith
 
 lemma fetch_t_wcode_14 [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) b
              = (L, Suc 0)"
   apply(case_tac b, simp_all add:fetch_t_wcode_14_Bk fetch_t_wcode_14_Oc)
   done
 
 lemma wcode_jump2: 
   "\<exists> stp ln rn. steps0 (t_twice_len + 14 + t_fourtimes_len
   , Bk # Bk # Bk\<up>(lnb) @ Oc # ires, Oc\<up>(Suc (4 * rs + 4)) @ Bk\<up>(rnb)) t_wcode_main stp =
   (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4 * rs + 4)) @ Bk\<up>(rn))"
   apply(rule_tac x = "Suc 0" in exI)
   apply(simp add: steps.simps)
   apply(rule_tac x = lnb in exI, rule_tac x = rnb in exI)
   apply(simp add: step.simps)
   done
 
 lemma wcode_fourtimes_case:
   shows "\<exists>stp ln rn.
   steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
   (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
 proof -
   have "\<exists>stp ln rn.
   steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
   (t_twice_len + 14, Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rn))"
     using wcode_fourtimes_case_first_correctness[of ires rs m n]
     by (auto simp add: wcode_fourtimes_case_inv.simps) auto
   from this obtain stpa lna rna where stp1:
     "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
   (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))" by blast
   have "\<exists>stp ln rn. steps0 (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))
                      t_wcode_main stp =
           (t_twice_len + 14 + t_fourtimes_len, Bk # Bk # Bk\<up>(ln) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
     using t_fourtimes_append[of " Bk\<up>(lna) @ Oc # ires" "rs + 1" rna]
     apply(erule_tac exE)
     apply(erule_tac exE)
     apply(erule_tac exE)
     apply(simp add: t_wcode_main_def) apply(rename_tac stp ln rn)
     apply(rule_tac x = stp in exI, 
         rule_tac x = "ln + lna" in exI,
         rule_tac x = rn in exI, simp)
     apply(simp add: replicate_Suc[THEN sym] replicate_add[THEN sym] del: replicate_Suc)
     done
   from this obtain stpb lnb rnb where stp2:
     "steps0 (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))
                      t_wcode_main stpb =
        (t_twice_len + 14 + t_fourtimes_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))"
     by blast
   have "\<exists>stp ln rn. steps0 (t_twice_len + 14 + t_fourtimes_len,
     Bk # Bk # Bk\<up>(lnb) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))
     t_wcode_main stp =
     (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
     apply(rule wcode_jump2)
     done
   from this obtain stpc lnc rnc where stp3: 
     "steps0 (t_twice_len + 14 + t_fourtimes_len,
     Bk # Bk # Bk\<up>(lnb) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))
     t_wcode_main stpc =
     (Suc 0, Bk # Bk\<up>(lnc) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnc))"
     by blast
   from stp1 stp2 stp3 show "?thesis"
     apply(rule_tac x = "stpa + stpb + stpc" in exI,
         rule_tac x = lnc in exI, rule_tac x = rnc in exI)
     apply(simp)
     done
 qed
 
 fun wcode_on_left_moving_3_B :: "bin_inv_t"
   where
     "wcode_on_left_moving_3_B ires rs (l, r) = 
        (\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # Bk # Bk # ires \<and>
                     r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and> 
                     ml + mr > Suc 0 \<and> mr > 0 )"
 
 fun wcode_on_left_moving_3_O :: "bin_inv_t"
   where
     "wcode_on_left_moving_3_O ires rs (l, r) = 
          (\<exists> ln rn. l = Bk # Bk # ires \<and>
                    r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wcode_on_left_moving_3 :: "bin_inv_t"
   where
     "wcode_on_left_moving_3 ires rs (l, r) = 
        (wcode_on_left_moving_3_B ires rs (l, r) \<or>  
         wcode_on_left_moving_3_O ires rs (l, r))"
 
 fun wcode_on_checking_3 :: "bin_inv_t"
   where
     "wcode_on_checking_3 ires rs (l, r) = 
          (\<exists> ln rn. l = Bk # ires \<and>
              r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wcode_goon_checking_3 :: "bin_inv_t"
   where
     "wcode_goon_checking_3 ires rs (l, r) = 
          (\<exists> ln rn. l = ires \<and>
              r = Bk # Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wcode_stop :: "bin_inv_t"
   where
     "wcode_stop ires rs (l, r) = 
           (\<exists> ln rn. l = Bk # ires \<and>
              r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wcode_halt_case_inv :: "nat \<Rightarrow> bin_inv_t"
   where
     "wcode_halt_case_inv st ires rs (l, r) = 
           (if st = 0 then wcode_stop ires rs (l, r)
            else if st = Suc 0 then wcode_on_left_moving_3 ires rs (l, r)
            else if st = Suc (Suc 0) then wcode_on_checking_3 ires rs (l, r)
            else if st = 7 then wcode_goon_checking_3 ires rs (l, r)
            else False)"
 
 fun wcode_halt_case_state :: "config \<Rightarrow> nat"
   where
     "wcode_halt_case_state (st, l, r) = 
            (if st = 1 then 5
             else if st = Suc (Suc 0) then 4
             else if st = 7 then 3
             else 0)"
 
 fun wcode_halt_case_step :: "config \<Rightarrow> nat"
   where
     "wcode_halt_case_step (st, l, r) = 
          (if st = 1 then length l
          else 0)"
 
 fun wcode_halt_case_measure :: "config \<Rightarrow> nat \<times> nat"
   where
     "wcode_halt_case_measure (st, l, r) = 
      (wcode_halt_case_state (st, l, r), 
       wcode_halt_case_step (st, l, r))"
 
 definition wcode_halt_case_le :: "(config \<times> config) set"
   where "wcode_halt_case_le \<equiv> (inv_image lex_pair wcode_halt_case_measure)"
 
 lemma wf_wcode_halt_case_le[intro]: "wf wcode_halt_case_le"
   by(auto simp: wcode_halt_case_le_def)
 
 declare wcode_on_left_moving_3_B.simps[simp del] wcode_on_left_moving_3_O.simps[simp del]  
   wcode_on_checking_3.simps[simp del] wcode_goon_checking_3.simps[simp del] 
   wcode_on_left_moving_3.simps[simp del] wcode_stop.simps[simp del]
 
 lemmas wcode_halt_invs = 
   wcode_on_left_moving_3_B.simps wcode_on_left_moving_3_O.simps
   wcode_on_checking_3.simps wcode_goon_checking_3.simps 
   wcode_on_left_moving_3.simps wcode_stop.simps
 
 
 lemma wcode_on_left_moving_3_mv_Bk[simp]: "wcode_on_left_moving_3 ires rs (b, Bk # list)
  \<Longrightarrow> wcode_on_left_moving_3 ires rs (tl b, hd b # Bk # list)"
   apply(simp only: wcode_halt_invs)
   apply(erule_tac disjE)
    apply(erule_tac exE)+ apply(rename_tac ml mr rn)
    apply(case_tac ml, simp)
     apply(rule_tac x = "mr - 2" in exI, rule_tac x = rn in exI)
     apply(case_tac mr, force, simp add: exp_ind del: replicate_Suc)
     apply(case_tac "mr - 1", force, simp add: exp_ind del: replicate_Suc)
    apply force
   apply force
   done
 
 lemma wcode_goon_checking_3_cases[simp]: "wcode_goon_checking_3 ires rs (b, Bk # list) \<Longrightarrow> 
   (b = [] \<longrightarrow> wcode_stop ires rs ([Bk], list)) \<and>
   (b \<noteq> [] \<longrightarrow> wcode_stop ires rs (Bk # b, list))"
   apply(auto simp: wcode_halt_invs)
   done
 
 lemma wcode_on_checking_3_mv_Oc[simp]: "wcode_on_left_moving_3 ires rs (b, Oc # list) \<Longrightarrow> 
                wcode_on_checking_3 ires rs (tl b, hd b # Oc # list)"
   by(simp add:wcode_halt_invs)
 
 lemma wcode_3_nonempty[simp]:
   "wcode_on_left_moving_3 ires rs (b, []) = False"
   "wcode_on_checking_3 ires rs (b, []) = False"
   "wcode_goon_checking_3 ires rs (b, []) = False"
   "wcode_on_left_moving_3 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
   "wcode_on_checking_3 ires rs (b, Oc # list) = False"
   "wcode_on_left_moving_3 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
   "wcode_on_checking_3 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
   "wcode_goon_checking_3 ires rs (b, Oc # list) = False"
   by(auto simp: wcode_halt_invs)
 
 lemma wcode_goon_checking_3_mv_Bk[simp]: "wcode_on_checking_3 ires rs (b, Bk # list) \<Longrightarrow> 
   wcode_goon_checking_3 ires rs (tl b, hd b # Bk # list)"
   apply(auto simp: wcode_halt_invs)
   done
 
 lemma t_halt_case_correctness: 
   shows "let P = (\<lambda> (st, l, r). st = 0) in 
        let Q = (\<lambda> (st, l, r). wcode_halt_case_inv st ires rs (l, r)) in 
        let f = (\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp) in
        \<exists> n .P (f n) \<and> Q (f (n::nat))"
 proof -
   let ?P = "(\<lambda> (st, l, r). st = 0)"
   let ?Q = "(\<lambda> (st, l, r). wcode_halt_case_inv st ires rs (l, r))"
   let ?f = "(\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp)"
   have "\<exists> n. ?P (?f n) \<and> ?Q (?f (n::nat))"
   proof(rule_tac halt_lemma2)
     show "wf wcode_halt_case_le" by auto
   next
     { fix na
       obtain a b c where abc:"?f na = (a,b,c)" by(cases "?f na",auto)
       hence "\<not> ?P (?f na) \<and> ?Q (?f na) \<Longrightarrow>
                     ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_halt_case_le"
         apply(simp add: step.simps)
         apply(cases c;cases "hd c")
            apply(auto simp: wcode_halt_case_le_def lex_pair_def split: if_splits)
         done
     }
     thus "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow> 
                     ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_halt_case_le" by blast     
   next 
     show "?Q (?f 0)"
       apply(simp add: steps.simps wcode_halt_invs)
       apply(rule_tac x = "Suc m" in exI, simp)
       apply(rule_tac x = "Suc 0" in exI, auto)
       done
   next
     show "\<not> ?P (?f 0)"
       apply(simp add: steps.simps)
       done
   qed
   thus "?thesis"
     apply(auto)
     done
 qed
 
 declare wcode_halt_case_inv.simps[simp del]
 lemma leading_Oc[intro]: "\<exists> xs. (<rev list @ [aa::nat]> :: cell list) = Oc # xs"
   apply(case_tac "rev list", simp)
   apply(simp add: tape_of_nl_cons)
   done
 
 lemma wcode_halt_case:
   "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n))
   t_wcode_main stp  = (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 proof -
   let ?P = "\<lambda>(st, l, r). st = 0"
   let ?Q = "\<lambda>(st, l, r). wcode_halt_case_inv st ires rs (l, r)"
   let ?f = "steps0 (Suc 0, Bk # Bk \<up> m @ Oc # Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main"
   from t_halt_case_correctness[of ires rs m n] obtain n where "?P (?f n) \<and> ?Q (?f n)" by metis
   thus ?thesis
     apply(simp add: wcode_halt_case_inv.simps wcode_stop.simps)
     apply(case_tac "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires,
                 Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main n")
     apply(auto simp: wcode_halt_case_inv.simps wcode_stop.simps)
     by auto
 qed
 
 lemma bl_bin_one[simp]: "bl_bin [Oc] = 1"
   apply(simp add: bl_bin.simps)
   done
 
 lemma twice_power[intro]: "2 * 2 ^ a = Suc (Suc (2 * bl_bin (Oc \<up> a)))"
   apply(induct a, auto simp: bl_bin.simps)
   done
 declare replicate_Suc[simp del]
 
 lemma t_wcode_main_lemma_pre:
   "\<lbrakk>args \<noteq> []; lm = <args::nat list>\<rbrakk> \<Longrightarrow> 
        \<exists> stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main
                     stp
       = (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2^(length lm - 1) ) @ Bk\<up>(rn))"
 proof(induct "length args" arbitrary: args lm rs m n, simp)
   fix x args lm rs m n
   assume ind:
     "\<And>args lm rs m n.
     \<lbrakk>x = length args; (args::nat list) \<noteq> []; lm = <args>\<rbrakk>
     \<Longrightarrow> \<exists>stp ln rn.
     steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
     (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2 ^ (length lm - 1)) @ Bk\<up>(rn))"
     and h: "Suc x = length args" "(args::nat list) \<noteq> []" "lm = <args>"
   from h have "\<exists> (a::nat) xs. args = xs @ [a]"
     apply(rule_tac x = "last args" in exI)
     apply(rule_tac x = "butlast args" in exI, auto)
     done    
   from this obtain a xs where "args = xs @ [a]" by blast
   from h and this show
     "\<exists>stp ln rn.
     steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
     (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2 ^ (length lm - 1)) @ Bk\<up>(rn))"
   proof(case_tac "xs::nat list", simp)
     show "\<exists>stp ln rn.
           steps0 (Suc 0, Bk # Bk \<up> m @ Oc \<up> Suc a @ Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
           (0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> (bl_bin (Oc \<up> Suc a) + rs * 2 ^ a) @ Bk \<up> rn)"
     proof(induct "a" arbitrary: m n rs ires, simp)
       fix m n rs ires
       show "\<exists>stp ln rn.
           steps0 (Suc 0, Bk # Bk \<up> m @ Oc # Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
           (0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> Suc rs @ Bk \<up> rn)"
         apply(rule_tac wcode_halt_case)
         done
     next
       fix a m n rs ires
       assume ind2:
         "\<And>m n rs ires.
            \<exists>stp ln rn.
               steps0 (Suc 0, Bk # Bk \<up> m @ Oc \<up> Suc a @ Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
               (0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> (bl_bin (Oc \<up> Suc a) + rs * 2 ^ a) @ Bk \<up> rn)"
       show " \<exists>stp ln rn.
           steps0 (Suc 0, Bk # Bk \<up> m @ Oc \<up> Suc (Suc a) @ Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
           (0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> (bl_bin (Oc \<up> Suc (Suc a)) + rs * 2 ^ Suc a) @ Bk \<up> rn)"
       proof -
         have "\<exists>stp ln rn.
           steps0 (Suc 0, Bk # Bk\<up>(m) @ rev (<Suc a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
           (Suc 0, Bk # Bk\<up>(ln) @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rn))"
           apply(simp add: tape_of_nat)
           using wcode_double_case[of m "Oc\<up>(a) @ Bk # Bk # ires" rs n]
           apply(simp add: replicate_Suc)
           done
         from this obtain stpa lna rna where stp1:  
           "steps0 (Suc 0, Bk # Bk\<up>(m) @ rev (<Suc a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
           (Suc 0, Bk # Bk\<up>(lna) @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rna))" by blast
         moreover have 
           "\<exists>stp ln rn.
           steps0 (Suc 0,  Bk # Bk\<up>(lna) @ rev (<a::nat>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rna)) t_wcode_main stp =
           (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<a>) + (2*rs + 2)  * 2 ^ a) @ Bk\<up>(rn))"
           using ind2[of lna ires "2*rs + 2" rna] by(simp add: tape_of_list_def tape_of_nat_def)   
         from this obtain stpb lnb rnb where stp2:  
           "steps0 (Suc 0,  Bk # Bk\<up>(lna) @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rna)) t_wcode_main stpb =
           (0, Bk # ires, Bk # Oc # Bk\<up>(lnb) @ Bk # Bk # Oc\<up>(bl_bin (<a>) + (2*rs + 2)  * 2 ^ a) @ Bk\<up>(rnb))"
           by blast
         from stp1 and stp2 show "?thesis"
           apply(rule_tac x = "stpa + stpb" in exI,
               rule_tac x = lnb in exI, rule_tac x = rnb in exI, simp add: tape_of_nat_def)
           apply(simp add:  bl_bin.simps replicate_Suc)
           apply(auto)
           done
       qed
     qed
   next
     fix aa list
     assume g: "Suc x = length args" "args \<noteq> []" "lm = <args>" "args = xs @ [a::nat]" "xs = (aa::nat) # list"
     thus "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
       (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2 ^ (length lm - 1)) @ Bk\<up>(rn))"
-    proof(induct a arbitrary: m n rs args lm, simp_all add: tape_of_nl_rev del: subst_all subst_all', 
-        simp only: tape_of_nl_cons_app1, simp del: subst_all subst_all')
+    proof(induct a arbitrary: m n rs args lm, simp_all add: tape_of_nl_rev del: subst_all, 
+        simp only: tape_of_nl_cons_app1, simp del: subst_all)
       fix m n rs args lm
       have "\<exists>stp ln rn.
         steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # rev (<(aa::nat) # list>) @ Bk # Bk # ires,
         Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
         (Suc 0, Bk # Bk\<up>(ln) @ rev (<aa # list>) @ Bk # Bk # ires, 
         Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
       proof(simp add: tape_of_nl_rev)
         have "\<exists> xs. (<rev list @ [aa]>) = Oc # xs" by auto           
         from this obtain xs where "(<rev list @ [aa]>) = Oc # xs" ..
         thus "\<exists>stp ln rn.
             steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # <rev list @ [aa]> @ Bk # Bk # ires,
             Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
             (Suc 0, Bk # Bk\<up>(ln) @ <rev list @ [aa]> @ Bk # Bk # ires, Bk # Oc\<up>(5 + 4 * rs) @ Bk\<up>(rn))"
           apply(simp)
           using wcode_fourtimes_case[of m "xs @ Bk # Bk # ires" rs n]
           apply(simp)
           done
       qed
       from this obtain stpa lna rna where stp1:
         "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # rev (<aa # list>) @ Bk # Bk # ires,
         Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
         (Suc 0, Bk # Bk\<up>(lna) @ rev (<aa # list>) @ Bk # Bk # ires, 
         Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rna))" by blast
       from g have 
         "\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(lna) @ rev (<(aa::nat) # list>) @ Bk # Bk # ires, 
         Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rna)) t_wcode_main stp = (0, Bk # ires, 
         Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<aa#list>)+ (4*rs + 4) * 2^(length (<aa#list>) - 1) ) @ Bk\<up>(rn))"
         apply(rule_tac args = "(aa::nat)#list" in ind, simp_all)
         done
       from this obtain stpb lnb rnb where stp2:
         "steps0 (Suc 0, Bk # Bk\<up>(lna) @ rev (<(aa::nat) # list>) @ Bk # Bk # ires, 
          Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rna)) t_wcode_main stpb = (0, Bk # ires, 
          Bk # Oc # Bk\<up>(lnb) @ Bk # Bk # Oc\<up>(bl_bin (<aa#list>)+ (4*rs + 4) * 2^(length (<aa#list>) - 1) ) @ Bk\<up>(rnb))"
         by blast
       from stp1 and stp2 and h
       show "\<exists>stp ln rn.
          steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # <rev list @ [aa]> @ Bk # Bk # ires,
          Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
          (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk #
          Bk # Oc\<up>(bl_bin (Oc\<up>(Suc aa) @ Bk # <list @ [0]>) + rs * (2 * 2 ^ (aa + length (<list @ [0]>)))) @ Bk\<up>(rn))"
         apply(rule_tac x = "stpa + stpb" in exI, rule_tac x = lnb in exI,
             rule_tac x = rnb in exI, simp add: steps_add tape_of_nl_rev)
         done
     next
       fix ab m n rs args lm
       assume ind2:
         "\<And> m n rs args lm.
          \<lbrakk>lm = <aa # list @ [ab]>; args = aa # list @ [ab]\<rbrakk>
          \<Longrightarrow> \<exists>stp ln rn.
          steps0 (Suc 0, Bk # Bk\<up>(m) @ <ab # rev list @ [aa]> @ Bk # Bk # ires,
          Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
          (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk #
          Bk # Oc\<up>(bl_bin (<aa # list @ [ab]>) + rs * 2 ^ (length (<aa # list @ [ab]>) - Suc 0)) @ Bk\<up>(rn))"
         and k: "args = aa # list @ [Suc ab]" "lm = <aa # list @ [Suc ab]>"
       show "\<exists>stp ln rn.
          steps0 (Suc 0, Bk # Bk\<up>(m) @ <Suc ab # rev list @ [aa]> @ Bk # Bk # ires,
          Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
          (0, Bk # ires,Bk # Oc # Bk\<up>(ln) @ Bk # 
          Bk # Oc\<up>(bl_bin (<aa # list @ [Suc ab]>) + rs * 2 ^ (length (<aa # list @ [Suc ab]>) - Suc 0)) @ Bk\<up>(rn))"
       proof(simp add: tape_of_nl_cons_app1)
         have "\<exists>stp ln rn.
            steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc\<up>(Suc (Suc ab)) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires, 
            Bk # Oc # Oc\<up>(rs) @ Bk\<up>(n)) t_wcode_main stp
            = (Suc 0, Bk # Bk\<up>(ln) @ Oc\<up>(Suc ab) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
            Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rn))"
           using wcode_double_case[of m "Oc\<up>(ab) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires"
               rs n]
           apply(simp add: replicate_Suc)
           done
         from this obtain stpa lna rna where stp1:
           "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc\<up>(Suc (Suc ab)) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires, 
            Bk # Oc # Oc\<up>(rs) @ Bk\<up>(n)) t_wcode_main stpa
            = (Suc 0, Bk # Bk\<up>(lna) @ Oc\<up>(Suc ab) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
            Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rna))" by blast
         from k have 
           "\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(lna) @ <ab # rev list @ [aa]> @ Bk # Bk # ires,
            Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rna)) t_wcode_main stp
            = (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk #
            Bk # Oc\<up>(bl_bin (<aa # list @ [ab]> ) +  (2*rs + 2)* 2^(length (<aa # list @ [ab]>) - Suc 0)) @ Bk\<up>(rn))"
           apply(rule_tac ind2, simp_all)
           done
         from this obtain stpb lnb rnb where stp2: 
           "steps0 (Suc 0, Bk # Bk\<up>(lna) @  <ab # rev list @ [aa]> @ Bk # Bk # ires,
            Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rna)) t_wcode_main stpb
            = (0, Bk # ires, Bk # Oc # Bk\<up>(lnb) @ Bk #
            Bk # Oc\<up>(bl_bin (<aa # list @ [ab]> ) +  (2*rs + 2)* 2^(length (<aa # list @ [ab]>) - Suc 0)) @ Bk\<up>(rnb))" 
           by blast
         from stp1 and stp2 show 
           "\<exists>stp ln rn.
            steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc\<up>(Suc (Suc ab)) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
            Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
            (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # 
            Oc\<up>(bl_bin (Oc\<up>(Suc aa) @ Bk # <list @ [Suc ab]>) + rs * (2 * 2 ^ (aa + length (<list @ [Suc ab]>)))) 
            @ Bk\<up>(rn))"
           apply(rule_tac x = "stpa + stpb" in exI, rule_tac x = lnb in exI,
               rule_tac x = rnb in exI, simp add: steps_add tape_of_nl_cons_app1 replicate_Suc)
           done
       qed
     qed
   qed
 qed
 
 
 definition t_wcode_prepare :: "instr list"
   where
     "t_wcode_prepare \<equiv> 
          [(W1, 2), (L, 1), (L, 3), (R, 2), (R, 4), (W0, 3),
           (R, 4), (R, 5), (R, 6), (R, 5), (R, 7), (R, 5),
           (W1, 7), (L, 0)]"
 
 fun wprepare_add_one :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_add_one m lm (l, r) = 
       (\<exists> rn. l = [] \<and>
                (r = <m # lm> @ Bk\<up>(rn) \<or> 
                 r = Bk # <m # lm> @ Bk\<up>(rn)))"
 
 fun wprepare_goto_first_end :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_goto_first_end m lm (l, r) = 
       (\<exists> ml mr rn. l = Oc\<up>(ml) \<and>
                       r = Oc\<up>(mr) @ Bk # <lm> @ Bk\<up>(rn) \<and>
                       ml + mr = Suc (Suc m))"
 
 fun wprepare_erase :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow>  bool"
   where
     "wprepare_erase m lm (l, r) = 
      (\<exists> rn. l = Oc\<up>(Suc m) \<and> 
                tl r = Bk # <lm> @ Bk\<up>(rn))"
 
 fun wprepare_goto_start_pos_B :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_goto_start_pos_B m lm (l, r) = 
      (\<exists> rn. l = Bk # Oc\<up>(Suc m) \<and>
                r = Bk # <lm> @ Bk\<up>(rn))"
 
 fun wprepare_goto_start_pos_O :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_goto_start_pos_O m lm (l, r) = 
      (\<exists> rn. l = Bk # Bk # Oc\<up>(Suc m) \<and>
                r = <lm> @ Bk\<up>(rn))"
 
 fun wprepare_goto_start_pos :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_goto_start_pos m lm (l, r) = 
        (wprepare_goto_start_pos_B m lm (l, r) \<or>
         wprepare_goto_start_pos_O m lm (l, r))"
 
 fun wprepare_loop_start_on_rightmost :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_loop_start_on_rightmost m lm (l, r) = 
      (\<exists> rn mr. rev l @ r = Oc\<up>(Suc m) @ Bk # Bk # <lm> @ Bk\<up>(rn) \<and> l \<noteq> [] \<and>
                        r = Oc\<up>(mr) @ Bk\<up>(rn))"
 
 fun wprepare_loop_start_in_middle :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_loop_start_in_middle m lm (l, r) =
      (\<exists> rn (mr:: nat) (lm1::nat list). 
   rev l @ r = Oc\<up>(Suc m) @ Bk # Bk # <lm> @ Bk\<up>(rn) \<and> l \<noteq> [] \<and>
   r = Oc\<up>(mr) @ Bk # <lm1> @ Bk\<up>(rn) \<and> lm1 \<noteq> [])"
 
 fun wprepare_loop_start :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_loop_start m lm (l, r) = (wprepare_loop_start_on_rightmost m lm (l, r) \<or> 
                                       wprepare_loop_start_in_middle m lm (l, r))"
 
 fun wprepare_loop_goon_on_rightmost :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_loop_goon_on_rightmost m lm (l, r) = 
      (\<exists> rn. l = Bk # <rev lm> @ Bk # Bk # Oc\<up>(Suc m) \<and>
                r = Bk\<up>(rn))"
 
 fun wprepare_loop_goon_in_middle :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_loop_goon_in_middle m lm (l, r) = 
      (\<exists> rn (mr:: nat) (lm1::nat list). 
   rev l @ r = Oc\<up>(Suc m) @ Bk # Bk # <lm> @ Bk\<up>(rn) \<and> l \<noteq> [] \<and>
                      (if lm1 = [] then r = Oc\<up>(mr) @ Bk\<up>(rn) 
                      else r = Oc\<up>(mr) @ Bk # <lm1> @ Bk\<up>(rn)) \<and> mr > 0)"
 
 fun wprepare_loop_goon :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_loop_goon m lm (l, r) = 
               (wprepare_loop_goon_in_middle m lm (l, r) \<or> 
                wprepare_loop_goon_on_rightmost m lm (l, r))"
 
 fun wprepare_add_one2 :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_add_one2 m lm (l, r) =
           (\<exists> rn. l = Bk # Bk # <rev lm> @ Bk # Bk # Oc\<up>(Suc m) \<and>
                (r = [] \<or> tl r = Bk\<up>(rn)))"
 
 fun wprepare_stop :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_stop m lm (l, r) = 
          (\<exists> rn. l = Bk # <rev lm> @ Bk # Bk # Oc\<up>(Suc m) \<and>
                r = Bk # Oc # Bk\<up>(rn))"
 
 fun wprepare_inv :: "nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wprepare_inv st m lm (l, r) = 
         (if st = 0 then wprepare_stop m lm (l, r) 
          else if st = Suc 0 then wprepare_add_one m lm (l, r)
          else if st = Suc (Suc 0) then wprepare_goto_first_end m lm (l, r)
          else if st = Suc (Suc (Suc 0)) then wprepare_erase m lm (l, r)
          else if st = 4 then wprepare_goto_start_pos m lm (l, r)
          else if st = 5 then wprepare_loop_start m lm (l, r)
          else if st = 6 then wprepare_loop_goon m lm (l, r)
          else if st = 7 then wprepare_add_one2 m lm (l, r)
          else False)"
 
 fun wprepare_stage :: "config \<Rightarrow> nat"
   where
     "wprepare_stage (st, l, r) = 
       (if st \<ge> 1 \<and> st \<le> 4 then 3
        else if st = 5 \<or> st = 6 then 2
        else 1)"
 
 fun wprepare_state :: "config \<Rightarrow> nat"
   where
     "wprepare_state (st, l, r) = 
        (if st = 1 then 4
         else if st = Suc (Suc 0) then 3
         else if st = Suc (Suc (Suc 0)) then 2
         else if st = 4 then 1
         else if st = 7 then 2
         else 0)"
 
 fun wprepare_step :: "config \<Rightarrow> nat"
   where
     "wprepare_step (st, l, r) = 
       (if st = 1 then (if hd r = Oc then Suc (length l)
                        else 0)
        else if st = Suc (Suc 0) then length r
        else if st = Suc (Suc (Suc 0)) then (if hd r = Oc then 1
                             else 0)
        else if st = 4 then length r
        else if st = 5 then Suc (length r)
        else if st = 6 then (if r = [] then 0 else Suc (length r))
        else if st = 7 then (if (r \<noteq> [] \<and> hd r = Oc) then 0
                             else 1)
        else 0)"
 
 fun wcode_prepare_measure :: "config \<Rightarrow> nat \<times> nat \<times> nat"
   where
     "wcode_prepare_measure (st, l, r) = 
      (wprepare_stage (st, l, r), 
       wprepare_state (st, l, r), 
       wprepare_step (st, l, r))"
 
 definition wcode_prepare_le :: "(config \<times> config) set"
   where "wcode_prepare_le \<equiv> (inv_image lex_triple wcode_prepare_measure)"
 
 lemma wf_wcode_prepare_le[intro]: "wf wcode_prepare_le"
   by(auto intro:wf_inv_image simp: wcode_prepare_le_def 
       lex_triple_def)
 
 declare wprepare_add_one.simps[simp del] wprepare_goto_first_end.simps[simp del]
   wprepare_erase.simps[simp del] wprepare_goto_start_pos.simps[simp del]
   wprepare_loop_start.simps[simp del] wprepare_loop_goon.simps[simp del]
   wprepare_add_one2.simps[simp del]
 
 lemmas wprepare_invs = wprepare_add_one.simps wprepare_goto_first_end.simps
   wprepare_erase.simps wprepare_goto_start_pos.simps
   wprepare_loop_start.simps wprepare_loop_goon.simps
   wprepare_add_one2.simps
 
 declare wprepare_inv.simps[simp del]
 
 lemma fetch_t_wcode_prepare[simp]:
   "fetch t_wcode_prepare (Suc 0) Bk = (W1, 2)"
   "fetch t_wcode_prepare (Suc 0) Oc = (L, 1)"
   "fetch t_wcode_prepare (Suc (Suc 0)) Bk = (L, 3)"
   "fetch t_wcode_prepare (Suc (Suc 0)) Oc = (R, 2)"
   "fetch t_wcode_prepare (Suc (Suc (Suc 0))) Bk = (R, 4)"
   "fetch t_wcode_prepare (Suc (Suc (Suc 0))) Oc = (W0, 3)"
   "fetch t_wcode_prepare 4 Bk = (R, 4)"
   "fetch t_wcode_prepare 4 Oc = (R, 5)"
   "fetch t_wcode_prepare 5 Oc = (R, 5)"
   "fetch t_wcode_prepare 5 Bk = (R, 6)"
   "fetch t_wcode_prepare 6 Oc = (R, 5)"
   "fetch t_wcode_prepare 6 Bk = (R, 7)"
   "fetch t_wcode_prepare 7 Oc = (L, 0)"
   "fetch t_wcode_prepare 7 Bk = (W1, 7)"
   unfolding fetch.simps t_wcode_prepare_def nth_of.simps
     numeral by auto
 
 lemma wprepare_add_one_nonempty_snd[simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_add_one m lm (b, []) = False"
   apply(simp add: wprepare_invs)
   done
 
 lemma wprepare_goto_first_end_nonempty_snd[simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_goto_first_end m lm (b, []) = False"
   apply(simp add: wprepare_invs)
   done
 
 lemma wprepare_erase_nonempty_snd[simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_erase m lm (b, []) = False"
   apply(simp add: wprepare_invs)
   done
 
 lemma wprepare_goto_start_pos_nonempty_snd[simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_goto_start_pos m lm (b, []) = False"
   apply(simp add: wprepare_invs)
   done
 
 lemma wprepare_loop_start_empty_nonempty_fst[simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [])\<rbrakk> \<Longrightarrow> b \<noteq> []"
   apply(simp add: wprepare_invs)
   done
 
 lemma rev_eq: "rev xs = rev ys \<Longrightarrow> xs = ys" by auto
 
 lemma wprepare_loop_goon_Bk_empty_snd[simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [])\<rbrakk> \<Longrightarrow> 
                                   wprepare_loop_goon m lm (Bk # b, [])"
   apply(simp only: wprepare_invs)
   apply(erule_tac disjE)
    apply(rule_tac disjI2)
    apply(simp add: wprepare_loop_start_on_rightmost.simps
       wprepare_loop_goon_on_rightmost.simps, auto)
   apply(rule_tac rev_eq, simp add: tape_of_nl_rev)
   done
 
 lemma wprepare_loop_goon_nonempty_fst[simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, [])\<rbrakk> \<Longrightarrow> b \<noteq> []"
   apply(simp only: wprepare_invs, auto)
   done
 
 lemma wprepare_add_one2_Bk_empty[simp]:"\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, [])\<rbrakk> \<Longrightarrow> 
   wprepare_add_one2 m lm (Bk # b, [])"
   apply(simp only: wprepare_invs, auto split: if_splits)
   done
 
 lemma wprepare_add_one2_nonempty_fst[simp]: "wprepare_add_one2 m lm (b, []) \<Longrightarrow> b \<noteq> []"
   apply(simp only: wprepare_invs, auto)
   done
 
 lemma wprepare_add_one2_Oc[simp]: "wprepare_add_one2 m lm (b, []) \<Longrightarrow> wprepare_add_one2 m lm (b, [Oc])"
   apply(simp only: wprepare_invs, auto)
   done
 
 lemma Bk_not_tape_start[simp]: "(Bk # list = <(m::nat) # lm> @ ys) = False"
   apply(case_tac lm, auto simp: tape_of_nl_cons replicate_Suc)
   done
 
 lemma wprepare_goto_first_end_cases[simp]:
   "\<lbrakk>lm \<noteq> []; wprepare_add_one m lm (b, Bk # list)\<rbrakk>
        \<Longrightarrow> (b = [] \<longrightarrow> wprepare_goto_first_end m lm ([], Oc # list)) \<and> 
            (b \<noteq> [] \<longrightarrow> wprepare_goto_first_end m lm (b, Oc # list))"
   apply(simp only: wprepare_invs)
   apply(auto simp: tape_of_nl_cons split: if_splits)
   apply(cases lm, auto simp add:tape_of_list_def replicate_Suc)
   done
 
 lemma wprepare_goto_first_end_Bk_nonempty_fst[simp]:
   "wprepare_goto_first_end m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
   apply(simp only: wprepare_invs , auto simp: replicate_Suc)
   done
 
 declare replicate_Suc[simp]
 
 lemma wprepare_erase_elem_Bk_rest[simp]: "wprepare_goto_first_end m lm (b, Bk # list) \<Longrightarrow>
                           wprepare_erase m lm (tl b, hd b # Bk # list)"
   by(simp add: wprepare_invs)
 
 lemma wprepare_erase_Bk_nonempty_fst[simp]: "wprepare_erase m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
   by(simp add: wprepare_invs)
 
 lemma wprepare_goto_start_pos_Bk[simp]: "wprepare_erase m lm (b, Bk # list) \<Longrightarrow> 
                            wprepare_goto_start_pos m lm (Bk # b, list)"
   apply(simp only: wprepare_invs, auto)
   done
 
 lemma wprepare_add_one_Bk_nonempty_snd[simp]: "\<lbrakk>wprepare_add_one m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
   apply(simp only: wprepare_invs)
   apply(case_tac lm, simp_all add: tape_of_list_def tape_of_nat_def, auto)
   done
 
 lemma wprepare_goto_first_end_nonempty_snd_tl[simp]:
   "\<lbrakk>lm \<noteq> [];  wprepare_goto_first_end m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
   by(simp only: wprepare_invs, auto)
 
 lemma wprepare_erase_Bk_nonempty_list[simp]: "\<lbrakk>lm \<noteq> []; wprepare_erase m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
   apply(simp only: wprepare_invs, auto)
   done
 
 
 lemma wprepare_goto_start_pos_Bk_nonempty[simp]: "\<lbrakk>lm \<noteq> [];  wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
   by(cases lm;cases list;simp only: wprepare_invs, auto)
 
 lemma wprepare_goto_start_pos_Bk_nonempty_fst[simp]: "\<lbrakk>lm \<noteq> [];  wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
   apply(simp only: wprepare_invs)
   apply(auto)
   done
 
 lemma wprepare_loop_goon_Bk_nonempty[simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
   apply(simp only: wprepare_invs, auto)
   done
 
 lemma wprepare_loop_goon_wprepare_add_one2_cases[simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> 
   (list = [] \<longrightarrow> wprepare_add_one2 m lm (Bk # b, [])) \<and> 
   (list \<noteq> [] \<longrightarrow> wprepare_add_one2 m lm (Bk # b, list))"
   unfolding wprepare_invs
   apply(cases list;auto split:nat.split if_splits)
   by (metis list.sel(3) tl_replicate)
 
 lemma wprepare_add_one2_nonempty[simp]: "wprepare_add_one2 m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
   apply(simp only: wprepare_invs, simp)
   done
 
 lemma wprepare_add_one2_cases[simp]: "wprepare_add_one2 m lm (b, Bk # list) \<Longrightarrow> 
       (list = [] \<longrightarrow> wprepare_add_one2 m lm (b, [Oc])) \<and> 
       (list \<noteq> [] \<longrightarrow> wprepare_add_one2 m lm (b, Oc # list))"
   apply(simp only:  wprepare_invs, auto)
   done
 
 lemma wprepare_goto_first_end_cases_Oc[simp]: "wprepare_goto_first_end m lm (b, Oc # list)
        \<Longrightarrow> (b = [] \<longrightarrow> wprepare_goto_first_end m lm ([Oc], list)) \<and> 
            (b \<noteq> [] \<longrightarrow> wprepare_goto_first_end m lm (Oc # b, list))"
   apply(simp only:  wprepare_invs, auto)
    apply(rule_tac x = 1 in exI, auto) apply(rename_tac ml mr rn)
   apply(case_tac mr, simp_all add: )
   apply(case_tac ml, simp_all add: )
   apply(rule_tac x = "Suc ml" in exI, simp_all add: )
   apply(rule_tac x = "mr - 1" in exI, simp)
   done
 
 lemma wprepare_erase_nonempty[simp]: "wprepare_erase m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
   apply(simp only: wprepare_invs, auto simp: )
   done
 
 lemma wprepare_erase_Bk[simp]: "wprepare_erase m lm (b, Oc # list)
   \<Longrightarrow> wprepare_erase m lm (b, Bk # list)"
   apply(simp  only:wprepare_invs, auto simp: )
   done
 
 lemma wprepare_goto_start_pos_Bk_move[simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk>
        \<Longrightarrow> wprepare_goto_start_pos m lm (Bk # b, list)"
   apply(simp only:wprepare_invs, auto)
           apply(case_tac [!] lm, simp, simp_all)
   done
 
 lemma wprepare_loop_start_b_nonempty[simp]: "wprepare_loop_start m lm (b, aa) \<Longrightarrow> b \<noteq> []"
   apply(simp only:wprepare_invs, auto)
   done
 lemma exists_exp_of_Bk[elim]: "Bk # list = Oc\<up>(mr) @ Bk\<up>(rn)  \<Longrightarrow> \<exists>rn. list = Bk\<up>(rn)"
   apply(case_tac mr, simp_all)
   apply(case_tac rn, simp_all)
   done
 
 lemma wprepare_loop_start_in_middle_Bk_False[simp]: "wprepare_loop_start_in_middle m lm (b, [Bk]) = False"
   by(auto)
 
 declare wprepare_loop_start_in_middle.simps[simp del]
 
 declare wprepare_loop_start_on_rightmost.simps[simp del] 
   wprepare_loop_goon_in_middle.simps[simp del]
   wprepare_loop_goon_on_rightmost.simps[simp del]
 
 lemma wprepare_loop_goon_in_middle_Bk_False[simp]: "wprepare_loop_goon_in_middle m lm (Bk # b, []) = False"
   apply(simp add: wprepare_loop_goon_in_middle.simps, auto)
   done
 
 lemma wprepare_loop_goon_Bk[simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [Bk])\<rbrakk> \<Longrightarrow>
   wprepare_loop_goon m lm (Bk # b, [])"
   unfolding wprepare_invs
   apply(auto simp add: wprepare_loop_goon_on_rightmost.simps 
       wprepare_loop_start_on_rightmost.simps)
   apply(rule_tac rev_eq)
   apply(simp add: tape_of_nl_rev)
   apply(simp add: exp_ind replicate_Suc[THEN sym] del: replicate_Suc)
   done
 
 lemma wprepare_loop_goon_in_middle_Bk_False2[simp]: "wprepare_loop_start_on_rightmost m lm (b, Bk # a # lista)
  \<Longrightarrow> wprepare_loop_goon_in_middle m lm (Bk # b, a # lista) = False"
   apply(auto simp: wprepare_loop_start_on_rightmost.simps
       wprepare_loop_goon_in_middle.simps)
   done
 
 lemma wprepare_loop_goon_on_rightbmost_Bk_False[simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start_on_rightmost m lm (b, Bk # a # lista)\<rbrakk>
     \<Longrightarrow> wprepare_loop_goon_on_rightmost m lm (Bk # b, a # lista)"
   apply(simp only: wprepare_loop_start_on_rightmost.simps
       wprepare_loop_goon_on_rightmost.simps, auto simp: tape_of_nl_rev)
    apply(simp add: replicate_Suc[THEN sym] exp_ind tape_of_nl_rev del: replicate_Suc)
   by (meson Cons_replicate_eq)
 
 
 lemma wprepare_loop_goon_in_middle_Bk_False3[simp]: 
   assumes "lm \<noteq> []" "wprepare_loop_start_in_middle m lm (b, Bk # a # lista)"
   shows "wprepare_loop_goon_in_middle m lm (Bk # b, a # lista)" (is "?t1")
     and "wprepare_loop_goon_on_rightmost m lm (Bk # b, a # lista) = False" (is ?t2)
 proof -
   from assms obtain rn mr lm1 where *:"rev b @ Oc \<up> mr @ Bk # <lm1> = Oc # Oc \<up> m @ Bk # Bk # <lm>"
     "b \<noteq> []" "Bk # a # lista = Oc \<up> mr @ Bk # <lm1::nat list> @ Bk \<up> rn" "lm1 \<noteq> []"
     by(auto simp add: wprepare_loop_start_in_middle.simps)
   thus ?t1 apply(simp add: wprepare_loop_start_in_middle.simps
         wprepare_loop_goon_in_middle.simps, auto)
     apply(rule_tac x = rn in exI, simp)
     apply(case_tac mr, simp_all add: )
     apply(case_tac lm1, simp)
     apply(rule_tac x = "Suc (hd lm1)" in exI, simp)
     apply(rule_tac x = "tl lm1" in exI)
     apply(case_tac "tl lm1", simp_all add: tape_of_list_def  tape_of_nat_def)
     done
   from * show ?t2 
     apply(simp add: wprepare_loop_start_in_middle.simps
         wprepare_loop_goon_on_rightmost.simps del:split_head_repeat, auto simp del:split_head_repeat)
      apply(case_tac mr)
       apply(case_tac  "lm1::nat list", simp_all, case_tac "tl lm1", simp_all)
       apply(auto simp add: tape_of_list_def )
       apply(case_tac [!] rna, simp_all add: )
      apply(case_tac mr, simp_all add: )
      apply(case_tac lm1, simp, case_tac list, simp)
      apply(simp_all add: tape_of_nat_def)
     by (metis Bk_not_tape_start tape_of_list_def tape_of_nat_list.elims)
 qed
 
 lemma wprepare_loop_goon_Bk2[simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, Bk # a # lista)\<rbrakk> \<Longrightarrow> 
   wprepare_loop_goon m lm (Bk # b, a # lista)"
   apply(simp add: wprepare_loop_start.simps 
       wprepare_loop_goon.simps)
   apply(erule_tac disjE, simp, auto)
   done
 
 lemma start_2_goon:
   "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, Bk # list)\<rbrakk> \<Longrightarrow>
    (list = [] \<longrightarrow> wprepare_loop_goon m lm (Bk # b, [])) \<and>
   (list \<noteq> [] \<longrightarrow> wprepare_loop_goon m lm (Bk # b, list))"
   apply(case_tac list, auto)
   done
 
 lemma add_one_2_add_one: "wprepare_add_one m lm (b, Oc # list)
   \<Longrightarrow> (hd b = Oc \<longrightarrow> (b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)) \<and>
                      (b \<noteq> [] \<longrightarrow> wprepare_add_one m lm (tl b, Oc # Oc # list))) \<and>
   (hd b \<noteq> Oc \<longrightarrow> (b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)) \<and>
                  (b \<noteq> [] \<longrightarrow> wprepare_add_one m lm (tl b, hd b # Oc # list)))"
   unfolding wprepare_add_one.simps by auto
 
 lemma wprepare_loop_start_on_rightmost_Oc[simp]: "wprepare_loop_start_on_rightmost m lm (b, Oc # list) \<Longrightarrow> 
   wprepare_loop_start_on_rightmost m lm (Oc # b, list)"
   apply(simp add: wprepare_loop_start_on_rightmost.simps)
   by (metis Cons_replicate_eq cell.distinct(1) list.sel(3) self_append_conv2 tl_append2 tl_replicate)
 
 lemma wprepare_loop_start_in_middle_Oc[simp]:
   assumes "wprepare_loop_start_in_middle m lm (b, Oc # list)"
   shows "wprepare_loop_start_in_middle m lm (Oc # b, list)"
 proof -
   from assms obtain mr lm1 rn
     where "rev b @ Oc \<up> mr @ Bk # <lm1::nat list> = Oc # Oc \<up> m @ Bk # Bk # <lm>"
       "Oc # list = Oc \<up> mr @ Bk # <lm1> @ Bk \<up> rn" "lm1 \<noteq> []"
     by(auto simp add: wprepare_loop_start_in_middle.simps)
   thus ?thesis 
     apply(auto simp add: wprepare_loop_start_in_middle.simps)
     apply(rule_tac x = rn in exI, auto)
     apply(case_tac mr, simp, simp add: )
     apply(rule_tac x = "mr - 1" in exI, simp)
     apply(rule_tac x = lm1 in exI, simp)
     done
 qed
 
 lemma start_2_start: "wprepare_loop_start m lm (b, Oc # list) \<Longrightarrow> 
        wprepare_loop_start m lm (Oc # b, list)"
   apply(simp add: wprepare_loop_start.simps)
   apply(erule_tac disjE, simp_all )
   done
 
 lemma wprepare_loop_goon_Oc_nonempty[simp]: "wprepare_loop_goon m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
   apply(simp add: wprepare_loop_goon.simps     
       wprepare_loop_goon_in_middle.simps 
       wprepare_loop_goon_on_rightmost.simps)
   apply(auto)
   done
 
 lemma wprepare_goto_start_pos_Oc_nonempty[simp]: "wprepare_goto_start_pos m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
   apply(simp add: wprepare_goto_start_pos.simps)
   done
 
 lemma wprepare_loop_goon_on_rightmost_Oc_False[simp]: "wprepare_loop_goon_on_rightmost m lm (b, Oc # list) = False"
   apply(simp add: wprepare_loop_goon_on_rightmost.simps)
   done
 
 lemma wprepare_loop1: "\<lbrakk>rev b @ Oc\<up>(mr) =  Oc\<up>(Suc m) @ Bk # Bk # <lm>; 
          b \<noteq> []; 0 < mr; Oc # list = Oc\<up>(mr) @ Bk\<up>(rn)\<rbrakk>
        \<Longrightarrow> wprepare_loop_start_on_rightmost m lm (Oc # b, list)"
   apply(simp add: wprepare_loop_start_on_rightmost.simps)
   apply(rule_tac x = rn in exI, simp)
   apply(case_tac mr, simp, simp)
   done
 
 lemma wprepare_loop2: "\<lbrakk>rev b @ Oc\<up>(mr) @ Bk # <a # lista> = Oc\<up>(Suc m) @ Bk # Bk # <lm>;
                 b \<noteq> []; Oc # list = Oc\<up>(mr) @ Bk # <(a::nat) # lista> @ Bk\<up>(rn)\<rbrakk>
        \<Longrightarrow>  wprepare_loop_start_in_middle m lm (Oc # b, list)"
   apply(simp add: wprepare_loop_start_in_middle.simps)
   apply(rule_tac x = rn in exI, simp)
   apply(case_tac mr, simp_all add: ) apply(rename_tac nat)
   apply(rule_tac x = nat in exI, simp)
   apply(rule_tac x = "a#lista" in exI, simp)
   done
 
 lemma wprepare_loop_goon_in_middle_cases[simp]: "wprepare_loop_goon_in_middle m lm (b, Oc # list) \<Longrightarrow>
                 wprepare_loop_start_on_rightmost m lm (Oc # b, list) \<or>
                 wprepare_loop_start_in_middle m lm (Oc # b, list)"
   apply(simp add: wprepare_loop_goon_in_middle.simps split: if_splits) apply(rename_tac lm1)
   apply(case_tac lm1, simp_all add: wprepare_loop1 wprepare_loop2)
   done
 
 lemma wprepare_add_one_b[simp]: "wprepare_add_one m lm (b, Oc # list)
        \<Longrightarrow> b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)"
   "wprepare_loop_goon m lm (b, Oc # list)
   \<Longrightarrow>  wprepare_loop_start m lm (Oc # b, list)"
    apply(auto simp add: wprepare_add_one.simps wprepare_loop_goon.simps
       wprepare_loop_start.simps)
   done
 
 lemma wprepare_loop_start_on_rightmost_Oc2[simp]: "wprepare_goto_start_pos m [a] (b, Oc # list)
               \<Longrightarrow> wprepare_loop_start_on_rightmost m [a] (Oc # b, list) "
   apply(auto simp: wprepare_goto_start_pos.simps 
       wprepare_loop_start_on_rightmost.simps) apply(rename_tac rn)
   apply(rule_tac x = rn in exI, simp)
   apply(simp add: replicate_Suc[THEN sym] exp_ind del: replicate_Suc)
   done
 
 lemma wprepare_loop_start_in_middle_2_Oc[simp]:  "wprepare_goto_start_pos m (a # aa # listaa) (b, Oc # list)
        \<Longrightarrow>wprepare_loop_start_in_middle m (a # aa # listaa) (Oc # b, list)"
   apply(auto simp: wprepare_goto_start_pos.simps
       wprepare_loop_start_in_middle.simps) apply(rename_tac rn)
   apply(rule_tac x = rn in exI, simp)
   apply(simp add: exp_ind[THEN sym])
   apply(rule_tac x = a in exI, rule_tac x = "aa#listaa" in exI, simp)
   apply(simp add: tape_of_nl_cons)
   done
 
 lemma wprepare_loop_start_Oc2[simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Oc # list)\<rbrakk>
        \<Longrightarrow> wprepare_loop_start m lm (Oc # b, list)"
   by(cases lm;cases "tl lm", auto simp add: wprepare_loop_start.simps)
 
 lemma wprepare_add_one2_Oc_nonempty[simp]: "wprepare_add_one2 m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
   apply(auto simp: wprepare_add_one2.simps)
   done
 
 lemma add_one_2_stop:
   "wprepare_add_one2 m lm (b, Oc # list)      
   \<Longrightarrow>  wprepare_stop m lm (tl b, hd b # Oc # list)"
   apply(simp add: wprepare_add_one2.simps)
   done
 
 declare wprepare_stop.simps[simp del]
 
 lemma wprepare_correctness:
   assumes h: "lm \<noteq> []"
   shows "let P = (\<lambda> (st, l, r). st = 0) in 
   let Q = (\<lambda> (st, l, r). wprepare_inv st m lm (l, r)) in 
   let f = (\<lambda> stp. steps0 (Suc 0, [], (<m # lm>)) t_wcode_prepare stp) in
     \<exists> n .P (f n) \<and> Q (f n)"
 proof -
   let ?P = "(\<lambda> (st, l, r). st = 0)"
   let ?Q = "(\<lambda> (st, l, r). wprepare_inv st m lm (l, r))"
   let ?f = "(\<lambda> stp. steps0 (Suc 0, [], (<m # lm>)) t_wcode_prepare stp)"
   have "\<exists> n. ?P (?f n) \<and> ?Q (?f n)"
   proof(rule_tac halt_lemma2)
     show "\<forall> n. \<not> ?P (?f n) \<and> ?Q (?f n) \<longrightarrow> 
                  ?Q (?f (Suc n)) \<and> (?f (Suc n), ?f n) \<in> wcode_prepare_le"
       using h
       apply(rule_tac allI, rule_tac impI) apply(rename_tac n)
       apply(case_tac "?f n", simp add: step.simps) apply(rename_tac c)
       apply(case_tac c, simp, case_tac [2] aa)
         apply(simp_all add: wprepare_inv.simps wcode_prepare_le_def lex_triple_def lex_pair_def
           split: if_splits) (* slow *)
          apply(simp_all add: start_2_goon  start_2_start
           add_one_2_add_one add_one_2_stop)
       apply(auto simp: wprepare_add_one2.simps)
       done
   qed (auto simp add: steps.simps wprepare_inv.simps wprepare_invs)
   thus "?thesis"
     apply(auto)
     done
 qed
 
 lemma tm_wf_t_wcode_prepare[intro]: "tm_wf (t_wcode_prepare, 0)"
   apply(simp add:tm_wf.simps t_wcode_prepare_def)
   done
 
 lemma is_28_even[intro]: "(28 + (length t_twice_compile + length t_fourtimes_compile)) mod 2 = 0"
   by(auto simp: t_twice_compile_def t_fourtimes_compile_def)
 
 lemma b_le_28[elim]: "(a, b) \<in> set t_wcode_main_first_part \<Longrightarrow>
   b \<le> (28 + (length t_twice_compile + length t_fourtimes_compile)) div 2"
   apply(auto simp: t_wcode_main_first_part_def t_twice_def)
   done
 
 
 
 lemma tm_wf_change_termi:
   assumes "tm_wf (tp, 0)"
   shows "list_all (\<lambda>(acn, st). (st \<le> Suc (length tp div 2))) (adjust0 tp)"
 proof -
   { fix acn st n
     assume "tp ! n = (acn, st)" "n < length tp" "0 < st"
     hence "(acn, st)\<in>set tp" by (metis nth_mem)
     with assms tm_wf.simps have "st \<le> length tp div 2 + 0" by auto
     hence "st \<le> Suc (length tp div 2)" by auto
   }
   thus ?thesis
     by(auto simp: tm_wf.simps List.list_all_length adjust.simps split: if_splits prod.split)
 qed
 
 lemma tm_wf_shift:
   assumes "list_all (\<lambda>(acn, st). (st \<le> y)) tp"
   shows "list_all (\<lambda>(acn, st). (st \<le> y + off)) (shift tp off)"
 proof -
   have [dest!]:"\<And> P Q n. \<forall>n. Q n \<longrightarrow> P n \<Longrightarrow> Q n \<Longrightarrow> P n" by metis
   from assms show ?thesis by(auto simp: tm_wf.simps List.list_all_length shift.simps)
 qed
 
 declare length_tp'[simp del]
 
 lemma length_mopup_1[simp]: "length (mopup (Suc 0)) = 16"
   apply(auto simp: mopup.simps)
   done
 
 lemma twice_plus_28_elim[elim]: "(a, b) \<in> set (shift (adjust0 t_twice_compile) 12) \<Longrightarrow> 
   b \<le> (28 + (length t_twice_compile + length t_fourtimes_compile)) div 2"
   apply(simp add: t_twice_compile_def t_fourtimes_compile_def)
 proof -
   assume g: "(a, b)
     \<in> set (shift
             (adjust
               (tm_of abc_twice @
                shift (mopup (Suc 0)) (length (tm_of abc_twice) div 2))
               (Suc ((length (tm_of abc_twice) + 16) div 2)))
             12)"
   moreover have "length (tm_of abc_twice) mod 2 = 0" by auto
   moreover have "length (tm_of abc_fourtimes) mod 2 = 0" by auto
   ultimately have "list_all (\<lambda>(acn, st). (st \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2)) 
     (shift (adjust0 t_twice_compile) 12)"
   proof(auto simp add: mod_ex1 del: adjust.simps)
     assume "even (length (tm_of abc_twice))"
     then obtain q where q:"length (tm_of abc_twice) = 2 * q" by auto
     assume "even (length (tm_of abc_fourtimes))"
     then obtain qa where qa:"length (tm_of abc_fourtimes) = 2 * qa" by auto
     note h = q qa
     hence "list_all (\<lambda>(acn, st). st \<le> (18 + (q + qa)) + 12) (shift (adjust0 t_twice_compile) 12)"
     proof(rule_tac tm_wf_shift t_twice_compile_def)
       have "list_all (\<lambda>(acn, st). st \<le> Suc (length t_twice_compile div 2)) (adjust0 t_twice_compile)"
         by(rule_tac tm_wf_change_termi, auto)
       thus "list_all (\<lambda>(acn, st). st \<le> 18 + (q + qa)) (adjust0 t_twice_compile)"
         using h
         apply(simp add: t_twice_compile_def, auto simp: List.list_all_length)
         done
     qed
     thus "list_all (\<lambda>(acn, st). st \<le> 30 + (length (tm_of abc_twice) div 2 + length (tm_of abc_fourtimes) div 2))
      (shift (adjust0 t_twice_compile) 12)" using h
       by simp
   qed
   thus "b \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2"
     using g
     apply(auto simp:t_twice_compile_def)
     apply(simp add: Ball_set[THEN sym])
     apply(erule_tac x = "(a, b)" in ballE, simp, simp)
     done
 qed 
 
 lemma length_plus_28_elim2[elim]: "(a, b) \<in> set (shift (adjust0 t_fourtimes_compile) (t_twice_len + 13)) 
   \<Longrightarrow> b \<le> (28 + (length t_twice_compile + length t_fourtimes_compile)) div 2"
   apply(simp add: t_twice_compile_def t_fourtimes_compile_def t_twice_len_def)
 proof -
   assume g: "(a, b)
     \<in> set (shift
              (adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) (length (tm_of abc_fourtimes) div 2))
                (Suc ((length (tm_of abc_fourtimes) + 16) div 2)))
              (length t_twice div 2 + 13))"
   moreover have "length (tm_of abc_twice) mod 2 = 0" by auto
   moreover have "length (tm_of abc_fourtimes) mod 2 = 0" by auto
   ultimately have "list_all (\<lambda>(acn, st). (st \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2)) 
     (shift (adjust0 (tm_of abc_fourtimes @ shift (mopup (Suc 0))
     (length (tm_of abc_fourtimes) div 2))) (length t_twice div 2 + 13))"
   proof(auto simp: mod_ex1 t_twice_def t_twice_compile_def)
     assume "even (length (tm_of abc_twice))"
     then obtain q where q:"length (tm_of abc_twice) = 2 * q" by auto
     assume "even (length (tm_of abc_fourtimes))"
     then obtain qa where qa:"length (tm_of abc_fourtimes) = 2 * qa" by auto
     note h = q qa
     hence "list_all (\<lambda>(acn, st). st \<le> (9 + qa + (21 + q)))
       (shift (adjust0 (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa)) (21 + q))"
     proof(rule_tac tm_wf_shift t_twice_compile_def)
       have "list_all (\<lambda>(acn, st). st \<le> Suc (length (tm_of abc_fourtimes @ shift 
         (mopup (Suc 0)) qa) div 2)) (adjust0 (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa))"
         apply(rule_tac tm_wf_change_termi)
         using wf_fourtimes h
         apply(simp add: t_fourtimes_compile_def)
         done
       thus "list_all (\<lambda>(acn, st). st \<le> 9 + qa)
         (adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa)
           (Suc (length (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa) div
                 2)))"
         using h
         apply(simp)
         done
     qed
     thus "list_all
      (\<lambda>(acn, st). st \<le> 30 + (length (tm_of abc_twice) div 2 + length (tm_of abc_fourtimes) div 2))
      (shift
        (adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) (length (tm_of abc_fourtimes) div 2))
          (9 + length (tm_of abc_fourtimes) div 2))
        (21 + length (tm_of abc_twice) div 2))"
       apply(subgoal_tac "qa + q = q + qa")
        apply(simp add: h)
       apply(simp)
       done
   qed
   thus "b \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2"
     using g
     apply(simp add: Ball_set[THEN sym])
     apply(erule_tac x = "(a, b)" in ballE, simp, simp)
     done
 qed
 
 lemma tm_wf_t_wcode_main[intro]: "tm_wf (t_wcode_main, 0)"
   by(auto simp: t_wcode_main_def tm_wf.simps
       t_twice_def t_fourtimes_def del: List.list_all_iff)
 
 declare tm_comp.simps[simp del]
 
 lemma prepare_mainpart_lemma:
   "args \<noteq> [] \<Longrightarrow> 
   \<exists> stp ln rn. steps0 (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) stp
               = (0,  Bk # Oc\<up>(Suc m), Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<args>)) @ Bk\<up>(rn))"
 proof -
   let ?P1 = "(\<lambda> (l, r). (l::cell list) = [] \<and> r = <m # args>)"
   let ?Q1 = "(\<lambda> (l, r). wprepare_stop m args (l, r))"
   let ?P2 = ?Q1
   let ?Q2 = "(\<lambda> (l, r). (\<exists> ln rn. l = Bk # Oc\<up>(Suc m) \<and>
                            r =  Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<args>)) @ Bk\<up>(rn)))"
   let ?P3 = "\<lambda> tp. False"
   assume h: "args \<noteq> []"
   have "{?P1} t_wcode_prepare |+| t_wcode_main {?Q2}"
   proof(rule_tac Hoare_plus_halt)
     show "{?P1} t_wcode_prepare {?Q1}"
     proof(rule_tac Hoare_haltI, auto)
       show "\<exists>n. is_final (steps0 (Suc 0, [], <m # args>) t_wcode_prepare n) \<and>
         wprepare_stop m args holds_for steps0 (Suc 0, [], <m # args>) t_wcode_prepare n"
         using wprepare_correctness[of args m,OF h]
         apply(auto simp add: wprepare_inv.simps)
         by (metis holds_for.simps is_finalI)
     qed
   next
     show "{?P2} t_wcode_main {?Q2}"
     proof(rule_tac Hoare_haltI, auto)
       fix l r
       assume "wprepare_stop m args (l, r)"
       thus "\<exists>n. is_final (steps0 (Suc 0, l, r) t_wcode_main n) \<and>
               (\<lambda>(l, r). l = Bk # Oc # Oc \<up> m \<and> (\<exists>ln rn. r = Bk # Oc # Bk \<up> ln @ 
         Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn)) holds_for steps0 (Suc 0, l, r) t_wcode_main n"
       proof(auto simp: wprepare_stop.simps)
         fix rn
         show " \<exists>n. is_final (steps0 (Suc 0, Bk # <rev args> @ Bk # Bk # Oc # Oc \<up> m, Bk # Oc # Bk \<up> rn) t_wcode_main n) \<and>
           (\<lambda>(l, r). l = Bk # Oc # Oc \<up> m \<and>
           (\<exists>ln rn. r = Bk # Oc # Bk \<up> ln @
           Bk # Bk # Oc \<up> bl_bin (<args>) @
           Bk \<up> rn)) holds_for steps0 (Suc 0, Bk # <rev args> @ Bk # Bk # Oc # Oc \<up> m, Bk # Oc # Bk \<up> rn) t_wcode_main n"
           using t_wcode_main_lemma_pre[of "args" "<args>" 0 "Oc\<up>(Suc m)" 0 rn,OF h refl]
           apply(auto simp: tape_of_nl_rev)
           apply(rename_tac stp ln rna)
           apply(rule_tac x = stp in exI, auto)
           done
       qed
     qed
   next
     show "tm_wf0 t_wcode_prepare"
       by auto
   qed
   then obtain n 
     where "\<And> tp. (case tp of (l, r) \<Rightarrow> l = [] \<and> r = <m # args>) \<longrightarrow>
        (is_final (steps0 (1, tp) (t_wcode_prepare |+| t_wcode_main) n) \<and>
             (\<lambda>(l, r).
                 \<exists>ln rn.
                    l = Bk # Oc \<up> Suc m \<and>
                    r = Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) holds_for steps0 (1, tp) (t_wcode_prepare |+| t_wcode_main) n)"
     unfolding Hoare_halt_def by auto
   thus "?thesis"
     apply(rule_tac x = n in exI)
     apply(case_tac "(steps0 (Suc 0, [], <m # args>)
       (adjust0 t_wcode_prepare @ shift t_wcode_main (length t_wcode_prepare div 2)) n)")
     apply(auto simp: tm_comp.simps)
     done
 qed
 
 definition tinres :: "cell list \<Rightarrow> cell list \<Rightarrow> bool"
   where
     "tinres xs ys = (\<exists>n. xs = ys @ Bk \<up> n \<or> ys = xs @ Bk \<up> n)"
 
 lemma tinres_fetch_congr[simp]:  "tinres r r' \<Longrightarrow> 
   fetch t ss (read r) = 
   fetch t ss (read r')"
   apply(simp add: fetch.simps, auto split: if_splits simp: tinres_def)
   using hd_replicate apply fastforce
   using hd_replicate apply fastforce
   done
 
 lemma nonempty_hd_tinres[simp]: "\<lbrakk>tinres r r'; r \<noteq> []; r' \<noteq> []\<rbrakk> \<Longrightarrow> hd r = hd r'"
   apply(auto simp: tinres_def)
   done
 
 lemma tinres_nonempty[simp]:
   "\<lbrakk>tinres r []; r \<noteq> []\<rbrakk> \<Longrightarrow> hd r = Bk"
   "\<lbrakk>tinres [] r'; r' \<noteq> []\<rbrakk> \<Longrightarrow> hd r' = Bk"
   "\<lbrakk>tinres r [];  r \<noteq> []\<rbrakk> \<Longrightarrow> tinres (tl r) []"
   "tinres r r' \<Longrightarrow> tinres (b # r) (b # r')"
   by(auto simp: tinres_def)
 
 lemma ex_move_tl[intro]: "\<exists>na. tl r = tl (r @ Bk\<up>(n)) @ Bk\<up>(na) \<or> tl (r @ Bk\<up>(n)) = tl r @ Bk\<up>(na)"
   apply(case_tac r, simp)
   by(case_tac n, auto)
 
 lemma tinres_tails[simp]: "tinres r r' \<Longrightarrow> tinres (tl r) (tl r')"
   apply(auto simp: tinres_def)
   by(case_tac r', auto)
 
 lemma tinres_empty[simp]: 
   "\<lbrakk>tinres [] r'\<rbrakk> \<Longrightarrow> tinres [] (tl r')"
   "tinres r [] \<Longrightarrow> tinres (Bk # tl r) [Bk]"
   "tinres r [] \<Longrightarrow> tinres (Oc # tl r) [Oc]"
   by(auto simp: tinres_def)
 
 lemma tinres_step2:
   assumes "tinres r r'" "step0 (ss, l, r) t = (sa, la, ra)" "step0 (ss, l, r') t = (sb, lb, rb)"
   shows "la = lb \<and> tinres ra rb \<and> sa = sb"
 proof (cases "fetch t ss (read r')")
   case (Pair a b)
   have sa:"sa = sb" using assms Pair by(force simp: step.simps)
   have "la = lb \<and> tinres ra rb" using assms Pair
     by(cases a, auto simp: step.simps split: if_splits)
   thus ?thesis using sa by auto
 qed
 
 lemma tinres_steps2: 
   "\<lbrakk>tinres r r'; steps0 (ss, l, r) t stp = (sa, la, ra); steps0 (ss, l, r') t stp = (sb, lb, rb)\<rbrakk>
     \<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
 proof(induct stp arbitrary: sa la ra sb lb rb)
   case (Suc stp sa la ra sb lb rb)
   then show ?case 
     apply(simp)
     apply(case_tac "(steps0 (ss, l, r) t stp)")
     apply(case_tac "(steps0 (ss, l, r') t stp)")
   proof -
     fix stp a b c aa ba ca
     assume ind: "\<And>sa la ra sb lb rb. \<lbrakk>steps0 (ss, l, r) t stp = (sa, la, ra); 
     steps0 (ss, l, r') t stp = (sb, lb, rb)\<rbrakk> \<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
       and h: " tinres r r'" "step0 (steps0 (ss, l, r) t stp) t = (sa, la, ra)"
       "step0 (steps0 (ss, l, r') t stp) t = (sb, lb, rb)" "steps0 (ss, l, r) t stp = (a, b, c)" 
       "steps0 (ss, l, r') t stp = (aa, ba, ca)"
     have "b = ba \<and> tinres c ca \<and> a = aa"
       apply(rule_tac ind, simp_all add: h)
       done
     thus "la = lb \<and> tinres ra rb \<and> sa = sb"
       apply(rule_tac l = b  and r = c  and ss = a and r' = ca   
           and t = t in tinres_step2)
       using h
         apply(simp, simp, simp)
       done
   qed
 qed (simp add: steps.simps)
 
 
 definition t_wcode_adjust :: "instr list"
   where
     "t_wcode_adjust = [(W1, 1), (R, 2), (Nop, 2), (R, 3), (R, 3), (R, 4), 
                    (L, 8), (L, 5), (L, 6), (W0, 5), (L, 6), (R, 7), 
                    (W1, 2), (Nop, 7), (L, 9), (W0, 8), (L, 9), (L, 10), 
                     (L, 11), (L, 10), (R, 0), (L, 11)]"
 
 lemma fetch_t_wcode_adjust[simp]:
   "fetch t_wcode_adjust (Suc 0) Bk = (W1, 1)"
   "fetch t_wcode_adjust (Suc 0) Oc = (R, 2)"
   "fetch t_wcode_adjust (Suc (Suc 0)) Oc = (R, 3)"
   "fetch t_wcode_adjust (Suc (Suc (Suc 0))) Oc = (R, 4)"
   "fetch t_wcode_adjust  (Suc (Suc (Suc 0))) Bk = (R, 3)"
   "fetch t_wcode_adjust 4 Bk = (L, 8)"
   "fetch t_wcode_adjust 4 Oc = (L, 5)"
   "fetch t_wcode_adjust 5 Oc = (W0, 5)"
   "fetch t_wcode_adjust 5 Bk = (L, 6)"
   "fetch t_wcode_adjust 6 Oc = (R, 7)"
   "fetch t_wcode_adjust 6 Bk = (L, 6)"
   "fetch t_wcode_adjust 7 Bk = (W1, 2)"
   "fetch t_wcode_adjust 8 Bk = (L, 9)"
   "fetch t_wcode_adjust 8 Oc = (W0, 8)"
   "fetch t_wcode_adjust 9 Oc = (L, 10)"
   "fetch t_wcode_adjust 9 Bk = (L, 9)"
   "fetch t_wcode_adjust 10 Bk = (L, 11)"
   "fetch t_wcode_adjust 10 Oc = (L, 10)"
   "fetch t_wcode_adjust 11 Oc = (L, 11)"
   "fetch t_wcode_adjust 11 Bk = (R, 0)"
   by(auto simp: fetch.simps t_wcode_adjust_def nth_of.simps numeral)
 
 
 fun wadjust_start :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_start m rs (l, r) = 
          (\<exists> ln rn. l = Bk # Oc\<up>(Suc m) \<and>
                    tl r = Oc # Bk\<up>(ln) @ Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
 
 fun wadjust_loop_start :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_loop_start m rs (l, r) = 
           (\<exists> ln rn ml mr. l = Oc\<up>(ml) @ Bk # Oc\<up>(Suc m)  \<and>
                           r = Oc # Bk\<up>(ln) @ Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and>
                           ml + mr = Suc (Suc rs) \<and> mr > 0)"
 
 fun wadjust_loop_right_move :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_loop_right_move m rs (l, r) = 
    (\<exists> ml mr nl nr rn. l = Bk\<up>(nl) @ Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
                       r = Bk\<up>(nr) @ Oc\<up>(mr) @ Bk\<up>(rn) \<and>
                       ml + mr = Suc (Suc rs) \<and> mr > 0 \<and>
                       nl + nr > 0)"
 
 fun wadjust_loop_check :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_loop_check m rs (l, r) = 
   (\<exists> ml mr ln rn. l = Oc # Bk\<up>(ln) @ Bk # Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
                   r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> ml + mr = (Suc rs))"
 
 fun wadjust_loop_erase :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_loop_erase m rs (l, r) = 
     (\<exists> ml mr ln rn. l = Bk\<up>(ln) @ Bk # Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
                     tl r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> ml + mr = (Suc rs) \<and> mr > 0)"
 
 fun wadjust_loop_on_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_loop_on_left_moving_O m rs (l, r) = 
       (\<exists> ml mr ln rn. l = Oc\<up>(ml) @ Bk # Oc\<up>(Suc m )\<and>
                       r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and>
                       ml + mr = Suc rs \<and> mr > 0)"
 
 fun wadjust_loop_on_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_loop_on_left_moving_B m rs (l, r) = 
       (\<exists> ml mr nl nr rn. l = Bk\<up>(nl) @ Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
                          r = Bk\<up>(nr) @ Bk # Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and> 
                          ml + mr = Suc rs \<and> mr > 0)"
 
 fun wadjust_loop_on_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_loop_on_left_moving m rs (l, r) = 
        (wadjust_loop_on_left_moving_O m rs (l, r) \<or>
        wadjust_loop_on_left_moving_B m rs (l, r))"
 
 fun wadjust_loop_right_move2 :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_loop_right_move2 m rs (l, r) = 
         (\<exists> ml mr ln rn. l = Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
                         r = Bk\<up>(ln) @ Bk # Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and>
                         ml + mr = Suc rs \<and> mr > 0)"
 
 fun wadjust_erase2 :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_erase2 m rs (l, r) = 
      (\<exists> ln rn. l = Bk\<up>(ln) @ Bk # Oc # Oc\<up>(Suc rs) @ Bk # Oc\<up>(Suc m) \<and>
                      tl r = Bk\<up>(rn))"
 
 fun wadjust_on_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_on_left_moving_O m rs (l, r) = 
         (\<exists> rn. l = Oc\<up>(Suc rs) @ Bk # Oc\<up>(Suc m) \<and>
                   r = Oc # Bk\<up>(rn))"
 
 fun wadjust_on_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_on_left_moving_B m rs (l, r) = 
          (\<exists> ln rn. l = Bk\<up>(ln) @ Oc # Oc\<up>(Suc rs) @ Bk # Oc\<up>(Suc m) \<and>
                    r = Bk\<up>(rn))"
 
 fun wadjust_on_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_on_left_moving m rs (l, r) = 
       (wadjust_on_left_moving_O m rs (l, r) \<or>
        wadjust_on_left_moving_B m rs (l, r))"
 
 fun wadjust_goon_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where 
     "wadjust_goon_left_moving_B m rs (l, r) = 
         (\<exists> rn. l = Oc\<up>(Suc m) \<and> 
                r = Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
 
 fun wadjust_goon_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_goon_left_moving_O m rs (l, r) = 
       (\<exists> ml mr rn. l = Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
                       r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> 
                       ml + mr = Suc (Suc rs) \<and> mr > 0)"
 
 fun wadjust_goon_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_goon_left_moving m rs (l, r) = 
             (wadjust_goon_left_moving_B m rs (l, r) \<or>
              wadjust_goon_left_moving_O m rs (l, r))"
 
 fun wadjust_backto_standard_pos_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_backto_standard_pos_B m rs (l, r) =
         (\<exists> rn. l = [] \<and> 
                r = Bk # Oc\<up>(Suc m )@ Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
 
 fun wadjust_backto_standard_pos_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_backto_standard_pos_O m rs (l, r) = 
       (\<exists> ml mr rn. l = Oc\<up>(ml) \<and>
                       r = Oc\<up>(mr) @ Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn) \<and> 
                       ml + mr = Suc m \<and> mr > 0)"
 
 fun wadjust_backto_standard_pos :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_backto_standard_pos m rs (l, r) = 
         (wadjust_backto_standard_pos_B m rs (l, r) \<or> 
         wadjust_backto_standard_pos_O m rs (l, r))"
 
 fun wadjust_stop :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_stop m rs (l, r) =
         (\<exists> rn. l = [Bk] \<and> 
                r = Oc\<up>(Suc m )@ Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
 
 declare wadjust_start.simps[simp del]  wadjust_loop_start.simps[simp del]
   wadjust_loop_right_move.simps[simp del]  wadjust_loop_check.simps[simp del]
   wadjust_loop_erase.simps[simp del] wadjust_loop_on_left_moving.simps[simp del]
   wadjust_loop_right_move2.simps[simp del] wadjust_erase2.simps[simp del]
   wadjust_on_left_moving_O.simps[simp del] wadjust_on_left_moving_B.simps[simp del]
   wadjust_on_left_moving.simps[simp del] wadjust_goon_left_moving_B.simps[simp del]
   wadjust_goon_left_moving_O.simps[simp del] wadjust_goon_left_moving.simps[simp del]
   wadjust_backto_standard_pos.simps[simp del] wadjust_backto_standard_pos_B.simps[simp del]
   wadjust_backto_standard_pos_O.simps[simp del] wadjust_stop.simps[simp del]
 
 fun wadjust_inv :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
   where
     "wadjust_inv st m rs (l, r) = 
        (if st = Suc 0 then wadjust_start m rs (l, r) 
         else if st = Suc (Suc 0) then wadjust_loop_start m rs (l, r)
         else if st = Suc (Suc (Suc 0)) then wadjust_loop_right_move m rs (l, r)
         else if st = 4 then wadjust_loop_check m rs (l, r)
         else if st = 5 then wadjust_loop_erase m rs (l, r)
         else if st = 6 then wadjust_loop_on_left_moving m rs (l, r)
         else if st = 7 then wadjust_loop_right_move2 m rs (l, r)
         else if st = 8 then wadjust_erase2 m rs (l, r)
         else if st = 9 then wadjust_on_left_moving m rs (l, r)
         else if st = 10 then wadjust_goon_left_moving m rs (l, r)
         else if st = 11 then wadjust_backto_standard_pos m rs (l, r)
         else if st = 0 then wadjust_stop m rs (l, r)
         else False
 )"
 
 declare wadjust_inv.simps[simp del]
 
 fun wadjust_phase :: "nat \<Rightarrow> config \<Rightarrow> nat"
   where
     "wadjust_phase rs (st, l, r) = 
          (if st = 1 then 3 
           else if st \<ge> 2 \<and> st \<le> 7 then 2
           else if st \<ge> 8 \<and> st \<le> 11 then 1
           else 0)"
 
 fun wadjust_stage :: "nat \<Rightarrow> config \<Rightarrow> nat"
   where
     "wadjust_stage rs (st, l, r) = 
            (if st \<ge> 2 \<and> st \<le> 7 then 
                   rs - length (takeWhile (\<lambda> a. a = Oc) 
                           (tl (dropWhile (\<lambda> a. a = Oc) (rev l @ r))))
             else 0)"
 
 fun wadjust_state :: "nat \<Rightarrow> config \<Rightarrow> nat"
   where
     "wadjust_state rs (st, l, r) = 
        (if st \<ge> 2 \<and> st \<le> 7 then 8 - st
         else if st \<ge> 8 \<and> st \<le> 11 then 12 - st
         else 0)"
 
 fun wadjust_step :: "nat \<Rightarrow> config \<Rightarrow> nat"
   where
     "wadjust_step rs (st, l, r) = 
        (if st = 1 then (if hd r = Bk then 1
                         else 0) 
         else if st = 3 then length r
         else if st = 5 then (if hd r = Oc then 1
                              else 0)
         else if st = 6 then length l
         else if st = 8 then (if hd r = Oc then 1
                              else 0)
         else if st = 9 then length l
         else if st = 10 then length l
         else if st = 11 then (if hd r = Bk then 0
                               else Suc (length l))
         else 0)"
 
 fun wadjust_measure :: "(nat \<times> config) \<Rightarrow> nat \<times> nat \<times> nat \<times> nat"
   where
     "wadjust_measure (rs, (st, l, r)) = 
      (wadjust_phase rs (st, l, r), 
       wadjust_stage rs (st, l, r),
       wadjust_state rs (st, l, r), 
       wadjust_step rs (st, l, r))"
 
 definition wadjust_le :: "((nat \<times> config) \<times> nat \<times> config) set"
   where "wadjust_le \<equiv> (inv_image lex_square wadjust_measure)"
 
 lemma wf_lex_square[intro]: "wf lex_square"
   by(auto intro:wf_lex_prod simp: Abacus.lex_pair_def lex_square_def 
       Abacus.lex_triple_def)
 
 lemma wf_wadjust_le[intro]: "wf wadjust_le"
   by(auto intro:wf_inv_image simp: wadjust_le_def
       Abacus.lex_triple_def Abacus.lex_pair_def)
 
 lemma wadjust_start_snd_nonempty[simp]: "wadjust_start m rs (c, []) = False"
   apply(auto simp: wadjust_start.simps)
   done
 
 lemma wadjust_loop_right_move_fst_nonempty[simp]: "wadjust_loop_right_move m rs (c, []) \<Longrightarrow> c \<noteq> []"
   apply(auto simp: wadjust_loop_right_move.simps)
   done
 
 lemma wadjust_loop_check_fst_nonempty[simp]: "wadjust_loop_check m rs (c, []) \<Longrightarrow> c \<noteq> []"
   apply(simp only: wadjust_loop_check.simps, auto)
   done
 
 lemma wadjust_loop_start_snd_nonempty[simp]: "wadjust_loop_start m rs (c, []) = False"
   apply(simp add: wadjust_loop_start.simps)
   done
 
 lemma wadjust_erase2_singleton[simp]: "wadjust_loop_check m rs (c, []) \<Longrightarrow> wadjust_erase2 m rs (tl c, [hd c])"
   apply(simp only: wadjust_loop_check.simps wadjust_erase2.simps, auto)
   done
 
 lemma wadjust_loop_on_left_moving_snd_nonempty[simp]:
   "wadjust_loop_on_left_moving m rs (c, []) = False"
   "wadjust_loop_right_move2 m rs (c, []) = False"
   "wadjust_erase2 m rs ([], []) = False"
   by(auto simp: wadjust_loop_on_left_moving.simps
       wadjust_loop_right_move2.simps
       wadjust_erase2.simps)
 
 lemma wadjust_on_left_moving_B_Bk1[simp]: "wadjust_on_left_moving_B m rs 
                  (Oc # Oc # Oc\<up>(rs) @ Bk # Oc # Oc\<up>(m), [Bk])"
   apply(simp add: wadjust_on_left_moving_B.simps, auto)
   done
 
 lemma wadjust_on_left_moving_B_Bk2[simp]: "wadjust_on_left_moving_B m rs 
                  (Bk\<up>(n) @ Bk # Oc # Oc # Oc\<up>(rs) @ Bk # Oc # Oc\<up>(m), [Bk])"
   apply(simp add: wadjust_on_left_moving_B.simps , auto)
   apply(rule_tac x = "Suc n" in exI, simp add: exp_ind del: replicate_Suc)
   done
 
 lemma wadjust_on_left_moving_singleton[simp]: "\<lbrakk>wadjust_erase2 m rs (c, []); c \<noteq> []\<rbrakk> \<Longrightarrow>
             wadjust_on_left_moving m rs (tl c, [hd c])" unfolding wadjust_erase2.simps
   apply(auto simp add: wadjust_on_left_moving.simps)
    apply (metis (no_types, lifting) empty_replicate hd_append hd_replicate list.sel(1) list.sel(3)
       self_append_conv2 tl_append2 tl_replicate
       wadjust_on_left_moving_B_Bk1 wadjust_on_left_moving_B_Bk2)+
   done
 
 lemma wadjust_erase2_cases[simp]: "wadjust_erase2 m rs (c, [])
     \<Longrightarrow> (c = [] \<longrightarrow> wadjust_on_left_moving m rs ([], [Bk])) \<and> 
        (c \<noteq> [] \<longrightarrow> wadjust_on_left_moving m rs (tl c, [hd c]))"
   apply(auto)
   done
 
 lemma wadjust_on_left_moving_nonempty[simp]:
   "wadjust_on_left_moving m rs ([], []) = False"
   "wadjust_on_left_moving_O m rs (c, []) = False"
    apply(auto simp: wadjust_on_left_moving.simps 
       wadjust_on_left_moving_O.simps wadjust_on_left_moving_B.simps)
   done
 
 lemma wadjust_on_left_moving_B_singleton_Bk[simp]:
   " \<lbrakk>wadjust_on_left_moving_B m rs (c, []); c \<noteq> []; hd c = Bk\<rbrakk> \<Longrightarrow>
                                       wadjust_on_left_moving_B m rs (tl c, [Bk])"
   apply(auto simp add: wadjust_on_left_moving_B.simps hd_append)
   by (metis cell.distinct(1) empty_replicate list.sel(1) tl_append2 tl_replicate)
 
 lemma wadjust_on_left_moving_B_singleton_Oc[simp]:
   "\<lbrakk>wadjust_on_left_moving_B m rs (c, []); c \<noteq> []; hd c = Oc\<rbrakk> \<Longrightarrow>
                                   wadjust_on_left_moving_O m rs (tl c, [Oc])"
   apply(auto simp add: wadjust_on_left_moving_B.simps wadjust_on_left_moving_O.simps hd_append)
    apply (metis cell.distinct(1) empty_replicate hd_replicate list.sel(3) self_append_conv2)+
   done
 
 lemma wadjust_on_left_moving_singleton2[simp]:
   "\<lbrakk>wadjust_on_left_moving m rs (c, []); c \<noteq> []\<rbrakk> \<Longrightarrow> 
   wadjust_on_left_moving m rs (tl c, [hd c])"
   apply(simp add: wadjust_on_left_moving.simps)
   apply(case_tac "hd c", simp_all)
   done
 
 lemma wadjust_nonempty[simp]: "wadjust_goon_left_moving m rs (c, []) = False"
   "wadjust_backto_standard_pos m rs (c, []) = False"
   by(auto simp: wadjust_goon_left_moving.simps wadjust_goon_left_moving_B.simps
       wadjust_goon_left_moving_O.simps wadjust_backto_standard_pos.simps
       wadjust_backto_standard_pos_B.simps wadjust_backto_standard_pos_O.simps)
 
 lemma wadjust_loop_start_no_Bk[simp]: "wadjust_loop_start m rs (c, Bk # list) = False"
   apply(auto simp: wadjust_loop_start.simps)
   done
 
 lemma wadjust_loop_check_nonempty[simp]: "wadjust_loop_check m rs (c, b) \<Longrightarrow> c \<noteq> []"
   apply(simp only: wadjust_loop_check.simps, auto)
   done
 
 lemma wadjust_erase2_via_loop_check_Bk[simp]: "wadjust_loop_check m rs (c, Bk # list)
               \<Longrightarrow>  wadjust_erase2 m rs (tl c, hd c # Bk # list)"
   by (auto simp: wadjust_loop_check.simps wadjust_erase2.simps)
 
 declare wadjust_loop_on_left_moving_O.simps[simp del]
   wadjust_loop_on_left_moving_B.simps[simp del]
 
 lemma wadjust_loop_on_left_moving_B_via_erase[simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); hd c = Bk\<rbrakk>
     \<Longrightarrow> wadjust_loop_on_left_moving_B m rs (tl c, Bk # Bk # list)"
   unfolding wadjust_loop_erase.simps wadjust_loop_on_left_moving_B.simps
   apply(erule_tac exE)+
   apply(rename_tac ml mr ln rn)
   apply(rule_tac x = ml in exI, rule_tac x = mr in exI, 
       rule_tac x = ln in exI, rule_tac x = 0 in exI)
   apply(case_tac ln, auto)
   apply(simp add: exp_ind [THEN sym])
   done
 
 lemma wadjust_loop_on_left_moving_O_Bk_via_erase[simp]:
   "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); c \<noteq> []; hd c = Oc\<rbrakk> \<Longrightarrow>
              wadjust_loop_on_left_moving_O m rs (tl c, Oc # Bk # list)"
   apply(auto simp: wadjust_loop_erase.simps wadjust_loop_on_left_moving_O.simps)
   by (metis cell.distinct(1) empty_replicate hd_append hd_replicate list.sel(1))
 
 lemma wadjust_loop_on_left_moving_Bk_via_erase[simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); c \<noteq> []\<rbrakk> \<Longrightarrow> 
                 wadjust_loop_on_left_moving m rs (tl c, hd c # Bk # list)"
   apply(case_tac "hd c", simp_all add:wadjust_loop_on_left_moving.simps)
   done
 
 
 lemma wadjust_loop_on_left_moving_B_Bk_move[simp]:
   "\<lbrakk>wadjust_loop_on_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
     \<Longrightarrow>  wadjust_loop_on_left_moving_B m rs (tl c, Bk # Bk # list)"
   apply(simp only: wadjust_loop_on_left_moving_B.simps)
   apply(erule_tac exE)+
   by (metis (no_types, lifting) cell.distinct(1) list.sel(1)
       replicate_Suc_iff_anywhere self_append_conv2 tl_append2 tl_replicate)
 
 lemma wadjust_loop_on_left_moving_O_Oc_move[simp]:
   "\<lbrakk>wadjust_loop_on_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
     \<Longrightarrow> wadjust_loop_on_left_moving_O m rs (tl c, Oc # Bk # list)"
   apply(simp only: wadjust_loop_on_left_moving_O.simps 
       wadjust_loop_on_left_moving_B.simps)
   by (metis cell.distinct(1) empty_replicate hd_append hd_replicate list.sel(3) self_append_conv2)
 
 
 lemma wadjust_loop_erase_nonempty[simp]: "wadjust_loop_erase m rs (c, b) \<Longrightarrow> c \<noteq> []"
   "wadjust_loop_on_left_moving m rs (c, b) \<Longrightarrow> c \<noteq> []"
   "wadjust_loop_right_move2 m rs (c, b) \<Longrightarrow> c \<noteq> []"
   "wadjust_erase2 m rs (c, Bk # list) \<Longrightarrow> c \<noteq> []"
   "wadjust_on_left_moving m rs (c,b) \<Longrightarrow> c \<noteq> []"
   "wadjust_on_left_moving_O m rs (c, Bk # list) = False"
   "wadjust_goon_left_moving m rs (c, b) \<Longrightarrow> c \<noteq> []"
   "wadjust_loop_on_left_moving_O m rs (c, Bk # list) = False"
   by(auto simp: wadjust_loop_erase.simps wadjust_loop_on_left_moving.simps 
       wadjust_loop_on_left_moving_O.simps wadjust_loop_on_left_moving_B.simps
       wadjust_loop_right_move2.simps wadjust_erase2.simps
       wadjust_on_left_moving.simps
       wadjust_on_left_moving_O.simps
       wadjust_on_left_moving_B.simps wadjust_goon_left_moving.simps
       wadjust_goon_left_moving_B.simps
       wadjust_goon_left_moving_O.simps)
 
 lemma wadjust_loop_on_left_moving_Bk_move[simp]:
   "wadjust_loop_on_left_moving m rs (c, Bk # list)
             \<Longrightarrow> wadjust_loop_on_left_moving m rs (tl c, hd c # Bk # list)"
   apply(simp add: wadjust_loop_on_left_moving.simps)
   apply(case_tac "hd c", simp_all)
   done
 
 lemma wadjust_loop_start_Oc_via_Bk_move[simp]: 
   "wadjust_loop_right_move2 m rs (c, Bk # list) \<Longrightarrow>  wadjust_loop_start m rs (c, Oc # list)"
   apply(auto simp: wadjust_loop_right_move2.simps wadjust_loop_start.simps replicate_app_Cons_same)
   by (metis add_Suc replicate_Suc)
 
 lemma wadjust_on_left_moving_Bk_via_erase[simp]: "wadjust_erase2 m rs (c, Bk # list) \<Longrightarrow> 
                  wadjust_on_left_moving m rs (tl c, hd c # Bk # list)"
   apply(auto simp: wadjust_erase2.simps wadjust_on_left_moving.simps replicate_app_Cons_same
       wadjust_on_left_moving_O.simps wadjust_on_left_moving_B.simps)
    apply (metis exp_ind replicate_append_same)+
   done
 
 
 lemma wadjust_on_left_moving_B_Bk_drop_one: "\<lbrakk>wadjust_on_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
     \<Longrightarrow> wadjust_on_left_moving_B m rs (tl c, Bk # Bk # list)"
   apply(auto simp: wadjust_on_left_moving_B.simps)
   by (metis cell.distinct(1) hd_append list.sel(1) tl_append2 tl_replicate)
 
 lemma wadjust_on_left_moving_B_Bk_drop_Oc: "\<lbrakk>wadjust_on_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
     \<Longrightarrow> wadjust_on_left_moving_O m rs (tl c, Oc # Bk # list)"
   apply(auto simp: wadjust_on_left_moving_O.simps wadjust_on_left_moving_B.simps)
   by (metis cell.distinct(1) empty_replicate hd_append hd_replicate list.sel(3) self_append_conv2)
 
 lemma wadjust_on_left_moving_B_drop[simp]: "wadjust_on_left_moving  m rs (c, Bk # list) \<Longrightarrow>  
                   wadjust_on_left_moving m rs (tl c, hd c # Bk # list)"
   by(cases "hd c", auto simp:wadjust_on_left_moving.simps wadjust_on_left_moving_B_Bk_drop_one
       wadjust_on_left_moving_B_Bk_drop_Oc)
 
 lemma wadjust_goon_left_moving_O_no_Bk[simp]: "wadjust_goon_left_moving_O m rs (c, Bk # list) = False"
   by (auto simp add: wadjust_goon_left_moving_O.simps)
 
 lemma wadjust_backto_standard_pos_via_left_Bk[simp]:
   "wadjust_goon_left_moving m rs (c, Bk # list) \<Longrightarrow>
   wadjust_backto_standard_pos m rs (tl c, hd c # Bk # list)"
   by(case_tac "hd c", simp_all add: wadjust_backto_standard_pos.simps wadjust_goon_left_moving.simps
       wadjust_goon_left_moving_B.simps wadjust_backto_standard_pos_O.simps)
 
 lemma wadjust_loop_right_move_Oc[simp]:
   "wadjust_loop_start m rs (c, Oc # list) \<Longrightarrow> wadjust_loop_right_move m rs (Oc # c, list)"
   apply(auto simp add: wadjust_loop_start.simps wadjust_loop_right_move.simps
       simp del:split_head_repeat)
   apply(rename_tac ln rn ml mr)
   apply(rule_tac x = ml in exI, rule_tac x = mr in exI, 
       rule_tac x = 0 in exI, simp)
   apply(rule_tac x = "Suc ln" in exI, simp add: exp_ind del: replicate_Suc)
   done
 
 lemma wadjust_loop_check_Oc[simp]:
   assumes "wadjust_loop_right_move m rs (c, Oc # list)" 
   shows "wadjust_loop_check m rs (Oc # c, list)"
 proof -
   from assms obtain ml mr nl nr rn
     where "c = Bk \<up> nl @ Oc # Oc \<up> ml @ Bk # Oc \<up> m @ [Oc]"
       "Oc # list = Bk \<up> nr @ Oc \<up> mr @ Bk \<up> rn"
       "ml + mr = Suc (Suc rs)" "0 < mr" "0 < nl + nr"
     unfolding wadjust_loop_right_move.simps exp_ind 
       wadjust_loop_check.simps by auto
   hence "\<exists>ln. Oc # c = Oc # Bk \<up> ln @ Bk # Oc # Oc \<up> ml @ Bk # Oc \<up> Suc m"
     "\<exists>rn. list = Oc \<up> (mr - 1) @ Bk \<up> rn" "ml + (mr - 1) = Suc rs"
     by(cases nl;cases nr;cases mr;force simp add: wadjust_loop_right_move.simps exp_ind 
         wadjust_loop_check.simps replicate_append_same)+
   thus ?thesis unfolding wadjust_loop_check.simps by auto
 qed
 
 lemma wadjust_loop_erase_move_Oc[simp]: "wadjust_loop_check m rs (c, Oc # list) \<Longrightarrow> 
                wadjust_loop_erase m rs (tl c, hd c # Oc # list)"
   apply(simp only: wadjust_loop_check.simps wadjust_loop_erase.simps)
   apply(erule_tac exE)+
   using Cons_replicate_eq by fastforce
 
 lemma wadjust_loop_on_move_no_Oc[simp]:
   "wadjust_loop_on_left_moving_B m rs (c, Oc # list) = False"
   "wadjust_loop_right_move2 m rs (c, Oc # list) = False"
   "wadjust_loop_on_left_moving m rs (c, Oc # list)
            \<Longrightarrow> wadjust_loop_right_move2 m rs (Oc # c, list)"
   "wadjust_on_left_moving_B m rs (c, Oc # list) = False"
   "wadjust_loop_erase m rs (c, Oc # list) \<Longrightarrow> 
                 wadjust_loop_erase m rs (c, Bk # list)"
   by(auto simp: wadjust_loop_on_left_moving_B.simps wadjust_loop_on_left_moving_O.simps
       wadjust_loop_right_move2.simps replicate_app_Cons_same wadjust_loop_on_left_moving.simps
       wadjust_on_left_moving_B.simps wadjust_loop_erase.simps)
 
 lemma wadjust_goon_left_moving_B_Bk_Oc: "\<lbrakk>wadjust_on_left_moving_O m rs (c, Oc # list); hd c = Bk\<rbrakk> \<Longrightarrow> 
          wadjust_goon_left_moving_B m rs (tl c, Bk # Oc # list)"
   apply(auto simp: wadjust_on_left_moving_O.simps 
       wadjust_goon_left_moving_B.simps )
   done
 
 lemma wadjust_goon_left_moving_O_Oc_Oc: "\<lbrakk>wadjust_on_left_moving_O m rs (c, Oc # list); hd c = Oc\<rbrakk>
     \<Longrightarrow> wadjust_goon_left_moving_O m rs (tl c, Oc # Oc # list)"
   apply(auto simp: wadjust_on_left_moving_O.simps 
       wadjust_goon_left_moving_O.simps )
   apply(auto simp:  numeral_2_eq_2)
   done
 
 
 lemma wadjust_goon_left_moving_Oc[simp]: "wadjust_on_left_moving m rs (c, Oc # list) \<Longrightarrow> 
               wadjust_goon_left_moving m rs (tl c, hd c # Oc # list)"
   by(cases "hd c"; force simp: wadjust_on_left_moving.simps wadjust_goon_left_moving.simps
       wadjust_goon_left_moving_B_Bk_Oc wadjust_goon_left_moving_O_Oc_Oc)+
 
 lemma left_moving_Bk_Oc[simp]: "\<lbrakk>wadjust_goon_left_moving_O m rs (c, Oc # list); hd c = Bk\<rbrakk> 
                \<Longrightarrow> wadjust_goon_left_moving_B m rs (tl c, Bk # Oc # list)"
   apply(auto simp: wadjust_goon_left_moving_O.simps wadjust_goon_left_moving_B.simps hd_append
       dest!: gr0_implies_Suc)
    apply (metis cell.distinct(1) empty_replicate hd_replicate list.sel(3) self_append_conv2)
   by (metis add_cancel_right_left cell.distinct(1) hd_replicate replicate_Suc_iff_anywhere)
 
 lemma  left_moving_Oc_Oc[simp]: "\<lbrakk>wadjust_goon_left_moving_O m rs (c, Oc # list); hd c = Oc\<rbrakk> \<Longrightarrow> 
   wadjust_goon_left_moving_O m rs (tl c, Oc # Oc # list)"
   apply(auto simp: wadjust_goon_left_moving_O.simps wadjust_goon_left_moving_B.simps)
   apply(rename_tac mlx mrx rnx)
   apply(rule_tac x = "mlx - 1" in exI, simp)
   apply(case_tac mlx, simp_all add: )
   apply(rule_tac x = "Suc mrx" in exI, auto simp: )
   done
 
 lemma wadjust_goon_left_moving_B_no_Oc[simp]:
   "wadjust_goon_left_moving_B m rs (c, Oc # list) = False"
   apply(auto simp: wadjust_goon_left_moving_B.simps)
   done
 
 lemma wadjust_goon_left_moving_Oc_move[simp]: "wadjust_goon_left_moving m rs (c, Oc # list) \<Longrightarrow> 
   wadjust_goon_left_moving m rs (tl c, hd c # Oc # list)"
   by(cases "hd c",auto simp: wadjust_goon_left_moving.simps)
 
 lemma wadjust_backto_standard_pos_B_no_Oc[simp]:
   "wadjust_backto_standard_pos_B m rs (c, Oc # list) = False"
   apply(simp add: wadjust_backto_standard_pos_B.simps)
   done
 
 lemma wadjust_backto_standard_pos_O_no_Bk[simp]:
   "wadjust_backto_standard_pos_O m rs (c, Bk # xs) = False"
   by(simp add: wadjust_backto_standard_pos_O.simps)
 
 lemma wadjust_backto_standard_pos_B_Bk_Oc[simp]:
   "wadjust_backto_standard_pos_O m rs ([], Oc # list) \<Longrightarrow> 
   wadjust_backto_standard_pos_B m rs ([], Bk # Oc # list)"
   apply(auto simp: wadjust_backto_standard_pos_O.simps
       wadjust_backto_standard_pos_B.simps)
   done
 
 lemma wadjust_backto_standard_pos_B_Bk_Oc_via_O[simp]: 
   "\<lbrakk>wadjust_backto_standard_pos_O m rs (c, Oc # list); c \<noteq> []; hd c = Bk\<rbrakk>
   \<Longrightarrow> wadjust_backto_standard_pos_B m rs (tl c, Bk # Oc # list)"
   apply(simp add:wadjust_backto_standard_pos_O.simps 
       wadjust_backto_standard_pos_B.simps, auto)
   done 
 
 lemma wadjust_backto_standard_pos_B_Oc_Oc_via_O[simp]: "\<lbrakk>wadjust_backto_standard_pos_O m rs (c, Oc # list); c \<noteq> []; hd c = Oc\<rbrakk>
           \<Longrightarrow>  wadjust_backto_standard_pos_O m rs (tl c, Oc # Oc # list)"
   apply(simp add: wadjust_backto_standard_pos_O.simps, auto)
   by force
 
 lemma wadjust_backto_standard_pos_cases[simp]: "wadjust_backto_standard_pos m rs (c, Oc # list)
   \<Longrightarrow> (c = [] \<longrightarrow> wadjust_backto_standard_pos m rs ([], Bk # Oc # list)) \<and> 
  (c \<noteq> [] \<longrightarrow> wadjust_backto_standard_pos m rs (tl c, hd c # Oc # list))"
   apply(auto simp: wadjust_backto_standard_pos.simps)
   apply(case_tac "hd c", simp_all)
   done
 
 lemma wadjust_loop_right_move_nonempty_snd[simp]: "wadjust_loop_right_move m rs (c, []) = False"
 proof -
   {fix nl ml mr rn nr
     have "(c = Bk \<up> nl @ Oc # Oc \<up> ml @ Bk # Oc \<up> Suc m \<and>
         [] = Bk \<up> nr @ Oc \<up> mr @ Bk \<up> rn \<and> ml + mr = Suc (Suc rs) \<and> 0 < mr \<and> 0 < nl + nr) =
     False" by auto
   } note t=this
   thus ?thesis unfolding wadjust_loop_right_move.simps t by blast
 qed
 
 lemma wadjust_loop_erase_nonempty_snd[simp]: "wadjust_loop_erase m rs (c, []) = False"
   apply(simp only: wadjust_loop_erase.simps, auto)
   done
 
 lemma wadjust_loop_erase_cases2[simp]: "\<lbrakk>Suc (Suc rs) = a;  wadjust_loop_erase m rs (c, Bk # list)\<rbrakk>
   \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list))))
   < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) \<or>
   a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list)))) =
   a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
   apply(simp only: wadjust_loop_erase.simps)
   apply(rule_tac disjI2)
   apply(case_tac c, simp, simp)
   done
 
 lemma dropWhile_exp1: "dropWhile (\<lambda>a. a = Oc) (Oc\<up>(n) @ xs) = dropWhile (\<lambda>a. a = Oc) xs"
   apply(induct n, simp_all add: )
   done
 lemma takeWhile_exp1: "takeWhile (\<lambda>a. a = Oc) (Oc\<up>(n) @ xs) = Oc\<up>(n) @ takeWhile (\<lambda>a. a = Oc) xs"
   apply(induct n, simp_all add: )
   done
 
 lemma wadjust_correctness_helper_1:
   assumes "Suc (Suc rs) = a" " wadjust_loop_right_move2 m rs (c, Bk # list)"
   shows "a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))
                  < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
 proof -
   have "ml + mr = Suc rs \<Longrightarrow> 0 < mr \<Longrightarrow>
        rs - (ml + length (takeWhile (\<lambda>a. a = Oc) list))
        < Suc rs -
          (ml +
           length
            (takeWhile (\<lambda>a. a = Oc)
              (Bk \<up> ln @ Bk # Bk # Oc \<up> mr @ Bk \<up> rn))) "
     for ml mr ln rn
     by(cases ln, auto)
   thus ?thesis using assms
     by (auto simp: wadjust_loop_right_move2.simps dropWhile_exp1 takeWhile_exp1)
 qed
 
 lemma wadjust_correctness_helper_2:
   "\<lbrakk>Suc (Suc rs) = a;  wadjust_loop_on_left_moving m rs (c, Bk # list)\<rbrakk>
   \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list))))
   < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) \<or>
   a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list)))) =
   a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
   apply(subgoal_tac "c \<noteq> []")
    apply(case_tac c, simp_all)
   done
 
 lemma wadjust_loop_check_empty_false[simp]: "wadjust_loop_check m rs ([], b) = False"
   apply(simp add: wadjust_loop_check.simps)
   done
 
 lemma wadjust_loop_check_cases: "\<lbrakk>Suc (Suc rs) = a;  wadjust_loop_check m rs (c, Oc # list)\<rbrakk>
   \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Oc # list))))
   < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list)))) \<or>
   a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Oc # list)))) =
   a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))"
   apply(case_tac "c", simp_all)
   done
 
 lemma wadjust_loop_erase_cases_or: 
   "\<lbrakk>Suc (Suc rs) = a;  wadjust_loop_erase m rs (c, Oc # list)\<rbrakk>
   \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))
   < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list)))) \<or>
   a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) =
   a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))"
   apply(simp add: wadjust_loop_erase.simps)
   apply(rule_tac disjI2)
   apply(auto)
   apply(simp add: dropWhile_exp1 takeWhile_exp1)
   done
 
 lemmas wadjust_correctness_helpers = wadjust_correctness_helper_2 wadjust_correctness_helper_1 wadjust_loop_erase_cases_or wadjust_loop_check_cases
 
 declare numeral_2_eq_2[simp del]
 
 lemma wadjust_start_Oc[simp]: "wadjust_start m rs (c, Bk # list)
        \<Longrightarrow> wadjust_start m rs (c, Oc # list)"
   apply(auto simp: wadjust_start.simps)
   done
 
 lemma wadjust_stop_Bk[simp]: "wadjust_backto_standard_pos m rs (c, Bk # list)
        \<Longrightarrow> wadjust_stop m rs (Bk # c, list)"
   apply(auto simp: wadjust_backto_standard_pos.simps 
       wadjust_stop.simps wadjust_backto_standard_pos_B.simps)
   done
 
 lemma wadjust_loop_start_Oc[simp]:
   assumes "wadjust_start m rs (c, Oc # list)"
   shows "wadjust_loop_start m rs (Oc # c, list)"
 proof -
   from assms[unfolded wadjust_start.simps] obtain ln rn where
     "c = Bk # Oc # Oc \<up> m" "list = Oc # Bk \<up> ln @ Bk # Oc # Oc \<up> rs @ Bk \<up> rn"
     by(auto)
   hence "Oc # c = Oc \<up> 1 @ Bk # Oc \<up> Suc m \<and>
        list = Oc # Bk \<up> ln @ Bk # Oc \<up>Suc rs @ Bk \<up> rn \<and> 1 + (Suc rs) = Suc (Suc rs) \<and> 0 < Suc rs"
     by auto
   thus ?thesis unfolding wadjust_loop_start.simps by blast
 qed
 
 lemma erase2_Bk_if_Oc[simp]:" wadjust_erase2 m rs (c, Oc # list)
        \<Longrightarrow> wadjust_erase2 m rs (c, Bk # list)"
   apply(auto simp: wadjust_erase2.simps)
   done
 
 lemma wadjust_loop_right_move_Bk[simp]: "wadjust_loop_right_move m rs (c, Bk # list)
     \<Longrightarrow> wadjust_loop_right_move m rs (Bk # c, list)"
   apply(simp only: wadjust_loop_right_move.simps)
   apply(erule_tac exE)+
   apply auto
    apply (metis cell.distinct(1) empty_replicate hd_append hd_replicate less_SucI
       list.sel(1) list.sel(3) neq0_conv replicate_Suc_iff_anywhere tl_append2 tl_replicate)+
   done
 
 lemma wadjust_correctness:
   shows "let P = (\<lambda> (len, st, l, r). st = 0) in 
   let Q = (\<lambda> (len, st, l, r). wadjust_inv st m rs (l, r)) in 
   let f = (\<lambda> stp. (Suc (Suc rs),  steps0 (Suc 0, Bk # Oc\<up>(Suc m), 
                 Bk # Oc # Bk\<up>(ln) @ Bk #  Oc\<up>(Suc rs) @ Bk\<up>(rn)) t_wcode_adjust stp)) in
     \<exists> n .P (f n) \<and> Q (f n)"
 proof -
   let ?P = "(\<lambda> (len, st, l, r). st = 0)"
   let ?Q = "\<lambda> (len, st, l, r). wadjust_inv st m rs (l, r)"
   let ?f = "\<lambda> stp. (Suc (Suc rs),  steps0 (Suc 0, Bk # Oc\<up>(Suc m), 
                 Bk # Oc # Bk\<up>(ln) @ Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn)) t_wcode_adjust stp)"
   have "\<exists> n. ?P (?f n) \<and> ?Q (?f n)"
   proof(rule_tac halt_lemma2)
     show "wf wadjust_le" by auto
   next
     { fix n assume a:"\<not> ?P (?f n) \<and> ?Q (?f n)"
       have "?Q (?f (Suc n)) \<and> (?f (Suc n), ?f n) \<in> wadjust_le"
       proof(cases "?f n")
         case (fields a b c d)
         then show ?thesis proof(cases d)
           case Nil
           then show ?thesis using a fields apply(simp add: step.simps)
             apply(simp_all only: wadjust_inv.simps split: if_splits)
                         apply(simp_all add: wadjust_inv.simps wadjust_le_def
                 wadjust_correctness_helpers
                 Abacus.lex_triple_def Abacus.lex_pair_def lex_square_def  split: if_splits).
         next
           case (Cons aa list)
           then show ?thesis using a fields Nil Cons
             apply((case_tac aa); simp add: step.simps)
              apply(simp_all only: wadjust_inv.simps split: if_splits)
                                 apply(simp_all)
                                apply(simp_all add: wadjust_inv.simps wadjust_le_def
                 wadjust_correctness_helpers
                 Abacus.lex_triple_def Abacus.lex_pair_def lex_square_def  split: if_splits).
         qed
       qed
     }
     thus "\<forall> n. \<not> ?P (?f n) \<and> ?Q (?f n) \<longrightarrow> 
                  ?Q (?f (Suc n)) \<and> (?f (Suc n), ?f n) \<in> wadjust_le" by auto
   next
     show "?Q (?f 0)" by(auto simp add: steps.simps wadjust_inv.simps wadjust_start.simps)
   next
     show "\<not> ?P (?f 0)" by (simp add: steps.simps)
   qed
   thus"?thesis" by simp
 qed
 
 lemma tm_wf_t_wcode_adjust[intro]: "tm_wf (t_wcode_adjust, 0)"
   by(auto simp: t_wcode_adjust_def tm_wf.simps)
 
 lemma bl_bin_nonzero[simp]: "args \<noteq> [] \<Longrightarrow> bl_bin (<args::nat list>) > 0"
   by(cases args)
     (auto simp: tape_of_nl_cons bl_bin.simps)
 
 lemma wcode_lemma_pre':
   "args \<noteq> [] \<Longrightarrow> 
   \<exists> stp rn. steps0 (Suc 0, [], <m # args>) 
               ((t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust) stp
   = (0,  [Bk],  Oc\<up>(Suc m) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn))" 
 proof -
   let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <m # args>"
   let ?Q1 = "\<lambda>(l, r). l = Bk # Oc\<up>(Suc m) \<and>
     (\<exists>ln rn. r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<args>)) @ Bk\<up>(rn))"
   let ?P2 = ?Q1
   let ?Q2 = "\<lambda> (l, r). (wadjust_stop m (bl_bin (<args>) - 1) (l, r))"
   let ?P3 = "\<lambda> tp. False"
   assume h: "args \<noteq> []"
   hence a: "bl_bin (<args>) > 0"
     using h by simp
   hence "{?P1} (t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust {?Q2}"
   proof(rule_tac Hoare_plus_halt)
   next
     show "tm_wf (t_wcode_prepare |+| t_wcode_main, 0)"
       by(rule_tac tm_comp_wf, auto)
   next
     show "{?P1} t_wcode_prepare |+| t_wcode_main {?Q1}"
     proof(rule_tac Hoare_haltI, auto)
       show 
         "\<exists>n. is_final (steps0 (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) n) \<and>
         (\<lambda>(l, r). l = Bk # Oc # Oc \<up> m \<and>
         (\<exists>ln rn. r = Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn))
         holds_for steps0 (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) n"
         using h prepare_mainpart_lemma[of args m]
         apply(auto) apply(rename_tac stp ln rn)
         apply(rule_tac x = stp in exI, simp)
         apply(rule_tac x = ln in exI, auto)
         done
     qed
   next
     show "{?P2} t_wcode_adjust {?Q2}"
     proof(rule_tac Hoare_haltI, auto del: replicate_Suc)
       fix ln rn
       obtain n a b where "steps0
         (Suc 0, Bk # Oc \<up> m @ [Oc],
          Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> (bl_bin (<args>) - Suc 0) @ Oc # Bk \<up> rn)
         t_wcode_adjust n = (0, a, b)"
         "wadjust_inv 0 m (bl_bin (<args>) - Suc 0) (a, b)"
         using wadjust_correctness[of m "bl_bin (<args>) - 1" "Suc ln" rn,unfolded Let_def]
         by(simp del: replicate_Suc add: replicate_Suc[THEN sym] exp_ind, auto)
       thus "\<exists>n. is_final (steps0 (Suc 0, Bk # Oc # Oc \<up> m, 
         Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_wcode_adjust n) \<and>
         wadjust_stop m (bl_bin (<args>) - Suc 0) holds_for steps0
         (Suc 0, Bk # Oc # Oc \<up> m, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_wcode_adjust n"
         apply(rule_tac x = n in exI)
         using a
         apply(case_tac "bl_bin (<args>)", simp, simp del: replicate_Suc add: exp_ind wadjust_inv.simps)
         by (simp add: replicate_append_same)
     qed
   qed
   thus "?thesis"
     apply(simp add: Hoare_halt_def, auto)
     apply(rename_tac n)
     apply(case_tac "(steps0 (Suc 0, [], <(m::nat) # args>) 
       ((t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust) n)")
     apply(rule_tac x = n in exI, auto simp: wadjust_stop.simps)
     using a
     apply(case_tac "bl_bin (<args>)", simp_all)
     done
 qed
 
 text \<open>
   The initialization TM \<open>t_wcode\<close>.
 \<close>
 definition t_wcode :: "instr list"
   where
     "t_wcode = (t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust        "
 
 text \<open>
   The correctness of \<open>t_wcode\<close>.
 \<close>
 
 lemma wcode_lemma_1:
   "args \<noteq> [] \<Longrightarrow> 
   \<exists> stp ln rn. steps0 (Suc 0, [], <m # args>)  (t_wcode) stp = 
               (0,  [Bk],  Oc\<up>(Suc m) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn))"
   apply(simp add: wcode_lemma_pre' t_wcode_def del: replicate_Suc)
   done
 
 lemma wcode_lemma: 
   "args \<noteq> [] \<Longrightarrow> 
   \<exists> stp ln rn. steps0 (Suc 0, [], <m # args>)  (t_wcode) stp = 
               (0,  [Bk],  <[m ,bl_bin (<args>)]> @ Bk\<up>(rn))"
   using wcode_lemma_1[of args m]
   apply(simp add: t_wcode_def tape_of_list_def tape_of_nat_def)
   done
 
 section \<open>The universal TM\<close>
 
 text \<open>
   This section gives the explicit construction of {\em Universal Turing Machine}, defined as \<open>UTM\<close> and proves its 
   correctness. It is pretty easy by composing the partial results we have got so far.
 \<close>
 
 
 definition UTM :: "instr list"
   where
     "UTM = (let (aprog, rs_pos, a_md) = rec_ci rec_F in 
           let abc_F = aprog [+] dummy_abc (Suc (Suc 0)) in 
           (t_wcode |+| (tm_of abc_F @ shift (mopup (Suc (Suc 0))) (length (tm_of abc_F) div 2))))"
 
 definition F_aprog :: "abc_prog"
   where
     "F_aprog \<equiv> (let (aprog, rs_pos, a_md) = rec_ci rec_F in 
                        aprog [+] dummy_abc (Suc (Suc 0)))"
 
 definition F_tprog :: "instr list"
   where
     "F_tprog = tm_of (F_aprog)"
 
 definition t_utm :: "instr list"
   where
     "t_utm \<equiv>
      F_tprog @ shift (mopup (Suc (Suc 0))) (length F_tprog div 2)"
 
 definition UTM_pre :: "instr list"
   where
     "UTM_pre = t_wcode |+| t_utm"
 
 lemma tinres_step1: 
   assumes "tinres l l'" "step (ss, l, r) (t, 0) = (sa, la, ra)" 
     "step (ss, l', r) (t, 0) = (sb, lb, rb)"
   shows "tinres la lb \<and> ra = rb \<and> sa = sb"
 proof(cases "r")
   case Nil
   then show ?thesis using assms
     by (cases "(fetch t ss Bk)";cases "fst (fetch t ss Bk)";auto simp:step.simps split:if_splits)
 next
   case (Cons a list)
   then show ?thesis using assms
     by (cases "(fetch t ss a)";cases "fst (fetch t ss a)";auto simp:step.simps split:if_splits)
 qed
 
 lemma tinres_steps1: 
   "\<lbrakk>tinres l l'; steps (ss, l, r) (t, 0) stp = (sa, la, ra); 
                  steps (ss, l', r) (t, 0) stp = (sb, lb, rb)\<rbrakk>
     \<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
 proof (induct stp arbitrary: sa la ra sb lb rb)
   case (Suc stp)
   then show ?case apply simp 
     apply(case_tac "(steps (ss, l, r) (t, 0) stp)")
     apply(case_tac "(steps (ss, l', r) (t, 0) stp)")
   proof -
     fix stp sa la ra sb lb rb a b c aa ba ca
     assume ind: "\<And>sa la ra sb lb rb. \<lbrakk>steps (ss, l, r) (t, 0) stp = (sa, (la::cell list), ra); 
           steps (ss, l', r) (t, 0) stp = (sb, lb, rb)\<rbrakk> \<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
       and h: " tinres l l'" "step (steps (ss, l, r) (t, 0) stp) (t, 0) = (sa, la, ra)"
       "step (steps (ss, l', r) (t, 0) stp) (t, 0) = (sb, lb, rb)" "steps (ss, l, r) (t, 0) stp = (a, b, c)" 
       "steps (ss, l', r) (t, 0) stp = (aa, ba, ca)"
     have "tinres b ba \<and> c = ca \<and> a = aa"
       using ind h by metis
     thus "tinres la lb \<and> ra = rb \<and> sa = sb"
       using tinres_step1 h by metis
   qed
 qed (simp add: steps.simps)
 
 lemma tinres_some_exp[simp]: 
   "tinres (Bk \<up> m @ [Bk, Bk]) la \<Longrightarrow> \<exists>m. la = Bk \<up> m" unfolding tinres_def
 proof -
   let ?c1 = "\<lambda> n. Bk \<up> m @ [Bk, Bk] = la @ Bk \<up> n"
   let ?c2 = "\<lambda> n. la = (Bk \<up> m @ [Bk, Bk]) @ Bk \<up> n"
   assume "\<exists>n. ?c1 n \<or> ?c2 n"
   then obtain n where "?c1 n \<or> ?c2 n" by auto
   then consider "?c1 n" | "?c2 n" by blast
   thus ?thesis proof(cases)
     case 1
     hence "Bk \<up> Suc (Suc m) = la @ Bk \<up> n"
       by (metis exp_ind append_Cons append_eq_append_conv2 self_append_conv2)
     hence "la = Bk \<up> (Suc (Suc m) - n)"
       by (metis replicate_add append_eq_append_conv diff_add_inverse2 length_append length_replicate)
     then show ?thesis by auto
   next
     case 2
     hence "la = Bk \<up> (m + Suc (Suc n))"
       by (metis append_Cons append_eq_append_conv2 replicate_Suc replicate_add self_append_conv2)
     then show ?thesis by blast
   qed
 qed
 
 lemma t_utm_halt_eq: 
   assumes tm_wf: "tm_wf (tp, 0)"
     and exec: "steps0 (Suc 0, Bk\<up>(l), <lm::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(n))"
     and resutl: "0 < rs"
   shows "\<exists>stp m n. steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>(i)) t_utm stp = 
                                                 (0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
 proof -
   obtain ap arity fp where a: "rec_ci rec_F = (ap, arity, fp)"
     by (metis prod_cases3) 
   moreover have b: "rec_exec rec_F [code tp, (bl2wc (<lm>))] = (rs - Suc 0)"
     using assms
     apply(rule_tac F_correct, simp_all)
     done 
   have "\<exists> stp m l. steps0 (Suc 0, Bk # Bk # [], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
     (F_tprog @ shift (mopup (length [code tp, bl2wc (<lm>)])) (length F_tprog div 2)) stp
     = (0, Bk\<up>m @ Bk # Bk # [], Oc\<up>Suc (rec_exec rec_F [code tp, (bl2wc (<lm>))]) @ Bk\<up>l)"  
   proof(rule_tac recursive_compile_to_tm_correct1)
     show "rec_ci rec_F = (ap, arity, fp)" using a by simp
   next
     show "terminate rec_F [code tp, bl2wc (<lm>)]"
       using assms
       by(rule_tac terminate_F, simp_all)
   next
     show "F_tprog = tm_of (ap [+] dummy_abc (length [code tp, bl2wc (<lm>)]))"
       using a
       apply(simp add: F_tprog_def F_aprog_def numeral_2_eq_2)
       done
   qed
   then obtain stp m l where 
     "steps0 (Suc 0, Bk # Bk # [], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
     (F_tprog @ shift (mopup (length [code tp, (bl2wc (<lm>))])) (length F_tprog div 2)) stp
     = (0, Bk\<up>m @ Bk # Bk # [], Oc\<up>Suc (rec_exec rec_F [code tp, (bl2wc (<lm>))]) @ Bk\<up>l)" by blast
   hence "\<exists> m. steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
     (F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp
     = (0, Bk\<up>m, Oc\<up>Suc (rs - 1) @ Bk\<up>l)"
   proof -
     assume g: "steps0 (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk \<up> i)
       (F_tprog @ shift (mopup (length [code tp, bl2wc (<lm>)])) (length F_tprog div 2)) stp =
       (0, Bk \<up> m @ [Bk, Bk], Oc \<up> Suc ((rec_exec rec_F [code tp, bl2wc (<lm>)])) @ Bk \<up> l)"
     moreover have "tinres [Bk, Bk] [Bk]"
       apply(auto simp: tinres_def)
       done
     moreover obtain sa la ra where "steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
     (F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp = (sa, la, ra)"
       apply(case_tac "steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
     (F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp", auto)
       done
     ultimately show "?thesis"
       using b
       apply(drule_tac la = "Bk\<up>m @ [Bk, Bk]" in tinres_steps1, auto simp: numeral_2_eq_2)
       done
   qed
   thus "?thesis"
     apply(auto)
     apply(rule_tac x = stp in exI, simp add: t_utm_def)
     using assms
     apply(case_tac rs, simp_all add: numeral_2_eq_2)
     done
 qed
 
 lemma tm_wf_t_wcode[intro]: "tm_wf (t_wcode, 0)"
   apply(simp add: t_wcode_def)
   apply(rule_tac tm_comp_wf)
    apply(rule_tac tm_comp_wf, auto)
   done
 
 lemma UTM_halt_lemma_pre: 
   assumes wf_tm: "tm_wf (tp, 0)"
     and result: "0 < rs"
     and args: "args \<noteq> []"
     and exec: "steps0 (Suc 0, Bk\<up>(i), <args::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(k))"
   shows "\<exists>stp m n. steps0 (Suc 0, [], <code tp # args>) UTM_pre stp = 
                                                 (0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
 proof -
   let ?Q2 = "\<lambda> (l, r). (\<exists> ln rn. l = Bk\<up>(ln) \<and> r = Oc\<up>(rs) @ Bk\<up>(rn))"
   let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <code tp # args>"
   let ?Q1 = "\<lambda> (l, r). (l = [Bk] \<and>
     (\<exists> rn. r = Oc\<up>(Suc (code tp)) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn)))"
   let ?P2 = ?Q1
   let ?P3 = "\<lambda> (l, r). False"
   have "{?P1} (t_wcode |+| t_utm) {?Q2}"
   proof(rule_tac Hoare_plus_halt)
     show "tm_wf (t_wcode, 0)" by auto
   next
     show "{?P1} t_wcode {?Q1}"
       apply(rule_tac Hoare_haltI, auto)
       using wcode_lemma_1[of args "code tp"] args
       apply(auto)
       by (metis (mono_tags, lifting) holds_for.simps is_finalI old.prod.case)
   next
     show "{?P2} t_utm {?Q2}"
     proof(rule_tac Hoare_haltI, auto)
       fix rn
       show "\<exists>n. is_final (steps0 (Suc 0, [Bk], Oc # Oc \<up> code tp @ Bk # Oc # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_utm n) \<and>
         (\<lambda>(l, r). (\<exists>ln. l = Bk \<up> ln) \<and>
         (\<exists>rn. r = Oc \<up> rs @ Bk \<up> rn)) holds_for steps0 (Suc 0, [Bk],
         Oc # Oc \<up> code tp @ Bk # Oc # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_utm n"
         using t_utm_halt_eq[of tp i "args" stp m rs k rn] assms
         apply(auto simp: bin_wc_eq tape_of_list_def tape_of_nat_def)
         apply(rename_tac stpa) apply(rule_tac x = stpa in exI, simp)
         done
     qed
   qed
   thus "?thesis"
     apply(auto simp: Hoare_halt_def UTM_pre_def)
     apply(case_tac "steps0 (Suc 0, [], <code tp # args>) (t_wcode |+| t_utm) n",simp)
     by auto
 qed
 
 text \<open>
   The correctness of \<open>UTM\<close>, the halt case.
 \<close>
 lemma UTM_halt_lemma': 
   assumes tm_wf: "tm_wf (tp, 0)"
     and result: "0 < rs"
     and args: "args \<noteq> []"
     and exec: "steps0 (Suc 0, Bk\<up>(i), <args::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(k))"
   shows "\<exists>stp m n. steps0 (Suc 0, [], <code tp # args>) UTM stp = 
                                                 (0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
   using UTM_halt_lemma_pre[of tp rs args i stp m k] assms
   apply(simp add: UTM_pre_def t_utm_def UTM_def F_aprog_def F_tprog_def)
   apply(case_tac "rec_ci rec_F", simp)
   done
 
 definition TSTD:: "config \<Rightarrow> bool"
   where
     "TSTD c = (let (st, l, r) = c in 
              st = 0 \<and> (\<exists> m. l = Bk\<up>(m)) \<and> (\<exists> rs n. r = Oc\<up>(Suc rs) @ Bk\<up>(n)))"
 
 lemma nstd_case1: "0 < a \<Longrightarrow> NSTD (trpl_code (a, b, c))"
   by(simp add: NSTD.simps trpl_code.simps)
 
 lemma nonzero_bl2wc[simp]: "\<forall>m. b \<noteq> Bk\<up>(m) \<Longrightarrow> 0 < bl2wc b"
 proof -
   have "\<forall>m. b \<noteq> Bk \<up> m \<Longrightarrow> bl2wc b = 0 \<Longrightarrow> False" proof(induct b)
     case (Cons a b)
     then show ?case
       apply(simp add: bl2wc.simps, case_tac a, simp_all 
           add: bl2nat.simps bl2nat_double)
       apply(case_tac "\<exists> m. b = Bk\<up>(m)", erule exE)
        apply(metis append_Nil2 replicate_Suc_iff_anywhere) 
       by simp
   qed auto
   thus "\<forall>m. b \<noteq> Bk\<up>(m) \<Longrightarrow> 0 < bl2wc b" by auto
 qed
 
 lemma nstd_case2: "\<forall>m. b \<noteq> Bk\<up>(m) \<Longrightarrow> NSTD (trpl_code (a, b, c))"
   apply(simp add: NSTD.simps trpl_code.simps)
   done
 
 lemma even_not_odd[elim]: "Suc (2 * x) = 2 * y \<Longrightarrow> RR"
 proof(induct x arbitrary: y)
   case (Suc x) thus ?case by(cases y;auto)
 qed auto
 
 declare replicate_Suc[simp del]
 
 lemma bl2nat_zero_eq[simp]: "(bl2nat c 0 = 0) = (\<exists>n. c = Bk\<up>(n))"
 proof(induct c)
   case (Cons a c)
   then show ?case by (cases a;auto simp: bl2nat.simps bl2nat_double Cons_replicate_eq)
 qed (auto simp: bl2nat.simps)
 
 lemma bl2wc_exp_ex: 
   "\<lbrakk>Suc (bl2wc c) = 2 ^  m\<rbrakk> \<Longrightarrow> \<exists> rs n. c = Oc\<up>(rs) @ Bk\<up>(n)"
 proof(induct c arbitrary: m)
   case (Cons a c m)
   { fix n
     have "Bk # Bk \<up> n = Oc \<up> 0 @ Bk \<up> Suc n" by (auto simp:replicate_Suc)
     hence "\<exists>rs na. Bk # Bk \<up> n = Oc \<up> rs @ Bk \<up> na" by blast
   }
   with Cons show ?case apply(cases a, auto)
      apply(case_tac m, simp_all add: bl2wc.simps, auto)
     apply(simp add: bl2wc.simps bl2nat.simps bl2nat_double Cons)
     apply(case_tac m, simp, simp add: bin_wc_eq bl2wc.simps twice_power )
     by (metis Cons.hyps Suc_pred bl2wc.simps neq0_conv power_not_zero
         replicate_Suc_iff_anywhere zero_neq_numeral)
 qed (simp add: bl2wc.simps bl2nat.simps)
 
 lemma lg_bin: 
   assumes "\<forall>rs n. c \<noteq> Oc\<up>(Suc rs) @ Bk\<up>(n)" 
     "bl2wc c = 2 ^ lg (Suc (bl2wc c)) 2 - Suc 0"
   shows "bl2wc c = 0"
 proof -
   from assms obtain rs nat n where *:"2 ^ rs - Suc 0 = nat"
     "c = Oc \<up> rs @ Bk \<up> n" 
     using bl2wc_exp_ex[of c "lg (Suc (bl2wc c)) 2"]
     by(case_tac "(2::nat) ^ lg (Suc (bl2wc c)) 2", 
         simp, simp, erule_tac exE, erule_tac exE, simp)
   have r:"bl2wc (Oc \<up> rs) = nat" 
     by (metis "*"(1) bl2nat_exp_zero bl2wc.elims)
   hence "Suc (bl2wc c) = 2^rs" using *
     by(case_tac "(2::nat)^rs", auto)
   thus ?thesis using * assms(1)
     apply(drule_tac bl2wc_exp_ex, simp, erule_tac exE, erule_tac exE)
     by(case_tac rs, simp, simp)
 qed
 
 lemma nstd_case3: 
   "\<forall>rs n. c \<noteq> Oc\<up>(Suc rs) @ Bk\<up>(n) \<Longrightarrow>  NSTD (trpl_code (a, b, c))"
   apply(simp add: NSTD.simps trpl_code.simps)
   apply(auto)
   apply(drule_tac lg_bin, simp_all)
   done
 
 lemma NSTD_1: "\<not> TSTD (a, b, c)
     \<Longrightarrow> rec_exec rec_NSTD [trpl_code (a, b, c)] = Suc 0"
   using NSTD_lemma1[of "trpl_code (a, b, c)"]
     NSTD_lemma2[of "trpl_code (a, b, c)"]
   apply(simp add: TSTD_def)
   apply(erule_tac disjE, erule_tac nstd_case1)
   apply(erule_tac disjE, erule_tac nstd_case2)
   apply(erule_tac nstd_case3)
   done
 
 lemma nonstop_t_uhalt_eq:
   "\<lbrakk>tm_wf (tp, 0);
   steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp = (a, b, c);
   \<not> TSTD (a, b, c)\<rbrakk>
   \<Longrightarrow> rec_exec rec_nonstop [code tp, bl2wc (<lm>), stp] = Suc 0"
   apply(simp add: rec_nonstop_def rec_exec.simps)
   apply(subgoal_tac 
       "rec_exec rec_conf [code tp, bl2wc (<lm>), stp] =
   trpl_code (a, b, c)", simp)
    apply(erule_tac NSTD_1)
   using rec_t_eq_steps[of tp l lm stp]
   apply(simp)
   done
 
 lemma nonstop_true:
   "\<lbrakk>tm_wf (tp, 0);
   \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))\<rbrakk>
   \<Longrightarrow> \<forall>y. rec_exec rec_nonstop ([code tp, bl2wc (<lm>), y]) = (Suc 0)"
 proof fix y
   assume a:"tm_wf0 tp" "\<forall>stp. \<not> TSTD (steps0 (Suc 0, Bk \<up> l, <lm>) tp stp)"
   hence "\<not> TSTD (steps0 (Suc 0, Bk \<up> l, <lm>) tp y)" by auto
   thus "rec_exec rec_nonstop [code tp, bl2wc (<lm>), y] = Suc 0"
     by (cases "steps0 (Suc 0, Bk\<up>(l), <lm>) tp y")
       (auto intro: nonstop_t_uhalt_eq[OF a(1)])
 qed
 
 lemma cn_arity:  "rec_ci (Cn n f gs) = (a, b, c) \<Longrightarrow> b = n"
   by(case_tac "rec_ci f", simp add: rec_ci.simps)
 
 lemma mn_arity: "rec_ci (Mn n f) = (a, b, c) \<Longrightarrow> b = n"
   by(case_tac "rec_ci f", simp add: rec_ci.simps)
 
 lemma F_aprog_uhalt: 
   assumes wf_tm: "tm_wf (tp,0)"
     and unhalt:  "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))"
     and compile: "rec_ci rec_F = (F_ap, rs_pos, a_md)"
   shows "{\<lambda> nl. nl = [code tp, bl2wc (<lm>)] @ 0\<up>(a_md - rs_pos ) @ suflm} (F_ap) \<up>"
   using compile
 proof(simp only: rec_F_def)
   assume h: "rec_ci (Cn (Suc (Suc 0)) rec_valu [Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0)) 
     rec_conf [recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), rec_halt]]]) =
     (F_ap, rs_pos, a_md)"
   moreover hence "rs_pos = Suc (Suc 0)"
     using cn_arity 
     by simp
   moreover obtain ap1 ar1 ft1 where a: "rec_ci 
     (Cn (Suc (Suc 0)) rec_right 
     [Cn (Suc (Suc 0)) rec_conf [recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), rec_halt]]) = (ap1, ar1, ft1)"
     by(case_tac "rec_ci (Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0)) 
       rec_conf [recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), rec_halt]])", auto)
   moreover hence b: "ar1 = Suc (Suc 0)"
     using cn_arity by simp
   ultimately show "?thesis"
   proof(rule_tac i = 0 in cn_unhalt_case, auto)
     fix anything
     obtain ap2 ar2 ft2 where c: 
       "rec_ci (Cn (Suc (Suc 0)) rec_conf [recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), rec_halt])
       = (ap2, ar2, ft2)" 
       by(case_tac "rec_ci (Cn (Suc (Suc 0)) rec_conf
         [recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), rec_halt])", auto)
     moreover hence d:"ar2 = Suc (Suc 0)"
       using cn_arity by simp
     ultimately have "{\<lambda>nl. nl = [code tp, bl2wc (<lm>)] @ 0 \<up> (ft1 - Suc (Suc 0)) @ anything} ap1 \<up>"
       using a b c d
     proof(rule_tac i = 0 in cn_unhalt_case, auto)
       fix anything
       obtain ap3 ar3 ft3 where e: "rec_ci rec_halt = (ap3, ar3, ft3)"
         by(case_tac "rec_ci rec_halt", auto)
       hence f: "ar3 = Suc (Suc 0)"
         using mn_arity
         by(simp add: rec_halt_def)
       have "{\<lambda>nl. nl = [code tp, bl2wc (<lm>)] @ 0 \<up> (ft2 - Suc (Suc 0)) @ anything} ap2 \<up>"
         using c d e f
       proof(rule_tac i = 2 in cn_unhalt_case, auto simp: rec_halt_def)
         fix anything
         have "{\<lambda>nl. nl = [code tp, bl2wc (<lm>)] @ 0 \<up> (ft3 - Suc (Suc 0)) @ anything} ap3 \<up>"
           using e f
         proof(rule_tac mn_unhalt_case, auto simp: rec_halt_def)
           fix i
           show "terminate rec_nonstop [code tp, bl2wc (<lm>), i]"
             by(rule_tac primerec_terminate, auto)
         next
           fix i
           show "0 < rec_exec rec_nonstop [code tp, bl2wc (<lm>), i]"
             using assms
             by(drule_tac nonstop_true, auto)
         qed
         thus "{\<lambda>nl. nl = code tp # bl2wc (<lm>) # 0 \<up> (ft3 - Suc (Suc 0)) @ anything} ap3 \<up>" by simp
       next
         fix apj arj ftj j  anything
         assume "j<2" "rec_ci ([recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), Mn (Suc (Suc 0)) rec_nonstop] ! j) = (apj, arj, ftj)"
         hence "{\<lambda>nl. nl = [code tp, bl2wc (<lm>)] @ 0 \<up> (ftj - arj) @ anything} apj
           {\<lambda>nl. nl = [code tp, bl2wc (<lm>)] @
             rec_exec ([recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), Mn (Suc (Suc 0)) rec_nonstop] ! j) [code tp, bl2wc (<lm>)] # 
                0 \<up> (ftj - Suc arj) @ anything}"
           apply(rule_tac recursive_compile_correct)
            apply(case_tac j, auto)
            apply(rule_tac [!] primerec_terminate)
           by(auto)
         thus "{\<lambda>nl. nl = code tp # bl2wc (<lm>) # 0 \<up> (ftj - arj) @ anything} apj
           {\<lambda>nl. nl = code tp # bl2wc (<lm>) # rec_exec ([recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0))
           (Suc 0), Mn (Suc (Suc 0)) rec_nonstop] ! j) [code tp, bl2wc (<lm>)] # 0 \<up> (ftj - Suc arj) @ anything}"
           by simp
       next
         fix j
         assume "(j::nat) < 2"
         thus "terminate ([recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), Mn (Suc (Suc 0)) rec_nonstop] ! j)
           [code tp, bl2wc (<lm>)]"
           by(case_tac j, auto intro!: primerec_terminate)
       qed
       thus "{\<lambda>nl. nl = code tp # bl2wc (<lm>) # 0 \<up> (ft2 - Suc (Suc 0)) @ anything} ap2 \<up>"
         by simp
     qed
     thus "{\<lambda>nl. nl = code tp # bl2wc (<lm>) # 0 \<up> (ft1 - Suc (Suc 0)) @ anything} ap1 \<up>" by simp
   qed
 qed
 
 lemma uabc_uhalt': 
   "\<lbrakk>tm_wf (tp, 0);
   \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp));
   rec_ci rec_F = (ap, pos, md)\<rbrakk>
   \<Longrightarrow> {\<lambda> nl. nl = [code tp, bl2wc (<lm>)]} ap \<up>"
 proof(frule_tac F_ap = ap and rs_pos = pos and a_md = md
     and suflm = "[]" in F_aprog_uhalt, auto simp: abc_Hoare_unhalt_def, 
     case_tac "abc_steps_l (0, [code tp, bl2wc (<lm>)]) ap n", simp)
   fix n a b
   assume h: 
     "\<forall>n. abc_notfinal (abc_steps_l (0, code tp # bl2wc (<lm>) # 0 \<up> (md - pos)) ap n) ap"
     "abc_steps_l (0, [code tp, bl2wc (<lm>)]) ap n = (a, b)" 
     "tm_wf (tp, 0)" 
     "rec_ci rec_F = (ap, pos, md)"
   moreover have a: "ap \<noteq> []"
     using h rec_ci_not_null[of "rec_F" pos md] by auto
   ultimately show "a < length ap"
   proof(erule_tac x = n in allE)
     assume g: "abc_notfinal (abc_steps_l (0, code tp # bl2wc (<lm>) # 0 \<up> (md - pos)) ap n) ap"
     obtain ss nl where b : "abc_steps_l (0, code tp # bl2wc (<lm>) # 0 \<up> (md - pos)) ap n = (ss, nl)"
       by (metis prod.exhaust)
     then have c: "ss < length ap"
       using g by simp
     thus "?thesis"
       using a b c
       using abc_list_crsp_steps[of "[code tp, bl2wc (<lm>)]"
           "md - pos" ap n ss nl] h
       by(simp)
   qed
 qed
 
 lemma uabc_uhalt: 
   "\<lbrakk>tm_wf (tp, 0); 
   \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))\<rbrakk>
   \<Longrightarrow> {\<lambda> nl. nl = [code tp, bl2wc (<lm>)]} F_aprog \<up> "
 proof -
   obtain a b c where abc:"rec_ci rec_F = (a,b,c)" by (cases "rec_ci rec_F") force
   assume a:"tm_wf (tp, 0)" "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))"
   from uabc_uhalt'[OF a abc] abc_Hoare_plus_unhalt1
   show "{\<lambda> nl. nl = [code tp, bl2wc (<lm>)]} F_aprog \<up>"
     by(simp add: F_aprog_def abc)
 qed
 
 lemma tutm_uhalt': 
   assumes tm_wf:  "tm_wf (tp,0)"
     and unhalt: "\<forall> stp. (\<not> TSTD (steps0 (1, Bk\<up>(l), <lm>) tp stp))"
   shows "\<forall> stp. \<not> is_final (steps0 (1, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp)"
   unfolding t_utm_def
 proof(rule_tac compile_correct_unhalt, auto)
   show "F_tprog = tm_of F_aprog"
     by(simp add:  F_tprog_def)
 next
   show "crsp (layout_of F_aprog) (0, [code tp, bl2wc (<lm>)]) (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>)  []"
     by(auto simp: crsp.simps start_of.simps)
 next
   fix stp a b
   show "abc_steps_l (0, [code tp, bl2wc (<lm>)]) F_aprog stp = (a, b) \<Longrightarrow> a < length F_aprog"
     using assms
     apply(drule_tac uabc_uhalt, auto simp: abc_Hoare_unhalt_def)
     by(erule_tac x = stp in allE, erule_tac x = stp in allE, simp) 
 qed
 
 lemma tinres_commute: "tinres r r' \<Longrightarrow> tinres r' r"
   apply(auto simp: tinres_def)
   done
 
 lemma inres_tape:
   "\<lbrakk>steps0 (st, l, r) tp stp = (a, b, c); steps0 (st, l', r') tp stp = (a', b', c'); 
   tinres l l'; tinres r r'\<rbrakk>
   \<Longrightarrow> a = a' \<and> tinres b b' \<and> tinres c c'"
 proof(case_tac "steps0 (st, l', r) tp stp")
   fix aa ba ca
   assume h: "steps0 (st, l, r) tp stp = (a, b, c)" 
     "steps0 (st, l', r') tp stp = (a', b', c')"
     "tinres l l'" "tinres r r'"
     "steps0 (st, l', r) tp stp = (aa, ba, ca)"
   have "tinres b ba \<and> c = ca \<and> a = aa"
     using h
     apply(rule_tac tinres_steps1, auto)
     done
   moreover have "b' = ba \<and> tinres c' ca \<and> a' =  aa"
     using h
     apply(rule_tac tinres_steps2, auto intro: tinres_commute)
     done
   ultimately show "?thesis"
     apply(auto intro: tinres_commute)
     done
 qed
 
 lemma tape_normalize:
   assumes "\<forall> stp. \<not> is_final(steps0 (Suc 0, [Bk,Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp)"
   shows   "\<forall> stp. \<not> is_final (steps0 (Suc 0, Bk\<up>(m), <[code tp, bl2wc (<lm>)]> @ Bk\<up>(n)) t_utm stp)"
     (is "\<forall> stp. ?P stp")
 proof
   fix stp
   from assms[rule_format,of stp] show "?P stp"
     apply(case_tac "steps0 (Suc 0, Bk\<up>(m), <[code tp, bl2wc (<lm>)]> @ Bk\<up>(n)) t_utm stp", simp)
     apply(case_tac "steps0 (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp", simp)
     apply(drule_tac inres_tape, auto)
      apply(auto simp: tinres_def)
     apply(case_tac "m > Suc (Suc 0)")
      apply(rule_tac x = "m - Suc (Suc 0)" in exI) 
      apply(case_tac m, simp_all)
      apply(metis Suc_lessD Suc_pred replicate_Suc)
     apply(rule_tac x = "2 - m" in exI, simp add: replicate_add[THEN sym])
     apply(simp only: numeral_2_eq_2, simp add: replicate_Suc)
     done
 qed
 
 lemma tutm_uhalt: 
   "\<lbrakk>tm_wf (tp,0);
     \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <args>) tp stp))\<rbrakk>
   \<Longrightarrow> \<forall> stp. \<not> is_final (steps0 (Suc 0, Bk\<up>(m), <[code tp, bl2wc (<args>)]> @ Bk\<up>(n)) t_utm stp)"
   apply(rule_tac tape_normalize)
   apply(rule_tac tutm_uhalt'[simplified], simp_all)
   done
 
 lemma UTM_uhalt_lemma_pre:
   assumes tm_wf: "tm_wf (tp, 0)"
     and exec: "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <args>) tp stp))"
     and args: "args \<noteq> []"
   shows "\<forall> stp. \<not> is_final (steps0 (Suc 0, [], <code tp # args>)  UTM_pre stp)"
 proof -
   let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <code tp # args>"
   let ?Q1 = "\<lambda> (l, r). (l = [Bk] \<and>
              (\<exists> rn. r = Oc\<up>(Suc (code tp)) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn)))"
   let ?P2 = ?Q1
   have "{?P1} (t_wcode |+| t_utm) \<up>"
   proof(rule_tac Hoare_plus_unhalt)
     show "tm_wf (t_wcode, 0)" by auto
   next
     show "{?P1} t_wcode {?Q1}"
       apply(rule_tac Hoare_haltI, auto)
       using wcode_lemma_1[of args "code tp"] args
       apply(auto)
       by (metis (mono_tags, lifting) holds_for.simps is_finalI old.prod.case)
   next
     show "{?P2} t_utm \<up>"
     proof(rule_tac Hoare_unhaltI, auto)
       fix n rn
       assume h: "is_final (steps0 (Suc 0, [Bk], Oc \<up> Suc (code tp) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn) t_utm n)"
       have "\<forall> stp. \<not> is_final (steps0 (Suc 0, Bk\<up>(Suc 0), <[code tp, bl2wc (<args>)]> @ Bk\<up>(rn)) t_utm stp)"
         using assms
         apply(rule_tac tutm_uhalt, simp_all)
         done
       thus "False"
         using h
         apply(erule_tac x = n in allE)
         apply(simp add: tape_of_list_def bin_wc_eq tape_of_nat_def)
         done
     qed
   qed
   thus "?thesis"
     apply(simp add: Hoare_unhalt_def UTM_pre_def)
     done
 qed
 
 text \<open>
   The correctness of \<open>UTM\<close>, the unhalt case.
 \<close>
 
 lemma UTM_uhalt_lemma':
   assumes tm_wf: "tm_wf (tp, 0)"
     and unhalt: "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <args>) tp stp))"
     and args: "args \<noteq> []"
   shows " \<forall> stp. \<not> is_final (steps0 (Suc 0, [], <code tp # args>)  UTM stp)"
   using UTM_uhalt_lemma_pre[of tp l args] assms
   apply(simp add: UTM_pre_def t_utm_def UTM_def F_aprog_def F_tprog_def)
   apply(case_tac "rec_ci rec_F", simp)
   done
 
 lemma UTM_halt_lemma:
   assumes tm_wf: "tm_wf (p, 0)"
     and resut: "rs > 0"
     and args: "(args::nat list) \<noteq> []"
     and exec: "{(\<lambda>tp. tp = (Bk\<up>i, <args>))} p {(\<lambda>tp. tp = (Bk\<up>m, Oc\<up>rs @ Bk\<up>k))}" 
   shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM {(\<lambda>tp. (\<exists> m n. tp = (Bk\<up>m, Oc\<up>rs @ Bk\<up>n)))}"
 proof -
   let ?steps0 = "steps0 (Suc 0, [], <code p # args>)"
   let ?stepsBk = "steps0 (Suc 0, Bk\<up>i, <args>) p"
   from wcode_lemma_1[OF args,of "code p"] obtain stp ln rn where
     wcl1:"?steps0 t_wcode stp =
      (0, [Bk], Oc \<up> Suc (code p) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn)" by fast
   from exec Hoare_halt_def obtain n where
     n:"{\<lambda>tp. tp = (Bk \<up> i, <args>)} p {\<lambda>tp. tp = (Bk \<up> m, Oc \<up> rs @ Bk \<up> k)}"
     "is_final (?stepsBk n)"
     "(\<lambda>tp. tp = (Bk \<up> m, Oc \<up> rs @ Bk \<up> k)) holds_for steps0 (Suc 0, Bk \<up> i, <args>) p n"
     by auto
   obtain a where a:"a = fst (rec_ci rec_F)" by blast
   have "{(\<lambda> (l, r). l = [] \<and> r = <code p # args>)} (t_wcode |+| t_utm)
           {(\<lambda> (l, r). (\<exists> m. l = Bk\<up>m) \<and> (\<exists> n. r = Oc\<up>rs @ Bk\<up>n))}"
   proof(rule_tac Hoare_plus_halt)
     show "{\<lambda>(l, r). l = [] \<and> r = <code p # args>} t_wcode {\<lambda> (l, r). (l = [Bk] \<and>
     (\<exists> rn. r = Oc\<up>(Suc (code p)) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn)))}"
       using wcl1 by (auto intro!:Hoare_haltI exI[of _ stp])
   next
     have "\<exists> stp. (?stepsBk stp = (0, Bk\<up>m, Oc\<up>rs @ Bk\<up>k))"
       using n by (case_tac "?stepsBk n", auto)
     then obtain stp where k: "steps0 (Suc 0, Bk\<up>i, <args>) p stp = (0, Bk\<up>m, Oc\<up>rs @ Bk\<up>k)"
       ..
     thus "{\<lambda>(l, r). l = [Bk] \<and> (\<exists>rn. r = Oc \<up> Suc (code p) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn)}
       t_utm {\<lambda>(l, r). (\<exists>m. l = Bk \<up> m) \<and> (\<exists>n. r = Oc \<up> rs @ Bk \<up> n)}"
     proof(rule_tac Hoare_haltI, auto)
       fix rn
       from t_utm_halt_eq[OF assms(1) k assms(2),of rn] assms k
       have "\<exists> ma n stp. steps0 (Suc 0, [Bk], <[code p, bl2wc (<args>)]> @ Bk \<up> rn) t_utm stp =
        (0, Bk \<up> ma, Oc \<up> rs @ Bk \<up> n)" by (auto simp add: bin_wc_eq)
       then obtain stpx m' n' where
         t:"steps0 (Suc 0, [Bk], <[code p, bl2wc (<args>)]> @ Bk \<up> rn) t_utm stpx =
        (0, Bk \<up> m', Oc \<up> rs @ Bk \<up> n')" by auto
       show "\<exists>n. is_final (steps0 (Suc 0, [Bk], Oc \<up> Suc (code p) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn) t_utm n) \<and>
              (\<lambda>(l, r). (\<exists>m. l = Bk \<up> m) \<and> (\<exists>n. r = Oc \<up> rs @ Bk \<up> n)) holds_for steps0 
          (Suc 0, [Bk], Oc \<up> Suc (code p) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn) t_utm n"      
         using t
         by(auto simp: bin_wc_eq tape_of_list_def tape_of_nat_def intro:exI[of _ stpx])
     qed
   next
     show "tm_wf0 t_wcode" by auto
   qed
   then obtain n where
     "is_final (?steps0 (t_wcode |+| t_utm) n)" 
     "(\<lambda>(l, r). (\<exists>m. l = Bk \<up> m) \<and>
            (\<exists>n. r = Oc \<up> rs @ Bk \<up> n)) holds_for ?steps0 (t_wcode |+| t_utm) n"
     by(auto simp add: Hoare_halt_def a)
   thus "?thesis"
     apply(case_tac "rec_ci rec_F")
     apply(auto simp add: UTM_def Hoare_halt_def)
     apply(case_tac "(?steps0 (t_wcode |+| t_utm) n)")
     apply(rule_tac x="n" in exI)
     apply(auto simp add:a t_utm_def F_aprog_def F_tprog_def)
     done
 qed
 
 lemma UTM_halt_lemma2:
   assumes tm_wf: "tm_wf (p, 0)"
     and args: "(args::nat list) \<noteq> []"
     and exec: "{(\<lambda>tp. tp = ([], <args>))} p {(\<lambda>tp. tp = (Bk\<up>m, <(n::nat)> @ Bk\<up>k))}" 
   shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM {(\<lambda>tp. (\<exists> m k. tp = (Bk\<up>m, <n> @ Bk\<up>k)))}"
   using UTM_halt_lemma[OF assms(1) _ assms(2), where i="0"]
   using assms(3)
   by(simp add: tape_of_nat_def)
 
 lemma UTM_unhalt_lemma: 
   assumes tm_wf: "tm_wf (p, 0)"
     and unhalt: "{(\<lambda>tp. tp = (Bk\<up>i, <args>))} p \<up>"
     and args: "args \<noteq> []"
   shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM \<up>"
 proof -
   have "(\<not> TSTD (steps0 (Suc 0, Bk\<up>(i), <args>) p stp))" for stp
     (* in unhalt, we substitute inner 'forall' n\<rightarrow>stp *)
     using unhalt[unfolded Hoare_unhalt_def,rule_format,OF refl,of stp]
     by(cases "steps0 (Suc 0, Bk \<up> i, <args>) p stp",auto simp: Hoare_unhalt_def TSTD_def)
   then have "\<forall> stp. \<not> is_final (steps0 (Suc 0, [], <code p # args>)  UTM stp)"
     using assms by(intro UTM_uhalt_lemma', auto)
   thus "?thesis" by(simp add: Hoare_unhalt_def)
 qed
 
 lemma UTM_unhalt_lemma2: 
   assumes tm_wf: "tm_wf (p, 0)"
     and unhalt: "{(\<lambda>tp. tp = ([], <args>))} p \<up>"
     and args: "args \<noteq> []"
   shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM \<up>"
   using UTM_unhalt_lemma[OF assms(1), where i="0"]
   using assms(2-3)
   by(simp add: tape_of_nat_def)
 
 end
\ No newline at end of file