theory Overtaking_rules
imports
  Main Overtaking_Aux Environment_Executable
  "./safe_distance/Safe_Distance_Isar"
begin

section "Trace"
\<comment> \<open>Represent the state of a (dynamic) road user as a record.\<close>

datatype vehicle = Pedestrian | Cyclist | Motorised

record raw_state = rectangle +   (* position is represented as the centre of the rectangle *)
  velocity     :: "real2"        (* velocity vector     *)
  acceleration :: "real2"        (* acceleration vector *)

\<comment> \<open>predicate to check whether a number is the supremum in a dimension.\<close>
definition is_sup :: "(real2 \<Rightarrow> real) \<Rightarrow> real \<Rightarrow> real2 set \<Rightarrow> bool" where
  "is_sup sel r occ \<equiv> (\<forall>p \<in> occ. sel p \<le> r)"

definition is_sup_x :: "real \<Rightarrow> real2 set \<Rightarrow> bool" where
  "is_sup_x \<equiv> is_sup fst"

definition is_sup_y :: "real \<Rightarrow> real2 set \<Rightarrow> bool" where
  "is_sup_y \<equiv> is_sup snd"

type_synonym runs = "vehicle \<times> raw_state list"
type_synonym black_boxes = "runs \<times> runs list"

subsection "Example of runs"

definition rectangle_ex :: "rectangle" where
  "rectangle_ex \<equiv> \<lparr>  Xcoord = 0.0,  Ycoord = 0.0,  Orient = 0.0, Length = 5.0,  Width = 1.5\<rparr>"

definition raw_state_ex :: "raw_state" where
  "raw_state_ex \<equiv> rectangle.extend rectangle_ex \<lparr>velocity = (10,10), acceleration = (5,5)\<rparr>"

lemma "rectangle.truncate raw_state_ex = rectangle_ex"
  unfolding raw_state_ex_def rectangle_ex_def rectangle.truncate_def rectangle.extend_def
  by auto

section "LTL with finite trace"

subsection "Syntax"

