(*  Author:     Gertrud Bauer, Tobias Nipkow
*)

section \<open>Graph\<close>

theory Graph
imports Rotation
begin

syntax
  "_UNION1"     :: "pttrns \<Rightarrow> 'b set \<Rightarrow> 'b set"           ("(3\<Union>(\<open>unbreakable\<close>\<^bsub>_\<^esub>)/ _)" [0, 10] 10)
  "_INTER1"     :: "pttrns \<Rightarrow> 'b set \<Rightarrow> 'b set"           ("(3\<Inter>(\<open>unbreakable\<close>\<^bsub>_\<^esub>)/ _)" [0, 10] 10)
  "_UNION"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> 'b set"  ("(3\<Union>(\<open>unbreakable\<close>\<^bsub>_\<in>_\<^esub>)/ _)" [0, 0, 10] 10)
  "_INTER"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> 'b set"  ("(3\<Inter>(\<open>unbreakable\<close>\<^bsub>_\<in>_\<^esub>)/ _)" [0, 0, 10] 10)

subsection\<open>Notation\<close>

type_synonym vertex = "nat"

consts
  vertices :: "'a \<Rightarrow> vertex list"
  edges :: "'a \<Rightarrow> (vertex \<times> vertex) set" ("\<E>")

abbreviation vertices_set :: "'a \<Rightarrow> vertex set" ("\<V>") where
  "\<V> f \<equiv> set (vertices f)"

subsection \<open>Faces\<close>

text \<open>
We represent faces by (distinct) lists of vertices and a face type.
\<close>

datatype facetype = Final | Nonfinal

datatype face = Face "(vertex list)"  facetype

consts final :: "'a \<Rightarrow> bool"
consts type :: "'a \<Rightarrow> facetype"

overloading
  final_face \<equiv> "final :: face \<Rightarrow> bool"
  type_face \<equiv> "type :: face \<Rightarrow> facetype"
  vertices_face \<equiv> "vertices :: face \<Rightarrow> vertex list"
  cong_face \<equiv> "pr_isomorphic :: face \<Rightarrow> face \<Rightarrow> bool"
begin

primrec final_face where
  "final (Face vs f) = (case f of Final \<Rightarrow> True | Nonfinal \<Rightarrow> False)"

primrec type_face where
  "type (Face vs f) = f"

primrec vertices_face where
  "vertices (Face vs f) = vs"

definition cong_face :: "face \<Rightarrow> face \<Rightarrow> bool"
  where "(f\<^sub>1 :: face) \<cong> f\<^sub>2 \<equiv> vertices f\<^sub>1 \<cong> vertices f\<^sub>2"

end

text \<open>The following operation makes a face final.\<close>

definition setFinal :: "face \<Rightarrow> face" where
  "setFinal f \<equiv> Face (vertices f) Final"

text \<open>The function \<open>nextVertex\<close> (written \<open>f \<bullet> v\<close>) is based on
\<open>nextElem\<close>, that returns the successor of an element in a list.\<close>

primrec nextElem :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a" where
 "nextElem [] b x = b"
