subsection \<open>Optimal Binary Search Trees\<close>

text \<open>
The material presented in this section just contains a simple and non-optimal version
(cubic instead of quadratic in the number of keys).
It can now be viewed to be superseded by the AFP entry \<open>Optimal_BST\<close>.
It is kept here as a more easily understandable example and for archival purposes.
\<close>

theory OptBST
imports
  "HOL-Library.Tree"
  "HOL-Library.Code_Target_Numeral"
  "../state_monad/State_Main"
  "../heap_monad/Heap_Default"
  Example_Misc
  "HOL-Library.Product_Lexorder"
  "HOL-Library.RBT_Mapping"
begin

subsubsection \<open>Function \<open>argmin\<close>\<close>

text \<open>Function \<open>argmin\<close> iterates over a list and returns the rightmost element
that minimizes a given function:\<close>

fun argmin :: "('a \<Rightarrow> ('b::linorder)) \<Rightarrow> 'a list \<Rightarrow> 'a" where
"argmin f (x#xs) =
  (if xs = [] then x else
   let m = argmin f xs in if f x < f m then x else m)"

text \<open>Note that @{term arg_min_list} is similar but returns the leftmost element.\<close>

lemma argmin_forall: "xs \<noteq> [] \<Longrightarrow> (\<And>x. x\<in>set xs \<Longrightarrow> P x) \<Longrightarrow> P (argmin f xs)"
by(induction xs) (auto simp: Let_def)

lemma argmin_Min: "xs \<noteq> [] \<Longrightarrow> f (argmin f xs) = Min (f ` set xs)"
by(induction xs) (auto simp: min_def intro!: antisym)

subsubsection \<open>Misc\<close>

lemma upto_join: "\<lbrakk> i \<le> j; j \<le> k \<rbrakk> \<Longrightarrow> [i..j-1] @ j # [j+1..k] = [i..k]"
  using upto_rec1 upto_split1 by auto

lemma atLeastAtMost_split:
  "{i..j} = {i..k} \<union> {k+1..j}" if "i \<le> k" "k \<le> j" for i j k :: int
  using that by auto

lemma atLeastAtMost_split_insert:
  "{i..k} = insert k {i..k-1}" if "k \<ge> i" for i :: int
  using that by auto

subsubsection \<open>Definitions\<close>

context
fixes W :: "int \<Rightarrow> int \<Rightarrow> nat"
begin

fun wpl :: "int \<Rightarrow> int \<Rightarrow> int tree \<Rightarrow> nat" where
   "wpl i j Leaf = 0"
 | "wpl i j (Node l k r) = wpl i (k-1) l + wpl (k+1) j r + W i j"

function min_wpl :: "int \<Rightarrow> int \<Rightarrow> nat" where
"min_wpl i j =
  (if i > j then 0
   else min_list (map (\<lambda>k. min_wpl i (k-1) + min_wpl (k+1) j + W i j) [i..j]))"
  by auto
termination by (relation "measure (\<lambda>(i,j) . nat(j-i+1))") auto
declare min_wpl.simps[simp del]

function opt_bst :: "int \<Rightarrow> int \<Rightarrow> int tree" where
"opt_bst i j =
  (if i > j then Leaf else argmin (wpl i j) [\<langle>opt_bst i (k-1), k, opt_bst (k+1) j\<rangle>. k \<leftarrow> [i..j]])"
  by auto
termination by (relation "measure (\<lambda>(i,j) . nat(j-i+1))") auto
declare opt_bst.simps[simp del]

subsubsection \<open>Functional Memoization\<close>

context
  fixes n :: nat
begin

context fixes
  mem :: "nat option array"
begin

memoize_fun min_wpl\<^sub>T: min_wpl
  with_memory dp_consistency_heap_default where bound = "Bound (0, 0) (int n, int n)" and mem="mem"
  monadifies (heap) min_wpl.simps

context includes heap_monad_syntax begin
thm min_wpl\<^sub>T'.simps min_wpl\<^sub>T_def
end

memoize_correct
  by memoize_prover

lemmas memoized_empty = min_wpl\<^sub>T.memoized_empty

end (* Fixed array *)

context
  includes heap_monad_syntax
  notes [simp del] = min_wpl\<^sub>T'.simps
begin

definition "min_wpl\<^sub>h \<equiv> \<lambda> i j. Heap_Monad.bind (mem_empty (n * n)) (\<lambda> mem. min_wpl\<^sub>T' mem i j)"

lemma min_wpl_heap:
  "min_wpl i j = result_of (min_wpl\<^sub>h i j) Heap.empty"
  unfolding min_wpl\<^sub>h_def
  using memoized_empty[of _ "\<lambda> m. \<lambda> (a, b). min_wpl\<^sub>T' m a b" "(i, j)", OF min_wpl\<^sub>T.crel]
  by (simp add: index_size_defs)

end

end (* Bound *)

context includes state_monad_syntax begin

memoize_fun min_wpl\<^sub>m: min_wpl with_memory dp_consistency_mapping monadifies (state) min_wpl.simps
thm min_wpl\<^sub>m'.simps

memoize_correct
  by memoize_prover
print_theorems
lemmas [code] = min_wpl\<^sub>m.memoized_correct

memoize_fun opt_bst\<^sub>m: opt_bst with_memory dp_consistency_mapping monadifies (state) opt_bst.simps
thm opt_bst\<^sub>m'.simps

memoize_correct
  by memoize_prover
print_theorems
lemmas [code] = opt_bst\<^sub>m.memoized_correct

end

subsubsection \<open>Correctness Proof\<close>

lemma min_wpl_minimal:
  "inorder t = [i..j] \<Longrightarrow> min_wpl i j \<le> wpl i j t"
proof(induction i j t rule: wpl.induct)
  case (1 i j)
  then show ?case by (simp add: min_wpl.simps)
next
  case (2 i j l k r)
  then show ?case
  proof cases
    assume "i > j" thus ?thesis by(simp add: min_wpl.simps)
  next
    assume [arith]: "\<not> i > j"
    have kk_ij: "k\<in>set[i..j]" using 2
        by (metis set_inorder tree.set_intros(2))

    let ?M = "((\<lambda>k. min_wpl i (k-1) + min_wpl (k+1) j + W i j) ` {i..j})"
    let ?w = "min_wpl i (k-1) + min_wpl (k+1) j + W i j"

    have aux_min:"Min ?M \<le> ?w"
    proof (rule Min_le)
      show "finite ?M" by simp
      show "?w \<in> ?M" using kk_ij by auto
    qed

    have"inorder \<langle>l,k,r\<rangle> = inorder l @k#inorder r" by auto
    from this have C:"[i..j] = inorder l @ k#inorder r" using 2 by auto
    have D: "[i..j] = [i..k-1]@k#[k+1..j]" using kk_ij upto_rec1 upto_split1
      by (metis atLeastAtMost_iff set_upto)

    have l_inorder: "inorder l = [i..k-1]"
      by (smt C D append_Cons_eq_iff atLeastAtMost_iff set_upto)
    have r_inorder: "inorder r = [k+1..j]"
      by (smt C D append_Cons_eq_iff atLeastAtMost_iff set_upto)

    have "min_wpl i j = Min ?M" by (simp add: min_wpl.simps min_list_Min)
    also have "... \<le> ?w" by (rule aux_min)
    also have "... \<le> wpl i (k-1) l + wpl (k+1) j r + W i j" using l_inorder r_inorder "2.IH" by simp
    also have "... = wpl i j \<langle>l,k,r\<rangle>" by simp
    finally show ?thesis .
  qed
qed

lemma opt_bst_correct: "inorder (opt_bst i j) = [i..j]"
  by (induction i j rule: opt_bst.induct)
     (clarsimp simp: opt_bst.simps upto_join | rule argmin_forall)+

lemma wpl_opt_bst: "wpl i j (opt_bst i j) = min_wpl i j"
proof(induction i j rule: min_wpl.induct)
  case (1 i j)
  show ?case
  proof cases
    assume "i > j" thus ?thesis by(simp add: min_wpl.simps opt_bst.simps)
  next
    assume *[arith]: "\<not> i > j"
    let ?ts = "[\<langle>opt_bst i (k-1), k, opt_bst (k+1) j\<rangle>. k <- [i..j]]"
    let ?M = "((\<lambda>k. min_wpl i (k-1) + min_wpl (k+1) j + W i j) ` {i..j})"
    have "?ts \<noteq> []" by (auto simp add: upto.simps)
    have "wpl i j (opt_bst i j) = wpl i j (argmin (wpl i j) ?ts)" by (simp add: opt_bst.simps)
    also have "\<dots> = Min (wpl i j ` (set ?ts))" by (rule argmin_Min[OF \<open>?ts \<noteq> []\<close>])
    also have "\<dots> = Min ?M"
    proof (rule arg_cong[where f=Min])
      show "wpl i j ` (set ?ts) = ?M"
        by (fastforce simp: Bex_def image_iff 1[OF *])
    qed
    also have "\<dots> = min_wpl i j" by (simp add: min_wpl.simps min_list_Min)
    finally show ?thesis .
  qed
qed

lemma opt_bst_is_optimal:
  "inorder t = [i..j] \<Longrightarrow> wpl i j (opt_bst i j) \<le> wpl i j t"
  by (simp add: min_wpl_minimal wpl_opt_bst)

end (* Weight function *)

subsubsection \<open>Access Frequencies\<close>
text \<open>Usually, the problem is phrased in terms of access frequencies.
We now give an interpretation of @{term wpl} in this view and show that we have actually computed
the right thing.\<close>

context
  \<comment> \<open>We are given a range \<open>[i..j]\<close> of integer keys with access frequencies \<open>p\<close>.
  These can be thought of as a probability distribution but are not required to represent one.
  This model assumes that the tree will contain all keys in the range \<open>[i..j]\<close>.
  See \<open>Optimal_BST\<close> for a model with missing keys.
  \<close>
  fixes p :: "int \<Rightarrow> nat"
begin

\<comment> \<open>The \<^emph>\<open>weighted path path length\<close> (or \<open>cost\<close>) of a tree.\<close>
fun cost :: "int tree \<Rightarrow> nat" where
  "cost Leaf = 0"
| "cost (Node l k r) = sum p (set_tree l) + cost l + p k + cost r + sum p (set_tree r)"

\<comment> \<open>Deriving a weight function from \<open>p\<close>.\<close>
qualified definition W where
  "W i j = sum p {i..j}"

\<comment> \<open>We will use this later for computing \<open>W\<close> efficiently.\<close>
lemma W_rec:
  "W i j = (if j \<ge> i then W i (j - 1) + p j else 0)"
  unfolding W_def by (simp add: atLeastAtMost_split_insert)

\<comment> \<open>The weight function correctly implements costs.\<close>
lemma inorder_wpl_correct:
  "inorder t = [i..j] \<Longrightarrow> wpl W i j t = cost t"
proof (induction t arbitrary: i j)
case Leaf
  show ?case
    by simp
next
  case (Node l k r)
  from \<open>inorder \<langle>l, k, r\<rangle> = [i..j]\<close> have *: "i \<le> k" "k \<le> j"
     by - (simp, metis atLeastAtMost_iff in_set_conv_decomp set_upto)+
   moreover from \<open>i \<le> k\<close> \<open>k \<le> j\<close> have "inorder l = [i..k-1]" "inorder r = [k+1..j]"
    using \<open>inorder \<langle>l, k, r\<rangle> = [i..j]\<close>[symmetric] by (simp add: upto_split3 append_Cons_eq_iff)+
  ultimately show ?case
    by (simp add: Node.IH, subst W_def, subst atLeastAtMost_split)
       (simp add: sum.union_disjoint atLeastAtMost_split_insert flip: set_inorder)+
qed

text \<open>The optimal binary search tree has minimal cost among all binary search trees.\<close>
lemma opt_bst_has_optimal_cost:
  "inorder t = [i..j] \<Longrightarrow> cost (opt_bst W i j) \<le> cost t"
  using inorder_wpl_correct opt_bst_is_optimal opt_bst_correct by metis

text \<open>
  The function @{term min_wpl} correctly computes the minimal cost among all binary search trees:
  \<^item> Its cost is a lower bound for the cost of all binary search trees
  \<^item> Its cost actually corresponds to an optimal binary search tree
\<close>
lemma min_wpl_minimal_cost:
  "inorder t = [i..j] \<Longrightarrow> min_wpl W i j \<le> cost t"
  using inorder_wpl_correct min_wpl_minimal by metis

lemma min_wpl_tree:
  "cost (opt_bst W i j) = min_wpl W i j"
  using wpl_opt_bst opt_bst_correct inorder_wpl_correct by metis

paragraph \<open>An alternative view of costs.\<close>

fun depth :: "'a \<Rightarrow> 'a tree \<Rightarrow> nat extended" where
  "depth x Leaf = \<infinity>"
| "depth x (Node l k r) = (if x = k then 1 else min (depth x l) (depth x r) + 1)"

fun the_fin where
  "the_fin (Fin x) = x" | "the_fin _ = undefined"

definition cost' :: "int tree \<Rightarrow> nat" where
  "cost' t = sum (\<lambda>x. the_fin (depth x t) * p x) (set_tree t)"

lemma set_tree_depth:
  assumes "x \<notin> set_tree t"
  shows "depth x t = \<infinity>"
  using assms by (induction t) auto

lemma depth_inf_iff:
  "depth x t = \<infinity> \<longleftrightarrow> x \<notin> set_tree t"
  apply (induction t)
   apply (auto simp: one_extended_def)
  subgoal for t1 k t2
    by (cases "depth x t1"; cases "depth x t2") auto
  subgoal for t1 k t2
    by (cases "depth x t1"; cases "depth x t2") auto
  subgoal for t1 k t2
    by (cases "depth x t1"; cases "depth x t2") auto
  subgoal for t1 k t2
    by (cases "depth x t1"; cases "depth x t2") auto
  done

lemma depth_not_neg_inf[simp]:
  "depth x t = -\<infinity> \<longleftrightarrow> False"
  apply (induction t)
   apply (auto simp: one_extended_def)
  subgoal for t1 k t2
    by (cases "depth x t1"; cases "depth x t2") auto
  done

lemma depth_FinD:
  assumes "x \<in> set_tree t"
  obtains d where "depth x t = Fin d"
  using assms by (cases "depth x t") (auto simp: depth_inf_iff)

lemma cost'_Leaf[simp]:
  "cost' Leaf = 0"
  unfolding cost'_def by simp