datatype (atoms_fin: 'a) ltlf =
    True_ltlf                             ("true\<^sub>f")
  | False_ltlf                            ("false\<^sub>f")
  | Prop_ltlf 'a                          ("prop\<^sub>f'(_')")
  | Not_ltlf "'a ltlf"                    ("not\<^sub>f _" [85] 85)
  | And_ltlf "'a ltlf" "'a ltlf"          ("_ and\<^sub>f _" [82,82] 81)
  | Or_ltlf "'a ltlf" "'a ltlf"           ("_ or\<^sub>f _" [81,81] 80)
  | Implies_ltlf "'a ltlf" "'a ltlf"      ("_ implies\<^sub>f _" [81,81] 80)
  | Next_ltlf "'a ltlf"                   ("X\<^sub>f _" [88] 87)
  | Final_ltlf "'a ltlf"                  ("F\<^sub>f _" [88] 87)
  | Global_ltlf "'a ltlf"                 ("G\<^sub>f _" [88] 87)
  | Until_ltlf "'a ltlf" "'a ltlf"        ("_ U\<^sub>f _" [84,84] 83)

definition Iff_ltlf ("_ iff\<^sub>f _" [81,81] 80)
where
  "\<phi> iff\<^sub>f \<psi> \<equiv> (\<phi> implies\<^sub>f \<psi>) and\<^sub>f (\<psi> implies\<^sub>f \<phi>)"

subsection "Semantics"

definition suffix_list :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list"
  where "suffix_list k xs \<equiv> drop k xs"

primrec semantics_ltlf :: "['a set list, 'a ltlf] \<Rightarrow> bool" ("_ \<Turnstile>\<^sub>f _" [80,80] 80)
where
  "\<xi> \<Turnstile>\<^sub>f true\<^sub>f = True"
| "\<xi> \<Turnstile>\<^sub>f false\<^sub>f = False"
| "\<xi> \<Turnstile>\<^sub>f prop\<^sub>f(q) = (q \<in> (\<xi> ! 0))"
| "\<xi> \<Turnstile>\<^sub>f not\<^sub>f \<phi> = (\<not> \<xi> \<Turnstile>\<^sub>f \<phi>)"
| "\<xi> \<Turnstile>\<^sub>f \<phi> and\<^sub>f \<psi> = (\<xi> \<Turnstile>\<^sub>f \<phi> \<and> \<xi> \<Turnstile>\<^sub>f \<psi>)"
| "\<xi> \<Turnstile>\<^sub>f \<phi> or\<^sub>f \<psi> = (\<xi> \<Turnstile>\<^sub>f \<phi> \<or> \<xi> \<Turnstile>\<^sub>f \<psi>)"
| "\<xi> \<Turnstile>\<^sub>f \<phi> implies\<^sub>f \<psi> = (\<xi> \<Turnstile>\<^sub>f \<phi> \<longrightarrow> \<xi> \<Turnstile>\<^sub>f \<psi>)"
| "\<xi> \<Turnstile>\<^sub>f X\<^sub>f \<phi> = (suffix_list 1 \<xi> \<Turnstile>\<^sub>f \<phi>)"
| "\<xi> \<Turnstile>\<^sub>f F\<^sub>f \<phi> = (\<exists>i. i < length \<xi> \<and> suffix_list i \<xi> \<Turnstile>\<^sub>f \<phi>)"
| "\<xi> \<Turnstile>\<^sub>f G\<^sub>f \<phi> = (\<forall>i. i < length \<xi> \<longrightarrow> suffix_list i \<xi> \<Turnstile>\<^sub>f \<phi>)"
| "\<xi> \<Turnstile>\<^sub>f \<phi> U\<^sub>f \<psi> = (\<exists>i. i < length \<xi> \<and> suffix_list i \<xi> \<Turnstile>\<^sub>f \<psi> \<and> (\<forall>j<i. suffix_list j \<xi> \<Turnstile>\<^sub>f \<phi>))"

lemma semantics_ltlc_sugar [simp]:
  "\<xi> \<Turnstile>\<^sub>f \<phi> iff\<^sub>f \<psi> = (\<xi> \<Turnstile>\<^sub>f \<phi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>f \<psi>)"
  "\<xi> \<Turnstile>\<^sub>f F\<^sub>f \<phi> = \<xi> \<Turnstile>\<^sub>f (true\<^sub>f U\<^sub>f \<phi>)"
  by (auto simp add: Iff_ltlf_def)

lemma ltl_true_or_con[simp]:
  "\<xi> \<Turnstile>\<^sub>f prop\<^sub>f(p) or\<^sub>f (not\<^sub>f prop\<^sub>f(p)) \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>f true\<^sub>f"
  by auto

lemma ltl_false_true_con[simp]:
  "\<xi> \<Turnstile>\<^sub>f not\<^sub>f true\<^sub>f \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>f false\<^sub>f"
  by auto

lemma ltl_Next_Neg_con[simp]:
  "\<xi> \<Turnstile>\<^sub>f X\<^sub>f (not\<^sub>f \<phi>) \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>f not\<^sub>f X\<^sub>f \<phi>"
  by auto

theorem exist_at_0:
  assumes "0 < length xs"
  shows "(\<exists>i < length xs. P i)  \<longleftrightarrow> (P 0 \<or> (\<exists>i. 0 < i \<and> i < length xs \<and> P i))"
  using assms by auto

theorem exist_at_0':
  assumes "(\<exists>i < length xs. P i)"
  shows "((0 < length xs \<and> P 0) \<or> (\<exists>i. 0 < i \<and> i < length xs \<and> P i))"
  using assms by auto
(*
theorem
  "suffix_list i (x # xs) \<Turnstile>\<^sub>f form = suffix_list (i - 1) xs \<Turnstile>\<^sub>f form"
  unfolding suffix_list_def by auto *)

theorem F_decompose:
  "((x # xs) \<Turnstile>\<^sub>f F\<^sub>f form) \<longleftrightarrow> (x # xs)  \<Turnstile>\<^sub>f form \<or> (xs \<Turnstile>\<^sub>f F\<^sub>f form)"
proof (cases "(x # xs)  \<Turnstile>\<^sub>f form")
  case True
  have "(x # xs) \<Turnstile>\<^sub>f F\<^sub>f form = (\<exists>i < length (x # xs). suffix_list i (x # xs) \<Turnstile>\<^sub>f form)"
    by auto
  also have "... = (suffix_list 0 (x # xs) \<Turnstile>\<^sub>f form \<or> (\<exists>i. 0 < i \<and> i < length (x # xs) \<and> suffix_list i (x # xs) \<Turnstile>\<^sub>f form))"
    (is "_ = (?disj1 \<or> ?disj2)")
    using exist_at_0 by auto
  also have "... = ((x # xs) \<Turnstile>\<^sub>f form \<or> ?disj2)" by (auto simp add:suffix_list_def)
  also have "... = True" using True by auto
  finally have "(x # xs) \<Turnstile>\<^sub>f F\<^sub>f form" by auto
  then show ?thesis using True by auto
next
  case False
  have "(x # xs) \<Turnstile>\<^sub>f F\<^sub>f form = (\<exists>i < length (x # xs). suffix_list i (x # xs) \<Turnstile>\<^sub>f form)"
    by auto
  also have "... = (suffix_list 0 (x # xs) \<Turnstile>\<^sub>f form \<or> (\<exists>i. 0 < i \<and> i < length (x # xs) \<and> suffix_list i (x # xs) \<Turnstile>\<^sub>f form))"
    (is "_ = (?disj1 \<or> ?disj2)")
    using exist_at_0 by auto
  also have "... = ((x # xs) \<Turnstile>\<^sub>f form \<or> ?disj2)" by (auto simp add:suffix_list_def)
  also have "... = ?disj2" using False by auto
  also have "... = (\<exists>i < length xs. suffix_list i xs \<Turnstile>\<^sub>f form)" unfolding suffix_list_def
  proof (rule)
    assume asm: "\<exists>i>0. i < length (x # xs) \<and> drop i (x # xs) \<Turnstile>\<^sub>f form"
    { fix i  :: nat
      assume i: "0 < i \<and> i < length (x # xs) \<and> drop i (x # xs) \<Turnstile>\<^sub>f form" hence "0 < i" "drop i (x # xs) \<Turnstile>\<^sub>f form"
        by auto
      define j where "j = i - 1"
      from i have j: "0 \<le> j \<and> j < length xs" unfolding j_def by auto
      from Environment_Executable.drop_cons[OF `0 < i`] have "drop (i-1) xs \<Turnstile>\<^sub>f form"
        using `drop i (x # xs) \<Turnstile>\<^sub>f form` by metis
      hence "drop j xs \<Turnstile>\<^sub>f form" unfolding j_def by auto
      with j have "\<exists>j < length xs. drop j xs \<Turnstile>\<^sub>f form" by auto }
    from exE[OF asm this] show "\<exists>i<length xs. drop i xs \<Turnstile>\<^sub>f form" by auto
  next
    assume asm: "\<exists>i<length xs. drop i xs \<Turnstile>\<^sub>f form"
    { fix i :: nat
      assume "i < length xs \<and> drop i xs \<Turnstile>\<^sub>f form"
      hence "0 < i + 1" "i + 1 < length (x # xs)" and "drop i xs \<Turnstile>\<^sub>f form" by auto
      with Environment_Executable.drop_cons[OF `0 < i + 1`] have "drop (i + 1) (x # xs) \<Turnstile>\<^sub>f form"
        by auto
      hence "\<exists>j. 0 < j \<and> j < length (x # xs) \<and> drop j (x # xs) \<Turnstile>\<^sub>f form" using `0 < i + 1` `i + 1 < length (x # xs)`
        by (auto intro:) }
    from exE[OF asm this] show " \<exists>i>0. i < length (x # xs) \<and> drop i (x # xs) \<Turnstile>\<^sub>f form"   by auto
  qed
  finally show ?thesis using False by auto
qed

theorem G_decompose:
  "(x # xs) \<Turnstile>\<^sub>f G\<^sub>f form = ((x # xs) \<Turnstile>\<^sub>f form \<and> xs \<Turnstile>\<^sub>f G\<^sub>f form)"
proof -
  have "(x # xs) \<Turnstile>\<^sub>f G\<^sub>f form = (\<forall>i < length (x # xs). suffix_list i (x # xs) \<Turnstile>\<^sub>f form)"
    by auto
  also have "... = (suffix_list 0 (x # xs) \<Turnstile>\<^sub>f form \<and> (\<forall>i. 0 < i \<and> i < length (x # xs) \<longrightarrow> suffix_list i (x # xs) \<Turnstile>\<^sub>f form))"
    (is "_ = (?conj1 \<and> ?conj2)")
    using univ_at_0 by auto
  also have "... = ((x # xs) \<Turnstile>\<^sub>f form \<and> ?conj2)" unfolding suffix_list_def by auto
  finally have *: "(x # xs) \<Turnstile>\<^sub>f G\<^sub>f form = ((x # xs) \<Turnstile>\<^sub>f form \<and> ?conj2)" by auto
  have "?conj2 = (\<forall>i < length xs. suffix_list i xs \<Turnstile>\<^sub>f form)" (is "_ = ?quant")
  proof
    assume "?conj2"
    show "?quant"
    proof (rule allI, rule impI)
      fix i
      assume "i < length xs"
      hence "i + 1 < length (x # xs)" and "0 < i + 1" by auto
      with `?conj2` have "suffix_list (i + 1) (x # xs) \<Turnstile>\<^sub>f form" by auto
      with Environment_Executable.drop_cons[OF `0 < i + 1`] show "suffix_list i xs \<Turnstile>\<^sub>f form"
        unfolding suffix_list_def by auto
    qed
  next
    assume "?quant"
    show "?conj2"
    proof (rule allI, rule impI)
      fix i
      assume "0 < i \<and> i < length (x # xs)"
      hence *: "0 \<le> i - 1 \<and> i - 1 < length xs" and "0 < i" by auto
      with `?quant` have "suffix_list (i-1) xs \<Turnstile>\<^sub>f form" by auto
      with Environment_Executable.drop_cons[OF `0 < i`] show "suffix_list i (x # xs) \<Turnstile>\<^sub>f form"
        unfolding suffix_list_def by metis
    qed
  qed
  with * show ?thesis by auto
qed

theorem
  "(\<exists>x. P x \<and> Q \<and> R x) \<Longrightarrow> Q \<and> (\<exists>x. P x \<and> R x)"
  by auto

theorem U_decompose:
  assumes "\<not> (x # xs) \<Turnstile>\<^sub>f form2"
  assumes "(x # xs) \<Turnstile>\<^sub>f form1 U\<^sub>f form2" (is "?eq1")
  shows "((x # xs) \<Turnstile>\<^sub>f form1 \<and> xs \<Turnstile>\<^sub>f form1 U\<^sub>f form2)" (is "_ \<and> ?eq2")
proof -
  have "0 < length (x # xs)" by auto
  have "?eq1 = (\<exists>i. i < length (x # xs) \<and> suffix_list i (x # xs) \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<i. suffix_list j (x # xs) \<Turnstile>\<^sub>f form1))"
    by auto
  also have "... = ((suffix_list 0 (x # xs) \<Turnstile>\<^sub>f form2 \<and> (\<forall>j < 0. suffix_list j (x # xs) \<Turnstile>\<^sub>f form1)) \<or>
                    (\<exists>i. 0 < i \<and> i < length (x # xs) \<and> suffix_list i (x # xs) \<Turnstile>\<^sub>f form2 \<and> (\<forall>j < i. suffix_list j (x # xs) \<Turnstile>\<^sub>f form1)))"
    (is "_ = (_ \<or> ?quant)")
    using exist_at_0[OF `0 < length (x # xs)`] by auto
  also have "... = ((x # xs)\<Turnstile>\<^sub>fform2 \<or> ?quant)" by (auto simp add:suffix_list_def)
  also have "... = ?quant" using assms by auto
  also have "... = (\<exists>i. 0 < i \<and> i < length (x # xs) \<and> suffix_list i (x # xs) \<Turnstile>\<^sub>f form2 \<and> suffix_list 0 (x # xs) \<Turnstile>\<^sub>f form1 \<and> (\<forall>j. 0 < j \<and> j < i \<longrightarrow> suffix_list j (x # xs) \<Turnstile>\<^sub>f form1))"
    using univ_at_0[where P="\<lambda>j. suffix_list j (x # xs) \<Turnstile>\<^sub>f form1"] by auto
  also have "... = (\<exists>i. 0 < i \<and> i < length (x # xs) \<and> suffix_list i (x # xs) \<Turnstile>\<^sub>f form2 \<and> (x # xs) \<Turnstile>\<^sub>f form1 \<and> (\<forall>j. 0 < j \<and> j < i \<longrightarrow> suffix_list j (x # xs) \<Turnstile>\<^sub>f form1))"
    (is "_ = ?bigquant")
    by (auto simp add:suffix_list_def)
  finally have "?eq1 = ?bigquant" by auto
  with assms have "?bigquant" by auto
  hence "(x # xs) \<Turnstile>\<^sub>f form1 \<and> (\<exists>i. 0 < i \<and> i < length (x # xs) \<and> suffix_list i (x # xs) \<Turnstile>\<^sub>f form2 \<and> (\<forall>j. 0 < j \<and> j < i \<longrightarrow> suffix_list j (x # xs) \<Turnstile>\<^sub>f form1))"
    (is "?conj1 \<and> ?conj2") by auto
  have "?conj2 \<Longrightarrow> ?eq2" unfolding semantics_ltlf.simps
  proof -
    assume "?conj2"
    { fix i :: nat
      assume "0 < i \<and> i < length (x # xs) \<and> suffix_list i (x # xs) \<Turnstile>\<^sub>f form2 \<and> (\<forall>j. 0 < j \<and> j < i \<longrightarrow> suffix_list j (x # xs) \<Turnstile>\<^sub>f form1)"
      hence "0 < i" and "i < length (x # xs)" and q2: "suffix_list i (x # xs) \<Turnstile>\<^sub>f form2" and q: "(\<forall>j. 0 < j \<and> j < i \<longrightarrow> suffix_list j (x # xs) \<Turnstile>\<^sub>f form1)"
        by auto
      hence "0 \<le> i -1" and c2: "i - 1 < length xs" by auto
      from Environment_Executable.drop_cons[OF `0 < i`] have c1: "suffix_list (i - 1) xs \<Turnstile>\<^sub>f form2"
        using `suffix_list i (x # xs) \<Turnstile>\<^sub>f form2` unfolding suffix_list_def by metis
      have "\<forall>j. j < (i - 1) \<longrightarrow> suffix_list j xs \<Turnstile>\<^sub>f form1"
      proof (rule, rule)
        fix j
        assume "j < i - 1"
        hence 0: "0 < j + 1 \<and> j + 1 < i" by auto
        hence "suffix_list (j + 1) (x # xs) \<Turnstile>\<^sub>f form1" using q by auto
        with Environment_Executable.drop_cons[of "j" "x" "xs"] show "suffix_list j xs \<Turnstile>\<^sub>f form1"
          unfolding suffix_list_def by auto
      qed
      with c1 and c2 have "i - 1 <length xs \<and>  suffix_list (i - 1) xs \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<i-1. suffix_list j xs \<Turnstile>\<^sub>f form1)"
        by auto }
    from this have "\<And>i. 0 < i \<and> i < length (x # xs) \<and> suffix_list i (x # xs) \<Turnstile>\<^sub>f form2 \<and> (\<forall>j. 0 < j \<and> j < i \<longrightarrow> suffix_list j (x # xs) \<Turnstile>\<^sub>f form1) \<Longrightarrow>
        i - 1 <length xs \<and>  suffix_list (i - 1) xs \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<i-1. suffix_list j xs \<Turnstile>\<^sub>f form1)" by auto
    from exE[OF `?conj2` this] obtain k where " k - 1 < length xs \<and> suffix_list (k - 1) xs \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<k - 1. suffix_list j xs \<Turnstile>\<^sub>f form1)"
      by blast
    thus "\<exists>i<length xs. suffix_list i xs \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<i. suffix_list j xs \<Turnstile>\<^sub>f form1)"
      by (auto intro:)
  qed
  with `?conj1 \<and> ?conj2` show ?thesis by auto
qed

theorem U_decompose':
  assumes "\<not> (x # xs) \<Turnstile>\<^sub>f form2"
  assumes "((x # xs) \<Turnstile>\<^sub>f form1 \<and> xs \<Turnstile>\<^sub>f form1 U\<^sub>f form2)" (is "_ \<and> ?eq2")
  shows "(x # xs) \<Turnstile>\<^sub>f form1 U\<^sub>f form2"
proof -
  have "?eq2 = (\<exists>i. i < length xs \<and> suffix_list i xs \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<i. suffix_list j xs \<Turnstile>\<^sub>f form1))"
    by auto
  also have "... \<Longrightarrow> ((0 < length xs \<and> suffix_list 0 xs \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<0. suffix_list j xs \<Turnstile>\<^sub>f form1)) \<or> (\<exists>i. 0 < i \<and> i < length xs \<and> suffix_list i xs \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<i. suffix_list j xs \<Turnstile>\<^sub>f form1)))"
    (is "_ \<Longrightarrow> (?case1 \<or> ?case2)")
    using exist_at_0'[where P="\<lambda>i. suffix_list i xs \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<i. suffix_list j xs \<Turnstile>\<^sub>f form1)" and xs="xs"]
    by auto
  with assms(2) have "?case1 \<or> ?case2" by auto
  moreover
  { assume "?case1"
    hence "xs \<Turnstile>\<^sub>f form2" unfolding suffix_list_def by auto
    have ?thesis
    proof (unfold semantics_ltlf.simps, rule exI[where x="1"])
      have 1: "1 < length (x # xs)" using `?case1` by auto
      have 2: "suffix_list 1 (x # xs) \<Turnstile>\<^sub>f form2" unfolding suffix_list_def using `xs \<Turnstile>\<^sub>f form2`
        by auto
      have 3: " (\<forall>j<1. suffix_list j (x # xs) \<Turnstile>\<^sub>f form1)" unfolding suffix_list_def using
          assms by auto
      with 1 and 2 show "1 < length (x # xs) \<and> suffix_list 1 (x # xs) \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<1. suffix_list j (x # xs) \<Turnstile>\<^sub>f form1)"
        by auto
    qed }
  moreover
  { assume "?case2"
    hence "(\<exists>k. 0 < k \<and> k < length (x # xs) \<and> suffix_list k (x # xs) \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<k. suffix_list j (x # xs) \<Turnstile>\<^sub>f form1))"
    proof -
      assume " \<exists>i>0. i<length xs \<and> suffix_list i xs \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<i. suffix_list j xs \<Turnstile>\<^sub>f form1)"
      { fix i :: nat
        assume "0 < i \<and> i<length xs \<and> suffix_list i xs \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<i. suffix_list j xs \<Turnstile>\<^sub>f form1)"
        hence "i + 1 < length (x # xs)" and "suffix_list (i + 1) (x # xs) \<Turnstile>\<^sub>f form2"
          and q: "(\<forall>j<i. suffix_list j xs \<Turnstile>\<^sub>f form1)" and "0 < i"
          using Environment_Executable.drop_cons[of "i + 1" "x" "xs"] unfolding suffix_list_def
          by auto
        have "(\<forall>j<i+1. suffix_list j (x # xs) \<Turnstile>\<^sub>f form1)"
        proof (rule, rule)
          fix j
          assume "j < i + 1"
          hence "j - 1 < i"  using \<open>0 < i\<close> by linarith
          with q have "suffix_list (j - 1) xs \<Turnstile>\<^sub>f form1" by auto
          have "j = 0 \<or> j \<noteq> 0" by auto
          moreover
          { assume "j = 0"
            hence "suffix_list j (x # xs) \<Turnstile>\<^sub>f form1" unfolding suffix_list_def using assms
              by auto  }
          moreover
          { assume "j \<noteq> 0"
            hence "0 < j" by auto
            hence "suffix_list j (x # xs) \<Turnstile>\<^sub>f form1"
              using Environment_Executable.drop_cons[OF `0 < j`, of "x" "xs"] `suffix_list (j - 1) xs \<Turnstile>\<^sub>f form1`
              unfolding suffix_list_def by metis }
          ultimately show "suffix_list j (x # xs) \<Turnstile>\<^sub>f form1" by auto
        qed
        hence "0 < i + 1 \<and> i + 1 < length (x # xs) \<and> suffix_list (i + 1) (x # xs) \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<i+1. suffix_list j (x # xs) \<Turnstile>\<^sub>f form1)"
          using `i + 1 < length (x # xs)` `suffix_list (i + 1) (x # xs) \<Turnstile>\<^sub>f form2` by auto }
      from exE[OF `?case2` this] obtain k where " 0 < k+1 \<and> k+1 < length (x # xs) \<and> suffix_list (k+1) (x # xs) \<Turnstile>\<^sub>f form2 \<and> (\<forall>j<k+1. suffix_list j (x # xs) \<Turnstile>\<^sub>f form1)"
        by metis
      thus ?thesis by auto
    qed }
  ultimately show ?thesis by auto
qed

section "Representing overtaking traffic rules in LTL with finite trace"

\<comment>\<open>traffic rules atoms\<close>
datatype tr_atom = overtaking_atom  | on_fastlane_atom  | sd_rear_atom  |  sd_front_atom  |
                   surpassing_atom  | safe_side_atom  |  larger_safe_side_atom  | motorised_atom  |
                   safe_to_return_atom  |  merging_atom  | original_lane_atom

thm tr_atom.eq.simps
find_theorems "overtaking_atom"
thm "tr_atom.eq.simps"
term "equal_class.equal overtaking_atom"

\<comment> \<open>abbreviations for meaningful names\<close>
abbreviation overtaking :: "tr_atom ltlf" where "overtaking \<equiv> prop\<^sub>f(overtaking_atom)"
abbreviation on_fastlane :: "tr_atom ltlf" where "on_fastlane \<equiv> prop\<^sub>f(on_fastlane_atom)"
abbreviation sd_rear :: "tr_atom ltlf" where "sd_rear \<equiv> prop\<^sub>f(sd_rear_atom)"
abbreviation sd_front :: "tr_atom ltlf" where "sd_front \<equiv> prop\<^sub>f(sd_front_atom)"
abbreviation surpassing :: "tr_atom ltlf" where "surpassing \<equiv> prop\<^sub>f(surpassing_atom)"
abbreviation safe_side :: "tr_atom ltlf" where "safe_side \<equiv> prop\<^sub>f(safe_side_atom)"
abbreviation larger_safe_side :: "tr_atom ltlf" where "larger_safe_side \<equiv> prop\<^sub>f(larger_safe_side_atom)"
abbreviation motorised :: "tr_atom ltlf" where "motorised \<equiv> prop\<^sub>f(motorised_atom)"
abbreviation safe_to_return :: "tr_atom ltlf" where "safe_to_return \<equiv> prop\<^sub>f(safe_to_return_atom)"
abbreviation merging :: "tr_atom ltlf" where "merging \<equiv> prop\<^sub>f(merging_atom)"
abbreviation original_lane :: "tr_atom ltlf" where "original_lane \<equiv> prop\<^sub>f(original_lane_atom)"

subsection "Formalised Traffic Rules in LTL interpreted over finite trace"

definition \<Phi>1 :: "tr_atom ltlf" where
  "\<Phi>1 \<equiv> G\<^sub>f (on_fastlane implies\<^sub>f sd_rear)"

definition \<Phi>2 :: "tr_atom ltlf" where
  "\<Phi>2 \<equiv> G\<^sub>f (overtaking and\<^sub>f (surpassing and\<^sub>f motorised) implies\<^sub>f safe_side)"

definition \<Phi>2' :: "tr_atom ltlf" where
  "\<Phi>2' \<equiv> G\<^sub>f (overtaking and\<^sub>f (surpassing and\<^sub>f not\<^sub>f motorised) implies\<^sub>f larger_safe_side)"

definition \<Phi>3 :: "tr_atom ltlf" where
  "\<Phi>3 \<equiv> G\<^sub>f ((merging implies\<^sub>f safe_to_return) and\<^sub>f (safe_to_return implies\<^sub>f merging))"

definition \<Phi>3_weaker :: "tr_atom ltlf" where
  "\<Phi>3_weaker \<equiv> G\<^sub>f (merging implies\<^sub>f safe_to_return)"

definition \<Phi>4 :: "tr_atom ltlf" where
  "\<Phi>4 \<equiv> G\<^sub>f (original_lane implies\<^sub>f sd_rear)"

subsection "Checker for atomic propositions"

type_synonym lane_type = "((real \<times> real) \<times> real \<times> real) list list"

fun bb_to_rects :: "black_boxes \<Rightarrow> rectangle list" where
  "bb_to_rects bb = (let ego_run = fst bb; ego_raw_trace = snd ego_run in
                                          map rectangle.truncate ego_raw_trace)"

definition rects_to_words :: "(rectangle list \<Rightarrow> bool list) \<Rightarrow> tr_atom \<Rightarrow> rectangle list \<Rightarrow> tr_atom set list"
  where
  "rects_to_words f atom rects = map (\<lambda>x. if x then {atom} else {}) (f rects)"

definition (in lane) overtaking_checker :: "black_boxes \<Rightarrow> tr_atom set list" where
  "overtaking_checker bb \<equiv>
                  rects_to_words (\<lambda>x. overtaking_trace  x) overtaking_atom (bb_to_rects bb)"

definition (in lane) onfastlane_checker :: "black_boxes \<Rightarrow> tr_atom set list" where
  "onfastlane_checker bb \<equiv>
                  rects_to_words (\<lambda>x. fast_lane_trace x) on_fastlane_atom (bb_to_rects bb)"

definition (in lane) merging_checker :: "black_boxes \<Rightarrow> tr_atom set list" where
  "merging_checker bb  \<equiv>
                        rects_to_words (\<lambda>x. merging_trace x) merging_atom (bb_to_rects bb)"

definition (in lane) original_lane_checker :: "black_boxes \<Rightarrow> tr_atom set list" where
  "original_lane_checker bb \<equiv>
            rects_to_words (\<lambda>x. original_lane_trace x) original_lane_atom (bb_to_rects bb)"

fun min_list_tail :: "'a :: linorder list \<Rightarrow> 'a \<Rightarrow> 'a" where
  "min_list_tail [] n = n" |
  "min_list_tail (x # xs) n = (if x < n then min_list_tail xs x else min_list_tail xs n)"

lemma min_list_tail_correct:
  "min_list_tail ys n = x \<Longrightarrow> x \<le> n \<and> (\<forall>y \<in> set ys. x \<le> y)"
proof (induction ys arbitrary:n)
  case Nil
  then show ?case by auto
next
  case (Cons a ys)
  note case_cons = this
  have "a < n \<or> a \<ge> n" by auto
  moreover
  { assume "a < n"
    hence "min_list_tail (a # ys) n = min_list_tail ys a" by auto
    with case_cons have "x \<le> a" and *: "\<forall>y\<in>set ys. x \<le> y" by auto
    with `a < n` have "x \<le> n" and "\<forall>y \<in> set (a # ys). x \<le> y" by auto
    hence " x \<le> n \<and> Ball (set (a # ys)) (op \<le> x)" by auto  }
  moreover
  { assume "a \<ge> n"
    hence "min_list_tail (a # ys) n = min_list_tail ys n" by auto
    with case_cons have "x \<le> n \<and> (\<forall>y\<in>set ys. x \<le> y)" by auto
    with `a \<ge> n` have "x \<le> n \<and> (\<forall>y \<in> set (a # ys). x \<le> y)" by auto
    hence " x \<le> n \<and> Ball (set (a # ys)) (op \<le> x)" by auto  }
  ultimately show ?case by auto
qed

fun min_list :: "'a :: linorder list \<Rightarrow> 'a option" where
  "min_list [] = None" |
  "min_list xs = Some (min_list_tail (tl xs) (hd xs))"

lemma min_list_correct:
  "min_list xs = Some n \<Longrightarrow> \<forall>x\<in> set xs. n \<le> x"
  by (induction xs arbitrary:n) (auto simp add:min_list_tail_correct)

definition min_list_idx :: "'a :: linorder list \<Rightarrow> nat option" where
  "min_list_idx xs \<equiv> (case min_list xs of
                        None \<Rightarrow> None
                      | Some n \<Rightarrow> Some (fst (the (find (\<lambda>x. snd x = n) (List.enumerate 0 xs)))))"

\<comment>\<open>Detecting vehicles behind and in front\<close>
definition relevant_boundaries :: "nat list \<Rightarrow> nat list" where
  "relevant_boundaries xs = (case find (\<lambda>x. x = 0) xs of
                              None \<Rightarrow> (case min_list xs of
                                        None \<Rightarrow> []
                                       | Some x \<Rightarrow> (x - 1) # xs)
                             | Some x \<Rightarrow> xs)"

fun relevant_lane_id :: "detection_opt \<Rightarrow> nat list" where
  "relevant_lane_id Outside = []" |
  "relevant_lane_id (Lane x) = [x]" |
  "relevant_lane_id (Boundaries ns) = relevant_boundaries ns"

fun list_intersect :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" where
  "list_intersect [] _ = False" |
  "list_intersect (a # as) bs = (case find (\<lambda>x. x = a) bs of
                                    Some _ \<Rightarrow> True
                                 |  None \<Rightarrow> list_intersect as bs)"