|"nextElem (a#as) b x =
    (if x=a then (case as of [] \<Rightarrow> b | (a'#as') \<Rightarrow> a') else nextElem as b x)"

definition nextVertex :: "face \<Rightarrow> vertex \<Rightarrow> vertex" (*<*)("_ \<bullet>" [999]) (*>*)where (* *)
 "f \<bullet> \<equiv> let vs = vertices f in nextElem vs (hd vs)"

text \<open>\<open>nextVertices\<close> is $n$-fold application of
\<open>nextvertex\<close>.\<close>

definition nextVertices :: "face \<Rightarrow> nat \<Rightarrow> vertex \<Rightarrow> vertex" (*<*)("_\<^bsup>_\<^esup> \<bullet> _" [100, 0, 100]) (*>*)where (* *)
  "f\<^bsup>n\<^esup> \<bullet> v \<equiv> (f \<bullet> ^^ n) v"

lemma nextV2: "f\<^bsup>2\<^esup>\<bullet>v = f\<bullet> (f\<bullet> v)"
by (simp add: nextVertices_def eval_nat_numeral)

(*<*)
overloading edges_face \<equiv> "edges :: face \<Rightarrow> (vertex \<times> vertex) set"
begin
  definition "\<E> f \<equiv> {(a, f \<bullet> a)|a. a \<in> \<V> f}"
end
(*>*)

(*<*)consts op :: "'a \<Rightarrow> 'a" ("_\<^bsup>op\<^esup>" [1000] 999)  (*>*) (* *)
overloading op_vertices \<equiv> "Graph.op :: vertex list \<Rightarrow> vertex list"
begin
  definition "(vs::vertex list)\<^bsup>op\<^esup> \<equiv> rev vs"
end

overloading op_graph \<equiv> "Graph.op :: face \<Rightarrow> face"
begin
  primrec op_graph where "(Face vs f)\<^bsup>op\<^esup> = Face (rev vs) f"
end

(*<*)

definition prevVertex :: "face \<Rightarrow> vertex \<Rightarrow> vertex" (*<*)("_\<^bsup>-1\<^esup> \<bullet>" [100]) (*>*)where (* *)
  "f\<^bsup>-1\<^esup> \<bullet> v \<equiv> (let vs = vertices f in nextElem (rev vs) (last vs) v)"

abbreviation
  triangle :: "face \<Rightarrow> bool" where
  "triangle f == |vertices f| = 3"

subsection \<open>Graphs\<close>

datatype graph = Graph "(face list)" "nat" "face list list" "nat list"

primrec faces :: "graph \<Rightarrow> face list" where
  "faces (Graph fs n f h) = fs"

abbreviation
  Faces :: "graph \<Rightarrow> face set" ("\<F>") where
  "\<F> g == set(faces g)"

primrec countVertices :: "graph \<Rightarrow> nat" where
  "countVertices (Graph fs n f h) = n"

overloading
  vertices_graph \<equiv> "vertices :: graph \<Rightarrow> vertex list"
begin
  primrec vertices_graph where "vertices (Graph fs n f h) = [0 ..< n]"
end

lemma vertices_graph: "vertices g = [0 ..< countVertices g]"
by (induct g) simp

lemma in_vertices_graph:
  "v \<in> set (vertices g) = (v < countVertices g)"
by (simp add:vertices_graph)

lemma len_vertices_graph:
  "|vertices g| = countVertices g"
by (simp add:vertices_graph)

primrec faceListAt :: "graph \<Rightarrow> face list list" where
  "faceListAt (Graph fs n f h) = f"

definition facesAt :: "graph \<Rightarrow> vertex \<Rightarrow> face list" where
 "facesAt g v \<equiv> \<^cancel>\<open>if v \<in> set(vertices g) then\<close> faceListAt g ! v \<^cancel>\<open>else []\<close>"

primrec heights :: "graph \<Rightarrow> nat list" where
  "heights (Graph fs n f h) = h"

definition height :: "graph \<Rightarrow> vertex \<Rightarrow> nat" where
  "height g v \<equiv> heights g ! v"

definition graph :: "nat \<Rightarrow> graph" where
  "graph n \<equiv>
    (let vs = [0 ..< n];
     fs = [ Face vs Final, Face (rev vs) Nonfinal]
     in (Graph fs n (replicate n fs) (replicate n 0)))"

subsection\<open>Operations on graphs\<close>

text \<open>final graph, final / nonfinal faces\<close>

definition finals :: "graph \<Rightarrow> face list" where
  "finals g \<equiv> [f \<leftarrow> faces g. final f]"

definition nonFinals :: "graph \<Rightarrow> face list" where
  "nonFinals g \<equiv> [f \<leftarrow> faces g. \<not> final f]"

definition countNonFinals :: "graph \<Rightarrow> nat" where
  "countNonFinals g \<equiv> |nonFinals g|"

overloading finalGraph \<equiv> "final :: graph \<Rightarrow> bool"
begin
  definition "finalGraph g \<equiv> (nonFinals g = [])"
end

lemma finalGraph_faces[simp]: "final g \<Longrightarrow> finals g = faces g"
 by (simp add: finalGraph_def finals_def nonFinals_def filter_compl1)

lemma finalGraph_face: "final g \<Longrightarrow> f \<in> set (faces g) \<Longrightarrow> final f"
  by (simp only: finalGraph_faces[symmetric]) (simp add: finals_def)

definition finalVertex :: "graph \<Rightarrow> vertex \<Rightarrow> bool" where
  "finalVertex g v \<equiv> \<forall>f \<in> set(facesAt g v). final f"

lemma finalVertex_final_face[dest]:
  "finalVertex g v \<Longrightarrow> f \<in> set (facesAt g v) \<Longrightarrow> final f"
  by (auto simp add: finalVertex_def)

text \<open>counting faces\<close>

definition degree :: "graph \<Rightarrow> vertex \<Rightarrow> nat" where
  "degree g v \<equiv> |facesAt g v|"

definition tri :: "graph \<Rightarrow> vertex \<Rightarrow> nat" where
 "tri g v \<equiv> |[f \<leftarrow> facesAt g v. final f \<and> |vertices f| = 3]|"

definition quad :: "graph \<Rightarrow> vertex \<Rightarrow> nat" where
 "quad g v \<equiv> |[f \<leftarrow> facesAt g v. final f \<and> |vertices f| = 4]|"

definition except :: "graph \<Rightarrow> vertex \<Rightarrow> nat" where
 "except g v \<equiv> |[f \<leftarrow> facesAt g v. final f \<and> 5 \<le> |vertices f| ]|"

definition vertextype :: "graph \<Rightarrow> vertex \<Rightarrow> nat \<times> nat \<times> nat" where
  "vertextype g v \<equiv> (tri g v, quad g v, except g v)"

lemma[simp]: "0 \<le> quad g v" by (simp add: quad_def)

lemma[simp]: "0 \<le> except g v" by (simp add: except_def)

definition exceptionalVertex :: "graph \<Rightarrow> vertex \<Rightarrow> bool" where
  "exceptionalVertex g v \<equiv> except g v \<noteq> 0"

definition noExceptionals :: "graph \<Rightarrow> vertex set \<Rightarrow> bool" where
  "noExceptionals g V \<equiv> (\<forall>v \<in> V. \<not> exceptionalVertex g v)"

text \<open>An edge $(a,b)$ is contained in face f,
  $b$ is the successor of $a$ in $f$.\<close>
(*>*)
overloading edges_graph \<equiv> "edges :: graph \<Rightarrow> (vertex \<times> vertex) set"
begin
  definition "\<E> (g::graph) \<equiv> \<Union>\<^bsub>f \<in> \<F> g\<^esub> edges f"
end

definition neighbors :: "graph \<Rightarrow> vertex \<Rightarrow> vertex list" where
 "neighbors g v \<equiv> [f\<bullet>v. f \<leftarrow> facesAt g v]"

subsection \<open>Navigation in graphs\<close>

text \<open>
The function $s'$ permutating the faces at a vertex,
is implemeted by the function \<open>nextFace\<close>
\<close>

definition nextFace :: "graph \<times> vertex \<Rightarrow> face \<Rightarrow> face" (*<*)("_ \<bullet>") (*>*)where
(*<*) nextFace_def_aux: "p \<bullet> \<equiv> \<lambda>f. (let (g,v) = p; fs = (facesAt g v) in
   (case fs of [] \<Rightarrow> f
           | g#gs \<Rightarrow> nextElem fs (hd fs) f))"  (*>*)

(* precondition a b in f *)
definition directedLength :: "face \<Rightarrow> vertex \<Rightarrow> vertex \<Rightarrow> nat" where
  "directedLength f a b \<equiv>
  if a = b then 0 else |(between (vertices f) a b)| + 1"

subsection \<open>Code generator setup\<close>

definition final_face :: "face \<Rightarrow> bool" where
  final_face_code_def: "final_face = final"
declare final_face_code_def [symmetric, code_unfold]

lemma final_face_code [code]:
  "final_face (Face vs Final) \<longleftrightarrow> True"
  "final_face (Face vs Nonfinal) \<longleftrightarrow> False"
  by (simp_all add: final_face_code_def)

definition final_graph :: "graph \<Rightarrow> bool" where
  final_graph_code_def: "final_graph = final"
declare final_graph_code_def [symmetric, code_unfold]

lemma final_graph_code [code]: "final_graph g = List.null (nonFinals g)"
  unfolding final_graph_code_def finalGraph_def null_def ..

definition vertices_face :: "face \<Rightarrow> vertex list" where
  vertices_face_code_def: "vertices_face = vertices"
declare vertices_face_code_def [symmetric, code_unfold]

lemma vertices_face_code [code]: "vertices_face (Face vs f) = vs"
  unfolding vertices_face_code_def by simp

definition vertices_graph :: "graph \<Rightarrow> vertex list" where
  vertices_graph_code_def: "vertices_graph = vertices"
declare vertices_graph_code_def [symmetric, code_unfold]

lemma vertices_graph_code [code]:
  "vertices_graph (Graph fs n f h) = [0 ..< n]"
  unfolding vertices_graph_code_def by simp

end


section {*L\_ATS\_Simulation\_Configuration\_Weak*}
theory
  L_ATS_Simulation_Configuration_Weak

imports
  PRJ_06_06__PRE

begin

(*
translation of
  is_forward_edge_deterministic_accessible
  get_accessible_configurations
  Nonblockingness_branching
  unmarked language
  marked language
using
  simulation relation on configuration where steps are mimicked weakly.
*)

locale ATS_Simulation_Configuration_Weak =
  GL:
  ATS_Language
  "TSstructure1 :: 'TSstructure1 \<Rightarrow> bool"
  "configurations1 :: 'TSstructure1 \<Rightarrow> 'conf1 set"
  "initial_configurations1 :: 'TSstructure1 \<Rightarrow> 'conf1 set"
  "step_labels1 :: 'TSstructure1 \<Rightarrow> 'label1 set"
  "step_relation1 :: 'TSstructure1 \<Rightarrow> 'conf1 \<Rightarrow> 'label1 \<Rightarrow> 'conf1 \<Rightarrow> bool"
  "effects1 :: 'TSstructure1 \<Rightarrow> 'event1 set"
  "marking_condition1 :: 'TSstructure1 \<Rightarrow> ('label1,'conf1)derivation \<Rightarrow> bool"
  "marked_effect1 :: 'TSstructure1 \<Rightarrow> ('label1,'conf1)derivation \<Rightarrow> 'event1 set"
  "unmarked_effect1 :: 'TSstructure1 \<Rightarrow> ('label1,'conf1)derivation \<Rightarrow> 'event1 set"
  +
  GR:
  ATS_Language
  "TSstructure2 :: 'TSstructure2 \<Rightarrow> bool"
  "configurations2 :: 'TSstructure2 \<Rightarrow> 'conf2 set"
  "initial_configurations2 :: 'TSstructure2 \<Rightarrow> 'conf2 set"
  "step_labels2 :: 'TSstructure2 \<Rightarrow> 'label2 set"
  "step_relation2 :: 'TSstructure2 \<Rightarrow> 'conf2 \<Rightarrow> 'label2 \<Rightarrow> 'conf2 \<Rightarrow> bool"
  "effects2 :: 'TSstructure2 \<Rightarrow> 'event2 set"
  "marking_condition2 :: 'TSstructure2 \<Rightarrow> ('label2,'conf2)derivation \<Rightarrow> bool"
  "marked_effect2 :: 'TSstructure2 \<Rightarrow> ('label2,'conf2)derivation \<Rightarrow> 'event2 set"
  "unmarked_effect2 :: 'TSstructure2 \<Rightarrow> ('label2,'conf2)derivation \<Rightarrow> 'event2 set"
  for
    TSstructure1 configurations1 initial_configurations1 step_labels1 step_relation1 effects1 marking_condition1 marked_effect1 unmarked_effect1 TSstructure2 configurations2 initial_configurations2 step_labels2 step_relation2 effects2 marking_condition2 marked_effect2 unmarked_effect2
    +

fixes relation_configuration :: "'TSstructure1 \<Rightarrow> 'TSstructure2 \<Rightarrow> 'conf1 \<Rightarrow> 'conf2 \<Rightarrow> bool"

fixes relation_initial_configuration :: "'TSstructure1 \<Rightarrow> 'TSstructure2 \<Rightarrow> 'conf1 \<Rightarrow> 'conf2 \<Rightarrow> bool"

fixes relation_effect :: "'TSstructure1 \<Rightarrow> 'TSstructure2 \<Rightarrow> 'event1 \<Rightarrow> 'event2 \<Rightarrow> bool"

fixes relation_TSstructure :: "'TSstructure1 \<Rightarrow> 'TSstructure2 \<Rightarrow> bool"

fixes relation_initial_simulation :: "'TSstructure1 \<Rightarrow> 'TSstructure2 \<Rightarrow> 'conf1 \<Rightarrow> ('label2, 'conf2) derivation \<Rightarrow> bool"

fixes relation_step_simulation :: "'TSstructure1 \<Rightarrow> 'TSstructure2 \<Rightarrow> 'conf1 \<Rightarrow> 'label1 \<Rightarrow> 'conf1 \<Rightarrow> 'conf2 \<Rightarrow> ('label2, 'conf2) derivation \<Rightarrow> bool"

assumes AX_TSstructure_relation_TSstructure1_belongs: "
  relation_TSstructure G1 G2
  \<Longrightarrow> TSstructure1 G1"

assumes AX_TSstructure_relation_TSstructure2_belongs: "
  relation_TSstructure G1 G2
  \<Longrightarrow> TSstructure2 G2"

assumes AX_relation_initial_simulation: "
  relation_TSstructure G1 G2
  \<Longrightarrow> c1 \<in> initial_configurations1 G1
  \<Longrightarrow> \<exists>d2 n.
  GR.derivation_initial G2 d2
  \<and> relation_initial_configuration G1 G2 c1 (the(get_configuration(d2 0)))
  \<and> relation_initial_simulation G1 G2 c1 d2
  \<and> maximum_of_domain d2 n
  \<and> relation_configuration G1 G2 c1 (the(get_configuration(d2 n)))"

assumes AX_relation_step_simulation: "
  relation_TSstructure G1 G2
  \<Longrightarrow> relation_configuration G1 G2 c1 c2
  \<Longrightarrow> e1 \<in> step_labels1 G1
  \<Longrightarrow> step_relation1 G1 c1 e1 c1'
  \<Longrightarrow> \<exists>d2 n.
  GR.derivation G2 d2
  \<and> GR.belongs G2 d2
  \<and> the(get_configuration(d2 0)) = c2
  \<and> relation_step_simulation G1 G2 c1 e1 c1' c2 d2
  \<and> maximum_of_domain d2 n
  \<and> relation_configuration G1 G2 c1' (the(get_configuration(d2 n)))"

context ATS_Simulation_Configuration_Weak begin

definition simulating_derivation_I :: "
  'TSstructure1
  \<Rightarrow> 'TSstructure2
  \<Rightarrow> ('label1, 'conf1) derivation
  \<Rightarrow> nat
  \<Rightarrow> ('label2, 'conf2) derivation
  \<Rightarrow> nat
  \<Rightarrow> (nat \<Rightarrow> nat)
  \<Rightarrow> bool"
  where
    "simulating_derivation_I G1 G2 d1 n1 d2 n2 f \<equiv>
  \<exists>d2' n.
  relation_initial_simulation G1 G2 (the (get_configuration (d1 0))) d2'
  \<and> maximum_of_domain d2' n
  \<and> derivation_take d2 n = d2'
  \<and> f 0 = n
  \<and> d2 n \<noteq> None"

definition simulating_derivation_DEF :: "
  'TSstructure1
  \<Rightarrow> 'TSstructure2
  \<Rightarrow> ('label1, 'conf1) derivation
  \<Rightarrow> nat
  \<Rightarrow> ('label2, 'conf2) derivation
  \<Rightarrow> nat
  \<Rightarrow> (nat \<Rightarrow> nat)
  \<Rightarrow> bool"
  where
    "simulating_derivation_DEF G1 G2 d1 n1 d2 n2 f \<equiv>
  (\<forall>i \<le> n1.
    d2 (f i) \<noteq> None
    \<and> relation_configuration G1 G2
        (the (get_configuration(d1 i)))
        (the (get_configuration(d2 (f i)))))
  \<and> f n1 = n2"

definition simulating_derivation_S :: "
  'TSstructure1
  \<Rightarrow> 'TSstructure2
  \<Rightarrow> ('label1, 'conf1) derivation
  \<Rightarrow> nat
  \<Rightarrow> ('label2, 'conf2) derivation
  \<Rightarrow> nat
  \<Rightarrow> (nat \<Rightarrow> nat)
  \<Rightarrow> bool"
  where
    "simulating_derivation_S G1 G2 d1 n1 d2 n2 f \<equiv>
  \<forall>i < n1. \<forall>ei ci ei' ci'.
    d1 i = Some (pair ei ci)
    \<and> d1 (Suc i) = Some (pair (Some ei') ci')
    \<longrightarrow> (\<exists>d2' n.
    relation_step_simulation G1 G2 ci ei' ci'
      (the (get_configuration (d2(f i)))) d2'
    \<and> maximum_of_domain d2' n
    \<and> f (Suc i) = f i + n
    \<and> derivation_take (derivation_drop d2 (f i)) n = d2')"

definition simulating_derivation :: "
  'TSstructure1
  \<Rightarrow> 'TSstructure2
  \<Rightarrow> ('label1, 'conf1) derivation
  \<Rightarrow> nat
  \<Rightarrow> ('label2, 'conf2) derivation
  \<Rightarrow> nat
  \<Rightarrow> (nat \<Rightarrow> nat)
  \<Rightarrow> bool"
  where
    "simulating_derivation G1 G2 d1 n1 d2 n2 f \<equiv>
  simulating_derivation_I G1 G2 d1 n1 d2 n2 f
  \<and> simulating_derivation_S G1 G2 d1 n1 d2 n2 f
  \<and> simulating_derivation_DEF G1 G2 d1 n1 d2 n2 f"

lemma mono_one: "
  simulating_derivation G1 G2 d1 n1 d2 n2 f
  \<Longrightarrow> GL.derivation_initial G1 d1
  \<Longrightarrow> d1 n1\<noteq>None
  \<Longrightarrow> Suc x \<le> n1
  \<Longrightarrow> f x \<le> f (Suc x)"
  apply(simp add: simulating_derivation_def)
  apply(clarsimp)
  apply(rename_tac y)(*strict*)
  apply(simp add: simulating_derivation_S_def)
  apply(erule_tac
      x="x"
      in allE)
  apply(clarsimp)
  apply(subgoal_tac "\<exists>e1 e2 c1 c2. d1 x = Some (pair e1 c1) \<and> d1 (Suc x) = Some (pair (Some e2) c2) \<and> step_relation1 G1 c1 e2 c2")
   apply(rename_tac y)(*strict*)
   prefer 2
   apply(rule_tac
      m="n1"
      in GL.step_detail_before_some_position)
     apply(rename_tac y)(*strict*)
     apply(rule GL.derivation_initial_is_derivation)
     apply(force)
    apply(rename_tac y)(*strict*)
    apply(simp add: maximum_of_domain_def)
   apply(rename_tac y)(*strict*)
   apply(force)
  apply(rename_tac y)(*strict*)
  apply(clarsimp)
  done

lemma mono_all: "
  simulating_derivation G1 G2 d1 n1 d2 n2 f
  \<Longrightarrow> GL.derivation_initial G1 d1
  \<Longrightarrow> d1 n1\<noteq>None
  \<Longrightarrow> x \<le> y
  \<Longrightarrow> y \<le> n1
  \<Longrightarrow> f x \<le> f y"
  apply(induct "y-x" arbitrary: x)
   apply(rename_tac x)(*strict*)
   apply(clarsimp)
  apply(rename_tac xa x)(*strict*)
  apply(clarsimp)
  apply(rename_tac xa x ya)(*strict*)
  apply(case_tac y)
   apply(rename_tac xa x ya)(*strict*)
   apply(force)
  apply(rename_tac xa x ya nat)(*strict*)
  apply(clarsimp)
  apply(rename_tac xa x y nat)(*strict*)
  apply(erule_tac
      x="Suc x"
      in meta_allE)
  apply(clarsimp)
  apply(erule meta_impE)
   apply(rename_tac xa x y nat)(*strict*)
   apply(force)
  apply(rename_tac xa x y nat)(*strict*)
  apply(erule meta_impE)
   apply(rename_tac xa x y nat)(*strict*)
   apply(force)
  apply(rename_tac xa x y nat)(*strict*)
  apply(rule_tac
      j="f(Suc x)"
      in le_trans)
   apply(rename_tac xa x y nat)(*strict*)
   apply(rule mono_one)
      apply(rename_tac xa x y nat)(*strict*)
      apply(force)
     apply(rename_tac xa x y nat)(*strict*)
     apply(force)
    apply(rename_tac xa x y nat)(*strict*)
    apply(force)
   apply(rename_tac xa x y nat)(*strict*)
   apply(force)
  apply(rename_tac xa x y nat)(*strict*)
  apply(force)
  done

lemma ATS_Simulation_Configuration_Weak_simulation_derivation_exists_witness: "
  relation_TSstructure G1 G2
  \<Longrightarrow> GL.derivation_initial G1 d1
  \<Longrightarrow> d1 x = Some (pair e1 c1)
  \<Longrightarrow> \<exists>d2 n2 f.
  GR.derivation_initial G2 d2
  \<and> maximum_of_domain d2 n2
  \<and> relation_initial_configuration G1 G2 (the (get_configuration (d1 0))) (the (get_configuration (d2 0)))
  \<and> relation_configuration G1 G2 c1 (the (get_configuration (d2 n2)))
  \<and> simulating_derivation G1 G2 d1 x d2 n2 f"
  apply(induct x arbitrary: e1 c1)
   apply(rename_tac e1 c1)(*strict*)
   apply(clarsimp)
   apply(subgoal_tac "c1 \<in> initial_configurations1 G1")
    apply(rename_tac e1 c1)(*strict*)
    prefer 2
    apply(simp add: GL.derivation_initial_def)
   apply(rename_tac e1 c1)(*strict*)
   apply(subgoal_tac "\<exists>d2 n. GR.derivation_initial G2 d2 \<and> relation_initial_configuration G1 G2 c1 (the(get_configuration(d2 0))) \<and> relation_initial_simulation G1 G2 c1 d2 \<and> maximum_of_domain d2 n \<and> relation_configuration G1 G2 c1 (the(get_configuration(d2 n)))")
    apply(rename_tac e1 c1)(*strict*)
    prefer 2
    apply(rule AX_relation_initial_simulation)
     apply(rename_tac e1 c1)(*strict*)
     apply(force)
    apply(rename_tac e1 c1)(*strict*)
    apply(force)
   apply(rename_tac e1 c1)(*strict*)
   apply(clarsimp)
   apply(rename_tac e1 c1 d2 n)(*strict*)
   apply(rule_tac
      x="d2"
      in exI)
   apply(clarsimp)
   apply(rule_tac
      x="n"
      in exI)
   apply(clarsimp)
   apply(rule conjI)
    apply(rename_tac e1 c1 d2 n)(*strict*)
    apply(simp add: get_configuration_def)
   apply(rename_tac e1 c1 d2 n)(*strict*)
   apply(rule_tac
      x="\<lambda>x. n"
      in exI)
   apply(simp add: simulating_derivation_def)
   apply(rule conjI)
    apply(rename_tac e1 c1 d2 n)(*strict*)
    apply(simp add: simulating_derivation_I_def)
    apply(rule conjI)
     apply(rename_tac e1 c1 d2 n)(*strict*)
     apply(simp add: get_configuration_def)
     apply (metis GR.derivation_take_id_prime_prime GR.derivation_initial_is_derivation eq_imp_le)
    apply(rename_tac e1 c1 d2 n)(*strict*)
    apply(rule conjI)
     apply(rename_tac e1 c1 d2 n)(*strict*)
     apply(simp add: maximum_of_domain_def derivation_take_def get_configuration_def)
    apply(rename_tac e1 c1 d2 n)(*strict*)
    apply(simp add: maximum_of_domain_def)
   apply(rename_tac e1 c1 d2 n)(*strict*)
   apply(rule conjI)
    apply(rename_tac e1 c1 d2 n)(*strict*)
    apply(simp add: simulating_derivation_S_def)
   apply(rename_tac e1 c1 d2 n)(*strict*)
   apply(simp add: simulating_derivation_DEF_def)
   apply(rule conjI)
    apply(rename_tac e1 c1 d2 n)(*strict*)
    apply(simp add: maximum_of_domain_def)
   apply(rename_tac e1 c1 d2 n)(*strict*)
   apply(simp add: get_configuration_def)
  apply(rename_tac x e1 c1)(*strict*)
  apply(clarsimp)
  apply(subgoal_tac "\<exists>e1 e2 c1 c2. d1 x = Some (pair e1 c1) \<and> d1 (Suc x) = Some (pair (Some e2) c2) \<and> step_relation1 G1 c1 e2 c2")
   apply(rename_tac x e1 c1)(*strict*)
   prefer 2
   apply(rule_tac
      m="Suc x"
      in GL.step_detail_before_some_position)
     apply(rename_tac x e1 c1)(*strict*)
     apply(rule GL.derivation_initial_is_derivation)
     apply(force)
    apply(rename_tac x e1 c1)(*strict*)
    apply(simp add: maximum_of_domain_def)
   apply(rename_tac x e1 c1)(*strict*)
   apply(force)
  apply(rename_tac x e1 c1)(*strict*)
  apply(clarsimp)
  apply(rename_tac x c1 e1a e2 c1a)(*strict*)
  apply(erule_tac
      x="e1a"
      in meta_allE)
  apply(erule_tac
      x="c1a"
      in meta_allE)
  apply(clarsimp)
  apply(rename_tac x c1 e1a e2 c1a d2 n2 xa)(*strict*)
  apply(rename_tac f)
  apply(rename_tac x c1 e1a e2 c1a d2 n2 f)(*strict*)
  apply(subgoal_tac "\<exists>e c. d2 n2 = Some (pair e c)")
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f)(*strict*)
   apply(clarsimp)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e c)(*strict*)
   apply(subgoal_tac "\<exists>d2 n. GR.derivation G2 d2 \<and> GR.belongs G2 d2 \<and> the(get_configuration(d2 0)) = c \<and> relation_step_simulation G1 G2 c1a e2 c1 c d2 \<and> maximum_of_domain d2 n \<and> relation_configuration G1 G2 c1 (the(get_configuration(d2 n)))")
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e c)(*strict*)
    prefer 2
    apply(rule AX_relation_step_simulation)
       apply(rename_tac x c1 e1a e2 c1a d2 n2 f e c)(*strict*)
       apply(force)
      apply(rename_tac x c1 e1a e2 c1a d2 n2 f e c)(*strict*)
      apply(simp add: get_configuration_def)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 f e c)(*strict*)
     apply (metis GL.belongs_step_labels GL.derivation_initial_belongs AX_TSstructure_relation_TSstructure1_belongs)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e c)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e c)(*strict*)
   apply(clarsimp)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n)(*strict*)
   apply(rule_tac
      x="derivation_append d2 d2a n2"
      in exI)
   apply(subgoal_tac "\<exists>c. d2a 0 = Some (pair None c)")
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n)(*strict*)
    apply(clarsimp)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
    apply(rule context_conjI)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
     apply(rule GR.derivation_append_preserves_derivation_initial)
       apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
       apply (metis AX_TSstructure_relation_TSstructure2_belongs)
      apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
      apply(force)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
     apply(rule GR.derivation_append_preserves_derivation)
       apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
       apply (metis GR.derivation_initial_is_derivation)
      apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
      apply(force)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
     apply(clarsimp)
     apply(simp add: get_configuration_def)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
    apply(rule_tac
      x="n2+n"
      in exI)
    apply(rule context_conjI)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
     apply (metis concat_has_max_dom)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
    apply(rule context_conjI)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
     apply(simp add: get_configuration_def derivation_append_def)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
    apply(rule conjI)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
     apply(simp add: get_configuration_def derivation_append_def)
     apply(clarsimp)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
    defer
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n)(*strict*)
    apply (metis GR.some_position_has_details_at_0)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f)(*strict*)
   apply(rule GR.some_position_has_details_before_max_dom)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 f)(*strict*)
     apply(rule GR.derivation_initial_is_derivation)
     apply(force)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f)(*strict*)
   apply(force)
  apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
  apply(rule_tac
      x="\<lambda>z. if z<Suc x then f z else f x + n"
      in exI)
  apply(simp add: simulating_derivation_def)
  apply(rule context_conjI)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
   apply(clarsimp)
   apply(simp only: simulating_derivation_I_def)
   apply(erule exE)+
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c d2' na)(*strict*)
   apply(rule_tac
      x="d2'"
      in exI)
   apply(rule_tac
      x="na"
      in exI)
   apply(rule conjI)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c d2' na)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c d2' na)(*strict*)
   apply(rule conjI)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c d2' na)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c d2' na)(*strict*)
   apply(rule conjI)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c d2' na)(*strict*)
    apply (metis GR.allPreMaxDomSome_prime derivation_take_derivation_append_ignore GR.derivation_initial_is_derivation)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c d2' na)(*strict*)
   apply(rule conjI)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c d2' na)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c d2' na)(*strict*)
   apply (metis GR.allPreMaxDomSome_prime derivation_take_conf_end derivation_take_derivation_append_ignore GR.derivation_initial_is_derivation)
  apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
  apply(rule propSym,rule context_conjI)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
   apply(simp add: simulating_derivation_DEF_def)
   apply(clarsimp)
   apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i)(*strict*)
   apply(rule conjI)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i)(*strict*)
    apply(clarsimp)
    apply(erule_tac
      x="i"
      in allE)
    apply(clarsimp)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i y)(*strict*)
    apply(subgoal_tac "f i \<le> f x")
     apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i y)(*strict*)
     prefer 2
     apply(rule_tac
      d="d2"
      in GR.allPreMaxDomSome_prime)
       apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i y)(*strict*)
       prefer 3
       apply(force)
      apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i y)(*strict*)
      apply(rule GR.derivation_initial_is_derivation)
      apply(force)
     apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i y)(*strict*)
     apply(force)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i y)(*strict*)
    apply(simp add: derivation_append_def)
   apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i)(*strict*)
   apply(clarsimp)
   apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c)(*strict*)
   apply(erule disjE)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c)(*strict*)
    apply(simp add: derivation_append_def maximum_of_domain_def)
   apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c)(*strict*)
   apply(subgoal_tac "get_configuration(derivation_append d2 d2a (f x) (f x + n)) = get_configuration(d2a n)")
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c)(*strict*)
    apply(simp add: get_configuration_def)
   apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c)(*strict*)
   apply(simp add: derivation_append_def)
   apply(clarsimp)
   apply(rename_tac x c1 e1a e2 c1a d2 f e d2a c)(*strict*)
   apply(simp add: get_configuration_def)
  apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c)(*strict*)
  apply(simp add: simulating_derivation_S_def)
  apply(erule conjE)+
  apply(rule allI)
  apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
  apply(case_tac "i<x")
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
   apply(rule conjI)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
   apply(rule impI)
   apply(thin_tac "i<x")
   apply(erule_tac
      x="i"
      in allE)
   apply(erule impE)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
   apply(rule allI)+
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci')(*strict*)
   apply(rule impI)
   apply(erule_tac
      x="ei"
      in allE)
   apply(erule_tac
      x="ci"
      in allE)
   apply(erule_tac
      x="ei'"
      in allE)
   apply(erule_tac
      x="ci'"
      in allE)
   apply(erule impE)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci')(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci')(*strict*)
   apply(erule exE)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2')(*strict*)
   apply(rule_tac
      x="d2'"
      in exI)
   apply(subgoal_tac "f i \<le> n2")
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2')(*strict*)
    prefer 2
    apply(simp add: simulating_derivation_DEF_def)
    apply(clarsimp)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na)(*strict*)
    apply(erule_tac
      x="i"
      and P="\<lambda>i. i \<le> x \<longrightarrow> (\<exists>y. d2 (f i) = Some y) \<and> relation_configuration G1 G2 (the (get_configuration (d1 i))) (the (get_configuration (d2 (f i))))"
      in allE)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na)(*strict*)
    apply(clarsimp)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na y)(*strict*)
    apply(rule_tac
      d="d2"
      in GR.allPreMaxDomSome_prime)
      apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na y)(*strict*)
      prefer 3
      apply(force)
     apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na y)(*strict*)
     apply(rule GR.derivation_initial_is_derivation)
     apply(force)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na y)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2')(*strict*)
   apply(rule_tac
      t="derivation_append d2 d2a n2 (f i)"
      and s="d2 (f i)"
      in ssubst)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2')(*strict*)
    apply(simp add: derivation_append_def get_configuration_def)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2')(*strict*)
   apply(rule conjI)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2')(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2')(*strict*)
   apply(erule conjE)+
   apply(erule exE)+
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2' na)(*strict*)
   apply(erule conjE)+
   apply(rule_tac
      x="na"
      in exI)
   apply(rule conjI)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2' na)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2' na)(*strict*)
   apply(rule conjI)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2' na)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2' na)(*strict*)
   apply(subgoal_tac "f i+na \<le> n2")
    apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2' na)(*strict*)
    prefer 2
    apply(simp add: simulating_derivation_DEF_def)
    apply(clarsimp)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na)(*strict*)
    apply(erule_tac
      x="Suc i"
      and P="\<lambda>i. i \<le> x \<longrightarrow> (\<exists>y. d2 (f (i)) = Some y) \<and> relation_configuration G1 G2 (the (get_configuration (d1 (i)))) (the (get_configuration (d2 (f (i)))))"
      in allE)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na)(*strict*)
    apply(clarsimp)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na y)(*strict*)
    apply(rule_tac
      d="d2"
      in GR.allPreMaxDomSome_prime)
      apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na y)(*strict*)
      prefer 3
      apply(force)
     apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na y)(*strict*)
     apply(rule GR.derivation_initial_is_derivation)
     apply(force)
    apply(rename_tac x c1 e1a e2 c1a d2 f e d2a n c i ei ci ei' ci' na y)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' d2' na)(*strict*)
   apply(clarsimp)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' na)(*strict*)
   apply(rule ext)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci' na xa)(*strict*)
   apply(simp add: derivation_take_def derivation_drop_def derivation_append_def)
  apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
  apply(rule conjI)
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
   apply(force)
  apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
  apply(rule impI)
  apply(rule impI)
  apply(subgoal_tac "i=x")
   apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i)(*strict*)
  apply(thin_tac "\<not> i < x")
  apply(thin_tac "\<not> i < x")
  apply(thin_tac "i < Suc x")
  apply(rule allI)+
  apply(rename_tac x c1 e1a e2 c1a d2 n2 f e d2a n c i ei ci ei' ci')(*strict*)
  apply(rule impI)
  apply(clarsimp)
  apply(rename_tac x d2 n2 f e d2a n c ei ci ei' ci')(*strict*)
  apply(subgoal_tac "f x=n2")
   apply(rename_tac x d2 n2 f e d2a n c ei ci ei' ci')(*strict*)
   prefer 2
   apply(simp add: simulating_derivation_DEF_def)
  apply(rename_tac x d2 n2 f e d2a n c ei ci ei' ci')(*strict*)
  apply(clarsimp)
  apply(rename_tac x d2 f e d2a n c ei ci ei' ci')(*strict*)
  apply(rule_tac
      t="(the (get_configuration (derivation_append d2 d2a (f x) (f x))))"
      and s="(the (get_configuration (Some (pair None c))))"
      in ssubst)
   apply(rename_tac x d2 f e d2a n c ei ci ei' ci')(*strict*)
   apply(simp add: get_configuration_def derivation_append_def)
  apply(rename_tac x d2 f e d2a n c ei ci ei' ci')(*strict*)
  apply(rule_tac
      t="derivation_take (derivation_drop (derivation_append d2 d2a (f x)) (f x)) n"
      and s="d2a"
      in ssubst)
   apply(rename_tac x d2 f e d2a n c ei ci ei' ci')(*strict*)
   apply(rule ext)
   apply(rename_tac x d2 f e d2a n c ei ci ei' ci' xa)(*strict*)
   apply(simp add: derivation_take_def derivation_drop_def derivation_append_def)
   apply(simp add: get_configuration_def)
   apply(clarsimp)
   apply (metis GR.allPreMaxDomSome_prime)
  apply(rename_tac x d2 f e d2a n c ei ci ei' ci')(*strict*)
  apply(rule conjI)
   apply(rename_tac x d2 f e d2a n c ei ci ei' ci')(*strict*)
   apply(force)
  apply(rename_tac x d2 f e d2a n c ei ci ei' ci')(*strict*)
  apply(force)
  done

