(*  Title:      ZF/Constructible/Reflection.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
*)

section {* The Reflection Theorem*}

theory Reflection imports Normal begin

lemma all_iff_not_ex_not: "(\<forall>x. P(x)) \<longleftrightarrow> (~ (\<exists>x. ~ P(x)))"
by blast

lemma ball_iff_not_bex_not: "(\<forall>x\<in>A. P(x)) \<longleftrightarrow> (~ (\<exists>x\<in>A. ~ P(x)))"
by blast

text{*From the notes of A. S. Kechris, page 6, and from
      Andrzej Mostowski, \emph{Constructible Sets with Applications},
      North-Holland, 1969, page 23.*}

subsection{*Basic Definitions*}

text{*First part: the cumulative hierarchy defining the class @{text M}.
To avoid handling multiple arguments, we assume that @{text "Mset(l)"} is
closed under ordered pairing provided @{text l} is limit.  Possibly this
could be avoided: the induction hypothesis @{term Cl_reflects}
(in locale @{text ex_reflection}) could be weakened to
@{term "\<forall>y\<in>Mset(a). \<forall>z\<in>Mset(a). P(<y,z>) \<longleftrightarrow> Q(a,<y,z>)"}, removing most
uses of @{term Pair_in_Mset}.  But there isn't much point in doing so, since
ultimately the @{text ex_reflection} proof is packaged up using the
predicate @{text Reflects}.
*}
locale reflection =
  fixes Mset and M and Reflects
  assumes Mset_mono_le : "mono_le_subset(Mset)"
      and Mset_cont    : "cont_Ord(Mset)"
      and Pair_in_Mset : "[| x \<in> Mset(a); y \<in> Mset(a); Limit(a) |]
                          ==> <x,y> \<in> Mset(a)"
  defines "M(x) == \<exists>a. Ord(a) & x \<in> Mset(a)"
      and "Reflects(Cl,P,Q) == Closed_Unbounded(Cl) &
                              (\<forall>a. Cl(a) \<longrightarrow> (\<forall>x\<in>Mset(a). P(x) \<longleftrightarrow> Q(a,x)))"
  fixes F0 --{*ordinal for a specific value @{term y}*}
  fixes FF --{*sup over the whole level, @{term "y\<in>Mset(a)"}*}
  fixes ClEx --{*Reflecting ordinals for the formula @{term "\<exists>z. P"}*}
  defines "F0(P,y) == \<mu> b. (\<exists>z. M(z) & P(<y,z>)) \<longrightarrow>
                               (\<exists>z\<in>Mset(b). P(<y,z>))"
      and "FF(P)   == \<lambda>a. \<Union>y\<in>Mset(a). F0(P,y)"
      and "ClEx(P,a) == Limit(a) & normalize(FF(P),a) = a"

lemma (in reflection) Mset_mono: "i\<le>j ==> Mset(i) \<subseteq> Mset(j)"
apply (insert Mset_mono_le)
apply (simp add: mono_le_subset_def leI)
done

text{*Awkward: we need a version of @{text ClEx_def} as an equality
      at the level of classes, which do not really exist*}
lemma (in reflection) ClEx_eq:
     "ClEx(P) == \<lambda>a. Limit(a) & normalize(FF(P),a) = a"
by (simp add: ClEx_def [symmetric])

subsection{*Easy Cases of the Reflection Theorem*}

theorem (in reflection) Triv_reflection [intro]:
     "Reflects(Ord, P, \<lambda>a x. P(x))"
by (simp add: Reflects_def)

theorem (in reflection) Not_reflection [intro]:
     "Reflects(Cl,P,Q) ==> Reflects(Cl, \<lambda>x. ~P(x), \<lambda>a x. ~Q(a,x))"
by (simp add: Reflects_def)