theorem list_intersect_sound:
  "list_intersect as bs \<longleftrightarrow> (\<exists>x. x \<in> set as \<and> x \<in> set bs)"
proof (induction as)
  case Nil
  then show ?case by auto
next
  case (Cons a as)
  note case_cons = this
  define res where "res \<equiv> find (\<lambda>x. x = a) bs"
  then show ?case unfolding list_intersect.simps
  proof (induction res)
    case None
    have "list_intersect as bs = (\<exists>x. x \<in> set (a # as) \<and> x \<in> set bs)" (is "?lhs = ?rhs")
    proof -
      from sym[OF None] have " (\<nexists>x. x \<in> set bs \<and> x = a)" unfolding find_None_iff by auto
      hence "a \<notin> set bs" by auto
      hence "?rhs = (\<exists>x. x \<in> set as \<and> x \<in> set bs)" by auto
      also have "... = ?lhs" using case_cons by auto
      finally show ?thesis by auto
    qed
    with sym[OF None] show ?case by auto
  next
    case (Some option)
    note case_option = this
    from sym[OF this] have " \<exists>i<length bs. bs ! i = a \<and> option = bs ! i \<and> (\<forall>j<i. bs ! j \<noteq> a)"
      unfolding find_Some_iff  by auto
    hence "a \<in> set bs" by auto
    hence " (\<exists>x. x \<in> set (a # as) \<and> x \<in> set bs)" by auto
    with sym[OF case_option] show ?case by auto
  qed
qed

fun is_relevant :: "detection_opt \<Rightarrow> detection_opt \<Rightarrow> bool" where
  "is_relevant Outside _ = False" |
  "is_relevant _ Outside = False" |
  "is_relevant (Lane x) (Lane y) = (x = y)" |
  "is_relevant (Lane x) (Boundaries ys) = (x \<in> set (relevant_boundaries ys))" |
  "is_relevant (Boundaries xs) (Lane y) = (y \<in> set (relevant_boundaries xs))" |
  "is_relevant (Boundaries xs) (Boundaries ys) = list_intersect (relevant_boundaries xs) (relevant_boundaries ys)"

definition (in lane) trim_vehicles_same_lane :: "raw_state list \<Rightarrow> detection_opt \<Rightarrow>  raw_state list" where
  "trim_vehicles_same_lane states l = filter (is_relevant l \<circ> lane_detection \<circ> rectangle.truncate) states"

definition (in lane) vehicles_behind :: "raw_state list \<Rightarrow> raw_state \<Rightarrow> raw_state list" where
  "vehicles_behind states r = (let re = rectangle.truncate r;
                                   states2 = (trim_vehicles_same_lane states (lane_detection re)) in
                                   filter (\<lambda>x. Xcoord x \<le> Xcoord re) states2)"

definition (in lane) vehicles_infront :: "raw_state list \<Rightarrow> raw_state \<Rightarrow> raw_state list" where
  "vehicles_infront states r = (let re = rectangle.truncate r;
                                    states2 = (trim_vehicles_same_lane states (lane_detection re)) in
                                    filter (\<lambda>x. Xcoord x > Xcoord re) states2)"

definition (in lane) closest_vehicles_infront :: "raw_state list \<Rightarrow> raw_state \<Rightarrow> raw_state option" where
  "closest_vehicles_infront states r = (let fronts = vehicles_infront states r;
                                            xpos =  map Xcoord fronts;
                                            min_idx = min_list_idx xpos
                                        in case min_idx of None \<Rightarrow> None | Some n \<Rightarrow> Some (fronts ! n))"

definition (in lane) closest_vehicles_infront_idx :: "raw_state list \<Rightarrow> raw_state \<Rightarrow> nat option" where
  "closest_vehicles_infront_idx states r = (let fronts = vehicles_infront states r;
                                            xpos =  map Xcoord fronts
                                        in
                                            min_list_idx xpos)"

(* why the length of the ego vehicle is subtracted from the coordinate? Shouldn't it be added? *)
definition (in lane) sd_raw_state :: "raw_state \<Rightarrow> raw_state \<Rightarrow> real \<Rightarrow> bool" where
  "sd_raw_state ego other \<delta> \<equiv> (let se = Xcoord ego + Length ego / 2;
                               ve = fst (velocity ego); ae = fst (acceleration ego);
                               so = Xcoord other - Length other / 2;
                               vo = fst (velocity other); ao = fst (acceleration other)
                            in checker_r se ve ae so vo ao \<delta>)"