lemma ATS_Simulation_Configuration_Weak_simulation_derivation_exists: "
  relation_TSstructure G1 G2
  \<Longrightarrow> GL.derivation_initial G1 d1
  \<Longrightarrow> d1 x = Some (pair e1 c1)
  \<Longrightarrow> \<exists>d2 n2.
  GR.derivation_initial G2 d2
  \<and> maximum_of_domain d2 n2
  \<and> relation_initial_configuration G1 G2 (the (get_configuration (d1 0))) (the (get_configuration (d2 0)))
  \<and> relation_configuration G1 G2 c1 (the (get_configuration (d2 n2)))"
  apply(metis ATS_Simulation_Configuration_Weak_simulation_derivation_exists_witness)
  done

lemma ATS_Simulation_Configuration_Weak_simulation_derivation_exists_witness2: "
  relation_TSstructure G1 G2
  \<Longrightarrow> GL.derivation G1 d1
  \<Longrightarrow> GL.belongs G1 d1
  \<Longrightarrow> d1 0 = Some (pair e0 c0)
  \<Longrightarrow> relation_configuration G1 G2 c0 c0'
  \<Longrightarrow> c0' \<in> configurations2 G2
  \<Longrightarrow> d1 x = Some (pair e1 c1)
  \<Longrightarrow> \<exists>d2 n2.
  GR.derivation G2 d2
  \<and> GR.belongs G2 d2
  \<and> maximum_of_domain d2 n2
  \<and> the (get_configuration (d2 0)) = c0'
  \<and> relation_configuration G1 G2 (the (get_configuration (d1 0))) (the (get_configuration (d2 0)))
  \<and> relation_configuration G1 G2 c1 (the (get_configuration (d2 n2)))"
  apply(induct x arbitrary: e1 c1)
   apply(rename_tac e1 c1)(*strict*)
   apply(clarsimp)
   apply(rule_tac
      x="der1 c0'"
      in exI)
   apply(rule conjI)
    apply(rule GR.der1_is_derivation)
   apply(rule conjI)
    apply(rule GR.der1_belongs)
    apply(metis)
   apply(rule_tac
      x="0"
      in exI)
   apply(rule conjI)
    apply(rule der1_maximum_of_domain)
   apply(simp add: get_configuration_def der1_def)
  apply(rename_tac x e1 c1)(*strict*)
  apply(clarsimp)
  apply(subgoal_tac "\<exists>e1 e2 c1 c2. d1 x = Some (pair e1 c1) \<and> d1 (Suc x) = Some (pair (Some e2) c2) \<and> step_relation1 G1 c1 e2 c2")
   apply(rename_tac x e1 c1)(*strict*)
   prefer 2
   apply(rule_tac
      m="Suc x"
      in GL.step_detail_before_some_position)
     apply(rename_tac x e1 c1)(*strict*)
     apply(force)
    apply(rename_tac x e1 c1)(*strict*)
    apply(force)
   apply(rename_tac x e1 c1)(*strict*)
   apply(force)
  apply(rename_tac x e1 c1)(*strict*)
  apply(clarsimp)
  apply(rename_tac x c1 e1a e2 c1a)(*strict*)
  apply(erule_tac
      x="e1a"
      in meta_allE)
  apply(erule_tac
      x="c1a"
      in meta_allE)
  apply(clarsimp)
  apply(rename_tac x c1 e1a e2 c1a d2 n2)(*strict*)
  apply(subgoal_tac "\<exists>e c. d2 n2 = Some (pair e c)")
   apply(rename_tac x c1 e1a e2 c1a d2 n2)(*strict*)
   apply(subgoal_tac "\<exists>c. d2 0 = Some (pair None c)")
    apply(rename_tac x c1 e1a e2 c1a d2 n2)(*strict*)
    apply(clarsimp)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 e c ca)(*strict*)
    apply(simp add: get_configuration_def der1_def)
    apply(subgoal_tac "\<exists>d2 n. GR.derivation G2 d2 \<and> GR.belongs G2 d2 \<and> the(get_configuration(d2 0)) = ca \<and> relation_step_simulation G1 G2 c1a e2 c1 ca d2 \<and> maximum_of_domain d2 n \<and> relation_configuration G1 G2 c1 (the(get_configuration(d2 n)))")
     apply(rename_tac x c1 e1a e2 c1a d2 n2 e c ca)(*strict*)
     prefer 2
     apply(rule AX_relation_step_simulation)
        apply(rename_tac x c1 e1a e2 c1a d2 n2 e c ca)(*strict*)
        apply(force)
       apply(rename_tac x c1 e1a e2 c1a d2 n2 e c ca)(*strict*)
       apply(simp add: get_configuration_def)
      apply(rename_tac x c1 e1a e2 c1a d2 n2 e c ca)(*strict*)
      apply (metis GL.belongs_step_labels)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 e c ca)(*strict*)
     apply(force)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 e c ca)(*strict*)
    apply(clarsimp)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n)(*strict*)
    apply(rule_tac
      x="derivation_append d2 d2a n2"
      in exI)
    apply(subgoal_tac "\<exists>c. d2a 0 = Some (pair None c)")
     apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n)(*strict*)
     apply(clarsimp)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
     apply(rule context_conjI)
      apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
      apply(rule GR.derivation_append_preserves_derivation)
        apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
        apply(force)
       apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
       apply(force)
      apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
      apply(clarsimp)
      apply(simp add: get_configuration_def)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
     apply(rule conjI)
      apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
      apply(rule GR.derivation_append_preserves_belongs)
        apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
        apply (metis AX_TSstructure_relation_TSstructure2_belongs)
       apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
       apply(force)
      apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
      apply(clarsimp)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
     apply(rule_tac
      x="n2+n"
      in exI)
     apply(rule context_conjI)
      apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
      apply (metis concat_has_max_dom)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
     apply(rule context_conjI)
      apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
      apply(simp add: get_configuration_def derivation_append_def)
     apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n ca)(*strict*)
     apply(simp add: get_configuration_def derivation_append_def)
     apply(clarsimp)
    apply(rename_tac x c1 e1a e2 c1a d2 n2 e c d2a n)(*strict*)
    apply (metis GR.some_position_has_details_at_0)
   apply(rename_tac x c1 e1a e2 c1a d2 n2)(*strict*)
   apply (metis GR.some_position_has_details_at_0)
  apply(rename_tac x c1 e1a e2 c1a d2 n2)(*strict*)
  apply(rule GR.some_position_has_details_before_max_dom)
    apply(rename_tac x c1 e1a e2 c1a d2 n2)(*strict*)
    apply(force)
   apply(rename_tac x c1 e1a e2 c1a d2 n2)(*strict*)
   apply(force)
  apply(rename_tac x c1 e1a e2 c1a d2 n2)(*strict*)
  apply(force)
  done