theorem (in reflection) And_reflection [intro]:
     "[| Reflects(Cl,P,Q); Reflects(C',P',Q') |]
      ==> Reflects(\<lambda>a. Cl(a) & C'(a), \<lambda>x. P(x) & P'(x),
                                      \<lambda>a x. Q(a,x) & Q'(a,x))"
by (simp add: Reflects_def Closed_Unbounded_Int, blast)

theorem (in reflection) Or_reflection [intro]:
     "[| Reflects(Cl,P,Q); Reflects(C',P',Q') |]
      ==> Reflects(\<lambda>a. Cl(a) & C'(a), \<lambda>x. P(x) | P'(x),
                                      \<lambda>a x. Q(a,x) | Q'(a,x))"
by (simp add: Reflects_def Closed_Unbounded_Int, blast)

theorem (in reflection) Imp_reflection [intro]:
     "[| Reflects(Cl,P,Q); Reflects(C',P',Q') |]
      ==> Reflects(\<lambda>a. Cl(a) & C'(a),
                   \<lambda>x. P(x) \<longrightarrow> P'(x),
                   \<lambda>a x. Q(a,x) \<longrightarrow> Q'(a,x))"
by (simp add: Reflects_def Closed_Unbounded_Int, blast)

theorem (in reflection) Iff_reflection [intro]:
     "[| Reflects(Cl,P,Q); Reflects(C',P',Q') |]
      ==> Reflects(\<lambda>a. Cl(a) & C'(a),
                   \<lambda>x. P(x) \<longleftrightarrow> P'(x),
                   \<lambda>a x. Q(a,x) \<longleftrightarrow> Q'(a,x))"
by (simp add: Reflects_def Closed_Unbounded_Int, blast)

subsection{*Reflection for Existential Quantifiers*}

lemma (in reflection) F0_works:
     "[| y\<in>Mset(a); Ord(a); M(z); P(<y,z>) |] ==> \<exists>z\<in>Mset(F0(P,y)). P(<y,z>)"
apply (unfold F0_def M_def, clarify)
apply (rule LeastI2)
  apply (blast intro: Mset_mono [THEN subsetD])
 apply (blast intro: lt_Ord2, blast)
done

lemma (in reflection) Ord_F0 [intro,simp]: "Ord(F0(P,y))"
by (simp add: F0_def)

lemma (in reflection) Ord_FF [intro,simp]: "Ord(FF(P,y))"
by (simp add: FF_def)

lemma (in reflection) cont_Ord_FF: "cont_Ord(FF(P))"
apply (insert Mset_cont)
apply (simp add: cont_Ord_def FF_def, blast)
done

text{*Recall that @{term F0} depends upon @{term "y\<in>Mset(a)"},
while @{term FF} depends only upon @{term a}. *}
lemma (in reflection) FF_works:
     "[| M(z); y\<in>Mset(a); P(<y,z>); Ord(a) |] ==> \<exists>z\<in>Mset(FF(P,a)). P(<y,z>)"
apply (simp add: FF_def)
apply (simp_all add: cont_Ord_Union [of concl: Mset]
                     Mset_cont Mset_mono_le not_emptyI Ord_F0)
apply (blast intro: F0_works)
done

lemma (in reflection) FFN_works:
     "[| M(z); y\<in>Mset(a); P(<y,z>); Ord(a) |]
      ==> \<exists>z\<in>Mset(normalize(FF(P),a)). P(<y,z>)"
apply (drule FF_works [of concl: P], assumption+)
apply (blast intro: cont_Ord_FF le_normalize [THEN Mset_mono, THEN subsetD])
done

text{*Locale for the induction hypothesis*}

locale ex_reflection = reflection +
  fixes P  --"the original formula"
  fixes Q  --"the reflected formula"
  fixes Cl --"the class of reflecting ordinals"
  assumes Cl_reflects: "[| Cl(a); Ord(a) |] ==> \<forall>x\<in>Mset(a). P(x) \<longleftrightarrow> Q(a,x)"

lemma (in ex_reflection) ClEx_downward:
     "[| M(z); y\<in>Mset(a); P(<y,z>); Cl(a); ClEx(P,a) |]
      ==> \<exists>z\<in>Mset(a). Q(a,<y,z>)"
apply (simp add: ClEx_def, clarify)
apply (frule Limit_is_Ord)
apply (frule FFN_works [of concl: P], assumption+)
apply (drule Cl_reflects, assumption+)
apply (auto simp add: Limit_is_Ord Pair_in_Mset)
done

lemma (in ex_reflection) ClEx_upward:
     "[| z\<in>Mset(a); y\<in>Mset(a); Q(a,<y,z>); Cl(a); ClEx(P,a) |]
      ==> \<exists>z. M(z) & P(<y,z>)"
apply (simp add: ClEx_def M_def)
apply (blast dest: Cl_reflects
             intro: Limit_is_Ord Pair_in_Mset)
done

text{*Class @{text ClEx} indeed consists of reflecting ordinals...*}
lemma (in ex_reflection) ZF_ClEx_iff:
     "[| y\<in>Mset(a); Cl(a); ClEx(P,a) |]
      ==> (\<exists>z. M(z) & P(<y,z>)) \<longleftrightarrow> (\<exists>z\<in>Mset(a). Q(a,<y,z>))"
by (blast intro: dest: ClEx_downward ClEx_upward)

text{*...and it is closed and unbounded*}
lemma (in ex_reflection) ZF_Closed_Unbounded_ClEx:
     "Closed_Unbounded(ClEx(P))"
apply (simp add: ClEx_eq)
apply (fast intro: Closed_Unbounded_Int Normal_imp_fp_Closed_Unbounded
                   Closed_Unbounded_Limit Normal_normalize)
done

text{*The same two theorems, exported to locale @{text reflection}.*}

text{*Class @{text ClEx} indeed consists of reflecting ordinals...*}
lemma (in reflection) ClEx_iff:
     "[| y\<in>Mset(a); Cl(a); ClEx(P,a);
        !!a. [| Cl(a); Ord(a) |] ==> \<forall>x\<in>Mset(a). P(x) \<longleftrightarrow> Q(a,x) |]
      ==> (\<exists>z. M(z) & P(<y,z>)) \<longleftrightarrow> (\<exists>z\<in>Mset(a). Q(a,<y,z>))"
apply (unfold ClEx_def FF_def F0_def M_def)
apply (rule ex_reflection.ZF_ClEx_iff
  [OF ex_reflection.intro, OF reflection.intro ex_reflection_axioms.intro,
    of Mset Cl])
apply (simp_all add: Mset_mono_le Mset_cont Pair_in_Mset)
done

(*Alternative proof, less unfolding:
apply (rule Reflection.ZF_ClEx_iff [of Mset _ _ Cl, folded M_def])
apply (fold ClEx_def FF_def F0_def)
apply (rule ex_reflection.intro, assumption)
apply (simp add: ex_reflection_axioms.intro, assumption+)
*)

lemma (in reflection) Closed_Unbounded_ClEx:
     "(!!a. [| Cl(a); Ord(a) |] ==> \<forall>x\<in>Mset(a). P(x) \<longleftrightarrow> Q(a,x))
      ==> Closed_Unbounded(ClEx(P))"
apply (unfold ClEx_eq FF_def F0_def M_def)
apply (rule ex_reflection.ZF_Closed_Unbounded_ClEx [of Mset _ _ Cl])
apply (rule ex_reflection.intro, rule reflection_axioms)
apply (blast intro: ex_reflection_axioms.intro)
done

subsection{*Packaging the Quantifier Reflection Rules*}

lemma (in reflection) Ex_reflection_0:
     "Reflects(Cl,P0,Q0)
      ==> Reflects(\<lambda>a. Cl(a) & ClEx(P0,a),
                   \<lambda>x. \<exists>z. M(z) & P0(<x,z>),
                   \<lambda>a x. \<exists>z\<in>Mset(a). Q0(a,<x,z>))"
apply (simp add: Reflects_def)
apply (intro conjI Closed_Unbounded_Int)
  apply blast
 apply (rule Closed_Unbounded_ClEx [of Cl P0 Q0], blast, clarify)
apply (rule_tac Cl=Cl in  ClEx_iff, assumption+, blast)
done

lemma (in reflection) All_reflection_0:
     "Reflects(Cl,P0,Q0)
      ==> Reflects(\<lambda>a. Cl(a) & ClEx(\<lambda>x.~P0(x), a),
                   \<lambda>x. \<forall>z. M(z) \<longrightarrow> P0(<x,z>),
                   \<lambda>a x. \<forall>z\<in>Mset(a). Q0(a,<x,z>))"
apply (simp only: all_iff_not_ex_not ball_iff_not_bex_not)
apply (rule Not_reflection, drule Not_reflection, simp)
apply (erule Ex_reflection_0)
done

theorem (in reflection) Ex_reflection [intro]:
     "Reflects(Cl, \<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x)))
      ==> Reflects(\<lambda>a. Cl(a) & ClEx(\<lambda>x. P(fst(x),snd(x)), a),
                   \<lambda>x. \<exists>z. M(z) & P(x,z),
                   \<lambda>a x. \<exists>z\<in>Mset(a). Q(a,x,z))"
by (rule Ex_reflection_0 [of _ " \<lambda>x. P(fst(x),snd(x))"
                               "\<lambda>a x. Q(a,fst(x),snd(x))", simplified])

theorem (in reflection) All_reflection [intro]:
     "Reflects(Cl,  \<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x)))
      ==> Reflects(\<lambda>a. Cl(a) & ClEx(\<lambda>x. ~P(fst(x),snd(x)), a),
                   \<lambda>x. \<forall>z. M(z) \<longrightarrow> P(x,z),
                   \<lambda>a x. \<forall>z\<in>Mset(a). Q(a,x,z))"
by (rule All_reflection_0 [of _ "\<lambda>x. P(fst(x),snd(x))"
                                "\<lambda>a x. Q(a,fst(x),snd(x))", simplified])

text{*And again, this time using class-bounded quantifiers*}

theorem (in reflection) Rex_reflection [intro]:
     "Reflects(Cl, \<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x)))
      ==> Reflects(\<lambda>a. Cl(a) & ClEx(\<lambda>x. P(fst(x),snd(x)), a),
                   \<lambda>x. \<exists>z[M]. P(x,z),
                   \<lambda>a x. \<exists>z\<in>Mset(a). Q(a,x,z))"
by (unfold rex_def, blast)

theorem (in reflection) Rall_reflection [intro]:
     "Reflects(Cl,  \<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x)))
      ==> Reflects(\<lambda>a. Cl(a) & ClEx(\<lambda>x. ~P(fst(x),snd(x)), a),
                   \<lambda>x. \<forall>z[M]. P(x,z),
                   \<lambda>a x. \<forall>z\<in>Mset(a). Q(a,x,z))"
by (unfold rall_def, blast)

text{*No point considering bounded quantifiers, where reflection is trivial.*}

subsection{*Simple Examples of Reflection*}

text{*Example 1: reflecting a simple formula.  The reflecting class is first
given as the variable @{text ?Cl} and later retrieved from the final
proof state.*}
schematic_lemma (in reflection)
     "Reflects(?Cl,
               \<lambda>x. \<exists>y. M(y) & x \<in> y,
               \<lambda>a x. \<exists>y\<in>Mset(a). x \<in> y)"
by fast

text{*Problem here: there needs to be a conjunction (class intersection)
in the class of reflecting ordinals.  The @{term "Ord(a)"} is redundant,
though harmless.*}
lemma (in reflection)
     "Reflects(\<lambda>a. Ord(a) & ClEx(\<lambda>x. fst(x) \<in> snd(x), a),
               \<lambda>x. \<exists>y. M(y) & x \<in> y,
               \<lambda>a x. \<exists>y\<in>Mset(a). x \<in> y)"
by fast

text{*Example 2*}
schematic_lemma (in reflection)
     "Reflects(?Cl,
               \<lambda>x. \<exists>y. M(y) & (\<forall>z. M(z) \<longrightarrow> z \<subseteq> x \<longrightarrow> z \<in> y),
               \<lambda>a x. \<exists>y\<in>Mset(a). \<forall>z\<in>Mset(a). z \<subseteq> x \<longrightarrow> z \<in> y)"
by fast