fun (in lane) sd_rear' :: "raw_state list \<Rightarrow> raw_state \<Rightarrow> real \<Rightarrow> bool" where
  "sd_rear' [] _ _ = True" |
  "sd_rear' (r # rs) ego \<delta> = (if sd_raw_state r ego \<delta> then sd_rear' rs ego \<delta> else False)"

definition (in lane) sd_rear :: "raw_state list \<Rightarrow> raw_state \<Rightarrow> real \<Rightarrow> bool" where
  "sd_rear rs ego \<delta> = (let vehicles = vehicles_behind rs ego in sd_rear' vehicles ego \<delta>)"

fun (in lane) sd_rears :: "raw_state list list \<Rightarrow> raw_state list \<Rightarrow> real \<Rightarrow> bool list" where
  "sd_rears _ [] _ = []" |
  "sd_rears [] (ego # egos) \<delta> = (sd_rear [] ego \<delta>) # sd_rears [] egos \<delta>" |
  "sd_rears (rs # rss) (ego # egos) \<delta> = (sd_rear rs ego \<delta>) # sd_rears rss egos \<delta>"

theorem (in lane)
  "length (sd_rears rss egos \<delta>) = length egos"
  by (induction rule:sd_rears.induct) (auto)

definition (in lane) sd_rear_checker' :: "black_boxes  \<Rightarrow> real \<Rightarrow> bool list" where
  "sd_rear_checker' bb \<delta> \<equiv> (let ego_run = snd (fst bb); other_runs = map snd (snd bb) in
                                 sd_rears (List.transpose other_runs) ego_run \<delta>)"

definition (in lane) sd_rear_checker :: "black_boxes  \<Rightarrow> real \<Rightarrow> tr_atom set list" where
  "sd_rear_checker bb \<delta> \<equiv> (let result = sd_rear_checker' bb \<delta>
                               in  map (\<lambda>x. if x then {sd_rear_atom} else {}) result)"

text \<open>Dropping @{term "k"} elements for each list in a list of list.\<close>
definition drop_list :: "nat \<Rightarrow> 'a list list \<Rightarrow> 'a list list" where
  "drop_list k xss = map (drop k) xss"

definition nth_list :: "nat \<Rightarrow> 'a list list \<Rightarrow> 'a list" where
  "nth_list k xss = map (\<lambda>xs. nth xs k) xss"

abbreviation uncurry :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> ('a \<times> 'b) \<Rightarrow> 'c" where
  "uncurry f p \<equiv> f (fst p) (snd p)"

fun take_some :: "'a option list \<Rightarrow> 'a list" where
  "take_some [] = []" |
  "take_some (x # xs) = (if x = None then take_some xs else the x # take_some xs)"

fun (in lane) sd_raw_state_list :: "raw_state list list \<Rightarrow> raw_state list \<Rightarrow> real \<Rightarrow> bool list list" where
  "sd_raw_state_list [] _ _ = []" |
  "sd_raw_state_list (ts # tss) es \<delta> = map (uncurry (\<lambda>ego other. sd_raw_state ego other \<delta>)) (zip ts es) # sd_raw_state_list tss es \<delta>"

definition (in lane) sd_raw_state_list' :: "raw_state list list \<Rightarrow> raw_state list \<Rightarrow> real \<Rightarrow> bool list" where
  "sd_raw_state_list' tss es \<delta> \<equiv> map (foldl (op \<and>) True) (List.transpose (sd_raw_state_list tss es \<delta>))"