lemma cost'_Node:
  "distinct (inorder \<langle>l, x, r\<rangle>) \<Longrightarrow>
  cost' \<langle>l, x, r\<rangle> = sum p (set_tree l) + cost' l + p x + cost' r + sum p (set_tree r)"
  unfolding cost'_def
  apply simp
  apply (subst sum.union_disjoint)
     apply (simp; fail)+
  apply (subst sum.cong[OF HOL.refl, where h = "\<lambda>x. (the_fin (depth x l) + 1) * p x"])
  subgoal for k
    using set_tree_depth by (force simp: one_extended_def elim: depth_FinD)
  apply (subst (2) sum.cong[OF HOL.refl, where h = "\<lambda>x. (the_fin (depth x r) + 1) * p x"])
  subgoal
    using set_tree_depth by (force simp: one_extended_def elim: depth_FinD)
  apply (simp add: sum.distrib)
  done

\<comment> \<open>The two variants coincide\<close>
lemma weight_correct:
  "distinct (inorder t) \<Longrightarrow> cost' t = cost t"
  by (induction t; simp add: cost'_Node)

subsubsection \<open>Memoizing Weights\<close>

function W_fun where
  "W_fun i j = (if i > j then 0 else W_fun i (j - 1) + p j)"
  by auto

termination
  by (relation "measure (\<lambda>(i::int, j::int). nat (j - i + 1))") auto

lemma W_fun_correct:
  "W_fun i j = W i j"
  by (induction rule: W_fun.induct) (simp add: W_def atLeastAtMost_split_insert)

memoize_fun W\<^sub>m: W_fun
  with_memory  dp_consistency_mapping
  monadifies (state) W_fun.simps

memoize_correct
  by memoize_prover

definition
  "compute_W n = snd (run_state (State_Main.map\<^sub>T' (\<lambda>i. W\<^sub>m' i n) [0..n]) Mapping.empty)"

notation W\<^sub>m.crel_vs ("crel")

lemmas W\<^sub>m_crel = W\<^sub>m.crel[unfolded W\<^sub>m.consistentDP_def, THEN rel_funD,
      of "(m, x)" "(m, y)" for m x y, unfolded prod.case]

lemma compute_W_correct:
  assumes "Mapping.lookup (compute_W n) (i, j) = Some x"
  shows "W i j = x"
proof -
  include state_monad_syntax app_syntax lifting_syntax
  let ?p = "State_Main.map\<^sub>T' (\<lambda>i. W\<^sub>m' i n) [0..n]"
  let ?q = "map (\<lambda>i. W i n) [0..n]"
  have "?q = map $ \<llangle>(\<lambda>i. W_fun i n)\<rrangle> $ \<llangle>[0..n]\<rrangle>"
    unfolding Wrap_def App_def W_fun_correct ..
  have "?p = State_Main.map\<^sub>T . \<langle>\<lambda>i. W\<^sub>m' i n\<rangle> . \<langle>[0..n]\<rangle>"
    unfolding State_Monad_Ext.fun_app_lifted_def State_Main.map\<^sub>T_def bind_left_identity ..
  \<comment> \<open>Not forgetting to write @{term  "list_all2 (=)"} instead of @{term "(=)"} was the tricky part.\<close>
  have "W\<^sub>m.crel_vs (list_all2 (=)) ?q ?p"
    unfolding \<open>?p = _\<close> \<open>?q = _\<close>
    apply (subst Transfer.Rel_def[symmetric])
    apply memoize_prover_match_step+
    apply (subst Rel_def, rule W\<^sub>m_crel, rule HOL.refl)
    done
  then have "W\<^sub>m.cmem (compute_W n)"
    unfolding compute_W_def by (elim W\<^sub>m.crel_vs_elim[OF _ W\<^sub>m.cmem_empty]; simp del: W\<^sub>m'.simps)
  with assms show ?thesis
    unfolding W_fun_correct[symmetric] by (elim W\<^sub>m.cmem_elim) (simp)+
qed

definition
  "min_wpl' i j \<equiv>
  let
    M = compute_W j;
    W = (\<lambda>i j. case Mapping.lookup M (i, j) of None \<Rightarrow> W i j | Some x \<Rightarrow> x)
  in min_wpl W i j"

lemma W_compute: "W i j = (case Mapping.lookup (compute_W n) (i, j) of None \<Rightarrow> W i j | Some x \<Rightarrow> x)"
  by (auto dest: compute_W_correct split: option.split)

lemma min_wpl'_correct:
  "min_wpl' i j = min_wpl W i j"
  using W_compute unfolding min_wpl'_def by simp

definition
  "opt_bst' i j \<equiv>
  let
    M = compute_W j;
    W = (\<lambda>i j. case Mapping.lookup M (i, j) of None \<Rightarrow> W i j | Some x \<Rightarrow> x)
  in opt_bst W i j"

lemma opt_bst'_correct:
  "opt_bst' i j = opt_bst W i j"
  using W_compute unfolding opt_bst'_def by simp

end (* fixed p *)

subsubsection \<open>Test Case\<close>

text \<open>Functional Implementations\<close>

lemma "min_wpl (\<lambda>i j. nat(i+j)) 0 4 = 10"
  by eval

lemma "opt_bst (\<lambda>i j. nat(i+j)) 0 4 = \<langle>\<langle>\<langle>\<langle>\<langle>\<langle>\<rangle>, 0, \<langle>\<rangle>\<rangle>, 1, \<langle>\<rangle>\<rangle>, 2, \<langle>\<rangle>\<rangle>, 3, \<langle>\<rangle>\<rangle>, 4, \<langle>\<rangle>\<rangle>"
  by eval

text \<open>Using Frequencies\<close>
definition
  "list_to_p xs (i::int) = (if i - 1 \<ge> 0 \<and> nat (i - 1) < length xs then xs ! nat (i - 1) else 0)"

definition
  "ex_p_1 = [10, 30, 15, 25, 20]"

definition
  "opt_tree_1 =
  \<langle>
    \<langle>
      \<langle>\<langle>\<rangle>, 1::int, \<langle>\<rangle>\<rangle>,
      2,
      \<langle>\<langle>\<rangle>, 3, \<langle>\<rangle>\<rangle>
    \<rangle>,
    4,
    \<langle>\<langle>\<rangle>, 5, \<langle>\<rangle>\<rangle>
  \<rangle>"

lemma "opt_bst' (list_to_p ex_p_1) 1 5 = opt_tree_1"
  by eval

text \<open>Imperative Implementation\<close>

code_thms min_wpl

definition "min_wpl_test = min_wpl\<^sub>h (\<lambda>i j. nat(i+j)) 4 0 4"

code_reflect Test functions min_wpl_test

ML \<open>Test.min_wpl_test ()\<close>

end


theory ND_Compl_Truthtable_Compact
imports ND_Compl_Truthtable Compactness
begin

theorem
  fixes \<Gamma> :: "'a :: countable formula set"
  shows "\<Gamma> \<TTurnstile> F \<Longrightarrow> \<Gamma> \<turnstile> F"
proof -
  assume \<open>\<Gamma> \<TTurnstile> F\<close>
  then obtain G  where "set G \<subseteq> \<Gamma>" "\<Turnstile> \<^bold>\<And>G \<^bold>\<rightarrow> F" by (rule compact_to_formula)
  from ND_complete \<open>\<Turnstile> \<^bold>\<And>G \<^bold>\<rightarrow> F\<close> have \<open>{} \<turnstile> \<^bold>\<And>G \<^bold>\<rightarrow> F\<close> .
  with AssmBigAnd have \<open>set G \<turnstile> F\<close> ..
  with Weaken show ?thesis using \<open>set G \<subseteq> \<Gamma>\<close> .
qed

end


(*<*)
(*
   Title:  Gateway_proof_aux.thy  (Gateway: Verification, aux. lemmas)
   Author: Maria Spichkova <maria.spichkova at rmit.edu.au>, 2013
*)
(*>*)
section \<open>Gateway: Verification\<close>

theory Gateway_proof_aux
imports Gateway BitBoolTS
begin

subsection \<open>Properties of the defined data types\<close>

lemma aType_empty:
  assumes h1:"msg (Suc 0) a"
         and h2: "a t \<noteq> [sc_ack]"
  shows       "a t = []"
proof (cases "a t")
  assume a1:"a t = []"
  from this show ?thesis by simp
next
  fix aa l
  assume a2:"a t = aa # l"
  show ?thesis
    proof (cases "aa")
      assume a3:"aa = sc_ack"
      from h1 have sg1:"length (a t) \<le> Suc 0" by (simp add: msg_def)
      from this and assms and a2 and a3 show ?thesis by auto
    qed
qed

lemma aType_nonempty:
  assumes h1:"msg (Suc 0) a"
      and h2: "a t \<noteq> []"
  shows       "a t = [sc_ack]"
proof (cases "a t")
  assume a1:"a t = []"
  from this and h2 show ?thesis by simp
next
  fix aa l
  assume a2:"a t = aa # l"
  from a2 and h1 have sg1: "l = []" by (simp add: msg_nonempty1)
  from a2 and h1 and sg1 show ?thesis
    proof (cases "aa")
      assume a3:"aa = sc_ack"
      from this and sg1 and h2 and a2 show ?thesis  by simp
    qed
qed

lemma aType_lemma:
  assumes "msg (Suc 0) a"
  shows    "a t = [] \<or> a t = [sc_ack]"
using assms
by (metis aType_nonempty)

lemma stopType_empty:
  assumes "msg (Suc 0) a"
         and "a t \<noteq> [stop_vc]"
  shows "a t = []"
using assms
by (metis (full_types) list_length_hint2 msg_nonempty2 stopType.exhaust)

lemma stopType_nonempty:
  assumes "msg (Suc 0) a"
         and "a t \<noteq> []"
  shows "a t = [stop_vc]"
using assms
by (metis stopType_empty)

lemma stopType_lemma:
  assumes "msg (Suc 0) a"
  shows    "a t = [] \<or> a t = [stop_vc]"
using assms
by (metis stopType_nonempty)

lemma vcType_empty:
  assumes "msg (Suc 0) a"
         and "a t \<noteq> [vc_com]"
  shows"a t = []"
using assms
by (metis (full_types) list_length_hint2 msg_nonempty2 vcType.exhaust)

lemma vcType_lemma:
  assumes "msg (Suc 0) a"
  shows    "a t = [] \<or> a t = [vc_com]"
using assms
by (metis vcType_empty)

subsection \<open>Properties of the Delay component\<close>

lemma Delay_L1:
 assumes h1:"\<forall>t1 < t. i1 t1 = []"
         and h2:"Delay y i1 d x i2"
         and h3:"t2 < t + d"
   shows "i2 t2 = []"
proof (cases "t2 < d")
  assume a1:"t2 < d"
  from h2 have sg1:"t2 < d \<longrightarrow> i2 t2 = []"
    by (simp add: Delay_def)
  from sg1 and a1 show ?thesis by simp
next
  assume a2:"\<not> t2 < d"
  from h2 have sg2:"d \<le> t2 \<longrightarrow> i2 t2 = i1 (t2 - d)"
    by (simp add: Delay_def)
  from a2 and sg2 have "i2 t2 = i1 (t2 - d)" by simp
  from h1 and a2 and h3 and this show ?thesis by auto
qed

lemma Delay_L2:
 assumes "\<forall>t1 < t. i1 t1 = []"
        and "Delay y i1 d x i2"
   shows "\<forall>t2 < t + d. i2 t2 = []"
using assms by (clarify, rule Delay_L1, auto)

lemma Delay_L3:
 assumes h1:"\<forall>t1 \<le> t. y t1 = []"
        and h2:"Delay y i1 d x i2"
        and h3:"t2 \<le> t + d"
   shows "x t2 = []"
proof (cases "t2 < d")
  assume a1:"t2 < d"
  from h2 have sg1:"t2 < d \<longrightarrow> x t2 = []"
    by (simp add: Delay_def)
  from sg1 and a1 show ?thesis by simp
next
  assume a2:"\<not> t2 < d"
  from h2 have sg2:"d \<le> t2 \<longrightarrow> x t2 = y (t2 - d)"
    by (simp add: Delay_def)
  from a2 and sg2 have sg3:"x t2 = y (t2 - d)" by simp
  from h1 and a2 and h3 and sg3 show ?thesis by auto
qed

lemma Delay_L4:
 assumes "\<forall>t1 \<le> t. y t1 = []"
     and "Delay y i1 d x i2"
   shows "\<forall>t2 \<le> t + d. x t2 = []"
using assms by (clarify, rule Delay_L3, auto)

lemma Delay_lengthOut1:
  assumes h1:"\<forall>t. length (x t) \<le> Suc 0"
         and h2:"Delay x i1 d y i2"
  shows "length (y t) \<le> Suc 0"
proof (cases "t < d")
  assume a1:"t < d"
  from h2 have sg1:"t < d \<longrightarrow> y t = []"
    by (simp add: Delay_def)
  from a1 and sg1 show ?thesis by auto
next
  assume a2:"\<not> t < d"
  from h2 have sg2:"t \<ge> d \<longrightarrow> (y t = x (t-d))"
    by (simp add: Delay_def)
  from a2 and sg2 and h1 show ?thesis by auto
qed

lemma Delay_msg1:
  assumes "msg (Suc 0) x"
         and "Delay x i1 d y i2"
  shows      "msg (Suc 0) y"
using assms
by (simp add: msg_def Delay_lengthOut1)

subsection \<open>Properties of the Loss component\<close>

lemma Loss_L1:
 assumes "\<forall>t2<t. i2 t2 = []"
        and "Loss lose a i2 y i"
        and "t2 < t"
        and "ts lose"
 shows "i t2 = []"
using assms
by (metis Loss_def)

lemma Loss_L2:
 assumes "\<forall>t2<t. i2 t2 = []"
        and "Loss lose a i2 y i"
        and "ts lose"
 shows  "\<forall>t2<t. i t2 = []"
using assms
by (metis Loss_def)

lemma Loss_L3:
 assumes "\<forall>t2<t. a t2 = []"
        and "Loss lose a i2 y i"
        and "t2 < t"
        and "ts lose"
 shows "y t2 = []"
using assms
by (metis Loss_def)

lemma Loss_L4:
 assumes "\<forall>t2<t. a t2 = []"
        and "Loss lose a i2 y i"
        and "ts lose"
 shows  "\<forall>t2<t. y t2 = []"
using assms
by (metis Loss_def)

lemma Loss_L5:
 assumes "\<forall>t1 \<le> t. a t1 = []"
        and "Loss lose a i2 y i"
        and "t2 \<le> t"
        and "ts lose"
 shows "y t2 = []"
using assms
by (metis Loss_def)

lemma Loss_L5Suc:
 assumes "\<forall>j \<le> d. a (t + Suc j) = []"
        and "Loss lose a i2 y i"
        and "Suc j \<le> d"
        and tsLose:"ts lose"
 shows "y (t + Suc j) = []"
using assms
proof (cases "lose (t + Suc j) = [False]")
  assume "lose (t + Suc j) = [False]"
  from assms and this show ?thesis by (simp add: Loss_def)
next
  assume "lose (t + Suc j) \<noteq> [False]"
  from this and tsLose have "lose (t + Suc j) = [True]"
    by (simp add: ts_bool_True)
  from assms and this show ?thesis by (simp add: Loss_def)
qed

lemma Loss_L6:
 assumes "\<forall>t2 \<le> t. a t2 = []"
        and "Loss lose a i2 y i"
        and "ts lose"
 shows  "\<forall>t2 \<le> t. y t2 = []"
using assms
by (metis Loss_L5)

lemma Loss_lengthOut1:
  assumes h1:"\<forall>t. length (a t) \<le> Suc 0"
         and h2:"Loss lose a i2 x i"
  shows "length (x t) \<le> Suc 0"
proof (cases "lose t =  [False]")
  assume "lose t =  [False]"
  from this and h2 have sg1:"x t = a t" by (simp add: Loss_def)
  from h1 have sg2:"length (a t) \<le> Suc 0" by auto
  from sg1 and sg2 show ?thesis by simp
next
  assume "lose t \<noteq> [False]"
  from this and h2 have "x t = []" by (simp add: Loss_def)
  from this show ?thesis by simp
qed

lemma Loss_lengthOut2:
  assumes "\<forall>t. length (a t) \<le> Suc 0"
         and "Loss lose a i2 x i"
  shows "\<forall>t. length (x t) \<le> Suc 0"
using assms
by (simp add: Loss_lengthOut1)

lemma Loss_msg1:
  assumes "msg (Suc 0) a"
         and "Loss lose a i2 x i"
  shows      "msg (Suc 0) x"
using assms
by (simp add: msg_def Loss_def Loss_lengthOut1)

subsection \<open>Properties of the composition of Delay and Loss components\<close>

lemma Loss_Delay_length_y:
  assumes "\<forall>t. length (a t) \<le> Suc 0"
         and "Delay x i1 d y i2"
         and "Loss lose a i2 x i"
  shows "length (y t) \<le> Suc 0"
using assms
by (metis Delay_msg1 Loss_msg1 msg_def)

lemma Loss_Delay_msg_a:
  assumes "msg (Suc 0) a"
         and "Delay x i1 d y i2"
         and "Loss lose a i2 x i"
  shows  "msg (Suc 0) y"
using assms
by (simp add: msg_def Loss_Delay_length_y)

subsection \<open>Auxiliary Lemmas\<close>

lemma inf_last_ti2:
  assumes "inf_last_ti dt (Suc (Suc t)) \<noteq> []"
  shows    "inf_last_ti dt (Suc (Suc (t + k))) \<noteq> []"
using assms
by (metis add_Suc inf_last_ti_nonempty_k)

lemma aux_ack_t2:
  assumes h1:"\<forall>m\<le>k. ack (Suc (Suc (t + m))) = [connection_ok]"
         and h2:"Suc (Suc t) < t2"
         and h3:"t2 < t + 3 + k"
  shows "ack t2 = [connection_ok]"
proof -
  from h3 have sg1:"t2 - Suc (Suc t) \<le> k" by arith
  from h1 and sg1
    obtain m where a1:"m = t2 - Suc (Suc t)"
                  and a2:"ack (Suc (Suc (t + m))) = [connection_ok]"
    by auto
  from h2 have sg2:"(Suc (Suc (t2 - 2))) =  t2" by arith
  from h2 have sg3:"Suc (Suc (t + (t2 - Suc (Suc t)))) =  t2" by arith
  from sg1 and a1 and a2 and sg2 and sg3 show ?thesis by simp
qed

lemma aux_lemma_lose_1:
  assumes h1:"\<forall>j\<le>((2::nat) * d + ((4::nat) + k)). (lose (t + j) = x)"
         and h2:"ka\<le>Suc d"
  shows "lose (Suc (Suc (t + k + ka))) = x"
proof -
  from h2 have sg1:"k + (2::nat) + ka \<le> (2::nat) * d + ((4::nat) + k)" by auto
  from h2 and sg1 have sg2:"Suc (Suc (k + ka)) \<le>2 * d + (4 + k)" by auto
  from sg1 and sg2 and h1 and h2  obtain j where a1:"j = k + (2::nat) + ka"
                                     and a2:"lose (t + j) = x"
    by blast
  have sg3:"Suc (Suc (t + (k + ka))) = Suc (Suc (t + k + ka))" by arith
  from a1 and a2 and sg3 show ?thesis  by simp
qed

lemma aux_lemma_lose_2:
  assumes "\<forall>j\<le>(2::nat) * d + ((4::nat) + k). lose (t + j) = [False]"
  shows    "\<forall>x\<le>d + (1::nat). lose (t + x) = [False]"
using assms by auto

lemma aux_lemma_lose_3a:
  assumes h1:"\<forall>j\<le>2 * d + (4 + k). lose (t + j) = [False]"
         and h2:"ka \<le> Suc d"
  shows "lose (d + (t + (3 + k)) + ka) = [False]"
proof -
  from h2 have sg1:"(d + 3 + k + ka) \<le>2 * d + (4 + k)"
    by arith
  from h1 and h2 and sg1  obtain j where a1:"j = (d + 3 + k + ka)" and
                                         a2:"lose (t + j) = [False]"
    by simp
  from h2 and sg1 have sg2:"(t + (d + 3 + k + ka)) = (d + (t + (3 + k)) + ka)"
    by arith
  from h1 and h2 and a1 and a2 and sg2 show ?thesis
    by simp
qed

lemma aux_lemma_lose_3:
  assumes "\<forall>j\<le>2 * d + (4 + k). lose (t + j) = [False]"
  shows    "\<forall>ka\<le>Suc d. lose (d + (t + (3 + k)) + ka) = [False]"
using assms
by (auto, simp add: aux_lemma_lose_3a)

lemma aux_arith1_Gateway7:
  assumes "t2 - t \<le> (2::nat) * d + (t + ((4::nat) + k))"
         and "t2 < t + (3::nat) + k + d"
         and "\<not> t2 - d < (0::nat)"
  shows "t2 - d < t + (3::nat) + k"
using assms  by arith

lemma ts_lose_ack_st1ts:
  assumes "ts lose"
         and "lose t = [True]  \<longrightarrow>  ack t = [x]  \<and> st_out t = x"
         and "lose t = [False] \<longrightarrow>  ack t = [y]  \<and> st_out t = y"
  shows "ack t = [st_out t]"
using assms
by (metis ts_bool_False)

lemma ts_lose_ack_st1:
  assumes h1:"lose t = [True] \<or> lose t = [False]"
  and h2:"lose t = [True]  \<longrightarrow>  ack t = [x]  \<and> st_out t = x"
  and h3:"lose t = [False] \<longrightarrow>  ack t = [y]  \<and> st_out t = y"
  shows "ack t = [st_out t]"
proof (cases "lose t = [False]")
  assume "lose t = [False]"
  from this and h3 show ?thesis by simp
next
  assume a2:"lose t \<noteq> [False]"
  from this and h1 have "lose t = [True]" by (simp add: ts_bool_True)
  from this and a2 and h2 show ?thesis by simp
qed

lemma ts_lose_ack_st2ts:
  assumes "ts lose"
         and "lose t = [True] \<longrightarrow>
                 ack t = [x]  \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = x"
        and "lose t = [False] \<longrightarrow>
               ack t = [y] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = y"
  shows "ack t = [st_out t]"
using assms
by (metis ts_bool_True_False)

lemma ts_lose_ack_st2:
  assumes h1:"lose t = [True] \<or> lose t = [False]"
         and h2:"lose t = [True] \<longrightarrow>
                ack t = [x]  \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = x"
         and h3:"lose t = [False] \<longrightarrow>
                ack t = [y] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = y"
  shows "ack t = [st_out t]"
proof (cases "lose t = [False]")
  assume "lose t = [False]"
  from this and h3 show ?thesis by simp
next
  assume a2:"lose t \<noteq> [False]"
  from this and h1 have "lose t = [True]" by (simp add: ts_bool_True)
  from this and a2 and h2 show ?thesis by simp
qed

lemma ts_lose_ack_st2vc_com:
assumes h1:"lose t = [True] \<or> lose t = [False]"
       and h2:"lose t = [True] \<longrightarrow>
             ack t = [x]  \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = x"
       and h3:"lose t = [False] \<longrightarrow>
             ack t = [y] \<and> i1 t = [] \<and> vc t = [vc_com] \<and> st_out t = y"
shows "ack t = [st_out t]"
proof (cases "lose t = [False]")
  assume "lose t = [False]"
  from this and h3 show ?thesis by simp
next
  assume a2:"lose t \<noteq> [False]"
  from this and h1 have ag1:"lose t = [True]" by (simp add: ts_bool_True)
  from this and a2 and h2 show ?thesis by simp
qed

lemma ts_lose_ack_st2send:
  assumes h1:"lose t = [True] \<or> lose t = [False]"
  and h2:"lose t = [True] \<longrightarrow>
      ack t = [x]  \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = x"
  and h3:"lose t = [False] \<longrightarrow>
      ack t = [y] \<and> i1 t = b t \<and> vc t = [] \<and> st_out t = y"
  shows "ack t = [st_out t]"
proof (cases "lose t = [False]")
  assume "lose t = [False]"
  from this and h3 show ?thesis by simp
next
  assume a2:"lose t \<noteq> [False]"
  from this and h1 have "lose t = [True]" by (simp add: ts_bool_True)
  from this and a2 and h2 show ?thesis by simp
qed

lemma tiTable_ack_st_splitten:
  assumes h1:"ts lose"
      and h2:"msg (Suc 0) a1"
      and h3:"msg (Suc 0) stop"
      and h4:"st_in t = init_state \<and> req t = [init] \<longrightarrow>
          ack t = [call] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = call"
      and h5:"st_in t = init_state \<and> req t \<noteq> [init] \<longrightarrow>
          ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
      and h6:"(st_in t = call \<or> st_in t = connection_ok \<and> req t \<noteq> [send]) \<and> lose t = [False] \<longrightarrow>
          ack t = [connection_ok] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = connection_ok"
      and h7:"(st_in t = call \<or> st_in t = connection_ok \<or> st_in t = sending_data) \<and> lose t = [True] \<longrightarrow>
          ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
      and h8:"st_in t = connection_ok \<and> req t = [send] \<and> lose t = [False] \<longrightarrow>
          ack t = [sending_data] \<and> i1 t = b t \<and> vc t = [] \<and> st_out t = sending_data"
      and h9:"st_in t = sending_data \<and> a1 t = [] \<and> lose t = [False] \<longrightarrow>
          ack t = [sending_data] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = sending_data"
      and h10:"st_in t = sending_data \<and> a1 t = [sc_ack] \<and> lose t = [False] \<longrightarrow>
          ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [vc_com] \<and> st_out t = voice_com"
      and h11:"st_in t = voice_com \<and> stop t = [] \<and> lose t = [False] \<longrightarrow>
          ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [vc_com] \<and> st_out t = voice_com"
      and h12:"st_in t = voice_com \<and> stop t = [] \<and> lose t = [True] \<longrightarrow>
          ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = voice_com"
      and h13:"st_in t = voice_com \<and> stop t = [stop_vc] \<longrightarrow>
          ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
  shows "ack t = [st_out t]"
proof -
  from h1 and h6 and h7 have sg1:"lose t = [True] \<or> lose t = [False]"
    by (simp add: ts_bool_True_False)
show ?thesis
proof (cases "st_in t")
  assume a1:"st_in t = init_state"
  from a1 and h4 and h5 show ?thesis
  proof (cases "req t = [init]")
    assume a11:"req t = [init]"
    from a11 and a1 and h4 and h5 show ?thesis by simp
  next
    assume a12:"req t \<noteq> [init]"
    from a12 and a1 and h4 and h5 show ?thesis by simp
  qed
next
  assume a2:"st_in t = call"
  from a2 and sg1 and h6 and h7 show ?thesis
     apply simp
     by (rule ts_lose_ack_st2, assumption+)
next
  assume a3:"st_in t = connection_ok"
  from a3 and h6 and h7 and h8 show ?thesis apply simp
  proof (cases "req t = [send]")
    assume a31:"req t = [send]"
    from this and a3 and h6 and h7 and h8 and sg1 show ?thesis
      apply simp
      by (rule ts_lose_ack_st2send, assumption+)
  next
    assume a32:"req t \<noteq> [send]"
    from this and a3 and h6 and h7 and h8 and sg1 show ?thesis
      apply simp
      by (rule ts_lose_ack_st2, assumption+)
  qed
next
  assume a4:"st_in t = sending_data"
  from sg1 and a4 and h7 and h9 and h10  show ?thesis apply simp
  proof (cases "a1 t = []")
    assume a41:"a1 t = []"
    from this and a4 and sg1 and h7 and h9 and h10 show ?thesis
      apply simp
      by (rule ts_lose_ack_st2, assumption+)
  next
    assume a42:"a1 t \<noteq> []"
    from this and h2  have "a1 t = [sc_ack]"  by (simp add: aType_nonempty)
    from this and a4 and a42 and sg1 and h7 and h9 and h10 show ?thesis
      apply simp
      by (rule ts_lose_ack_st2vc_com, assumption+)
  qed
next
  assume a5:"st_in t = voice_com"
  from a5 and h11 and h12 and h13 show ?thesis
  apply simp
  proof (cases "stop t = []")
    assume a51:"stop t = []"
    from this and a5 and h11 and h12 and h13 and sg1 show ?thesis
      apply simp
      by (rule ts_lose_ack_st2vc_com, assumption+)
  next
    assume a52:"stop t \<noteq> []"
    from this and h3 have sg7:"stop t = [stop_vc]"
      by (simp add: stopType_nonempty)
    from this and a5 and a52 and h13 show ?thesis by simp
  qed
qed
qed

lemma tiTable_ack_st:
assumes "tiTable_SampleT req a1 stop lose st_in b ack i1 vc st_out"
       and tsLose:"ts lose"
       and a1Msg1:"msg (Suc 0) a1"
       and stopMsg1:"msg (Suc 0) stop"
  shows      "ack t = [st_out t] "
proof -
  from assms have sg1:
   "st_in t = init_state \<and> req t = [init] \<longrightarrow>
    ack t = [call] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = call"
     by (simp add: tiTable_SampleT_def)
  from assms have sg2:
   "st_in t = init_state \<and> req t \<noteq> [init] \<longrightarrow>
    ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
     by (simp add: tiTable_SampleT_def)
  from assms have sg3:
   "(st_in t = call \<or> st_in t = connection_ok \<and> req t \<noteq> [send]) \<and>
     lose t = [False] \<longrightarrow>
     ack t = [connection_ok] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = connection_ok"
     by (simp add: tiTable_SampleT_def)
  from assms have sg4:
   "(st_in t = call \<or> st_in t = connection_ok \<or> st_in t = sending_data) \<and>
     lose t = [True] \<longrightarrow>
     ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
     by (simp add: tiTable_SampleT_def)
  from assms have sg5:
   "st_in t = connection_ok \<and> req t = [send] \<and> lose t = [False] \<longrightarrow>
    ack t = [sending_data] \<and> i1 t = b t \<and> vc t = [] \<and> st_out t = sending_data"
    by (simp add: tiTable_SampleT_def)
  from assms have sg6:
   "st_in t = sending_data \<and> a1 t = [] \<and> lose t = [False] \<longrightarrow>
    ack t = [sending_data] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = sending_data"
     by (simp add: tiTable_SampleT_def)
  from assms have sg7:
   "st_in t = sending_data \<and> a1 t = [sc_ack] \<and> lose t = [False] \<longrightarrow>
    ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [vc_com] \<and> st_out t = voice_com"
    by (simp add: tiTable_SampleT_def)
  from assms have sg8:
   "st_in t = voice_com \<and> stop t = [] \<and> lose t = [False] \<longrightarrow>
    ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [vc_com] \<and> st_out t = voice_com"
    by (simp add: tiTable_SampleT_def)
  from assms have sg9:
   "st_in t = voice_com \<and> stop t = [] \<and> lose t = [True] \<longrightarrow>
    ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = voice_com"
    by (simp add: tiTable_SampleT_def)
  from assms have sg10:
   "st_in t = voice_com \<and> stop t = [stop_vc] \<longrightarrow>
    ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
    by (simp add: tiTable_SampleT_def)
  from tsLose and a1Msg1 and stopMsg1 and sg1 and sg2 and sg3 and sg4 and sg5 and
  sg6 and sg7 and sg8 and sg9 and sg10 show ?thesis
    by (rule tiTable_ack_st_splitten)
qed

lemma tiTable_ack_st_hd:
assumes "tiTable_SampleT req a1 stop lose st_in b ack i1 vc st_out"
       and "ts lose"
       and "msg (Suc 0) a1"
       and "msg (Suc 0) stop"
shows "st_out t =  hd (ack t)"
using assms by (simp add:  tiTable_ack_st)

lemma tiTable_ack_connection_ok:
  assumes tbl:"tiTable_SampleT req x stop lose st_in b ack i1 vc st_out"
      and ackCon:"ack t = [connection_ok]"
      and xMsg1:"msg (Suc 0) x"
      and tsLose:"ts lose"
      and stopMsg1:"msg (Suc 0) stop"
  shows "(st_in t = call \<or> st_in t = connection_ok \<and> req t \<noteq> [send]) \<and>
         lose t = [False]"
proof -
  from tbl and tsLose have sg1:"lose t = [True] \<or> lose t = [False]"
    by (simp add: ts_bool_True_False)
  from tbl and xMsg1 have sg2:"x t = [] \<or> x t = [sc_ack]"
    by (simp add: aType_lemma)
  from tbl and stopMsg1 have sg3:"stop t = [] \<or> stop t = [stop_vc]"
    by (simp add: stopType_lemma)
  show ?thesis
  proof (cases "st_in t")
    assume a1:"st_in t = init_state"
    show ?thesis
    proof (cases "req t = [init]")
      assume a11:"req t = [init]"
      from tbl and a1 and a11 and ackCon show ?thesis by (simp add: tiTable_SampleT_def)
    next
      assume a12:"req t \<noteq> [init]"
      from tbl and a1 and a12 and ackCon show ?thesis by (simp add: tiTable_SampleT_def)
    qed
  next
    assume a2:"st_in t = call"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a21:"lose t = [True]"
      from tbl and a2 and a21 and ackCon show ?thesis by (simp add: tiTable_SampleT_def)
    next
      assume a22:"lose t \<noteq> [True]"
      from this and tsLose have a22a:"lose t = [False]" by (simp add: ts_bool_False)
      from tbl have
       "(st_in t = call \<or> st_in t = connection_ok \<and> req t \<noteq> [send]) \<and>
         lose t = [False] \<longrightarrow>
         ack t = [connection_ok] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = connection_ok"
         by (simp add: tiTable_SampleT_def)
      from this and a2 and a22a and ackCon show ?thesis by simp
    qed
  next
    assume a3:"st_in t = connection_ok"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a31:"lose t = [True]"
      from tbl have
       "(st_in t = call \<or> st_in t = connection_ok \<or> st_in t = sending_data) \<and>
         lose t = [True] \<longrightarrow>
         ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
        by (simp add: tiTable_SampleT_def)
      from this and a3 and a31 and ackCon show ?thesis by simp
    next
      assume a32:"lose t \<noteq> [True]"
      from this and tsLose have a32a:"lose t = [False]" by (simp add: ts_bool_False)
      show ?thesis
      proof (cases "req t = [send]")
        assume a321:"req t = [send]"
        from tbl and a3 and a32a and a321 and ackCon show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a322:"req t \<noteq> [send]"
        from tbl and a3 and a32a and a322 and ackCon show ?thesis
           by (simp add: tiTable_SampleT_def)
      qed
    qed
  next
    assume a4:"st_in t = sending_data"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a41:"lose t = [True]"
      from tbl and a4 and a41 and ackCon show ?thesis
         by (simp add: tiTable_SampleT_def)
    next
      assume a42:"lose t \<noteq> [True]"
      from this and tsLose have a42a:"lose t = [False]" by (simp add: ts_bool_False)
      show ?thesis
      proof (cases "x t = [sc_ack]")
        assume a421:"x t = [sc_ack]"
        from tbl and a4 and a42a and a421 and ackCon show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a422:" x t \<noteq> [sc_ack]"
        from this and xMsg1 have a422a:"x t = []" by (simp add: aType_empty)
        from tbl and a4 and a42a and a422a and ackCon show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  next
    assume a5:"st_in t = voice_com"
    show ?thesis
    proof (cases "stop t = [stop_vc]")
      assume a51:"stop t = [stop_vc]"
      from tbl and a5 and a51 and ackCon show ?thesis
         by (simp add: tiTable_SampleT_def)
    next
      assume a52:"stop t \<noteq> [stop_vc]"
      from this and stopMsg1 have a52a:"stop t = []" by (simp add: stopType_empty)
      show ?thesis
      proof (cases "lose t = [True]")
        assume a521:"lose t = [True]"
        from tbl and a5 and a52a and a521 and ackCon show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a522:"lose t \<noteq> [True]"
        from this and tsLose have a522a:"lose t = [False]" by (simp add: ts_bool_False)
        from tbl and a5 and a52a and a522a and ackCon show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  qed
qed

lemma tiTable_i1_1:
assumes tbl:"tiTable_SampleT req x stop lose st_in b ack i1 vc st_out"
       and "ts lose"
       and "msg (Suc 0) x"
       and "msg (Suc 0) stop"
       and "ack t = [connection_ok]"
shows "i1 t = []"
proof -
  from assms have
   "(st_in t = call \<or> st_in t = connection_ok \<and> req t \<noteq> [send]) \<and>
    lose t = [False]"
    by (simp add: tiTable_ack_connection_ok)
  from this and tbl show ?thesis by (simp add: tiTable_SampleT_def)
qed

lemma tiTable_ack_call:
assumes tbl:"tiTable_SampleT req x stop lose st_in b ack i1 vc st_out"
      and ackCall:"ack t = [call]"
      and xMsg1:"msg (Suc 0) x"
      and tsLose:"ts lose"
      and stopMsg1:"msg (Suc 0) stop"
shows "st_in t = init_state \<and> req t = [init]"
proof -
  from tbl and tsLose have sg1:"lose t = [True] \<or> lose t = [False]"
    by (simp add: ts_bool_True_False)
  from tbl and xMsg1 have sg2:"x t = [] \<or> x t = [sc_ack]"
    by (simp add: aType_lemma)
  from tbl and stopMsg1 have sg3:"stop t = [] \<or> stop t = [stop_vc]"
    by (simp add: stopType_lemma)
  show ?thesis
  proof (cases "st_in t")
    assume a1:"st_in t = init_state"
    show ?thesis
    proof (cases "req t = [init]")
      assume a11:"req t = [init]"
      from tbl and a1 and a11 and ackCall show ?thesis
        by (simp add: tiTable_SampleT_def)
    next
      assume a12:"req t \<noteq> [init]"
      from tbl and a1 and a12 and ackCall show ?thesis
         by (simp add: tiTable_SampleT_def)
    qed
  next
    assume a2:"st_in t = call"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a21:"lose t = [True]"
      from tbl and a2 and a21 and ackCall show ?thesis
        by (simp add: tiTable_SampleT_def)
    next
      assume a22:"lose t \<noteq> [True]"
      from this and tsLose have a22a:"lose t = [False]"
         by (simp add: ts_bool_False)
      from tbl and a2 and a22a and ackCall show ?thesis
         by (simp add: tiTable_SampleT_def)
    qed
  next
    assume a3:"st_in t = connection_ok"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a31:"lose t = [True]"
      from tbl and a3 and a31 and ackCall show ?thesis
        by (simp add: tiTable_SampleT_def)
    next
      assume a32:"lose t \<noteq> [True]"
      from this and tsLose have a32a:"lose t = [False]"
        by (simp add: ts_bool_False)
      show ?thesis
      proof (cases "req t = [send]")
        assume a321:"req t = [send]"
        from tbl and a3 and a32a and a321 and ackCall show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a322:"req t \<noteq> [send]"
        from tbl and a3 and a32a and a322 and ackCall show ?thesis
           by (simp add: tiTable_SampleT_def)
      qed
    qed
  next
    assume a4:"st_in t = sending_data"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a41:"lose t = [True]"
      from tbl and a4 and a41 and ackCall show ?thesis
        by (simp add: tiTable_SampleT_def)
    next
      assume a42:"lose t \<noteq> [True]"
      from this and tsLose have a42a:"lose t = [False]"
        by (simp add: ts_bool_False)
      show ?thesis
      proof (cases "x t = [sc_ack]")
        assume a421:"x t = [sc_ack]"
        from tbl and a4 and a42a and a421 and ackCall show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a422:" x t \<noteq> [sc_ack]"
        from this and xMsg1  have a422a:"x t = []"
          by (simp add: aType_empty)
        from tbl and a4 and a42a and a422a and ackCall show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  next
    assume a5:"st_in t = voice_com"
    show ?thesis
    proof (cases "stop t = [stop_vc]")
      assume a51:"stop t = [stop_vc]"
      from tbl and a5 and a51 and ackCall show ?thesis
        by (simp add: tiTable_SampleT_def)
    next
      assume a52:"stop t \<noteq> [stop_vc]"
      from this and stopMsg1 have a52a:"stop t = []" by (simp add: stopType_empty)
      show ?thesis
      proof (cases "lose t = [True]")
        assume a521:"lose t = [True]"
        from tbl and a5 and a52a and a521 and ackCall show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a522:"lose t \<noteq> [True]"
        from this and tsLose have a522a:"lose t = [False]" by (simp add: ts_bool_False)
        from tbl and a5 and a52a and a522a and ackCall show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  qed
qed

lemma tiTable_i1_2:
assumes tbl:"tiTable_SampleT req a1 stop lose st_in b ack i1 vc st_out"
       and "ts lose"
       and "msg (Suc 0) a1"
       and "msg (Suc 0) stop"
       and "ack t = [call]"
shows "i1 t = []"
proof -
  from assms have "st_in t = init_state \<and> req t = [init]"
    by (simp add: tiTable_ack_call)
  from this and tbl show ?thesis
    by (simp add: tiTable_SampleT_def)
qed

lemma tiTable_ack_init0:
assumes tbl:"tiTable_SampleT req a1 stop lose
                  (fin_inf_append [init_state] st)
                   b ack i1 vc st"
      and req0:"req 0 = []"
shows "ack 0 = [init_state]"
proof -
  have "(fin_inf_append [init_state] st) (0::nat) = init_state"
    by (simp add: fin_inf_append_def)
  from tbl and this and req0 show ?thesis by (simp add: tiTable_SampleT_def)
qed

lemma tiTable_ack_init:
assumes "tiTable_SampleT req a1 stop lose
                  (fin_inf_append [init_state] st)
                   b ack i1 vc st"
      and "ts lose"
      and "msg (Suc 0) a1"
      and "msg (Suc 0) stop"
      and "\<forall> t1 \<le> t. req t1 = []"
shows "ack t = [init_state]"
using assms
proof (induction t)
  case 0
  from this show ?case
    by (simp add: tiTable_ack_init0)
next
  case (Suc t)
  from Suc have sg1: "st t =  hd (ack t)"
    by (simp add: tiTable_ack_st_hd)
  from Suc and sg1 have sg2:
   "(fin_inf_append [init_state] st) (Suc t) = init_state"
    by (simp add: correct_fin_inf_append2)
  from Suc and sg1 and sg2 show ?case
    by (simp add: tiTable_SampleT_def)
qed

lemma tiTable_i1_3:
assumes tbl:"tiTable_SampleT req x stop lose
                  (fin_inf_append [init_state] st)  b ack i1 vc st"
      and tsLose:"ts lose"
      and xMsg1:"msg (Suc 0) x"
      and stopMsg1:"msg (Suc 0) stop"
      and h5:"\<forall> t1 \<le> t. req t1 = []"
shows "i1 t = []"
proof -
  from assms have sg1:"ack t = [init_state]"
    by (simp add: tiTable_ack_init)
  from assms have sg2:"st t =  hd (ack t)"
    by (simp add: tiTable_ack_st_hd)
  from sg1 and sg2 have sg3:
   "(fin_inf_append [init_state] st) (Suc t) = init_state"
    by (simp add: correct_fin_inf_append2)
  from tbl and tsLose have sg4:"lose t = [True] \<or> lose t = [False]"
    by (simp add: ts_bool_True_False)
  from tbl and xMsg1 have sg5:"x t = [] \<or> x t = [sc_ack]"
    by (simp add: aType_lemma)
  from tbl and stopMsg1 have sg6:"stop t = [] \<or> stop t = [stop_vc]"
    by (simp add: stopType_lemma)
  show ?thesis
  proof (cases "fin_inf_append [init_state] st t")
    assume a1:"fin_inf_append [init_state] st t = init_state"
    from assms and sg1 and sg2 and sg3 and a1 show ?thesis
      by (simp add:  tiTable_SampleT_def)
  next
    assume a2:"fin_inf_append [init_state] st t = call"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a21:"lose t = [True]"
      from tbl and a2 and a21 show ?thesis
         by (simp add: tiTable_SampleT_def)
    next
      assume a22:"lose t \<noteq> [True]"
      from this and tsLose have a22a:"lose t = [False]"
        by (simp add: ts_bool_False)
      from tbl and a2 and a22a show ?thesis
        by (simp add: tiTable_SampleT_def)
    qed
  next
    assume a3:"fin_inf_append [init_state] st t = connection_ok"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a31:"lose t = [True]"
      from tbl and a3 and a31 show ?thesis
         by (simp add: tiTable_SampleT_def)
    next
      assume a32:"lose t \<noteq> [True]"
      from this and tsLose have a32a:"lose t = [False]"
         by (simp add: ts_bool_False)
      from h5 have a322:"req t \<noteq> [send]" by auto
      from tbl and a3 and a32a and a322 show ?thesis
        by (simp add: tiTable_SampleT_def)
    qed
  next
    assume a4:"fin_inf_append [init_state] st t = sending_data"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a41:"lose t = [True]"
      from tbl and a4 and a41 show ?thesis by (simp add: tiTable_SampleT_def)
    next
      assume a42:"lose t \<noteq> [True]"
      from this and tsLose have a42a:"lose t = [False]" by (simp add: ts_bool_False)
      show ?thesis
      proof (cases "x t = [sc_ack]")
        assume a421:"x t = [sc_ack]"
        from tbl and a4 and a42a and a421 and tsLose show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a422:" x t \<noteq> [sc_ack]"
        from this and xMsg1 have a422a:"x t = []" by (simp add: aType_empty)
        from tbl and a4 and a42a and a422a and tsLose show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  next
    assume a5:"fin_inf_append [init_state] st t = voice_com"
    show ?thesis
    proof (cases "stop t = [stop_vc]")
      assume a51:"stop t = [stop_vc]"
      from tbl and a5 and a51 and tsLose show ?thesis
         by (simp add: tiTable_SampleT_def)
    next
      assume a52:"stop t \<noteq> [stop_vc]"
      from this and stopMsg1 have a52a:"stop t = []" by (simp add: stopType_empty)
      show ?thesis
      proof (cases "lose t = [True]")
        assume a521:"lose t = [True]"
        from tbl and a5 and a52a and a521 and tsLose show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a522:"lose t \<noteq> [True]"
        from this and tsLose have a522a:"lose t = [False]" by (simp add: ts_bool_False)
        from tbl and a5 and a52a and a522a and tsLose show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  qed
qed

lemma tiTable_st_call_ok:
assumes tbl:"tiTable_SampleT req x stop lose
                  (fin_inf_append [init_state] st)
                   b ack i1 vc st"
      and tsLose:"ts lose"
      and h3:"\<forall>m \<le> k. ack (Suc (Suc (t + m))) = [connection_ok]"
      and h4:"st (Suc t) = call"
shows "st (Suc (Suc t)) = connection_ok"
proof -
    from h4 have sg1:
     "(fin_inf_append [init_state] st) (Suc (Suc t)) = call"
      by (simp add: correct_fin_inf_append2)
   from tbl and tsLose have sg2:"lose (Suc (Suc t)) = [True] \<or> lose (Suc (Suc t)) = [False]"
    by (simp add: ts_bool_True_False)
   show ?thesis
   proof (cases "lose (Suc (Suc t)) = [False]")
     assume a1:"lose (Suc (Suc t)) = [False]"
     from tbl and a1 and sg1 show ?thesis
       by (simp add: tiTable_SampleT_def)
   next
     assume a2:"lose (Suc (Suc t)) \<noteq> [False]"
     from h3 have sg3:"ack (Suc (Suc t)) = [connection_ok]" by auto
     from tbl and a2 and sg1 and sg2 and sg3 show ?thesis
       by (simp add: tiTable_SampleT_def)
   qed
qed

lemma tiTable_i1_4b:
assumes "tiTable_SampleT req x stop lose
                  (fin_inf_append [init_state] st) b ack i1 vc st"
      and "ts lose"
      and "msg (Suc 0) x"
      and "msg (Suc 0) stop"
      and "\<forall> t1 \<le> t. req t1 = []"
      and "req (Suc t) = [init]"
      and "\<forall>m < k + 3. req (t + m) \<noteq> [send]"
      and h7:"\<forall>m \<le> k. ack (Suc (Suc (t + m))) = [connection_ok]"
      and "\<forall>j \<le> k + 3. lose (t + j) = [False]"
      and h9:"t2 < (t + 3 + k)"
shows "i1 t2 = []"
proof (cases "t2 \<le> t")
  assume "t2 \<le> t"
  from assms and this show ?thesis by (simp add: tiTable_i1_3)
next
  assume a2:"\<not> t2 \<le> t"
  from assms have sg1:"ack t = [init_state]" by (simp add: tiTable_ack_init)
  from assms have sg2:"st t =  hd (ack t)" by (simp add: tiTable_ack_st_hd)
  from sg1 and sg2 have sg3:
   "(fin_inf_append [init_state] st) (Suc t) = init_state"
    by (simp add: correct_fin_inf_append2)
  from assms and sg3 have sg4:"st (Suc t) = call"
    by (simp add: tiTable_SampleT_def)
  show ?thesis
  proof (cases "t2 = Suc t")
    assume a3:"t2 = Suc t"
    from assms and sg3 and a3 show ?thesis
      by (simp add: tiTable_SampleT_def)
  next
    assume a4:"t2 \<noteq> Suc t"
    from assms and sg4 and a4 and a2 have sg7:"st (Suc (Suc t)) = connection_ok"
      by (simp add: tiTable_st_call_ok)
    from assms have sg8:"ack (Suc (Suc t)) = [st (Suc (Suc t))]"
      by (simp add: tiTable_ack_st)
    show ?thesis
    proof (cases "t2 =  Suc (Suc t)")
      assume a5:"t2 =  Suc (Suc t)"
      from h7 and h9 and a5 have sg9:"ack t2 = [connection_ok]" by auto
      from assms and sg9 show ?thesis by (simp add:  tiTable_i1_1)
    next
      assume a6:"t2 \<noteq> Suc (Suc t)"
      from a6 and a4 and a2 have sg10:"Suc (Suc t) < t2" by arith
      from h7 and h9 and sg10 have sg11:"ack t2 = [connection_ok]"
        by (simp add: aux_ack_t2)
      from assms and a6 and sg7 and sg8 and sg11 show ?thesis
        by (simp add:  tiTable_i1_1)
    qed
  qed
qed

lemma tiTable_i1_4:
assumes "tiTable_SampleT req a1 stop lose
                  (fin_inf_append [init_state] st) b ack i1 vc st"
      and "ts lose"
      and "msg (Suc 0) a1"
      and "msg (Suc 0) stop"
      and "\<forall> t1 \<le> t. req t1 = []"
      and "req (Suc t) = [init]"
      and "\<forall>m < k + 3. req (t + m) \<noteq> [send]"
      and "\<forall>m \<le> k. ack (Suc (Suc (t + m))) = [connection_ok]"
      and "\<forall>j \<le> k + 3. lose (t + j) = [False]"
shows "\<forall> t2 < (t + 3 + k). i1 t2 = []"
using assms by (simp add: tiTable_i1_4b)

lemma tiTable_ack_ok:
  assumes h1:"\<forall>j\<le> d + 2. lose (t + j) = [False]"
      and tsLose:"ts lose"
      and stopMsg1:"msg (Suc 0) stop"
      and a1Msg1:"msg (Suc 0) a1"
      and reqNsend:"req (Suc t) \<noteq> [send]"
      and ackCon:"ack t = [connection_ok]"
      and tbl:"tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st) b ack i1 vc st"
  shows "ack (Suc t) = [connection_ok]"
proof -
  from tbl and tsLose and a1Msg1 and stopMsg1 have "st t =  hd (ack t)"
    by (simp add: tiTable_ack_st_hd)
  from this and ackCon have sg2:
   "(fin_inf_append [init_state] st) (Suc t) =  connection_ok"
    by (simp add: correct_fin_inf_append2)
  have sg3a:"Suc 0 \<le> d + 2" by arith
  from h1 and sg3a have sg3:"lose (t + Suc 0) = [False]" by auto
  from sg2 and sg3 and reqNsend and tbl show ?thesis
    by (simp add: tiTable_SampleT_def)
qed

lemma Gateway_L7a:
  assumes gw:"Gateway req dt a stop lose d ack i vc"
      and aMsg1:"msg (Suc 0) a"
      and stopMsg1:"msg (Suc 0) stop"
      and reqMsg1:"msg (Suc 0) req"
      and tsLose:"ts lose"
      and loseFalse:"\<forall>j\<le> d + 2. lose (t + j) = [False]"
      and nsend:"req (Suc t) \<noteq> [send]"
      and ackNCon:"ack (t) = [connection_ok]"
  shows "ack (Suc t) = [connection_ok]"
proof -
  from gw and stopMsg1 and reqMsg1 and nsend obtain i1 i2 a1 a2 where
    ah1:"Sample req dt a1 stop lose ack i1 vc" and
    ah2:"Delay a2 i1 d a1 i2" and
    ah3:"Loss lose a i2 a2 i"
    by (simp add: Gateway_def, auto)
  from ah2 and ah3 and aMsg1 have sg1:"msg (Suc 0) a1"
    by (simp add: Loss_Delay_msg_a)
  from ah1 and sg1 and stopMsg1 and reqMsg1 obtain st buffer where
    ah4:"Sample_L req dt a1 stop lose (fin_inf_append [init_state] st)
             (fin_inf_append [[]] buffer)
             ack i1 vc st buffer"
    by (simp add: Sample_def, auto)
  from ah4 have sg2:
    "tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st)
         (fin_inf_append [[]] buffer)
         ack i1 vc st"
    by (simp add: Sample_L_def)
  from loseFalse and tsLose and stopMsg1 and sg1 and
           nsend and ackNCon and sg2 show ?thesis
    by (simp add: tiTable_ack_ok)
qed

lemma Sample_L_buffer:
  assumes
    "Sample_L req dt a1 stop lose (fin_inf_append [init_state] st)
          (fin_inf_append [[]] buffer)
           ack i1 vc st buffer"
  shows "buffer t = inf_last_ti dt t"
proof -
  from assms have
   "\<forall>t. buffer t =
    (if dt t = [] then fin_inf_append [[]] buffer t else dt t)"
    by (simp add: Sample_L_def)
  from this show ?thesis
  proof (induct t)
    case 0
    from this show ?case
      by (simp add: fin_inf_append_def)
  next
    fix t
    case (Suc t)
    from this show ?case
    proof (cases "dt t = []")
      assume "dt t = []"
      from this and Suc show ?thesis
        by (simp add: correct_fin_inf_append1)
    next
      assume "dt t \<noteq> []"
      from this and Suc show ?thesis
        by (simp add: correct_fin_inf_append1)
    qed
  qed
qed

lemma  tiTable_SampleT_i1_buffer:
 assumes "ack t = [connection_ok]"
        and reqSend:"req (Suc t) = [send]"
        and loseFalse:"\<forall>k\<le>Suc d. lose (t + k) = [False]"
        and buf: "buffer t = inf_last_ti dt t"
        and tbl:"tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st)
      (fin_inf_append [[]] buffer) ack
      i1 vc st"
     and conOk:"fin_inf_append [init_state] st (Suc t) = connection_ok"
shows "i1 (Suc t) = inf_last_ti dt t"
proof -
  have sg1:"Suc 0 \<le>Suc d" by arith
  from loseFalse and sg1 have sg2:"lose (Suc t) = [False]" by auto
  from tbl have
   "fin_inf_append [init_state] st (Suc t) = connection_ok \<and>
    req (Suc t) = [send] \<and>
    lose (Suc t) = [False] \<longrightarrow>
    ack (Suc t) = [sending_data] \<and>
    i1 (Suc t) = (fin_inf_append [[]] buffer) (Suc t) \<and>
    vc (Suc t) = [] \<and> st (Suc t) = sending_data"
    by (simp add: tiTable_SampleT_def)
  from this and conOk and reqSend and sg2 have
   "i1 (Suc t) = (fin_inf_append [[]] buffer) (Suc t)" by simp
  from this and buf show ?thesis by (simp add: correct_fin_inf_append1)
qed

lemma Sample_L_i1_buffer:
  assumes "msg (Suc 0) req"
      and "msg (Suc 0) a"
      and stopMsg1:"msg (Suc 0) stop"
      and a1Msg1:"msg (Suc 0) a1"
      and tsLose:"ts lose"
      and ackCon:"ack t = [connection_ok]"
      and reqSend:"req (Suc t) = [send]"
      and loseFalse:"\<forall>k\<le>Suc d. lose (t + k) = [False]"
      and smpl:"Sample_L req dt a1 stop lose
                (fin_inf_append [init_state] st)
                (fin_inf_append [[]] buffer) ack i1 vc st buffer"
  shows "i1 (Suc t) =  buffer t"
proof -
  from smpl have sg1:"buffer t = inf_last_ti dt t"
    by (simp add: Sample_L_buffer)
  from smpl have sg2:
    "\<forall>t. buffer t = (if dt t = [] then fin_inf_append [[]] buffer t else dt t)"
    by (simp add: Sample_L_def)
  from smpl have sg3:
    "tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st)
      (fin_inf_append [[]] buffer) ack
      i1 vc st"
    by (simp add: Sample_L_def)
  from sg3 and tsLose and a1Msg1 and stopMsg1 have sg4:"st t =  hd (ack t)"
    by (simp add: tiTable_ack_st_hd)
  from ackCon and sg4 have sg5:
    "(fin_inf_append [init_state] st) (Suc t) = connection_ok"
    by (simp add: correct_fin_inf_append1)
  from ackCon and reqSend and loseFalse and sg1 and
           sg3 and sg4 and sg5 have sg6:
    "i1 (Suc t) = inf_last_ti dt t"
     by (simp add: tiTable_SampleT_i1_buffer)
  from this and sg1 show ?thesis by simp
qed

lemma tiTable_SampleT_sending_data:
  assumes tbl: "tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st)
         (fin_inf_append [[]] buffer)
         ack i1 vc st"
      and loseFalse:"\<forall>j\<le>2 * d. lose (t + j) = [False]"
      and a1e:"\<forall>t4\<le>t + d + d. a1 t4 = []"
      and snd:"fin_inf_append [init_state] st (Suc (t + x)) = sending_data"
      and h6:"Suc (t + x) \<le> 2 * d + t"
  shows "ack (Suc (t + x)) = [sending_data]"
proof -
  from h6 have "Suc x \<le> 2 * d" by arith
  from this and loseFalse have sg1:"lose (t + Suc x) = [False]" by auto
  from h6 have "Suc (t + x) \<le>t + d + d" by arith
  from this and a1e have sg2:"a1 (Suc (t + x)) = []" by auto
  from tbl and sg1 and sg2 and snd show ?thesis
    by (simp add: tiTable_SampleT_def)
qed

lemma Sample_sending_data:
  assumes stopMsg1:"msg (Suc 0) stop"
      and tsLose:"ts lose"
      and reqMsg1:"msg (Suc 0) req"
      and a1Msg1:"msg (Suc 0) a1"
      and loseFalse:"\<forall>j\<le>2 * d. lose (t + j) = [False]"
      and ackSnd:"ack t = [sending_data]"
      and smpl:"Sample req dt a1 stop lose ack i1 vc"
      and xdd:"x \<le> d + d"
      and h9:"\<forall>t4 \<le> t + d + d. a1 t4 = []"
 shows "ack (t + x) = [sending_data]"
using assms
proof -
  from stopMsg1 and reqMsg1 and a1Msg1 and smpl obtain st buffer where a1:
   "Sample_L req dt a1 stop lose (fin_inf_append [init_state] st)
             (fin_inf_append [[]] buffer) ack
             i1 vc st buffer"
    by (simp add: Sample_def, auto)
  from a1 have sg1:
    "tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st)
        (fin_inf_append [[]] buffer)
         ack i1 vc st"
     by (simp add: Sample_L_def)
  from a1 have sg2:
    "\<forall>t. buffer t = (if dt t = [] then fin_inf_append [[]] buffer t else dt t)"
     by (simp add: Sample_L_def)
  from stopMsg1 and tsLose and a1Msg1 and ackSnd and xdd and sg1 and sg2 show ?thesis
  proof (induct "x")
    case 0
    from this show ?case by simp
  next
    fix x
    case (Suc x)
    from this have sg3:"st (t + x) = hd (ack (t + x))"
      by (simp add: tiTable_ack_st_hd)
    from Suc have sg4:"x \<le> d + d" by arith
    from Suc and sg3 and sg4 have sg5:
     "(fin_inf_append [init_state] st) (Suc (t + x)) = sending_data"
      by (simp add: fin_inf_append_def)
    from Suc have sg6:"Suc (t + x) \<le> 2 * d + t" by simp
    from Suc have sg7:"ack (t + x) = [sending_data]" by simp
    from sg1 and loseFalse and h9 and sg7 and sg5 and sg6 have sg7:
     "ack (Suc (t + x)) = [sending_data]"
      by (simp add: tiTable_SampleT_sending_data)
    from this show ?case by simp
  qed
qed

subsection \<open>Properties of the ServiceCenter component\<close>

lemma ServiceCenter_a_l:
  assumes "ServiceCenter i a"
  shows    "length (a t) \<le> (Suc 0)"
proof (cases "t")
  case 0
  from this and assms show ?thesis by (simp add: ServiceCenter_def)
next
  fix m assume "t = Suc m"
  from this and assms show ?thesis by (simp add: ServiceCenter_def)
qed

lemma ServiceCenter_a_msg:
  assumes "ServiceCenter i a"
  shows    "msg (Suc 0) a"
using assms
by (simp add: msg_def ServiceCenter_a_l)

lemma ServiceCenter_L1:
assumes "\<forall> t2 < x. i t2 = []"
       and "ServiceCenter i a"
       and "t \<le> x"
shows "a t = []"
using assms
proof (induct t)
   case 0
   from this show ?case by (simp add: ServiceCenter_def)
next
   case (Suc t)
   from this show ?case by (simp add: ServiceCenter_def)
qed

lemma ServiceCenter_L2:
assumes "\<forall> t2 < x. i t2 = []"
       and "ServiceCenter i a"
shows "\<forall> t3 \<le> x. a t3 = []"
using assms
by (clarify, simp add: ServiceCenter_L1)

subsection \<open>General properties of stream values\<close>

lemma streamValue1:
assumes h1:"\<forall>j\<le> D + (z::nat). str (t + j) = x"
       and h2: "j\<le> D"
shows      "str (t + j + z) = x"
proof -
    from h2 have sg1:" j + z \<le> D + z" by arith
    have sg2:"t + j + z = t + (j + z)" by arith
    from h1 and sg1 and sg2 show ?thesis by (simp (no_asm_simp))
qed

lemma streamValue2:
  assumes "\<forall>j\<le> D + (z::nat). str (t + j) = x"
  shows    "\<forall>j\<le> D. str (t + j + z) = x"
using assms by (clarify, simp add: streamValue1)

lemma streamValue3:
assumes "\<forall>j\<le> D. str (t + j + (Suc y)) = x"
        and "j \<le> D"
        and h3:"str (t + y) = x"
    shows    "str (t + j + y) = x"
using assms
proof (induct j)
  case 0
  from h3 show ?case by simp
next
  case (Suc j)
  from this show ?case by auto
qed

lemma streamValue4:
assumes "\<forall>j\<le> D. str (t + j + (Suc y)) = x"
       and "str (t + y) = x"
shows     "\<forall>j\<le> D. str (t + j + y) = x"
using assms
by (clarify, hypsubst_thin, simp add: streamValue3)

lemma streamValue5:
assumes "\<forall>j\<le> D. str (t + j + ((i::nat) + k)) = x"
       and "j\<le> D"
shows      "str (t + i + k + j) = x"
using assms
by (metis add.commute add.left_commute)

lemma streamValue6:
  assumes "\<forall>j\<le> D. str (t + j + ((i::nat) + k)) = x"
  shows     "\<forall>j\<le> D. str (t + (i::nat) + k + j) = x"
using assms by (clarify, simp add: streamValue5)

lemma streamValue7:
  assumes h1:"\<forall>j\<le>d. str (t + i + k + d + Suc j) = x"
      and h2:"str (t + i + k + d) = x"
      and h3:"j\<le> Suc d"
  shows      "str (t + i + k + d + j) = x"
proof -
  from h1 have sg1:"str (t + i + k + d + Suc d) = x"
     by (simp (no_asm_simp), simp)
  from assms show ?thesis
  proof (cases "j = Suc d")
    assume a1:"j = Suc d"
    from a1 and sg1 show ?thesis by simp
  next
    assume a2:"j \<noteq> Suc d"
    from a2 and h3 have sg2:"j\<le>d" by auto
    from assms and sg2 show ?thesis
    proof (cases "j > 0")
      assume a3:"0 < j"
      from a3 and h3 have sg3:"j - (1::nat) \<le> d" by simp
      from a3 have sg4:"Suc (j - (1::nat)) = j"  by arith
      from sg3 and h1 and sg4 have sg5:"str (t + i + k + d + j) = x" by auto
      from sg5 show ?thesis by simp
    next
      assume a4:"\<not> 0 < j"
      from a4 have sg6:"j = 0" by simp
      from h2 and sg6 show ?thesis by simp
    qed
  qed
qed

lemma streamValue8:
assumes "\<forall>j\<le>d. str (t + i + k + d + Suc j) = x"
       and "str (t + i + k + d) = x"
shows "\<forall> j\<le> Suc d. str (t + i + k + d + j) = x"
using assms streamValue7
  by metis

lemma arith_streamValue9aux:
"Suc (t + (j + d) + (i + k)) =  Suc (t + i + k + d + j)"
by arith

lemma streamValue9:
assumes h1:"\<forall>j\<le>2 * d. str (t + j + Suc (i + k)) = x"
       and h2:"j\<le>d"
shows      "str (t + i + k + d + Suc j) = x"
proof -
  from h2 have "(j+d) \<le>2 * d" by arith
  from h1 and this have "str (t + (j + d) + Suc (i + k)) = x" by auto
  from this show ?thesis  by (simp add: arith_streamValue9aux)
qed

lemma streamValue10:
  assumes "\<forall>j\<le>2 * d. str (t + j + Suc (i + k)) = x"
  shows    "\<forall>j\<le>d. str (t + i + k + d + Suc j) = x"
using assms
  apply clarify
  by (rule streamValue9, auto)

lemma arith_sum1:"(t::nat) + (i + k + d) =  t + i + k + d"
by arith

lemma arith_sum2:"Suc (Suc (t + k + j)) = Suc (Suc (t + (k + j)))"
by arith

lemma arith_sum4:"t + 3 + k + d = Suc (t + (2::nat) + k + d)"
by arith

lemma streamValue12:
 assumes  "\<forall>j\<le>2 * d + (4 + k). lose (t + j) = x"
 shows     "\<forall>j\<le>Suc d. lose (t + 2 + k + j) = x"
using assms
  apply clarify
  by (rule streamValue11, auto)

lemma streamValue43:
  assumes "\<forall>j\<le>2 * d + ((4::nat) + k). lose (t + j) = [False]"
  shows    "\<forall>j\<le>2 * d. lose ((t + (3::nat) + k) + j) = [False]"
proof -
  from assms have sg1:"\<forall>j\<le>2 * d. lose (t + j + (4 + k)) = [False]"
    by (simp add: streamValue2)
  have sg2:"Suc (3 + k) = (4 + k)" by arith
  from sg1 and sg2 have sg3:"\<forall>j\<le>2 * d. lose (t + j + Suc (3 + k)) = [False]"
    by (simp (no_asm_simp))
  from assms have sg4:"lose (t + (3 + k)) = [False]" by auto
  from sg3 and sg4 have sg5:"\<forall>j\<le>2 * d. lose (t + j + (3 + k)) = [False]"
    by (rule streamValue4)
  from sg5 show ?thesis by (rule streamValue6)
qed

end


subsubsection\<open>Completeness\<close>
theory Resolution_Compl
imports Resolution CNF_Sema
begin

text\<open>Completeness proof following Schöning~\<^cite>\<open>"schoening1987logik"\<close>.\<close>

definition "make_lit v a \<equiv> case v of True \<Rightarrow> Pos a | False \<Rightarrow> Neg a"

definition "restrict_cnf_atom a v C \<equiv> {c - {make_lit (\<not>v) a} | c. c \<in> C \<and> make_lit v a \<notin> c}"

lemma restrict_cnf_remove: "atoms_of_cnf (restrict_cnf_atom a v c) \<subseteq>
  atoms_of_cnf c - {a}"
  unfolding  restrict_cnf_atom_def atoms_of_cnf_alt lit_atoms_cases make_lit_def
  by (force split: literal.splits bool.splits)

lemma cnf_substitution_lemma:
  "cnf_semantics A (restrict_cnf_atom a v S) = cnf_semantics (A(a := v)) S"
  unfolding restrict_cnf_atom_def cnf_semantics_def clause_semantics_def lit_semantics_cases make_lit_def
  apply (clarsimp split: bool.splits literal.splits)
  apply safe
     subgoal for s by(fastforce elim!: allE[of _ "s - {Neg a}"])
    subgoal by (metis DiffI singletonD)
   subgoal for s by(fastforce elim!: allE[of _ "s - {Pos a}"])
  subgoal by (metis DiffI singletonD)
done

lemma finite_restrict: "finite S \<Longrightarrow> finite (restrict_cnf_atom a v S)"
  unfolding restrict_cnf_atom_def by(simp add: image_iff)

text\<open>The next lemma describes what we have to (or can) do to a CNF after it has been mangled by @{const restrict_cnf_atom} to get back to
(a subset of) the original CNF.
The idea behind this will be clearer upon usage.\<close>
lemma unrestrict_effects:
  "(\<lambda>c. if {make_lit (\<not>v) a} \<union> c \<in> S then {make_lit (\<not>v) a} \<union> c else c) ` restrict_cnf_atom a v S \<subseteq> S"
proof -
  have "\<lbrakk>xa \<in> restrict_cnf_atom a v S; {make_lit (\<not> v) a} \<union> xa \<notin> S; x = xa\<rbrakk> \<Longrightarrow> xa \<in> S" for x xa
    unfolding restrict_cnf_atom_def using insert_Diff by fastforce
  hence "x \<in> (\<lambda>c. if {make_lit (\<not> v) a} \<union> c \<in> S then {make_lit (\<not> v) a} \<union> c else c) ` restrict_cnf_atom a v S \<Longrightarrow> x \<in> S" for x
    unfolding image_iff by(elim bexE) simp
  thus ?thesis ..
qed

lemma can_cope_with_unrestrict_effects:
  assumes pr: "S \<turnstile> \<box>"
  assumes su: "S \<subseteq> T"
  shows "\<exists>R \<subseteq> {make_lit v a}. (\<lambda>c. if c \<in> n then {make_lit v a} \<union> c else c) ` T \<turnstile> R"
proof -
  from Resolution_taint_assumptions[where D="{make_lit v a}"]
  have taint: "\<Gamma> \<union> \<Lambda> \<turnstile> \<box> \<Longrightarrow> \<exists>R\<subseteq>{make_lit v a}. insert (make_lit v a) ` \<Gamma> \<union> \<Lambda> \<turnstile> R"
    for \<Gamma> \<Lambda> by (metis image_cong insert_def sup_bot.right_neutral)
  have S: "S = {c \<in> S. c \<in> n} \<union> {c \<in> S. c \<notin> n}" by blast
  hence SI: "(\<lambda>c. if c \<in> n then {make_lit v a} \<union> c else c) ` S =
    (insert (make_lit v a) ` {c \<in> S. c \<in> n}) \<union> {c \<in> S. c \<notin> n}
  " by auto
  from pr have "\<exists>R \<subseteq> {make_lit v a}.
  (\<lambda>c. if c \<in> n then {make_lit v a} \<union> c else c) ` S \<turnstile> R"
    apply(subst SI)
    apply(subst(asm) S)
    apply(elim taint)
  done
  thus ?thesis using Resolution_weaken su by (metis (no_types, lifting) image_Un sup.order_iff)
qed

lemma unrestrict':
  fixes R :: "'a clause"
  assumes rp: "restrict_cnf_atom a v S \<turnstile> \<box>"
  shows "\<exists>R \<subseteq> {make_lit (\<not>v) a}. S \<turnstile> R"
proof -
  fix C :: "'a clause" fix k :: 'a
  from unrestrict_effects[of v a S]
  text\<open>The idea is that the restricted set lost some clauses, and that some others were crippled.
    So, there must be a set of clauses to heal and a set of clauses to reinsert to get the original.
    (Mind you, this is not exactly what is happening, because e.g. both
   @{term C} and @{term "{k\<inverse>} \<union> C"} might be in there and get reduced to one @{term C}.
    You then heal that @{term C} to @{term "{k\<inverse>} \<union> C"} and insert the shadowed @{term C}\<open>\<dots>\<close> Details.)
 \<close>
  obtain n where S:
    "(\<lambda>c. if c \<in> n then {make_lit (\<not> v) a} \<union> c else c) ` restrict_cnf_atom a v S \<subseteq> S"
    using exI[where x="{c. {make_lit (\<not>v) a} \<union> c \<in> S}"] by force
  note  finite_restrict S
  show ?thesis using can_cope_with_unrestrict_effects[OF rp]
    by (metis (no_types) S Resolution_weaken subset_refl sup.order_iff)
qed

text\<open>What you might actually want is  @{term "\<forall>\<A>. \<not>cnf_semantics \<A> S \<Longrightarrow> S \<turnstile> \<box>"}.
  Unfortunately, applying compactness (to get a finite set with a finite number of atoms) here is problematic:
  You would need to convert all clauses to disjunction-formulas, but there might be clauses with an infinite number of atoms.
  Removing those has to be done before applying compactness, we would possibly have to remove an infinite number of infinite clauses.
  Since the notion of a formula with an infinite number of atoms is not exactly standard, it is probably better to just skip this.
 \<close>

end


theory additional imports recursion
begin

(*
  have \<open>f ` a = v\<close>
    sorry
  proof(rule mkel, rule apparg)
    show \<open>(\<Union>S)`a = v\<close> by (rule N)
    show \<open>a\<in>A\<close> by (rule T)
    oops
*)
 (*todo!*)
(*  show \<open>f ` a = v\<close> *)

(* Natural numbers are linearly ordered by \<in> *)

definition add_g2 :: \<open>i\<close>
  where add_g2_def : \<open>add_g2 == {p \<in> (nat \<times> nat) \<times> nat. snd(p) = succ(fst(fst(p)))}\<close>

theorem addg2subpow : \<open>add_g2 \<in> Pow((nat \<times> nat) \<times> nat)\<close>
proof
  show \<open>add_g2 \<subseteq> (nat \<times> nat) \<times> nat\<close>
  proof
    fix x
    assume \<open>x \<in> add_g2\<close>
    hence G:\<open>x \<in> {p \<in> (nat \<times> nat) \<times> nat . snd(p) = succ(fst(fst(p)))}\<close>
      by (unfold add_g2_def)
    show \<open>x \<in> (nat \<times> nat) \<times> nat\<close>
      by(rule CollectD1[OF G])
  qed
qed

lemma addg2dom : \<open>nat \<times> nat \<subseteq> domain(add_g2)\<close>
proof
  fix x
  assume xnn:\<open>x\<in>nat \<times> nat\<close>
  hence fxn:\<open>fst(x)\<in>nat\<close> by auto
  show \<open>x\<in>domain(add_g2)\<close>
  proof
(*snd(p) = succ(fst(fst(p)))*)
    show \<open>\<langle>x, succ(fst(x))\<rangle> \<in> add_g2\<close>
    proof(unfold add_g2_def, rule CollectI)
      show \<open>\<langle>x, succ(fst(x))\<rangle> \<in> (nat \<times> nat) \<times> nat\<close>
      proof
        show \<open>x\<in>nat \<times> nat\<close> by (rule xnn)
      next
        from fxn
        show \<open>succ(fst(x)) \<in> nat\<close> by auto
      qed
    next
      show \<open>snd(\<langle>x, succ(fst(x))\<rangle>) =
    succ(fst(fst(\<langle>x, succ(fst(x))\<rangle>)))\<close>
      proof(rule trans, rule pair.snd_conv)
        have \<open>x = fst(\<langle>x, succ(fst(x))\<rangle>)\<close>
          by (rule sym, rule pair.fst_conv)
        hence \<open> fst(x) = fst(fst(\<langle>x, succ(fst(x))\<rangle>))\<close>
          by(rule subst_context)
        thus \<open> succ(fst(x)) =
    succ(fst(fst(\<langle>x, succ(fst(x))\<rangle>)))\<close>
          by(rule subst_context)
        qed
    qed
  qed
qed

lemma addg2fun: \<open>function(add_g2)\<close>
proof(unfold function_def, unfold add_g2_def, rule allI, rule allI, rule impI, rule allI, rule impI)
  fix x y1 y2
  assume H1:\<open>\<langle>x, y1\<rangle> \<in> add_g2\<close>
  assume H2:\<open>\<langle>x, y1\<rangle> \<in> add_g2\<close>
  oops

(*
then prove transfinite induction & recursion
then define Von Neumann hierarchy
then prove V=\<Union>(\<alpha>\<in>Ord).V\<alpha>
trying to rewrite everything without replacement
*)

subsection \<open>Only\<close>

text \<open>Quantifier "!x. P(x)" means "at most one object has property P"\<close>

definition Only1 :: \<open>('a \<Rightarrow> o) \<Rightarrow> o\<close>  (binder \<open>!\<close> 10)
  where only1_def: \<open>!x. P(x) \<equiv> (\<forall>x.\<forall>y. P(x) \<and> P(y) \<longrightarrow> x = y)\<close>

lemma only1I [intro]:
  assumes H: \<open>(\<And>x y. (\<lbrakk>P(x); P(y)\<rbrakk> \<Longrightarrow> x = y))\<close>
  shows \<open>!x. P(x)\<close>
  by (unfold only1_def, rule allI, rule allI, rule impI, rule H,
        erule conjunct1, erule conjunct2)

lemma only1D: \<open>!x. P(x) \<Longrightarrow> (\<And>x y. \<lbrakk>P(x); P(y)\<rbrakk> \<Longrightarrow> x = y)\<close>
  apply(unfold only1_def)
  apply(rule mp, rule spec, erule spec)
  apply(erule conjI, assumption)
  done

lemma only1E [elim]:
  assumes major: \<open>!x. P(x)\<close>
      and r: \<open>(\<And>x y. \<lbrakk>P(x); P(y)\<rbrakk> \<Longrightarrow> x = y) \<Longrightarrow> R\<close>
    shows \<open>R\<close>
  by (rule r, rule only1D[OF major], assumption+)

lemma ex1newD1: \<open>\<exists>!x. P(x) \<Longrightarrow> \<exists>x. P(x)\<close>
  by auto

lemma ex1newD2: \<open>\<exists>!x. P(x) \<Longrightarrow> !x. P(x)\<close>
proof -
  assume Y:\<open>\<exists>!x. P(x)\<close>
  show \<open>(!x. P(x))\<close>
  proof(rule ex1E[OF Y])
    fix x
    assume Px:\<open>P(x)\<close>
    assume J:\<open>\<forall>y. P(y) \<longrightarrow> y = x\<close>
    show \<open>(!x. P(x))\<close>
    proof
      fix x1 x2
      assume Px1:\<open>P(x1)\<close>
      assume Px2:\<open>P(x2)\<close>
      show \<open>x1 = x2\<close>
      proof(rule trans, rule mp, rule spec[OF J], rule Px1)
        show \<open>x = x2\<close>
          by (rule sym, rule mp, rule spec[OF J], rule Px2)
      qed
    qed
  qed
qed

subsection \<open>Uniqueness\<close>

text \<open>Another uniqueness definition\<close>

lemma ex1new_def: \<open>\<exists>!x. P(x) \<equiv> (\<exists>x. P(x)) \<and> (!x. P(x))\<close>
proof (rule iff_reflection, rule iffI)
  assume Y:\<open>\<exists>!x. P(x)\<close>
  show \<open>(\<exists>x. P(x)) \<and> (!x. P(x))\<close>
  proof
    from Y show \<open>(\<exists>x. P(x))\<close> by auto
  next
    from Y show \<open>(!x. P(x))\<close> by (rule ex1newD2)
  qed
next
  assume Y:\<open>(\<exists>x. P(x)) \<and> (!x. P(x))\<close>
  hence Y2:\<open>(!x. P(x))\<close> by auto
  show \<open>\<exists>!x. P(x)\<close>
  proof
    from Y show \<open>(\<exists>x. P(x))\<close> by auto
  next
    show \<open>\<And>x y. P(x) \<Longrightarrow> P(y) \<Longrightarrow> x = y\<close>
      by (rule only1D[OF Y2], assumption+)
  qed
qed

lemma ex1newI: \<open>\<lbrakk>\<exists>x. P(x); !x. P(x)\<rbrakk> \<Longrightarrow> \<exists>!x. P(x)\<close>
  by (unfold ex1new_def, rule conjI, assumption+)

lemma ex1newE: \<open>\<exists>!x. P(x) \<Longrightarrow> (\<lbrakk>\<exists>x. P(x); !x. P(x)\<rbrakk> \<Longrightarrow> R) \<Longrightarrow> R\<close>
  apply (unfold ex1new_def)
  apply (assumption | erule exE conjE)+
  done
(*
lemma ex1newD1: \<open>\<exists>!x. P(x) \<Longrightarrow> \<exists>x. P(x)\<close>
  by (erule ex1newE)

lemma ex1newD2: \<open>\<exists>!x. P(x) \<Longrightarrow> !x. P(x)\<close>
  by (erule ex1newE)
*)

subsection\<open>Bounded existential quantifier\<close>

definition Bonly :: "[i, i \<Rightarrow> o] \<Rightarrow> o"
  where "Bonly(A, P) \<equiv> !x. x\<in>A \<and> P(x)"

syntax
  "_Bonly" :: "[pttrn, i, o] \<Rightarrow> o"  (\<open>(3!_\<in>_./ _)\<close> 10)
translations
  "!x\<in>A. P" \<rightleftharpoons> "CONST Bonly(A, \<lambda>x. P)"

lemma bonlyI [intro]: "[| !x. (x\<in>A \<and> P(x)) |] ==> !x\<in>A. P(x)"
  by (unfold Bonly_def, assumption)

lemma bonlyE [elim!]: "[| !x\<in>A. P(x);  [| !x. (x\<in>A \<and> P(x)) |] ==> Q |] ==> Q"
  by (unfold Bonly_def, blast)

definition Bex1 :: "[i, i \<Rightarrow> o] \<Rightarrow> o"
  where "Bex1(A, P) \<equiv> (\<exists>x\<in>A. P(x)) \<and> (!x\<in>A. P(x))"

syntax
  "_Bex1" :: "[pttrn, i, o] \<Rightarrow> o"  (\<open>(3\<exists>!_\<in>_./ _)\<close> 10)
translations
  "\<exists>!x\<in>A. P" \<rightleftharpoons> "CONST Bex1(A, \<lambda>x. P)"

lemma bex1I [intro]: "[| \<exists>x\<in>A. P(x) ; !x\<in>A. P(x) |] ==> \<exists>!x\<in>A. P(x)"
  by (unfold Bex1_def, auto)

lemma bex1E [elim!]: "[| \<exists>!x\<in>A. P(x);  [| \<exists>x\<in>A. P(x) ; !x\<in>A. P(x) |] ==> Q |] ==> Q"
  by (unfold Bex1_def, blast)

lemma mychoice:
  assumes D:\<open>\<forall>x\<in>A.\<exists>y. y\<in>B(x)\<close>
  shows \<open>\<exists>f. f\<in>Pi(A,B)\<close>
  oops

lemma basedomsig : \<open>domain(Sigma(A, B)) \<subseteq> A\<close>
proof
  fix x
  assume J:\<open>x \<in> domain(Sigma(A, B))\<close>
  show \<open>x\<in>A\<close>
  proof(rule domainE[OF J])
    fix y
    assume K:\<open>\<langle>x, y\<rangle> \<in> Sigma(A, B)\<close>
    show \<open>x\<in>A\<close>
      by (rule SigmaD1[OF K])
  qed
qed

lemma domsig:
  assumes H:\<open>\<forall>x\<in>A.\<exists>y. y\<in>B(x)\<close>
  shows \<open>A\<subseteq>domain(Sigma(A, B))\<close>
proof
  fix x
  assume L:\<open>x\<in>A\<close>
  have U:\<open>\<exists>y. y\<in>B(x)\<close>
    by (rule bspec[OF H L])
  show \<open>x \<in> domain(Sigma(A, B))\<close>
  proof(rule exE[OF U])
    fix y
    assume V:\<open>y\<in>B(x)\<close>
    show \<open>x \<in> domain(Sigma(A, B))\<close>
    proof
      show \<open>\<langle>x, y\<rangle> \<in> Sigma(A, B)\<close>
      proof
        show \<open>x\<in>A\<close> by (rule L)
      next
        show \<open>y\<in>B(x)\<close> by (rule V)
      qed
    qed
  qed
qed

lemma fuch:
  assumes H:\<open>\<forall>x\<in>A.\<exists>!y. P(x,y)\<close>
  shows \<open>\<forall>x\<in>A.\<exists>y. P(x,y)\<close>
proof
  fix x
  assume \<open>x\<in>A\<close>
  hence \<open>\<exists>!y. P(x,y)\<close>
    by (rule bspec[OF H])
  thus \<open>\<exists>y. P(x, y)\<close>
    by auto
qed

lemma bfuch:
  assumes H:\<open>\<forall>x\<in>A.\<exists>!y\<in>B(x). P(x,y)\<close>
  shows \<open>\<forall>x\<in>A.\<exists>y\<in>B(x). P(x,y)\<close>
proof
  fix x
  assume \<open>x\<in>A\<close>
  hence \<open>\<exists>!y\<in>B(x). P(x,y)\<close>
    by (rule bspec[OF H])
  thus \<open>\<exists>y\<in>B(x). P(x, y)\<close>
    by auto
qed

lemma mkfun:
  assumes H:\<open>\<forall>x\<in>A.\<exists>!y. y\<in>B(x)\<close>
  shows \<open>\<exists>f. f\<in>Pi(A,B)\<close>
proof
  show \<open>Sigma(A,B)\<in>Pi(A,B)\<close>
  proof(unfold Pi_def)
    show \<open>Sigma(A, B) \<in> {f \<in> Pow(Sigma(A, B)) . A \<subseteq> domain(f) \<and> function(f)}\<close>
    proof
      show \<open>Sigma(A, B) \<in> Pow(Sigma(A, B))\<close>
        by (rule PowI, auto)
    next
      show \<open>A \<subseteq> domain(Sigma(A, B)) \<and> function(Sigma(A, B))\<close>
      proof
        show \<open>A \<subseteq> domain(Sigma(A, B))\<close>
          by (rule domsig, rule fuch, rule H)
      next
        show \<open>function(Sigma(A, B))\<close>
        proof(rule functionI)
          fix x y1 y2
          assume J1:\<open>\<langle>x, y1\<rangle> \<in> Sigma(A, B)\<close>
          assume J2:\<open>\<langle>x, y2\<rangle> \<in> Sigma(A, B)\<close>
          show \<open>y1=y2\<close>
          proof(rule SigmaE[OF J1], rule SigmaE[OF J2])
            fix xa1 xa2 ya1 ya2
            assume M1:\<open>xa1 \<in> A\<close>
            assume M2:\<open>ya1 \<in> B(xa1)\<close>
            assume M3:\<open>\<langle>x, y1\<rangle> = \<langle>xa1, ya1\<rangle>\<close>
            assume M4:\<open>xa2 \<in> A\<close>
            assume M5:\<open>ya2 \<in> B(xa2)\<close>
            assume M6:\<open>\<langle>x, y2\<rangle> = \<langle>xa2, ya2\<rangle>\<close>

            from M3 have M31:\<open>x=xa1\<close> by (rule pair.Pair_inject1)
            from M6 have M61:\<open>x=xa2\<close> by (rule pair.Pair_inject1)
            from M1 and M31 have M1:\<open>x \<in> A\<close> by auto
            from M2 and M31 have M2:\<open>ya1 \<in> B(x)\<close> by auto
            from M5 and M61 have M5:\<open>ya2 \<in> B(x)\<close> by auto
            from M3 have M32:\<open>y1=ya1\<close> by (rule pair.Pair_inject2)
            from M6 have M62:\<open>y2=ya2\<close> by (rule pair.Pair_inject2)
            have \<open>\<exists>!y. y\<in>B(x)\<close> by(rule bspec[OF H M1])
            hence Q:\<open>!y. y\<in>B(x)\<close> by auto
            show \<open>y1=y2\<close>
            proof(rule only1D[OF Q])
              from M32 and M2 show \<open>y1 \<in> B(x)\<close>
                by auto
              from M62 and M5 show \<open>y2 \<in> B(x)\<close>
                by auto
            qed
          qed
        qed
      qed
    qed
  qed
qed

lemma splt:
  assumes H:\<open>f\<in>Pi(A,\<lambda>x. {y\<in>B(x). P(x,y)})\<close>
  shows \<open>f\<in>Pi(A,B)\<and>(\<forall>x\<in>A. P(x,f`x))\<close>
proof -
  from H
  have K:\<open>f\<in>{f\<in>Pow(Sigma(A,\<lambda>x. {y\<in>B(x). P(x,y)})). A\<subseteq>domain(f) & function(f)}\<close>
    by (unfold Pi_def)
  show ?thesis
  proof
    show \<open>f \<in> Pi(A, B)\<close>
      by (rule CollectE[OF K], unfold Pi_def, rule CollectI, auto)
  next
    show \<open>\<forall>x\<in>A. P(x, f ` x)\<close>
    proof
      fix x
      assume L:\<open>x\<in>A\<close>
      have R:\<open>(f`x)\<in>{y\<in>B(x). P(x,y)}\<close>
        by (rule func.apply_type[OF H L])
      show \<open>P(x, f ` x)\<close>
        by (rule CollectD2[OF R])
    qed
  qed
qed
(* f = {p\<in>Sigma(A,B). }*)

(*
proof(unfold Pi_def)
  show \<open> \<exists>f. f \<in> {f \<in> Pow(Sigma(A, B)) . A \<subseteq> domain(f) \<and> function(f)}\<close>
*)
lemma kjhg:
  assumes D:\<open>\<forall>x\<in>A.\<exists>!y\<in>B(x). P(x,y)\<close>
  shows \<open>\<exists>!f\<in>Pi(A,B).\<forall>x\<in>A. P(x, f`y)\<close>
proof
  have D1:\<open>\<forall>x\<in>A.\<exists>y\<in>B(x). P(x,y)\<close>
    by (rule bfuch[OF D])

  show \<open>\<exists>f\<in>Pi(A, B). \<forall>x\<in>A. P(x, f ` y)\<close>
  proof

    oops
(*rule splt*)

lemma kjhg:
  assumes D:\<open>\<forall>x\<in>A.\<exists>!y. y\<in>B \<and> <x,y>\<in>f\<close>
  shows \<open>f\<in>A\<rightarrow>B\<close>s
proof -(*rule PiI*)
  oops

theorem plus:
  shows
 \<open>\<exists>!g. ((g \<in> (nat\<rightarrow>(nat\<rightarrow>nat))) \<and> (\<forall>a\<in>nat.(((g`a)`0 = a) \<and> satpc(g`a,nat,add_g2))))\<close>
  oops

