(*
This file is a part of IsarMathLib -
a library of formalized mathematics for Isabelle/Isar.

Copyright (C) 2008  Slawomir Kolodynski

This program is free software; Redistribution and use in source and binary forms,
with or without modification, are permitted provided that the
following conditions are met:

1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

section \<open>Groups 1\<close>

theory Group_ZF_1 imports Group_ZF

begin

text\<open>In this theory we consider right and left translations and odd
  functions.\<close>

subsection\<open>Translations\<close>

text\<open>In this section we consider translations. Translations are maps
  $T: G\rightarrow G$ of the form $T_g (a) = g\cdot a$ or
  $T_g (a) = a\cdot g$. We also consider two-dimensional translations
  $T_g : G\times G \rightarrow G\times G$, where
  $T_g(a,b) = (a\cdot g, b\cdot g)$ or $T_g(a,b) = (g\cdot a, g\cdot b)$.
\<close>

text\<open>For an element $a\in G$ the right translation is defined
  a function (set of pairs) such that its value (the second element
  of a pair) is the value of the group operation on the first element
  of the pair and $g$. This looks a bit strange in the raw set notation,
  when we write a function explicitely as a set of pairs and value of
  the group operation on the pair $\langle a,b \rangle$
  as \<open>P`\<langle>a,b\<rangle>\<close> instead of the usual infix $a\cdot b$
  or $a + b$.\<close>

definition
  "RightTranslation(G,P,g) \<equiv> {\<langle> a,b\<rangle> \<in> G\<times>G. P`\<langle>a,g\<rangle> = b}"

text\<open>A similar definition of the left translation.\<close>

definition
  "LeftTranslation(G,P,g) \<equiv> {\<langle>a,b\<rangle> \<in> G\<times>G. P`\<langle>g,a\<rangle> = b}"

text\<open>Translations map $G$ into $G$. Two dimensional translations map
  $G\times G$ into itself.\<close>

lemma (in group0) group0_5_L1: assumes A1: "g\<in>G"
  shows "RightTranslation(G,P,g) : G\<rightarrow>G" and  "LeftTranslation(G,P,g) : G\<rightarrow>G"
proof -
  from A1 have "\<forall>a\<in>G. a\<cdot>g \<in> G" and "\<forall>a\<in>G. g\<cdot>a \<in> G"
    using group_oper_fun apply_funtype by auto
  then show
    "RightTranslation(G,P,g) : G\<rightarrow>G"
    "LeftTranslation(G,P,g) : G\<rightarrow>G"
    using RightTranslation_def LeftTranslation_def func1_1_L11A
    by auto
qed

text\<open>The values of the translations are what we expect.\<close>

lemma (in group0) group0_5_L2: assumes "g\<in>G" "a\<in>G"
  shows
  "RightTranslation(G,P,g)`(a) = a\<cdot>g"
  "LeftTranslation(G,P,g)`(a) = g\<cdot>a"
  using assms group0_5_L1 RightTranslation_def LeftTranslation_def
    func1_1_L11B by auto

text\<open>Composition of left translations is a left translation by the product.\<close>

lemma (in group0) group0_5_L4: assumes A1: "g\<in>G" "h\<in>G" "a\<in>G" and
  A2: "T\<^sub>g = LeftTranslation(G,P,g)"  "T\<^sub>h = LeftTranslation(G,P,h)"
  shows
  "T\<^sub>g`(T\<^sub>h`(a)) = g\<cdot>h\<cdot>a"
  "T\<^sub>g`(T\<^sub>h`(a)) = LeftTranslation(G,P,g\<cdot>h)`(a)"
proof -
  from A1 have I: "h\<cdot>a\<in>G"  "g\<cdot>h\<in>G"
    using group_oper_fun apply_funtype by auto
  with A1 A2 show "T\<^sub>g`(T\<^sub>h`(a)) = g\<cdot>h\<cdot>a"
    using group0_5_L2 group_oper_assoc by simp
  with A1 A2 I show
    "T\<^sub>g`(T\<^sub>h`(a)) = LeftTranslation(G,P,g\<cdot>h)`(a)"
    using group0_5_L2 group_oper_assoc by simp
qed

text\<open>Composition of right translations is a right translation by
  the product.\<close>

lemma (in group0) group0_5_L5: assumes A1: "g\<in>G" "h\<in>G" "a\<in>G" and
  A2: "T\<^sub>g = RightTranslation(G,P,g)"  "T\<^sub>h = RightTranslation(G,P,h)"
  shows
 "T\<^sub>g`(T\<^sub>h`(a)) = a\<cdot>h\<cdot>g"
  "T\<^sub>g`(T\<^sub>h`(a)) = RightTranslation(G,P,h\<cdot>g)`(a)"
proof -
  from A1 have I: "a\<cdot>h\<in>G" "h\<cdot>g \<in>G"
    using group_oper_fun apply_funtype by auto
  with A1 A2 show "T\<^sub>g`(T\<^sub>h`(a)) = a\<cdot>h\<cdot>g"
    using group0_5_L2 group_oper_assoc by simp
  with A1 A2 I show
    "T\<^sub>g`(T\<^sub>h`(a)) = RightTranslation(G,P,h\<cdot>g)`(a)"
    using group0_5_L2 group_oper_assoc by simp
qed

text\<open>Point free version of \<open>group0_5_L4\<close> and \<open>group0_5_L5\<close>.\<close>

lemma (in group0) trans_comp: assumes "g\<in>G" "h\<in>G" shows
  "RightTranslation(G,P,g) O RightTranslation(G,P,h) = RightTranslation(G,P,h\<cdot>g)"
  "LeftTranslation(G,P,g) O LeftTranslation(G,P,h) = LeftTranslation(G,P,g\<cdot>h)"
proof -
  let ?T\<^sub>g = "RightTranslation(G,P,g)"
  let ?T\<^sub>h = "RightTranslation(G,P,h)"
  from assms have "?T\<^sub>g:G\<rightarrow>G" and "?T\<^sub>h:G\<rightarrow>G"
    using group0_5_L1 by auto
  then have "?T\<^sub>g O ?T\<^sub>h:G\<rightarrow>G" using comp_fun by simp
  moreover from assms have "RightTranslation(G,P,h\<cdot>g):G\<rightarrow>G"
    using group_op_closed group0_5_L1 by simp
  moreover from assms \<open>?T\<^sub>h:G\<rightarrow>G\<close> have
    "\<forall>a\<in>G. (?T\<^sub>g O ?T\<^sub>h)`(a) = RightTranslation(G,P,h\<cdot>g)`(a)"
    using comp_fun_apply group0_5_L5 by simp
  ultimately show "?T\<^sub>g O ?T\<^sub>h =  RightTranslation(G,P,h\<cdot>g)"
    by (rule func_eq)
next
  let ?T\<^sub>g = "LeftTranslation(G,P,g)"
  let ?T\<^sub>h = "LeftTranslation(G,P,h)"
  from assms have "?T\<^sub>g:G\<rightarrow>G" and "?T\<^sub>h:G\<rightarrow>G"
    using group0_5_L1 by auto
  then have "?T\<^sub>g O ?T\<^sub>h:G\<rightarrow>G" using comp_fun by simp
  moreover from assms have "LeftTranslation(G,P,g\<cdot>h):G\<rightarrow>G"
    using group_op_closed group0_5_L1 by simp
  moreover from assms \<open>?T\<^sub>h:G\<rightarrow>G\<close> have
    "\<forall>a\<in>G. (?T\<^sub>g O ?T\<^sub>h)`(a) = LeftTranslation(G,P,g\<cdot>h)`(a)"
    using comp_fun_apply group0_5_L4 by simp
  ultimately show "?T\<^sub>g O ?T\<^sub>h =  LeftTranslation(G,P,g\<cdot>h)"
    by (rule func_eq)
qed

text\<open>The image of a set under a composition of translations is the same as
  the image under translation by a product.\<close>

lemma (in group0) trans_comp_image: assumes A1: "g\<in>G" "h\<in>G" and
  A2: "T\<^sub>g = LeftTranslation(G,P,g)"  "T\<^sub>h = LeftTranslation(G,P,h)"
shows "T\<^sub>g``(T\<^sub>h``(A)) = LeftTranslation(G,P,g\<cdot>h)``(A)"
proof -
  from A2 have "T\<^sub>g``(T\<^sub>h``(A)) = (T\<^sub>g O T\<^sub>h)``(A)"
    using image_comp by simp
  with assms show ?thesis using trans_comp by simp
qed

text\<open>Another form of the image of a set under a composition of translations\<close>

lemma (in group0) group0_5_L6:
  assumes A1: "g\<in>G" "h\<in>G" and A2: "A\<subseteq>G" and
  A3: "T\<^sub>g = RightTranslation(G,P,g)"  "T\<^sub>h = RightTranslation(G,P,h)"
  shows "T\<^sub>g``(T\<^sub>h``(A)) = {a\<cdot>h\<cdot>g. a\<in>A}"
proof -
  from A2 have "\<forall>a\<in>A. a\<in>G" by auto
  from A1 A3 have "T\<^sub>g : G\<rightarrow>G"  "T\<^sub>h : G\<rightarrow>G"
    using group0_5_L1 by auto
  with assms \<open>\<forall>a\<in>A. a\<in>G\<close> show
    "T\<^sub>g``(T\<^sub>h``(A)) = {a\<cdot>h\<cdot>g. a\<in>A}"
    using func1_1_L15C group0_5_L5 by auto
qed

text\<open>The translation by neutral element is the identity on group.\<close>

lemma (in group0) trans_neutral: shows
  "RightTranslation(G,P,\<one>) = id(G)" and "LeftTranslation(G,P,\<one>) = id(G)"
proof -
  have "RightTranslation(G,P,\<one>):G\<rightarrow>G" and "\<forall>a\<in>G. RightTranslation(G,P,\<one>)`(a) = a"
    using group0_2_L2 group0_5_L1 group0_5_L2  by auto
  then show "RightTranslation(G,P,\<one>) = id(G)" by (rule indentity_fun)
  have "LeftTranslation(G,P,\<one>):G\<rightarrow>G" and "\<forall>a\<in>G. LeftTranslation(G,P,\<one>)`(a) = a"
    using group0_2_L2 group0_5_L1 group0_5_L2  by auto
  then show "LeftTranslation(G,P,\<one>) = id(G)" by (rule indentity_fun)
qed

text\<open>Translation by neutral element does not move sets. \<close>

lemma (in group0) trans_neutral_image: assumes "V\<subseteq>G"
  shows "RightTranslation(G,P,\<one>)``(V) = V" and "LeftTranslation(G,P,\<one>)``(V) = V"
  using assms trans_neutral image_id_same by auto

text\<open>Composition of translations by an element and its inverse is identity.\<close>

lemma (in group0) trans_comp_id: assumes "g\<in>G" shows
  "RightTranslation(G,P,g) O RightTranslation(G,P,g\<inverse>) = id(G)" and
  "RightTranslation(G,P,g\<inverse>) O RightTranslation(G,P,g) = id(G)" and
  "LeftTranslation(G,P,g) O LeftTranslation(G,P,g\<inverse>) = id(G)" and
  "LeftTranslation(G,P,g\<inverse>) O LeftTranslation(G,P,g) = id(G)"
  using assms inverse_in_group trans_comp group0_2_L6 trans_neutral by auto

text\<open>Translations are bijective.\<close>

lemma (in group0) trans_bij: assumes "g\<in>G" shows
  "RightTranslation(G,P,g) \<in> bij(G,G)" and "LeftTranslation(G,P,g) \<in> bij(G,G)"
proof-
  from assms have
    "RightTranslation(G,P,g):G\<rightarrow>G" and
    "RightTranslation(G,P,g\<inverse>):G\<rightarrow>G" and
    "RightTranslation(G,P,g) O RightTranslation(G,P,g\<inverse>) = id(G)"
    "RightTranslation(G,P,g\<inverse>) O RightTranslation(G,P,g) = id(G)"
  using inverse_in_group group0_5_L1 trans_comp_id by auto
  then show "RightTranslation(G,P,g) \<in> bij(G,G)" using fg_imp_bijective by simp
  from assms have
    "LeftTranslation(G,P,g):G\<rightarrow>G" and
    "LeftTranslation(G,P,g\<inverse>):G\<rightarrow>G" and
    "LeftTranslation(G,P,g) O LeftTranslation(G,P,g\<inverse>) = id(G)"
    "LeftTranslation(G,P,g\<inverse>) O LeftTranslation(G,P,g) = id(G)"
    using inverse_in_group group0_5_L1 trans_comp_id by auto
  then show "LeftTranslation(G,P,g) \<in> bij(G,G)" using fg_imp_bijective by simp
qed

text\<open>Converse of a translation is translation by the inverse.\<close>