fun (in lane) process_safe_to_return :: "(nat \<times> nat \<times> nat \<times> nat) list \<Rightarrow> nat list \<Rightarrow> nat option list \<Rightarrow> raw_state list list \<Rightarrow> raw_state list \<Rightarrow> real \<Rightarrow> bool list" where
  "process_safe_to_return [] xs _ _ _ _ = replicate (length xs) False" |
  "process_safe_to_return ((t1, t2, t3, t4) # ts) (n # ns) (iden # ids) other_runs ego_runs \<delta> =
        (if n < t1 then False # process_safe_to_return ((t1, t2, t3, t4) # ts) ns (iden # ids) other_runs ego_runs \<delta> else
         if n > t4 then process_safe_to_return ts (n # ns) ids other_runs ego_runs \<delta> else
           (case iden of None \<Rightarrow> False # process_safe_to_return ((t1, t2, t3, t4) # ts) ns (iden # ids) other_runs ego_runs \<delta> |
            Some num \<Rightarrow> sd_raw_state ((other_runs ! num) ! n) (ego_runs ! n) \<delta> # process_safe_to_return ((t1, t2, t3, t4) # ts) ns (iden # ids) other_runs ego_runs \<delta>))"

definition (in lane) safe_to_return_trace :: "black_boxes \<Rightarrow> real \<Rightarrow> bool list" where
  "safe_to_return_trace bb \<delta> \<equiv> (let ego_rects = bb_to_rects bb;
                                     ego_runs = snd (fst bb);
                                     other_runs = map snd (snd bb);
                                     ov_nums = overtaking ego_rects;
                                     start_ovs = map fst ov_nums;
                                     choppeds = [f other_runs . f \<leftarrow> (map nth_list start_ovs)];
                                     ego_chopped = [f (snd (fst bb)). f \<leftarrow> (map (\<lambda>n xs. xs ! n) start_ovs)];
                                     overtaken_vehs  = map (uncurry closest_vehicles_infront_idx) (zip (List.transpose choppeds) ego_chopped)
                                   in process_safe_to_return ov_nums [0..< (length ego_runs)] overtaken_vehs other_runs ego_runs \<delta>)"

definition (in lane) safe_to_return_checker :: "black_boxes \<Rightarrow> real \<Rightarrow> tr_atom set list" where
  "safe_to_return_checker bb \<delta> \<equiv> (let result = safe_to_return_trace bb \<delta> in
                                      map (\<lambda>x. if x then {safe_to_return_atom} else {}) result)"

function monitor_tr :: "[tr_atom set list, tr_atom ltlf] \<Rightarrow> bool"  and
         monitor_tr_F :: "tr_atom set list \<Rightarrow> tr_atom ltlf \<Rightarrow> bool" and
         monitor_tr_G :: "tr_atom set list \<Rightarrow> tr_atom ltlf \<Rightarrow> bool" and
         monitor_tr_U :: "tr_atom set list \<Rightarrow> tr_atom ltlf \<Rightarrow> tr_atom ltlf \<Rightarrow> bool"
where
  "monitor_tr \<xi> (true\<^sub>f) = True"
| "monitor_tr \<xi> (false\<^sub>f) = False"
| "monitor_tr \<xi> prop\<^sub>f(q) = (q \<in> (\<xi> ! 0))"
| "monitor_tr \<xi> (not\<^sub>f \<phi>) = (\<not> monitor_tr \<xi> \<phi>)"
| "monitor_tr \<xi> (\<phi> and\<^sub>f \<psi>) = (monitor_tr \<xi> \<phi> \<and> monitor_tr \<xi> \<psi>)"
| "monitor_tr \<xi> (\<phi> or\<^sub>f \<psi>) = (monitor_tr \<xi> \<phi> \<or> monitor_tr \<xi> \<psi>)"
| "monitor_tr \<xi> (\<phi> implies\<^sub>f \<psi>) = (monitor_tr \<xi> \<phi> \<longrightarrow> monitor_tr \<xi> \<psi>)"
| "monitor_tr \<xi> (X\<^sub>f \<phi>) = (monitor_tr (suffix_list 1 \<xi>) \<phi>)"
| "monitor_tr \<xi> (F\<^sub>f \<phi>) = monitor_tr_F \<xi> \<phi>"
| "monitor_tr \<xi> (G\<^sub>f \<phi>) = monitor_tr_G \<xi> \<phi>"
| "monitor_tr \<xi> (\<phi> U\<^sub>f \<psi>) = monitor_tr_U \<xi> \<phi> \<psi>"

| "monitor_tr_F [] form = False"
| "monitor_tr_F (x # xs) form = (if monitor_tr (x # xs) form then True else monitor_tr_F xs form)"

| "monitor_tr_G [] form = True"
| "monitor_tr_G (x # xs) form = (if monitor_tr (x # xs) form then monitor_tr_G xs form else False)"

| "monitor_tr_U [] form1 form2  = False"
| "monitor_tr_U (x # xs) form1 form2 = (if monitor_tr (x # xs) form2 then True else
                                           monitor_tr (x # xs) form1 \<and> monitor_tr_U xs form1 form2)"
  by pat_completeness auto
termination  by size_change

theorem monitoring:
  "semantics_ltlf \<xi> form = monitor_tr \<xi> form"
  "semantics_ltlf \<xi> (F\<^sub>f \<phi>) = monitor_tr_F \<xi> \<phi>"
  "semantics_ltlf \<xi> (G\<^sub>f \<phi>) = monitor_tr_G \<xi> \<phi>"
  "semantics_ltlf \<xi> (\<phi> U\<^sub>f \<psi>) = monitor_tr_U \<xi> \<phi> \<psi>"
proof (induct  rule:monitor_tr_monitor_tr_F_monitor_tr_G_monitor_tr_U.induct)
  case (1 \<xi>)
  then show ?case by auto
next
  case (2 \<xi>)
  then show ?case by auto
next
  case (3 \<xi> q)
  then show ?case by auto
next
  case (4 \<xi> \<phi>)
  then show ?case by auto
next
  case (5 \<xi> \<phi> \<psi>)
  then show ?case by auto
next
  case (6 \<xi> \<phi> \<psi>)
  then show ?case by auto
next
  case (7 \<xi> \<phi> \<psi>)
  then show ?case by auto
next
  case (8 \<xi> \<phi>)
  then show ?case by auto
next
  case (9 \<xi> \<phi>)
  then show ?case  by (induction \<xi>) auto
next
  case (10 \<xi> \<phi>)
  then show ?case  by (induction \<xi>) auto
next
  case (11 \<xi> \<phi> \<psi>)
  then show ?case  by (induction \<xi>) auto
next
  case (12 form)
  then show ?case by auto
next
  case (13 x xs form)
  note case13 = this
  have "monitor_tr (x # xs) form \<or> \<not> monitor_tr (x # xs) form" by auto
  moreover
  { assume True: "monitor_tr (x # xs) form"
    with case13 have "(x # xs) \<Turnstile>\<^sub>f form"  by auto
    hence "(x # xs) \<Turnstile>\<^sub>f F\<^sub>f(form)"
      by (auto intro:exI[where x="0"] simp add: suffix_list_def)
    hence ?case unfolding monitor_tr_F.simps using True by auto }
  moreover
  { assume False: "\<not> monitor_tr (x # xs) form"
    with case13 have *: "xs \<Turnstile>\<^sub>f F\<^sub>f form = monitor_tr_F xs form" by auto
    have "((x # xs) \<Turnstile>\<^sub>f F\<^sub>f form) \<longleftrightarrow> (x # xs)  \<Turnstile>\<^sub>f form \<or> (xs \<Turnstile>\<^sub>f F\<^sub>f form)" using F_decompose[of "x" "xs" "form"] .
    hence ?case unfolding monitor_tr_F.simps using False and *  by (simp add: case13(1)) }
  ultimately show ?case by auto
next
  case (14 form)
  then show ?case by auto
next
  case (15 x xs form)
  note case15 = this
  have "monitor_tr (x # xs) form \<or> \<not> monitor_tr (x # xs) form" by auto
  moreover
  { assume True: "monitor_tr (x # xs) form"
    with case15 have 0: "xs \<Turnstile>\<^sub>f G\<^sub>f form = monitor_tr_G xs form" by auto
    have *: "monitor_tr_G (x # xs) form = (monitor_tr (x # xs) form \<and> monitor_tr_G xs form)"
      by (cases "monitor_tr (x # xs) form") auto
    have "(x # xs) \<Turnstile>\<^sub>f G\<^sub>f form = ((x # xs) \<Turnstile>\<^sub>f form \<and> xs \<Turnstile>\<^sub>f G\<^sub>f form)" using G_decompose[of "x" "xs" "form"] by auto
    with case15 have **: "(x # xs) \<Turnstile>\<^sub>f G\<^sub>f form = (monitor_tr (x # xs) form \<and> xs \<Turnstile>\<^sub>f G\<^sub>f form)"  by auto
    have ?case unfolding ** * using 0 by auto }
  moreover
  { assume False: "\<not> monitor_tr (x # xs) form"
    hence *: "\<not> monitor_tr_G (x # xs) form" by auto
    from case15 have "\<not> (x # xs) \<Turnstile>\<^sub>f form" using False by auto
    hence "\<not> (x # xs) \<Turnstile>\<^sub>f (G\<^sub>f form)" by (auto simp add:suffix_list_def)
    then have ?case using * by auto  }
  ultimately show ?case by auto
next
  case (16 form1 form2)
  then show ?case by auto
next
  case (17 x xs form1 form2)
  note case17 = this
  have " monitor_tr (x # xs) form2 \<or> \<not>  monitor_tr (x # xs) form2 " by auto
  moreover
  { assume True: " monitor_tr (x # xs) form2 "
    hence *: "monitor_tr_U (x # xs) form1 form2" by auto
    from True case17 have "(x # xs) \<Turnstile>\<^sub>f form2" by auto
    hence "(x # xs) \<Turnstile>\<^sub>f form1 U\<^sub>f form2" by (auto simp add:suffix_list_def)
    hence ?case using * by auto }
  moreover
  { assume False: " \<not> monitor_tr (x # xs) form2 "
    hence False': "\<not> (x # xs) \<Turnstile>\<^sub>f form2" using case17 by auto
    from False case17 have eq1: " (x # xs) \<Turnstile>\<^sub>f form1 = monitor_tr (x # xs) form1" and
                     eq2: " xs \<Turnstile>\<^sub>f form1 U\<^sub>f form2 = monitor_tr_U xs form1 form2" by auto
    have *: " monitor_tr_U (x # xs) form1 form2 = (monitor_tr (x # xs) form1 \<and> monitor_tr_U xs form1 form2)"
      using False by auto
    have  " (x # xs) \<Turnstile>\<^sub>f form1 U\<^sub>f form2 = ((x # xs) \<Turnstile>\<^sub>f form1 \<and> xs \<Turnstile>\<^sub>f form1 U\<^sub>f form2)" using U_decompose[OF False', of "form1"]
      U_decompose'[OF False', of "form1"] by (rule) auto
    hence ?case unfolding * eq1 eq2 by auto }
  ultimately show ?case by auto
qed

theorem  "semantics_ltlf \<xi> form = monitor_tr \<xi> form"  using monitoring by auto

end


theory AteProof
imports AteDefs "../Reduction"
begin

context ate_parameters
begin

subsection \<open>Preliminary Lemmas\<close>

text \<open>
  If a process newly decides value \<open>v\<close> at some round,
  then it received more than \<open>E - \<alpha>\<close> messages holding \<open>v\<close>
  at this round.
\<close>

lemma decide_sent_msgs_threshold:
  assumes run: "SHORun Ate_M rho HOs SHOs"
  and comm: "SHOcommPerRd Ate_M (HOs r) (SHOs r)"
  and nvp: "decide (rho r p) \<noteq> Some v"
  and vp: "decide (rho (Suc r) p) = Some v"
  shows "card {qq. sendMsg Ate_M r qq p (rho r qq) = v} > E - \<alpha>"
proof -
  from run obtain \<mu>p
    where mu: "\<mu>p \<in> SHOmsgVectors Ate_M r p (rho r) (HOs r p) (SHOs r p)"
      and nxt: "nextState Ate_M r p (rho r p) \<mu>p (rho (Suc r) p)"
    by (auto simp: SHORun_eq SHOnextConfig_eq)
  from mu
  have "{qq. \<mu>p qq = Some v} - (HOs r p - SHOs r p)
          \<subseteq> {qq. sendMsg Ate_M r qq p (rho r qq) = v}"
       (is "?vrcvdp - ?ahop \<subseteq> ?vsentp")
    by (auto simp: SHOmsgVectors_def)
  hence "card (?vrcvdp - ?ahop) \<le> card ?vsentp"
    and "card (?vrcvdp - ?ahop) \<ge> card ?vrcvdp - card ?ahop"
    by (auto simp: card_mono diff_card_le_card_Diff)
  hence "card ?vsentp \<ge> card ?vrcvdp - card ?ahop" by auto
  moreover
  from nxt nvp vp have "card ?vrcvdp > E"
    by (auto simp: Ate_SHOMachine_def nextState_def Ate_nextState_def)
  moreover
  from comm have "card (HOs r p - SHOs r p) \<le> \<alpha>"
    by (auto simp: Ate_SHOMachine_def Ate_commPerRd_def)
  ultimately
  show ?thesis using Egta by auto
qed

text \<open>
  If more than \<open>E - \<alpha>\<close> processes send a value \<open>v\<close> to some
  process \<open>q\<close> at some round, then \<open>q\<close> will receive at least
  \<open>N + 2*\<alpha> - E\<close> messages holding \<open>v\<close> at this round.
\<close>

lemma other_values_received:
  assumes comm: "SHOcommPerRd Ate_M (HOs r) (SHOs r)"
  and nxt: "nextState Ate_M r q (rho r q) \<mu>q ((rho (Suc r)) q)"
  and muq: "\<mu>q \<in> SHOmsgVectors Ate_M r q (rho r) (HOs r q) (SHOs r q)"
  and vsent: "card {qq. sendMsg Ate_M r qq q (rho r qq) = v} > E - \<alpha>"
             (is "card ?vsent > _")
  shows "card ({qq. \<mu>q qq \<noteq> Some v} \<inter> HOs r q) \<le> N + 2*\<alpha> - E"
proof -
  from nxt muq
  have "({qq. \<mu>q qq \<noteq> Some v} \<inter> HOs r q) - (HOs r q - SHOs r q)
        \<subseteq>  {qq. sendMsg Ate_M r qq q (rho r qq) \<noteq> v}"
    (is "?notvrcvd - ?aho \<subseteq> ?notvsent")
    unfolding SHOmsgVectors_def by auto
  hence "card ?notvsent \<ge> card (?notvrcvd - ?aho)"
    and "card (?notvrcvd - ?aho) \<ge> card ?notvrcvd - card ?aho"
    by (auto simp: card_mono diff_card_le_card_Diff)
  moreover
  from comm have "card ?aho \<le> \<alpha>"
    by (auto simp: Ate_SHOMachine_def Ate_commPerRd_def)
  moreover
  have 1: "card ?notvsent + card ?vsent = card (?notvsent \<union> ?vsent)"
    by (subst card_Un_Int) auto
  have "?notvsent \<union> ?vsent = (UNIV::Proc set)" by auto
  hence "card (?notvsent \<union> ?vsent) = N" by simp
  with 1 vsent have "card ?notvsent \<le>  N - (E + 1 - \<alpha>)" by auto
  ultimately
  show ?thesis using EltN Egta by auto
qed

text \<open>
  If more than \<open>E - \<alpha>\<close> processes send a value \<open>v\<close> to some
  process \<open>q\<close> at some round \<open>r\<close>, and if \<open>q\<close> receives more than
  \<open>T\<close> messages in \<open>r\<close>, then \<open>v\<close> is the most frequently
  received value by \<open>q\<close> in \<open>r\<close>.
\<close>

lemma mostOftenRcvd_v:
  assumes comm: "SHOcommPerRd Ate_M (HOs r) (SHOs r)"
  and nxt: "nextState Ate_M r q (rho r q) \<mu>q ((rho (Suc r)) q)"
  and muq: "\<mu>q \<in> SHOmsgVectors Ate_M r q (rho r) (HOs r q) (SHOs r q)"
  and threshold_T: "card {qq. \<mu>q qq \<noteq> None} > T"
  and threshold_E: "card {qq. sendMsg Ate_M r qq q (rho r qq) = v} > E - \<alpha>"
  shows "mostOftenRcvd \<mu>q = {v}"
proof -
  from muq have hodef:"HOs r q = {qq. \<mu>q qq \<noteq> None}"
    unfolding SHOmsgVectors_def by auto

  from comm nxt muq threshold_E
  have "card ({qq. \<mu>q qq \<noteq> Some v} \<inter> HOs r q) \<le> N + 2*\<alpha> - E"
    (is "card ?heardnotv \<le> _")
    by (rule other_values_received)
  moreover
  have "card ?heardnotv \<ge> T + 1 - card {qq. \<mu>q qq = Some v}"
  proof -
    from muq
    have "?heardnotv = (HOs r q) - {qq. \<mu>q qq = Some v}"
      and "{qq. \<mu>q qq = Some v} \<subseteq> HOs r q"
      unfolding SHOmsgVectors_def by auto
    hence "card ?heardnotv = card (HOs r q) - card {qq. \<mu>q qq = Some v}"
      by (auto simp: card_Diff_subset)
    with hodef threshold_T show ?thesis by auto
  qed
  ultimately
  have "card {qq. \<mu>q qq = Some v} > card ?heardnotv"
    using TNaE by auto
  moreover
  {
    fix w
    assume w: "w \<noteq> v"
    with hodef have "{qq. \<mu>q qq = Some w} \<subseteq> ?heardnotv" by auto
    hence "card {qq. \<mu>q qq = Some w} \<le> card ?heardnotv" by (auto simp: card_mono)
  }
  ultimately
  have "{w. card {qq. \<mu>q qq = Some w} \<ge> card {qq. \<mu>q qq = Some v}} = {v}"
    by force
  thus ?thesis unfolding mostOftenRcvd_def by auto
qed

text \<open>
  If at some round more than \<open>E - \<alpha>\<close> processes have their \<open>x\<close>
  variable set to \<open>v\<close>, then this is also true at next round.
\<close>

lemma common_x_induct:
  assumes run: "SHORun Ate_M rho HOs SHOs"
  and comm: "SHOcommPerRd Ate_M (HOs (r+k)) (SHOs (r+k))"
  and ih: "card {qq. x (rho (r + k) qq) = v} > E - \<alpha>"
  shows "card {qq. x (rho (r + Suc k) qq) = v} > E - \<alpha>"
proof -
  from ih
  have thrE:"\<forall>pp. card {qq. sendMsg Ate_M (r + k) qq pp (rho (r + k) qq) = v}
                      > E - \<alpha>"
    by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)

  {
    fix qq
    assume kv:"x (rho (r + k) qq) = v"
    from run obtain \<mu>qq
      where nxt: "nextState Ate_M (r + k) qq (rho (r + k) qq) \<mu>qq ((rho (Suc (r + k))) qq)"
        and muq: "\<mu>qq \<in> SHOmsgVectors Ate_M (r + k) qq (rho (r + k))
                                         (HOs (r + k) qq) (SHOs (r + k) qq)"
      by (auto simp: SHORun_eq SHOnextConfig_eq)

    have "x (rho (r + Suc k) qq) = v"
    proof (cases "card {pp. \<mu>qq pp \<noteq> None} > T")
      case True
      with comm nxt muq thrE have "mostOftenRcvd \<mu>qq = {v}"
        by (auto dest: mostOftenRcvd_v)
      with nxt True show "x (rho (r + Suc k) qq) = v"
        by (auto simp: Ate_SHOMachine_def nextState_def Ate_nextState_def)
    next
      case False
      with nxt have "x (rho (r + Suc k) qq) = x (rho (r + k) qq)"
        by (auto simp: Ate_SHOMachine_def nextState_def Ate_nextState_def)
      with kv show "x (rho (r + Suc k) qq) = v" by simp
    qed
  }
  hence "{qq. x (rho (r + k) qq) = v} \<subseteq> {qq. x (rho (r + Suc k) qq) = v}"
    by auto
  hence "card {qq. x (rho (r + k) qq) = v} \<le> card {qq. x (rho (r + Suc k) qq) = v}"
    by (auto simp: card_mono)
  with ih show ?thesis by auto
qed

text \<open>
  Whenever some process newly decides value \<open>v\<close>, then any
  process that updates its \<open>x\<close> variable will set it to \<open>v\<close>.
\<close>
(* The proof mainly relies on lemmas @{text decide_sent_msgs_threshold},
   @{text mostOftenRcvd_v} and @{text common_x_induct}. *)

lemma common_x:
  assumes run: "SHORun Ate_M rho HOs SHOs"
  and comm: "\<forall>r. SHOcommPerRd (Ate_M::(Proc, 'val::linorder pstate, 'val) SHOMachine)
                              (HOs r) (SHOs r)"
  and d1: "decide (rho r p) \<noteq> Some v"
  and d2: "decide (rho (Suc r) p) = Some v"
  and qupdatex: "x (rho (r + Suc k) q) \<noteq> x (rho (r + k) q)"
  shows "x (rho (r + Suc k) q) = v"
proof -
  from comm
  have "SHOcommPerRd (Ate_M::(Proc, 'val::linorder pstate, 'val) SHOMachine)
                     (HOs (r+k)) (SHOs (r+k))" ..
  moreover
  from run obtain \<mu>q
    where nxt: "nextState Ate_M (r+k) q (rho (r+k) q) \<mu>q (rho (r + Suc k) q)"
      and muq: "\<mu>q \<in> SHOmsgVectors Ate_M (r+k) q (rho (r+k))
                                   (HOs (r+k) q) (SHOs (r+k) q)"
    by (auto simp: SHORun_eq SHOnextConfig_eq)
  moreover
  from nxt qupdatex
  have threshold_T: "card {qq. \<mu>q qq \<noteq> None} > T"
    and xsmall: "x (rho (r + Suc k) q) = Min (mostOftenRcvd \<mu>q)"
    by (auto simp: Ate_SHOMachine_def nextState_def Ate_nextState_def)
  moreover
  have "E - \<alpha> < card {qq. x (rho (r + k) qq) = v}"
  proof (induct k)
    from run comm d1 d2
    have "E - \<alpha> < card {qq. sendMsg Ate_M r qq p (rho r qq) = v}"
      by (auto dest: decide_sent_msgs_threshold)
    thus "E - \<alpha> < card {qq. x (rho (r + 0) qq) = v}"
      by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)
  next
    fix k
    assume "E - \<alpha> < card {qq. x (rho (r + k) qq) = v}"
    with run comm show "E - \<alpha> < card {qq. x (rho (r + Suc k) qq) = v}"
      by (auto dest: common_x_induct)
  qed
  with run
  have "E - \<alpha> < card {qq. sendMsg Ate_M (r+k) qq q (rho (r+k) qq) = v}"
    by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def SHORun_eq SHOnextConfig_eq)
  ultimately
  have "mostOftenRcvd \<mu>q = {v}" by (auto dest:mostOftenRcvd_v)
  with xsmall show ?thesis by auto