definition fite :: "[i, o, i, i] \<Rightarrow> i" (\<open>from _ if _ then _ else _\<close>)
  where "fite(A, \<phi>, a, b) == \<Union>{x\<in>A.(\<phi>\<and>x=a)\<or>((\<not>\<phi>)\<and>x=b)}"

definition ite :: "[o, i, i] \<Rightarrow> i" (\<open>myif _ then _ else _\<close>)
  where "ite(\<phi>, a, b) == \<Union>{x\<in>{a,b}.(\<phi>\<and>x=a)\<or>((\<not>\<phi>)\<and>x=b)}"

theorem ite1 : \<open>\<phi> \<Longrightarrow> ((myif \<phi> then a else b) = a)\<close>
proof (unfold ite_def)
  assume H:\<open>\<phi>\<close>
  have P:\<open>{x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b} = {a}\<close>
  proof
    show \<open> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b} \<subseteq> {a}\<close>
    proof
      fix x
      assume G:\<open>x \<in> {x \<in> {a, b} .  \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b}\<close>
      have U:\<open>\<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b\<close> by (rule CollectE[OF G])
      have T:\<open>x = a\<close>
      proof (rule disjE[OF U conjunct2])
        show \<open>\<phi> \<and> x = a \<Longrightarrow> \<phi> \<and> x = a\<close> by assumption
      next
        assume \<open>\<not>\<phi> \<and> x = b\<close>
        then have Y:\<open>\<not>\<phi>\<close> by (rule conjunct1)
        show \<open>x = a\<close> by (rule notE[OF Y H])
      qed
      have R:\<open>x\<in>{x}\<close> by (rule upair.singletonI)
      find_theorems "_\<in>{_}"
      show \<open>x\<in>{a}\<close>
      proof (rule subst)
        show \<open>x\<in>{x}\<close> by (rule upair.singletonI)
      next
        show \<open>{x} = {a}\<close> by (rule IFOL.subst_context[OF T])
      qed
    qed
  next
    show \<open>{a} \<subseteq> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b}\<close>
    proof (*(rule subsetI)... Which rule is used here? *)
      show\<open>a \<in> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b} \<and>
      0 \<subseteq> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b}\<close>
      proof
        show \<open>0 \<subseteq> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b}\<close>
          by (rule empty_subsetI)
      next
        show \<open>a \<in> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b}\<close>
        proof
          show \<open>a \<in> {a, b}\<close> by (rule upairI1)
        next
          show \<open>\<phi> \<and> a = a \<or> \<not> \<phi> \<and> a = b\<close>
          proof (rule disjI1)
            show \<open>\<phi> \<and> a = a\<close>
            proof
              show \<open>\<phi>\<close> by (rule H)
            next
              show \<open>a = a\<close> by (rule IFOL.refl)
            qed
          qed
        qed
      qed
    qed
  qed
  find_theorems "_\<Longrightarrow>a\<in>{a,b}"
  have P1:\<open>\<Union>{x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b} = \<Union>{a}\<close>
    by (rule IFOL.subst_context[OF P])
  (*find_theorems "Lam [_]. _"*)
  have P2:\<open>\<Union>{a} = a\<close> by (rule equalities.Union_singleton)
  (*find_theorems "\<Union>{_}"*)
  (*find_theorems "_=_\<Longrightarrow>_=_ \<Longrightarrow>_"*)
  show \<open>\<Union>{x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b} = a\<close>
    by (rule IFOL.trans[OF P1 P2])
