(*  Title:      ZF/Induct/Multiset.thy
    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory

A definitional theory of multisets,
including a wellfoundedness proof for the multiset order.

The theory features ordinal multisets and the usual ordering.
*)

theory Multiset
imports FoldSet Acc
begin

abbreviation (input)
  \<comment> \<open>Short cut for multiset space\<close>
  Mult :: "i=>i" where
  "Mult(A) == A -||> nat-{0}"

definition
  (* This is the original "restrict" from ZF.thy.
     Restricts the function f to the domain A
     FIXME: adapt Multiset to the new "restrict". *)
  funrestrict :: "[i,i] => i"  where
  "funrestrict(f,A) == \<lambda>x \<in> A. f`x"

definition
  (* M is a multiset *)
  multiset :: "i => o"  where
  "multiset(M) == \<exists>A. M \<in> A -> nat-{0} & Finite(A)"

definition
  mset_of :: "i=>i"  where
  "mset_of(M) == domain(M)"

definition
  munion    :: "[i, i] => i" (infixl "+#" 65)  where
  "M +# N == \<lambda>x \<in> mset_of(M) \<union> mset_of(N).
     if x \<in> mset_of(M) \<inter> mset_of(N) then  (M`x) #+ (N`x)
     else (if x \<in> mset_of(M) then M`x else N`x)"