qed

text \<open>
  A process that holds some decision \<open>v\<close> has decided \<open>v\<close>
  sometime in the past.
\<close>
lemma decisionNonNullThenDecided:
  assumes run: "SHORun Ate_M rho HOs SHOs"
      and dec: "decide (rho n p) = Some v"
  obtains m where "m < n"
              and "decide (rho m p) \<noteq> Some v"
              and "decide (rho (Suc m) p) = Some v"
proof -
  let "?dec k" = "decide (rho k p)"
  have "(\<forall>m<n. ?dec (Suc m) \<noteq> ?dec m \<longrightarrow> ?dec (Suc m) \<noteq> Some v) \<longrightarrow> ?dec n \<noteq> Some v"
    (is "?P n" is "?A n \<longrightarrow> _")
  proof (induct n)
    from run show "?P 0"
      by (auto simp: Ate_SHOMachine_def SHORun_eq HOinitConfig_eq
                     initState_def Ate_initState_def)
  next
    fix n
    assume ih: "?P n" thus "?P (Suc n)" by force
  qed
  with dec that show ?thesis by auto
qed

subsection \<open>Proof of Validity\<close>

text \<open>
  Validity asserts that if all processes were initialized with the same value,
  then no other value may ever be decided.
\<close>

theorem ate_validity:
  assumes run: "SHORun Ate_M rho HOs SHOs"
  and comm: "\<forall>r. SHOcommPerRd Ate_M (HOs r) (SHOs r)"
  and initv: "\<forall>q. x (rho 0 q) = v"
  and dp: "decide (rho r p) = Some w"
  shows "w = v"
proof -
  {
    fix r
    have "\<forall>qq. sendMsg Ate_M r qq p (rho r qq) = v"
    proof (induct r)
      from run initv show "\<forall>qq. sendMsg Ate_M 0 qq p (rho 0 qq) = v"
        by (auto simp: SHORun_eq SHOnextConfig_eq Ate_SHOMachine_def Ate_sendMsg_def)
    next
      fix r
      assume ih:"\<forall>qq. sendMsg Ate_M r qq p (rho r qq) = v"

      have "\<forall>qq. x (rho (Suc r) qq) = v"
      proof
        fix qq
        from run obtain \<mu>qq
          where nxt: "nextState Ate_M r qq (rho r qq) \<mu>qq (rho (Suc r) qq)"
            and mu: "\<mu>qq \<in> SHOmsgVectors Ate_M r qq (rho r) (HOs r qq) (SHOs r qq)"
          by (auto simp: SHORun_eq SHOnextConfig_eq)
        from nxt
        have "(card {pp. \<mu>qq pp \<noteq> None} > T \<and> x (rho (Suc r) qq) = Min (mostOftenRcvd \<mu>qq))
            \<or> (card {pp. \<mu>qq pp \<noteq> None} \<le> T \<and> x (rho (Suc r) qq) = x (rho r qq))"
          by (auto simp: Ate_SHOMachine_def nextState_def Ate_nextState_def)
        thus "x (rho (Suc r) qq) = v"
        proof safe
          assume "x (rho (Suc r) qq) = x (rho r qq)"
          with ih show "?thesis"
            by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)
        next
          assume threshold_T:"T < card {pp. \<mu>qq pp \<noteq> None}"
             and xsmall:"x (rho (Suc r) qq) = Min (mostOftenRcvd \<mu>qq)"

          have "card {pp. \<exists>w. w \<noteq> v \<and> \<mu>qq pp = Some w} \<le> T div 2"
          proof -
            from comm have 1:"card (HOs r qq - SHOs r qq) \<le> \<alpha>"
              by (auto simp: Ate_SHOMachine_def Ate_commPerRd_def)
            moreover
            from mu ih
            have "SHOs r qq \<inter> HOs r qq \<subseteq> {pp. \<mu>qq pp = Some v}"
              and "HOs r qq = {pp. \<mu>qq pp \<noteq> None}"
              by (auto simp: SHOmsgVectors_def Ate_SHOMachine_def Ate_sendMsg_def)
            hence "{pp. \<mu>qq pp \<noteq> None} - {pp. \<mu>qq pp = Some v}
                   \<subseteq> HOs r qq - SHOs r qq"
              by auto
            hence "card ({pp. \<mu>qq pp \<noteq> None} - {pp. \<mu>qq pp = Some v})
                      \<le> card (HOs r qq - SHOs r qq)"
              by (auto simp:card_mono)
            ultimately
            have "card ({pp. \<mu>qq pp \<noteq> None} - {pp. \<mu>qq pp = Some v}) \<le> T div 2"
              using Tge2a by auto
            moreover
            have "{pp. \<mu>qq pp \<noteq> None} - {pp. \<mu>qq pp = Some v}
                  = {pp. \<exists>w. w \<noteq> v \<and> \<mu>qq pp = Some w}" by auto
            ultimately
            show ?thesis by simp
          qed
          moreover
          have "{pp. \<mu>qq pp \<noteq> None}
                = {pp. \<mu>qq pp = Some v} \<union> {pp. \<exists>w. w \<noteq> v \<and> \<mu>qq pp = Some w}"
            and "{pp. \<mu>qq pp = Some v} \<inter> {pp. \<exists>w. w \<noteq> v \<and> \<mu>qq pp = Some w} = {}"
            by auto
          hence "card {pp. \<mu>qq pp \<noteq> None}
                 = card {pp. \<mu>qq pp = Some v} + card {pp. \<exists>w. w \<noteq> v \<and> \<mu>qq pp = Some w}"
            by (auto simp: card_Un_Int)
          moreover
          note threshold_T
          ultimately
          have "card {pp. \<mu>qq pp = Some v} > card {pp. \<exists>w. w \<noteq> v \<and> \<mu>qq pp = Some w}"
            by auto
          moreover
          {
            fix w
            assume "w \<noteq> v"
            hence "{pp. \<mu>qq pp = Some w} \<subseteq> {pp. \<exists>w. w \<noteq> v \<and> \<mu>qq pp = Some w}"
              by auto
            hence "card {pp. \<mu>qq pp = Some w} \<le> card {pp. \<exists>w. w \<noteq> v \<and> \<mu>qq pp = Some w}"
              by (auto simp: card_mono)
          }
          ultimately
          have zz:"\<And>w. w \<noteq> v \<Longrightarrow>
                       card {pp. \<mu>qq pp = Some w} < card {pp. \<mu>qq pp = Some v}"
            by force
          hence "\<And>w. card {pp. \<mu>qq pp = Some v} \<le> card {pp. \<mu>qq pp = Some w}
                      \<Longrightarrow> w = v"
            by force
          with zz have "mostOftenRcvd \<mu>qq = {v}"
            by (force simp: mostOftenRcvd_def)
          with xsmall show "x (rho (Suc r) qq) = v" by auto
        qed
      qed
      thus "\<forall>qq. sendMsg Ate_M (Suc r) qq p (rho (Suc r) qq) = v"
        by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)
    qed
  }
  note P = this

  from run dp obtain rp
    where rp: "rp < r" "decide (rho rp p) \<noteq> Some w"
              "decide (rho (Suc rp) p) = Some w"
    by (rule decisionNonNullThenDecided)

  from run obtain \<mu>p
    where nxt: "nextState Ate_M rp p (rho rp p) \<mu>p (rho (Suc rp) p)"
      and mu: "\<mu>p \<in> SHOmsgVectors Ate_M rp p (rho rp) (HOs rp p) (SHOs rp p)"
    by (auto simp: SHORun_eq SHOnextConfig_eq)

  {
    fix w
    assume w: "w \<noteq> v"
    from comm have "card (HOs rp p - SHOs rp p) \<le> \<alpha>"
      by (auto simp: Ate_SHOMachine_def Ate_commPerRd_def)
    moreover
    from mu P
    have "SHOs rp p \<inter> HOs rp p \<subseteq> {pp. \<mu>p pp = Some v}"
      and "HOs rp p = {pp. \<mu>p pp \<noteq> None}"
      by (auto simp: SHOmsgVectors_def)
    hence "{pp. \<mu>p pp \<noteq> None} - {pp. \<mu>p pp = Some v}
           \<subseteq> HOs rp p - SHOs rp p"
      by auto
    hence "card ({pp. \<mu>p pp \<noteq> None} - {pp. \<mu>p pp = Some v})
            \<le> card (HOs rp p - SHOs rp p)"
      by (auto simp: card_mono)
    ultimately
    have "card ({pp. \<mu>p pp \<noteq> None} - {pp. \<mu>p pp = Some v}) < E"
      using Egta by auto
    moreover
    from w have "{pp. \<mu>p pp = Some w}
                 \<subseteq> {pp. \<mu>p pp \<noteq> None} - {pp. \<mu>p pp = Some v}"
      by auto
    hence "card {pp. \<mu>p pp = Some w}
             \<le> card ({pp. \<mu>p pp \<noteq> None} - {pp. \<mu>p pp = Some v})"
      by (auto simp: card_mono)
    ultimately
    have "card {pp. \<mu>p pp = Some w} < E" by simp
  }
  hence PP: "\<And>w. card {pp. \<mu>p pp = Some w} \<ge> E \<Longrightarrow> w = v" by force

  from rp nxt mu have "card {q. \<mu>p q = Some w} > E"
    by (auto simp: SHOmsgVectors_def Ate_SHOMachine_def
                   nextState_def Ate_nextState_def)
  with PP show ?thesis by auto
qed

subsection \<open>Proof of Agreement\<close>

text \<open>
  If two processes decide at the some round, they decide the same value.
\<close>
(* The proof mainly relies on lemma @{text decide_sent_msgs_threshold}. *)

lemma common_decision:
  assumes run: "SHORun Ate_M rho HOs SHOs"
  and comm: "SHOcommPerRd Ate_M (HOs r) (SHOs r)"
  and nvp: "decide (rho r p) \<noteq> Some v"
  and vp: "decide (rho (Suc r) p) = Some v"
  and nwq: "decide (rho r q) \<noteq> Some w"
  and wq: "decide (rho (Suc r) q) = Some w"
  shows "w = v"
proof -
  have gtn: "card {qq. sendMsg Ate_M r qq p (rho r qq) = v}
             + card {qq. sendMsg Ate_M r qq q (rho r qq) = w} > N"
  proof -
    from run comm nvp vp
    have "card {qq. sendMsg Ate_M r qq p (rho r qq) = v} > E - \<alpha>"
      by (rule decide_sent_msgs_threshold)
    moreover
    from run comm nwq wq
    have "card {qq. sendMsg Ate_M r qq q (rho r qq) = w} > E - \<alpha>"
      by (rule decide_sent_msgs_threshold)
    ultimately
    show ?thesis using majE by auto
  qed

  show ?thesis
  proof (rule ccontr)
    assume vw:"w \<noteq> v"
    have "\<forall>qq. sendMsg Ate_M r qq p (rho r qq) = sendMsg Ate_M r qq q (rho r qq)"
      by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)
    with vw
    have "{qq. sendMsg Ate_M r qq p (rho r qq) = v}
          \<inter> {qq. sendMsg Ate_M r qq q (rho r qq) = w} = {}"
      by auto
    with gtn
    have "card ({qq. sendMsg Ate_M r qq p (rho r qq) = v}
                 \<union> {qq. sendMsg Ate_M r qq q (rho r qq) = w}) > N"
      by (auto simp: card_Un_Int)
    moreover
    have "card ({qq. sendMsg Ate_M r qq p (rho r qq) = v}
                 \<union> {qq. sendMsg Ate_M r qq q (rho r qq) = w}) \<le> N"
      by (auto simp: card_mono)
    ultimately
    show "False" by auto
  qed