qed

theorem ite2 : \<open>\<not>\<phi> \<Longrightarrow> ((myif \<phi> then a else b) = b)\<close>
proof (unfold ite_def)
  assume H:\<open>\<not>\<phi>\<close>
  have P:\<open>{x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b} = {b}\<close>
  proof
    show \<open> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b} \<subseteq> {b}\<close>
    proof
      fix x
      assume G:\<open>x \<in> {x \<in> {a, b} .  \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b}\<close>
      have U:\<open>(\<phi> \<and> x = a) \<or> (\<not> \<phi> \<and> x = b)\<close> by (rule CollectE[OF G])

      have T:\<open>x = b\<close>
      proof (rule disjE[OF U conjunct2])
        assume \<open>\<not>\<phi> \<and> x = b\<close>
        then show \<open>x = b\<close> by (rule conjunct2)
      next
        assume \<open>\<phi> \<and> x = a\<close>
        then have Y:\<open>\<phi>\<close> by (rule conjunct1)
        have T1:\<open>x = b\<close> by (rule notE[OF H Y])
        show \<open>\<not>\<phi> \<and> x = b\<close> by (rule conjI[OF H T1])
      qed
      have R:\<open>x\<in>{x}\<close> by (rule upair.singletonI)
      find_theorems "_\<in>{_}"
      show \<open>x\<in>{b}\<close>
      proof (rule subst)
        show \<open>x\<in>{x}\<close> by (rule upair.singletonI)
      next
        show \<open>{x} = {b}\<close> by (rule IFOL.subst_context[OF T])
      qed
    qed
  next
    show \<open>{b} \<subseteq> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b}\<close>
    proof (*(rule subsetI)... Which rule is used here? *)
      show\<open>b \<in> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b} \<and>
      0 \<subseteq> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b}\<close>
      proof
        show \<open>0 \<subseteq> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b}\<close>
          by (rule empty_subsetI)
      next
        show \<open>b \<in> {x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b}\<close>
        proof
          show \<open>b \<in> {a, b}\<close> by (rule upairI2)
        next
          show \<open>(\<phi> \<and> b = a) \<or> (\<not> \<phi> \<and> b = b)\<close>
          proof (rule disjI2)
            show \<open>(\<not>\<phi>) \<and> b = b\<close>
            proof
              show \<open>\<not>\<phi>\<close> by (rule H)
            next
              show \<open>b = b\<close> by (rule IFOL.refl)
            qed
          qed
        qed
      qed
    qed
  qed
  have P1:\<open>\<Union>{x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b} = \<Union>{b}\<close>
    by (rule IFOL.subst_context[OF P])
  have P2:\<open>\<Union>{b} = b\<close> by (rule equalities.Union_singleton)
  show \<open>\<Union>{x \<in> {a, b} . \<phi> \<and> x = a \<or> \<not> \<phi> \<and> x = b} = b\<close>
    by (rule IFOL.trans[OF P1 P2])