lemma simulating_derivation_exist_initial: "
  GR.derivation_initial G2 d2
  \<Longrightarrow> relation_initial_simulation G1 G2 c1 d2
  \<Longrightarrow> maximum_of_domain d2 n
  \<Longrightarrow> relation_configuration G1 G2 c1 (the (get_configuration (d2 n)))
  \<Longrightarrow> d2 0 = Some (pair None c2)
  \<Longrightarrow> simulating_derivation G1 G2 (derivation_append (der1 c1) (der1 c1) 0) 0 (derivation_append (der1 (the (get_configuration (d2 0)))) d2 0) (0 + n) (\<lambda>x. n)"
  apply(rule_tac
      t="derivation_append (der1 c1) (der1 c1) 0"
      and s="der1 c1"
      in ssubst)
   apply(rule ext)
   apply(rename_tac x)(*strict*)
   apply(simp add: derivation_append_def der1_def)
  apply(rule_tac
      t="derivation_append (der1 (the (get_configuration (d2 0)))) d2 0"
      and s="d2"
      in ssubst)
   apply(rule ext)
   apply(rename_tac x)(*strict*)
   apply(simp add: derivation_append_def get_configuration_def der1_def)
  apply(clarsimp)
  apply(simp add: simulating_derivation_def)
  apply(rule conjI)
   apply(simp add: simulating_derivation_I_def)
   apply(simp add: der1_def)
   apply(simp add: get_configuration_def)
   apply(rule_tac
      t="derivation_take d2 n"
      and s="d2"
      in ssubst)
    apply(rule ext)
    apply(rename_tac x)(*strict*)
    apply(simp add: derivation_take_def)
    apply(clarsimp)
    apply(rule sym)
    apply(rule GR.none_position_after_max_dom)
      apply(rename_tac x)(*strict*)
      apply(rule GR.derivation_initial_is_derivation)
      apply(force)
     apply(rename_tac x)(*strict*)
     apply(force)
    apply(rename_tac x)(*strict*)
    apply(force)
   apply(rule conjI)
    apply(force)
   apply(rule conjI)
    apply(force)
   apply(simp add: maximum_of_domain_def)
  apply(rule conjI)
   apply(simp add: simulating_derivation_S_def)
  apply(simp add: simulating_derivation_DEF_def)
  apply(rule conjI)
   apply(simp add: maximum_of_domain_def)
  apply(simp add: get_configuration_def der1_def)
  done