lemma (in group0) trans_conv_inv: assumes "g\<in>G" shows
  "converse(RightTranslation(G,P,g)) = RightTranslation(G,P,g\<inverse>)" and
  "converse(LeftTranslation(G,P,g)) = LeftTranslation(G,P,g\<inverse>)" and
  "LeftTranslation(G,P,g) = converse(LeftTranslation(G,P,g\<inverse>))" and
  "RightTranslation(G,P,g) = converse(RightTranslation(G,P,g\<inverse>))"
proof -
  from assms have
    "RightTranslation(G,P,g) \<in> bij(G,G)"  "RightTranslation(G,P,g\<inverse>) \<in> bij(G,G)" and
    "LeftTranslation(G,P,g) \<in> bij(G,G)"  "LeftTranslation(G,P,g\<inverse>) \<in> bij(G,G)"
    using trans_bij inverse_in_group by auto
  moreover from assms have
    "RightTranslation(G,P,g\<inverse>) O RightTranslation(G,P,g) = id(G)" and
    "LeftTranslation(G,P,g\<inverse>) O LeftTranslation(G,P,g) = id(G)" and
    "LeftTranslation(G,P,g) O LeftTranslation(G,P,g\<inverse>) = id(G)" and
    "LeftTranslation(G,P,g\<inverse>) O LeftTranslation(G,P,g) = id(G)"
    using trans_comp_id by auto
  ultimately show
    "converse(RightTranslation(G,P,g)) = RightTranslation(G,P,g\<inverse>)" and
    "converse(LeftTranslation(G,P,g)) = LeftTranslation(G,P,g\<inverse>)" and
    "LeftTranslation(G,P,g) = converse(LeftTranslation(G,P,g\<inverse>))" and
    "RightTranslation(G,P,g) = converse(RightTranslation(G,P,g\<inverse>))"
    using comp_id_conv by auto
qed

text\<open>The image of a set by translation is the same as the inverse image by
by the inverse element translation.\<close>

lemma (in group0) trans_image_vimage: assumes "g\<in>G" shows
  "LeftTranslation(G,P,g)``(A) = LeftTranslation(G,P,g\<inverse>)-``(A)" and
  "RightTranslation(G,P,g)``(A) = RightTranslation(G,P,g\<inverse>)-``(A)"
  using assms trans_conv_inv vimage_converse by auto

text\<open>Another way of looking at translations is that they are sections
  of the group operation.\<close>

lemma (in group0) trans_eq_section: assumes "g\<in>G" shows
  "RightTranslation(G,P,g) = Fix2ndVar(P,g)" and
  "LeftTranslation(G,P,g) =  Fix1stVar(P,g)"
proof -
  let ?T = "RightTranslation(G,P,g)"
  let ?F = "Fix2ndVar(P,g)"
  from assms have "?T: G\<rightarrow>G" and "?F: G\<rightarrow>G"
    using group0_5_L1 group_oper_fun fix_2nd_var_fun by auto
  moreover from assms have "\<forall>a\<in>G. ?T`(a) = ?F`(a)"
    using group0_5_L2 group_oper_fun fix_var_val by simp
  ultimately show "?T = ?F" by (rule func_eq)
next
  let ?T = "LeftTranslation(G,P,g)"
  let ?F = "Fix1stVar(P,g)"
  from assms have "?T: G\<rightarrow>G" and "?F: G\<rightarrow>G"
    using group0_5_L1 group_oper_fun fix_1st_var_fun by auto
  moreover from assms have "\<forall>a\<in>G. ?T`(a) = ?F`(a)"
    using group0_5_L2 group_oper_fun fix_var_val by simp
  ultimately show "?T = ?F" by (rule func_eq)
qed

text\<open>A lemma demonstrating what is the left translation of a set\<close>

lemma (in group0) ltrans_image: assumes A1: "V\<subseteq>G" and A2: "x\<in>G"
  shows "LeftTranslation(G,P,x)``(V) = {x\<cdot>v. v\<in>V}"
proof -
  from assms have "LeftTranslation(G,P,x)``(V) = {LeftTranslation(G,P,x)`(v). v\<in>V}"
    using group0_5_L1 func_imagedef by blast
  moreover from assms have "\<forall>v\<in>V. LeftTranslation(G,P,x)`(v) = x\<cdot>v"
    using group0_5_L2 by auto
  ultimately show ?thesis by auto
qed

text\<open>A lemma demonstrating what is the right translation of a set\<close>

lemma (in group0) rtrans_image: assumes A1: "V\<subseteq>G" and A2: "x\<in>G"
  shows "RightTranslation(G,P,x)``(V) = {v\<cdot>x. v\<in>V}"
proof -
  from assms have "RightTranslation(G,P,x)``(V) = {RightTranslation(G,P,x)`(v). v\<in>V}"
    using group0_5_L1 func_imagedef by blast
  moreover from assms have "\<forall>v\<in>V. RightTranslation(G,P,x)`(v) = v\<cdot>x"
    using group0_5_L2 by auto
  ultimately show ?thesis by auto
qed

text\<open>Right and left translations of a set are subsets of the group.
  Interestingly, we do not have to assume the set is a subset of the group. \<close>

lemma (in group0) lrtrans_in_group: assumes "x\<in>G"
  shows "LeftTranslation(G,P,x)``(V) \<subseteq> G" and "RightTranslation(G,P,x)``(V) \<subseteq> G"
proof -
  from assms have "LeftTranslation(G,P,x):G\<rightarrow>G" and "RightTranslation(G,P,x):G\<rightarrow>G"
    using group0_5_L1 by auto
  then show "LeftTranslation(G,P,x)``(V) \<subseteq> G" and "RightTranslation(G,P,x)``(V) \<subseteq> G"
    using func1_1_L6(2) by auto
qed

text\<open>A technical lemma about solving equations with translations.\<close>

lemma (in group0) ltrans_inv_in: assumes A1: "V\<subseteq>G" and A2: "y\<in>G" and
  A3: "x \<in> LeftTranslation(G,P,y)``(GroupInv(G,P)``(V))"
  shows "y \<in> LeftTranslation(G,P,x)``(V)"
proof -
  have "x\<in>G"
  proof -
    from A2 have "LeftTranslation(G,P,y):G\<rightarrow>G" using group0_5_L1 by simp
    then have "LeftTranslation(G,P,y)``(GroupInv(G,P)``(V)) \<subseteq> G"
      using func1_1_L6 by simp
    with A3 show "x\<in>G" by auto
  qed
  have "\<exists>v\<in>V. x = y\<cdot>v\<inverse>"
  proof -
    have "GroupInv(G,P): G\<rightarrow>G" using groupAssum group0_2_T2
      by simp
    with assms obtain z where "z \<in> GroupInv(G,P)``(V)" and "x = y\<cdot>z"
      using func1_1_L6 ltrans_image by auto
    with A1 \<open>GroupInv(G,P): G\<rightarrow>G\<close> show ?thesis using func_imagedef by auto
  qed
  then obtain v where "v\<in>V" and "x = y\<cdot>v\<inverse>" by auto
  with A1 A2 have "y = x\<cdot>v" using inv_cancel_two by auto
  with assms \<open>x\<in>G\<close> \<open>v\<in>V\<close> show ?thesis using ltrans_image by auto
qed

text\<open>We can look at the result of interval arithmetic operation as union of
  left translated sets.\<close>

lemma (in group0) image_ltrans_union: assumes "A\<subseteq>G" "B\<subseteq>G" shows
  "(P {lifted to subsets of} G)`\<langle>A,B\<rangle> = (\<Union>a\<in>A.  LeftTranslation(G,P,a)``(B))"
proof
  from assms have I: "(P {lifted to subsets of} G)`\<langle>A,B\<rangle> = {a\<cdot>b . \<langle>a,b\<rangle> \<in> A\<times>B}"
    using group_oper_fun lift_subsets_explained by simp
  { fix c assume "c \<in> (P {lifted to subsets of} G)`\<langle>A,B\<rangle>"
    with I obtain a b where "c = a\<cdot>b" and "a\<in>A"  "b\<in>B" by auto
    hence "c \<in> {a\<cdot>b. b\<in>B}" by auto
    moreover from assms \<open>a\<in>A\<close> have
      "LeftTranslation(G,P,a)``(B) = {a\<cdot>b. b\<in>B}" using ltrans_image by auto
    ultimately have "c \<in> LeftTranslation(G,P,a)``(B)" by simp
    with \<open>a\<in>A\<close> have "c \<in> (\<Union>a\<in>A.  LeftTranslation(G,P,a)``(B))" by auto
  } thus "(P {lifted to subsets of} G)`\<langle>A,B\<rangle> \<subseteq> (\<Union>a\<in>A.  LeftTranslation(G,P,a)``(B))"
    by auto
  { fix c assume "c \<in> (\<Union>a\<in>A.  LeftTranslation(G,P,a)``(B))"
    then obtain a where "a\<in>A" and "c \<in> LeftTranslation(G,P,a)``(B)"
      by auto
    moreover from assms \<open>a\<in>A\<close> have "LeftTranslation(G,P,a)``(B) = {a\<cdot>b. b\<in>B}"
      using ltrans_image by auto
    ultimately obtain b where "b\<in>B" and "c = a\<cdot>b" by auto
    with I \<open>a\<in>A\<close> have "c \<in> (P {lifted to subsets of} G)`\<langle>A,B\<rangle>" by auto
  } thus "(\<Union>a\<in>A. LeftTranslation(G,P,a)``(B)) \<subseteq> (P {lifted to subsets of} G)`\<langle>A,B\<rangle>"
    by auto
qed

text\<open> The right translation version of \<open>image_ltrans_union\<close> The proof follows the same schema.\<close>

lemma (in group0) image_rtrans_union: assumes "A\<subseteq>G" "B\<subseteq>G" shows
  "(P {lifted to subsets of} G)`\<langle>A,B\<rangle> = (\<Union>b\<in>B.  RightTranslation(G,P,b)``(A))"
proof
  from assms have I: "(P {lifted to subsets of} G)`\<langle>A,B\<rangle> = {a\<cdot>b . \<langle>a,b\<rangle> \<in> A\<times>B}"
    using group_oper_fun lift_subsets_explained by simp
  { fix c assume "c \<in> (P {lifted to subsets of} G)`\<langle>A,B\<rangle>"
    with I obtain a b where "c = a\<cdot>b" and "a\<in>A"  "b\<in>B" by auto
    hence "c \<in> {a\<cdot>b. a\<in>A}" by auto
    moreover from assms \<open>b\<in>B\<close> have
      "RightTranslation(G,P,b)``(A) = {a\<cdot>b. a\<in>A}" using rtrans_image by auto
    ultimately have "c \<in> RightTranslation(G,P,b)``(A)" by simp
    with \<open>b\<in>B\<close> have "c \<in> (\<Union>b\<in>B.  RightTranslation(G,P,b)``(A))" by auto
  } thus "(P {lifted to subsets of} G)`\<langle>A,B\<rangle> \<subseteq> (\<Union>b\<in>B.  RightTranslation(G,P,b)``(A))"
    by auto
  { fix c assume "c \<in> (\<Union>b\<in>B.  RightTranslation(G,P,b)``(A))"
    then obtain b where "b\<in>B" and "c \<in> RightTranslation(G,P,b)``(A)"
      by auto
    moreover from assms \<open>b\<in>B\<close> have "RightTranslation(G,P,b)``(A) = {a\<cdot>b. a\<in>A}"
      using rtrans_image by auto
    ultimately obtain a where "a\<in>A" and "c = a\<cdot>b" by auto
    with I \<open>b\<in>B\<close> have "c \<in> (P {lifted to subsets of} G)`\<langle>A,B\<rangle>" by auto
  } thus "(\<Union>b\<in>B. RightTranslation(G,P,b)``(A)) \<subseteq> (P {lifted to subsets of} G)`\<langle>A,B\<rangle>"
    by auto
qed

text\<open>If the neutral element belongs to a set, then an element of group belongs
  the translation of that set.\<close>

lemma (in group0) neut_trans_elem:
  assumes A1: "A\<subseteq>G" "g\<in>G" and A2: "\<one>\<in>A"
  shows "g \<in> LeftTranslation(G,P,g)``(A)" "g \<in> RightTranslation(G,P,g)``(A)"
proof -
  from assms have "g\<cdot>\<one> \<in> LeftTranslation(G,P,g)``(A)"
    using ltrans_image by auto
  with A1 show "g \<in> LeftTranslation(G,P,g)``(A)" using group0_2_L2 by simp
  from assms have "\<one>\<cdot>g \<in> RightTranslation(G,P,g)``(A)"
    using rtrans_image by auto
  with A1 show "g \<in> RightTranslation(G,P,g)``(A)" using group0_2_L2 by simp
qed

text\<open>The neutral element belongs to the translation of a set by the inverse
  of an element that belongs to it.\<close>

lemma (in group0) elem_trans_neut: assumes A1: "A\<subseteq>G" and A2: "g\<in>A"
  shows "\<one> \<in> LeftTranslation(G,P,g\<inverse>)``(A)" "\<one> \<in> RightTranslation(G,P,g\<inverse>)``(A)"