text{*Example 2'.  We give the reflecting class explicitly. *}
lemma (in reflection)
  "Reflects
    (\<lambda>a. (Ord(a) &
          ClEx(\<lambda>x. ~ (snd(x) \<subseteq> fst(fst(x)) \<longrightarrow> snd(x) \<in> snd(fst(x))), a)) &
          ClEx(\<lambda>x. \<forall>z. M(z) \<longrightarrow> z \<subseteq> fst(x) \<longrightarrow> z \<in> snd(x), a),
            \<lambda>x. \<exists>y. M(y) & (\<forall>z. M(z) \<longrightarrow> z \<subseteq> x \<longrightarrow> z \<in> y),
            \<lambda>a x. \<exists>y\<in>Mset(a). \<forall>z\<in>Mset(a). z \<subseteq> x \<longrightarrow> z \<in> y)"
by fast

text{*Example 2''.  We expand the subset relation.*}
schematic_lemma (in reflection)
  "Reflects(?Cl,
        \<lambda>x. \<exists>y. M(y) & (\<forall>z. M(z) \<longrightarrow> (\<forall>w. M(w) \<longrightarrow> w\<in>z \<longrightarrow> w\<in>x) \<longrightarrow> z\<in>y),
        \<lambda>a x. \<exists>y\<in>Mset(a). \<forall>z\<in>Mset(a). (\<forall>w\<in>Mset(a). w\<in>z \<longrightarrow> w\<in>x) \<longrightarrow> z\<in>y)"
by fast