lemma simulating_derivation_exist_step: "
  ATS.derivation_initial initial_configurations1 step_relation1 G1 d
  \<Longrightarrow> maximum_of_domain d (Suc x)
  \<Longrightarrow> d x = Some (pair e0 c1)
  \<Longrightarrow> d (Suc x) = Some (pair (Some e1) c1')
  \<Longrightarrow> ATS.derivation_initial initial_configurations2 step_relation2 G2 deri2
  \<Longrightarrow> maximum_of_domain deri2 deri2n
  \<Longrightarrow> simulating_derivation G1 G2 d x deri2 deri2n f
  \<Longrightarrow> deri2 deri2n = Some (pair e (the (get_configuration (Some (pair None c2)))))
  \<Longrightarrow> ATS.derivation step_relation2 G2 d2
  \<Longrightarrow> relation_step_simulation G1 G2 c1 e1 c1' (the (get_configuration (Some (pair None c2)))) d2
  \<Longrightarrow> maximum_of_domain d2 n
  \<Longrightarrow> relation_configuration G1 G2 c1' (the (get_configuration (d2 n)))
  \<Longrightarrow> d2 0 = Some (pair None c2)
  \<Longrightarrow> simulating_derivation G1 G2 (derivation_append (derivation_take d x) (der2 c1 e1 c1') x) (Suc x) (derivation_append deri2 d2 deri2n) (deri2n + n) (\<lambda>a. if a \<le> x then f a else f x + n)"
  apply(rule_tac
      s="d"
      and t="(derivation_append (derivation_take d x) (der2 c1 e1 c1') x)"
      in ssubst)
   apply(rule ext)
   apply(rename_tac xa)(*strict*)
   apply(simp add: derivation_append_def derivation_take_def der2_def)
   apply(case_tac "xa-x")
    apply(rename_tac xa)(*strict*)
    apply(clarsimp)
   apply(rename_tac xa nat)(*strict*)
   apply(clarsimp)
   apply(case_tac nat)
    apply(rename_tac xa nat)(*strict*)
    apply(clarsimp)
    apply(rename_tac xa)(*strict*)
    apply(subgoal_tac "Suc x=xa")
     apply(rename_tac xa)(*strict*)
     prefer 2
     apply(force)
    apply(rename_tac xa)(*strict*)
    apply(clarsimp)
   apply(rename_tac xa nat nata)(*strict*)
   apply(clarsimp)
   apply(rename_tac xa nata)(*strict*)
   apply(subgoal_tac "xa=x+Suc(Suc nata)")
    apply(rename_tac xa nata)(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac xa nata)(*strict*)
   apply(clarsimp)
   apply(rename_tac nata)(*strict*)
   apply(rule sym)
   apply(rule GL.none_position_after_max_dom)
     apply(rename_tac nata)(*strict*)
     apply(rule GL.derivation_initial_is_derivation)
     apply(force)
    apply(rename_tac nata)(*strict*)
    apply(force)
   apply(rename_tac nata)(*strict*)
   apply(force)
  apply(simp add: simulating_derivation_def)
  apply(rule conjI)
   apply(simp add: simulating_derivation_I_def)
   apply(clarsimp)
   apply(rename_tac y)(*strict*)
   apply(subgoal_tac "f 0 \<le> deri2n")
    apply(rename_tac y)(*strict*)
    prefer 2
    apply (metis GR.derivation_append_derivation_take derivation_take_twice_prime GR.derivation_initial_is_derivation GR.maximum_of_domainUnique less_or_eq_imp_le nat_le_linear)
   apply(rename_tac y)(*strict*)
   apply(rule_tac
      t="derivation_take (derivation_append deri2 d2 deri2n) (f 0)"
      and s="derivation_take deri2 (f 0)"
      in ssubst)
    apply(rename_tac y)(*strict*)
    apply(rule ext)
    apply(rename_tac y xa)(*strict*)
    apply(simp add: derivation_take_def)
    apply(clarsimp)
    apply(simp add: derivation_append_def)
   apply(rename_tac y)(*strict*)
   apply(clarsimp)
   apply(simp add: derivation_take_def)
   apply(simp add: derivation_append_def)
  apply(rule conjI)
   apply(simp add: simulating_derivation_S_def)
   apply(rule allI)
   apply(rename_tac i)(*strict*)
   apply(rule conjI)
    apply(rename_tac i)(*strict*)
    apply(clarsimp)
    apply(rename_tac i ei ci ei' ci')(*strict*)
    apply(erule_tac
      x="i"
      in allE)
    apply(clarsimp)
    apply(rename_tac i ei ci ei' ci' na)(*strict*)
    apply(simp add: simulating_derivation_DEF_def)
    apply(clarsimp)
    apply(subgoal_tac "f i \<le> f x")
     apply(rename_tac i ei ci ei' ci' na)(*strict*)
     prefer 2
     apply(erule_tac
      x="i"
      in allE)
     apply(clarsimp)
     apply(rename_tac i ei ci ei' ci' na y)(*strict*)
     apply(case_tac y)
     apply(rename_tac i ei ci ei' ci' na y option b)(*strict*)
     apply(clarsimp)
     apply(rename_tac i ei ci ei' ci' na option b)(*strict*)
     apply(rule_tac
      M="G2"
      and d="deri2"
      in GR.allPreMaxDomSome_prime)
       apply(rename_tac i ei ci ei' ci' na option b)(*strict*)
       apply(rule GR.derivation_initial_is_derivation)
       apply(force)
      apply(rename_tac i ei ci ei' ci' na option b)(*strict*)
      apply(force)
     apply(rename_tac i ei ci ei' ci' na option b)(*strict*)
     apply(force)
    apply(rename_tac i ei ci ei' ci' na)(*strict*)
    apply(subgoal_tac "\<exists>y. deri2 (f i) = Some y")
     apply(rename_tac i ei ci ei' ci' na)(*strict*)
     prefer 2
     apply(force)
    apply(rename_tac i ei ci ei' ci' na)(*strict*)
    apply(erule exE)
    apply(rename_tac i ei ci ei' ci' na y)(*strict*)
    apply(rule_tac
      t="(derivation_append deri2 d2 (f x) (f i))"
      and s="Some y"
      in ssubst)
     apply(rename_tac i ei ci ei' ci' na y)(*strict*)
     apply(simp add: derivation_append_def)
    apply(rename_tac i ei ci ei' ci' na y)(*strict*)
    apply(case_tac y)
    apply(rename_tac i ei ci ei' ci' na y option b)(*strict*)
    apply(clarsimp)
    apply(rename_tac i ei ci ei' ci' na option b)(*strict*)
    apply(erule_tac
      x="Suc i"
      in allE)
    apply(erule impE)
     apply(rename_tac i ei ci ei' ci' na option b)(*strict*)
     apply(force)
    apply(rename_tac i ei ci ei' ci' na option b)(*strict*)
    apply(clarsimp)
    apply(rename_tac i ei ci ei' ci' na option b y)(*strict*)
    apply(case_tac y)
    apply(rename_tac i ei ci ei' ci' na option b y optiona ba)(*strict*)
    apply(clarsimp)
    apply(rename_tac i ei ci ei' ci' na option b optiona ba)(*strict*)
    apply(rule_tac
      t="derivation_take (derivation_drop (derivation_append deri2 d2 (f x)) (f i)) na"
      and s="derivation_take (derivation_drop deri2 (f i)) na"
      in ssubst)
     apply(rename_tac i ei ci ei' ci' na option b optiona ba)(*strict*)
     prefer 2
     apply(force)
    apply(rename_tac i ei ci ei' ci' na option b optiona ba)(*strict*)
    apply(rule ext)
    apply(rename_tac i ei ci ei' ci' na option b optiona ba xa)(*strict*)
    apply(simp add: derivation_take_def)
    apply(clarsimp)
    apply(simp add: derivation_drop_def)
    apply(rule conjI)
     apply(rename_tac i ei ci ei' ci' na option b optiona ba xa)(*strict*)
     apply(clarsimp)
     apply(rename_tac i ei ci ei' ci' na option b optiona ba)(*strict*)
     apply(simp add: derivation_append_def)
    apply(rename_tac i ei ci ei' ci' na option b optiona ba xa)(*strict*)
    apply(clarsimp)
    apply(simp add: derivation_append_def)
    apply(clarsimp)
    apply(subgoal_tac "f (Suc i) \<le> f x")
     apply(rename_tac i ei ci ei' ci' na option b optiona ba xa)(*strict*)
     apply(force)
    apply(rename_tac i ei ci ei' ci' na option b optiona ba xa)(*strict*)
    apply(rule_tac
      M="G2"
      and d="deri2"
      in GR.allPreMaxDomSome_prime)
      apply(rename_tac i ei ci ei' ci' na option b optiona ba xa)(*strict*)
      apply(rule GR.derivation_initial_is_derivation)
      apply(force)
     apply(rename_tac i ei ci ei' ci' na option b optiona ba xa)(*strict*)
     apply(force)
    apply(rename_tac i ei ci ei' ci' na option b optiona ba xa)(*strict*)
    apply(force)
   apply(rename_tac i)(*strict*)
   apply(clarsimp)
   apply(rename_tac i ei ci ei' ci')(*strict*)
   apply(subgoal_tac "x=i")
    apply(rename_tac i ei ci ei' ci')(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac i ei ci ei' ci')(*strict*)
   apply(clarsimp)
   apply(rule_tac
      t="get_configuration(derivation_append deri2 d2 deri2n (f x))"
      and s="get_configuration(Some (pair None c2))"
      in ssubst)
    apply(simp add: simulating_derivation_DEF_def)
    apply(clarsimp)
    apply(simp add: derivation_append_def)
    apply(simp add: get_configuration_def)
   apply(rule_tac
      t="derivation_take (derivation_drop (derivation_append deri2 d2 deri2n) (f x)) n"
      and s="d2"
      in ssubst)
    prefer 2
    apply(force)
   apply(rule ext)
   apply(rename_tac xa)(*strict*)
   apply(simp add: simulating_derivation_DEF_def)
   apply(clarsimp)
   apply(simp add: derivation_take_def)
   apply(rule conjI)
    apply(rename_tac xa)(*strict*)
    apply(clarsimp)
    apply(simp add: derivation_drop_def)
    apply(rule conjI)
     apply(rename_tac xa)(*strict*)
     apply(clarsimp)
     apply(simp add: derivation_append_def)
     apply(simp add: get_configuration_def)
    apply(rename_tac xa)(*strict*)
    apply(clarsimp)
    apply(simp add: derivation_append_def)
   apply(rename_tac xa)(*strict*)
   apply(clarsimp)
   apply (metis GR.allPreMaxDomSome_prime)
  apply(simp add: simulating_derivation_DEF_def)
  apply(clarsimp)
  apply(rename_tac i)(*strict*)
  apply(rule conjI)
   apply(rename_tac i)(*strict*)
   apply(clarsimp)
   apply(erule_tac
      x="i"
      in allE)
   apply(clarsimp)
   apply(rename_tac i y)(*strict*)
   apply(simp add: derivation_append_def)
   apply(clarsimp)
   apply(case_tac y)
   apply(rename_tac i y option b)(*strict*)
   apply(clarsimp)
   apply(rename_tac i option b)(*strict*)
   apply(subgoal_tac "f i \<le> f x")
    apply(rename_tac i option b)(*strict*)
    apply(force)
   apply(rename_tac i option b)(*strict*)
   apply(rule_tac
      M="G2"
      and d="deri2"
      in GR.allPreMaxDomSome_prime)
     apply(rename_tac i option b)(*strict*)
     apply(rule GR.derivation_initial_is_derivation)
     apply(force)
    apply(rename_tac i option b)(*strict*)
    apply(force)
   apply(rename_tac i option b)(*strict*)
   apply(force)
  apply(rename_tac i)(*strict*)
  apply(clarsimp)
  apply(subgoal_tac "i=Suc x")
   apply(rename_tac i)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac i)(*strict*)
  apply(clarsimp)
  apply(rule conjI)
   apply(simp add: derivation_append_def)
   apply(clarsimp)
   apply(simp add: maximum_of_domain_def)
  apply(rule_tac
      t="get_configuration (derivation_append deri2 d2 (f x) (f x + n))"
      and s="get_configuration(d2 n)"
      in ssubst)
   apply(simp add: derivation_append_def)
   apply(clarsimp)
   apply(simp add: get_configuration_def)
  apply(simp add: get_configuration_def)
  done

definition relation_step_simulation_preservation :: "
  'TSstructure1
  \<Rightarrow> 'TSstructure2
  \<Rightarrow> ('label1,'conf1)derivation
  \<Rightarrow> ('label2,'conf2)derivation
  \<Rightarrow> bool"
  where
    "relation_step_simulation_preservation G1 G2 d1' d2' \<equiv>
  \<exists>c1 e1 c1' c2 d1 n1 d2 n2 ds n f.
  relation_TSstructure G1 G2
  \<and> relation_configuration G1 G2 c1 c2
  \<and> e1 \<in> step_labels1 G1
  \<and> step_relation1 G1 c1 e1 c1'
  \<and> relation_step_simulation G1 G2 c1 e1 c1' c2 ds
  \<and> maximum_of_domain ds n
  \<and> GL.derivation_initial G1 d1
  \<and> maximum_of_domain d1 n1
  \<and> GR.derivation_initial G2 d2
  \<and> maximum_of_domain d2 n2
  \<and> relation_initial_configuration G1 G2
        (the (get_configuration (d1 0)))
        (the (get_configuration (d2 0)))
  \<and> derivation_append_fit d1 (der2 c1 e1 c1') n1
  \<and> derivation_append_fit d2 ds n2
  \<and> d1' = derivation_append d1 (der2 c1 e1 c1') n1
  \<and> d2' = derivation_append d2 ds n2
  \<and> simulating_derivation G1 G2 d1' (Suc n1) d2' (n2 + n) f"

lemma relation_step_simulation_preservation_PROVE: "
  relation_TSstructure G1 G2
  \<Longrightarrow> relation_configuration G1 G2 c1 c2
  \<Longrightarrow> e1 \<in> step_labels1 G1
  \<Longrightarrow> step_relation1 G1 c1 e1 c1'
  \<Longrightarrow> relation_step_simulation G1 G2 c1 e1 c1' c2 ds
  \<Longrightarrow> maximum_of_domain ds n
  \<Longrightarrow> GL.derivation_initial G1 d1
  \<Longrightarrow> maximum_of_domain d1 n1
  \<Longrightarrow> GR.derivation_initial G2 d2
  \<Longrightarrow> maximum_of_domain d2 n2
  \<Longrightarrow> relation_initial_configuration G1 G2
        (the(get_configuration(d1 0)))
        (the(get_configuration(d2 0)))
  \<Longrightarrow> derivation_append_fit d1 (der2 c1 e1 c1') n1
  \<Longrightarrow> derivation_append_fit d2 ds n2
  \<Longrightarrow> d1' = derivation_append d1 (der2 c1 e1 c1') n1
  \<Longrightarrow> d2' = derivation_append d2 ds n2
  \<Longrightarrow> simulating_derivation G1 G2 d1' (Suc n1) d2' (n2+n) f
  \<Longrightarrow> relation_step_simulation_preservation G1 G2 d1' d2'"
  apply(simp (no_asm) only: relation_step_simulation_preservation_def)
  apply(rule_tac
      x="c1"
      in exI)
  apply(rule_tac
      x="e1"
      in exI)
  apply(rule_tac
      x="c1'"
      in exI)
  apply(rule_tac
      x="c2"
      in exI)
  apply(rule_tac
      x="d1"
      in exI)
  apply(rule_tac
      x="n1"
      in exI)
  apply(rule_tac
      x="d2"
      in exI)
  apply(rule_tac
      x="n2"
      in exI)
  apply(rule_tac
      x="ds"
      in exI)
  apply(rule_tac
      x="n"
      in exI)
  apply(rule_tac
      x="f"
      in exI)
  apply(force)
  done

lemma relation_step_simulation_preservation_PROVE2: "
  (\<And>c1 c2 e1 c1' d2 n deri1 deri1n deri2 deri2n f.
  relation_TSstructure G1 G2
  \<Longrightarrow> relation_configuration G1 G2 c1 c2
  \<Longrightarrow> e1 \<in> step_labels1 G1
  \<Longrightarrow> step_relation1 G1 c1 e1 c1'
  \<Longrightarrow> relation_step_simulation G1 G2 c1 e1 c1' c2 d2
  \<Longrightarrow> maximum_of_domain d2 n
  \<Longrightarrow> GL.derivation_initial G1 deri1
  \<Longrightarrow> maximum_of_domain deri1 deri1n
  \<Longrightarrow> GR.derivation_initial G2 deri2
  \<Longrightarrow> maximum_of_domain deri2 deri2n
  \<Longrightarrow> relation_initial_configuration G1 G2 (the(get_configuration(deri1 0))) (the(get_configuration(deri2 0)))
  \<Longrightarrow> derivation_append_fit deri1 (der2 c1 e1 c1') deri1n
  \<Longrightarrow> derivation_append_fit deri2 d2 deri2n
  \<Longrightarrow> simulating_derivation G1 G2 (derivation_append deri1 (der2 c1 e1 c1') deri1n) (Suc deri1n) (derivation_append deri2 d2 deri2n) (deri2n+n) f
  \<Longrightarrow> d1' = derivation_append deri1 (der2 c1 e1 c1') deri1n
  \<Longrightarrow> d2' = derivation_append deri2 d2 deri2n
  \<Longrightarrow> Q G1 G2 d1' d2')
  \<Longrightarrow> relation_step_simulation_preservation G1 G2 d1' d2'
  \<Longrightarrow> Q G1 G2 d1' d2'"
  apply(unfold relation_step_simulation_preservation_def)
  apply(erule exE)+
  apply(rename_tac c1 e1 c1' c2 d1 n1 d2 n2 ds n f)(*strict*)
  apply(erule_tac
      x="c1"
      in meta_allE)
  apply(erule_tac
      x="c2"
      in meta_allE)
  apply(erule_tac
      x="e1"
      in meta_allE)
  apply(erule_tac
      x="c1'"
      in meta_allE)
  apply(erule_tac
      x="ds"
      in meta_allE)
  apply(erule_tac
      x="n"
      in meta_allE)
  apply(erule_tac
      x="d1"
      in meta_allE)
  apply(erule_tac
      x="n1"
      in meta_allE)
  apply(erule_tac
      x="d2"
      in meta_allE)
  apply(erule_tac
      x="n2"
      in meta_allE)
  apply(erule_tac
      x="f"
      in meta_allE)
  apply(force)
  done

definition relation_initial_simulation_preservation :: "
  'TSstructure1
  \<Rightarrow> 'TSstructure2
  \<Rightarrow> ('label1,'conf1)derivation
  \<Rightarrow> ('label2,'conf2)derivation
  \<Rightarrow> bool"
  where
    "relation_initial_simulation_preservation G1 G2 d1' d2' \<equiv>
  \<exists>c1 d1 n1 d2 n2 ds n f.
  relation_TSstructure G1 G2
  \<and> c1 \<in> initial_configurations1 G1
  \<and> relation_initial_simulation G1 G2 c1 ds
  \<and> maximum_of_domain ds n
  \<and> GL.derivation_initial G1 d1
  \<and> maximum_of_domain d1 n1
  \<and> GR.derivation_initial G2 d2
  \<and> maximum_of_domain d2 n2
  \<and> relation_initial_configuration G1 G2
        (the (get_configuration (d1 0)))
        (the (get_configuration (d2 0)))
  \<and> derivation_append_fit d1 (der1 c1) n1
  \<and> derivation_append_fit d2 ds n2
  \<and> d1' = derivation_append d1 (der1 c1) n1
  \<and> d2' = derivation_append d2 ds n2
  \<and> simulating_derivation G1 G2 d1' n1 d2' (n2 + n) f"

lemma relation_initial_simulation_preservation_PROVE: "
  relation_TSstructure G1 G2
  \<Longrightarrow> c1 \<in> initial_configurations1 G1
  \<Longrightarrow> relation_initial_simulation G1 G2 c1 ds
  \<Longrightarrow> maximum_of_domain ds n
  \<Longrightarrow> GL.derivation_initial G1 d1
  \<Longrightarrow> maximum_of_domain d1 n1
  \<Longrightarrow> GR.derivation_initial G2 d2
  \<Longrightarrow> maximum_of_domain d2 n2
  \<Longrightarrow> relation_initial_configuration G1 G2
        (the(get_configuration(d1 0)))
        (the(get_configuration(d2 0)))
  \<Longrightarrow> derivation_append_fit d1 (der1 c1) n1
  \<Longrightarrow> derivation_append_fit d2 ds n2
  \<Longrightarrow> d1' = derivation_append d1 (der1 c1) n1
  \<Longrightarrow> d2' = derivation_append d2 ds n2
  \<Longrightarrow> simulating_derivation G1 G2 d1' n1 d2' (n2+n) f
  \<Longrightarrow> relation_initial_simulation_preservation G1 G2 d1' d2'"
  apply(simp (no_asm) only: relation_initial_simulation_preservation_def)
  apply(rule_tac
      x="c1"
      in exI)
  apply(rule_tac
      x="d1"
      in exI)
  apply(rule_tac
      x="n1"
      in exI)
  apply(rule_tac
      x="d2"
      in exI)
  apply(rule_tac
      x="n2"
      in exI)
  apply(rule_tac
      x="ds"
      in exI)
  apply(rule_tac
      x="n"
      in exI)
  apply(rule_tac
      x="f"
      in exI)
  apply(force)
  done

lemma relation_initial_simulation_preservation_PROVE2: "
  (\<And>c1 d2 n deri1 deri1n deri2 deri2n f.
  relation_TSstructure G1 G2
  \<Longrightarrow> c1 \<in> initial_configurations1 G1
  \<Longrightarrow> relation_initial_simulation G1 G2 c1 d2
  \<Longrightarrow> maximum_of_domain d2 n
  \<Longrightarrow> GL.derivation_initial G1 deri1
  \<Longrightarrow> maximum_of_domain deri1 deri1n
  \<Longrightarrow> GR.derivation_initial G2 deri2
  \<Longrightarrow> maximum_of_domain deri2 deri2n
  \<Longrightarrow> relation_initial_configuration G1 G2 (the(get_configuration(deri1 0))) (the(get_configuration(deri2 0)))
  \<Longrightarrow> derivation_append_fit deri1 (der1 c1) deri1n
  \<Longrightarrow> derivation_append_fit deri2 d2 deri2n
  \<Longrightarrow> simulating_derivation G1 G2 (derivation_append deri1 (der1 c1) deri1n) deri1n (derivation_append deri2 d2 deri2n) (deri2n+n) f
  \<Longrightarrow> d1' = (derivation_append deri1 (der1 c1) deri1n)
  \<Longrightarrow> d2' = derivation_append deri2 d2 deri2n
  \<Longrightarrow> Q G1 G2 d1' d2')
  \<Longrightarrow> relation_initial_simulation_preservation G1 G2 d1' d2'
  \<Longrightarrow> Q G1 G2 d1' d2'"
  apply(unfold relation_initial_simulation_preservation_def)
  apply(erule exE)+
  apply(rename_tac c1 d1 n1 d2 n2 ds n f)(*strict*)
  apply(erule_tac
      x="c1"
      in meta_allE)
  apply(erule_tac
      x="ds"
      in meta_allE)
  apply(erule_tac
      x="n"
      in meta_allE)
  apply(erule_tac
      x="d1"
      in meta_allE)
  apply(erule_tac
      x="n1"
      in meta_allE)
  apply(erule_tac
      x="d2"
      in meta_allE)
  apply(erule_tac
      x="n2"
      in meta_allE)
  apply(erule_tac
      x="f"
      in meta_allE)
  apply(force)
  done

lemma get_accessible_configurations_transfer: "
  relation_TSstructure G1 G2
  \<Longrightarrow> c2 \<in> configurations2 G2
  \<Longrightarrow> relation_configuration G1 G2 c1 c2
  \<Longrightarrow> (\<And>cA cB.
          relation_configuration G1 G2 c1 cA
          \<Longrightarrow> relation_configuration G1 G2 c1 cB
          \<Longrightarrow> cA \<in> configurations2 G2
          \<Longrightarrow> cB \<in> configurations2 G2
          \<Longrightarrow> cA = cB)
  \<Longrightarrow> c1 \<in> GL.get_accessible_configurations G1
  \<Longrightarrow> c2 \<in> GR.get_accessible_configurations G2"
  apply(simp add: GL.get_accessible_configurations_def GR.get_accessible_configurations_def)
  apply(clarsimp)
  apply(rename_tac d i)(*strict*)
  apply(case_tac "d i")
   apply(rename_tac d i)(*strict*)
   apply(simp add: get_configuration_def)
  apply(rename_tac d i a)(*strict*)
  apply(clarsimp)
  apply(case_tac a)
  apply(rename_tac d i a option b)(*strict*)
  apply(clarsimp)
  apply(rename_tac d i option b)(*strict*)
  apply(simp add: get_configuration_def)
  apply(clarsimp)
  apply(rename_tac d i option)(*strict*)
  apply(subgoal_tac "X" for X)
   apply(rename_tac d i option)(*strict*)
   prefer 2
   apply(rule ATS_Simulation_Configuration_Weak_simulation_derivation_exists)
     apply(rename_tac d i option)(*strict*)
     apply(force)
    apply(rename_tac d i option)(*strict*)
    apply(force)
   apply(rename_tac d i option)(*strict*)
   apply(force)
  apply(rename_tac d i option)(*strict*)
  apply(clarsimp)
  apply(rename_tac d i option d2 n2)(*strict*)
  apply(rule_tac
      x="d2"
      in exI)
  apply(clarsimp)
  apply(rule_tac
      x="n2"
      in exI)
  apply(simp add: get_configuration_def)
  apply(simp add: maximum_of_domain_def)
  apply(clarsimp)
  apply(rename_tac d i option d2 n2 y)(*strict*)
  apply(case_tac y)
  apply(rename_tac d i option d2 n2 y optiona conf)(*strict*)
  apply(clarsimp)
  apply(rename_tac d i option d2 n2 optiona conf)(*strict*)
  apply(erule_tac x="conf" in meta_allE)
  apply(erule_tac x="c2" in meta_allE)
  apply(clarsimp)
  apply(erule meta_impE)
   apply(rename_tac d i option d2 n2 optiona conf)(*strict*)
   apply(rule_tac d="d2" in GR.belongs_configurations)
    apply(rename_tac d i option d2 n2 optiona conf)(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac d i option d2 n2 optiona conf)(*strict*)
   apply(rule GR.derivation_initial_belongs)
    apply(rename_tac d i option d2 n2 optiona conf)(*strict*)
    apply(rule AX_TSstructure_relation_TSstructure2_belongs)
    apply(force)
   apply(rename_tac d i option d2 n2 optiona conf)(*strict*)
   apply(force)
  apply(rename_tac d i option d2 n2 optiona conf)(*strict*)
  apply(force)
  done

theorem get_accessible_configurations_transfer_ALT: "
  relation_TSstructure G1 G2
  \<Longrightarrow> c2 \<in> configurations2 G2
  \<Longrightarrow> relation_configuration G1 G2 c1 c2
  \<Longrightarrow> inj_on (relation_configuration G1 G2 c1) (configurations2 G2)
  \<Longrightarrow> c1 \<in> GL.get_accessible_configurations G1
  \<Longrightarrow> c2 \<in> GR.get_accessible_configurations G2"
  apply(rule get_accessible_configurations_transfer)
      apply(force)
     apply(force)
    apply(force)
   apply(rename_tac cA cB)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac cA cB)(*strict*)
  apply(simp add: inj_on_def)
  done

end

end


theory HNR_While
imports HNR Tools
begin

subsection "While rule for hnr"

definition "monadic_WHILEIT I b f s \<equiv> do {
  Sepreftime.RECT (\<lambda>D s. do {
    ASSERT (I s);
    bv \<leftarrow> b s;
    if bv then do {
      s \<leftarrow> f s;
      D s
    } else do {RETURNT s}
  }) s
}"

definition "heap_WHILET b f s \<equiv> do {
  heap.fixp_fun (\<lambda>D s. do {
    bv \<leftarrow> b s;
    if bv then do {
      s \<leftarrow> f s;
      D s
    } else do {ureturn s}
  }) s
}"

lemma heap_WHILET_unfold[code]: "heap_WHILET b f s =
  do {
    bv \<leftarrow> b s;
    if bv then do {
      s \<leftarrow> f s;
      heap_WHILET b f s
    } else
      ureturn s
  }"
  unfolding heap_WHILET_def
  apply (subst heap.mono_body_fixp)
  apply pf_mono
  apply simp
  done

definition  WHILEIT :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a nrest) \<Rightarrow> 'a \<Rightarrow> 'a nrest" where
  " WHILEIT I b c = RECT (\<lambda>whileT s. (if I s then (if b s then bindT (c s) whileT else RETURNT s) else FAILT))"

lemma WHILEIT_to_monadic: "WHILEIT I b f s = monadic_WHILEIT I (\<lambda>s. RETURNT (b s)) f s"
  unfolding WHILEIT_def monadic_WHILEIT_def
  unfolding whileT_def bind_ASSERT_eq_if
  by (simp cong: if_cong)

lemma whileT_I': "whileT b c s = WHILEIT (\<lambda>_. True) b c s"
  unfolding WHILEIT_def whileT_def by simp

lemma whileT_I: "whileT = WHILEIT (\<lambda>_. True) " using whileT_I' by fast

lemma Ra: "A * \<Gamma> \<Longrightarrow>\<^sub>t \<Gamma> * A"
  by (simp add: assn_times_comm entt_refl)

lemma assumes "hn_refine P c Q R a"
    "Q\<Longrightarrow>\<^sub>AQ'*true" shows "hn_refine P c Q' R a"
  apply(rule hn_refine_cons'[OF _ assms]) by (auto simp add: entt_refl')

lemma hn_monadic_WHILE_aux:
  assumes FR: "P \<Longrightarrow>\<^sub>t \<Gamma> * hn_ctxt Rs s' s"
  assumes b_ref: "\<And>s s'. I s' \<Longrightarrow> hn_refine
    (\<Gamma> * hn_ctxt Rs s' s)
    (b s)
    (\<Gamma>b s' s)
    (pure bool_rel)
    (b' s')"
  assumes b_fr: "\<And>s' s. \<Gamma>b s' s \<Longrightarrow>\<^sub>t \<Gamma> * hn_ctxt Rs s' s"

  assumes f_ref: "\<And>s' s. \<lbrakk>I s'\<rbrakk> \<Longrightarrow> hn_refine
    (\<Gamma> * hn_ctxt Rs s' s)
    (f s)
    (\<Gamma>f s' s)
    Rs
    (f' s')"
  assumes f_fr: "\<And>s' s. \<Gamma>f s' s \<Longrightarrow>\<^sub>t \<Gamma> * hn_ctxt (\<lambda>_ _. true) s' s"
  (*assumes PREC: "precise Rs"*)
  shows "hn_refine (P) (heap_WHILET b f s) (\<Gamma> * hn_invalid Rs s' s) Rs (monadic_WHILEIT I b' f' s')"

  unfolding monadic_WHILEIT_def heap_WHILET_def
  apply1 (rule hn_refine_cons_pre[OF FR])

  apply weaken_hnr_post

  focus (rule hn_refine_cons_pre[OF _ hnr_RECT])
    applyS (subst mult_ac(2)[of \<Gamma>]; rule entt_refl; fail)

    apply1 (rule hnr_ASSERT)
    focus (rule hnr_bind)
      focus (rule hn_refine_cons[OF _ b_ref b_fr entt_refl])
        applyS (simp add: Ra)
        applyS assumption
      solved

      focus (rule hnr_If)
        applyS (rule entt_refl)
        focus (rule hnr_bind)
          focus (rule hn_refine_cons[OF _ f_ref f_fr entt_refl])
            subgoal unfolding entailst_def
              using ent_star_mono entails_triv entails_true by blast
            apply assumption
          solved

          focus (rule hnr_frame)
            applyS rprems
            apply  (rule enttI)
            apply(simp add: mult_ac )
              apply rotater
              apply(rule match_first)
              apply(rule match_first)
              apply(rule match_rest) apply simp
          solved

          apply rotatel apply rotatel apply rotater
              apply(rule match_first)  apply rotater
              apply(rule match_rest) apply simp
            solved
        applyF (auto,rule hnr_frame)
          applyS (rule hnr_uRETURN_pass)
          (*apply (tactic {* Sepref_Frame.frame_tac @{context} 1*})*)
          apply (rule enttI)
          apply rotatel  apply rotater
              apply(rule match_first) apply rotater
              apply(rule match_rest) apply simp
        solved

        apply (rule entt_refl)
      solved

            applyF (rule ent_disjE) apply(simp only: hn_ctxt_def)
             apply rotatel apply (rule match_first) apply rotater
             apply (rule match_rest) apply simp

            apply(simp only: hn_ctxt_def)

        apply1 (rule ent_true_drop) apply rotatel
        apply1 (rule match_first)

            apply simp

      solved
    solved
    apply pf_mono
  solved
  done

end


(*  Title:      HOL/Library/Quotient_List.thy
    Author:     Cezary Kaliszyk and Christian Urban
*)

section \<open>Quotient infrastructure for the list type\<close>

theory Quotient_List
imports Quotient_Set Quotient_Product Quotient_Option
begin

subsection \<open>Rules for the Quotient package\<close>

lemma map_id [id_simps]:
  "map id = id"
  by (fact List.map.id)

lemma list_all2_eq [id_simps]:
  "list_all2 (=) = (=)"
proof (rule ext)+
  fix xs ys
  show "list_all2 (=) xs ys \<longleftrightarrow> xs = ys"
    by (induct xs ys rule: list_induct2') simp_all
qed

lemma reflp_list_all2:
  assumes "reflp R"
  shows "reflp (list_all2 R)"
proof (rule reflpI)
  from assms have *: "\<And>xs. R xs xs" by (rule reflpE)
  fix xs
  show "list_all2 R xs xs"
    by (induct xs) (simp_all add: *)
qed

lemma list_symp:
  assumes "symp R"
  shows "symp (list_all2 R)"
proof (rule sympI)
  from assms have *: "\<And>xs ys. R xs ys \<Longrightarrow> R ys xs" by (rule sympE)
  fix xs ys
  assume "list_all2 R xs ys"
  then show "list_all2 R ys xs"
    by (induct xs ys rule: list_induct2') (simp_all add: *)
qed

lemma list_transp:
  assumes "transp R"
  shows "transp (list_all2 R)"
proof (rule transpI)
  from assms have *: "\<And>xs ys zs. R xs ys \<Longrightarrow> R ys zs \<Longrightarrow> R xs zs" by (rule transpE)
  fix xs ys zs
  assume "list_all2 R xs ys" and "list_all2 R ys zs"
  then show "list_all2 R xs zs"
    by (induct arbitrary: zs) (auto simp: list_all2_Cons1 intro: *)
qed

lemma list_equivp [quot_equiv]:
  "equivp R \<Longrightarrow> equivp (list_all2 R)"
  by (blast intro: equivpI reflp_list_all2 list_symp list_transp elim: equivpE)

lemma list_quotient3 [quot_thm]:
  assumes "Quotient3 R Abs Rep"
  shows "Quotient3 (list_all2 R) (map Abs) (map Rep)"
proof (rule Quotient3I)
  from assms have "\<And>x. Abs (Rep x) = x" by (rule Quotient3_abs_rep)
  then show "\<And>xs. map Abs (map Rep xs) = xs" by (simp add: comp_def)
next
  from assms have "\<And>x y. R (Rep x) (Rep y) \<longleftrightarrow> x = y" by (rule Quotient3_rel_rep)
  then show "\<And>xs. list_all2 R (map Rep xs) (map Rep xs)"
    by (simp add: list_all2_map1 list_all2_map2 list_all2_eq)
next
  fix xs ys
  from assms have "\<And>x y. R x x \<and> R y y \<and> Abs x = Abs y \<longleftrightarrow> R x y" by (rule Quotient3_rel)
  then show "list_all2 R xs ys \<longleftrightarrow> list_all2 R xs xs \<and> list_all2 R ys ys \<and> map Abs xs = map Abs ys"
    by (induct xs ys rule: list_induct2') auto
qed

declare [[mapQ3 list = (list_all2, list_quotient3)]]

lemma cons_prs [quot_preserve]:
  assumes q: "Quotient3 R Abs Rep"
  shows "(Rep ---> (map Rep) ---> (map Abs)) (#) = (#)"
  by (auto simp add: fun_eq_iff comp_def Quotient3_abs_rep [OF q])

lemma cons_rsp [quot_respect]:
  assumes q: "Quotient3 R Abs Rep"
  shows "(R ===> list_all2 R ===> list_all2 R) (#) (#)"
  by auto

lemma nil_prs [quot_preserve]:
  assumes q: "Quotient3 R Abs Rep"
  shows "map Abs [] = []"
  by simp

lemma nil_rsp [quot_respect]:
  assumes q: "Quotient3 R Abs Rep"
  shows "list_all2 R [] []"
  by simp

lemma map_prs_aux:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "(map abs2) (map ((abs1 ---> rep2) f) (map rep1 l)) = map f l"
  by (induct l)
     (simp_all add: Quotient3_abs_rep[OF a] Quotient3_abs_rep[OF b])

lemma map_prs [quot_preserve]:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "((abs1 ---> rep2) ---> (map rep1) ---> (map abs2)) map = map"
  and   "((abs1 ---> id) ---> map rep1 ---> id) map = map"
  by (simp_all only: fun_eq_iff map_prs_aux[OF a b] comp_def)
    (simp_all add: Quotient3_abs_rep[OF a] Quotient3_abs_rep[OF b])

lemma map_rsp [quot_respect]:
  assumes q1: "Quotient3 R1 Abs1 Rep1"
  and     q2: "Quotient3 R2 Abs2 Rep2"
  shows "((R1 ===> R2) ===> (list_all2 R1) ===> list_all2 R2) map map"
  and   "((R1 ===> (=)) ===> (list_all2 R1) ===> (=)) map map"
  unfolding list_all2_eq [symmetric] by (rule list.map_transfer)+

lemma foldr_prs_aux:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "abs2 (foldr ((abs1 ---> abs2 ---> rep2) f) (map rep1 l) (rep2 e)) = foldr f l e"
  by (induct l) (simp_all add: Quotient3_abs_rep[OF a] Quotient3_abs_rep[OF b])

lemma foldr_prs [quot_preserve]:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "((abs1 ---> abs2 ---> rep2) ---> (map rep1) ---> rep2 ---> abs2) foldr = foldr"
  apply (simp add: fun_eq_iff)
  by (simp only: fun_eq_iff foldr_prs_aux[OF a b])
     (simp)

lemma foldl_prs_aux:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "abs1 (foldl ((abs1 ---> abs2 ---> rep1) f) (rep1 e) (map rep2 l)) = foldl f e l"
  by (induct l arbitrary:e) (simp_all add: Quotient3_abs_rep[OF a] Quotient3_abs_rep[OF b])

lemma foldl_prs [quot_preserve]:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "((abs1 ---> abs2 ---> rep1) ---> rep1 ---> (map rep2) ---> abs1) foldl = foldl"
  by (simp add: fun_eq_iff foldl_prs_aux [OF a b])

lemma foldl_rsp[quot_respect]:
  assumes q1: "Quotient3 R1 Abs1 Rep1"
  and     q2: "Quotient3 R2 Abs2 Rep2"
  shows "((R1 ===> R2 ===> R1) ===> R1 ===> list_all2 R2 ===> R1) foldl foldl"
  by (rule foldl_transfer)

lemma foldr_rsp[quot_respect]:
  assumes q1: "Quotient3 R1 Abs1 Rep1"
  and     q2: "Quotient3 R2 Abs2 Rep2"
  shows "((R1 ===> R2 ===> R2) ===> list_all2 R1 ===> R2 ===> R2) foldr foldr"
  by (rule foldr_transfer)

lemma list_all2_rsp:
  assumes r: "\<forall>x y. R x y \<longrightarrow> (\<forall>a b. R a b \<longrightarrow> S x a = T y b)"
  and l1: "list_all2 R x y"
  and l2: "list_all2 R a b"
  shows "list_all2 S x a = list_all2 T y b"
  using l1 l2
  by (induct arbitrary: a b rule: list_all2_induct,
    auto simp: list_all2_Cons1 list_all2_Cons2 r)

lemma [quot_respect]:
  "((R ===> R ===> (=)) ===> list_all2 R ===> list_all2 R ===> (=)) list_all2 list_all2"
  by (rule list.rel_transfer)

lemma [quot_preserve]:
  assumes a: "Quotient3 R abs1 rep1"
  shows "((abs1 ---> abs1 ---> id) ---> map rep1 ---> map rep1 ---> id) list_all2 = list_all2"
  apply (simp add: fun_eq_iff)
  apply clarify
  apply (induct_tac xa xb rule: list_induct2')
  apply (simp_all add: Quotient3_abs_rep[OF a])
  done

lemma [quot_preserve]:
  assumes a: "Quotient3 R abs1 rep1"
  shows "(list_all2 ((rep1 ---> rep1 ---> id) R) l m) = (l = m)"
  by (induct l m rule: list_induct2') (simp_all add: Quotient3_rel_rep[OF a])

lemma list_all2_find_element:
  assumes a: "x \<in> set a"
  and b: "list_all2 R a b"
  shows "\<exists>y. (y \<in> set b \<and> R x y)"
  using b a by induct auto

lemma list_all2_refl:
  assumes a: "\<And>x y. R x y = (R x = R y)"
  shows "list_all2 R x x"
  by (induct x) (auto simp add: a)

end


theory FaultTreeRule

imports FaultTree

begin

text {*
  {@term BasicEventMinLevel n}: no basic event should appear before level n from the root.
  {@term RootProbability p}: the root probability should be smaller than p.
  {@term NoHigherCombinations n}: no higher combinations of ANDs should appear. For example: if an
intermediate event is caused by a fault F1, ..., Fn-1, than faults F1, ..., Fn-1 should not appear
in a combination with Fn.
  {@term OrProbability perc}: if an OR gate has events probability such that the lowest is perc
  lower than the second lowest one.
*}

datatype FaultTreeRule =
  BasicEventMinLevel nat
  | RootProbability real
  | NoHigherCombinations nat
  | OrProbability real

primrec evaluateRule :: "'vb FaultTree \<Rightarrow> FaultTreeRule \<Rightarrow> ('vb \<Rightarrow> real) \<Rightarrow> bool"
where
  "evaluateRule ft (BasicEventMinLevel n) P = (min_basicEventLevel ft \<ge> n)" |
  "evaluateRule ft (RootProbability p) P = ((FT_probability ft P) \<le> p)"

definition unsatisfiedRules :: "'vb FaultTree \<Rightarrow> FaultTreeRule set \<Rightarrow> ('vb \<Rightarrow> real)
  \<Rightarrow> FaultTreeRule set"
where
  "unsatisfiedRules ft rules P \<equiv> { r. r \<in> rules \<and> \<not> evaluateRule ft r P }"

definition evaluateRules :: "'vb FaultTree \<Rightarrow> FaultTreeRule set \<Rightarrow> ('vb \<Rightarrow> real) \<Rightarrow> bool"
where
  "evaluateRules ft rules P \<equiv> unsatisfiedRules ft rules P = {}"

definition verifyFaultTree :: "'vb FaultTree \<Rightarrow> FaultTreeRule set \<Rightarrow> ('vb \<Rightarrow> real)
  \<Rightarrow> (bool \<times> FaultTreeRule set)"
where
  "verifyFaultTree ft rules P \<equiv> let unsats = unsatisfiedRules ft rules P in (unsats = {}, unsats)"

lemma [simp]: "\<lbrakk> min_basicEventLevel ft > n  \<rbrakk> \<Longrightarrow>
  (verifyFaultTree ft {BasicEventMinLevel n} P) = (True, {})"
apply (induct ft)
apply (auto simp add: min_basicEventLevel_def verifyFaultTree_def)
apply (auto simp add: unsatisfiedRules_def)
apply (auto simp add: min_basicEventLevel_def)
done

lemma [simp]: "\<lbrakk> FT_probability ft P \<le> p; min_basicEventLevel ft > n  \<rbrakk> \<Longrightarrow>
  (verifyFaultTree ft {BasicEventMinLevel n, RootProbability p} P) = (True, {})"
apply (induct ft)
apply (auto simp add: min_basicEventLevel_def verifyFaultTree_def)
apply (auto simp add: unsatisfiedRules_def)
apply (auto simp add: min_basicEventLevel_def)
done

end