qed

(* === This works but not used === *)
theorem lemma1 :
(*
\<open>\<forall> x . ((\<exists> y . \<langle>x, y\<rangle> \<in> f)
 \<longrightarrow> (\<exists> u. u \<in> f \<and> (\<exists> c. c \<in> u \<and> x \<in> c)))\<close>
*)
\<open>\<forall>x.(\<exists>y.\<langle>x, y\<rangle> \<in> f)\<longrightarrow>(\<exists>u\<in>f.\<exists>c\<in>u. x\<in>c)\<close>
proof
  fix x
  show \<open>(\<exists>y. \<langle>x, y\<rangle> \<in> f) \<longrightarrow> (\<exists>u\<in>f. \<exists>c\<in>u. x \<in> c)\<close>
  proof
    assume H1:\<open>\<exists>y. \<langle>x, y\<rangle> \<in> f\<close>
    show \<open>\<exists>u\<in>f. \<exists>c\<in>u. x \<in> c\<close>
    proof (rule exE[OF H1])
      fix xa
      assume H2:\<open>\<langle>x, xa\<rangle> \<in> f\<close>
      show \<open>\<exists>u\<in>f. \<exists>c\<in>u. x \<in> c\<close>
      proof
        show \<open>\<langle>x, xa\<rangle> \<in> f\<close> by (rule H2)
      next
        show \<open>\<exists>c\<in>\<langle>x, xa\<rangle>. x \<in> c\<close>
        proof
          show \<open>{x} \<in> \<langle>x, xa\<rangle>\<close>
            by (rule sinup)
        next
          show \<open>x \<in> {x}\<close>
            by (rule upair.singletonI)
        qed
      qed
    qed
  qed