text{*Example 2'''.  Single-step version, to reveal the reflecting class.*}
schematic_lemma (in reflection)
     "Reflects(?Cl,
               \<lambda>x. \<exists>y. M(y) & (\<forall>z. M(z) \<longrightarrow> z \<subseteq> x \<longrightarrow> z \<in> y),
               \<lambda>a x. \<exists>y\<in>Mset(a). \<forall>z\<in>Mset(a). z \<subseteq> x \<longrightarrow> z \<in> y)"
apply (rule Ex_reflection)
txt{*
@{goals[display,indent=0,margin=60]}
*}
apply (rule All_reflection)
txt{*
@{goals[display,indent=0,margin=60]}
*}
apply (rule Triv_reflection)
txt{*
@{goals[display,indent=0,margin=60]}
*}
done

text{*Example 3.  Warning: the following examples make sense only
if @{term P} is quantifier-free, since it is not being relativized.*}
schematic_lemma (in reflection)
     "Reflects(?Cl,
               \<lambda>x. \<exists>y. M(y) & (\<forall>z. M(z) \<longrightarrow> z \<in> y \<longleftrightarrow> z \<in> x & P(z)),
               \<lambda>a x. \<exists>y\<in>Mset(a). \<forall>z\<in>Mset(a). z \<in> y \<longleftrightarrow> z \<in> x & P(z))"
by fast

text{*Example 3'*}
schematic_lemma (in reflection)
     "Reflects(?Cl,
               \<lambda>x. \<exists>y. M(y) & y = Collect(x,P),
               \<lambda>a x. \<exists>y\<in>Mset(a). y = Collect(x,P))"
by fast

text{*Example 3''*}
schematic_lemma (in reflection)
     "Reflects(?Cl,
               \<lambda>x. \<exists>y. M(y) & y = Replace(x,P),
               \<lambda>a x. \<exists>y\<in>Mset(a). y = Replace(x,P))"
by fast

text{*Example 4: Axiom of Choice.  Possibly wrong, since @{text \<Pi>} needs
to be relativized.*}
schematic_lemma (in reflection)
     "Reflects(?Cl,
               \<lambda>A. 0\<notin>A \<longrightarrow> (\<exists>f. M(f) & f \<in> (\<Pi> X \<in> A. X)),
               \<lambda>a A. 0\<notin>A \<longrightarrow> (\<exists>f\<in>Mset(a). f \<in> (\<Pi> X \<in> A. X)))"
by fast

end


theory SergotTests

imports Main SergotCoulds SergotCases

begin
nitpick_params[user_axioms, timeout = 300]

section "(In)Dependence of Coulds"

lemma 12: "\<lfloor>(Could\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)
lemma 13: "\<lfloor>(Could\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)
lemma 14: "\<lfloor>(Could\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)

lemma 21: "\<lfloor>(Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)
lemma 23: "\<lfloor>(Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)
lemma 24: "\<lfloor>(Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)

lemma 31: "\<lfloor>(Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)
lemma 32: "\<lfloor>(Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)
lemma 34: "\<lfloor>(Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)

lemma 41: "\<lfloor>(Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops(*nitpick finds a counterexample*)
lemma 42: "\<lfloor>(Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)
lemma 43: "\<lfloor>(Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<rightarrow> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>)\<rfloor>" oops (*nitpick finds a counterexample*)

section "Cases"

lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {a,b} g)))"
  (*by (metis Diff_cancel Throwers_axioms Throwers_def UNIV_I equals0D mem_Collect_eq tildeeqU tildexeq)*) oops
lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sub> {a,b} g)))"
  (*by (smt (verit) Throwers_axioms Throwers_def UNIV_I mem_Collect_eq tildexeq) *) oops
lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sub> {a,b} g)))"
  using a by blast
lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sub> {a,b} g)))"
  (*by (smt (verit) Throwers_axioms Throwers_def UNIV_I mem_Collect_eq tildexeq) *) oops

lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {a} g)))" oops
lemma (in Throwers) "\<not> (\<forall>\<tau>. (\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {a} g)))"
  by (smt (verit, del_insts) Diff_insert_absorb Throwers_axioms Throwers_def insertCI mem_Collect_eq singletonD tildeeqU tildexeq)
lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {b} g)))"  oops
lemma (in Throwers) " \<not> (\<forall>\<tau>.(\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {b} g)))" oops

lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> {a,b} g)))" oops
lemma (in Throwers) "\<not>(\<forall>\<tau>.(\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> {a,b} g)))" oops
lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> {a,b} g)))" oops
lemma (in Throwers) "\<not>(\<forall>\<tau>.(\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> {a,b} g)))"
  (* by (metis Throwers_axioms Throwers_def insert_subset mem_Collect_eq psubsetI singletonD subsetI tildexeq)*) oops
lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> {a,b} g)))" oops
lemma (in Throwers) "\<not>(\<forall>\<tau>.(\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> {a,b} g)))"
  by (metis Throwers_axioms Throwers_def bot.not_eq_extremum insert_not_empty)
lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> {a,b} g)))" oops
lemma (in Throwers) "\<not>(\<forall>\<tau>.(\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> {a,b} g)))" oops

lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} g)))" oops
lemma (in Throwers) "\<not>(\<forall>\<tau>.(\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} g)))" oops
lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} g)))" oops
lemma (in Throwers) "\<not>(\<forall>\<tau>.(\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} g)))" oops
lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} g)))" oops
lemma (in Throwers) "\<not>(\<forall>\<tau>.(\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} g)))" oops
lemma (in Throwers) "((\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} g)))"  oops
lemma (in Throwers) "\<not>(\<forall>\<tau>.(\<tau> \<in> athrows \<and> \<tau> \<in> bthrows) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (\<^bold>\<not> g)) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} g)))" oops

lemma (in Vase) "(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} (\<^bold>\<not> wet)))" oops
lemma (in Vase) " \<not> (\<forall>\<tau>.(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} (\<^bold>\<not> wet))))" oops
lemma (in Vase) "(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {a} (\<^bold>\<not> wet)))"  oops
lemma (in Vase) " \<not> (\<forall>\<tau>.(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {a} (\<^bold>\<not> wet))))" oops

lemma (in Vase) "(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} (\<^bold>\<not> wet)))" oops
lemma (in Vase) " \<not> (\<forall>\<tau>.(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} (\<^bold>\<not> wet))))"
  (*by (metis Vase_axioms Vase_def mem_Collect_eq singletonD tildeeqU tildexeq)*) oops
lemma (in Vase) "(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sub> {a} (\<^bold>\<not> wet)))" oops
lemma (in Vase) " \<not> (\<forall>\<tau>.(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sub> {a} (\<^bold>\<not> wet))))" oops

lemma (in Vase) "(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} (\<^bold>\<not> wet)))" oops
lemma (in Vase) " \<not> (\<forall>\<tau>.(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} (\<^bold>\<not> wet))))"oops
(*  by (metis Vase_axioms Vase_def bot.not_eq_extremum insert_not_empty) *)
lemma (in Vase) "(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sub> {a} (\<^bold>\<not> wet)))"
  by (meson singletonI tildexeq)
lemma (in Vase) "\<not> ((\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sub> {a} (\<^bold>\<not> wet))))" oops

lemma (in Vase) "(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} (\<^bold>\<not> wet)))" oops
lemma (in Vase) " \<not> (\<forall>\<tau>.(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> {a} (\<^bold>\<not> wet))))" oops
lemma (in Vase) "(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sub> {a} (\<^bold>\<not> wet)))" oops
lemma (in Vase) " \<not> (\<forall>\<tau>.(\<tau> \<in> abringsvase) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> wet) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sub> {a} (\<^bold>\<not> wet))))" oops

lemma (in JumpersDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))" (*nitpick finds a counterexample*)oops
lemma (in JumpersDet) " \<not> (\<forall>\<tau>.(\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))" oops
lemma (in JumpersDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {j} \<^bold>\<not> k)))" (*nitpick finds a counterexample? ? *) oops
lemma (in JumpersDet) " \<not> (\<forall>\<tau>.(\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {j} \<^bold>\<not> k)))" oops

lemma (in JumpersDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))"
  (*by (smt (verit, del_insts) Diff_insert_absorb JumpersDet_axioms JumpersDet_def ac empty_subsetI insert_subset leD less_le mem_Collect_eq singleton_iff singleton_insert_inj_eq' tildeeqU) *) oops
lemma (in JumpersDet) "\<not>((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))" (*nitpick finds a counterexample*) oops
lemma (in JumpersDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sub> {j} \<^bold>\<not> k)))"
  by (smt (z3) JumpersDet_axioms JumpersDet_def ac insertI1 mem_Collect_eq)
lemma (in JumpersDet) "\<not>((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sub> {j} \<^bold>\<not> k)))" (*nitpick finds a counterexample*) oops

lemma (in JumpersDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))" (*nitpick finds a counterexample ? ? *) oops
lemma (in JumpersDet) "\<not>(\<forall>\<tau>. (\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))"
  by (metis JumpersDet_axioms JumpersDet_def bot.not_eq_extremum insert_not_empty)
lemma (in JumpersDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sub> {j} \<^bold>\<not> k)))"
  by (meson singletonI tildexeq)
lemma (in JumpersDet) "\<not>(\<forall>\<tau>.(\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sub> {j} \<^bold>\<not> k)))" (*nitpick finds a counterexample*) oops

lemma (in JumpersDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))"
 (* by (metis JumpersDet_axioms JumpersDet_def empty_subsetI insertCI insert_subset leD less_le mem_Collect_eq singletonD tildeeqU tildexeq) *) oops
lemma (in JumpersDet) "\<not>((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))"(*nitpick finds a counterexample*) oops
lemma (in JumpersDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sub> {j} \<^bold>\<not> k)))"
  (*by (metis JumpersDet_axioms JumpersDet_def mem_Collect_eq singletonacc tildexeq) *) oops
lemma (in JumpersDet) "\<not>((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sub> {j} \<^bold>\<not> k)))" (*Nitpick finds a counterexample*) oops

lemma (in JumpersNonDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))" oops
lemma (in JumpersNonDet) "\<not>(\<forall>\<tau>. (\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))" oops
lemma (in JumpersNonDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {j} \<^bold>\<not> k)))" oops
lemma (in JumpersNonDet) "\<not>(\<forall>\<tau>.(\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could\<^sub> {j} \<^bold>\<not> k)))"
 (*by (metis DiffI JumpersNonDet_axioms JumpersNonDet_def UNIV_I mem_Collect_eq singletonD tildeeqU tildexeq) *)oops

lemma (in JumpersNonDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))"
 (* by (smt (verit, ccfv_threshold) Diff_insert_absorb ac ap emptyE empty_subsetI f insertI1 insert_subset mem_Collect_eq psubsetE singleton_insert_inj_eq' tildeeqU) *) oops
lemma (in JumpersNonDet) "\<not>((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))" oops
lemma (in JumpersNonDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sub> {j} \<^bold>\<not> k)))"
  by (meson ac ap f insertI1)
lemma (in JumpersNonDet) "\<not>((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could2\<^sub> {j} \<^bold>\<not> k)))" oops

lemma (in JumpersNonDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))" oops
lemma (in JumpersNonDet) "\<not>(\<forall>\<tau>.(\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))"
  by (meson a b bot.not_eq_extremum insert_not_empty)
lemma (in JumpersNonDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sub> {j} \<^bold>\<not> k)))"
  using d by blast
lemma (in JumpersNonDet) "\<not>(\<forall>\<tau>. (\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could3\<^sub> {j} \<^bold>\<not> k)))"oops

lemma (in JumpersNonDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))"
  (*by (metis Diff_insert_absorb ap e empty_iff empty_subsetI f insertI1 insert_subset mem_Collect_eq psubsetE singleton_insert_inj_eq tildeeqU tildexeq) *)oops
lemma (in JumpersNonDet) "\<not>(\<forall>\<tau>. (\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sup>m\<^sup>i\<^sup>n\<^sub> {j} \<^bold>\<not> k)))" oops
lemma (in JumpersNonDet) "((\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sub> {j} \<^bold>\<not> k)))"
 (* by (smt (verit, del_insts) JumpersNonDet.e JumpersNonDet_axioms ap f mem_Collect_eq singletonI tildexeq) *)oops
lemma (in JumpersNonDet) "\<not>(\<forall>\<tau>.(\<tau> \<in> jjumps \<and> \<tau> \<in> sshoots) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> k) \<longrightarrow> (\<tau> \<^bold>\<Turnstile> (Could4\<^sub> {j} \<^bold>\<not> k)))" oops

end


(*<*)
theory system_model
  imports fmap_functions
    system_model_types
    standard_crdts
    snapshot
begin
(*>*)

section {* System model *}

text {*
We parameterize our Model based on four type parameters:

 - The operation type describes which operations can be executed via the API.
 - The operation-result type determines what are possible results of operations.
 - The operation-effector type describes, which messages can be sent to other replicas as effectors.
 - The state type describes the state at each replica.

*}

record ('operation, 'operation_result, 'operation_effector, 'state) eventInfo =
  event_operation :: "'operation"
  event_result :: 'operation_result
  event_effectors :: "'operation_effector list"
  event_executionOrder :: "event list"
  event_state_pre :: 'state (* state before executing the event *)
  event_state_post :: 'state (* state after executing the event *)
  event_snapshot :: snapshot  (* events that happened before and how many of their effectors are included in the snapshot *)

record ('operation, 'operation_result, 'operation_effector, 'state) execution =
  events :: "(event, ('operation, 'operation_result, 'operation_effector, 'state) eventInfo) fmap"

abbreviation "events' E \<equiv> fmap_entries (events E)"
abbreviation "eventsIds E \<equiv> fmdom' (events E)"

definition happensBeforeP :: "event \<Rightarrow> event \<Rightarrow> ('operation, 'operation_result, 'operation_effector, 'state) execution \<Rightarrow> bool" ("_ happened before _ in _" [25,25,25]25) where
"x happened before y in E \<equiv>
   case (events E).[y] of
     None \<Rightarrow> False
   | Some yInfo \<Rightarrow> (
      case (events E).[x] of
       None \<Rightarrow> False
     | Some xInfo \<Rightarrow> includedIn x (length (event_effectors xInfo)) (event_snapshot yInfo)
  ) "

definition happensBefore :: "('operation, 'operation_result, 'operation_effector, 'state) execution \<Rightarrow> event rel"  where
"happensBefore E \<equiv> {(x,y). x happened before y in E}"

lemma happensBefore_code[code]:
"happensBefore E = \<Union> ((\<lambda>(e,eInfo). (Set.filter (\<lambda>e'. e' happened before e in E) (snapshot_events (event_snapshot eInfo))) \<times> {e} )  ` fmap_entries (events E))"
  apply (auto simp add: happensBefore_def happensBeforeP_def  split: option.splits)
  apply (rule_tac x="(b,y)" in bexI)
  apply (auto simp add: fmap_entries_def fmdom'I image_iff)
  using fmlookup_dom'_iff includedIn_def by fastforce

lemma in_happensBefore_code[code_abbrev]: "(x happened before y in E) \<longleftrightarrow> (x,y)\<in>happensBefore E"
  by (auto simp add: happensBefore_def happensBeforeP_def fmdom'I split: option.splits)

export_code happensBefore in Haskell

definition "foo x y E \<equiv> \<forall>(e,ei)\<in>fmap_entries(events E). True"

export_code foo in Haskell

type_synonym ('operation, 'operation_result, 'operation_effector, 'state) generator_function = "('operation \<Rightarrow> uid \<Rightarrow> 'state \<Rightarrow> 'operation_result \<times> ('operation_effector list))"
type_synonym ('operation_effector, 'state) effector_function = "('operation_effector \<Rightarrow> 'state \<Rightarrow> 'state)"

definition "wf_causallyConsistent E \<equiv>
\<forall>(e,eInfo)\<in>events' E. \<forall>(e',i)\<in>snapshot_entries(event_snapshot eInfo).
  case (events E).[e'] of
      None \<Rightarrow> False
    | Some eInfo' \<Rightarrow> event_snapshot eInfo' \<le> event_snapshot eInfo
"

definition wf_generator :: "('operation, 'operation_result, 'operation_effector, 'state) execution \<Rightarrow> ('operation, 'operation_result, 'operation_effector, 'state)generator_function \<Rightarrow> bool" where
"wf_generator execution gen \<equiv>
events execution |> fmpred (\<lambda>e eInfo.
  gen (event_operation eInfo)  e (event_state_pre eInfo) = (event_result eInfo, event_effectors eInfo))
"

definition executeEffectors :: "'operation_effector list \<Rightarrow> 'state \<Rightarrow> ('operation_effector, 'state) effector_function \<Rightarrow> 'state" where
"executeEffectors effectors initial eff \<equiv> foldl (\<lambda>s e. eff e s) initial effectors "

definition sorted_partial :: "'a list \<Rightarrow> 'a rel \<Rightarrow> bool" where
"sorted_partial list rel \<equiv> (\<forall>j<length list. \<forall>i<j. (list!j, list!i)\<notin>rel)"

definition
"valid_event_sequence eventList eventSet hb \<equiv>
set eventList = eventSet \<and> distinct eventList \<and> sorted_partial eventList hb"

definition "previous_events hb e \<equiv> fst ` Set.filter (\<lambda>(x,y). y = e \<and> x\<noteq>e) hb"  (* or {e'.  e'\<noteq>e \<and> (e',e)\<in>hb}*)
definition "downwards_closure S E \<equiv> S \<union>  (\<Union>e\<in>S. case (events E).[e] of None \<Rightarrow> {} | Some info \<Rightarrow> snapshot_events (event_snapshot info))"
definition "parallel_closure S A hb \<equiv> Set.filter (\<lambda>x. x\<in>S \<or> (\<exists>y\<in>S. (y,x)\<notin>hb)) A"

value "parallel_closure {1,2::int} {1,2,3,4,5} ({(2,3), (2,4), (1,4), (1,1), (2,2), (3,3), (4,4), (5,5)}\<^sup>+)"

value "parallel_closure {} {1::int,2,3,4,5} ({(2,3), (1,4), (1,1), (2,2), (3,3), (4,4), (5,5)}\<^sup>+)"

export_code previous_events in Haskell

definition
"wf_correct_execution_lists execution \<equiv>
events execution |> fmpred (\<lambda>e eInfo. valid_event_sequence (event_executionOrder eInfo) (previous_events (happensBefore execution) e) (happensBefore execution))
"

export_code wf_correct_execution_lists

find_consts "('a \<Rightarrow> 'b list) => 'a list => 'b list"

definition wf_effector :: "('operation, 'operation_result, 'operation_effector, 'state)execution \<Rightarrow> 'state \<Rightarrow> ('operation_effector, 'state) effector_function \<Rightarrow> bool" where
"wf_effector execution initS eff \<equiv>
events execution |> fmpred (\<lambda>e eInfo.
  let effectors = event_executionOrder eInfo |> List.maps (\<lambda>e'.
      case (events execution).[e'] of Some eInfo' \<Rightarrow> take (snapshot_num (event_snapshot eInfo) e') (event_effectors eInfo') | None \<Rightarrow> [])
  in
  event_state_pre eInfo = executeEffectors effectors initS eff
  \<and> event_state_post eInfo = executeEffectors (event_effectors eInfo) (event_state_pre eInfo) eff)
"

definition
"wf_localPreconditions execution localPred \<equiv>
events execution |> fmpred (\<lambda>e eInfo.  localPred (event_operation eInfo) (event_state_pre eInfo))
"

definition
"closed_concurrent e hb E \<equiv> \<forall>e1\<in>E. e1\<noteq>e \<and> (e1, e)\<in>hb \<longrightarrow> (\<forall>e2\<in>E.(e1,e2)\<notin>hb \<and> (e2,e1)\<notin>hb \<longrightarrow> (e2, e)\<in>hb)"

text {* Define that event e has received all effectors from its dependencies. *}
definition
"fullSnapshot e E \<equiv>
  case (events E).[e] of
      None \<Rightarrow> False
    | Some info \<Rightarrow> (\<forall>(e',n)\<in>snapshot_entries (event_snapshot info).
        case (events E).[e'] of
            None \<Rightarrow> False
          | Some info' \<Rightarrow> n \<ge> length (event_effectors info'))"

definition
"stable e E \<equiv> closed_concurrent e (happensBefore E) (fmdom' (events E))
            \<and> fullSnapshot e E  "

definition
"wf_stablePreconditions execution pred \<equiv>
events execution |> fmpred (\<lambda>e eInfo.
    case pred (event_operation eInfo) of
       None \<Rightarrow> True
     | Some cond \<Rightarrow>
        stable e execution
      \<and> cond (event_state_pre eInfo))
"

export_code closed_concurrent in Haskell
export_code wf_stablePreconditions in Haskell

definition wellFormed :: "('operation, 'operation_result, 'operation_effector, 'state) execution \<Rightarrow> 'state \<Rightarrow> ('operation, 'operation_result, 'operation_effector, 'state) generator_function \<Rightarrow> ( 'operation_effector, 'state) effector_function \<Rightarrow> ('operation \<Rightarrow> 'state \<Rightarrow> bool) \<Rightarrow> ('operation \<rightharpoonup> 'state \<Rightarrow> bool) \<Rightarrow> bool"
where
"wellFormed execution initS gen eff localPre pre \<equiv>
    wf_causallyConsistent execution
  \<and> wf_correct_execution_lists execution
  \<and> wf_generator execution gen
  \<and> wf_effector execution initS eff
  \<and> wf_localPreconditions execution localPre
  \<and> wf_stablePreconditions execution pre"

end


theory SINVAR_Subnets2
imports"../TopoS_Helper"
begin

(*EXPERIMENTAL!!*)

subsection \<open>SecurityInvariant Subnets2\<close>

text\<open>Warning, This is just a test. Please look at @{file \<open>SINVAR_Subnets.thy\<close>}.
This security invariant has the following changes, compared to @{file \<open>SINVAR_Subnets.thy\<close>}:
A new BorderRouter' is introduced which can send to the members of its subnet.
A new InboundRouter is accessible by anyone. It can access all other routers and the outside.
\<close>

datatype subnets = Subnet nat | BorderRouter nat | BorderRouter' nat | InboundRouter | Unassigned

definition default_node_properties :: "subnets"
  where "default_node_properties \<equiv> Unassigned"

fun allowed_subnet_flow :: "subnets \<Rightarrow> subnets \<Rightarrow> bool" where
  "allowed_subnet_flow (Subnet s1) (Subnet s2) = (s1 = s2)" |
  "allowed_subnet_flow (Subnet s1) (BorderRouter s2) = (s1 = s2)" |
  "allowed_subnet_flow (Subnet s1) (BorderRouter' s2) = (s1 = s2)" |
  "allowed_subnet_flow (Subnet _) _ = True" |
  "allowed_subnet_flow (BorderRouter _) (Subnet _) = False" |
  "allowed_subnet_flow (BorderRouter _) _ = True" |
  "allowed_subnet_flow (BorderRouter' s1) (Subnet s2) = (s1 = s2)" |
  "allowed_subnet_flow (BorderRouter' _) _ = True" |
  "allowed_subnet_flow InboundRouter (Subnet _) = False" |
  "allowed_subnet_flow InboundRouter _ = True" |
  "allowed_subnet_flow Unassigned Unassigned  = True" |
  "allowed_subnet_flow Unassigned InboundRouter  = True" |
  "allowed_subnet_flow Unassigned _  = False"

fun sinvar :: "'v graph \<Rightarrow> ('v \<Rightarrow> subnets) \<Rightarrow> bool" where
  "sinvar G nP = (\<forall> (e1,e2) \<in> edges G. allowed_subnet_flow (nP e1) (nP e2))"

definition receiver_violation :: "bool" where "receiver_violation = False"

text\<open>Only members of the same subnet or their @{const BorderRouter'} can access them.\<close>
lemma "allowed_subnet_flow a (Subnet s1) \<Longrightarrow> a = (BorderRouter' s1) \<or> a = (Subnet s1)"
  apply(cases a)
      apply(simp_all)
  done

subsubsection \<open>Preliminaries\<close>

subsubsection\<open>ENF\<close>
  lemma All_to_Unassigned: "\<forall> e1. allowed_subnet_flow e1 Unassigned"
    by (rule allI, case_tac e1, simp_all)
  lemma Unassigned_default_candidate: "\<forall> nP e1 e2. \<not> allowed_subnet_flow (nP e1) (nP e2) \<longrightarrow> \<not> allowed_subnet_flow Unassigned (nP e2)"
    apply(intro allI)
    apply(case_tac "nP e2")
       apply simp_all
     apply(case_tac "nP e1")
         apply simp_all
    by(simp add: All_to_Unassigned)
  lemma allowed_subnet_flow_refl: "\<forall> e. allowed_subnet_flow e e"
    by(rule allI, case_tac e, simp_all)
  lemma Subnets_ENF: "SecurityInvariant_withOffendingFlows.sinvar_all_edges_normal_form sinvar allowed_subnet_flow"
    unfolding SecurityInvariant_withOffendingFlows.sinvar_all_edges_normal_form_def
    by simp
  lemma Subnets_ENF_refl: "SecurityInvariant_withOffendingFlows.ENF_refl sinvar allowed_subnet_flow"
    unfolding SecurityInvariant_withOffendingFlows.ENF_refl_def
    apply(rule conjI)
     apply(simp add: Subnets_ENF)
    apply(simp add: allowed_subnet_flow_refl)
  done

  definition Subnets_offending_set:: "'v graph \<Rightarrow> ('v \<Rightarrow> subnets) \<Rightarrow> ('v \<times> 'v) set set" where
  "Subnets_offending_set G nP = (if sinvar G nP then
      {}
     else
      { {e \<in> edges G. case e of (e1,e2) \<Rightarrow> \<not> allowed_subnet_flow (nP e1) (nP e2)} })"
  lemma Subnets_offending_set:
  "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar = Subnets_offending_set"
    apply(simp only: fun_eq_iff ENF_offending_set[OF Subnets_ENF] Subnets_offending_set_def)
    apply(rule allI)+
    apply(rename_tac G nP)
    apply(auto)
  done

interpretation Subnets: SecurityInvariant_ACS
where default_node_properties = SINVAR_Subnets2.default_node_properties
and sinvar = SINVAR_Subnets2.sinvar
rewrites "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar = Subnets_offending_set"
  unfolding SINVAR_Subnets2.default_node_properties_def
  apply unfold_locales
    apply(rule ballI)
    apply (rule SecurityInvariant_withOffendingFlows.ENF_fsts_refl_instance[OF Subnets_ENF_refl Unassigned_default_candidate])[1]
     apply(simp_all)[2]
   apply(erule default_uniqueness_by_counterexample_ACS)
   apply (simp add: SecurityInvariant_withOffendingFlows.set_offending_flows_def
      SecurityInvariant_withOffendingFlows.is_offending_flows_min_set_def
      SecurityInvariant_withOffendingFlows.is_offending_flows_def)
   apply (simp add:graph_ops)
   apply (simp split: prod.split_asm prod.split)
   apply(rule_tac x="\<lparr> nodes={vertex_1,vertex_2}, edges = {(vertex_1,vertex_2)} \<rparr>" in exI, simp)
   apply(rule conjI)
    apply(simp add: wf_graph_def)
   apply(case_tac otherbot, simp_all)
      apply(rename_tac mysubnetcase)
      apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := BorderRouter mysubnetcase)" in exI, simp)
      apply(rule_tac x="vertex_1" in exI, simp)
      apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)
     apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := BorderRouter whatever)" in exI, simp)
     apply(rule_tac x="vertex_1" in exI, simp)
     apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)
    apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := BorderRouter whatever)" in exI, simp)
    apply(rule_tac x="vertex_1" in exI, simp)
    apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)
   apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := BorderRouter whatever)" in exI, simp)
   apply(rule_tac x="vertex_1" in exI, simp)
   apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)
  apply(fact Subnets_offending_set)
 done

  lemma TopoS_Subnets2: "SecurityInvariant sinvar default_node_properties receiver_violation"
  unfolding receiver_violation_def by unfold_locales

hide_fact (open) sinvar_mono
hide_const (open) sinvar receiver_violation default_node_properties

end


theory Worklist_Common
  imports Worklist_Locales
begin

lemma (in Search_Space_finite) finitely_branching:
  assumes "reachable a"
  shows "finite ({a'. E a a' \<and> \<not> empty a'})"
proof -
  have "{a'. E a a' \<and> \<not> empty a'} \<subseteq> {a'. reachable a' \<and> \<not> empty a'}"
    using assms(1) by (auto intro: reachable_step)
  then show ?thesis using finite_reachable
    by (rule finite_subset)
qed

end (* Theory *)


(*  Title:      HOL/Basic_BNF_LFPs.thy
    Author:     Jasmin Blanchette, TU Muenchen
    Copyright   2014

Registration of basic types as BNF least fixpoints (datatypes).
*)

theory Basic_BNF_LFPs
imports BNF_Least_Fixpoint
begin

definition xtor :: "'a \<Rightarrow> 'a" where
  "xtor x = x"

lemma xtor_map: "f (xtor x) = xtor (f x)"
  unfolding xtor_def by (rule refl)

lemma xtor_map_unique: "u \<circ> xtor = xtor \<circ> f \<Longrightarrow> u = f"
  unfolding o_def xtor_def .

lemma xtor_set: "f (xtor x) = f x"
  unfolding xtor_def by (rule refl)

lemma xtor_rel: "R (xtor x) (xtor y) = R x y"
  unfolding xtor_def by (rule refl)

lemma xtor_induct: "(\<And>x. P (xtor x)) \<Longrightarrow> P z"
  unfolding xtor_def by assumption

lemma xtor_xtor: "xtor (xtor x) = x"
  unfolding xtor_def by (rule refl)

lemmas xtor_inject = xtor_rel[of "op ="]

lemma xtor_rel_induct: "(\<And>x y. vimage2p id_bnf id_bnf R x y \<Longrightarrow> IR (xtor x) (xtor y)) \<Longrightarrow> R \<le> IR"
  unfolding xtor_def vimage2p_def id_bnf_def ..

lemma xtor_iff_xtor: "u = xtor w \<longleftrightarrow> xtor u = w"
  unfolding xtor_def ..

lemma Inl_def_alt: "Inl \<equiv> (\<lambda>a. xtor (id_bnf (Inl a)))"
  unfolding xtor_def id_bnf_def by (rule reflexive)

lemma Inr_def_alt: "Inr \<equiv> (\<lambda>a. xtor (id_bnf (Inr a)))"
  unfolding xtor_def id_bnf_def by (rule reflexive)

lemma Pair_def_alt: "Pair \<equiv> (\<lambda>a b. xtor (id_bnf (a, b)))"
  unfolding xtor_def id_bnf_def by (rule reflexive)

definition ctor_rec :: "'a \<Rightarrow> 'a" where
  "ctor_rec x = x"

lemma ctor_rec: "g = id \<Longrightarrow> ctor_rec f (xtor x) = f ((id_bnf \<circ> g \<circ> id_bnf) x)"
  unfolding ctor_rec_def id_bnf_def xtor_def comp_def id_def by hypsubst (rule refl)

lemma ctor_rec_unique: "g = id \<Longrightarrow> f \<circ> xtor = s \<circ> (id_bnf \<circ> g \<circ> id_bnf) \<Longrightarrow> f = ctor_rec s"
  unfolding ctor_rec_def id_bnf_def xtor_def comp_def id_def by hypsubst (rule refl)

lemma ctor_rec_def_alt: "f = ctor_rec (f \<circ> id_bnf)"
  unfolding ctor_rec_def id_bnf_def comp_def by (rule refl)

lemma ctor_rec_o_map: "ctor_rec f \<circ> g = ctor_rec (f \<circ> (id_bnf \<circ> g \<circ> id_bnf))"
  unfolding ctor_rec_def id_bnf_def comp_def by (rule refl)

lemma ctor_rec_transfer: "rel_fun (rel_fun (vimage2p id_bnf id_bnf R) S) (rel_fun R S) ctor_rec ctor_rec"
  unfolding rel_fun_def vimage2p_def id_bnf_def ctor_rec_def by simp

lemma eq_fst_iff: "a = fst p \<longleftrightarrow> (\<exists>b. p = (a, b))"
  by (cases p) auto

lemma eq_snd_iff: "b = snd p \<longleftrightarrow> (\<exists>a. p = (a, b))"
  by (cases p) auto

lemma ex_neg_all_pos: "((\<exists>x. P x) \<Longrightarrow> Q) \<equiv> (\<And>x. P x \<Longrightarrow> Q)"
  by standard blast+

lemma hypsubst_in_prems: "(\<And>x. y = x \<Longrightarrow> z = f x \<Longrightarrow> P) \<equiv> (z = f y \<Longrightarrow> P)"
  by standard blast+

lemma isl_map_sum:
  "isl (map_sum f g s) = isl s"
  by (cases s) simp_all

lemma map_sum_sel:
  "isl s \<Longrightarrow> projl (map_sum f g s) = f (projl s)"
  "\<not> isl s \<Longrightarrow> projr (map_sum f g s) = g (projr s)"
  by (case_tac [!] s) simp_all

lemma set_sum_sel:
  "isl s \<Longrightarrow> projl s \<in> setl s"
  "\<not> isl s \<Longrightarrow> projr s \<in> setr s"
  by (case_tac [!] s) (auto intro: setl.intros setr.intros)

lemma rel_sum_sel: "rel_sum R1 R2 a b = (isl a = isl b \<and>
  (isl a \<longrightarrow> isl b \<longrightarrow> R1 (projl a) (projl b)) \<and>
  (\<not> isl a \<longrightarrow> \<not> isl b \<longrightarrow> R2 (projr a) (projr b)))"
  by (cases a b rule: sum.exhaust[case_product sum.exhaust]) simp_all

lemma isl_transfer: "rel_fun (rel_sum A B) (op =) isl isl"
  unfolding rel_fun_def rel_sum_sel by simp

lemma rel_prod_sel: "rel_prod R1 R2 p q = (R1 (fst p) (fst q) \<and> R2 (snd p) (snd q))"
  by (force simp: rel_prod.simps elim: rel_prod.cases)

ML_file "Tools/BNF/bnf_lfp_basic_sugar.ML"

ML_file "~~/src/HOL/Tools/Old_Datatype/old_size.ML"

lemma size_bool[code]: "size (b :: bool) = 0"
  by (cases b) auto

declare prod.size[no_atp]

lemmas size_nat = size_nat_def

hide_const (open) xtor ctor_rec

hide_fact (open)
  xtor_def xtor_map xtor_set xtor_rel xtor_induct xtor_xtor xtor_inject ctor_rec_def ctor_rec
  ctor_rec_def_alt ctor_rec_o_map xtor_rel_induct Inl_def_alt Inr_def_alt Pair_def_alt

end


(*  Title:      ZF/AC/AC15_WO6.thy
    Author:     Krzysztof Grabczewski

The proofs needed to state that AC10, ..., AC15 are equivalent to the rest.
We need the following:

WO1 \<Longrightarrow> AC10(n) \<Longrightarrow> AC11 \<Longrightarrow> AC12 \<Longrightarrow> AC15 \<Longrightarrow> WO6

In order to add the formulations AC13 and AC14 we need:

AC10(succ(n)) \<Longrightarrow> AC13(n) \<Longrightarrow> AC14 \<Longrightarrow> AC15

or

AC1 \<Longrightarrow> AC13(1);  AC13(m) \<Longrightarrow> AC13(n) \<Longrightarrow> AC14 \<Longrightarrow> AC15    (m\<le>n)

So we don't have to prove all implications of both cases.
Moreover we don't need to prove AC13(1) \<Longrightarrow> AC1 and AC11 \<Longrightarrow> AC14 as
Rubin & Rubin do.
*)

theory AC15_WO6
imports HH Cardinal_aux
begin

(* ********************************************************************** *)
(* Lemmas used in the proofs in which the conclusion is AC13, AC14        *)
(* or AC15                                                                *)
(*  - cons_times_nat_not_Finite                                           *)
(*  - ex_fun_AC13_AC15                                                    *)
(* ********************************************************************** *)

lemma lepoll_Sigma: "A\<noteq>0 \<Longrightarrow> B \<lesssim> A*B"
  unfolding lepoll_def
apply (erule not_emptyE)
apply (rule_tac x = "\<lambda>z \<in> B. \<langle>x,z\<rangle>" in exI)
apply (fast intro!: snd_conv lam_injective)
done

lemma cons_times_nat_not_Finite:
     "0\<notin>A \<Longrightarrow> \<forall>B \<in> {cons(0,x*nat). x \<in> A}. \<not>Finite(B)"
apply clarify
apply (rule nat_not_Finite [THEN notE] )
apply (subgoal_tac "x \<noteq> 0")
 apply (blast intro: lepoll_Sigma [THEN lepoll_Finite])+
done

lemma lemma1: "\<lbrakk>\<Union>(C)=A; a \<in> A\<rbrakk> \<Longrightarrow> \<exists>B \<in> C. a \<in> B \<and> B \<subseteq> A"
by fast

lemma lemma2:
        "\<lbrakk>pairwise_disjoint(A); B \<in> A; C \<in> A; a \<in> B; a \<in> C\<rbrakk> \<Longrightarrow> B=C"
by (unfold pairwise_disjoint_def, blast)

lemma lemma3:
     "\<forall>B \<in> {cons(0, x*nat). x \<in> A}. pairwise_disjoint(f`B) \<and>
             sets_of_size_between(f`B, 2, n) \<and> \<Union>(f`B)=B
     \<Longrightarrow> \<forall>B \<in> A. \<exists>! u. u \<in> f`cons(0, B*nat) \<and> u \<subseteq> cons(0, B*nat) \<and>
             0 \<in> u \<and> 2 \<lesssim> u \<and> u \<lesssim> n"
  unfolding sets_of_size_between_def
apply (rule ballI)
apply (erule_tac x="cons(0, B*nat)" in ballE)
 apply (blast dest: lemma1 intro!: lemma2, blast)
done

lemma lemma4: "\<lbrakk>A \<lesssim> i; Ord(i)\<rbrakk> \<Longrightarrow> {P(a). a \<in> A} \<lesssim> i"
  unfolding lepoll_def
apply (erule exE)
apply (rule_tac x = "\<lambda>x \<in> RepFun(A,P). \<mu> j. \<exists>a\<in>A. x=P(a) \<and> f`a=j"
       in exI)
apply (rule_tac d = "\<lambda>y. P (converse (f) `y) " in lam_injective)
apply (erule RepFunE)
apply (frule inj_is_fun [THEN apply_type], assumption)
apply (fast intro: LeastI2 elim!: Ord_in_Ord inj_is_fun [THEN apply_type])
apply (erule RepFunE)
apply (rule LeastI2)
  apply fast
 apply (fast elim!: Ord_in_Ord inj_is_fun [THEN apply_type])
apply (fast elim: sym left_inverse [THEN ssubst])
done

lemma lemma5_1:
     "\<lbrakk>B \<in> A; 2 \<lesssim> u(B)\<rbrakk> \<Longrightarrow> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<noteq> 0"
apply simp
apply (fast dest: lepoll_Diff_sing
            elim: lepoll_trans [THEN succ_lepoll_natE] ssubst
            intro!: lepoll_refl)
done

lemma lemma5_2:
     "\<lbrakk>B \<in> A; u(B) \<subseteq> cons(0, B*nat)\<rbrakk>
      \<Longrightarrow> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<subseteq> B"
apply auto
done

lemma lemma5_3:
     "\<lbrakk>n \<in> nat; B \<in> A; 0 \<in> u(B); u(B) \<lesssim> succ(n)\<rbrakk>
      \<Longrightarrow> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<lesssim> n"
apply simp
apply (fast elim!: Diff_lepoll [THEN lemma4 [OF _ nat_into_Ord]])
done

lemma ex_fun_AC13_AC15:
     "\<lbrakk>\<forall>B \<in> {cons(0, x*nat). x \<in> A}.
                pairwise_disjoint(f`B) \<and>
                sets_of_size_between(f`B, 2, succ(n)) \<and> \<Union>(f`B)=B;
         n \<in> nat\<rbrakk>
      \<Longrightarrow> \<exists>f. \<forall>B \<in> A. f`B \<noteq> 0 \<and> f`B \<subseteq> B \<and> f`B \<lesssim> n"
by (fast del: subsetI notI
         dest!: lemma3 theI intro!: lemma5_1 lemma5_2 lemma5_3)

(* ********************************************************************** *)
(* The target proofs                                                      *)
(* ********************************************************************** *)

(* ********************************************************************** *)
(* AC10(n) \<Longrightarrow> AC11                                                       *)
(* ********************************************************************** *)

theorem AC10_AC11: "\<lbrakk>n \<in> nat; 1\<le>n; AC10(n)\<rbrakk> \<Longrightarrow> AC11"
by (unfold AC10_def AC11_def, blast)

(* ********************************************************************** *)
(* AC11 \<Longrightarrow> AC12                                                          *)
(* ********************************************************************** *)

theorem AC11_AC12: "AC11 \<Longrightarrow> AC12"
by (unfold AC10_def AC11_def AC11_def AC12_def, blast)

(* ********************************************************************** *)
(* AC12 \<Longrightarrow> AC15                                                          *)
(* ********************************************************************** *)

theorem AC12_AC15: "AC12 \<Longrightarrow> AC15"
  unfolding AC12_def AC15_def
apply (blast del: ballI
             intro!: cons_times_nat_not_Finite ex_fun_AC13_AC15)
done

(* ********************************************************************** *)
(* AC15 \<Longrightarrow> WO6                                                           *)
(* ********************************************************************** *)

lemma OUN_eq_UN: "Ord(x) \<Longrightarrow> (\<Union>a<x. F(a)) = (\<Union>a \<in> x. F(a))"
by (fast intro!: ltI dest!: ltD)

lemma AC15_WO6_aux1:
     "\<forall>x \<in> Pow(A)-{0}. f`x\<noteq>0 \<and> f`x \<subseteq> x \<and> f`x \<lesssim> m
      \<Longrightarrow> (\<Union>i<\<mu> x. HH(f,A,x)={A}. HH(f,A,i)) = A"
apply (simp add: Ord_Least [THEN OUN_eq_UN])
apply (rule equalityI)
apply (fast dest!: less_Least_subset_x)
apply (blast del: subsetI
           intro!: f_subsets_imp_UN_HH_eq_x [THEN Diff_eq_0_iff [THEN iffD1]])
done

lemma AC15_WO6_aux2:
     "\<forall>x \<in> Pow(A)-{0}. f`x\<noteq>0 \<and> f`x \<subseteq> x \<and> f`x \<lesssim> m
      \<Longrightarrow> \<forall>x < (\<mu> x. HH(f,A,x)={A}). HH(f,A,x) \<lesssim> m"
apply (rule oallI)
apply (drule ltD [THEN less_Least_subset_x])
apply (frule HH_subset_imp_eq)
apply (erule ssubst)
apply (blast dest!: HH_subset_x_imp_subset_Diff_UN [THEN not_emptyI2])
        (*but can't use del: DiffE despite the obvious conflict*)
done

theorem AC15_WO6: "AC15 \<Longrightarrow> WO6"
  unfolding AC15_def WO6_def
apply (rule allI)
apply (erule_tac x = "Pow (A) -{0}" in allE)
apply (erule impE, fast)
apply (elim bexE conjE exE)
apply (rule bexI)
 apply (rule conjI, assumption)
 apply (rule_tac x = "\<mu> i. HH (f,A,i) ={A}" in exI)
 apply (rule_tac x = "\<lambda>j \<in> (\<mu> i. HH (f,A,i) ={A}) . HH (f,A,j) " in exI)
 apply (simp_all add: ltD)
apply (fast intro!: Ord_Least lam_type [THEN domain_of_fun]
            elim!: less_Least_subset_x AC15_WO6_aux1 AC15_WO6_aux2)
done

(* ********************************************************************** *)
(* The proof needed in the first case, not in the second                  *)
(* ********************************************************************** *)

(* ********************************************************************** *)
(* AC10(n) \<Longrightarrow> AC13(n-1)  if 2\<le>n                                       *)
(*                                                                        *)
(* Because of the change to the formal definition of AC10(n) we prove     *)
(* the following obviously equivalent theorem \<in>                           *)
(* AC10(n) implies AC13(n) for (1\<le>n)                                   *)
(* ********************************************************************** *)

theorem AC10_AC13: "\<lbrakk>n \<in> nat; 1\<le>n; AC10(n)\<rbrakk> \<Longrightarrow> AC13(n)"
apply (unfold AC10_def AC13_def, safe)
apply (erule allE)
apply (erule impE [OF _ cons_times_nat_not_Finite], assumption)
apply (fast elim!: impE [OF _ cons_times_nat_not_Finite]
            dest!: ex_fun_AC13_AC15)
done

(* ********************************************************************** *)
(* The proofs needed in the second case, not in the first                 *)
(* ********************************************************************** *)

(* ********************************************************************** *)
(* AC1 \<Longrightarrow> AC13(1)                                                        *)
(* ********************************************************************** *)

lemma AC1_AC13: "AC1 \<Longrightarrow> AC13(1)"
  unfolding AC1_def AC13_def
apply (rule allI)
apply (erule allE)
apply (rule impI)
apply (drule mp, assumption)
apply (elim exE)
apply (rule_tac x = "\<lambda>x \<in> A. {f`x}" in exI)
apply (simp add: singleton_eqpoll_1 [THEN eqpoll_imp_lepoll])
done

(* ********************************************************************** *)
(* AC13(m) \<Longrightarrow> AC13(n) for m \<subseteq> n                                         *)
(* ********************************************************************** *)

lemma AC13_mono: "\<lbrakk>m\<le>n; AC13(m)\<rbrakk> \<Longrightarrow> AC13(n)"
  unfolding AC13_def
apply (drule le_imp_lepoll)
apply (fast elim!: lepoll_trans)
done

(* ********************************************************************** *)
(* The proofs necessary for both cases                                    *)
(* ********************************************************************** *)

(* ********************************************************************** *)
(* AC13(n) \<Longrightarrow> AC14  if 1 \<subseteq> n                                            *)
(* ********************************************************************** *)

theorem AC13_AC14: "\<lbrakk>n \<in> nat; 1\<le>n; AC13(n)\<rbrakk> \<Longrightarrow> AC14"
by (unfold AC13_def AC14_def, auto)

(* ********************************************************************** *)
(* AC14 \<Longrightarrow> AC15                                                          *)
(* ********************************************************************** *)

theorem AC14_AC15: "AC14 \<Longrightarrow> AC15"
by (unfold AC13_def AC14_def AC15_def, fast)

(* ********************************************************************** *)
(* The redundant proofs; however cited by Rubin & Rubin                   *)
(* ********************************************************************** *)

(* ********************************************************************** *)
(* AC13(1) \<Longrightarrow> AC1                                                        *)
(* ********************************************************************** *)

lemma lemma_aux: "\<lbrakk>A\<noteq>0; A \<lesssim> 1\<rbrakk> \<Longrightarrow> \<exists>a. A={a}"
by (fast elim!: not_emptyE lepoll_1_is_sing)

lemma AC13_AC1_lemma:
     "\<forall>B \<in> A. f(B)\<noteq>0 \<and> f(B)<=B \<and> f(B) \<lesssim> 1
      \<Longrightarrow> (\<lambda>x \<in> A. THE y. f(x)={y}) \<in> (\<Prod>X \<in> A. X)"
apply (rule lam_type)
apply (drule bspec, assumption)
apply (elim conjE)
apply (erule lemma_aux [THEN exE], assumption)
apply (simp add: the_equality)
done

theorem AC13_AC1: "AC13(1) \<Longrightarrow> AC1"
  unfolding AC13_def AC1_def
apply (fast elim!: AC13_AC1_lemma)
done

(* ********************************************************************** *)
(* AC11 \<Longrightarrow> AC14                                                          *)
(* ********************************************************************** *)

theorem AC11_AC14: "AC11 \<Longrightarrow> AC14"
  unfolding AC11_def AC14_def
apply (fast intro!: AC10_AC13)
done

end