proof -
  from assms have ginv:"g\<inverse> \<in> G" using inverse_in_group by auto
  with assms have "g\<inverse>\<cdot>g \<in> LeftTranslation(G,P,g\<inverse>)``(A)"
    using ltrans_image by auto
  moreover from assms have "g\<inverse>\<cdot>g = \<one>" using group0_2_L6 by auto
  ultimately show "\<one> \<in> LeftTranslation(G,P,g\<inverse>)``(A)" by simp
  from ginv assms have "g\<cdot>g\<inverse> \<in> RightTranslation(G,P,g\<inverse>)``(A)"
    using rtrans_image by auto
  moreover from assms have "g\<cdot>g\<inverse> = \<one>" using group0_2_L6 by auto
  ultimately show "\<one> \<in> RightTranslation(G,P,g\<inverse>)``(A)" by simp
qed

subsection\<open>Odd functions\<close>

text\<open>This section is about odd functions.\<close>

text\<open>Odd functions are those that commute with the group inverse:
  $f(a^{-1}) = (f(a))^{-1}.$\<close>

definition
  "IsOdd(G,P,f) \<equiv> (\<forall>a\<in>G. f`(GroupInv(G,P)`(a)) = GroupInv(G,P)`(f`(a)) )"

text\<open>Let's see the definition of an odd function in a more readable
  notation.\<close>

lemma (in group0) group0_6_L1:
  shows "IsOdd(G,P,p) \<longleftrightarrow> ( \<forall>a\<in>G. p`(a\<inverse>) = (p`(a))\<inverse> )"
  using IsOdd_def by simp

text\<open>We can express the definition of an odd function in two ways.\<close>

lemma (in group0) group0_6_L2:
  assumes A1: "p : G\<rightarrow>G"
  shows
  "(\<forall>a\<in>G. p`(a\<inverse>) = (p`(a))\<inverse>) \<longleftrightarrow> (\<forall>a\<in>G. (p`(a\<inverse>))\<inverse> = p`(a))"
proof
  assume "\<forall>a\<in>G. p`(a\<inverse>) = (p`(a))\<inverse>"
  with A1 show "\<forall>a\<in>G. (p`(a\<inverse>))\<inverse> = p`(a)"
    using apply_funtype group_inv_of_inv by simp
next assume A2: "\<forall>a\<in>G. (p`(a\<inverse>))\<inverse> = p`(a)"
  { fix a assume "a\<in>G"
    with A1 A2  have
      "p`(a\<inverse>) \<in> G" and "((p`(a\<inverse>))\<inverse>)\<inverse> =  (p`(a))\<inverse>"
    using apply_funtype inverse_in_group by auto
  then have "p`(a\<inverse>) = (p`(a))\<inverse>"
    using group_inv_of_inv by simp
  } then show "\<forall>a\<in>G. p`(a\<inverse>) = (p`(a))\<inverse>" by simp
qed

subsection\<open>Subgroups and interval arithmetic\<close>

text\<open> The section \<open>Binary operations\<close> in the \<open>func_ZF\<close> theory defines the notion of
  "lifting operation to subsets". In short, every binary operation
  $f:X\times X \longrightarrow X $ on a set $X$ defines an operation
  on the subsets of $X$ defined by $F(A,B) = \{ f\langle x,y \rangle | x\in A, y\in B\}$.
  In the group context using multiplicative notation we can write this as
  $H\cdot K = \{ x\cdot y | x\in A, y\in B\}$. Similarly we can define $H^{-1}=\{ x^{-1} | x\in H\}$.
  In this section we study properties of these derived operation and how they relate to the concept
  of subgroups.\<close>

text\<open>The next locale extends the \<open>groups0\<close> locale with notation related to interval arithmetics.\<close>

locale group4 = group0 +
  fixes sdot (infixl "\<sdot>" 70)
  defines sdot_def [simp]: "A\<sdot>B  \<equiv> (P {lifted to subsets of} G)`\<langle>A,B\<rangle>"

  fixes sinv ("_\<sinv> " [90] 91)
  defines sinv_def[simp]: "A\<sinv> \<equiv> GroupInv(G,P)``(A)"

text\<open>The next lemma shows a somewhat more explicit way of defining the product
  of two subsets of a group.\<close>

lemma (in group4) interval_prod: assumes "A\<subseteq>G" "B\<subseteq>G"
  shows "A\<sdot>B =  {x\<cdot>y. \<langle>x,y\<rangle> \<in> A\<times>B}"
  using assms group_oper_fun lift_subsets_explained by auto

text\<open>Product of elements of subsets of the group is in the set product of those subsets\<close>

lemma (in group4) interval_prod_el: assumes "A\<subseteq>G" "B\<subseteq>G" "x\<in>A" "y\<in>B"
  shows "x\<cdot>y \<in> A\<sdot>B"
  using assms interval_prod by auto

text\<open>An alternative definition of a group inverse of a set.\<close>

lemma (in group4) interval_inv: assumes "A\<subseteq>G"
  shows "A\<sinv> = {x\<inverse>.x\<in>A}"
proof -
  from groupAssum have "GroupInv(G,P):G\<rightarrow>G" using group0_2_T2 by simp
  with assms show "A\<sinv> = {x\<inverse>.x\<in>A}" using func_imagedef by simp
qed

text\<open>Group inverse of a set is a subset of the group.
  Interestingly we don't need to assume the set is a subset of the group.\<close>

lemma (in group4) interval_inv_cl: shows "A\<sinv> \<subseteq> G"
proof -
  from groupAssum have "GroupInv(G,P):G\<rightarrow>G" using group0_2_T2 by simp
  then show "A\<sinv> \<subseteq> G" using func1_1_L6(2) by simp
qed

text\<open>The product of two subsets of a group is a subset of the group.\<close>

lemma (in group4) interval_prod_closed: assumes "A\<subseteq>G" "B\<subseteq>G"
  shows "A\<sdot>B \<subseteq> G"
proof
  fix z assume "z \<in> A\<sdot>B"
  with assms obtain x y where "x\<in>A" "y\<in>B" "z=x\<cdot>y" using interval_prod by auto
  with assms show "z\<in>G" using group_op_closed by auto
qed

text\<open> The product of sets operation is associative.\<close>

lemma (in group4) interval_prod_assoc: assumes "A\<subseteq>G" "B\<subseteq>G" "C\<subseteq>G"
  shows "A\<sdot>B\<sdot>C = A\<sdot>(B\<sdot>C)"
proof -
  from groupAssum have "(P {lifted to subsets of} G) {is associative on} Pow(G)"
    unfolding IsAgroup_def IsAmonoid_def using lift_subset_assoc by simp
  with assms show ?thesis unfolding IsAssociative_def by auto
qed

text\<open> A simple rearrangement following from associativity of the product of sets operation.\<close>

lemma (in group4) interval_prod_rearr1: assumes "A\<subseteq>G" "B\<subseteq>G" "C\<subseteq>G" "D\<subseteq>G"
  shows "A\<sdot>B\<sdot>(C\<sdot>D) = A\<sdot>(B\<sdot>C)\<sdot>D"
proof -
  from assms(1,2) have "A\<sdot>B \<subseteq> G" using interval_prod_closed by simp
  with assms(3,4) have "A\<sdot>B\<sdot>(C\<sdot>D) = A\<sdot>B\<sdot>C\<sdot>D"
    using interval_prod_assoc by simp
  also from assms(1,2,3) have "A\<sdot>B\<sdot>C\<sdot>D = A\<sdot>(B\<sdot>C)\<sdot>D"
    using interval_prod_assoc by simp
  finally show ?thesis by simp
qed

text\<open>A subset $A$ of the group is closed with respect to the group operation
  iff $A\cdot A \subseteq A$. \<close>

lemma (in group4) subset_gr_op_cl: assumes "A\<subseteq>G"
  shows "(A {is closed under} P) \<longleftrightarrow> A\<sdot>A \<subseteq> A"
proof
  assume "A {is closed under} P"
  { fix z assume "z \<in> A\<sdot>A"
    with assms obtain x y where "x\<in>A" "y\<in>A" and "z=x\<cdot>y" using interval_prod by auto
    with \<open>A {is closed under} P\<close> have "z\<in>A" unfolding IsOpClosed_def by simp
  } thus "A\<sdot>A \<subseteq> A" by auto
next
  assume "A\<sdot>A \<subseteq> A"
  { fix x y assume "x\<in>A" "y\<in>A"
    with assms have "x\<cdot>y \<in> A\<sdot>A" using interval_prod by auto
    with \<open>A\<sdot>A \<subseteq> A\<close> have "x\<cdot>y \<in> A" by auto
  } then show "A {is closed under} P" unfolding IsOpClosed_def by simp
qed

text\<open>Inverse and square of a subgroup is this subgroup.\<close>

lemma (in group4) subgroup_inv_sq: assumes "IsAsubgroup(H,P)"
   shows "H\<sinv> = H" and "H\<sdot>H = H"
proof
  from assms have "H\<subseteq>G" using group0_3_L2 by simp
  with assms show "H\<sinv> \<subseteq> H" using interval_inv group0_3_T3A by auto
  { fix x assume "x\<in>H"
    with assms have "(x\<inverse>)\<inverse> \<in> {y\<inverse>.y\<in>H}" using group0_3_T3A by auto
    moreover from \<open>x\<in>H\<close> \<open>H\<subseteq>G\<close> have "(x\<inverse>)\<inverse> = x" using group_inv_of_inv by auto
    ultimately have "x \<in> {y\<inverse>.y\<in>H}" by auto
    with \<open>H\<subseteq>G\<close> have "x \<in> H\<sinv>" using interval_inv by simp
  } thus "H \<subseteq> H\<sinv>" by auto
  from assms have "H {is closed under} P" using group0_3_L6 unfolding IsOpClosed_def by simp
  with assms have "H\<sdot>H \<subseteq> H" using subset_gr_op_cl group0_3_L2 by simp
  moreover
  { fix x assume "x\<in>H"
    with assms have "x\<in>G" using group0_3_L2 by auto
    from assms \<open>H\<subseteq>G\<close> \<open>x\<in>H\<close> have "x\<cdot>\<one> \<in> H\<sdot>H" using group0_3_L5 interval_prod by auto
    with \<open>x\<in>G\<close> have "x \<in> H\<sdot>H" using group0_2_L2 by simp
  } hence "H \<subseteq> H\<sdot>H" by auto
  ultimately show "H\<sdot>H = H" by auto
qed

text\<open>Inverse of a product two sets is a product of inverses with the reversed order.\<close>

lemma (in group4) interval_prod_inv: assumes "A\<subseteq>G" "B\<subseteq>G"
  shows
    "(A\<sdot>B)\<sinv> = {(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}"
    "(A\<sdot>B)\<sinv> = {y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}"
    "(A\<sdot>B)\<sinv> = (B\<sinv>)\<sdot>(A\<sinv>)"