qed

  find_theorems "_\<in>domain(_)"
theorem lemma2 : \<open>domain(f)\<subseteq>\<Union>\<Union>f\<close>
proof
  fix x
  assume H1:\<open>x\<in>domain(f)\<close>
  have H2:\<open>(\<exists>y. \<langle>x, y\<rangle> \<in> f)\<close>
    by (rule iffD1[OF equalities.domain_iff H1])
  show \<open>x\<in>\<Union>\<Union>f\<close>
  proof (rule exE[OF H2])
    fix xa
    assume H3:\<open>\<langle>x, xa\<rangle> \<in> f\<close>
    show \<open>x \<in> \<Union>\<Union>f\<close>
    proof
      show \<open>x \<in> {x}\<close>
        by (rule upair.singletonI)
    next
      show \<open>{x} \<in> \<Union>f\<close>
      proof
        show \<open>\<langle>x, xa\<rangle> \<in> f\<close>
          by (rule H3)
      next
        show \<open>{x} \<in> \<langle>x, xa\<rangle>\<close>
          by (rule sinup)
      qed
    qed
  qed
qed

lemma hhc :
  assumes 1:\<open>A\<subseteq>C\<close>
  assumes 2:\<open>a\<in>C\<close>
  shows \<open>cons(a,A)\<subseteq>C\<close>