qed

text \<open>
  If process \<open>p\<close> decides at step \<open>r\<close> and process \<open>q\<close> decides
  at some later step \<open>r+k\<close> then \<open>p\<close> and \<open>q\<close> decide the
  same value.
\<close>
(*
  The proof mainly relies on lemmas @{text common_decision}, @{text common_x},
  @{text decide_with_threshold_E}, @{text unique_majority_E_\<alpha>}
  and @{text  decide_sent_msgs_threshold}.
*)

lemma laterProcessDecidesSameValue :
  assumes run: "SHORun Ate_M rho HOs SHOs"
  and comm: "\<forall>r. SHOcommPerRd Ate_M (HOs r) (SHOs r)"
  and nd1: "decide (rho r p) \<noteq> Some v"
  and d1: "decide (rho (Suc r) p) = Some v"
  and nd2: "decide (rho (r+k) q) \<noteq> Some w"
  and d2: "decide (rho (Suc (r+k)) q) = Some w"
  shows "w = v"
proof (rule ccontr)
  assume vdifw:"w \<noteq> v"
  have kgt0: "k > 0"
  proof (rule ccontr)
    assume "\<not> k > 0"
    hence "k = 0" by auto
    with run comm nd1 d1 nd2 d2 have "w = v"
      by (auto dest: common_decision)
    with vdifw show False ..
  qed

  have 1: "{qq. sendMsg Ate_M r qq p (rho r qq) = v}
           \<inter> {qq. sendMsg Ate_M (r+k) qq q (rho (r+k) qq) = w} = {}"
    (is "?sentv \<inter> ?sentw = {}")
  proof (rule ccontr)
    assume "\<not> ?thesis"
    then obtain qq
      where xrv: "x (rho r qq) = v" and rkw: "x (rho (r+k) qq) = w"
      by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)
    have "\<exists>k' < k. x (rho (r + k') qq) \<noteq> w \<and> x (rho (r + Suc k') qq) = w"
    proof (rule ccontr)
      assume f: "\<not> ?thesis"
      {
        fix k'
        assume kk':"k' < k" hence "x (rho (r + k') qq) \<noteq> w"
        proof (induct k')
          from xrv vdifw
          show "x (rho (r + 0) qq) \<noteq> w" by simp
        next
          fix k'
          assume ih:"k' < k \<Longrightarrow> x (rho (r + k') qq) \<noteq> w"
             and ksk':"Suc k' < k"
          from ksk' have "k' < k" by simp
          with ih f  show "x (rho (r + Suc k') qq) \<noteq> w" by auto
        qed
      }
      with f have "\<forall>k' < k. x (rho (r + Suc k') qq) \<noteq> w" by auto
      moreover
      from kgt0 have "k - 1 < k" and kk:"Suc (k - 1) = k" by auto
      ultimately
      have "x (rho (r + Suc (k - 1)) qq) \<noteq> w" by blast
      with rkw kk show "False" by simp
    qed
    then obtain k'
      where "k' < k"
        and w: "x (rho (r + Suc k') qq) = w"
        and qqupdatex: "x (rho (r + Suc k') qq) \<noteq> x (rho (r + k') qq)"
      by auto
    from run comm nd1 d1 qqupdatex
    have "x (rho (r + Suc k') qq) = v" by (rule common_x)
    with w vdifw show False by simp
  qed
  from run comm nd1 d1 have sentv: "card ?sentv > E - \<alpha>"
    by (auto dest: decide_sent_msgs_threshold)
  from run comm nd2 d2 have "card ?sentw > E - \<alpha>"
    by (auto dest: decide_sent_msgs_threshold)
  with sentv majE have "(card ?sentv) + (card ?sentw) > N"
    by simp
  with 1 vdifw  have 2: "card (?sentv \<union> ?sentw) > N"
    by (auto simp: card_Un_Int)
  have "card (?sentv \<union> ?sentw) \<le> N"
    by (auto simp: card_mono)
  with 2 show "False" by simp
qed

text \<open>
  The Agreement property is now an immediate consequence.
\<close>
(*
  The proof mainly relies on lemmas @{text decisionNonNullThenDecided}
  and @{text laterProcessDecidesSameValue}.
*)

theorem ate_agreement:
  assumes run: "SHORun Ate_M rho HOs SHOs"
  and comm: "\<forall>r. SHOcommPerRd Ate_M (HOs r) (SHOs r)"
  and p: "decide (rho m p) = Some v"
  and q: "decide (rho n q) = Some w"
  shows "w = v"
proof -
  from run p obtain k where
    k: "k < m" "decide (rho k p) \<noteq> Some v" "decide (rho (Suc k) p) = Some v"
    by (rule decisionNonNullThenDecided)
  from run q obtain l where
    l: "l < n" "decide (rho l q) \<noteq> Some w" "decide (rho (Suc l) q) = Some w"
    by (rule decisionNonNullThenDecided)
  show ?thesis
  proof (cases "k \<le> l")
    case True
    then obtain i where "l = k+i" by (auto simp add: le_iff_add)
    with run comm k l show ?thesis
      by (auto dest: laterProcessDecidesSameValue)
  next
    case False
    hence "l \<le> k" by simp
    then obtain i where m: "k = l+i" by (auto simp add: le_iff_add)
    with run comm k l show ?thesis
      by (auto dest: laterProcessDecidesSameValue)
  qed
qed

subsection \<open>Proof of Termination\<close>

text \<open>
  We now prove that every process must eventually decide, given the
  global and round-by-round communication predicates.
\<close>
(* The proof relies on previous lemmas @{text common_x_induct} and @{text mostOftenRcvd_v}. *)

theorem ate_termination:
  assumes run: "SHORun Ate_M rho HOs SHOs"
  and commR: "\<forall>r. (SHOcommPerRd::((Proc, 'val::linorder pstate, 'val) SHOMachine)
                                     \<Rightarrow> (Proc HO) \<Rightarrow> (Proc HO) \<Rightarrow> bool)
                  Ate_M (HOs r) (SHOs r)"
  and commG: "SHOcommGlobal Ate_M HOs SHOs"
  shows "\<exists>r v. decide (rho r p) = Some v"
proof -
  from commG obtain r' \<pi>1 \<pi>2
    where \<pi>ea: "card \<pi>1 > E - \<alpha>"
      and \<pi>t: "card \<pi>2 > T"
      and  hosho: "\<forall>p \<in> \<pi>1. (HOs r' p = \<pi>2 \<and> SHOs r' p \<inter> HOs r' p = \<pi>2)"
    by (auto simp: Ate_SHOMachine_def Ate_commGlobal_def)

  obtain v where
    P1: "\<forall>pp. card {qq. sendMsg Ate_M (Suc r') qq pp (rho (Suc r') qq) = v} > E - \<alpha>"
  proof -
    have "\<forall>p \<in> \<pi>1. \<forall>q \<in> \<pi>1. x (rho (Suc r') p) = x (rho (Suc r') q)"
    proof (clarify)
      fix p q
      assume p: "p \<in> \<pi>1" and q: "q \<in> \<pi>1"

      from run obtain \<mu>p
        where nxtp: "nextState Ate_M r' p (rho r' p) \<mu>p (rho (Suc r') p)"
          and mup: "\<mu>p \<in> SHOmsgVectors Ate_M r' p (rho r') (HOs r' p) (SHOs r' p)"
        by (auto simp: SHORun_eq SHOnextConfig_eq)

      from run obtain \<mu>q
        where nxtq: "nextState Ate_M r' q (rho r' q) \<mu>q (rho (Suc r') q)"
          and muq: "\<mu>q \<in> SHOmsgVectors Ate_M r' q (rho r') (HOs r' q) (SHOs r' q)"
        by (auto simp: SHORun_eq SHOnextConfig_eq)

      from mup muq p q
      have "{qq. \<mu>q qq \<noteq> None}  = HOs r' q"
        and 2:"{qq. \<mu>q qq = Some (sendMsg Ate_M r' qq q (rho r' qq))}
               \<supseteq> SHOs r' q \<inter> HOs r' q"
        and "{qq. \<mu>p qq \<noteq> None}  = HOs r' p"
        and 4:"{qq. \<mu>p qq = Some (sendMsg Ate_M r' qq p (rho r' qq))}
               \<supseteq> SHOs r' p \<inter> HOs r' p"
        by (auto simp: SHOmsgVectors_def)
      with p q hosho
      have aa:"\<pi>2 = {qq. \<mu>q qq \<noteq> None}"
        and cc:"\<pi>2 = {qq. \<mu>p qq \<noteq> None}" by auto
      from p q hosho 2
      have bb:"{qq. \<mu>q qq = Some (sendMsg Ate_M r' qq q (rho r' qq))} \<supseteq> \<pi>2"
        by auto
      from p q hosho 4
      have dd:"{qq. \<mu>p qq = Some (sendMsg Ate_M r' qq p (rho r' qq))} \<supseteq> \<pi>2"
        by auto
      have "Min (mostOftenRcvd \<mu>p) = Min (mostOftenRcvd \<mu>q)"
      proof -
        have "\<forall>qq. sendMsg Ate_M r' qq p (rho r' qq)
                   = sendMsg Ate_M r' qq q (rho r' qq)"
          by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)
        with aa bb cc dd have "\<forall>qq. \<mu>p qq \<noteq> None \<longrightarrow> \<mu>p qq = \<mu>q qq"
          by force
        moreover
        from aa bb cc dd
        have "{qq. \<mu>p qq \<noteq> None} = {qq. \<mu>q qq \<noteq> None}" by auto
        hence "\<forall>qq. \<mu>p qq = None \<longleftrightarrow> \<mu>q qq = None" by blast
        hence "\<forall>qq. \<mu>p qq = None \<longrightarrow> \<mu>p qq = \<mu>q qq" by auto
        ultimately
        have "\<forall>qq. \<mu>p qq = \<mu>q qq" by blast
        thus ?thesis by (auto simp: mostOftenRcvd_def)
      qed
      with \<pi>t aa nxtq \<pi>t cc nxtp
      show "x (rho (Suc r') p) = x (rho (Suc r') q)"
        by (auto simp: Ate_SHOMachine_def nextState_def Ate_nextState_def)
    qed
    then obtain v where Pv:"\<forall>p \<in> \<pi>1. x (rho (Suc r') p) = v" by blast
    {
      fix pp
      from Pv have "\<forall>p \<in> \<pi>1. sendMsg Ate_M (Suc r') p pp (rho (Suc r') p) = v"
        by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)
      hence "card \<pi>1 \<le> card {qq. sendMsg Ate_M (Suc r') qq pp (rho (Suc r') qq) = v}"
        by (auto intro: card_mono)
      with \<pi>ea
      have "E - \<alpha> < card {qq. sendMsg Ate_M (Suc r') qq pp (rho (Suc r') qq) = v}"
        by simp
    }
    with that show ?thesis by blast
  qed

  {
    fix k pp
    have "E - \<alpha> < card {qq. sendMsg Ate_M (Suc r' + k) qq pp (rho (Suc r' + k) qq) = v}"
      (is "?P k")
    proof (induct k)
      from P1 show "?P 0" by simp
    next
      fix k
      assume ih: "?P k"
      from commR
      have "(SHOcommPerRd::((Proc, 'val::linorder pstate, 'val) SHOMachine)
                               \<Rightarrow> (Proc HO) \<Rightarrow> (Proc HO) \<Rightarrow> bool)
                Ate_M (HOs (Suc r' + k)) (SHOs (Suc r' + k))" ..
      moreover
      from ih have "E - \<alpha> < card {qq. x (rho (Suc r' + k) qq) = v}"
        by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)
      ultimately
      have "E - \<alpha> < card {qq. x (rho (Suc r' + Suc k) qq) = v}"
        by (rule common_x_induct[OF run])
      thus "?P (Suc k)"
        by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)
    qed
  }
  note P2 = this

  {
    fix k pp
    assume ppupdatex: "x (rho (Suc r' + Suc k) pp) \<noteq> x (rho (Suc r' + k) pp)"

    from commR
    have "(SHOcommPerRd::((Proc, 'val::linorder pstate, 'val) SHOMachine)
                            \<Rightarrow> (Proc HO) \<Rightarrow> (Proc HO) \<Rightarrow> bool)
              Ate_M (HOs (Suc r' + k)) (SHOs (Suc r' + k))" ..
    moreover
    from run obtain \<mu>pp
      where nxt:"nextState Ate_M (Suc r' + k) pp (rho (Suc r' + k) pp) \<mu>pp
                           (rho (Suc r' + Suc k) pp)"
        and mu: "\<mu>pp \<in> SHOmsgVectors Ate_M (Suc r' + k) pp (rho (Suc r' + k))
                           (HOs (Suc r' + k) pp) (SHOs (Suc r' + k) pp)"
      by (auto simp: SHORun_eq SHOnextConfig_eq)
    moreover
    from nxt ppupdatex
    have threshold_T: "card {qq. \<mu>pp qq \<noteq> None} > T"
      and xsmall: "x (rho (Suc r' + Suc k) pp) = Min (mostOftenRcvd \<mu>pp)"
      by (auto simp: Ate_SHOMachine_def nextState_def Ate_nextState_def)
    moreover
    from P2
    have "E - \<alpha> < card {qq. sendMsg Ate_M (Suc r' + k) qq pp (rho (Suc r' + k) qq) = v}" .
    ultimately
    have "mostOftenRcvd \<mu>pp = {v}" by (auto dest!: mostOftenRcvd_v)
    with xsmall
    have "x (rho (Suc r' + Suc k) pp) = v" by simp
  }
  note P3 = this

  have P4:"\<forall>pp. \<exists>k. x (rho (Suc r' + Suc k) pp) = v"
  proof
    fix pp
    from commG have "\<exists>r'' > r'. card (HOs r'' pp) > T"
      by (auto simp: Ate_SHOMachine_def Ate_commGlobal_def)
    then obtain k where "Suc r' + k > r'" and t:"card (HOs (Suc r' + k) pp) > T"
      by (auto dest: less_imp_Suc_add)
    moreover
    from run obtain \<mu>pp
      where nxt: "nextState Ate_M (Suc r' + k) pp (rho (Suc r' + k) pp) \<mu>pp
                                  (rho (Suc r' + Suc k) pp)"
        and mu: "\<mu>pp \<in> SHOmsgVectors Ate_M (Suc r' + k) pp (rho (Suc r' + k))
                                  (HOs (Suc r' + k) pp) (SHOs (Suc r' + k) pp)"
      by (auto simp: SHORun_eq SHOnextConfig_eq)
    moreover
    have "x (rho (Suc r' + Suc k) pp) = v"
    proof -
      from commR
      have "(SHOcommPerRd::((Proc, 'val::linorder pstate, 'val::linorder) SHOMachine)
                                \<Rightarrow> (Proc HO) \<Rightarrow> (Proc HO) \<Rightarrow> bool)
                Ate_M (HOs (Suc r' + k)) (SHOs (Suc r' + k))" ..
      moreover
      from mu have "HOs (Suc r' + k) pp = {q. \<mu>pp q \<noteq> None}"
        by (auto simp: SHOmsgVectors_def)
      with nxt t
      have threshold_T: "card {q. \<mu>pp q \<noteq> None} > T"
        and xsmall: "x (rho (Suc r' + Suc k) pp) = Min (mostOftenRcvd \<mu>pp)"
        by (auto simp: Ate_SHOMachine_def nextState_def Ate_nextState_def)
      moreover
      from P2
      have "E - \<alpha> < card {qq. sendMsg Ate_M (Suc r' + k) qq pp (rho (Suc r' + k) qq) = v}" .
      ultimately
      have "mostOftenRcvd \<mu>pp = {v}"
        using nxt mu by (auto dest!: mostOftenRcvd_v)
      with xsmall show ?thesis by auto
    qed
    thus "\<exists>k. x (rho (Suc r' + Suc k) pp) = v" ..
  qed

  have P5a: "\<forall>pp. \<exists>rr. \<forall>k. x (rho (rr + k) pp) = v"
  proof
    fix pp
    from P4 obtain rk where
      xrrv: "x (rho (Suc r' + Suc rk) pp) = v" (is "x (rho ?rr pp) = v")
      by blast
    have "\<forall>k. x (rho (?rr + k) pp) = v"
    proof
      fix k
      show "x (rho (?rr + k) pp) = v"
      proof (induct k)
        from xrrv show "x (rho (?rr + 0) pp) = v" by simp
      next
        fix k
        assume ih: "x (rho (?rr + k) pp) = v"
        obtain k' where rrk: "Suc r' + k' = ?rr + k" by auto
        show "x (rho (?rr + Suc k) pp) = v"
        proof (rule ccontr)
          assume nv: "x (rho (?rr + Suc k) pp) \<noteq> v"
          with rrk ih
          have "x (rho (Suc r' + Suc k') pp) \<noteq> x (rho (Suc r' + k') pp)"
            by (simp add: ac_simps)
          hence "x (rho (Suc r' + Suc k') pp) = v" by (rule P3)
          with rrk nv show False by (simp add: ac_simps)
        qed
      qed
    qed
    thus "\<exists>rr. \<forall>k. x (rho (rr + k) pp) = v" by blast
  qed

  from P5a have "\<exists>F. \<forall>pp k. x (rho (F pp + k) pp) = v" by (rule choice)
  then obtain R::"(Proc \<Rightarrow> nat)"
    where imgR: "R ` (UNIV::Proc set) \<noteq> {}"
      and R: "\<forall>pp k. x (rho (R pp + k) pp) = v"
    by blast
  define rr where "rr = Max (R ` UNIV)"

  have P5: "\<forall>r' > rr. \<forall>pp. x (rho r' pp) = v"
  proof (clarify)
    fix r' pp
    assume r': "r' > rr"
    hence "r' > R pp" by (auto simp: rr_def)
    then obtain i where "r' = R pp + i"
      by (auto dest: less_imp_Suc_add)
    with R show "x (rho r' pp) = v" by auto
  qed

  from commG have "\<exists>r' > rr. card (SHOs r' p \<inter> HOs r' p) > E"
    by (auto simp: Ate_SHOMachine_def Ate_commGlobal_def)
  with P5 obtain r'
    where "r' > rr"
      and "card (SHOs r' p \<inter> HOs r' p) > E"
      and "\<forall>pp. sendMsg Ate_M r' pp p (rho r' pp) = v"
    by (auto simp: Ate_SHOMachine_def Ate_sendMsg_def)
  moreover
  from run obtain \<mu>p
    where nxt: "nextState Ate_M r' p (rho r' p) \<mu>p (rho (Suc r') p)"
      and mu: "\<mu>p \<in> SHOmsgVectors Ate_M r' p (rho r') (HOs r' p) (SHOs r' p)"
    by (auto simp: SHORun_eq SHOnextConfig_eq)
  from mu
  have "card (SHOs r' p \<inter> HOs r' p)
        \<le> card {q. \<mu>p q = Some (sendMsg Ate_M r' q p (rho r' q))}"
    by (auto simp: SHOmsgVectors_def intro: card_mono)
  ultimately
  have threshold_E: "card {q. \<mu>p q = Some v} > E" by auto
  with nxt show ?thesis
    by (auto simp: Ate_SHOMachine_def nextState_def Ate_nextState_def)
qed

subsection \<open>\ate{} Solves Weak Consensus\<close>

text \<open>
  Summing up, all (coarse-grained) runs of \ate{} for
  HO and SHO collections that satisfy the communication predicate
  satisfy the Weak Consensus property.
\<close>

theorem ate_weak_consensus:
  assumes run: "SHORun Ate_M rho HOs SHOs"
      and commR: "\<forall>r. SHOcommPerRd Ate_M (HOs r) (SHOs r)"
      and commG: "SHOcommGlobal Ate_M HOs SHOs"
  shows "weak_consensus (x \<circ> (rho 0)) decide rho"
  unfolding weak_consensus_def using assms
  by (auto elim: ate_validity ate_agreement ate_termination)

text \<open>
  By the reduction theorem, the correctness of the algorithm carries over
  to the fine-grained model of runs.
\<close>

theorem ate_weak_consensus_fg:
  assumes run: "fg_run Ate_M rho HOs SHOs (\<lambda>r q. undefined)"
      and commR: "\<forall>r. SHOcommPerRd Ate_M (HOs r) (SHOs r)"
      and commG: "SHOcommGlobal Ate_M HOs SHOs"
  shows "weak_consensus (\<lambda>p. x (state (rho 0) p)) decide (state \<circ> rho)"
    (is "weak_consensus ?inits _ _")
proof (rule local_property_reduction[OF run weak_consensus_is_local])
  fix crun
  assume crun: "CSHORun Ate_M crun HOs SHOs (\<lambda>r q. undefined)"
     and init: "crun 0 = state (rho 0)"
  from crun have "SHORun Ate_M crun HOs SHOs" by (unfold SHORun_def)
  from this commR commG
  have "weak_consensus (x \<circ> (crun 0)) decide crun"
    by (rule ate_weak_consensus)
  with init show "weak_consensus ?inits decide crun"
    by (simp add: o_def)
qed

end   \<comment> \<open>context @{text "ate_parameters"}\<close>

end   (* theory AteProof *)


(*  Title:      HOL/UNITY/FP.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1998  University of Cambridge

From Misra, "A Logic for Concurrent Programming", 1994
*)

section\<open>Fixed Point of a Program\<close>

theory FP imports UNITY begin

definition FP_Orig :: "'a program => 'a set" where
    "FP_Orig F == \<Union>{A. ALL B. F : stable (A Int B)}"

definition FP :: "'a program => 'a set" where
    "FP F == {s. F : stable {s}}"

lemma stable_FP_Orig_Int: "F : stable (FP_Orig F Int B)"
apply (simp only: FP_Orig_def stable_def Int_Union2)
apply (blast intro: constrains_UN)
done

lemma FP_Orig_weakest:
    "(!!B. F : stable (A Int B)) ==> A <= FP_Orig F"
by (simp add: FP_Orig_def stable_def, blast)

lemma stable_FP_Int: "F : stable (FP F Int B)"
apply (subgoal_tac "FP F Int B = (UN x:B. FP F Int {x}) ")
prefer 2 apply blast
apply (simp (no_asm_simp) add: Int_insert_right)
apply (simp add: FP_def stable_def)
apply (rule constrains_UN)
apply (simp (no_asm))
done

lemma FP_equivalence: "FP F = FP_Orig F"
apply (rule equalityI)
 apply (rule stable_FP_Int [THEN FP_Orig_weakest])
apply (simp add: FP_Orig_def FP_def, clarify)
apply (drule_tac x = "{x}" in spec)
apply (simp add: Int_insert_right)
done

lemma FP_weakest:
    "(!!B. F : stable (A Int B)) ==> A <= FP F"
by (simp add: FP_equivalence FP_Orig_weakest)

lemma Compl_FP:
    "-(FP F) = (UN act: Acts F. -{s. act``{s} <= {s}})"
by (simp add: FP_def stable_def constrains_def, blast)

lemma Diff_FP: "A - (FP F) = (UN act: Acts F. A - {s. act``{s} <= {s}})"
by (simp add: Diff_eq Compl_FP)

lemma totalize_FP [simp]: "FP (totalize F) = FP F"
by (simp add: FP_def)

end


text\<open> 8 October 2021: Exercise for Homework Assignment 06 in CS 511 \<close>
text\<open> Your task to remove the invocation of the pre-defined method blast,
      by an equivalent sequence of 'apply' steps \<close>
text\<open> This is a continuation of the Isabelle exercise you did for
      Homework Assignment 05, and inspired by the exercise on page 32
      in Lecture Slides 11 "Quantified Propositional Logic" \<close>

theory HW06_solution
  imports Main
begin

(* The following is a theorem of QPL. Note that "=" means the same as "\<longleftrightarrow>" *)
theorem "(\<exists>y. (y = Phi) \<and> (y \<or> Psi1) \<and> (y \<or> Psi2)) \<longleftrightarrow> (Phi \<or> Psi1) \<and> (Phi \<or> Psi2)"
  apply (rule iffI)
  apply (erule exE)
  apply (erule conjE)
  apply clarify
  apply (rule exI)
  apply (clarify)
  apply (rule conjI)
  apply (rule iffI)
  apply clarify
  apply assumption
  apply clarify
  apply (rule conjI)
  apply assumption
  apply assumption
  done
end