proof -
  from assms have "(A\<sdot>B) \<subseteq> G" using interval_prod_closed by simp
  then have I: "(A\<sdot>B)\<sinv> = {z\<inverse>.z\<in>A\<sdot>B}" using interval_inv by simp
  show II: "(A\<sdot>B)\<sinv> = {(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}"
  proof
    { fix p assume "p \<in> (A\<sdot>B)\<sinv>"
      with I obtain z where "p=z\<inverse>" and "z\<in>A\<sdot>B" by auto
      with assms obtain x y where "\<langle>x,y\<rangle> \<in> A\<times>B" and "z=x\<cdot>y" using interval_prod by auto
      with \<open>p=z\<inverse>\<close> have "p\<in>{(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}" by auto
    } thus "(A\<sdot>B)\<sinv> \<subseteq> {(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}" by blast
    { fix p assume "p\<in>{(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}"
      then obtain x y where "x\<in>A" "y\<in>B" and "p=(x\<cdot>y)\<inverse>" by auto
      with assms \<open>(A\<sdot>B) \<subseteq> G\<close> have "p\<in>(A\<sdot>B)\<sinv>" using interval_prod interval_inv
        by auto
    } thus "{(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B} \<subseteq> (A\<sdot>B)\<sinv>" by blast
  qed
  have "{(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B} = {y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}"
  proof
    { fix p assume "p \<in> {(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}"
      then obtain x y where "x\<in>A" "y\<in>B" and "p=(x\<cdot>y)\<inverse>" by auto
      with assms have "y\<inverse>\<cdot>x\<inverse> = (x\<cdot>y)\<inverse>" using group_inv_of_two by auto
      with \<open>p=(x\<cdot>y)\<inverse>\<close> have "p = y\<inverse>\<cdot>x\<inverse>" by simp
      with \<open>x\<in>A\<close> \<open>y\<in>B\<close> have "p\<in>{y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}" by auto
    } thus "{(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B} \<subseteq> {y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}" by blast
    { fix p assume "p\<in>{y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}"
      then obtain x y where "x\<in>A" "y\<in>B" and "p=y\<inverse>\<cdot>x\<inverse>" by auto
      with assms have "p = (x\<cdot>y)\<inverse>" using group_inv_of_two by auto
      with \<open>x\<in>A\<close> \<open>y\<in>B\<close> have "p \<in> {(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}" by auto
    } thus "{y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B} \<subseteq> {(x\<cdot>y)\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}" by blast
  qed
  with II show III: "(A\<sdot>B)\<sinv> = {y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}" by simp
  have "{y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B} = (B\<sinv>)\<sdot>(A\<sinv>)"
  proof
    { fix p assume "p\<in>{y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}"
      then obtain x y where "x\<in>A" "y\<in>B" and "p=y\<inverse>\<cdot>x\<inverse>" by auto
      with assms have "y\<inverse> \<in> (B\<sinv>)" and "x\<inverse> \<in> (A\<sinv>)"
        using interval_inv by auto
      with \<open>p=y\<inverse>\<cdot>x\<inverse>\<close> have "p \<in> (B\<sinv>)\<sdot>(A\<sinv>)" using interval_inv_cl interval_prod
        by auto
    } thus "{y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B} \<subseteq> (B\<sinv>)\<sdot>(A\<sinv>)" by blast
    { fix p assume "p \<in> (B\<sinv>)\<sdot>(A\<sinv>)"
      then obtain y x where "y\<in>B\<sinv>" "x\<in>A\<sinv>" and "p=y\<cdot>x"
        using interval_inv_cl interval_prod by auto
      with assms obtain x\<^sub>1 y\<^sub>1 where "x\<^sub>1 \<in> A" "y\<^sub>1 \<in> B" and "x=x\<^sub>1\<inverse>" "y=y\<^sub>1\<inverse>" using interval_inv
        by auto
      with \<open>p=y\<cdot>x\<close> have "p \<in> {y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}" by auto
    } thus "(B\<sinv>)\<sdot>(A\<sinv>) \<subseteq> {y\<inverse>\<cdot>x\<inverse>.\<langle>x,y\<rangle> \<in> A\<times>B}" by blast
  qed
  with III show "(A\<sdot>B)\<sinv> = (B\<sinv>)\<sdot>(A\<sinv>)" by simp
qed

text\<open> If $H,K$ are subgroups then $H\cdot K$ is a subgroup iff $H\cdot K = K\cdot H$. \<close>

theorem (in group4) prod_subgr_subgr:
  assumes "IsAsubgroup(H,P)" and "IsAsubgroup(K,P)"
  shows "IsAsubgroup(H\<sdot>K,P) \<longleftrightarrow>  H\<sdot>K = K\<sdot>H"
proof
  assume "IsAsubgroup(H\<sdot>K,P)"
  then have "(H\<sdot>K)\<sinv> = H\<sdot>K" using subgroup_inv_sq(1) by simp
  with assms show "H\<sdot>K = K\<sdot>H" using group0_3_L2 interval_prod_inv subgroup_inv_sq(1)
    by auto
next
  from assms have "H\<subseteq>G" and "K\<subseteq>G" using group0_3_L2 by auto
  have I: "H\<sdot>K \<noteq> 0"
  proof -
    let ?x = "\<one>" let ?y = "\<one>"
    from assms have "?x\<cdot>?y \<in> (H\<sdot>K)" using group0_3_L5 group0_3_L2 interval_prod
      by auto
    thus ?thesis by auto
  qed
  from \<open>H\<subseteq>G\<close> \<open>K\<subseteq>G\<close> have II: "H\<sdot>K \<subseteq> G" using interval_prod_closed by simp
  assume "H\<sdot>K = K\<sdot>H"
  have III: "(H\<sdot>K){is closed under} P"
  proof -
    have "(H\<sdot>K)\<sdot>(H\<sdot>K) = H\<sdot>K"
    proof -
      from \<open>H\<subseteq>G\<close> \<open>K\<subseteq>G\<close> have "(H\<sdot>K)\<sdot>(H\<sdot>K) = H\<sdot>(K\<sdot>H)\<sdot>K"
        using interval_prod_rearr1 by simp
      also from \<open>H\<sdot>K = K\<sdot>H\<close> have "... = H\<sdot>(H\<sdot>K)\<sdot>K" by simp
      also from \<open>H\<subseteq>G\<close> \<open>K\<subseteq>G\<close> have "... = (H\<sdot>H)\<sdot>(K\<sdot>K)"
        using interval_prod_rearr1 by simp
      also from assms have "... = H\<sdot>K" using subgroup_inv_sq(2) by simp
      finally show ?thesis by simp
    qed
    with \<open>H\<sdot>K \<subseteq> G\<close> show ?thesis using subset_gr_op_cl by simp
  qed
  have IV: "\<forall>x \<in> H\<sdot>K. x\<inverse> \<in> H\<sdot>K"
  proof -
    { fix x assume "x \<in> H\<sdot>K"
      with \<open>H\<sdot>K \<subseteq> G\<close> have "x\<inverse> \<in> (H\<sdot>K)\<sinv>" using interval_inv by auto
      with assms \<open>H\<subseteq>G\<close> \<open>K\<subseteq>G\<close> \<open>H\<sdot>K = K\<sdot>H\<close> have "x\<inverse> \<in> H\<sdot>K"
        using interval_prod_inv subgroup_inv_sq(1) by simp
    } thus ?thesis by auto
  qed
  from I II III IV show "IsAsubgroup(H\<sdot>K,P)" using group0_3_T3 by simp
qed

end


(*  Title:       Conflict analysis/Acquisition histories
    Author:      Peter Lammich <peter.lammich@uni-muenster.de>
    Maintainer:  Peter Lammich <peter.lammich@uni-muenster.de>
*)
header "Acquisition Histories"
theory AcquisitionHistory
imports ConsInterleave
begin
text_raw {*\label{thy:AcquisitionHistory}*}