proof
  from 1 and 2 show \<open>a \<in> C \<and> A \<subseteq> C\<close> by auto
qed

(* todo
theorem nat_elem_is_ss:\<open>\<forall>m\<in>nat. n\<in>m \<longrightarrow> n\<subseteq>m\<close>
proof(rule nat_induct_bound)
  sorry (**)

theorem nat_ldfghj:\<open>\<forall>n\<in>nat. \<forall>m\<in>nat. n\<subseteq>m \<and> n\<noteq>m \<longrightarrow> n\<in>m\<close>
  sorry
*)

(*
do it through ordinals.
*)
(*
theorem nat_linord_ss:\<open>\<forall>n\<in>nat. \<forall>m\<in>nat. m\<subseteq>n\<or>n\<subseteq>m\<close>
  sorry
*)
end


theory ExponentialCategory imports Category

begin

definition (in categoryProduct) isExponential:: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" ("isExp")
  where "isExp a b c \<epsilon> \<equiv> \<^bold>\<exists>p1 p2. product a c (dom \<epsilon>) p1 p2 \<and> \<epsilon>:(a\<^bold>\<times>c)\<rightarrow>b \<and>
                        (\<^bold>\<forall>z f. \<^bold>\<exists>q1 q2. product z a (dom f) q1 q2 \<and> f:(z\<^bold>\<times>a)\<rightarrow>b \<and>
                          (\<^bold>\<exists>!\<ff>. \<ff>:z\<rightarrow>c \<and> (\<^bold>\<exists>!\<jj>. \<jj>:(dom f)\<rightarrow>(dom \<epsilon>) \<and>
                            p2 \<cdot> \<jj> \<simeq> \<ff> \<cdot> q1 \<and> p1 \<cdot> \<jj> \<simeq> q2 \<and> \<epsilon> \<cdot> \<jj> \<simeq> f)))"

class exponentialCategory = categoryProduct +
  fixes  exp::"'a \<Rightarrow> 'a \<Rightarrow> 'a" ("_\<^sup>_")

  assumes E1: "\<^bold>\<forall>a b. \<^bold>\<exists>\<epsilon>. isExp a b (exp a b) \<epsilon>" and
          E2: "E (a\<^sup>b) \<longrightarrow> (E a \<and> E b)"
begin

\<comment> \<open>Checking notation\<close>
lemma "\<^bold>\<forall>a b. \<^bold>\<exists>\<epsilon>. (isExp a b (a\<^sup>b) \<epsilon>)"
  using local.E1 by blast

lemma "True" nitpick[satisfy] oops

lemma "\<exists>x. final x" oops

abbreviation finalObj::'a where "finalObj \<equiv> SOME x. final x"

end

sublocale exponentialCategory \<subseteq> cartesianCategory domain codomain composition product_func finalObj sorry

proposition "E A \<and> type (A::'a::exponentialCategory) \<longrightarrow> isFunctor (\<lambda>x. (x\<^sup>A))" oops

end