definition
  (*convert a function to a multiset by eliminating 0*)
  normalize :: "i => i"  where
  "normalize(f) ==
       if (\<exists>A. f \<in> A -> nat & Finite(A)) then
            funrestrict(f, {x \<in> mset_of(f). 0 < f`x})
       else 0"

definition
  mdiff  :: "[i, i] => i" (infixl "-#" 65)  where
  "M -# N ==  normalize(\<lambda>x \<in> mset_of(M).
                        if x \<in> mset_of(N) then M`x #- N`x else M`x)"

definition
  (* set of elements of a multiset *)
  msingle :: "i => i"    ("{#_#}")  where
  "{#a#} == {<a, 1>}"

definition
  MCollect :: "[i, i=>o] => i"  (*comprehension*)  where
  "MCollect(M, P) == funrestrict(M, {x \<in> mset_of(M). P(x)})"

definition
  (* Counts the number of occurrences of an element in a multiset *)
  mcount :: "[i, i] => i"  where
  "mcount(M, a) == if a \<in> mset_of(M) then  M`a else 0"

definition
  msize :: "i => i"  where
  "msize(M) == setsum(%a. $# mcount(M,a), mset_of(M))"

abbreviation
  melem :: "[i,i] => o"    ("(_/ :# _)" [50, 51] 50)  where
  "a :# M == a \<in> mset_of(M)"

syntax
  "_MColl" :: "[pttrn, i, o] => i" ("(1{# _ \<in> _./ _#})")
translations
  "{#x \<in> M. P#}" == "CONST MCollect(M, \<lambda>x. P)"

  (* multiset orderings *)

definition
   (* multirel1 has to be a set (not a predicate) so that we can form
      its transitive closure and reason about wf(.) and acc(.) *)
  multirel1 :: "[i,i]=>i"  where
  "multirel1(A, r) ==
     {<M, N> \<in> Mult(A)*Mult(A).
      \<exists>a \<in> A. \<exists>M0 \<in> Mult(A). \<exists>K \<in> Mult(A).
      N=M0 +# {#a#} & M=M0 +# K & (\<forall>b \<in> mset_of(K). <b,a> \<in> r)}"

definition
  multirel :: "[i, i] => i"  where
  "multirel(A, r) == multirel1(A, r)^+"

  (* ordinal multiset orderings *)

definition
  omultiset :: "i => o"  where
  "omultiset(M) == \<exists>i. Ord(i) & M \<in> Mult(field(Memrel(i)))"

definition
  mless :: "[i, i] => o" (infixl "<#" 50)  where
  "M <# N ==  \<exists>i. Ord(i) & <M, N> \<in> multirel(field(Memrel(i)), Memrel(i))"

definition
  mle  :: "[i, i] => o"  (infixl "<#=" 50)  where
  "M <#= N == (omultiset(M) & M = N) | M <# N"

subsection\<open>Properties of the original "restrict" from ZF.thy\<close>

lemma funrestrict_subset: "[| f \<in> Pi(C,B);  A\<subseteq>C |] ==> funrestrict(f,A) \<subseteq> f"
by (auto simp add: funrestrict_def lam_def intro: apply_Pair)

lemma funrestrict_type:
    "[| !!x. x \<in> A ==> f`x \<in> B(x) |] ==> funrestrict(f,A) \<in> Pi(A,B)"
by (simp add: funrestrict_def lam_type)

lemma funrestrict_type2: "[| f \<in> Pi(C,B);  A\<subseteq>C |] ==> funrestrict(f,A) \<in> Pi(A,B)"
by (blast intro: apply_type funrestrict_type)

lemma funrestrict [simp]: "a \<in> A ==> funrestrict(f,A) ` a = f`a"
by (simp add: funrestrict_def)

lemma funrestrict_empty [simp]: "funrestrict(f,0) = 0"
by (simp add: funrestrict_def)

lemma domain_funrestrict [simp]: "domain(funrestrict(f,C)) = C"
by (auto simp add: funrestrict_def lam_def)

lemma fun_cons_funrestrict_eq:
     "f \<in> cons(a, b) -> B ==> f = cons(<a, f ` a>, funrestrict(f, b))"
apply (rule equalityI)
prefer 2 apply (blast intro: apply_Pair funrestrict_subset [THEN subsetD])
apply (auto dest!: Pi_memberD simp add: funrestrict_def lam_def)
done

declare domain_of_fun [simp]
declare domainE [rule del]

text\<open>A useful simplification rule\<close>
lemma multiset_fun_iff:
     "(f \<in> A -> nat-{0}) \<longleftrightarrow> f \<in> A->nat&(\<forall>a \<in> A. f`a \<in> nat & 0 < f`a)"
apply safe
apply (rule_tac [4] B1 = "range (f) " in Pi_mono [THEN subsetD])
apply (auto intro!: Ord_0_lt
            dest: apply_type Diff_subset [THEN Pi_mono, THEN subsetD]
            simp add: range_of_fun apply_iff)
done

(** The multiset space  **)
lemma multiset_into_Mult: "[| multiset(M); mset_of(M)\<subseteq>A |] ==> M \<in> Mult(A)"
apply (simp add: multiset_def)
apply (auto simp add: multiset_fun_iff mset_of_def)
apply (rule_tac B1 = "nat-{0}" in FiniteFun_mono [THEN subsetD], simp_all)
apply (rule Finite_into_Fin [THEN [2] Fin_mono [THEN subsetD], THEN fun_FiniteFunI])
apply (simp_all (no_asm_simp) add: multiset_fun_iff)
done

lemma Mult_into_multiset: "M \<in> Mult(A) ==> multiset(M) & mset_of(M)\<subseteq>A"
apply (simp add: multiset_def mset_of_def)
apply (frule FiniteFun_is_fun)
apply (drule FiniteFun_domain_Fin)
apply (frule FinD, clarify)
apply (rule_tac x = "domain (M) " in exI)
apply (blast intro: Fin_into_Finite)
done

lemma Mult_iff_multiset: "M \<in> Mult(A) \<longleftrightarrow> multiset(M) & mset_of(M)\<subseteq>A"
by (blast dest: Mult_into_multiset intro: multiset_into_Mult)

lemma multiset_iff_Mult_mset_of: "multiset(M) \<longleftrightarrow> M \<in> Mult(mset_of(M))"
by (auto simp add: Mult_iff_multiset)

text\<open>The @{term multiset} operator\<close>

(* the empty multiset is 0 *)

lemma multiset_0 [simp]: "multiset(0)"
by (auto intro: FiniteFun.intros simp add: multiset_iff_Mult_mset_of)

text\<open>The @{term mset_of} operator\<close>

lemma multiset_set_of_Finite [simp]: "multiset(M) ==> Finite(mset_of(M))"
by (simp add: multiset_def mset_of_def, auto)

lemma mset_of_0 [iff]: "mset_of(0) = 0"
by (simp add: mset_of_def)

lemma mset_is_0_iff: "multiset(M) ==> mset_of(M)=0 \<longleftrightarrow> M=0"
by (auto simp add: multiset_def mset_of_def)

lemma mset_of_single [iff]: "mset_of({#a#}) = {a}"
by (simp add: msingle_def mset_of_def)

lemma mset_of_union [iff]: "mset_of(M +# N) = mset_of(M) \<union> mset_of(N)"
by (simp add: mset_of_def munion_def)

lemma mset_of_diff [simp]: "mset_of(M)\<subseteq>A ==> mset_of(M -# N) \<subseteq> A"
by (auto simp add: mdiff_def multiset_def normalize_def mset_of_def)

(* msingle *)

lemma msingle_not_0 [iff]: "{#a#} \<noteq> 0 & 0 \<noteq> {#a#}"
by (simp add: msingle_def)

lemma msingle_eq_iff [iff]: "({#a#} = {#b#}) \<longleftrightarrow>  (a = b)"
by (simp add: msingle_def)

lemma msingle_multiset [iff,TC]: "multiset({#a#})"
apply (simp add: multiset_def msingle_def)
apply (rule_tac x = "{a}" in exI)
apply (auto intro: Finite_cons Finite_0 fun_extend3)
done

(** normalize **)

lemmas Collect_Finite = Collect_subset [THEN subset_Finite]

lemma normalize_idem [simp]: "normalize(normalize(f)) = normalize(f)"
apply (simp add: normalize_def funrestrict_def mset_of_def)
apply (case_tac "\<exists>A. f \<in> A -> nat & Finite (A) ")
apply clarify
apply (drule_tac x = "{x \<in> domain (f) . 0 < f ` x}" in spec)
apply auto
apply (auto  intro!: lam_type simp add: Collect_Finite)
done

lemma normalize_multiset [simp]: "multiset(M) ==> normalize(M) = M"
by (auto simp add: multiset_def normalize_def mset_of_def funrestrict_def multiset_fun_iff)

lemma multiset_normalize [simp]: "multiset(normalize(f))"
apply (simp add: normalize_def)
apply (simp add: normalize_def mset_of_def multiset_def, auto)
apply (rule_tac x = "{x \<in> A . 0<f`x}" in exI)
apply (auto intro: Collect_subset [THEN subset_Finite] funrestrict_type)
done

(** Typechecking rules for union and difference of multisets **)

(* union *)

lemma munion_multiset [simp]: "[| multiset(M); multiset(N) |] ==> multiset(M +# N)"
apply (unfold multiset_def munion_def mset_of_def, auto)
apply (rule_tac x = "A \<union> Aa" in exI)
apply (auto intro!: lam_type intro: Finite_Un simp add: multiset_fun_iff zero_less_add)
done

(* difference *)

lemma mdiff_multiset [simp]: "multiset(M -# N)"
by (simp add: mdiff_def)

(** Algebraic properties of multisets **)

(* Union *)

lemma munion_0 [simp]: "multiset(M) ==> M +# 0 = M & 0 +# M = M"
apply (simp add: multiset_def)
apply (auto simp add: munion_def mset_of_def)
done

lemma munion_commute: "M +# N = N +# M"
by (auto intro!: lam_cong simp add: munion_def)

lemma munion_assoc: "(M +# N) +# K = M +# (N +# K)"
apply (unfold munion_def mset_of_def)
apply (rule lam_cong, auto)
done

lemma munion_lcommute: "M +# (N +# K) = N +# (M +# K)"
apply (unfold munion_def mset_of_def)
apply (rule lam_cong, auto)
done

lemmas munion_ac = munion_commute munion_assoc munion_lcommute

(* Difference *)

lemma mdiff_self_eq_0 [simp]: "M -# M = 0"
by (simp add: mdiff_def normalize_def mset_of_def)

lemma mdiff_0 [simp]: "0 -# M = 0"
by (simp add: mdiff_def normalize_def)

lemma mdiff_0_right [simp]: "multiset(M) ==> M -# 0 = M"
by (auto simp add: multiset_def mdiff_def normalize_def multiset_fun_iff mset_of_def funrestrict_def)

lemma mdiff_union_inverse2 [simp]: "multiset(M) ==> M +# {#a#} -# {#a#} = M"
apply (unfold multiset_def munion_def mdiff_def msingle_def normalize_def mset_of_def)
apply (auto cong add: if_cong simp add: ltD multiset_fun_iff funrestrict_def subset_Un_iff2 [THEN iffD1])
prefer 2 apply (force intro!: lam_type)
apply (subgoal_tac [2] "{x \<in> A \<union> {a} . x \<noteq> a \<and> x \<in> A} = A")
apply (rule fun_extension, auto)
apply (drule_tac x = "A \<union> {a}" in spec)
apply (simp add: Finite_Un)
apply (force intro!: lam_type)
done

(** Count of elements **)

lemma mcount_type [simp,TC]: "multiset(M) ==> mcount(M, a) \<in> nat"
by (auto simp add: multiset_def mcount_def mset_of_def multiset_fun_iff)

lemma mcount_0 [simp]: "mcount(0, a) = 0"
by (simp add: mcount_def)

lemma mcount_single [simp]: "mcount({#b#}, a) = (if a=b then 1 else 0)"
by (simp add: mcount_def mset_of_def msingle_def)

lemma mcount_union [simp]: "[| multiset(M); multiset(N) |]
                     ==>  mcount(M +# N, a) = mcount(M, a) #+ mcount (N, a)"
apply (auto simp add: multiset_def multiset_fun_iff mcount_def munion_def mset_of_def)
done

lemma mcount_diff [simp]:
     "multiset(M) ==> mcount(M -# N, a) = mcount(M, a) #- mcount(N, a)"
apply (simp add: multiset_def)
apply (auto dest!: not_lt_imp_le
     simp add: mdiff_def multiset_fun_iff mcount_def normalize_def mset_of_def)
apply (force intro!: lam_type)
apply (force intro!: lam_type)
done

lemma mcount_elem: "[| multiset(M); a \<in> mset_of(M) |] ==> 0 < mcount(M, a)"
apply (simp add: multiset_def, clarify)
apply (simp add: mcount_def mset_of_def)
apply (simp add: multiset_fun_iff)
done

(** msize **)

lemma msize_0 [simp]: "msize(0) = #0"
by (simp add: msize_def)

lemma msize_single [simp]: "msize({#a#}) = #1"
by (simp add: msize_def)

lemma msize_type [simp,TC]: "msize(M) \<in> int"
by (simp add: msize_def)

lemma msize_zpositive: "multiset(M)==> #0 $\<le> msize(M)"
by (auto simp add: msize_def intro: g_zpos_imp_setsum_zpos)

lemma msize_int_of_nat: "multiset(M) ==> \<exists>n \<in> nat. msize(M)= $# n"
apply (rule not_zneg_int_of)
apply (simp_all (no_asm_simp) add: msize_type [THEN znegative_iff_zless_0] not_zless_iff_zle msize_zpositive)
done

lemma not_empty_multiset_imp_exist:
     "[| M\<noteq>0; multiset(M) |] ==> \<exists>a \<in> mset_of(M). 0 < mcount(M, a)"
apply (simp add: multiset_def)
apply (erule not_emptyE)
apply (auto simp add: mset_of_def mcount_def multiset_fun_iff)
apply (blast dest!: fun_is_rel)
done

lemma msize_eq_0_iff: "multiset(M) ==> msize(M)=#0 \<longleftrightarrow> M=0"
apply (simp add: msize_def, auto)
apply (rule_tac P = "setsum (u,v) \<noteq> #0" for u v in swap)
apply blast
apply (drule not_empty_multiset_imp_exist, assumption, clarify)
apply (subgoal_tac "Finite (mset_of (M) - {a}) ")
 prefer 2 apply (simp add: Finite_Diff)
apply (subgoal_tac "setsum (%x. $# mcount (M, x), cons (a, mset_of (M) -{a}))=#0")
 prefer 2 apply (simp add: cons_Diff, simp)
apply (subgoal_tac "#0 $\<le> setsum (%x. $# mcount (M, x), mset_of (M) - {a}) ")
apply (rule_tac [2] g_zpos_imp_setsum_zpos)
apply (auto simp add: Finite_Diff not_zless_iff_zle [THEN iff_sym] znegative_iff_zless_0 [THEN iff_sym])
apply (rule not_zneg_int_of [THEN bexE])
apply (auto simp del: int_of_0 simp add: int_of_add [symmetric] int_of_0 [symmetric])
done

lemma setsum_mcount_Int:
     "Finite(A) ==> setsum(%a. $# mcount(N, a), A \<inter> mset_of(N))
                  = setsum(%a. $# mcount(N, a), A)"
apply (induct rule: Finite_induct)
 apply auto
apply (subgoal_tac "Finite (B \<inter> mset_of (N))")
prefer 2 apply (blast intro: subset_Finite)
apply (auto simp add: mcount_def Int_cons_left)
done

lemma msize_union [simp]:
     "[| multiset(M); multiset(N) |] ==> msize(M +# N) = msize(M) $+ msize(N)"
apply (simp add: msize_def setsum_Un setsum_addf int_of_add setsum_mcount_Int)
apply (subst Int_commute)
apply (simp add: setsum_mcount_Int)
done

lemma msize_eq_succ_imp_elem: "[|msize(M)= $# succ(n); n \<in> nat|] ==> \<exists>a. a \<in> mset_of(M)"
apply (unfold msize_def)
apply (blast dest: setsum_succD)
done

(** Equality of multisets **)

lemma equality_lemma:
     "[| multiset(M); multiset(N); \<forall>a. mcount(M, a)=mcount(N, a) |]
      ==> mset_of(M)=mset_of(N)"
apply (simp add: multiset_def)
apply (rule sym, rule equalityI)
apply (auto simp add: multiset_fun_iff mcount_def mset_of_def)
apply (drule_tac [!] x=x in spec)
apply (case_tac [2] "x \<in> Aa", case_tac "x \<in> A", auto)
done

lemma multiset_equality:
  "[| multiset(M); multiset(N) |]==> M=N\<longleftrightarrow>(\<forall>a. mcount(M, a)=mcount(N, a))"
apply auto
apply (subgoal_tac "mset_of (M) = mset_of (N) ")
prefer 2 apply (blast intro: equality_lemma)
apply (simp add: multiset_def mset_of_def)
apply (auto simp add: multiset_fun_iff)
apply (rule fun_extension)
apply (blast, blast)
apply (drule_tac x = x in spec)
apply (auto simp add: mcount_def mset_of_def)
done

(** More algebraic properties of multisets **)

lemma munion_eq_0_iff [simp]: "[|multiset(M); multiset(N)|]==>(M +# N =0) \<longleftrightarrow> (M=0 & N=0)"
by (auto simp add: multiset_equality)

lemma empty_eq_munion_iff [simp]: "[|multiset(M); multiset(N)|]==>(0=M +# N) \<longleftrightarrow> (M=0 & N=0)"
apply (rule iffI, drule sym)
apply (simp_all add: multiset_equality)
done

lemma munion_right_cancel [simp]:
     "[| multiset(M); multiset(N); multiset(K) |]==>(M +# K = N +# K)\<longleftrightarrow>(M=N)"
by (auto simp add: multiset_equality)

lemma munion_left_cancel [simp]:
  "[|multiset(K); multiset(M); multiset(N)|] ==>(K +# M = K +# N) \<longleftrightarrow> (M = N)"
by (auto simp add: multiset_equality)

lemma nat_add_eq_1_cases: "[| m \<in> nat; n \<in> nat |] ==> (m #+ n = 1) \<longleftrightarrow> (m=1 & n=0) | (m=0 & n=1)"
by (induct_tac n) auto

lemma munion_is_single:
     "[|multiset(M); multiset(N)|]
      ==> (M +# N = {#a#}) \<longleftrightarrow>  (M={#a#} & N=0) | (M = 0 & N = {#a#})"
apply (simp (no_asm_simp) add: multiset_equality)
apply safe
apply simp_all
apply (case_tac "aa=a")
apply (drule_tac [2] x = aa in spec)
apply (drule_tac x = a in spec)
apply (simp add: nat_add_eq_1_cases, simp)
apply (case_tac "aaa=aa", simp)
apply (drule_tac x = aa in spec)
apply (simp add: nat_add_eq_1_cases)
apply (case_tac "aaa=a")
apply (drule_tac [4] x = aa in spec)
apply (drule_tac [3] x = a in spec)
apply (drule_tac [2] x = aaa in spec)
apply (drule_tac x = aa in spec)
apply (simp_all add: nat_add_eq_1_cases)
done

lemma msingle_is_union: "[| multiset(M); multiset(N) |]
  ==> ({#a#} = M +# N) \<longleftrightarrow> ({#a#} = M  & N=0 | M = 0 & {#a#} = N)"
apply (subgoal_tac " ({#a#} = M +# N) \<longleftrightarrow> (M +# N = {#a#}) ")
apply (simp (no_asm_simp) add: munion_is_single)
apply blast
apply (blast dest: sym)
done

(** Towards induction over multisets **)

lemma setsum_decr:
"Finite(A)
  ==>  (\<forall>M. multiset(M) \<longrightarrow>
  (\<forall>a \<in> mset_of(M). setsum(%z. $# mcount(M(a:=M`a #- 1), z), A) =
  (if a \<in> A then setsum(%z. $# mcount(M, z), A) $- #1
           else setsum(%z. $# mcount(M, z), A))))"
apply (unfold multiset_def)
apply (erule Finite_induct)
apply (auto simp add: multiset_fun_iff)
apply (unfold mset_of_def mcount_def)
apply (case_tac "x \<in> A", auto)
apply (subgoal_tac "$# M ` x $+ #-1 = $# M ` x $- $# 1")
apply (erule ssubst)
apply (rule int_of_diff, auto)
done

lemma setsum_decr2:
     "Finite(A)
      ==> \<forall>M. multiset(M) \<longrightarrow> (\<forall>a \<in> mset_of(M).
           setsum(%x. $# mcount(funrestrict(M, mset_of(M)-{a}), x), A) =
           (if a \<in> A then setsum(%x. $# mcount(M, x), A) $- $# M`a
            else setsum(%x. $# mcount(M, x), A)))"
apply (simp add: multiset_def)
apply (erule Finite_induct)
apply (auto simp add: multiset_fun_iff mcount_def mset_of_def)
done

lemma setsum_decr3: "[| Finite(A); multiset(M); a \<in> mset_of(M) |]
      ==> setsum(%x. $# mcount(funrestrict(M, mset_of(M)-{a}), x), A - {a}) =
          (if a \<in> A then setsum(%x. $# mcount(M, x), A) $- $# M`a
           else setsum(%x. $# mcount(M, x), A))"
apply (subgoal_tac "setsum (%x. $# mcount (funrestrict (M, mset_of (M) -{a}),x),A-{a}) = setsum (%x. $# mcount (funrestrict (M, mset_of (M) -{a}),x),A) ")
apply (rule_tac [2] setsum_Diff [symmetric])
apply (rule sym, rule ssubst, blast)
apply (rule sym, drule setsum_decr2, auto)
apply (simp add: mcount_def mset_of_def)
done

lemma nat_le_1_cases: "n \<in> nat ==> n \<le> 1 \<longleftrightarrow> (n=0 | n=1)"
by (auto elim: natE)

lemma succ_pred_eq_self: "[| 0<n; n \<in> nat |] ==> succ(n #- 1) = n"
apply (subgoal_tac "1 \<le> n")
apply (drule add_diff_inverse2, auto)
done

text\<open>Specialized for use in the proof below.\<close>
lemma multiset_funrestict:
     "\<lbrakk>\<forall>a\<in>A. M ` a \<in> nat \<and> 0 < M ` a; Finite(A)\<rbrakk>
      \<Longrightarrow> multiset(funrestrict(M, A - {a}))"
apply (simp add: multiset_def multiset_fun_iff)
apply (rule_tac x="A-{a}" in exI)
apply (auto intro: Finite_Diff funrestrict_type)
done

lemma multiset_induct_aux:
  assumes prem1: "!!M a. [| multiset(M); a\<notin>mset_of(M); P(M) |] ==> P(cons(<a, 1>, M))"
      and prem2: "!!M b. [| multiset(M); b \<in> mset_of(M); P(M) |] ==> P(M(b:= M`b #+ 1))"
  shows
  "[| n \<in> nat; P(0) |]
     ==> (\<forall>M. multiset(M)\<longrightarrow>
  (setsum(%x. $# mcount(M, x), {x \<in> mset_of(M). 0 < M`x}) = $# n) \<longrightarrow> P(M))"
apply (erule nat_induct, clarify)
apply (frule msize_eq_0_iff)
apply (auto simp add: mset_of_def multiset_def multiset_fun_iff msize_def)
apply (subgoal_tac "setsum (%x. $# mcount (M, x), A) =$# succ (x) ")
apply (drule setsum_succD, auto)
apply (case_tac "1 <M`a")
apply (drule_tac [2] not_lt_imp_le)
apply (simp_all add: nat_le_1_cases)
apply (subgoal_tac "M= (M (a:=M`a #- 1)) (a:= (M (a:=M`a #- 1))`a #+ 1) ")
apply (rule_tac [2] A = A and B = "%x. nat" and D = "%x. nat" in fun_extension)
apply (rule_tac [3] update_type)+
apply (simp_all (no_asm_simp))
 apply (rule_tac [2] impI)
 apply (rule_tac [2] succ_pred_eq_self [symmetric])
apply (simp_all (no_asm_simp))
apply (rule subst, rule sym, blast, rule prem2)
apply (simp (no_asm) add: multiset_def multiset_fun_iff)
apply (rule_tac x = A in exI)
apply (force intro: update_type)
apply (simp (no_asm_simp) add: mset_of_def mcount_def)
apply (drule_tac x = "M (a := M ` a #- 1) " in spec)
apply (drule mp, drule_tac [2] mp, simp_all)
apply (rule_tac x = A in exI)
apply (auto intro: update_type)
apply (subgoal_tac "Finite ({x \<in> cons (a, A) . x\<noteq>a\<longrightarrow>0<M`x}) ")
prefer 2 apply (blast intro: Collect_subset [THEN subset_Finite] Finite_cons)
apply (drule_tac A = "{x \<in> cons (a, A) . x\<noteq>a\<longrightarrow>0<M`x}" in setsum_decr)
apply (drule_tac x = M in spec)
apply (subgoal_tac "multiset (M) ")
 prefer 2
 apply (simp add: multiset_def multiset_fun_iff)
 apply (rule_tac x = A in exI, force)
apply (simp_all add: mset_of_def)
apply (drule_tac psi = "\<forall>x \<in> A. u(x)" for u in asm_rl)
apply (drule_tac x = a in bspec)
apply (simp (no_asm_simp))
apply (subgoal_tac "cons (a, A) = A")
prefer 2 apply blast
apply simp
apply (subgoal_tac "M=cons (<a, M`a>, funrestrict (M, A-{a}))")
 prefer 2
 apply (rule fun_cons_funrestrict_eq)
 apply (subgoal_tac "cons (a, A-{a}) = A")
  apply force
  apply force
apply (rule_tac a = "cons (<a, 1>, funrestrict (M, A - {a}))" in ssubst)
apply simp
apply (frule multiset_funrestict, assumption)
apply (rule prem1, assumption)
apply (simp add: mset_of_def)
apply (drule_tac x = "funrestrict (M, A-{a}) " in spec)
apply (drule mp)
apply (rule_tac x = "A-{a}" in exI)
apply (auto intro: Finite_Diff funrestrict_type simp add: funrestrict)
apply (frule_tac A = A and M = M and a = a in setsum_decr3)
apply (simp (no_asm_simp) add: multiset_def multiset_fun_iff)
apply blast
apply (simp (no_asm_simp) add: mset_of_def)
apply (drule_tac b = "if u then v else w" for u v w in sym, simp_all)
apply (subgoal_tac "{x \<in> A - {a} . 0 < funrestrict (M, A - {x}) ` x} = A - {a}")
apply (auto intro!: setsum_cong simp add: zdiff_eq_iff zadd_commute multiset_def multiset_fun_iff mset_of_def)
done

lemma multiset_induct2:
  "[| multiset(M); P(0);
    (!!M a. [| multiset(M); a\<notin>mset_of(M); P(M) |] ==> P(cons(<a, 1>, M)));
    (!!M b. [| multiset(M); b \<in> mset_of(M);  P(M) |] ==> P(M(b:= M`b #+ 1))) |]
     ==> P(M)"
apply (subgoal_tac "\<exists>n \<in> nat. setsum (\<lambda>x. $# mcount (M, x), {x \<in> mset_of (M) . 0 < M ` x}) = $# n")
apply (rule_tac [2] not_zneg_int_of)
apply (simp_all (no_asm_simp) add: znegative_iff_zless_0 not_zless_iff_zle)
apply (rule_tac [2] g_zpos_imp_setsum_zpos)
prefer 2 apply (blast intro:  multiset_set_of_Finite Collect_subset [THEN subset_Finite])
 prefer 2 apply (simp add: multiset_def multiset_fun_iff, clarify)
apply (rule multiset_induct_aux [rule_format], auto)
done

lemma munion_single_case1:
     "[| multiset(M); a \<notin>mset_of(M) |] ==> M +# {#a#} = cons(<a, 1>, M)"
apply (simp add: multiset_def msingle_def)
apply (auto simp add: munion_def)
apply (unfold mset_of_def, simp)
apply (rule fun_extension, rule lam_type, simp_all)
apply (auto simp add: multiset_fun_iff fun_extend_apply)
apply (drule_tac c = a and b = 1 in fun_extend3)
apply (auto simp add: cons_eq Un_commute [of _ "{a}"])
done

lemma munion_single_case2:
     "[| multiset(M); a \<in> mset_of(M) |] ==> M +# {#a#} = M(a:=M`a #+ 1)"
apply (simp add: multiset_def)
apply (auto simp add: munion_def multiset_fun_iff msingle_def)
apply (unfold mset_of_def, simp)
apply (subgoal_tac "A \<union> {a} = A")
apply (rule fun_extension)
apply (auto dest: domain_type intro: lam_type update_type)
done

(* Induction principle for multisets *)

lemma multiset_induct:
  assumes M: "multiset(M)"
      and P0: "P(0)"
      and step: "!!M a. [| multiset(M); P(M) |] ==> P(M +# {#a#})"
  shows "P(M)"
apply (rule multiset_induct2 [OF M])
apply (simp_all add: P0)
apply (frule_tac [2] a = b in munion_single_case2 [symmetric])
apply (frule_tac a = a in munion_single_case1 [symmetric])
apply (auto intro: step)
done

(** MCollect **)

lemma MCollect_multiset [simp]:
     "multiset(M) ==> multiset({# x \<in> M. P(x)#})"
apply (simp add: MCollect_def multiset_def mset_of_def, clarify)
apply (rule_tac x = "{x \<in> A. P (x) }" in exI)
apply (auto dest: CollectD1 [THEN [2] apply_type]
            intro: Collect_subset [THEN subset_Finite] funrestrict_type)
done

lemma mset_of_MCollect [simp]:
     "multiset(M) ==> mset_of({# x \<in> M. P(x) #}) \<subseteq> mset_of(M)"
by (auto simp add: mset_of_def MCollect_def multiset_def funrestrict_def)

lemma MCollect_mem_iff [iff]:
     "x \<in> mset_of({#x \<in> M. P(x)#}) \<longleftrightarrow>  x \<in> mset_of(M) & P(x)"
by (simp add: MCollect_def mset_of_def)

lemma mcount_MCollect [simp]:
     "mcount({# x \<in> M. P(x) #}, a) = (if P(a) then mcount(M,a) else 0)"
by (simp add: mcount_def MCollect_def mset_of_def)

lemma multiset_partition: "multiset(M) ==> M = {# x \<in> M. P(x) #} +# {# x \<in> M. ~ P(x) #}"
by (simp add: multiset_equality)

lemma natify_elem_is_self [simp]:
     "[| multiset(M); a \<in> mset_of(M) |] ==> natify(M`a) = M`a"
by (auto simp add: multiset_def mset_of_def multiset_fun_iff)

(* and more algebraic laws on multisets *)

lemma munion_eq_conv_diff: "[| multiset(M); multiset(N) |]
  ==>  (M +# {#a#} = N +# {#b#}) \<longleftrightarrow>  (M = N & a = b |
       M = N -# {#a#} +# {#b#} & N = M -# {#b#} +# {#a#})"
apply (simp del: mcount_single add: multiset_equality)
apply (rule iffI, erule_tac [2] disjE, erule_tac [3] conjE)
apply (case_tac "a=b", auto)
apply (drule_tac x = a in spec)
apply (drule_tac [2] x = b in spec)
apply (drule_tac [3] x = aa in spec)
apply (drule_tac [4] x = a in spec, auto)
apply (subgoal_tac [!] "mcount (N,a) :nat")
apply (erule_tac [3] natE, erule natE, auto)
done

lemma melem_diff_single:
"multiset(M) ==>
  k \<in> mset_of(M -# {#a#}) \<longleftrightarrow> (k=a & 1 < mcount(M,a)) | (k\<noteq> a & k \<in> mset_of(M))"
apply (simp add: multiset_def)
apply (simp add: normalize_def mset_of_def msingle_def mdiff_def mcount_def)
apply (auto dest: domain_type intro: zero_less_diff [THEN iffD1]
            simp add: multiset_fun_iff apply_iff)
apply (force intro!: lam_type)
apply (force intro!: lam_type)
apply (force intro!: lam_type)
done

lemma munion_eq_conv_exist:
"[| M \<in> Mult(A); N \<in> Mult(A) |]
  ==> (M +# {#a#} = N +# {#b#}) \<longleftrightarrow>
      (M=N & a=b | (\<exists>K \<in> Mult(A). M= K +# {#b#} & N=K +# {#a#}))"
by (auto simp add: Mult_iff_multiset melem_diff_single munion_eq_conv_diff)

subsection\<open>Multiset Orderings\<close>

(* multiset on a domain A are finite functions from A to nat-{0} *)

(* multirel1 type *)

lemma multirel1_type: "multirel1(A, r) \<subseteq> Mult(A)*Mult(A)"
by (auto simp add: multirel1_def)

lemma multirel1_0 [simp]: "multirel1(0, r) =0"
by (auto simp add: multirel1_def)

lemma multirel1_iff:
" <N, M> \<in> multirel1(A, r) \<longleftrightarrow>
  (\<exists>a. a \<in> A &
  (\<exists>M0. M0 \<in> Mult(A) & (\<exists>K. K \<in> Mult(A) &
   M=M0 +# {#a#} & N=M0 +# K & (\<forall>b \<in> mset_of(K). <b,a> \<in> r))))"
by (auto simp add: multirel1_def Mult_iff_multiset Bex_def)

text\<open>Monotonicity of @{term multirel1}\<close>

lemma multirel1_mono1: "A\<subseteq>B ==> multirel1(A, r)\<subseteq>multirel1(B, r)"
apply (auto simp add: multirel1_def)
apply (auto simp add: Un_subset_iff Mult_iff_multiset)
apply (rule_tac x = a in bexI)
apply (rule_tac x = M0 in bexI, simp)
apply (rule_tac x = K in bexI)
apply (auto simp add: Mult_iff_multiset)
done

lemma multirel1_mono2: "r\<subseteq>s ==> multirel1(A,r)\<subseteq>multirel1(A, s)"
apply (simp add: multirel1_def, auto)
apply (rule_tac x = a in bexI)
apply (rule_tac x = M0 in bexI)
apply (simp_all add: Mult_iff_multiset)
apply (rule_tac x = K in bexI)
apply (simp_all add: Mult_iff_multiset, auto)
done

lemma multirel1_mono:
     "[| A\<subseteq>B; r\<subseteq>s |] ==> multirel1(A, r) \<subseteq> multirel1(B, s)"
apply (rule subset_trans)
apply (rule multirel1_mono1)
apply (rule_tac [2] multirel1_mono2, auto)
done

subsection\<open>Toward the proof of well-foundedness of multirel1\<close>

lemma not_less_0 [iff]: "<M,0> \<notin> multirel1(A, r)"
by (auto simp add: multirel1_def Mult_iff_multiset)

lemma less_munion: "[| <N, M0 +# {#a#}> \<in> multirel1(A, r); M0 \<in> Mult(A) |] ==>
  (\<exists>M. <M, M0> \<in> multirel1(A, r) & N = M +# {#a#}) |
  (\<exists>K. K \<in> Mult(A) & (\<forall>b \<in> mset_of(K). <b, a> \<in> r) & N = M0 +# K)"
apply (frule multirel1_type [THEN subsetD])
apply (simp add: multirel1_iff)
apply (auto simp add: munion_eq_conv_exist)
apply (rule_tac x="Ka +# K" in exI, auto, simp add: Mult_iff_multiset)
apply (simp (no_asm_simp) add: munion_left_cancel munion_assoc)
apply (auto simp add: munion_commute)
done

lemma multirel1_base: "[| M \<in> Mult(A); a \<in> A |] ==> <M, M +# {#a#}> \<in> multirel1(A, r)"
apply (auto simp add: multirel1_iff)
apply (simp add: Mult_iff_multiset)
apply (rule_tac x = a in exI, clarify)
apply (rule_tac x = M in exI, simp)
apply (rule_tac x = 0 in exI, auto)
done

lemma acc_0: "acc(0)=0"
by (auto intro!: equalityI dest: acc.dom_subset [THEN subsetD])

lemma lemma1: "[| \<forall>b \<in> A. <b,a> \<in> r \<longrightarrow>
    (\<forall>M \<in> acc(multirel1(A, r)). M +# {#b#}:acc(multirel1(A, r)));
    M0 \<in> acc(multirel1(A, r)); a \<in> A;
    \<forall>M. <M,M0> \<in> multirel1(A, r) \<longrightarrow> M +# {#a#} \<in> acc(multirel1(A, r)) |]
  ==> M0 +# {#a#} \<in> acc(multirel1(A, r))"
apply (subgoal_tac "M0 \<in> Mult(A) ")
 prefer 2
 apply (erule acc.cases)
 apply (erule fieldE)
 apply (auto dest: multirel1_type [THEN subsetD])
apply (rule accI)
apply (rename_tac "N")
apply (drule less_munion, blast)
apply (auto simp add: Mult_iff_multiset)
apply (erule_tac P = "\<forall>x \<in> mset_of (K) . <x, a> \<in> r" in rev_mp)
apply (erule_tac P = "mset_of (K) \<subseteq>A" in rev_mp)
apply (erule_tac M = K in multiset_induct)
(* three subgoals *)
(* subgoal 1 \<in> the induction base case *)
apply (simp (no_asm_simp))
(* subgoal 2 \<in> the induction general case *)
apply (simp add: Ball_def Un_subset_iff, clarify)
apply (drule_tac x = aa in spec, simp)
apply (subgoal_tac "aa \<in> A")
prefer 2 apply blast
apply (drule_tac x = "M0 +# M" and P =
       "%x. x \<in> acc(multirel1(A, r)) \<longrightarrow> Q(x)" for Q in spec)
apply (simp add: munion_assoc [symmetric])
(* subgoal 3 \<in> additional conditions *)
apply (auto intro!: multirel1_base [THEN fieldI2] simp add: Mult_iff_multiset)
done

lemma lemma2: "[| \<forall>b \<in> A. <b,a> \<in> r
   \<longrightarrow> (\<forall>M \<in> acc(multirel1(A, r)). M +# {#b#} :acc(multirel1(A, r)));
        M \<in> acc(multirel1(A, r)); a \<in> A|] ==> M +# {#a#} \<in> acc(multirel1(A, r))"
apply (erule acc_induct)
apply (blast intro: lemma1)
done

lemma lemma3: "[| wf[A](r); a \<in> A |]
      ==> \<forall>M \<in> acc(multirel1(A, r)). M +# {#a#} \<in> acc(multirel1(A, r))"
apply (erule_tac a = a in wf_on_induct, blast)
apply (blast intro: lemma2)
done

lemma lemma4: "multiset(M) ==> mset_of(M)\<subseteq>A \<longrightarrow>
   wf[A](r) \<longrightarrow> M \<in> field(multirel1(A, r)) \<longrightarrow> M \<in> acc(multirel1(A, r))"
apply (erule multiset_induct)
(* proving the base case *)
apply clarify
apply (rule accI, force)
apply (simp add: multirel1_def)
(* Proving the general case *)
apply clarify
apply simp
apply (subgoal_tac "mset_of (M) \<subseteq>A")
prefer 2 apply blast
apply clarify
apply (drule_tac a = a in lemma3, blast)
apply (subgoal_tac "M \<in> field (multirel1 (A,r))")
apply blast
apply (rule multirel1_base [THEN fieldI1])
apply (auto simp add: Mult_iff_multiset)
done

lemma all_accessible: "[| wf[A](r); M \<in> Mult(A); A \<noteq> 0|] ==> M \<in> acc(multirel1(A, r))"
apply (erule not_emptyE)
apply  (rule lemma4 [THEN mp, THEN mp, THEN mp])
apply (rule_tac [4] multirel1_base [THEN fieldI1])
apply  (auto simp add: Mult_iff_multiset)
done

lemma wf_on_multirel1: "wf[A](r) ==> wf[A-||>nat-{0}](multirel1(A, r))"
apply (case_tac "A=0")
apply (simp (no_asm_simp))
apply (rule wf_imp_wf_on)
apply (rule wf_on_field_imp_wf)
apply (simp (no_asm_simp) add: wf_on_0)
apply (rule_tac A = "acc (multirel1 (A,r))" in wf_on_subset_A)
apply (rule wf_on_acc)
apply (blast intro: all_accessible)
done

lemma wf_multirel1: "wf(r) ==>wf(multirel1(field(r), r))"
apply (simp (no_asm_use) add: wf_iff_wf_on_field)
apply (drule wf_on_multirel1)
apply (rule_tac A = "field (r) -||> nat - {0}" in wf_on_subset_A)
apply (simp (no_asm_simp))
apply (rule field_rel_subset)
apply (rule multirel1_type)
done

(** multirel **)

lemma multirel_type: "multirel(A, r) \<subseteq> Mult(A)*Mult(A)"
apply (simp add: multirel_def)
apply (rule trancl_type [THEN subset_trans])
apply (auto dest: multirel1_type [THEN subsetD])
done

(* Monotonicity of multirel *)
lemma multirel_mono:
     "[| A\<subseteq>B; r\<subseteq>s |] ==> multirel(A, r)\<subseteq>multirel(B,s)"
apply (simp add: multirel_def)
apply (rule trancl_mono)
apply (rule multirel1_mono, auto)
done

(* Equivalence of multirel with the usual (closure-free) definition *)

lemma add_diff_eq: "k \<in> nat ==> 0 < k \<longrightarrow> n #+ k #- 1 = n #+ (k #- 1)"
by (erule nat_induct, auto)

lemma mdiff_union_single_conv: "[|a \<in> mset_of(J); multiset(I); multiset(J) |]
   ==> I +# J -# {#a#} = I +# (J-# {#a#})"
apply (simp (no_asm_simp) add: multiset_equality)
apply (case_tac "a \<notin> mset_of (I) ")
apply (auto simp add: mcount_def mset_of_def multiset_def multiset_fun_iff)
apply (auto dest: domain_type simp add: add_diff_eq)
done

lemma diff_add_commute: "[| n \<le> m;  m \<in> nat; n \<in> nat; k \<in> nat |] ==> m #- n #+ k = m #+ k #- n"
by (auto simp add: le_iff less_iff_succ_add)

(* One direction *)

lemma multirel_implies_one_step:
"<M,N> \<in> multirel(A, r) ==>
     trans[A](r) \<longrightarrow>
     (\<exists>I J K.
         I \<in> Mult(A) & J \<in> Mult(A) &  K \<in> Mult(A) &
         N = I +# J & M = I +# K & J \<noteq> 0 &
        (\<forall>k \<in> mset_of(K). \<exists>j \<in> mset_of(J). <k,j> \<in> r))"
apply (simp add: multirel_def Ball_def Bex_def)
apply (erule converse_trancl_induct)
apply (simp_all add: multirel1_iff Mult_iff_multiset)
(* Two subgoals remain *)
(* Subgoal 1 *)
apply clarify
apply (rule_tac x = M0 in exI, force)
(* Subgoal 2 *)
apply clarify
apply hypsubst_thin
apply (case_tac "a \<in> mset_of (Ka) ")
apply (rule_tac x = I in exI, simp (no_asm_simp))
apply (rule_tac x = J in exI, simp (no_asm_simp))
apply (rule_tac x = " (Ka -# {#a#}) +# K" in exI, simp (no_asm_simp))
apply (simp_all add: Un_subset_iff)
apply (simp (no_asm_simp) add: munion_assoc [symmetric])
apply (drule_tac t = "%M. M-#{#a#}" in subst_context)
apply (simp add: mdiff_union_single_conv melem_diff_single, clarify)
apply (erule disjE, simp)
apply (erule disjE, simp)
apply (drule_tac x = a and P = "%x. x :# Ka \<longrightarrow> Q(x)" for Q in spec)
apply clarify
apply (rule_tac x = xa in exI)
apply (simp (no_asm_simp))
apply (blast dest: trans_onD)
(* new we know that  a\<notin>mset_of(Ka) *)
apply (subgoal_tac "a :# I")
apply (rule_tac x = "I-#{#a#}" in exI, simp (no_asm_simp))
apply (rule_tac x = "J+#{#a#}" in exI)
apply (simp (no_asm_simp) add: Un_subset_iff)
apply (rule_tac x = "Ka +# K" in exI)
apply (simp (no_asm_simp) add: Un_subset_iff)
apply (rule conjI)
apply (simp (no_asm_simp) add: multiset_equality mcount_elem [THEN succ_pred_eq_self])
apply (rule conjI)
apply (drule_tac t = "%M. M-#{#a#}" in subst_context)
apply (simp add: mdiff_union_inverse2)
apply (simp_all (no_asm_simp) add: multiset_equality)
apply (rule diff_add_commute [symmetric])
apply (auto intro: mcount_elem)
apply (subgoal_tac "a \<in> mset_of (I +# Ka) ")
apply (drule_tac [2] sym, auto)
done

lemma melem_imp_eq_diff_union [simp]: "[| a \<in> mset_of(M); multiset(M) |] ==> M -# {#a#} +# {#a#} = M"
by (simp add: multiset_equality mcount_elem [THEN succ_pred_eq_self])

lemma msize_eq_succ_imp_eq_union:
     "[| msize(M)=$# succ(n); M \<in> Mult(A); n \<in> nat |]
      ==> \<exists>a N. M = N +# {#a#} & N \<in> Mult(A) & a \<in> A"
apply (drule msize_eq_succ_imp_elem, auto)
apply (rule_tac x = a in exI)
apply (rule_tac x = "M -# {#a#}" in exI)
apply (frule Mult_into_multiset)
apply (simp (no_asm_simp))
apply (auto simp add: Mult_iff_multiset)
done

(* The second direction *)

lemma one_step_implies_multirel_lemma [rule_format (no_asm)]:
"n \<in> nat ==>
   (\<forall>I J K.
    I \<in> Mult(A) & J \<in> Mult(A) & K \<in> Mult(A) &
   (msize(J) = $# n & J \<noteq>0 &  (\<forall>k \<in> mset_of(K).  \<exists>j \<in> mset_of(J). <k, j> \<in> r))
    \<longrightarrow> <I +# K, I +# J> \<in> multirel(A, r))"
apply (simp add: Mult_iff_multiset)
apply (erule nat_induct, clarify)
apply (drule_tac M = J in msize_eq_0_iff, auto)
(* one subgoal remains *)
apply (subgoal_tac "msize (J) =$# succ (x) ")
 prefer 2 apply simp
apply (frule_tac A = A in msize_eq_succ_imp_eq_union)
apply (simp_all add: Mult_iff_multiset, clarify)
apply (rename_tac "J'", simp)
apply (case_tac "J' = 0")
apply (simp add: multirel_def)
apply (rule r_into_trancl, clarify)
apply (simp add: multirel1_iff Mult_iff_multiset, force)
(*Now we know J' \<noteq>  0*)
apply (drule sym, rotate_tac -1, simp)
apply (erule_tac V = "$# x = msize (J') " in thin_rl)
apply (frule_tac M = K and P = "%x. <x,a> \<in> r" in multiset_partition)
apply (erule_tac P = "\<forall>k \<in> mset_of (K) . P(k)" for P in rev_mp)
apply (erule ssubst)
apply (simp add: Ball_def, auto)
apply (subgoal_tac "< (I +# {# x \<in> K. <x, a> \<in> r#}) +# {# x \<in> K. <x, a> \<notin> r#}, (I +# {# x \<in> K. <x, a> \<in> r#}) +# J'> \<in> multirel(A, r) ")
 prefer 2
 apply (drule_tac x = "I +# {# x \<in> K. <x, a> \<in> r#}" in spec)
 apply (rotate_tac -1)
 apply (drule_tac x = "J'" in spec)
 apply (rotate_tac -1)
 apply (drule_tac x = "{# x \<in> K. <x, a> \<notin> r#}" in spec, simp) apply blast
apply (simp add: munion_assoc [symmetric] multirel_def)
apply (rule_tac b = "I +# {# x \<in> K. <x, a> \<in> r#} +# J'" in trancl_trans, blast)
apply (rule r_into_trancl)
apply (simp add: multirel1_iff Mult_iff_multiset)
apply (rule_tac x = a in exI)
apply (simp (no_asm_simp))
apply (rule_tac x = "I +# J'" in exI)
apply (auto simp add: munion_ac Un_subset_iff)
done

lemma one_step_implies_multirel:
     "[| J \<noteq> 0;  \<forall>k \<in> mset_of(K). \<exists>j \<in> mset_of(J). <k,j> \<in> r;
         I \<in> Mult(A); J \<in> Mult(A); K \<in> Mult(A) |]
      ==> <I+#K, I+#J> \<in> multirel(A, r)"
apply (subgoal_tac "multiset (J) ")
 prefer 2 apply (simp add: Mult_iff_multiset)
apply (frule_tac M = J in msize_int_of_nat)
apply (auto intro: one_step_implies_multirel_lemma)
done

(** Proving that multisets are partially ordered **)

(*irreflexivity*)

lemma multirel_irrefl_lemma:
     "Finite(A) ==> part_ord(A, r) \<longrightarrow> (\<forall>x \<in> A. \<exists>y \<in> A. <x,y> \<in> r) \<longrightarrow>A=0"
apply (erule Finite_induct)
apply (auto dest: subset_consI [THEN [2] part_ord_subset])
apply (auto simp add: part_ord_def irrefl_def)
apply (drule_tac x = xa in bspec)
apply (drule_tac [2] a = xa and b = x in trans_onD, auto)
done

lemma irrefl_on_multirel:
     "part_ord(A, r) ==> irrefl(Mult(A), multirel(A, r))"
apply (simp add: irrefl_def)
apply (subgoal_tac "trans[A](r) ")
 prefer 2 apply (simp add: part_ord_def, clarify)
apply (drule multirel_implies_one_step, clarify)
apply (simp add: Mult_iff_multiset, clarify)
apply (subgoal_tac "Finite (mset_of (K))")
apply (frule_tac r = r in multirel_irrefl_lemma)
apply (frule_tac B = "mset_of (K) " in part_ord_subset)
apply simp_all
apply (auto simp add: multiset_def mset_of_def)
done

lemma trans_on_multirel: "trans[Mult(A)](multirel(A, r))"
apply (simp add: multirel_def trans_on_def)
apply (blast intro: trancl_trans)
done

lemma multirel_trans:
 "[| <M, N> \<in> multirel(A, r); <N, K> \<in> multirel(A, r) |] ==>  <M, K> \<in> multirel(A,r)"
apply (simp add: multirel_def)
apply (blast intro: trancl_trans)
done

lemma trans_multirel: "trans(multirel(A,r))"
apply (simp add: multirel_def)
apply (rule trans_trancl)
done

lemma part_ord_multirel: "part_ord(A,r) ==> part_ord(Mult(A), multirel(A, r))"
apply (simp (no_asm) add: part_ord_def)
apply (blast intro: irrefl_on_multirel trans_on_multirel)
done

(** Monotonicity of multiset union **)

lemma munion_multirel1_mono:
"[|<M,N> \<in> multirel1(A, r); K \<in> Mult(A) |] ==> <K +# M, K +# N> \<in> multirel1(A, r)"
apply (frule multirel1_type [THEN subsetD])
apply (auto simp add: multirel1_iff Mult_iff_multiset)
apply (rule_tac x = a in exI)
apply (simp (no_asm_simp))
apply (rule_tac x = "K+#M0" in exI)
apply (simp (no_asm_simp) add: Un_subset_iff)
apply (rule_tac x = Ka in exI)
apply (simp (no_asm_simp) add: munion_assoc)
done

lemma munion_multirel_mono2:
 "[| <M, N> \<in> multirel(A, r); K \<in> Mult(A) |]==><K +# M, K +# N> \<in> multirel(A, r)"
apply (frule multirel_type [THEN subsetD])
apply (simp (no_asm_use) add: multirel_def)
apply clarify
apply (drule_tac psi = "<M,N> \<in> multirel1 (A, r) ^+" in asm_rl)
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule trancl_induct, clarify)
apply (blast intro: munion_multirel1_mono r_into_trancl, clarify)
apply (subgoal_tac "y \<in> Mult(A) ")
 prefer 2
 apply (blast dest: multirel_type [unfolded multirel_def, THEN subsetD])
apply (subgoal_tac "<K +# y, K +# z> \<in> multirel1 (A, r) ")
prefer 2 apply (blast intro: munion_multirel1_mono)
apply (blast intro: r_into_trancl trancl_trans)
done

lemma munion_multirel_mono1:
     "[|<M, N> \<in> multirel(A, r); K \<in> Mult(A)|] ==> <M +# K, N +# K> \<in> multirel(A, r)"
apply (frule multirel_type [THEN subsetD])
apply (rule_tac P = "%x. <x,u> \<in> multirel(A, r)" for u in munion_commute [THEN subst])
apply (subst munion_commute [of N])
apply (rule munion_multirel_mono2)
apply (auto simp add: Mult_iff_multiset)
done

lemma munion_multirel_mono:
     "[|<M,K> \<in> multirel(A, r); <N,L> \<in> multirel(A, r)|]
      ==> <M +# N, K +# L> \<in> multirel(A, r)"
apply (subgoal_tac "M \<in> Mult(A) & N \<in> Mult(A) & K \<in> Mult(A) & L \<in> Mult(A) ")
prefer 2 apply (blast dest: multirel_type [THEN subsetD])
apply (blast intro: munion_multirel_mono1 multirel_trans munion_multirel_mono2)
done

subsection\<open>Ordinal Multisets\<close>

(* A \<subseteq> B ==>  field(Memrel(A)) \<subseteq> field(Memrel(B)) *)
lemmas field_Memrel_mono = Memrel_mono [THEN field_mono]

(*
[| Aa \<subseteq> Ba; A \<subseteq> B |] ==>
multirel(field(Memrel(Aa)), Memrel(A))\<subseteq> multirel(field(Memrel(Ba)), Memrel(B))
*)

lemmas multirel_Memrel_mono = multirel_mono [OF field_Memrel_mono Memrel_mono]

lemma omultiset_is_multiset [simp]: "omultiset(M) ==> multiset(M)"
apply (simp add: omultiset_def)
apply (auto simp add: Mult_iff_multiset)
done

lemma munion_omultiset [simp]: "[| omultiset(M); omultiset(N) |] ==> omultiset(M +# N)"
apply (simp add: omultiset_def, clarify)
apply (rule_tac x = "i \<union> ia" in exI)
apply (simp add: Mult_iff_multiset Ord_Un Un_subset_iff)
apply (blast intro: field_Memrel_mono)
done

lemma mdiff_omultiset [simp]: "omultiset(M) ==> omultiset(M -# N)"
apply (simp add: omultiset_def, clarify)
apply (simp add: Mult_iff_multiset)
apply (rule_tac x = i in exI)
apply (simp (no_asm_simp))
done

(** Proving that Memrel is a partial order **)

lemma irrefl_Memrel: "Ord(i) ==> irrefl(field(Memrel(i)), Memrel(i))"
apply (rule irreflI, clarify)
apply (subgoal_tac "Ord (x) ")
prefer 2 apply (blast intro: Ord_in_Ord)
apply (drule_tac i = x in ltI [THEN lt_irrefl], auto)
done

lemma trans_iff_trans_on: "trans(r) \<longleftrightarrow> trans[field(r)](r)"
by (simp add: trans_on_def trans_def, auto)

lemma part_ord_Memrel: "Ord(i) ==>part_ord(field(Memrel(i)), Memrel(i))"
apply (simp add: part_ord_def)
apply (simp (no_asm) add: trans_iff_trans_on [THEN iff_sym])
apply (blast intro: trans_Memrel irrefl_Memrel)
done

(*
  Ord(i) ==>
  part_ord(field(Memrel(i))-||>nat-{0}, multirel(field(Memrel(i)), Memrel(i)))
*)

lemmas part_ord_mless = part_ord_Memrel [THEN part_ord_multirel]

(*irreflexivity*)

lemma mless_not_refl: "~(M <# M)"
apply (simp add: mless_def, clarify)
apply (frule multirel_type [THEN subsetD])
apply (drule part_ord_mless)
apply (simp add: part_ord_def irrefl_def)
done

(* N<N ==> R *)
lemmas mless_irrefl = mless_not_refl [THEN notE, elim!]

(*transitivity*)
lemma mless_trans: "[| K <# M; M <# N |] ==> K <# N"
apply (simp add: mless_def, clarify)
apply (rule_tac x = "i \<union> ia" in exI)
apply (blast dest: multirel_Memrel_mono [OF Un_upper1 Un_upper1, THEN subsetD]
                   multirel_Memrel_mono [OF Un_upper2 Un_upper2, THEN subsetD]
        intro: multirel_trans Ord_Un)
done

(*asymmetry*)
lemma mless_not_sym: "M <# N ==> ~ N <# M"
apply clarify
apply (rule mless_not_refl [THEN notE])
apply (erule mless_trans, assumption)
done

lemma mless_asym: "[| M <# N; ~P ==> N <# M |] ==> P"
by (blast dest: mless_not_sym)

lemma mle_refl [simp]: "omultiset(M) ==> M <#= M"
by (simp add: mle_def)

(*anti-symmetry*)
lemma mle_antisym:
     "[| M <#= N;  N <#= M |] ==> M = N"
apply (simp add: mle_def)
apply (blast dest: mless_not_sym)
done

(*transitivity*)
lemma mle_trans: "[| K <#= M; M <#= N |] ==> K <#= N"
apply (simp add: mle_def)
apply (blast intro: mless_trans)
done

lemma mless_le_iff: "M <# N \<longleftrightarrow> (M <#= N & M \<noteq> N)"
by (simp add: mle_def, auto)

(** Monotonicity of mless **)

lemma munion_less_mono2: "[| M <# N; omultiset(K) |] ==> K +# M <# K +# N"
apply (simp add: mless_def omultiset_def, clarify)
apply (rule_tac x = "i \<union> ia" in exI)
apply (simp add: Mult_iff_multiset Ord_Un Un_subset_iff)
apply (rule munion_multirel_mono2)
 apply (blast intro: multirel_Memrel_mono [THEN subsetD])
apply (simp add: Mult_iff_multiset)
apply (blast intro: field_Memrel_mono [THEN subsetD])
done

lemma munion_less_mono1: "[| M <# N; omultiset(K) |] ==> M +# K <# N +# K"
by (force dest: munion_less_mono2 simp add: munion_commute)

lemma mless_imp_omultiset: "M <# N ==> omultiset(M) & omultiset(N)"
by (auto simp add: mless_def omultiset_def dest: multirel_type [THEN subsetD])

lemma munion_less_mono: "[| M <# K; N <# L |] ==> M +# N <# K +# L"
apply (frule_tac M = M in mless_imp_omultiset)
apply (frule_tac M = N in mless_imp_omultiset)
apply (blast intro: munion_less_mono1 munion_less_mono2 mless_trans)
done

(* <#= *)

lemma mle_imp_omultiset: "M <#= N ==> omultiset(M) & omultiset(N)"
by (auto simp add: mle_def mless_imp_omultiset)

lemma mle_mono: "[| M <#= K;  N <#= L |] ==> M +# N <#= K +# L"
apply (frule_tac M = M in mle_imp_omultiset)
apply (frule_tac M = N in mle_imp_omultiset)
apply (auto simp add: mle_def intro: munion_less_mono1 munion_less_mono2 munion_less_mono)
done

lemma omultiset_0 [iff]: "omultiset(0)"
by (auto simp add: omultiset_def Mult_iff_multiset)

lemma empty_leI [simp]: "omultiset(M) ==> 0 <#= M"
apply (simp add: mle_def mless_def)
apply (subgoal_tac "\<exists>i. Ord (i) & M \<in> Mult(field(Memrel(i))) ")
 prefer 2 apply (simp add: omultiset_def)
apply (case_tac "M=0", simp_all, clarify)
apply (subgoal_tac "<0 +# 0, 0 +# M> \<in> multirel(field (Memrel(i)), Memrel(i))")
apply (rule_tac [2] one_step_implies_multirel)
apply (auto simp add: Mult_iff_multiset)
done

lemma munion_upper1: "[| omultiset(M); omultiset(N) |] ==> M <#= M +# N"
apply (subgoal_tac "M +# 0 <#= M +# N")
apply (rule_tac [2] mle_mono, auto)
done

end


section \<open>Rely Quotient Operator \label{S:rely-quotient}\<close>

text \<open>
  The rely quotient operator is used to generalise a Jones-style rely condition
  to a process \<^cite>\<open>"jon83a"\<close>.
  It is defined in terms of the parallel operator and a process $i$
  representing interference from the environment.
\<close>

theory Rely_Quotient
imports
  CRA
  Conjunctive_Iteration
begin

subsection \<open>Basic rely quotient\<close>

text \<open>
  The rely quotient of a process $c$ and an interference process $i$
  is the most general process $d$ such that $c$ is refined by $d \parallel i$.
  The following locale introduces the definition of the
  rely quotient $c \quotient i$ as a non-deterministic choice over
  all processes $d$ such that $c$ is refined by $d \parallel i$.
\<close>

locale rely_quotient = par_distrib + conjunction_parallel
begin

definition
  rely_quotient :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "'/'/" 85)
where
  "c // i \<equiv> \<Sqinter>{ d. (c \<sqsubseteq> d \<parallel> i)}"

text \<open>
  Any process $c$ is implemented by itself if the interference is skip.
\<close>
lemma quotient_identity: "c // skip = c"
proof -
  have "c // skip = \<Sqinter>{ d. (c \<sqsubseteq> d \<parallel> skip) }" by (metis rely_quotient_def)
  then have "c // skip = \<Sqinter>{ d. (c \<sqsubseteq> d)  }" by (metis (mono_tags, lifting) Collect_cong par_skip)
  thus ?thesis by (metis Inf_greatest Inf_lower2 dual_order.antisym dual_order.refl mem_Collect_eq)
qed

text \<open>
  Provided the interference process $i$ is non-aborting (i.e. it refines chaos),
  any process $c$ is refined by its rely quotient with $i$ in parallel with $i$.
  If interference $i$ was allowed to be aborting then,
  because $(c \quotient \bot) \parallel \bot$ equals $\bot$,
  it does not refine $c$ in general.
\<close>
theorem rely_quotient:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  shows "c \<sqsubseteq> (c // i) \<parallel> i"
proof -
  define D where "D = { d \<parallel> i | d. (c \<sqsubseteq> d \<parallel> i)}"
  define C where "C = {c}"
  have "(\<forall>d \<in> D. (\<exists> c \<in> C. c \<sqsubseteq> d))" using D_def C_def CollectD singletonI by auto
  then have "\<Sqinter> C \<sqsubseteq> (\<Sqinter> D)" by (simp add: Inf_mono)
  then have "c \<sqsubseteq> \<Sqinter>{ d \<parallel> i | d. (c \<sqsubseteq> d \<parallel> i)}" by (simp add: C_def D_def)
  also have "... = \<Sqinter>{ d \<parallel> i | d. d \<in> {d. (c \<sqsubseteq> d \<parallel> i)}}" by simp
  also have "... = (\<Sqinter>d \<in> {d. (c \<sqsubseteq> d \<parallel> i)}. d \<parallel> i)" by (simp add: INF_Inf)
  also have "... = \<Sqinter>{ d | d. (c \<sqsubseteq> d \<parallel> i)} \<parallel> i"
  proof (cases "{ d | d. (c \<sqsubseteq> d \<parallel> i)} = {}")
    assume "{ d | d. (c \<sqsubseteq> d \<parallel> i)} = {}"
    then show "(\<Sqinter>d \<in> {d. (c \<sqsubseteq> d \<parallel> i)}. d \<parallel> i) = \<Sqinter>{ d | d. (c \<sqsubseteq> d \<parallel> i)} \<parallel> i"
      using nonabort_i Collect_empty_eq top_greatest
            nonabort_par_top par_commute by fastforce
  next
    assume a: "{ d | d. (c \<sqsubseteq> d \<parallel> i)} \<noteq> {}"
    have b: "{d. (c \<sqsubseteq> d \<parallel> i)}  \<noteq> {}" using a by blast
    then have "(\<Sqinter>d \<in> {d. (c \<sqsubseteq> d \<parallel> i)}. d \<parallel> i) = \<Sqinter>{ d. (c \<sqsubseteq> d \<parallel> i)} \<parallel> i"
      using Inf_par_distrib by simp
    then show ?thesis by auto
  qed
  also have "... = (c // i) \<parallel> i" by (metis rely_quotient_def)
  finally show ?thesis .
qed

text \<open>
  The following theorem represents the Galois connection between
  the parallel operator (upper adjoint) and the rely quotient operator
  (lower adjoint). This basic relationship is used to prove the majority
  of the theorems about rely quotient.
\<close>

theorem rely_refinement:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  shows "c // i \<sqsubseteq> d \<longleftrightarrow> c \<sqsubseteq> d \<parallel> i"
proof
  assume a: "c // i \<sqsubseteq> d"
  have "c \<sqsubseteq> (c // i) \<parallel> i" using rely_quotient nonabort_i by simp
  thus "c \<sqsubseteq> d \<parallel> i" using par_mono a
    by (metis inf.absorb_iff2 inf_commute le_infI2 order_refl)
next
  assume b: "c \<sqsubseteq> d \<parallel> i"
  then have "\<Sqinter>{ d. (c \<sqsubseteq> d \<parallel> i)} \<sqsubseteq> d" by (simp add: Inf_lower)
  thus "c // i \<sqsubseteq> d" by (metis rely_quotient_def)
qed

text \<open>
  Refining the ``numerator'' in a quotient, refines the quotient.
\<close>

lemma rely_mono:
  assumes c_refsto_d: "c \<sqsubseteq> d"
  shows "(c // i) \<sqsubseteq> (d // i)"
proof -
  have "\<And> f. ((d \<sqsubseteq> f \<parallel> i) \<Longrightarrow> \<exists> e. (c \<sqsubseteq> e \<parallel> i) \<and> (e \<sqsubseteq> f))"
    using c_refsto_d order.trans by blast
  then have b: "\<Sqinter>{ e. (c \<sqsubseteq> e \<parallel> i)} \<sqsubseteq>  \<Sqinter>{ f. (d \<sqsubseteq> f \<parallel> i)}"
    by (metis Inf_mono mem_Collect_eq)
  show ?thesis using rely_quotient_def b by simp
qed

text \<open>
  Refining the ``denominator'' in a quotient, gives a reverse refinement
  for the quotients. This corresponds to weaken rely condition law of
  Jones \<^cite>\<open>"jon83a"\<close>,
  i.e. assuming less about the environment.
\<close>

lemma weaken_rely:
  assumes i_refsto_j: "i \<sqsubseteq> j"
  shows "(c // j) \<sqsubseteq> (c // i)"
proof -
  have "\<And> f. ((c \<sqsubseteq> f \<parallel> i) \<Longrightarrow> \<exists> e. (c \<sqsubseteq> e \<parallel> j) \<and> (e \<sqsubseteq> f))"
    using i_refsto_j order.trans
    by (metis inf.absorb_iff2 inf_le1 inf_par_distrib inf_sup_ord(2) par_commute)
  then have b: "\<Sqinter>{ e. (c \<sqsubseteq> e \<parallel> j)} \<sqsubseteq>  \<Sqinter>{ f. (c \<sqsubseteq> f \<parallel> i)}"
    by (metis Inf_mono mem_Collect_eq)
  show ?thesis using rely_quotient_def b by simp
qed

lemma par_nonabort:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes nonabort_j: "chaos \<sqsubseteq> j"
  shows "chaos \<sqsubseteq> i \<parallel> j"
  by (meson chaos_par_chaos nonabort_i nonabort_j order_trans par_mono)

text \<open>
  Nesting rely quotients of $j$ and $i$ means the same as a single quotient
  which is the parallel composition of $i$ and $j$.
\<close>

lemma nested_rely:
  assumes j_nonabort: "chaos \<sqsubseteq> j"
  shows "((c // j) // i) = c // (i \<parallel> j)"
proof (rule antisym)
  show "((c // j) // i) \<sqsubseteq> c // (i \<parallel> j)"
  proof -
    have "\<And> f. ((c \<sqsubseteq> f \<parallel> i \<parallel> j) \<Longrightarrow> \<exists> e. (c \<sqsubseteq> e \<parallel> j) \<and> (e \<sqsubseteq> f \<parallel> i))" by blast
    then have "\<Sqinter>{ d. (\<Sqinter>{ e. (c \<sqsubseteq> e \<parallel> j)} \<sqsubseteq> d \<parallel> i)} \<sqsubseteq>  \<Sqinter>{ f. (c \<sqsubseteq> f \<parallel> i \<parallel> j)}"
      by (simp add: Collect_mono Inf_lower Inf_superset_mono)
    thus ?thesis using local.rely_quotient_def par_assoc by auto
  qed
next
  show "c // (i \<parallel> j) \<sqsubseteq> ((c // j) // i) "
  proof -
    have "c \<sqsubseteq> \<Sqinter>{ e. (c \<sqsubseteq> e \<parallel> j)} \<parallel> j"
      using j_nonabort local.rely_quotient_def rely_quotient by auto
    then have "\<And> d. \<Sqinter>{ e. (c \<sqsubseteq> e \<parallel> j)} \<sqsubseteq> d \<parallel> i  \<Longrightarrow> (c \<sqsubseteq> d \<parallel> i \<parallel> j)"
      by (meson j_nonabort order_trans rely_refinement)
    thus ?thesis
      by (simp add: Collect_mono Inf_superset_mono local.rely_quotient_def par_assoc)
  qed
qed

end

subsection \<open>Distributed rely quotient\<close>

locale rely_distrib = rely_quotient + conjunction_sequential
begin

text \<open>
  The following is a fundamental law for introducing a parallel composition
  of process to refine a conjunction of specifications.
  It represents an abstract view of the parallel introduction law of Jones \<^cite>\<open>"jon83a"\<close>.
\<close>

lemma introduce_parallel:
  assumes nonabort_i: "chaos \<sqsubseteq>  i"
  assumes nonabort_j: "chaos \<sqsubseteq>  j"
  shows "c \<iinter> d \<sqsubseteq>  (j \<iinter> (c // i)) \<parallel> (i \<iinter> (d // j))"
proof -
  have a: "c \<sqsubseteq> (c // i) \<parallel> i" using nonabort_i nonabort_j rely_quotient by auto
  have b: "d \<sqsubseteq> j \<parallel> (d // j)" using rely_quotient par_commute
    by (simp add: nonabort_j)
  have "c \<iinter> d \<sqsubseteq>  ((c // i) \<parallel> i) \<iinter> ( j \<parallel> (d // j))" using a b by (metis conj_mono)
  also have interchange: "c \<iinter> d \<sqsubseteq>  ((c // i) \<iinter> j) \<parallel> ( i \<iinter> (d // j))"
   using parallel_interchange refine_trans calculation by blast
  show ?thesis using interchange by (simp add: local.conj_commute)
qed

text \<open>
  Rely quotients satisfy a range of distribution properties with respect
  to the other operators.
\<close>

lemma distribute_rely_conjunction:
  assumes nonabort_i: "chaos \<sqsubseteq>  i"
  shows "(c \<iinter> d) // i  \<sqsubseteq>  (c // i) \<iinter> (d // i)"
proof -
  have "c \<iinter> d \<sqsubseteq> ((c // i) \<parallel> i) \<iinter> ((d // i) \<parallel> i)" using conj_mono rely_quotient
    by (simp add: nonabort_i)
  then have "c \<iinter> d \<sqsubseteq> ((c // i) \<iinter> (d // i)) \<parallel> (i \<iinter> i)"
    by (metis parallel_interchange refine_trans)
  then have "c \<iinter> d \<sqsubseteq> ((c // i) \<iinter> (d // i)) \<parallel> i" by (metis conj_idem)
  thus ?thesis using rely_refinement by (simp add: nonabort_i)
qed

lemma distribute_rely_choice:
  assumes nonabort_i: "chaos \<sqsubseteq>  i"
  shows "(c \<sqinter> d) // i  \<sqsubseteq>  (c // i) \<sqinter> (d // i)"
proof -
  have "c \<sqinter> d \<sqsubseteq> ((c // i) \<parallel> i) \<sqinter> ((d // i) \<parallel> i)"
    by (metis nonabort_i inf_mono rely_quotient)
  then have "c \<sqinter> d \<sqsubseteq> ((c // i) \<sqinter> (d // i)) \<parallel> i" by (metis inf_par_distrib)
  thus ?thesis by (metis nonabort_i rely_refinement)
qed

lemma distribute_rely_parallel1:
  assumes nonabort_i: "chaos \<sqsubseteq>  i"
  assumes nonabort_j: "chaos \<sqsubseteq>  j"
  shows "(c \<parallel> d) // (i \<parallel> j)  \<sqsubseteq>  (c // i) \<parallel> (d // j)"
proof -
  have "(c \<parallel> d) \<sqsubseteq> ((c // i) \<parallel> i) \<parallel> ((d // j) \<parallel> j)"
    using par_mono rely_quotient nonabort_i nonabort_j by simp
  then have "(c \<parallel> d) \<sqsubseteq> (c // i) \<parallel> (d // j) \<parallel> j \<parallel> i" by (metis par_assoc par_commute)
  thus ?thesis using par_assoc par_commute rely_refinement
    by (metis nonabort_i nonabort_j par_nonabort)
qed

lemma distribute_rely_parallel2:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes i_par_i: "i \<parallel> i \<sqsubseteq> i"
  shows "(c \<parallel> d) // i  \<sqsubseteq>  (c // i) \<parallel> (d // i)"
proof -
  have "(c \<parallel> d) // i \<sqsubseteq> ((c \<parallel> d) // (i \<parallel> i))" using assms(1) using weaken_rely
    by (simp add: i_par_i par_nonabort)
  thus ?thesis by (metis distribute_rely_parallel1 refine_trans nonabort_i)
qed

lemma distribute_rely_sequential:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes "(\<forall> c. (\<forall> d. ((c \<parallel> i);(d \<parallel> i) \<sqsubseteq> (c;d) \<parallel> i)))"
  shows "(c;d) // i \<sqsubseteq> (c // i);(d // i)"
proof -
  have "c;d \<sqsubseteq> ((c // i) \<parallel> i);((d // i) \<parallel> i)"
    by (metis rely_quotient nonabort_i seq_mono)
  then have "c;d \<sqsubseteq> (c // i) ; (d // i) \<parallel> i" using assms(2) by (metis refine_trans)
  thus ?thesis by (metis rely_refinement nonabort_i)
qed

lemma distribute_rely_sequential_event:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes nonabort_j: "chaos \<sqsubseteq> j"
  assumes nonabort_e: "chaos \<sqsubseteq> e"
  assumes "(\<forall> c. (\<forall> d. ((c \<parallel> i);e;(d \<parallel> j) \<sqsubseteq> (c;e;d) \<parallel> (i;e;j))))"
  shows "(c;e;d) // (i;e;j) \<sqsubseteq> (c // i);e;(d // j)"
proof -
  have "c;e;d \<sqsubseteq> ((c // i) \<parallel> i);e;((d // j) \<parallel> j)"
    by (metis order.refl rely_quotient nonabort_i nonabort_j seq_mono)
  then have "c;e;d \<sqsubseteq> ((c // i);e;(d // j)) \<parallel> (i;e;j)" using assms
    by (metis refine_trans)
  thus ?thesis using rely_refinement nonabort_i nonabort_j nonabort_e
    by (simp add: Inf_lower local.rely_quotient_def)
qed

lemma introduce_parallel_with_rely:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes nonabort_j0: "chaos \<sqsubseteq>  j\<^sub>0"
  assumes nonabort_j1: "chaos \<sqsubseteq>  j\<^sub>1"
  shows "(c \<iinter> d) // i \<sqsubseteq> (j\<^sub>1 \<iinter> (c // (j\<^sub>0 \<parallel> i))) \<parallel> (j\<^sub>0 \<iinter> (d // (j\<^sub>1 \<parallel> i)))"
proof -
  have "(c \<iinter> d) // i \<sqsubseteq> (c // i) \<iinter> (d // i)"
    by (metis distribute_rely_conjunction nonabort_i)
  then have "(c \<iinter> d) // i \<sqsubseteq> (j\<^sub>1 \<iinter> ((c // i) // j\<^sub>0)) \<parallel> (j\<^sub>0 \<iinter> ((d // i) // j\<^sub>1))"
    by (metis introduce_parallel nonabort_j0 nonabort_j1 inf_assoc inf.absorb_iff1)
  thus ?thesis by (simp add: nested_rely nonabort_i)
qed

lemma introduce_parallel_with_rely_guarantee:
  assumes nonabort_i: "chaos \<sqsubseteq>  i"
  assumes nonabort_j0: "chaos \<sqsubseteq>  j\<^sub>0"
  assumes nonabort_j1: "chaos \<sqsubseteq>  j\<^sub>1"
  shows "(j\<^sub>1 \<parallel> j\<^sub>0) \<iinter> (c \<iinter> d) // i \<sqsubseteq> (j\<^sub>1 \<iinter> (c // (j\<^sub>0 \<parallel> i))) \<parallel> (j\<^sub>0 \<iinter> (d // (j\<^sub>1 \<parallel> i)))"
proof -
  have "(j\<^sub>1 \<parallel> j\<^sub>0) \<iinter> (c \<iinter> d) // i \<sqsubseteq> (j\<^sub>1 \<parallel> j\<^sub>0) \<iinter> ((j\<^sub>1 \<iinter> (c // (j\<^sub>0 \<parallel> i))) \<parallel> (j\<^sub>0 \<iinter> (d // (j\<^sub>1 \<parallel> i))))"
    by (metis introduce_parallel_with_rely nonabort_i nonabort_j0 nonabort_j1
        conj_mono order.refl)
  also have "... \<sqsubseteq> (j\<^sub>1 \<iinter> j\<^sub>1 \<iinter> (c // (j\<^sub>0 \<parallel> i))) \<parallel> (j\<^sub>0 \<iinter> j\<^sub>0 \<iinter> (d // (j\<^sub>1 \<parallel> i)))"
    by (metis conj_assoc parallel_interchange)
  finally show ?thesis by (metis conj_idem)
qed

lemma wrap_rely_guar:
  assumes nonabort_rg: "chaos \<sqsubseteq> rg"
  and skippable: "rg \<sqsubseteq> skip"
  shows "c \<sqsubseteq> rg \<iinter> c // rg"
proof -
  have "c = c // skip" by (simp add: quotient_identity)
  also have "... \<sqsubseteq> c // rg" by (simp add: skippable weaken_rely nonabort_rg)
  also have "... \<sqsubseteq> rg \<iinter> c // rg" using conjoin_non_aborting conj_commute nonabort_rg
    by auto
  finally show "c \<sqsubseteq> rg \<iinter> c // rg" .
qed

end

locale rely_distrib_iteration = rely_distrib + iteration_finite_conjunctive

begin

lemma distribute_rely_iteration:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes "(\<forall> c. (\<forall> d. ((c \<parallel> i);(d \<parallel> i) \<sqsubseteq> (c;d) \<parallel> i)))"
  shows "(c\<^sup>\<omega>;d) // i \<sqsubseteq> (c // i)\<^sup>\<omega>;(d // i)"
proof -
  have "d \<sqinter> c ; ((c // i)\<^sup>\<omega>;(d // i) \<parallel> i) \<sqsubseteq> ((d // i) \<parallel> i) \<sqinter> ((c // i) \<parallel> i);((c // i)\<^sup>\<omega>;(d // i) \<parallel> i)"
    by (metis inf_mono order.refl rely_quotient nonabort_i seq_mono)
  also have "... \<sqsubseteq> ((d // i) \<parallel> i) \<sqinter> ((c // i);(c // i)\<^sup>\<omega>;(d // i) \<parallel> i )"
    using assms inf_mono_right seq_assoc by fastforce
  also have "... \<sqsubseteq> ((d // i) \<sqinter> (c // i);(c // i)\<^sup>\<omega>;(d // i)) \<parallel> i"
    by (simp add: inf_par_distrib)
  also have "... = ((c // i)\<^sup>\<omega>;(d // i)) \<parallel> i"
    by (metis iter_unfold inf_seq_distrib seq_nil_left)
  finally show ?thesis by (metis rely_refinement nonabort_i iter_induct)
qed

end

end


section \<open>Limit Sets\<close>
theory Limit_Set
  imports Invariance
begin

context auto_ll_on_open begin
text \<open>Positive limit point, assuming \<open>{0..} \<subseteq> existence_ivl0 x\<close>\<close>

(* TODO: Perhaps a more intrinsic definition would be better here *)
definition "\<omega>_limit_point x p \<longleftrightarrow>
  {0..} \<subseteq> existence_ivl0 x \<and>
  (\<exists>s. s \<longlonglongrightarrow>\<^bsub>\<^esub> \<infinity> \<and> (flow0 x \<circ> s) \<longlonglongrightarrow> p)"

text \<open> Also called the \<open>\<omega>\<close>-limit set of x \<close>
definition "\<omega>_limit_set x = {p. \<omega>_limit_point x p}"

definition "\<alpha>_limit_point x p \<longleftrightarrow>
  {..0} \<subseteq> existence_ivl0 x \<and>
  (\<exists>s. s \<longlonglongrightarrow>\<^bsub>\<^esub> -\<infinity> \<and> (flow0 x \<circ> s) \<longlonglongrightarrow> p)"

text \<open> Also called the \<open>\<alpha>\<close>-limit set of x \<close>
definition "\<alpha>_limit_set x =
  {p. \<alpha>_limit_point x p}"

end context auto_ll_on_open begin

lemma \<alpha>_limit_point_eq_rev: "\<alpha>_limit_point x p = rev.\<omega>_limit_point x p"
  unfolding \<alpha>_limit_point_def rev.\<omega>_limit_point_def
  apply (auto simp: rev_eq_flow[abs_def] o_def filterlim_uminus_at_bot rev_existence_ivl_eq0 subset_iff
      intro: exI[where x="uminus o s" for s])
  using neg_0_le_iff_le by fastforce

lemma \<alpha>_limit_set_eq_rev: "\<alpha>_limit_set x = rev.\<omega>_limit_set x"
  unfolding \<alpha>_limit_set_def rev.\<omega>_limit_set_def \<alpha>_limit_point_eq_rev ..

lemma \<omega>_limit_pointE:
  assumes "\<omega>_limit_point x p"
  obtains s where
    "filterlim s at_top sequentially"
    "(flow0 x \<circ> s) \<longlonglongrightarrow> p"
    "\<forall>n. b \<le> s n"
  using assms filterlim_at_top_choose_lower \<omega>_limit_point_def by blast

lemma \<omega>_limit_set_eq:
  assumes "{0..} \<subseteq> existence_ivl0 x"
  shows "\<omega>_limit_set x = (INF \<tau> \<in> {0..}. closure (flow0 x ` {\<tau>..}))"
  unfolding \<omega>_limit_set_def
proof safe
  fix p t
  assume pt: "0 \<le> (t::real)" "\<omega>_limit_point x p"
  from \<omega>_limit_pointE[OF pt(2)]
  obtain s where
    "filterlim s at_top sequentially"
    "(flow0 x \<circ> s) \<longlonglongrightarrow> p"
    "\<forall>n. t \<le> s n" by blast
  thus "p \<in> closure (flow0 x ` {t..})" unfolding closure_sequential
    by (metis atLeast_iff comp_apply imageI)
next
  fix p
  assume "p \<in> (\<Inter>\<tau>\<in>{0..}. closure (flow0 x ` {\<tau>..}))"
  then have "\<And>t. t \<ge>0 \<Longrightarrow> p \<in> closure (flow0 x ` {t..})" by blast
  then have "\<And>t e. t \<ge>0 \<Longrightarrow> e > 0 \<Longrightarrow> (\<exists>tt \<ge> t. dist (flow0 x tt) p < e)"
    unfolding closure_approachable
    by fastforce
  from approachable_sequenceE[OF this]
  obtain s where "filterlim s at_top sequentially" "(flow0 x \<circ> s) \<longlonglongrightarrow> p" by auto
  thus "\<omega>_limit_point x p" unfolding \<omega>_limit_point_def using assms by auto
qed

lemma \<omega>_limit_set_closed: "closed (\<omega>_limit_set x)"
  using \<omega>_limit_set_eq
  by (metis \<omega>_limit_set_empty closed_INT closed_closure closed_empty)

(* TODO: Walter gives a more direct proof *)
lemma \<omega>_limit_set_positively_invariant:
  shows "positively_invariant (\<omega>_limit_set x)"
  unfolding positively_invariant_def trapped_forward_def
proof safe
  fix dummy p t
  assume xa: "p \<in> \<omega>_limit_set x"
    "t \<in> existence_ivl0 p"
    "0 \<le> t"
  have "p \<in> X" using mem_existence_ivl_iv_defined(2) xa(2) by blast
  have exist: "{0..} \<subseteq> existence_ivl0 x" using xa(1)
    unfolding \<omega>_limit_set_def \<omega>_limit_point_def by auto
  from xa(1)
  obtain s where s:
    "filterlim s at_top sequentially"
    "(flow0 x \<circ> s) \<longlonglongrightarrow> p"
    "\<forall>n. 0 \<le> s n"
    unfolding \<omega>_limit_set_def by (auto elim!:\<omega>_limit_pointE)
  define r where "r = (\<lambda>n. t + s n)"
  have rlim: "filterlim r at_top sequentially" unfolding r_def
    by (auto intro: filterlim_tendsto_add_at_top[OF _ s(1)])
  define dom where "dom = image (flow0 x) {0..} \<union> {p} "
  have domin: "\<forall>n. (flow0 x \<circ> s) n \<in> dom" "p \<in> dom" unfolding dom_def o_def
    using exist by(auto simp add: s(3))
  have xt: "\<And>x. x \<in> dom \<Longrightarrow> t \<in> existence_ivl0 x" unfolding dom_def using xa(2)
    apply auto
    apply (rule existence_ivl_trans')
    using exist xa(3) apply auto[1]
    using exist  by auto
  have cont: "continuous_on dom (\<lambda>x. flow0 x t)"
    apply (rule flow_continuous_on_compose)
       apply auto
    using \<open>p \<in> X\<close>  exist local.dom_def local.flow_in_domain apply auto[1]
    using xt .
  then have f1: "((\<lambda>x. flow0 x t) \<circ> (flow0 x \<circ> s)) \<longlonglongrightarrow> flow0 p t" using domin s(2)
    unfolding continuous_on_sequentially
    by blast
  have ff:"\<And>n. (flow0 x \<circ> r) n = ((\<lambda>x. flow0 x t) \<circ> (flow0 x \<circ> s)) n"
    unfolding o_def r_def
  proof -
    fix n
    have s:"s n \<in> existence_ivl0 x"
      using s(3) exist by auto
    then have t:"t \<in> existence_ivl0 (flow0 x (s n))"
      using domin(1) xt by auto
    from flow_trans[OF s t]
    show "flow0 x (t + s n) = flow0 (flow0 x (s n)) t"
      by (simp add: add.commute)
  qed
  have f2: "(flow0 x \<circ> r) \<longlonglongrightarrow> flow0 p t" using f1 unfolding ff .
  show "flow0 p t \<in> \<omega>_limit_set x" using exist f2 rlim
    unfolding \<omega>_limit_set_def \<omega>_limit_point_def
    using flow_in_domain r_def s(3) xa(2) xa(3) by auto
qed

lemma \<omega>_limit_set_invariant:
  shows "invariant (\<omega>_limit_set x)"
  unfolding invariant_iff_pos_invariant_and_compl_pos_invariant
proof safe
  show "positively_invariant (\<omega>_limit_set x)"
    using \<omega>_limit_set_positively_invariant .
next
  show "positively_invariant (X - \<omega>_limit_set x)"
    unfolding positively_invariant_def trapped_forward_def
    apply safe
    using local.flow_in_domain apply blast
  proof -
    fix dummy p t
    assume xa: "p \<in> X" "p \<notin> \<omega>_limit_set x"
      "t \<in> existence_ivl0 p" "0 \<le> t"
      and f: "flow0 p t \<in> \<omega>_limit_set x"
    have exist: "{0..} \<subseteq> existence_ivl0 x" using f
      unfolding \<omega>_limit_set_def \<omega>_limit_point_def by auto
    from f
    obtain s where s:
      "filterlim s at_top sequentially"
      "(flow0 x \<circ> s) \<longlonglongrightarrow> flow0 p t"
      "\<forall>n. t \<le> s n"
      unfolding \<omega>_limit_set_def by (auto elim!:\<omega>_limit_pointE)
    define r where "r = (\<lambda>n. (-t) + s n)"
    have "(\<lambda>x. -t) \<longlonglongrightarrow> -t" by simp
    from filterlim_tendsto_add_at_top[OF this s(1)]
    have rlim: "filterlim r at_top sequentially" unfolding r_def by simp
    define dom where "dom = image (flow0 x) {t..} \<union> {flow0 p t} "
    have domin: "\<forall>n. (flow0 x \<circ> s) n \<in> dom" "flow0 p t \<in> dom" unfolding dom_def o_def
      using exist by(auto simp add: s(3))
    have xt: "\<And>x. x \<in> dom \<Longrightarrow> -t \<in> existence_ivl0 x" unfolding dom_def using xa(2)
      apply auto
      using local.existence_ivl_reverse xa(3) apply auto[1]
      by (metis exist atLeast_iff diff_conv_add_uminus diff_ge_0_iff_ge linordered_ab_group_add_class.zero_le_double_add_iff_zero_le_single_add local.existence_ivl_trans' order_trans subset_iff xa(4))
    have cont: "continuous_on dom (\<lambda>x. flow0 x (-t))"
      apply (rule flow_continuous_on_compose)
         apply auto
      using local.mem_existence_ivl_iv_defined(2) xt apply blast
      by (simp add: xt)
    then have f1: "((\<lambda>x. flow0 x (-t)) \<circ> (flow0 x \<circ> s)) \<longlonglongrightarrow> flow0 (flow0 p t) (-t)" using domin s(2)
      unfolding continuous_on_sequentially
      by blast
    have ff:"\<And>n. (flow0 x \<circ> r) n = ((\<lambda>x. flow0 x (-t)) \<circ> (flow0 x \<circ> s)) n"
      unfolding o_def r_def
    proof -
      fix n
      have s:"s n \<in> existence_ivl0 x"
        using s(3) exist \<open>0\<le> t\<close> by (meson atLeast_iff order_trans subset_eq)
      then have t:"-t \<in> existence_ivl0 (flow0 x (s n))"
        using domin(1) xt by auto
      from flow_trans[OF s t]
      show "flow0 x (-t + s n) = flow0 (flow0 x (s n)) (-t)"
        by (simp add: add.commute)
    qed
    have "(flow0 x \<circ> r) \<longlonglongrightarrow> flow0 (flow0 p t) (-t)" using f1 unfolding ff .
    then have f2: "(flow0 x \<circ> r) \<longlonglongrightarrow> p" using flows_reverse xa(3) by auto
    then have "p \<in> \<omega>_limit_set x" unfolding \<omega>_limit_set_def \<omega>_limit_point_def
      using rlim exist by auto
    thus False using xa(2) by auto
  qed
qed

end context auto_ll_on_open begin

lemma \<alpha>_limit_set_eq:
  assumes "{..0} \<subseteq> existence_ivl0 x"
  shows "\<alpha>_limit_set x = (INF \<tau> \<in> {..0}. closure (flow0 x ` {..\<tau>}))"
  using rev.\<omega>_limit_set_eq[of x, OF assms[folded infinite_rev_existence_ivl0_rewrites]]
  unfolding \<alpha>_limit_set_eq_rev rev_flow_image_eq image_uminus_atLeast
  by (smt INT_extend_simps(10) Sup.SUP_cong image_uminus_atMost)

lemma \<alpha>_limit_set_closed:
  shows "closed (\<alpha>_limit_set x)"
  unfolding \<alpha>_limit_set_eq_rev by (rule rev.\<omega>_limit_set_closed)

lemma \<alpha>_limit_set_positively_invariant:
  shows "negatively_invariant (\<alpha>_limit_set x)"
  unfolding negatively_invariant_eq_rev \<alpha>_limit_set_eq_rev
  by (simp add: rev.\<omega>_limit_set_positively_invariant)

lemma \<alpha>_limit_set_invariant:
  shows "invariant (\<alpha>_limit_set x)"
  unfolding invariant_eq_rev \<alpha>_limit_set_eq_rev
  by (simp add: rev.\<omega>_limit_set_invariant)

text \<open> Fundamental properties of the positive limit set \<close>

context
  fixes x K
  assumes K: "compact K" "K \<subseteq> X"
  assumes x: "x \<in> X" "trapped_forward x K"
begin

text \<open>Bunch of facts for what's to come\<close>
private lemma props:
  shows "{0..} \<subseteq> existence_ivl0 x" "seq_compact K"
   apply (rule trapped_sol_right)
  using x K by (auto simp add: compact_imp_seq_compact)

private lemma flowimg:
  shows "flow0 x ` (existence_ivl0 x \<inter> {0..}) = flow0 x ` {0..}"
  using props(1) by auto

lemma \<omega>_limit_set_in_compact_subset:
  shows "\<omega>_limit_set x \<subseteq> K"
  unfolding \<omega>_limit_set_def
proof safe
  fix p s
  assume "\<omega>_limit_point x p"
  from \<omega>_limit_pointE[OF this]
  obtain s where s:
    "filterlim s at_top sequentially"
    "(flow0 x \<circ> s) \<longlonglongrightarrow> p"
    "\<forall>n. 0 \<le> s n" by blast
  then have fin: "\<forall>n. (flow0 x \<circ> s) n \<in> K" using s(3) x K props(1)
    unfolding trapped_forward_def
    by (simp add: subset_eq)
  from seq_compactE[OF props(2) fin]
  show "p \<in> K" using s(2)
    by (metis LIMSEQ_subseq_LIMSEQ LIMSEQ_unique)
qed

lemma \<omega>_limit_set_in_compact_compact:
  shows "compact (\<omega>_limit_set x)"
proof -
  from \<omega>_limit_set_in_compact_subset
  have "bounded (\<omega>_limit_set x)"
    using bounded_subset compact_imp_bounded
    using K(1) by auto
  thus ?thesis using \<omega>_limit_set_closed
    by (simp add: compact_eq_bounded_closed)
qed

lemma \<omega>_limit_set_in_compact_nonempty:
  shows "\<omega>_limit_set x \<noteq> {}"
proof -
  have fin: "\<forall>n. (flow0 x \<circ> real) n \<in> K" using x K props(1)
    by (simp add: flowimg image_subset_iff trapped_forward_def)
  from seq_compactE[OF props(2) this]
  obtain r l where "l \<in> K" "strict_mono r" "(flow0 x \<circ> real \<circ> r) \<longlonglongrightarrow> l" by blast
  then have "\<omega>_limit_point x l" unfolding \<omega>_limit_point_def using props(1)
    by (smt comp_def filterlim_sequentially_iff_filterlim_real filterlim_subseq tendsto_at_top_eq_left)
  thus ?thesis unfolding \<omega>_limit_set_def by auto
qed

lemma \<omega>_limit_set_in_compact_existence:
  shows "\<And>y. y \<in> \<omega>_limit_set x \<Longrightarrow> existence_ivl0 y = UNIV"
proof -
  fix y
  assume y: "y \<in> \<omega>_limit_set x"
  then have "y \<in> X" using \<omega>_limit_set_in_compact_subset K by blast
  from \<omega>_limit_set_invariant
  have "\<And>t. t \<in> existence_ivl0 y \<Longrightarrow> flow0 y t \<in> \<omega>_limit_set x"
    unfolding invariant_def trapped_iff_on_existence_ivl0 using y by blast
  then have t: "\<And>t. t \<in> existence_ivl0 y \<Longrightarrow> flow0 y t \<in> K"
    using \<omega>_limit_set_in_compact_subset by blast
  thus "existence_ivl0 y = UNIV"
    by (meson \<open>y \<in> X\<close> existence_ivl_zero existence_ivl_initial_time_iff existence_ivl_subset mem_compact_implies_subset_existence_interval subset_antisym K)
qed

lemma \<omega>_limit_set_in_compact_tendsto:
  shows "((\<lambda>t. infdist (flow0 x t) (\<omega>_limit_set x)) \<longlongrightarrow> 0) at_top"
proof (rule ccontr)
  assume "\<not> ((\<lambda>t. infdist (flow0 x t) (\<omega>_limit_set x)) \<longlongrightarrow> 0) at_top"
  from not_tendsto_frequentlyE[OF this]
  obtain S where S: "open S" "0 \<in> S"
    "\<exists>\<^sub>F t in at_top. infdist (flow0 x t) (\<omega>_limit_set x) \<notin> S" .
  then obtain e where "e > 0" "ball 0 e \<subseteq> S" using openE by blast
  then have "\<And>x. x \<ge>0 \<Longrightarrow> x \<notin> S \<Longrightarrow> x \<ge> e" by force
  then have "\<forall>xa. infdist (flow0 x xa) (\<omega>_limit_set x) \<notin> S \<longrightarrow>
        infdist (flow0 x xa) (\<omega>_limit_set x) \<ge> e" using infdist_nonneg by blast
  from frequently_mono[OF this S(3)]
  have "\<exists>\<^sub>F t in at_top. infdist (flow0 x t) (\<omega>_limit_set x) \<ge> e" by blast
  then have "\<forall>n. \<exists>\<^sub>F t in at_top. infdist (flow0 x t) (\<omega>_limit_set x) \<ge> e \<and> real n \<le> t"
    by (auto intro!: eventually_frequently_conj)
  from frequently_at_topE[OF this]
  obtain s where s: "\<And>i. e \<le> infdist (flow0 x (s i)) (\<omega>_limit_set x)"
    "\<And>i. real i \<le> s i" "strict_mono s" by force
  then have sf: "filterlim s at_top sequentially"
    using filterlim_at_top_mono filterlim_real_sequentially not_eventuallyD by blast
  have fin: "\<forall>n. (flow0 x \<circ> s) n \<in> K"  using x K props(1) s unfolding flowimg trapped_forward_def
    by (metis atLeast_iff comp_apply image_subset_iff of_nat_0_le_iff order_trans)
  from seq_compactE[OF props(2) this]
  obtain r l where r:"strict_mono r" and l: "l \<in> K" "(flow0 x \<circ> s \<circ> r) \<longlonglongrightarrow> l" by blast
  moreover from filterlim_at_top_strict_mono[OF s(3) r(1) sf]
  have "filterlim (s \<circ> r) at_top sequentially" .
  moreover have "\<omega>_limit_point x l" unfolding \<omega>_limit_point_def using props(1) calculation
    by (metis comp_assoc)
  ultimately have "infdist l (\<omega>_limit_set x) = 0" by (simp add: \<omega>_limit_set_def)
  then have c1:"((\<lambda>y. infdist y (\<omega>_limit_set x)) \<circ> (flow0 x \<circ> s \<circ> r)) \<longlonglongrightarrow> 0"
    by (auto intro!: tendsto_compose_at[OF l(2)] tendsto_eq_intros)
  have c2: "\<And>i. e \<le> infdist (flow0 x ((s \<circ> r) i)) (\<omega>_limit_set x)" using s(1) by simp
  show False using c1 c2 \<open>e > 0\<close> unfolding o_def
    using Lim_bounded2
    by (metis (no_types, lifting) ball_eq_empty centre_in_ball empty_iff)
qed

lemma \<omega>_limit_set_in_compact_connected:
  shows "connected (\<omega>_limit_set x)"
  unfolding connected_closed_set[OF \<omega>_limit_set_closed]
proof clarsimp
  fix Apre Bpre
  assume pre: "closed Apre" "Apre \<union> Bpre = \<omega>_limit_set x" "closed Bpre"
    "Apre \<noteq> {}" "Bpre \<noteq> {}" "Apre \<inter> Bpre = {}"
    (* TODO: this move is very strange *)
  then obtain A B where "Apre \<subseteq> A" "Bpre \<subseteq> B" "open A" "open B" and disj:"A \<inter> B = {}"
    by (meson t4_space)
  then have "\<omega>_limit_set x \<subseteq> A \<union> B"
    "\<omega>_limit_set x \<inter> A \<noteq> {}" "\<omega>_limit_set x \<inter> B \<noteq> {}" using pre by auto
  then obtain p q where
    p: "\<omega>_limit_point x p" "p \<in> A"
    and q: "\<omega>_limit_point x q" "q \<in> B"
    using \<omega>_limit_set_def by auto
  from \<omega>_limit_pointE[OF p(1)]
  obtain ps where ps: "filterlim ps at_top sequentially"
    "(flow0 x \<circ> ps) \<longlonglongrightarrow> p" "\<forall>n. 0 \<le> ps n" by blast
  from \<omega>_limit_pointE[OF q(1)]
  obtain qs where qs: "filterlim qs at_top sequentially"
    "(flow0 x \<circ> qs) \<longlonglongrightarrow> q" "\<forall>n. 0 \<le> qs n" by blast
  have "\<forall>n. \<exists>\<^sub>F t in at_top. flow0 x t \<notin> A \<and> flow0 x t \<notin> B" unfolding frequently_at_top
  proof safe
    fix dummy mpre
    obtain m where "m \<ge> (0::real)" "m > mpre"
      by (meson approximation_preproc_push_neg(1) gt_ex le_cases order_trans)
    from ps obtain a where a:"a > m" "(flow0 x a) \<in> A"
      using \<open>open A\<close> p unfolding tendsto_def filterlim_at_top eventually_sequentially
      by (metis approximation_preproc_push_neg(1) comp_apply gt_ex le_cases order_trans)
    from qs obtain b where b:"b > a" "(flow0 x b) \<in> B"
      using \<open>open B\<close> q unfolding tendsto_def filterlim_at_top eventually_sequentially
      by (metis approximation_preproc_push_neg(1) comp_apply gt_ex le_cases order_trans)
    have "continuous_on {a..b} (flow0 x)"
      by (metis Icc_subset_Ici_iff \<open>0 \<le> m\<close> \<open>m < a\<close> approximation_preproc_push_neg(2) atMost_iff atMost_subset_iff continuous_on_subset le_cases local.flow_continuous_on props(1) subset_eq)
    from connected_continuous_image[OF this connected_Icc]
    have c:"connected (flow0 x ` {a..b})" .
    have "\<exists>t\<in> {a..b}. flow0 x t \<notin> A \<and> flow0 x t \<notin> B"
    proof (rule ccontr)
      assume "\<not> (\<exists>t\<in>{a..b}. flow0 x t \<notin> A \<and> flow0 x t \<notin> B)"
      then have "flow0 x ` {a..b} \<subseteq> A \<union> B" by blast
      from topological_space_class.connectedD[OF c \<open>open A\<close> \<open>open B\<close> _ this]
      show False using a b disj by force
    qed
    thus "\<exists>n>mpre. flow0 x n \<notin> A \<and> flow0 x n \<notin> B"
      by (smt \<open>mpre < m\<close> a(1) atLeastAtMost_iff)
  qed
  from frequently_at_topE'[OF this filterlim_real_sequentially]
  obtain s where s: "\<forall>i. flow0 x (s i) \<notin> A \<and> flow0 x (s i) \<notin> B"
    "strict_mono s" "\<And>n. real n \<le> s n" by blast
  then have "\<forall>n. (flow0 x \<circ> s) n \<in> K"
    by (smt atLeast_iff comp_apply flowimg image_subset_iff of_nat_0_le_iff trapped_forward_def x(2))
  from seq_compactE[OF props(2) this]
  obtain r l where r: "l \<in> K" "strict_mono r" "(flow0 x \<circ> s \<circ> r) \<longlonglongrightarrow> l" by blast
  have "filterlim s at_top sequentially"
    using s filterlim_at_top_mono filterlim_real_sequentially not_eventuallyD by blast
  from filterlim_at_top_strict_mono[OF s(2) r(2) this]
  have "filterlim (s \<circ> r) at_top sequentially" .
  then have "\<omega>_limit_point x l" unfolding \<omega>_limit_point_def using props(1) r
    by (metis comp_assoc)
  moreover have "l \<notin> A" using s(1) r(3) \<open>open A\<close> unfolding tendsto_def by auto
  moreover have "l \<notin> B" using s(1) r(3) \<open>open B\<close> unfolding tendsto_def by auto
  ultimately show False using \<open>\<omega>_limit_set x \<subseteq> A \<union> B\<close> unfolding \<omega>_limit_set_def
    by auto
qed

lemma \<omega>_limit_set_in_compact_\<omega>_limit_set_contained:
  shows "\<forall>y \<in> \<omega>_limit_set x. \<omega>_limit_set y \<subseteq> \<omega>_limit_set x"
proof safe
  fix y z
  assume "y \<in> \<omega>_limit_set x" "z \<in> \<omega>_limit_set y"
  then have "\<omega>_limit_point y z" unfolding \<omega>_limit_set_def by auto
  from \<omega>_limit_pointE[OF this]
  obtain s where s: "(flow0 y \<circ> s) \<longlonglongrightarrow> z" .
  have "\<forall>n. (flow0 y \<circ> s) n \<in> \<omega>_limit_set x"
    using \<open>y \<in> \<omega>_limit_set x\<close> invariant_def
      \<omega>_limit_set_in_compact_existence \<omega>_limit_set_invariant trapped_iff_on_existence_ivl0
    by force
  thus "z \<in> \<omega>_limit_set x" using closed_sequential_limits s \<omega>_limit_set_closed
    by blast
qed

lemma \<omega>_limit_set_in_compact_\<alpha>_limit_set_contained:
  assumes zpx: "z \<in> \<omega>_limit_set x"
  shows "\<alpha>_limit_set z \<subseteq> \<omega>_limit_set x"
proof
  fix w assume "w \<in> \<alpha>_limit_set z"
  then obtain s where s: "(flow0 z \<circ> s) \<longlonglongrightarrow> w"
    unfolding \<alpha>_limit_set_def \<alpha>_limit_point_def
    by auto
  from \<omega>_limit_set_invariant have "invariant (\<omega>_limit_set x)" .
  then have "\<forall>n. (flow0 z \<circ> s) n \<in> \<omega>_limit_set x"
    using \<omega>_limit_set_in_compact_existence[OF zpx] zpx
    using invariant_def trapped_iff_on_existence_ivl0 by fastforce
  from closed_sequentially[OF \<omega>_limit_set_closed this s]
  show "w \<in> \<omega>_limit_set x" .
qed

end

text \<open> Fundamental properties of the negative limit set \<close>

end context auto_ll_on_open begin

context
  fixes x K
  assumes x: "x \<in> X" "trapped_backward x K"
  assumes K: "compact K" "K \<subseteq> X"
begin

private lemma xrev: "x \<in> X" "rev.trapped_forward x K"
  using trapped_backward_iff_rev_trapped_forward x(2)
  by (auto simp: rev_existence_ivl_eq0 rev_eq_flow x(1))

lemma \<alpha>_limit_set_in_compact_subset: "\<alpha>_limit_set x \<subseteq> K"
  and \<alpha>_limit_set_in_compact_compact: "compact (\<alpha>_limit_set x)"
  and \<alpha>_limit_set_in_compact_nonempty: "\<alpha>_limit_set x \<noteq> {}"
  and \<alpha>_limit_set_in_compact_connected: "connected (\<alpha>_limit_set x)"
  and \<alpha>_limit_set_in_compact_\<alpha>_limit_set_contained:
  "\<forall>y \<in> \<alpha>_limit_set x. \<alpha>_limit_set y \<subseteq> \<alpha>_limit_set x"
  and \<alpha>_limit_set_in_compact_tendsto: "((\<lambda>t. infdist (flow0 x t) (\<alpha>_limit_set x)) \<longlongrightarrow> 0) at_bot"
  using rev.\<omega>_limit_set_in_compact_subset[OF K xrev]
  using rev.\<omega>_limit_set_in_compact_compact[OF K xrev]
  using rev.\<omega>_limit_set_in_compact_nonempty[OF K xrev]
  using rev.\<omega>_limit_set_in_compact_connected[OF K xrev]
  using rev.\<omega>_limit_set_in_compact_\<omega>_limit_set_contained[OF K xrev]
  using rev.\<omega>_limit_set_in_compact_tendsto[OF K xrev]
  unfolding invariant_eq_rev \<alpha>_limit_set_eq_rev existence_ivl_eq_rev flow_eq_rev0 filterlim_at_bot_mirror
    minus_minus
  .

lemma \<alpha>_limit_set_in_compact_existence:
  shows "\<And>y. y \<in> \<alpha>_limit_set x \<Longrightarrow> existence_ivl0 y = UNIV"
  using rev.\<omega>_limit_set_in_compact_existence[OF K xrev]
  unfolding \<alpha>_limit_set_eq_rev existence_ivl_eq_rev0
  by auto

end
end

end