text {* The concept of {\em acquisition histories} was introduced by Kahlon, Ivancic, and Gupta \cite{KIG05} as a bounded size abstraction of executions that acquire and release locks that contains enough information
  to decide consistent interleavability. In this work, we use this concept for reentrant monitors.
  As in Section~\ref{thy:ConsInterleave}, we encode monitor usage information in pairs of sets of monitors, and regard lists of such pairs as (abstract) executions.
  An item @{term "(E,U)"} of such a list describes a sequence of steps of the concrete execution that first enters the monitors in @{term E} and then passes through the monitors in @{term U}. The monitors in @{term E} are
  never left by the execution. Note that due to the syntactic binding of monitors to the program structure, any execution of a single thread can be abstracted to a sequence of @{term "(E,U)"}-pairs.
  Restricting the possible schedules (see Section \ref{thy:Normalization}) will allow us to also abstract executions reaching a single program point to a sequence of such pairs.

  We want to decide whether two executions are interleavable. The key observation of \cite{KIG05} is, that two executions @{term "e"} and @{term "e'"} are {\em not} interleavable if and only if
  there is a conflicting pair @{term "(m,m')"} of monitors, such that @{term e} enters (and never leaves) @{term m} and then uses @{term m'} and @{term e'} enters (and never leaves) @{term m'} and then uses @{term m}.

  An acquisition history is a map from monitors to set of monitors. The acquisition history of an execution maps a monitor @{term m} that is allocated at the end of the execution to all monitors that are used after or in the
  same step that finally enters @{term m}. Monitors that are not allocated at the end of an execution are mapped to the empty set. Though originally used for a setting without reentrant monitors, acquisition histories also work
  for our setting with reentrant monitors.

  This theory contains the definition of acquisition histories and acquisition history interleavability, an ordering on acquisition histories that reflects the blocking potential of acquisition histories,
  and a mapping function from paths to acquisition histories that is shown to be compatible with monitor consistent interleaving.  *}

subsection "Definitions"
text {* Acquisition histories are modeled as functions from monitors to sets of monitors. Intuitively @{term "m'\<in>h m"} models that an execution finally is in @{term m}, and monitor @{term m'} has been used (i.e. passed or entered)
  after or at the same time @{term m} has been finally entered. By convention, we have @{term "m\<in>h m"} or @{term "h m = {}"}.
*}

  (* TODO: Make acquisition histories an own type, with access and update operator of sort order  *)
definition "ah == { (h::'m \<Rightarrow> 'm set) . \<forall> m. h m = {} \<or> m\<in>h m }"

lemma ah_cases[cases set]: "\<lbrakk>h\<in>ah; h m = {} \<Longrightarrow> P ; m \<in> h m \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (unfold ah_def) blast

subsection "Interleavability"
text {* Two acquisition histories @{term h1} and @{term h2} are considered interleavable, iff there is no conflicting pair of monitors @{term m1} and @{term m2},
  where a pair of monitors @{term m1} and @{term m2} is called {\em conflicting} iff @{term m1} is used in @{term h2} after entering @{term m2} and, vice versa, @{term m2} is used in @{term h1} after entering @{term m1}. *}
definition
  ah_il :: "('m \<Rightarrow> 'm set) \<Rightarrow> ('m \<Rightarrow> 'm set) \<Rightarrow> bool" (infix "[*]" 65)
  where
  "h1 [*] h2 == \<not>(\<exists>m1 m2. m1\<in>h2 m2 \<and> m2 \<in> h1 m1)"

text {* From our convention, it follows (as expected) that the sets of entered monitors (lock-sets) of two interleavable acquisition histories are disjoint *}
lemma ah_il_lockset_disjoint:
  "\<lbrakk> h1\<in>ah; h2\<in>ah; h1 [*] h2 \<rbrakk> \<Longrightarrow> h1 m = {} \<or> h2 m = {}"
  by (unfold ah_il_def) (auto elim: ah_cases)

text {* Of course, acquisition history interleavability is commutative *}
lemma ah_il_commute: "h1 [*] h2 \<Longrightarrow> h2 [*] h1"
  by (unfold ah_il_def) auto

subsection "Used monitors"
text {* Let's define the monitors of an acquisition history, as all monitors that occur in the acquisition history *}
definition
  mon_ah :: "('m \<Rightarrow> 'm set) \<Rightarrow> 'm set"
  where
  "mon_ah h == \<Union>{ h(m) | m. True}"

subsection "Ordering"
text {* The element-wise subset-ordering on acquisition histories intuitively reflects the blocking potential: The bigger the acquisition history, the fewer acquisition histories are interleavable with it.*}
text {* Note that the Isabelle standard library automatically lifts the subset ordering to functions, so we need no explicit definition here. *}

-- {* The ordering is compatible with interleavability, i.e.\ smaller acquisition histories are more likely to be interleavable. *}
lemma ah_leq_il: "\<lbrakk> h1 [*] h2; h1' \<le> h1; h2' \<le> h2 \<rbrakk> \<Longrightarrow> h1' [*] h2'"
  by (unfold ah_il_def le_fun_def [where 'b="'a set"]) blast+
lemma ah_leq_il_left: "\<lbrakk> h1 [*] h2; h1' \<le> h1 \<rbrakk> \<Longrightarrow> h1' [*] h2" and
      ah_leq_il_right: "\<lbrakk> h1 [*] h2; h2' \<le> h2 \<rbrakk> \<Longrightarrow> h1 [*] h2'"
  by (unfold ah_il_def le_fun_def [where 'b="'a set"]) blast+

subsection "Acquisition histories of executions"
text {* Next we define a function that abstracts from executions (lists of enter/use pairs) to acquisition histories *}
primrec \<alpha>ah :: "('m set \<times> 'm set) list \<Rightarrow> 'm \<Rightarrow> 'm set" where
  "\<alpha>ah [] m = {}"
| "\<alpha>ah (e#w) m = (if m\<in>fst e then fst e \<union> snd e \<union> mon_pl w else \<alpha>ah w m)"

-- {* @{term \<alpha>ah} generates valid acquisition histories *}
lemma \<alpha>ah_ah: "\<alpha>ah w \<in> ah"
  apply (induct w)
  apply (unfold ah_def)
  apply simp
  apply (fastforce split: split_if_asm)
  done

lemma \<alpha>ah_hd: "\<lbrakk>m\<in>fst e; x\<in>fst e \<union> snd e \<union> mon_pl w\<rbrakk> \<Longrightarrow> x\<in>\<alpha>ah (e#w) m"
  by auto
lemma \<alpha>ah_tl: "\<lbrakk>m\<notin>fst e; x\<in>\<alpha>ah w m\<rbrakk> \<Longrightarrow> x\<in>\<alpha>ah (e#w) m"
  by auto

lemma \<alpha>ah_cases[cases set, case_names hd tl]: "\<lbrakk>
    x\<in>\<alpha>ah w m;
    !!e w'. \<lbrakk>w=e#w'; m\<in>fst e; x\<in>fst e \<union> snd e \<union> mon_pl w'\<rbrakk> \<Longrightarrow> P;
    !!e w'. \<lbrakk>w=e#w'; m\<notin>fst e; x\<in>\<alpha>ah w' m\<rbrakk> \<Longrightarrow> P
  \<rbrakk> \<Longrightarrow> P"
  by (cases w) (simp_all split: split_if_asm)

lemma \<alpha>ah_cons_cases[cases set, case_names hd tl]: "\<lbrakk>
    x\<in>\<alpha>ah (e#w') m;
    \<lbrakk>m\<in>fst e; x\<in>fst e \<union> snd e \<union> mon_pl w'\<rbrakk> \<Longrightarrow> P;
    \<lbrakk>m\<notin>fst e; x\<in>\<alpha>ah w' m\<rbrakk> \<Longrightarrow> P
  \<rbrakk> \<Longrightarrow> P"
  by (simp_all split: split_if_asm)

lemma mon_ah_subset: "mon_ah (\<alpha>ah w) \<subseteq> mon_pl w"
  by (induct w) (auto simp add: mon_ah_def)

-- {* Subwords generate smaller acquisition histories *}
lemma \<alpha>ah_ileq: "w1\<preceq>w2 \<Longrightarrow> \<alpha>ah w1 \<le> \<alpha>ah w2"
proof (induct rule: less_eq_list_induct)
  case empty thus ?case by (unfold le_fun_def [where 'b="'a set"], simp)
next
  case (drop l' l a) show ?case
  proof (unfold le_fun_def  [where 'b="'a set"], intro allI subsetI)
    fix m x
    assume A: "x \<in> \<alpha>ah l' m"
    with drop(2) have "x\<in>\<alpha>ah l m" by (unfold le_fun_def  [where 'b="'a set"], auto)
    moreover hence "x\<in>mon_pl l" using mon_ah_subset[unfolded mon_ah_def] by fast
    ultimately show "x\<in>\<alpha>ah (a # l) m" by auto
  qed
next
  case (take a b l' l) show ?case
  proof (unfold le_fun_def [where 'b="'a set"], intro allI subsetI)
    fix m x
    assume A: "x\<in>\<alpha>ah (a#l') m"
    thus "x \<in> \<alpha>ah (b # l) m"
    proof (cases rule: \<alpha>ah_cons_cases)
      case hd
      with mon_pl_ileq[OF take.hyps(2)] and `a = b`
      show ?thesis by auto
    next
      case tl
      with take.hyps(3)[unfolded le_fun_def [where 'b="'a set"]] and `a = b`
      show ?thesis by auto
    qed
  qed
qed

text {* We can now prove the relation of monitor consistent interleavability and interleavability of the acquisition histories. *}
lemma ah_interleavable1:
  "w \<in> w1 \<otimes>\<^bsub>\<alpha>\<^esub> w2 \<Longrightarrow> \<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> w2)"
  -- "The lemma is shown by induction on the structure of the monitor consistent interleaving operator"
proof (induct w \<alpha> w1 w2 rule: cil_set_induct_fix\<alpha>)
  case empty show ?case by (simp add: ah_il_def) -- {* The base case is trivial by the definition of @{term "op [*]"} *}
next
  -- "Case: First step comes from the left word"
  case (left e w' w1' w2) show ?case
  proof (rule ccontr) -- "We do a proof by contradiction"
    -- "Assume there is a conflicting pair in the acquisition histories"
    assume "\<not> \<alpha>ah (map \<alpha> (e # w1')) [*] \<alpha>ah (map \<alpha> w2)"
    then obtain m1 m2 where CPAIR: "m1 \<in> \<alpha>ah (map \<alpha> (e#w1')) m2" "m2 \<in> \<alpha>ah (map \<alpha> w2) m1" by (unfold ah_il_def, blast)
    -- "It comes either from the first step or not"
    from CPAIR(1) have "(m2\<in>fst (\<alpha> e) \<and> m1 \<in> fst (\<alpha> e) \<union> snd (\<alpha> e) \<union> mon_pl (map \<alpha> w1')) \<or> (m2\<notin>fst (\<alpha> e) \<and> m1 \<in> \<alpha>ah (map \<alpha> w1') m2)" (is "?CASE1 \<or> ?CASE2")
      by (auto split: split_if_asm)
    moreover {
      -- "Case: One monitor of the conflicting pair is entered in the first step of the left path"
      assume ?CASE1 hence C: "m2\<in>fst (\<alpha> e)" ..
      -- "Because the paths are consistently interleavable, the monitors entered in the first step must not occur in the other path"
      from left(2) mon_ah_subset[of "map \<alpha> w2"] have "fst (\<alpha> e) \<inter> mon_ah (\<alpha>ah (map \<alpha> w2)) = {}" by auto
      -- "But this is a contradiction to being a conflicting pair"
      with C CPAIR(2) have False by (unfold mon_ah_def, blast)
    } moreover {
      -- "Case: The first monitor of the conflicting pair is entered after the first step of the left path"
      assume ?CASE2 hence C: "m1 \<in> \<alpha>ah (map \<alpha> w1') m2" ..
      -- "But this is a contradiction to the induction hypothesis, that says that the acquisition histories of the tail of the left path and the
        right path are interleavable"
      with left(3) CPAIR(2) have False by (unfold ah_il_def, blast)
    } ultimately show False ..
  qed
next
  -- "Case: First step comes from the right word. This case is shown completely analogous"
  case (right e w' w2' w1) show ?case
  proof (rule ccontr)
    assume "\<not> \<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> (e#w2'))"
    then obtain m1 m2 where CPAIR: "m1 \<in> \<alpha>ah (map \<alpha> w1) m2" "m2 \<in> \<alpha>ah (map \<alpha> (e#w2')) m1" by (unfold ah_il_def, blast)
    from CPAIR(2) have "(m1\<in>fst (\<alpha> e) \<and> m2 \<in> fst (\<alpha> e) \<union> snd (\<alpha> e) \<union> mon_pl (map \<alpha> w2')) \<or> (m1\<notin>fst (\<alpha> e) \<and> m2 \<in> \<alpha>ah (map \<alpha> w2') m1)" (is "?CASE1 \<or> ?CASE2")
      by (auto split: split_if_asm)
    moreover {
      assume ?CASE1 hence C: "m1\<in>fst (\<alpha> e)" ..
      from right(2) mon_ah_subset[of "map \<alpha> w1"] have "fst (\<alpha> e) \<inter> mon_ah (\<alpha>ah (map \<alpha> w1)) = {}" by auto
      with C CPAIR(1) have False by (unfold mon_ah_def, blast)
    } moreover {
      assume ?CASE2 hence C: "m2 \<in> \<alpha>ah (map \<alpha> w2') m1" ..
      with right(3) CPAIR(1) have False by (unfold ah_il_def, blast)
    } ultimately show False ..
  qed
qed

lemma ah_interleavable2:
  assumes A: "\<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> w2)"
  shows "w1 \<otimes>\<^bsub>\<alpha>\<^esub> w2 \<noteq> {}"
  -- "This lemma is shown by induction on the sum of the word lengths"
proof -
  -- "To apply this induction in Isabelle, we have to rewrite the lemma a bit"
  { fix n
    have "!!w1 w2. \<lbrakk>\<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> w2); n=length w1 + length w2\<rbrakk> \<Longrightarrow> w1 \<otimes>\<^bsub>\<alpha>\<^esub> w2 \<noteq> {}"
    proof (induct n rule: nat_less_induct[case_names I])
      -- "We first rule out the cases that one of the words is empty"
      case (I n w1 w2) show ?case proof (cases w1)
        -- "If the first word is empty, the lemma is trivial"
        case Nil with I.prems show ?thesis by simp
      next
        case (Cons e1 w1') note CONS1=this show ?thesis proof (cases w2)
          -- "If the second word is empty, the lemma is also trivial"
          case Nil with I.prems show ?thesis by simp
        next
          -- "The interesting case is if both words are not empty"
          case (Cons e2 w2') note CONS2=this
          -- {* In this case, we check whether the first step of one of the words can safely be executed without blocking any steps of the other word *}
          show ?thesis proof (cases "fst (\<alpha> e1) \<inter> mon_pl (map \<alpha> w2) = {}")
            case True -- "The first step of the first word can safely be executed"
            -- "From the induction hypothesis, we get that there is a consistent interleaving of the rest of the first word and the second word"
            have "w1'\<otimes>\<^bsub>\<alpha>\<^esub>w2 \<noteq> {}" proof -
              from I.prems(1) CONS1 ah_leq_il_left[OF _ \<alpha>ah_ileq[OF le_list_map, OF less_eq_list_drop[OF order_refl]]] have "\<alpha>ah (map \<alpha> w1') [*] \<alpha>ah (map \<alpha> w2)" by fast
              moreover from CONS1 I.prems(2) have "length w1'+length w2 < n" by simp
              ultimately show ?thesis using I.hyps by blast
            qed
            -- "And because the first step of the first word can be safely executed, we can prepend it to that consistent interleaving"
            with cil_cons1[OF _ True] CONS1 show ?thesis by blast
          next
            case False note C1=this
            show ?thesis proof (cases "fst (\<alpha> e2) \<inter> mon_pl (map \<alpha> w1) = {}")
              case True -- "The first step of the second word can safely be executed"
              -- "This case is shown analogously to the latter one"
              have "w1\<otimes>\<^bsub>\<alpha>\<^esub>w2' \<noteq> {}" proof -
                from I.prems(1) CONS2 ah_leq_il_right[OF _ \<alpha>ah_ileq[OF le_list_map, OF less_eq_list_drop[OF order_refl]]] have "\<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> w2')" by fast
                moreover from CONS2 I.prems(2) have "length w1+length w2' < n" by simp
                ultimately show ?thesis using I.hyps by blast
              qed
              with cil_cons2[OF _ True] CONS2 show ?thesis by blast
            next
              case False note C2=this -- "Neither first step can safely be executed. This is exactly the situation from that we can extract a conflicting pair"
              from C1 C2 obtain m1 m2 where "m1\<in>fst (\<alpha> e1)" "m1\<in>mon_pl (map \<alpha> w2)" "m2\<in>fst (\<alpha> e2)" "m2\<in>mon_pl (map \<alpha> w1)" by blast
              with CONS1 CONS2 have "m2 \<in> \<alpha>ah (map \<alpha> w1) m1" "m1 \<in> \<alpha>ah (map \<alpha> w2) m2" by auto
              -- "But by assumption, there are no conflicting pairs, thus we get a contradiction"
              with I.prems(1) have False by (unfold ah_il_def) blast
              thus ?thesis ..
            qed
          qed
        qed
      qed
    qed
  } with A show ?thesis by blast
qed

text {* Finally, we can state the relationship between monitor consistent interleaving and interleaving of acquisition histories *}
theorem ah_interleavable:
  "(\<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> w2)) \<longleftrightarrow> (w1\<otimes>\<^bsub>\<alpha>\<^esub>w2\<noteq>{})"
  using ah_interleavable1 ah_interleavable2 by blast

subsection "Acquisition history backward update"
text {* We define a function to update an acquisition history backwards. This function is useful for constructing acquisition histories in backward constraint systems. *}
definition
  ah_update :: "('m \<Rightarrow> 'm set) \<Rightarrow> ('m set * 'm set) \<Rightarrow> 'm set \<Rightarrow> ('m \<Rightarrow> 'm set)"
  where
  "ah_update h F M m == if m\<in>fst F then fst F \<union> snd F \<union> M else h m"

text {*
  Intuitively, @{term "ah_update h (E,U) M m"} means to prepend a step @{term "(E,U)"} to the acquisition history @{term h} of a path that uses monitors @{term M}. Note that we need the extra parameter @{term M}, since
  an acquisition history does not contain information about the monitors that are used on a path before the first monitor that will not be left has been entered.
*}
lemma ah_update_cons: "\<alpha>ah (e#w) = ah_update (\<alpha>ah w) e (mon_pl w)"
  by (auto intro!: ext simp add: ah_update_def)

text {* The backward-update function is monotonic in the first and third argument as well as in the used monitors of the second argument.
  Note that it is, in general, not monotonic in the entered monitors of the second argument. *}
lemma ah_update_mono: "\<lbrakk>h \<le> h'; F=F'; M\<subseteq>M'\<rbrakk>
  \<Longrightarrow> ah_update h F M \<le> ah_update h' F' M'"
  by (auto simp add: ah_update_def le_fun_def [where 'b="'a set"])
lemma ah_update_mono2: "\<lbrakk>h \<le> h'; U\<subseteq>U'; M\<subseteq>M'\<rbrakk>
  \<Longrightarrow> ah_update h (E,U) M \<le> ah_update h' (E,U') M'"
  by (auto simp add: ah_update_def le_fun_def [where 'b="'a set"])

end


section \<open> Reactive Designs Healthiness Conditions \<close>

theory utp_rdes_healths
  imports "UTP1-Reactive.utp_reactive"
begin

subsection \<open> Preliminaries \<close>

named_theorems rdes and rdes_def and RD_elim

type_synonym ('s,'t) rdes = "('s,'t,unit) hrel_rsp"

translations
  (type) "('s,'t) rdes" <= (type) "('s, 't, unit) hrel_rsp"

(* FIXME: Nasty Hack. Can we automate this? *)

declare des_vars.splits [alpha_splits del]
declare rp_vars.splits [alpha_splits del]
declare rp_vars.splits [alpha_splits]
declare des_vars.splits [alpha_splits]

lemma R2_st_ex: "R2 (\<exists> $st \<bullet> P) = (\<exists> $st \<bullet> R2(P))"
  by (rel_auto)

lemma R2s_st'_eq_st:
  "R2s($st\<acute> =\<^sub>u $st) = ($st\<acute> =\<^sub>u $st)"
  by (rel_auto)

lemma R2c_st'_eq_st:
  "R2c($st\<acute> =\<^sub>u $st) = ($st\<acute> =\<^sub>u $st)"
  by (rel_auto)

lemma R1_des_lift_skip: "R1(\<lceil>II\<rceil>\<^sub>D) = \<lceil>II\<rceil>\<^sub>D"
  by (rel_auto)

lemma R2_des_lift_skip:
  "R2(\<lceil>II\<rceil>\<^sub>D) = \<lceil>II\<rceil>\<^sub>D"
  apply (rel_auto) using minus_zero_eq by blast

lemma R1_R2c_ex_st: "R1 (R2c (\<exists> $st\<acute> \<bullet> Q\<^sub>1)) = (\<exists> $st\<acute> \<bullet> R1 (R2c Q\<^sub>1))"
  by (rel_auto)

subsection \<open> Identities \<close>

text \<open> We define two identities fro reactive designs, which correspond to the regular and
  state-sensitive versions of reactive designs, respectively. The former is the one used in
  the UTP book and related publications for CSP. \<close>

definition skip_rea :: "('t::trace, '\<alpha>) hrel_rp" ("II\<^sub>C") where
skip_rea_def [urel_defs]: "II\<^sub>C = (II \<or> (\<not> $ok \<and> $tr \<le>\<^sub>u $tr\<acute>))"

definition skip_srea :: "('s, 't::trace, '\<alpha>) hrel_rsp" ("II\<^sub>R") where
skip_srea_def [urel_defs]: "II\<^sub>R = ((\<exists> $st \<bullet> II\<^sub>C) \<triangleleft> $wait \<triangleright> II\<^sub>C)"

lemma skip_rea_R1_lemma: "II\<^sub>C = R1($ok \<Rightarrow> II)"
  by (rel_auto)

lemma skip_rea_form: "II\<^sub>C = (II \<triangleleft> $ok \<triangleright> R1(true))"
  by (rel_auto)

lemma skip_srea_form: "II\<^sub>R = ((\<exists> $st \<bullet> II) \<triangleleft> $wait \<triangleright> II) \<triangleleft> $ok \<triangleright> R1(true)"
  by (rel_auto)

lemma R1_skip_rea: "R1(II\<^sub>C) = II\<^sub>C"
  by (rel_auto)

lemma R2c_skip_rea: "R2c II\<^sub>C = II\<^sub>C"
  by (simp add: skip_rea_def R2c_and R2c_disj R2c_skip_r R2c_not R2c_ok R2c_tr_le_tr')

lemma R2_skip_rea: "R2(II\<^sub>C) = II\<^sub>C"
  by (metis R1_R2c_is_R2 R1_skip_rea R2c_skip_rea)

lemma R2c_skip_srea: "R2c(II\<^sub>R) = II\<^sub>R"
  apply (rel_auto) using minus_zero_eq by blast+

lemma skip_srea_R1 [closure]: "II\<^sub>R is R1"
  by (rel_auto)

lemma skip_srea_R2c [closure]: "II\<^sub>R is R2c"
  by (simp add: Healthy_def R2c_skip_srea)

lemma skip_srea_R2 [closure]: "II\<^sub>R is R2"
  by (metis Healthy_def' R1_R2c_is_R2 R2c_skip_srea skip_srea_R1)

subsection \<open> RD1: Divergence yields arbitrary traces \<close>

definition RD1 :: "('t::trace,'\<alpha>,'\<beta>) rel_rp \<Rightarrow> ('t,'\<alpha>,'\<beta>) rel_rp" where
[upred_defs]: "RD1(P) = (P \<or> (\<not> $ok \<and> $tr \<le>\<^sub>u $tr\<acute>))"

text \<open> $RD1$ is essentially $H1$ from the theory of designs, but viewed through the prism of
  reactive processes. \<close>

lemma RD1_idem: "RD1(RD1(P)) = RD1(P)"
  by (rel_auto)

lemma RD1_Idempotent: "Idempotent RD1"
  by (simp add: Idempotent_def RD1_idem)

lemma RD1_mono: "P \<sqsubseteq> Q \<Longrightarrow> RD1(P) \<sqsubseteq> RD1(Q)"
  by (rel_auto)

lemma RD1_Monotonic: "Monotonic RD1"
  using mono_def RD1_mono by blast

lemma RD1_Continuous: "Continuous RD1"
  by (rel_auto)

lemma R1_true_RD1_closed [closure]: "R1(true) is RD1"
  by (rel_auto)

lemma RD1_wait_false [closure]: "P is RD1 \<Longrightarrow> P\<lbrakk>false/$wait\<rbrakk> is RD1"
  by (rel_auto)

lemma RD1_wait'_false [closure]: "P is RD1 \<Longrightarrow> P\<lbrakk>false/$wait\<acute>\<rbrakk> is RD1"
  by (rel_auto)

lemma RD1_seq: "RD1(RD1(P) ;; RD1(Q)) = RD1(P) ;; RD1(Q)"
  by (rel_auto)

lemma RD1_seq_closure [closure]: "\<lbrakk> P is RD1; Q is RD1 \<rbrakk> \<Longrightarrow> P ;; Q is RD1"
  by (metis Healthy_def' RD1_seq)

lemma RD1_R1_commute: "RD1(R1(P)) = R1(RD1(P))"
  by (rel_auto)

lemma RD1_R2c_commute: "RD1(R2c(P)) = R2c(RD1(P))"
  by (rel_auto)

lemma RD1_via_R1: "R1(H1(P)) = RD1(R1(P))"
  by (rel_auto)

lemma RD1_R1_cases: "RD1(R1(P)) = (R1(P) \<triangleleft> $ok \<triangleright> R1(true))"
  by (rel_auto)

lemma skip_rea_RD1_skip: "II\<^sub>C = RD1(II)"
  by (rel_auto)

lemma skip_srea_RD1 [closure]: "II\<^sub>R is RD1"
  by (rel_auto)

lemma RD1_algebraic_intro:
  assumes
    "P is R1" "(R1(true\<^sub>h) ;; P) = R1(true\<^sub>h)" "(II\<^sub>C ;; P) = P"
  shows "P is RD1"
proof -
  have "P = (II\<^sub>C ;; P)"
    by (simp add: assms(3))
  also have "... = (R1($ok \<Rightarrow> II) ;; P)"
    by (simp add: skip_rea_R1_lemma)
  also have "... = (((\<not> $ok \<and> R1(true)) ;; P) \<or> P)"
    by (metis (no_types, lifting) R1_def seqr_left_unit seqr_or_distl skip_rea_R1_lemma skip_rea_def utp_pred_laws.inf_top_left utp_pred_laws.sup_commute)
  also have "... = ((R1(\<not> $ok) ;; (R1(true\<^sub>h) ;; P)) \<or> P)"
    using dual_order.trans by (rel_blast)
  also have "... = ((R1(\<not> $ok) ;; R1(true\<^sub>h)) \<or> P)"
    by (simp add: assms(2))
  also have "... = (R1(\<not> $ok) \<or> P)"
    by (rel_auto)
  also have "... = RD1(P)"
    by (rel_auto)
  finally show ?thesis
    by (simp add: Healthy_def)
qed

theorem RD1_left_zero:
  assumes "P is R1" "P is RD1"
  shows "(R1(true) ;; P) = R1(true)"
proof -
  have "(R1(true) ;; R1(RD1(P))) = R1(true)"
    by (rel_auto)
  thus ?thesis
    by (simp add: Healthy_if assms(1) assms(2))
qed

theorem RD1_left_unit:
  assumes "P is R1" "P is RD1"
  shows "(II\<^sub>C ;; P) = P"
proof -
  have "(II\<^sub>C ;; R1(RD1(P))) = R1(RD1(P))"
    by (rel_auto)
  thus ?thesis
    by (simp add: Healthy_if assms(1) assms(2))
qed

lemma RD1_alt_def:
  assumes "P is R1"
  shows "RD1(P) = (P \<triangleleft> $ok \<triangleright> R1(true))"
proof -
  have "RD1(R1(P)) = (R1(P) \<triangleleft> $ok \<triangleright> R1(true))"
    by (rel_auto)
  thus ?thesis
    by (simp add: Healthy_if assms)
qed

theorem RD1_algebraic:
  assumes "P is R1"
  shows "P is RD1 \<longleftrightarrow> (R1(true\<^sub>h) ;; P) = R1(true\<^sub>h) \<and> (II\<^sub>C ;; P) = P"
  using RD1_algebraic_intro RD1_left_unit RD1_left_zero assms by blast

subsection \<open> R3c and R3h: Reactive design versions of R3 \<close>

definition R3c :: "('t::trace, '\<alpha>) hrel_rp \<Rightarrow> ('t, '\<alpha>) hrel_rp" where
[upred_defs]: "R3c(P) = (II\<^sub>C \<triangleleft> $wait \<triangleright> P)"

definition R3h :: "('s, 't::trace, '\<alpha>) hrel_rsp \<Rightarrow> ('s, 't, '\<alpha>) hrel_rsp" where
 R3h_def [upred_defs]: "R3h(P) = ((\<exists> $st \<bullet> II\<^sub>C) \<triangleleft> $wait \<triangleright> P)"

lemma R3c_idem: "R3c(R3c(P)) = R3c(P)"
  by (rel_auto)

lemma R3c_Idempotent: "Idempotent R3c"
  by (simp add: Idempotent_def R3c_idem)

lemma R3c_mono: "P \<sqsubseteq> Q \<Longrightarrow> R3c(P) \<sqsubseteq> R3c(Q)"
  by (rel_auto)

lemma R3c_Monotonic: "Monotonic R3c"
  by (simp add: mono_def R3c_mono)

lemma R3c_Continuous: "Continuous R3c"
  by (rel_auto)

lemma R3h_idem: "R3h(R3h(P)) = R3h(P)"
  by (rel_auto)

lemma R3h_Idempotent: "Idempotent R3h"
  by (simp add: Idempotent_def R3h_idem)

lemma R3h_mono: "P \<sqsubseteq> Q \<Longrightarrow> R3h(P) \<sqsubseteq> R3h(Q)"
  by (rel_auto)

lemma R3h_Monotonic: "Monotonic R3h"
  by (simp add: mono_def R3h_mono)

lemma R3h_Continuous: "Continuous R3h"
  by (rel_auto)

lemma R3h_inf: "R3h(P \<sqinter> Q) = R3h(P) \<sqinter> R3h(Q)"
  by (rel_auto)

lemma R3h_UINF:
  "A \<noteq> {} \<Longrightarrow> R3h(\<Sqinter> i \<in> A \<bullet> P(i)) = (\<Sqinter> i \<in> A \<bullet> R3h(P(i)))"
  by (rel_auto)

lemma R3h_cond: "R3h(P \<triangleleft> b \<triangleright> Q) = (R3h(P) \<triangleleft> b \<triangleright> R3h(Q))"
  by (rel_auto)

lemma R3c_via_RD1_R3: "RD1(R3(P)) = R3c(RD1(P))"
  by (rel_auto)

lemma R3c_RD1_def: "P is RD1 \<Longrightarrow> R3c(P) = RD1(R3(P))"
  by (simp add: Healthy_if R3c_via_RD1_R3)

lemma RD1_R3c_commute: "RD1(R3c(P)) = R3c(RD1(P))"
  by (rel_auto)

lemma R1_R3c_commute: "R1(R3c(P)) = R3c(R1(P))"
  by (rel_auto)

lemma R2c_R3c_commute: "R2c(R3c(P)) = R3c(R2c(P))"
  apply (rel_auto) using minus_zero_eq by blast+

lemma R1_R3h_commute: "R1(R3h(P)) = R3h(R1(P))"
  by (rel_auto)

lemma R2c_R3h_commute: "R2c(R3h(P)) = R3h(R2c(P))"
  apply (rel_auto) using minus_zero_eq by blast+

lemma RD1_R3h_commute: "RD1(R3h(P)) = R3h(RD1(P))"
  by (rel_auto)

lemma R3c_cancels_R3: "R3c(R3(P)) = R3c(P)"
  by (rel_auto)

lemma R3_cancels_R3c: "R3(R3c(P)) = R3(P)"
  by (rel_auto)

lemma R3h_cancels_R3c: "R3h(R3c(P)) = R3h(P)"
  by (rel_auto)

lemma R3c_semir_form:
  "(R3c(P) ;; R3c(R1(Q))) = R3c(P ;; R3c(R1(Q)))"
  by (rel_simp, safe, auto intro: order_trans)

lemma R3h_semir_form:
  "(R3h(P) ;; R3h(R1(Q))) = R3h(P ;; R3h(R1(Q)))"
  by (rel_simp, safe, auto intro: order_trans, blast+)

lemma R3c_seq_closure:
  assumes "P is R3c" "Q is R3c" "Q is R1"
  shows "(P ;; Q) is R3c"
  by (metis Healthy_def' R3c_semir_form assms)

lemma R3h_seq_closure [closure]:
  assumes "P is R3h" "Q is R3h" "Q is R1"
  shows "(P ;; Q) is R3h"
  by (metis Healthy_def' R3h_semir_form assms)

lemma R3c_R3_left_seq_closure:
  assumes "P is R3" "Q is R3c"
  shows "(P ;; Q) is R3c"
proof -
  have "(P ;; Q) = ((P ;; Q)\<lbrakk>true/$wait\<rbrakk> \<triangleleft> $wait \<triangleright> (P ;; Q))"
    by (metis cond_var_split cond_var_subst_right in_var_uvar wait_vwb_lens)
  also have "... = (((II \<triangleleft> $wait \<triangleright> P) ;; Q)\<lbrakk>true/$wait\<rbrakk> \<triangleleft> $wait \<triangleright> (P ;; Q))"
    by (metis Healthy_def' R3_def assms(1))
  also have "... = ((II\<lbrakk>true/$wait\<rbrakk> ;; Q) \<triangleleft> $wait \<triangleright> (P ;; Q))"
    by (subst_tac)
  also have "... = (((II \<and> $wait\<acute>) ;; Q) \<triangleleft> $wait \<triangleright> (P ;; Q))"
    by (metis (no_types, lifting) cond_def conj_pos_var_subst seqr_pre_var_out skip_var utp_pred_laws.inf_left_idem wait_vwb_lens)
  also have "... = ((II\<lbrakk>true/$wait\<acute>\<rbrakk> ;; Q\<lbrakk>true/$wait\<rbrakk>) \<triangleleft> $wait \<triangleright> (P ;; Q))"
    by (metis seqr_pre_transfer seqr_right_one_point true_alt_def uovar_convr upred_eq_true utp_rel.unrest_ouvar vwb_lens_mwb wait_vwb_lens)
  also have "... = ((II\<lbrakk>true/$wait\<acute>\<rbrakk> ;; (II\<^sub>C \<triangleleft> $wait \<triangleright> Q)\<lbrakk>true/$wait\<rbrakk>) \<triangleleft> $wait \<triangleright> (P ;; Q))"
    by (metis Healthy_def' R3c_def assms(2))
  also have "... = ((II\<lbrakk>true/$wait\<acute>\<rbrakk> ;; II\<^sub>C\<lbrakk>true/$wait\<rbrakk>) \<triangleleft> $wait \<triangleright> (P ;; Q))"
    by (subst_tac)
  also have "... = (((II \<and> $wait\<acute>) ;; II\<^sub>C) \<triangleleft> $wait \<triangleright> (P ;; Q))"
    by (metis seqr_pre_transfer seqr_right_one_point true_alt_def uovar_convr upred_eq_true utp_rel.unrest_ouvar vwb_lens_mwb wait_vwb_lens)
  also have "... = ((II ;; II\<^sub>C) \<triangleleft> $wait \<triangleright> (P ;; Q))"
    by (simp add: cond_def seqr_pre_transfer utp_rel.unrest_ouvar)
  also have "... = (II\<^sub>C \<triangleleft> $wait \<triangleright> (P ;; Q))"
    by simp
  also have "... = R3c(P ;; Q)"
    by (simp add: R3c_def)
  finally show ?thesis
    by (simp add: Healthy_def')
qed

lemma R3c_cases: "R3c(P) = ((II \<triangleleft> $ok \<triangleright> R1(true)) \<triangleleft> $wait \<triangleright> P)"
  by (rel_auto)

lemma R3h_cases: "R3h(P) = (((\<exists> $st \<bullet> II) \<triangleleft> $ok \<triangleright> R1(true)) \<triangleleft> $wait \<triangleright> P)"
  by (rel_auto)

lemma R3h_form: "R3h(P) = II\<^sub>R \<triangleleft> $wait \<triangleright> P"
  by (rel_auto)

lemma R3c_subst_wait: "R3c(P) = R3c(P \<^sub>f)"
  by (simp add: R3c_def cond_var_subst_right)

lemma R3h_subst_wait: "R3h(P) = R3h(P \<^sub>f)"
  by (simp add: R3h_cases cond_var_subst_right)

lemma skip_srea_R3h [closure]: "II\<^sub>R is R3h"
  by (rel_auto)

lemma R3h_wait_true:
  assumes "P is R3h"
  shows "P \<^sub>t = II\<^sub>R \<^sub>t"
proof -
  have "P \<^sub>t = (II\<^sub>R \<triangleleft> $wait \<triangleright> P) \<^sub>t"
    by (metis Healthy_if R3h_form assms)
  also have "... = II\<^sub>R \<^sub>t"
    by (simp add: usubst)
  finally show ?thesis .
qed

lemma R3c_refines_R3h: "R3h(P) \<sqsubseteq> R3c(P)"
  by (rel_auto)

subsection \<open> RD2: A reactive specification cannot require non-termination \<close>

definition RD2 where
[upred_defs]: "RD2(P) = H2(P)"

text \<open> $RD2$ is just $H2$ since the type system will automatically have J identifying
  the reactive variables as required. \<close>

lemma RD2_idem: "RD2(RD2(P)) = RD2(P)"
  by (simp add: H2_idem RD2_def)

lemma RD2_Idempotent: "Idempotent RD2"
  by (simp add: Idempotent_def RD2_idem)

lemma RD2_mono: "P \<sqsubseteq> Q \<Longrightarrow> RD2(P) \<sqsubseteq> RD2(Q)"
  by (simp add: H2_def RD2_def seqr_mono)

lemma RD2_Monotonic: "Monotonic RD2"
  using mono_def RD2_mono by blast

lemma RD2_Continuous: "Continuous RD2"
  by (rel_auto)

lemma RD1_RD2_commute: "RD1(RD2(P)) = RD2(RD1(P))"
  by (rel_auto)

lemma RD2_R3c_commute: "RD2(R3c(P)) = R3c(RD2(P))"
  by (rel_auto)

lemma RD2_R3h_commute: "RD2(R3h(P)) = R3h(RD2(P))"
  by (rel_auto)

subsection \<open> Major healthiness conditions \<close>

definition RH :: "('t::trace,'\<alpha>) hrel_rp \<Rightarrow> ('t,'\<alpha>) hrel_rp" ("\<^bold>R")
where [upred_defs]: "RH(P) = R1(R2c(R3c(P)))"

definition RHS :: "('s,'t::trace,'\<alpha>) hrel_rsp \<Rightarrow> ('s,'t,'\<alpha>) hrel_rsp" ("\<^bold>R\<^sub>s")
where [upred_defs]: "RHS(P) = R1(R2c(R3h(P)))"

definition RD :: "('t::trace,'\<alpha>) hrel_rp \<Rightarrow> ('t,'\<alpha>) hrel_rp"
where [upred_defs]: "RD(P) = RD1(RD2(RP(P)))"

definition SRD :: "('s,'t::trace,'\<alpha>) hrel_rsp \<Rightarrow> ('s,'t,'\<alpha>) hrel_rsp"
where [upred_defs]: "SRD(P) = RD1(RD2(RHS(P)))"

lemma RH_comp: "RH = R1 \<circ> R2c \<circ> R3c"
  by (auto simp add: RH_def)

lemma RHS_comp: "RHS = R1 \<circ> R2c \<circ> R3h"
  by (auto simp add: RHS_def)

lemma RD_comp: "RD = RD1 \<circ> RD2 \<circ> RP"
  by (auto simp add: RD_def)

lemma SRD_comp: "SRD = RD1 \<circ> RD2 \<circ> RHS"
  by (auto simp add: SRD_def)

lemma RH_idem: "\<^bold>R(\<^bold>R(P)) = \<^bold>R(P)"
  by (simp add: R1_R2c_commute R1_R3c_commute R1_idem R2c_R3c_commute R2c_idem R3c_idem RH_def)

lemma RH_Idempotent: "Idempotent \<^bold>R"
  by (simp add: Idempotent_def RH_idem)

lemma RH_Monotonic: "Monotonic \<^bold>R"
  by (metis (no_types, lifting) R1_Monotonic R2c_Monotonic R3c_mono RH_def mono_def)

lemma RH_mono: "P \<sqsubseteq> Q \<Longrightarrow> \<^bold>R(P) \<sqsubseteq> \<^bold>R(Q)"
  using mono_def RH_Monotonic by blast

lemma RH_Continuous: "Continuous \<^bold>R"
  by (simp add: Continuous_comp R1_Continuous R2c_Continuous R3c_Continuous RH_comp)

lemma RHS_idem: "\<^bold>R\<^sub>s(\<^bold>R\<^sub>s(P)) = \<^bold>R\<^sub>s(P)"
  by (simp add: R1_R2c_is_R2 R1_R3h_commute R2_idem R2c_R3h_commute R3h_idem RHS_def)

lemma RHS_Idempotent [closure]: "Idempotent \<^bold>R\<^sub>s"
  by (simp add: Idempotent_def RHS_idem)

lemma RHS_Monotonic: "Monotonic \<^bold>R\<^sub>s"
  by (simp add: mono_def R1_R2c_is_R2 R2_mono R3h_mono RHS_def)

lemma RHS_mono: "P \<sqsubseteq> Q \<Longrightarrow> \<^bold>R\<^sub>s(P) \<sqsubseteq> \<^bold>R\<^sub>s(Q)"
  using mono_def RHS_Monotonic by blast

lemma RHS_Continuous [closure]: "Continuous \<^bold>R\<^sub>s"
  by (simp add: Continuous_comp R1_Continuous R2c_Continuous R3h_Continuous RHS_comp)

lemma RHS_inf: "\<^bold>R\<^sub>s(P \<sqinter> Q) = \<^bold>R\<^sub>s(P) \<sqinter> \<^bold>R\<^sub>s(Q)"
  using Continuous_Disjunctous Disjunctuous_def RHS_Continuous by auto

lemma RHS_INF:
  "A \<noteq> {} \<Longrightarrow> \<^bold>R\<^sub>s(\<Sqinter> i \<in> A \<bullet> P(i)) = (\<Sqinter> i \<in> A \<bullet> \<^bold>R\<^sub>s(P(i)))"
  by (simp add: RHS_def R3h_UINF R2c_USUP R1_USUP)

lemma RHS_sup: "\<^bold>R\<^sub>s(P \<squnion> Q) = \<^bold>R\<^sub>s(P) \<squnion> \<^bold>R\<^sub>s(Q)"
  by (rel_auto)

lemma RHS_SUP:
  "A \<noteq> {} \<Longrightarrow> \<^bold>R\<^sub>s(\<Squnion> i \<in> A \<bullet> P(i)) = (\<Squnion> i \<in> A \<bullet> \<^bold>R\<^sub>s(P(i)))"
  by (rel_auto)

lemma RHS_cond: "\<^bold>R\<^sub>s(P \<triangleleft> b \<triangleright> Q) = (\<^bold>R\<^sub>s(P) \<triangleleft> R2c b \<triangleright> \<^bold>R\<^sub>s(Q))"
  by (simp add: RHS_def R3h_cond R2c_condr R1_cond)

lemma RD_alt_def: "RD(P) = RD1(RD2(\<^bold>R(P)))"
  by (simp add: R3c_via_RD1_R3 RD1_R1_commute RD1_R2c_commute RD1_R3c_commute RD1_RD2_commute RH_def RD_def RP_def)

lemma RD1_RH_commute: "RD1(\<^bold>R(P)) = \<^bold>R(RD1(P))"
  by (simp add: RD1_R1_commute RD1_R2c_commute RD1_R3c_commute RH_def)

lemma RD2_RH_commute: "RD2(\<^bold>R(P)) = \<^bold>R(RD2(P))"
  by (metis R1_H2_commute R2c_H2_commute RD2_R3c_commute RD2_def RH_def)

lemma RD_idem: "RD(RD(P)) = RD(P)"
  by (simp add: RD_alt_def RD1_RH_commute RD2_RH_commute RD1_RD2_commute RD2_idem RD1_idem RH_idem)

lemma RD_Monotonic: "Monotonic RD"
  by (simp add: Monotonic_comp RD1_Monotonic RD2_Monotonic RD_comp RP_Monotonic)

lemma RD_Continuous: "Continuous RD"
  by (simp add: Continuous_comp RD1_Continuous RD2_Continuous RD_comp RP_Continuous)

lemma R3_RD_RP: "R3(RD(P)) = RP(RD1(RD2(P)))"
  by (metis (no_types, lifting) R1_R2c_is_R2 R2_R3_commute R3_cancels_R3c RD1_RH_commute RD2_RH_commute RD_alt_def RH_def RP_def)

lemma RD_healths [closure]:
  assumes "P is RD"
  shows "P is R1" "P is R2" "P is R3c" "P is RD1" "P is RD2"
  apply (metis Healthy_def R1_idem RD1_RH_commute RD2_RH_commute RH_def RD_alt_def assms)
  apply (metis Healthy_def R1_R2c_is_R2 R2_idem RD1_RH_commute RD2_RH_commute RH_def RD_alt_def assms)
  apply (metis Healthy_def R3_RD_RP R3c_via_RD1_R3 RD1_RD2_commute RD1_RH_commute RD2_R3c_commute RD2_RH_commute RD_alt_def RD_def assms)
  apply (metis Healthy_Idempotent Healthy_def RD1_Idempotent RD_alt_def assms)
  apply (metis H2_idem Healthy_def RD1_RD2_commute RD2_def RD_def assms)
  done

lemma RD1_RHS_commute: "RD1(\<^bold>R\<^sub>s(P)) = \<^bold>R\<^sub>s(RD1(P))"
  by (simp add: RD1_R1_commute RD1_R2c_commute RD1_R3h_commute RHS_def)

lemma RD2_RHS_commute: "RD2(\<^bold>R\<^sub>s(P)) = \<^bold>R\<^sub>s(RD2(P))"
  by (metis R1_H2_commute R2c_H2_commute RD2_R3h_commute RD2_def RHS_def)

lemma SRD_idem: "SRD(SRD(P)) = SRD(P)"
  by (simp add: RD1_RD2_commute RD1_RHS_commute RD1_idem RD2_RHS_commute RD2_idem RHS_idem SRD_def)

lemma SRD_Idempotent [closure]: "Idempotent SRD"
  by (simp add: Idempotent_def SRD_idem)

lemma SRD_Monotonic: "Monotonic SRD"
  by (simp add: Monotonic_comp RD1_Monotonic RD2_Monotonic RHS_Monotonic SRD_comp)

lemma SRD_Continuous [closure]: "Continuous SRD"
  by (simp add: Continuous_comp RD1_Continuous RD2_Continuous RHS_Continuous SRD_comp)

lemma SRD_RHS_H1_H2: "SRD(P) = \<^bold>R\<^sub>s(\<^bold>H(P))"
  by (rel_auto)

lemma SRD_healths [closure]:
  assumes "P is SRD"
  shows "P is R1" "P is R2" "P is R3h" "P is RD1" "P is RD2"
  apply (metis Healthy_def R1_idem RD1_RHS_commute RD2_RHS_commute RHS_def SRD_def assms)
  apply (metis Healthy_def R1_R2c_is_R2 R2_idem RD1_RHS_commute RD2_RHS_commute RHS_def SRD_def assms)
  apply (metis Healthy_def R1_R3h_commute R2c_R3h_commute R3h_idem RD1_R3h_commute RD2_R3h_commute RHS_def SRD_def assms)
  apply (metis Healthy_def' RD1_idem SRD_def assms)
  apply (metis Healthy_def' RD1_RD2_commute RD2_idem SRD_def assms)
done

lemma SRD_intro:
  assumes "P is R1" "P is R2" "P is R3h" "P is RD1" "P is RD2"
  shows "P is SRD"
  by (metis Healthy_def R1_R2c_is_R2 RHS_def SRD_def assms(2) assms(3) assms(4) assms(5))

lemma SRD_ok_false [usubst]: "P is SRD \<Longrightarrow> P\<lbrakk>false/$ok\<rbrakk> = R1(true)"
  by (metis (no_types, opaque_lifting) H1_H2_eq_design Healthy_def R1_ok_false RD1_R1_commute RD1_via_R1 RD2_def SRD_def SRD_healths(1) design_ok_false)

lemma SRD_ok_true_wait_true [usubst]:
  assumes "P is SRD"
  shows "P\<lbrakk>true,true/$ok,$wait\<rbrakk> = (\<exists> $st \<bullet> II)\<lbrakk>true,true/$ok,$wait\<rbrakk>"
proof -
  have "P = (\<exists> $st \<bullet> II) \<triangleleft> $ok \<triangleright> R1 true \<triangleleft> $wait \<triangleright> P"
    by (metis Healthy_def R3h_cases SRD_healths(3) assms)
  moreover have "((\<exists> $st \<bullet> II) \<triangleleft> $ok \<triangleright> R1 true \<triangleleft> $wait \<triangleright> P)\<lbrakk>true,true/$ok,$wait\<rbrakk> = (\<exists> $st \<bullet> II)\<lbrakk>true,true/$ok,$wait\<rbrakk>"
    by (simp add: usubst)
  ultimately show ?thesis
    by (simp)
qed

lemma SRD_left_zero_1: "P is SRD \<Longrightarrow> R1(true) ;; P = R1(true)"
  by (simp add: RD1_left_zero SRD_healths(1) SRD_healths(4))

lemma SRD_left_zero_2:
  assumes "P is SRD"
  shows "(\<exists> $st \<bullet> II)\<lbrakk>true,true/$ok,$wait\<rbrakk> ;; P = (\<exists> $st \<bullet> II)\<lbrakk>true,true/$ok,$wait\<rbrakk>"
proof -
  have "(\<exists> $st \<bullet> II)\<lbrakk>true,true/$ok,$wait\<rbrakk> ;; R3h(P) = (\<exists> $st \<bullet> II)\<lbrakk>true,true/$ok,$wait\<rbrakk>"
    by (rel_auto)
  thus ?thesis
    by (simp add: Healthy_if SRD_healths(3) assms)
qed

subsection \<open> UTP theories \<close>

text \<open> We create two theory objects: one for reactive designs and one for stateful reactive
        designs. \<close>

interpretation rdes_theory: utp_theory_continuous RD
  rewrites "P \<in> carrier rdes_theory.thy_order \<longleftrightarrow> P is RD"
  and "carrier rdes_theory.thy_order \<rightarrow> carrier rdes_theory.thy_order \<equiv> \<lbrakk>RD\<rbrakk>\<^sub>H \<rightarrow> \<lbrakk>RD\<rbrakk>\<^sub>H"
  and "le rdes_theory.thy_order = (\<sqsubseteq>)"
  and "eq rdes_theory.thy_order = (=)"
proof -
  show "utp_theory_continuous RD"
    by (unfold_locales, simp_all add: RD_idem RD_Continuous)
qed (simp_all)

interpretation srdes_theory: utp_theory_continuous SRD
  rewrites "P \<in> carrier srdes_theory.thy_order \<longleftrightarrow> P is SRD"
  and "carrier srdes_theory.thy_order \<rightarrow> carrier srdes_theory.thy_order \<equiv> \<lbrakk>SRD\<rbrakk>\<^sub>H \<rightarrow> \<lbrakk>SRD\<rbrakk>\<^sub>H"
  and "le srdes_theory.thy_order = (\<sqsubseteq>)"
  and "eq srdes_theory.thy_order = (=)"
proof -
  show "utp_theory_continuous SRD"
    by (unfold_locales, simp_all add: SRD_idem SRD_Continuous)
qed (simp_all)

interpretation rdes_rea_galois:
  galois_connection "(RD \<Leftarrow>\<langle>RD1 \<circ> RD2,R3\<rangle>\<Rightarrow> RP)"
proof (simp add: mk_conn_def, rule galois_connectionI', simp_all add: utp_partial_order)
  show "R3 \<in> \<lbrakk>RD\<rbrakk>\<^sub>H \<rightarrow> \<lbrakk>RP\<rbrakk>\<^sub>H"
    by (metis (no_types, lifting) Healthy_def' Pi_I R3_RD_RP RP_idem mem_Collect_eq)
  show "RD1 \<circ> RD2 \<in> \<lbrakk>RP\<rbrakk>\<^sub>H \<rightarrow> \<lbrakk>RD\<rbrakk>\<^sub>H"
    by (simp add: Pi_iff Healthy_def, metis RD_def RD_idem)
  show "isotone (utp_order RD) (utp_order RP) R3"
    by (simp add: R3_Monotonic isotone_utp_orderI)
  show "isotone (utp_order RP) (utp_order RD) (RD1 \<circ> RD2)"
    by (simp add: Monotonic_comp RD1_Monotonic RD2_Monotonic isotone_utp_orderI)
  fix P :: "('a, 'b) hrel_rp"
  assume "P is RD"
  thus "P \<sqsubseteq> RD1 (RD2 (R3 P))"
    by (metis Healthy_if R3_RD_RP RD_def RP_idem eq_iff)
next
  fix P :: "('a, 'b) hrel_rp"
  assume a: "P is RP"
  thus "R3 (RD1 (RD2 P)) \<sqsubseteq> P"
  proof -
    have "R3 (RD1 (RD2 P)) = RP (RD1 (RD2(P)))"
      by (metis Healthy_if R3_RD_RP RD_def a)
    moreover have "RD1(RD2(P)) \<sqsubseteq> P"
      by (rel_auto)
    ultimately show ?thesis
      by (metis Healthy_if RP_mono a)
  qed
qed

interpretation rdes_rea_retract:
  retract "(RD \<Leftarrow>\<langle>RD1 \<circ> RD2,R3\<rangle>\<Rightarrow> RP)"
  by (unfold_locales, simp_all add: mk_conn_def utp_partial_order)
     (metis Healthy_if R3_RD_RP RD_def RP_idem eq_refl)

abbreviation Chaos :: "('s,'t::trace,'\<alpha>) hrel_rsp" where
"Chaos \<equiv> srdes_theory.utp_bottom"

abbreviation Miracle :: "('s,'t::trace,'\<alpha>) hrel_rsp" where
"Miracle \<equiv> srdes_theory.utp_top"

thm srdes_theory.weak.bottom_lower
thm srdes_theory.weak.top_higher
thm srdes_theory.meet_bottom
thm srdes_theory.meet_top

abbreviation srd_lfp ("\<mu>\<^sub>R") where "\<mu>\<^sub>R F \<equiv> srdes_theory.utp_lfp F"

abbreviation srd_gfp ("\<nu>\<^sub>R") where "\<nu>\<^sub>R F \<equiv> srdes_theory.utp_gfp F"

syntax
  "_srd_mu" :: "pttrn \<Rightarrow> logic \<Rightarrow> logic" ("\<mu>\<^sub>R _ \<bullet> _" [0, 10] 10)
  "_srd_nu" :: "pttrn \<Rightarrow> logic \<Rightarrow> logic" ("\<nu>\<^sub>R _ \<bullet> _" [0, 10] 10)

translations
  "\<mu>\<^sub>R X \<bullet> P" == "\<mu>\<^sub>R (\<lambda> X. P)"
  "\<nu>\<^sub>R X \<bullet> P" == "\<mu>\<^sub>R (\<lambda> X. P)"

text \<open> The reactive design weakest fixed-point can be defined in terms of relational calculus one. \<close>

lemma srd_mu_equiv:
  assumes "Monotonic F" "F \<in> \<lbrakk>SRD\<rbrakk>\<^sub>H \<rightarrow> \<lbrakk>SRD\<rbrakk>\<^sub>H"
  shows "(\<mu>\<^sub>R X \<bullet> F(X)) = (\<mu> X \<bullet> F(SRD(X)))"
  by (metis assms srdes_theory.utp_lfp_def)

end


(*  Title:      HOL/Auth/n_mutualExDeadFree_on_inis.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_mutualExDeadFree Protocol Case Study*}

theory n_mutualExDeadFree_on_inis imports n_mutualExDeadFree_on_ini
begin
lemma on_inis:
  assumes b1: "f \<in> (invariants N)" and b2: "ini \<in> {andList (allInitSpecs N)}" and b3: "formEval ini s"
  shows "formEval f s"
  proof -
  have c1: "(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__2  p__Inv0 p__Inv1)\<or>
    (\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__3  p__Inv0 p__Inv1)"
  apply (cut_tac b1, simp) done
    moreover {
      assume d1: "(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__2  p__Inv0 p__Inv1)"
      have "formEval f s"
      apply (rule iniImply_inv__2)
      apply (cut_tac d1, assumption)
      apply (cut_tac b2 b3, blast) done
    }

    moreover {
      assume d1: "(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__3  p__Inv0 p__Inv1)"
      have "formEval f s"
      apply (rule iniImply_inv__3)
      apply (cut_tac d1, assumption)
      apply (cut_tac b2 b3, blast) done
    }

  ultimately show "formEval f s"
  by satx
qed

end