(*
   Title: The Calculus of Communicating Systems
   Author/Maintainer: Jesper Bengtson (jebe@itu.dk), 2012
*)
theory Strong_Bisim
  imports Strong_Sim
begin

  assumes "P \<leadsto>[A] Q"
  and     "A \<subseteq> B"

  shows "P \<leadsto>[B] Q"
using assms
by(fastforce simp add: simulation_def)

lemma monoCoinduct: "\<And>x y xa xb P Q.
                      x \<le> y \<Longrightarrow>
                      (Q \<leadsto>[{(xb, xa). x xb xa}] P) \<longrightarrow>
                     (Q \<leadsto>[{(xb, xa). y xb xa}] P)"
apply auto
apply(rule monotonic)
by(auto dest: le_funE)

coinductive_set bisim :: "(ccs \<times> ccs) set"
where
  "\<lbrakk>P \<leadsto>[bisim] Q; (Q, P) \<in> bisim\<rbrakk> \<Longrightarrow> (P, Q) \<in> bisim"
monos monoCoinduct

abbreviation
  bisimJudge ("_ \<sim> _" [70, 70] 65) where "P \<sim> Q \<equiv> (P, Q) \<in> bisim"

lemma bisimCoinductAux[consumes 1]:
  fixes P :: "ccs"
  and   Q :: "ccs"
  and   X :: "(ccs \<times> ccs) set"

  assumes "(P, Q) \<in> X"
  and     "\<And>P Q. (P, Q) \<in> X \<Longrightarrow> P \<leadsto>[(X \<union> bisim)] Q \<and> (Q, P) \<in> X"

  shows "P \<sim> Q"
proof -
  have "X \<union> bisim = {(P, Q). (P, Q) \<in> X \<or> (P, Q) \<in> bisim}" by auto
  with assms show ?thesis
    by coinduct simp
qed

lemma bisimCoinduct[consumes 1, case_names cSim cSym]:
  fixes P :: "ccs"
  and   Q :: "ccs"
  and   X :: "(ccs \<times> ccs) set"

  assumes "(P, Q) \<in> X"
  and     "\<And>R S. (R, S) \<in> X \<Longrightarrow> R \<leadsto>[(X \<union> bisim)] S"
  and     "\<And>R S. (R, S) \<in> X \<Longrightarrow> (S, R) \<in> X"

  shows "P \<sim> Q"
proof -
  have "X \<union> bisim = {(P, Q). (P, Q) \<in> X \<or> (P, Q) \<in> bisim}" by auto
  with assms show ?thesis
    by coinduct simp
qed

lemma bisimWeakCoinductAux[consumes 1]:
  fixes P :: "ccs"
  and   Q :: "ccs"
  and   X :: "(ccs \<times> ccs) set"

  assumes "(P, Q) \<in> X"
  and     "\<And>R S. (R, S) \<in> X \<Longrightarrow> R \<leadsto>[X] S \<and> (S, R) \<in> X"

  shows "P \<sim> Q"
using assms
by(coinduct rule: bisimCoinductAux) (blast intro: monotonic)

lemma bisimWeakCoinduct[consumes 1, case_names cSim cSym]:
  fixes P :: "ccs"
  and   Q :: "ccs"
  and   X :: "(ccs \<times> ccs) set"

  assumes "(P, Q) \<in> X"
  and     "\<And>P Q. (P, Q) \<in> X \<Longrightarrow> P \<leadsto>[X] Q"
  and     "\<And>P Q. (P, Q) \<in> X \<Longrightarrow> (Q, P) \<in> X"

  shows "P \<sim> Q"
proof -
  have "X \<union> bisim = {(P, Q). (P, Q) \<in> X \<or> (P, Q) \<in> bisim}" by auto
  with assms show ?thesis
  by(coinduct rule: bisimCoinduct) (blast intro: monotonic)+
qed

lemma bisimE:
  fixes P  :: "ccs"
  and   Q  :: "ccs"

  assumes "P \<sim> Q"

  shows "P \<leadsto>[bisim] Q"
  and   "Q \<sim> P"
using assms
by(auto simp add: intro: bisim.cases)

lemma bisimI:
  fixes P :: "ccs"
  and   Q :: "ccs"

  assumes "P \<leadsto>[bisim] Q"
  and     "Q \<sim> P"

  shows "P \<sim> Q"
using assms
by(auto intro: bisim.intros)

lemma reflexive:
  fixes P :: ccs

  shows "P \<sim> P"
proof -
  have "(P, P) \<in> Id" by blast
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: reflexive)
qed

  assumes "P \<sim> Q"

  shows "Q \<sim> P"
using assms
by(rule bisimE)

  assumes "P \<sim> Q"
  and     "Q \<sim> R"

  shows "P \<sim> R"
proof -
  from assms have "(P, R) \<in> bisim O bisim" by auto
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: transitive dest: bisimE)
qed

lemma bisimTransCoinduct[consumes 1, case_names cSim cSym]:
  fixes P :: ccs
  and   Q :: ccs

  assumes "(P, Q) \<in> X"
  and     rSim: "\<And>R S. (R, S) \<in> X \<Longrightarrow> R \<leadsto>[(bisim O X O bisim)] S"
  and     rSym: "\<And>R S. (R, S) \<in> X \<Longrightarrow> (S, R) \<in> X"

  shows "P \<sim> Q"
proof -
  from \<open>(P, Q) \<in> X\<close> have "(P, Q) \<in> bisim O X O bisim"
    by(auto intro: reflexive)
  thus ?thesis
  proof(coinduct rule: bisimWeakCoinduct)
    case(cSim P Q)
    from \<open>(P, Q) \<in> bisim O X O bisim\<close>
    obtain R S where "P \<sim> R" and "(R, S) \<in> X" and "S \<sim> Q"
      by auto
    from \<open>P \<sim> R\<close> have "P \<leadsto>[bisim] R" by(rule bisimE)
    moreover from \<open>(R, S) \<in> X\<close> have "R \<leadsto>[(bisim O X O bisim)] S"
      by(rule rSim)
    moreover have "bisim O (bisim O X O bisim) \<subseteq> bisim O X O bisim"
      by(auto intro: transitive)
    ultimately have "P \<leadsto>[(bisim O X O bisim)] S"
      by(rule Strong_Sim.transitive)
    moreover from \<open>S \<sim> Q\<close> have "S \<leadsto>[bisim] Q" by(rule bisimE)
    moreover have "(bisim O X O bisim) O bisim \<subseteq> bisim O X O bisim"
      by(auto intro: transitive)
    ultimately show ?case by(rule Strong_Sim.transitive)
  next
    case(cSym P Q)
    thus ?case by(auto dest: symmetric rSym)
  qed
qed

end


(*  Author:     Gertrud Bauer
*)

section\<open>Plane Graph Enumeration\<close>

theory Plane
imports Enumerator FaceDivision RTranCl
begin

definition maxGon :: "nat \<Rightarrow> nat" where
"maxGon p \<equiv> p+3"

declare maxGon_def [simp]

definition duplicateEdge :: "graph \<Rightarrow> face \<Rightarrow> vertex \<Rightarrow> vertex \<Rightarrow> bool" where
 "duplicateEdge g f a b \<equiv>
  2 \<le> directedLength f a b \<and> 2 \<le> directedLength f b a \<and> b \<in> set (neighbors g a)"

primrec containsUnacceptableEdgeSnd ::
      "(nat \<Rightarrow> nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> bool" where
 "containsUnacceptableEdgeSnd N v [] = False" |
 "containsUnacceptableEdgeSnd N v (w#ws) =
     (case ws of [] \<Rightarrow> False
         | (w'#ws') \<Rightarrow> if v < w \<and> w < w' \<and> N w w' then True
                      else containsUnacceptableEdgeSnd N w ws)"

primrec containsUnacceptableEdge :: "(nat \<Rightarrow> nat \<Rightarrow> bool) \<Rightarrow> nat list \<Rightarrow> bool" where
 "containsUnacceptableEdge N [] = False" |
 "containsUnacceptableEdge N (v#vs) =
     (case vs of [] \<Rightarrow> False
           | (w#ws) \<Rightarrow> if v < w \<and> N v w then True
                      else containsUnacceptableEdgeSnd N v vs)"

definition containsDuplicateEdge :: "graph \<Rightarrow> face \<Rightarrow> vertex \<Rightarrow> nat list \<Rightarrow> bool" where
 "containsDuplicateEdge g f v is \<equiv>
     containsUnacceptableEdge (\<lambda>i j. duplicateEdge g f (f\<^bsup>i\<^esup>\<bullet>v) (f\<^bsup>j\<^esup>\<bullet>v)) is"

definition containsDuplicateEdge' :: "graph \<Rightarrow> face \<Rightarrow> vertex \<Rightarrow> nat list \<Rightarrow> bool" where
 "containsDuplicateEdge' g f v is \<equiv>
  2 \<le> |is| \<and>
  ((\<exists>k < |is| - 2. let i0 = is!k; i1 = is!(k+1); i2 = is!(k+2) in
    (duplicateEdge g f (f\<^bsup>i1 \<^esup>\<bullet>v) (f\<^bsup>i2 \<^esup>\<bullet>v)) \<and> (i0 < i1) \<and> (i1 < i2))
  \<or> (let i0 = is!0; i1 = is!1 in
    (duplicateEdge g f (f\<^bsup>i0 \<^esup>\<bullet>v) (f\<^bsup>i1 \<^esup>\<bullet>v)) \<and> (i0 < i1)))"

definition generatePolygon :: "nat \<Rightarrow> vertex \<Rightarrow> face \<Rightarrow> graph \<Rightarrow> graph list" where
 "generatePolygon n v f g \<equiv>
     let enumeration = enumerator n |vertices f|;
     enumeration = [is \<leftarrow> enumeration. \<not> containsDuplicateEdge g f v is];
     vertexLists = [indexToVertexList f v is. is \<leftarrow> enumeration] in
     [subdivFace g f vs. vs \<leftarrow> vertexLists]"

definition next_plane0 :: "nat \<Rightarrow> graph \<Rightarrow> graph list" ("next'_plane0\<^bsub>_\<^esub>") where
 "next_plane0\<^bsub>p\<^esub> g \<equiv>
     if final g then []
     else \<Squnion>\<^bsub>f\<in>nonFinals g\<^esub> \<Squnion>\<^bsub>v\<in>vertices f\<^esub> \<Squnion>\<^bsub>i\<in>[3..<Suc(maxGon p)]\<^esub> generatePolygon i v f g"

definition Seed :: "nat \<Rightarrow> graph" ("Seed\<^bsub>_\<^esub>") where
  "Seed\<^bsub>p\<^esub> \<equiv> graph(maxGon p)"

lemma Seed_not_final[iff]: "\<not> final (Seed p)"
by(simp add:Seed_def graph_def finalGraph_def nonFinals_def)

definition PlaneGraphs0 :: "graph set" where
"PlaneGraphs0 \<equiv> \<Union>p. {g. Seed\<^bsub>p\<^esub> [next_plane0\<^bsub>p\<^esub>]\<rightarrow>* g \<and> final g}"

end


theory prop_41
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  datatype Nat = Z | S "Nat"
  fun take :: "Nat => 'a list => 'a list" where
  "take (Z) y = Nil2"
  | "take (S z) (Nil2) = Nil2"
  | "take (S z) (Cons2 x2 x3) = Cons2 x2 (take z x3)"
  fun map2 :: "('a => 'b) => 'a list => 'b list" where
  "map2 x (Nil2) = Nil2"
  | "map2 x (Cons2 z xs) = Cons2 (x z) (map2 x xs)"
  (*hipster take map2 *)
  theorem x0 :
    "(take n (map2 f xs)) = (map2 f (take n xs))"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
end


header {* Boolean Algebra of Assertions *}

theory  Assertion_Algebra
imports Mono_Bool_Tran_Algebra
begin

text{*
This section introduces the boolean algebra of assertions. The
type $\mathsf{Assertion}$ and the boolean operation are instroduced
based on the set $\mathsf{assertion}$ and the operations on the monotonic
boolean transformers algebra. The type $\mathsf{Assertion}$ over
a complete monotonic boolean transformers algebra is a complete boolean
algebra.
*}

typedef ('a::mbt_algebra) Assertion = "assertion::'a set"
  apply (rule_tac x = "\<bottom>" in exI)
  by (unfold assertion_def, simp)

definition
  assert :: "'a::mbt_algebra Assertion \<Rightarrow> 'a"  ("{\<cdot> _ }" [0] 1000) where
  "{\<cdot>p} =  Rep_Assertion p"

definition
  "abs_wpt x = Abs_Assertion (wpt x)"

lemma [simp]: "abs_wpt ({\<cdot>p}) = p"
  apply (simp add: abs_wpt_def)
  by (simp add: assert_def Rep_Assertion_inverse)

lemma [simp]: "x \<in> assertion \<Longrightarrow> {\<cdot>Abs_Assertion x} = x"
  apply (simp add: assert_def)
  by (rule Abs_Assertion_inverse, simp)

lemma [simp]: "x \<in> assertion \<Longrightarrow> {\<cdot>abs_wpt x} = x"
  apply (simp add: abs_wpt_def assert_def)
  by (rule Abs_Assertion_inverse, simp)

lemma assert_injective: "{\<cdot>p} = {\<cdot>q} \<Longrightarrow> p = q"
  proof -
    assume A: "{\<cdot> p } = {\<cdot> q } "
    have "p = abs_wpt ({\<cdot>p})" by simp
    also have "... = q" by (subst A, simp)
    finally show ?thesis .
  qed

instantiation Assertion :: (mbt_algebra) boolean_algebra
begin
  definition
    uminus_Assertion_def: "- p = abs_wpt(neg_assert {\<cdot>p})"

  definition
    bot_Assertion_def: "\<bottom> = abs_wpt \<bottom>"

  definition
    top_Assertion_def: "\<top> = abs_wpt 1"

  definition
    inf_Assertion_def: "p \<sqinter> q = abs_wpt ({\<cdot>p} \<sqinter> {\<cdot>q})"

  definition
    sup_Assertion_def: "p \<squnion> q = abs_wpt ({\<cdot>p} \<squnion> {\<cdot>q})"

  definition
    less_eq_Assertion_def: "(p \<le> q) = ({\<cdot>p} \<le>  {\<cdot>q})"

  definition
    less_Assertion_def: "(p < q) = ({\<cdot>p} < {\<cdot>q})"

  definition
    minus_Assertion_def: "(p::'a Assertion) - q = p \<sqinter> - q"

instance
  proof
    fix x y :: "'a Assertion" show "(x < y) = (x \<le> y \<and> \<not> y \<le> x)"
      by (simp add: less_Assertion_def less_eq_Assertion_def less_le_not_le)
  next
    fix x ::"'a Assertion" show "x \<le> x" by (simp add: less_eq_Assertion_def)
  next
    fix x y z :: "'a Assertion" assume A: "x \<le> y" assume B: "y \<le> z" from A and B show "x \<le> z"
      by (simp add: less_eq_Assertion_def)
  next
    fix x y :: "'a Assertion" assume A: "x \<le> y" assume B: "y \<le> x" from A and B show "x = y"
      apply (cut_tac p = x and q = y in assert_injective)
      by (rule antisym, simp_all add: less_eq_Assertion_def)
  next
    fix x y :: "'a Assertion" show "x \<sqinter> y \<le> x"
      by (simp add: less_eq_Assertion_def inf_Assertion_def)
    fix x y :: "'a Assertion" show "x \<sqinter> y \<le> y"
      by (simp add: less_eq_Assertion_def inf_Assertion_def)
  next
    fix x y z :: "'a Assertion" assume A: "x \<le> y" assume B: "x \<le> z" from A and B show "x \<le> y \<sqinter> z"
      by (simp add: less_eq_Assertion_def inf_Assertion_def)
  next
    fix x y :: "'a Assertion" show "x \<le> x \<squnion> y"
      by (simp add: less_eq_Assertion_def sup_Assertion_def)
    fix x y :: "'a Assertion" show "y \<le> x \<squnion> y"
      by (simp add: less_eq_Assertion_def sup_Assertion_def)
  next
    fix x y z :: "'a Assertion" assume A: "y \<le> x" assume B: "z \<le> x" from A and B show "y \<squnion> z \<le> x"
      by (simp add: less_eq_Assertion_def sup_Assertion_def)
  next
    fix x :: "'a Assertion" show "\<bottom> \<le> x"
      by (simp add: less_eq_Assertion_def bot_Assertion_def)
  next
    fix x :: "'a Assertion" show "x \<le> \<top>"
      by (simp add: less_eq_Assertion_def top_Assertion_def)
  next
    fix x y z :: "'a Assertion" show "x \<squnion> y \<sqinter> z = (x \<squnion> y) \<sqinter> (x \<squnion> z)"
      by (simp add: less_eq_Assertion_def sup_Assertion_def inf_Assertion_def sup_inf_distrib)
  next
    fix x :: "'a Assertion" show "x \<sqinter> - x = \<bottom>"
      by (simp add: inf_Assertion_def uminus_Assertion_def bot_Assertion_def)
  next
    fix x :: "'a Assertion" show "x \<squnion> - x = \<top>"
      by (simp add: sup_Assertion_def uminus_Assertion_def top_Assertion_def)
  next
    fix x y :: "'a Assertion" show "x - y = x \<sqinter> - y"
      by (simp add: minus_Assertion_def)
  qed

end

lemma assert_image [simp]: "assert ` A \<subseteq> assertion"
  by auto

instantiation Assertion :: (complete_mbt_algebra) complete_lattice
begin
  definition
    Sup_Assertion_def: "Sup A = abs_wpt (Sup (assert ` A))"

  definition
    Inf_Assertion_def: "Inf (A::('a Assertion) set) = - (Sup (uminus ` A))"

lemma Sup1: "(x::'a Assertion) \<in> A \<Longrightarrow> x \<le> Sup A"
    apply (simp add: Sup_Assertion_def less_eq_Assertion_def Abs_Assertion_inverse del: Sup_image_eq)
    by (rule Sup_upper, simp)

lemma Sup2: "(\<And>x::'a Assertion . x \<in> A \<Longrightarrow> x \<le> z) \<Longrightarrow> Sup A \<le> z"
    apply (simp add: Sup_Assertion_def less_eq_Assertion_def Abs_Assertion_inverse del: Sup_image_eq)
    apply (rule Sup_least)
    by blast

instance
proof
  fix x :: "'a Assertion" fix A assume A: "x \<in> A" from A show "Inf A \<le> x"
    apply (simp add: Inf_Assertion_def)
    apply (subst compl_le_compl_iff [THEN sym], simp)
    by (rule Sup1, simp)
next
  fix z :: "'a Assertion" fix A assume A: "\<And>x . x \<in> A \<Longrightarrow> z \<le> x" from A show "z \<le> Inf A"
    apply (simp add: Inf_Assertion_def)
    apply (subst compl_le_compl_iff [THEN sym], simp)
    apply (rule Sup2)
    apply safe
    by simp
next
  fix x :: "'a Assertion" fix A assume A: "x \<in> A" from A show "x \<le> Sup A"
    by (rule Sup1)
next
  fix z :: "'a Assertion" fix A assume A: "\<And>x . x \<in> A \<Longrightarrow> x \<le> z" from A show "Sup A \<le> z"
    by (rule Sup2)
next
  show "Inf {} = (\<top>::'a Assertion)"
    by (auto simp: Inf_Assertion_def Sup_Assertion_def compl_bot_eq [symmetric] bot_Assertion_def)
next
  show "Sup {} = (\<bottom>::'a Assertion)"
    by (auto simp: Sup_Assertion_def bot_Assertion_def)
qed
end

lemma assert_top [simp]: "{\<cdot>\<top>} = 1"
  by (simp add: top_Assertion_def)

lemma assert_Sup: "{\<cdot>Sup A} = Sup (assert ` A)"
  by (simp add: Sup_Assertion_def Abs_Assertion_inverse del: Sup_image_eq)

lemma assert_Inf: "{\<cdot>Inf A} = (Inf (assert ` A)) \<sqinter> 1"
proof (cases "A = {}")
  case True then show ?thesis by simp
next
  note strong_INF_cong [cong del] strong_SUP_cong [cong del]
  case False then show ?thesis
  apply (simp add: Inf_Assertion_def uminus_Assertion_def)
  apply (simp add: neg_assert_def assert_Sup dual_Sup Inf_comp inf_commute inf_Inf comp_def INF_def SUP_def
    del: Inf_image_eq Sup_image_eq)
  apply (rule_tac f = Inf in fun_eq)
  apply safe
  apply simp
  apply (subst inf_commute)
  apply (simp add: image_def uminus_Assertion_def)
  apply (simp add: neg_assert_def dual_comp dual_inf sup_comp assertion_prop)
  apply (simp add: inf_commute)
  apply auto [1]
  apply (simp)
  apply (subst image_def, simp)
  apply (simp add: uminus_Assertion_def)
  apply (subst inf_commute)
  apply (simp add: neg_assert_def dual_comp dual_inf sup_comp assertion_prop)
  apply auto
  done
qed

lemma assert_Inf_ne: "A \<noteq> {} \<Longrightarrow> {\<cdot>Inf A} = Inf (assert ` A)"
  apply (unfold assert_Inf)
  apply (rule antisym)
  apply simp_all
  apply safe
  apply (erule notE)
  apply (rule_tac y = "{\<cdot>x}" in order_trans)
  by (simp_all add: INF_lower)

lemma assert_Sup_range: "{\<cdot>Sup (range p)} = Sup (range (assert o p))"
  apply (subst assert_Sup)
  by (rule_tac f = "Sup" in fun_eq, auto)

lemma assert_Sup_less: "{\<cdot> Sup_less p w } = Sup_less (assert o p) w"
  apply (simp add: Sup_less_def)
  apply (subst assert_Sup)
  by (rule_tac f = "Sup" in fun_eq, auto)

end


theory Check
  imports Submission
begin

lemma sound: "\<Turnstile> {change_rule x b P} CHANGE x ST b {P}"
  by (rule Submission.sound)

lemma complete: "\<Turnstile> {P} (CHANGE x ST b) {Q} \<Longrightarrow> \<turnstile> {P} CHANGE x ST b {Q}"
  by (rule Submission.complete)

lemma MINUS_correct:
  "\<turnstile> {\<lambda>s. s=s\<^sub>0} MINUS {\<lambda>s. s ''y'' = - s ''x'' \<and> (\<forall>v \<noteq> ''y''. s v = s\<^sub>0 v)}"
  by (rule Submission.MINUS_correct)

end


(*  Title:      ZF/ex/LList.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1994  University of Cambridge

Codatatype definition of Lazy Lists.

Equality for llist(A) as a greatest fixed point

Functions for Lazy Lists

STILL NEEDS:
co_recursion for defining lconst, flip, etc.
a typing rule for it, based on some notion of "productivity..."
*)

theory LList imports ZF begin

consts
  llist  :: "i\<Rightarrow>i"

codatatype
  "llist(A)" = LNil | LCons ("a \<in> A", "l \<in> llist(A)")

(*Coinductive definition of equality*)
consts
  lleq :: "i\<Rightarrow>i"

(*Previously used <*> in the domain and variant pairs as elements.  But
  standard pairs work just as well.  To use variant pairs, must change prefix
  a q/Q to the Sigma, Pair and converse rules.*)
coinductive
  domains "lleq(A)" \<subseteq> "llist(A) * llist(A)"
  intros
    LNil:  "\<langle>LNil, LNil\<rangle> \<in> lleq(A)"
    LCons: "\<lbrakk>a \<in> A; <l,l'> \<in> lleq(A)\<rbrakk>
            \<Longrightarrow> <LCons(a,l), LCons(a,l')> \<in> lleq(A)"
  type_intros  llist.intros

(*Lazy list functions; flip is not definitional!*)
definition
  lconst   :: "i \<Rightarrow> i"  where
  "lconst(a) \<equiv> lfp(univ(a), \<lambda>l. LCons(a,l))"

axiomatization flip :: "i \<Rightarrow> i"
where
  flip_LNil:   "flip(LNil) = LNil" and
  flip_LCons:  "\<lbrakk>x \<in> bool; l \<in> llist(bool)\<rbrakk>
                \<Longrightarrow> flip(LCons(x,l)) = LCons(not(x), flip(l))"

(*These commands cause classical reasoning to regard the subset relation
  as primitive, not reducing it to membership*)

declare subsetI [rule del]
        subsetCE [rule del]

declare subset_refl [intro!]
        cons_subsetI [intro!]
        subset_consI [intro!]
        Union_least [intro!]
        UN_least [intro!]
        Un_least [intro!]
        Inter_greatest [intro!]
        Int_greatest [intro!]
        RepFun_subset [intro!]
        Un_upper1 [intro!]
        Un_upper2 [intro!]
        Int_lower1 [intro!]
        Int_lower2 [intro!]

(*An elimination rule, for type-checking*)
inductive_cases LConsE: "LCons(a,l) \<in> llist(A)"

(*Proving freeness results*)
lemma LCons_iff: "LCons(a,l)=LCons(a',l') \<longleftrightarrow> a=a' \<and> l=l'"
by auto

lemma LNil_LCons_iff: "\<not> LNil=LCons(a,l)"
by auto

(*
lemma llist_unfold: "llist(A) = {0} <+> (A <*> llist(A))";
let open llist  val rew = rewrite_rule con_defs in
by (fast_tac (claset() addSIs (subsetI ::map rew intros) addEs [rew elim]) 1)
end
done
*)

(*** Lemmas to justify using "llist" in other recursive type definitions ***)

lemma llist_mono: "A \<subseteq> B \<Longrightarrow> llist(A) \<subseteq> llist(B)"
  unfolding llist.defs
apply (rule gfp_mono)
apply (rule llist.bnd_mono)
apply (assumption | rule quniv_mono basic_monos)+
done

(** Closure of quniv(A) under llist -- why so complex?  Its a gfp... **)

declare QPair_Int_Vset_subset_UN [THEN subset_trans, intro!]
        QPair_subset_univ [intro!]
        empty_subsetI [intro!]
        one_in_quniv [THEN qunivD, intro!]
declare qunivD [dest!]
declare Ord_in_Ord [elim!]

lemma llist_quniv_lemma:
     "Ord(i) \<Longrightarrow> l \<in> llist(quniv(A)) \<Longrightarrow> l \<inter> Vset(i) \<subseteq> univ(eclose(A))"
proof (induct i arbitrary: l rule: trans_induct)
  case (step i l)
  show ?case using \<open>l \<in> llist(quniv(A))\<close>
  proof (cases l rule: llist.cases)
    case LNil thus ?thesis
      by (simp add: QInl_def QInr_def llist.con_defs)
  next
    case (LCons a l) thus ?thesis using step.hyps
    proof (simp add: QInl_def QInr_def llist.con_defs)
      show "<1; <a; l>> \<inter> Vset(i) \<subseteq> univ(eclose(A))" using LCons \<open>Ord(i)\<close>
        by (fast intro: step Ord_trans Int_lower1 [THEN subset_trans])
    qed
  qed
qed

lemma llist_quniv: "llist(quniv(A)) \<subseteq> quniv(A)"
apply (rule qunivI [THEN subsetI])
apply (rule Int_Vset_subset)
apply (assumption | rule llist_quniv_lemma)+
done

lemmas llist_subset_quniv =
       subset_trans [OF llist_mono llist_quniv]

(*** Lazy List Equality: lleq ***)

declare QPair_Int_Vset_subset_UN [THEN subset_trans, intro!]
        QPair_mono [intro!]

declare Ord_in_Ord [elim!]

(*Lemma for proving finality.  Unfold the lazy list; use induction hypothesis*)
lemma lleq_Int_Vset_subset:
     "Ord(i) \<Longrightarrow> <l,l'> \<in> lleq(A) \<Longrightarrow> l \<inter> Vset(i) \<subseteq> l'"
proof (induct i arbitrary: l l' rule: trans_induct)
  case (step i l l')
  show ?case using \<open>\<langle>l, l'\<rangle> \<in> lleq(A)\<close>
  proof (cases rule: lleq.cases)
    case LNil thus ?thesis
      by (auto simp add: QInr_def llist.con_defs)
  next
    case (LCons a l l') thus ?thesis using step.hyps
      by (auto simp add: QInr_def llist.con_defs intro: Ord_trans)
  qed
qed

(*lleq(A) is a symmetric relation because qconverse(lleq(A)) is a fixedpoint*)
lemma lleq_symmetric: "<l,l'> \<in> lleq(A) \<Longrightarrow> <l',l> \<in> lleq(A)"
apply (erule lleq.coinduct [OF converseI])
apply (rule lleq.dom_subset [THEN converse_type], safe)
apply (erule lleq.cases, blast+)
done

lemma lleq_implies_equal: "<l,l'> \<in> lleq(A) \<Longrightarrow> l=l'"
apply (rule equalityI)
apply (assumption | rule lleq_Int_Vset_subset [THEN Int_Vset_subset] |
       erule lleq_symmetric)+
done

lemma equal_llist_implies_leq:
     "\<lbrakk>l=l';  l \<in> llist(A)\<rbrakk> \<Longrightarrow> <l,l'> \<in> lleq(A)"
apply (rule_tac X = "{\<langle>l,l\<rangle>. l \<in> llist (A) }" in lleq.coinduct)
apply blast
apply safe
apply (erule_tac a=la in llist.cases, fast+)
done

(*** Lazy List Functions ***)

(*Examples of coinduction for type-checking and to prove llist equations*)

(*** lconst -- defined directly using lfp, but equivalent to a LList_corec ***)

lemma lconst_fun_bnd_mono: "bnd_mono(univ(a), \<lambda>l. LCons(a,l))"
  unfolding llist.con_defs
apply (rule bnd_monoI)
apply (blast intro: A_subset_univ QInr_subset_univ)
apply (blast intro: subset_refl QInr_mono QPair_mono)
done

(* lconst(a) = LCons(a,lconst(a)) *)
lemmas lconst = def_lfp_unfold [OF lconst_def lconst_fun_bnd_mono]
lemmas lconst_subset = lconst_def [THEN def_lfp_subset]
lemmas member_subset_Union_eclose = arg_into_eclose [THEN Union_upper]

lemma lconst_in_quniv: "a \<in> A \<Longrightarrow> lconst(a) \<in> quniv(A)"
apply (rule lconst_subset [THEN subset_trans, THEN qunivI])
apply (erule arg_into_eclose [THEN eclose_subset, THEN univ_mono])
done

lemma lconst_type: "a \<in> A \<Longrightarrow> lconst(a): llist(A)"
apply (rule singletonI [THEN llist.coinduct])
apply (erule lconst_in_quniv [THEN singleton_subsetI])
apply (fast intro!: lconst)
done

(*** flip --- equations merely assumed; certain consequences proved ***)

declare flip_LNil [simp]
        flip_LCons [simp]
        not_type [simp]

lemma bool_Int_subset_univ: "b \<in> bool \<Longrightarrow> b \<inter> X \<subseteq> univ(eclose(A))"
by (fast intro: Int_lower1 [THEN subset_trans] elim!: boolE)

declare not_type [intro!]
declare bool_Int_subset_univ [intro]

(*Reasoning borrowed from lleq.ML; a similar proof works for all
  "productive" functions -- cf Coquand's "Infinite Objects in Type Theory".*)
lemma flip_llist_quniv_lemma:
     "Ord(i) \<Longrightarrow> l \<in> llist(bool) \<Longrightarrow> flip(l) \<inter> Vset(i) \<subseteq> univ(eclose(bool))"
proof (induct i arbitrary: l rule: trans_induct)
  case (step i l)
  show ?case using \<open>l \<in> llist(bool)\<close>
  proof (cases l rule: llist.cases)
    case LNil thus ?thesis
      by (simp, simp add: QInl_def QInr_def llist.con_defs)
  next
    case (LCons a l) thus ?thesis using step.hyps
    proof (simp, simp add: QInl_def QInr_def llist.con_defs)
      show "<1; <not(a); flip(l)>> \<inter> Vset(i) \<subseteq> univ(eclose(bool))" using LCons step.hyps
        by (auto intro: Ord_trans)
    qed
  qed
qed

lemma flip_in_quniv: "l \<in> llist(bool) \<Longrightarrow> flip(l) \<in> quniv(bool)"
by (rule flip_llist_quniv_lemma [THEN Int_Vset_subset, THEN qunivI], assumption+)

lemma flip_type: "l \<in> llist(bool) \<Longrightarrow> flip(l): llist(bool)"
apply (rule_tac X = "{flip (l) . l \<in> llist (bool) }" in llist.coinduct)
apply blast
apply (fast intro!: flip_in_quniv)
apply (erule RepFunE)
apply (erule_tac a=la in llist.cases, auto)
done

lemma flip_flip: "l \<in> llist(bool) \<Longrightarrow> flip(flip(l)) = l"
apply (rule_tac X1 = "{<flip (flip (l)),l> . l \<in> llist (bool) }" in
       lleq.coinduct [THEN lleq_implies_equal])
apply blast
apply (fast intro!: flip_type)
apply (erule RepFunE)
apply (erule_tac a=la in llist.cases)
apply (simp_all add: flip_type not_not)
done

end


(* Author: Johannes Hölzl <hoelzl@in.tum.de> *)

section {* Stopping times *}

theory Stopping_Time
  imports "../Analysis/Analysis"
begin

subsection \<open>Stopping Time\<close>

text \<open>This is also called strong stopping time. Then stopping time is T with alternative is
  \<open>T x < t\<close> measurable.\<close>

definition stopping_time :: "('t::linorder \<Rightarrow> 'a measure) \<Rightarrow> ('a \<Rightarrow> 't) \<Rightarrow> bool"
where
  "stopping_time F T = (\<forall>t. Measurable.pred (F t) (\<lambda>x. T x \<le> t))"

lemma stopping_time_cong: "(\<And>t x. x \<in> space (F t) \<Longrightarrow> T x = S x) \<Longrightarrow> stopping_time F T = stopping_time F S"
  unfolding stopping_time_def by (intro arg_cong[where f=All] ext measurable_cong) simp

lemma stopping_timeD: "stopping_time F T \<Longrightarrow> Measurable.pred (F t) (\<lambda>x. T x \<le> t)"
  by (auto simp: stopping_time_def)

lemma stopping_timeD2: "stopping_time F T \<Longrightarrow> Measurable.pred (F t) (\<lambda>x. t < T x)"
  unfolding not_le[symmetric] by (auto intro: stopping_timeD Measurable.pred_intros_logic)

lemma stopping_timeI[intro?]: "(\<And>t. Measurable.pred (F t) (\<lambda>x. T x \<le> t)) \<Longrightarrow> stopping_time F T"
  by (auto simp: stopping_time_def)

lemma measurable_stopping_time:
  fixes T :: "'a \<Rightarrow> 't::{linorder_topology, second_countable_topology}"
  assumes T: "stopping_time F T"
    and M: "\<And>t. sets (F t) \<subseteq> sets M" "\<And>t. space (F t) = space M"
  shows "T \<in> M \<rightarrow>\<^sub>M borel"
proof (rule borel_measurableI_le)
  show "{x \<in> space M. T x \<le> t} \<in> sets M" for t
    using stopping_timeD[OF T] M by (auto simp: Measurable.pred_def)
qed

lemma stopping_time_const: "stopping_time F (\<lambda>x. c)"
  by (auto simp: stopping_time_def)

lemma stopping_time_min:
  "stopping_time F T \<Longrightarrow> stopping_time F S \<Longrightarrow> stopping_time F (\<lambda>x. min (T x) (S x))"
  by (auto simp: stopping_time_def min_le_iff_disj intro!: pred_intros_logic)

lemma stopping_time_max:
  "stopping_time F T \<Longrightarrow> stopping_time F S \<Longrightarrow> stopping_time F (\<lambda>x. max (T x) (S x))"
  by (auto simp: stopping_time_def intro!: pred_intros_logic)

section \<open>Filtration\<close>

locale filtration =
  fixes \<Omega> :: "'a set" and F :: "'t::{linorder_topology, second_countable_topology} \<Rightarrow> 'a measure"
  assumes space_F: "\<And>i. space (F i) = \<Omega>"
  assumes sets_F_mono: "\<And>i j. i \<le> j \<Longrightarrow> sets (F i) \<le> sets (F j)"
begin

subsection \<open>$\sigma$-algebra of a Stopping Time\<close>

definition pre_sigma :: "('a \<Rightarrow> 't) \<Rightarrow> 'a measure"
where
  "pre_sigma T = sigma \<Omega> {A. \<forall>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)}"

lemma space_pre_sigma: "space (pre_sigma T) = \<Omega>"
  unfolding pre_sigma_def using sets.space_closed[of "F _"]
  by (intro space_measure_of) (auto simp: space_F)

lemma measure_pre_sigma[simp]: "emeasure (pre_sigma T) = (\<lambda>_. 0)"
  by (simp add: pre_sigma_def emeasure_sigma)

lemma sigma_algebra_pre_sigma:
  assumes T: "stopping_time F T"
  shows "sigma_algebra \<Omega> {A. \<forall>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)}"
  unfolding sigma_algebra_iff2
proof (intro sigma_algebra_iff2[THEN iffD2] conjI ballI allI impI CollectI)
  show "{A. \<forall>t. {\<omega> \<in> A. T \<omega> \<le> t} \<in> sets (F t)} \<subseteq> Pow \<Omega>"
    using sets.space_closed[of "F _"] by (auto simp: space_F)
next
  fix A t assume "A \<in> {A. \<forall>t. {\<omega> \<in> A. T \<omega> \<le> t} \<in> sets (F t)}"
  then have "{\<omega> \<in> space (F t). T \<omega> \<le> t} - {\<omega> \<in> A. T \<omega> \<le> t} \<in> sets (F t)"
    using T stopping_timeD[measurable] by auto
  also have "{\<omega> \<in> space (F t). T \<omega> \<le> t} - {\<omega> \<in> A. T \<omega> \<le> t} = {\<omega> \<in> \<Omega> - A. T \<omega> \<le> t}"
    by (auto simp: space_F)
  finally show "{\<omega> \<in> \<Omega> - A. T \<omega> \<le> t} \<in> sets (F t)" .
next
  fix AA :: "nat \<Rightarrow> 'a set" and t assume "range AA \<subseteq> {A. \<forall>t. {\<omega> \<in> A. T \<omega> \<le> t} \<in> sets (F t)}"
  then have "(\<Union>i. {\<omega> \<in> AA i. T \<omega> \<le> t}) \<in> sets (F t)" for t
    by auto
  also have "(\<Union>i. {\<omega> \<in> AA i. T \<omega> \<le> t}) = {\<omega> \<in> UNION UNIV AA. T \<omega> \<le> t}"
    by auto
  finally show "{\<omega> \<in> UNION UNIV AA. T \<omega> \<le> t} \<in> sets (F t)" .
qed auto

lemma sets_pre_sigma: "stopping_time F T \<Longrightarrow> sets (pre_sigma T) = {A. \<forall>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)}"
  unfolding pre_sigma_def by (rule sigma_algebra.sets_measure_of_eq[OF sigma_algebra_pre_sigma])

lemma sets_pre_sigmaI: "stopping_time F T \<Longrightarrow> (\<And>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)) \<Longrightarrow> A \<in> sets (pre_sigma T)"
  unfolding sets_pre_sigma by auto

lemma pred_pre_sigmaI:
  assumes T: "stopping_time F T"
  shows "(\<And>t. Measurable.pred (F t) (\<lambda>\<omega>. P \<omega> \<and> T \<omega> \<le> t)) \<Longrightarrow> Measurable.pred (pre_sigma T) P"
  unfolding pred_def space_F space_pre_sigma by (intro sets_pre_sigmaI[OF T]) simp

lemma sets_pre_sigmaD: "stopping_time F T \<Longrightarrow> A \<in> sets (pre_sigma T) \<Longrightarrow> {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)"
  unfolding sets_pre_sigma by auto

lemma stopping_time_le_const: "stopping_time F T \<Longrightarrow> s \<le> t \<Longrightarrow> Measurable.pred (F t) (\<lambda>\<omega>. T \<omega> \<le> s)"
  using stopping_timeD[of F T] sets_F_mono[of _ t] by (auto simp: pred_def space_F)

lemma measurable_stopping_time_pre_sigma:
  assumes T: "stopping_time F T" shows "T \<in> pre_sigma T \<rightarrow>\<^sub>M borel"
proof (intro borel_measurableI_le sets_pre_sigmaI[OF T])
  fix t t'
  have "{\<omega>\<in>space (F (min t' t)). T \<omega> \<le> min t' t} \<in> sets (F (min t' t))"
    using T unfolding pred_def[symmetric] by (rule stopping_timeD)
  also have "\<dots> \<subseteq> sets (F t)"
    by (rule sets_F_mono) simp
  finally show "{\<omega> \<in> {x \<in> space (pre_sigma T). T x \<le> t'}. T \<omega> \<le> t} \<in> sets (F t)"
    by (simp add: space_pre_sigma space_F)
qed

lemma mono_pre_sigma:
  assumes T: "stopping_time F T" and S: "stopping_time F S"
    and le: "\<And>\<omega>. \<omega> \<in> \<Omega> \<Longrightarrow> T \<omega> \<le> S \<omega>"
  shows "sets (pre_sigma T) \<subseteq> sets (pre_sigma S)"
  unfolding sets_pre_sigma[OF S] sets_pre_sigma[OF T]
proof safe
  interpret sigma_algebra \<Omega> "{A. \<forall>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)}"
    using T by (rule sigma_algebra_pre_sigma)
  fix A t assume A: "\<forall>t. {\<omega>\<in>A. T \<omega> \<le> t} \<in> sets (F t)"
  then have "A \<subseteq> \<Omega>"
    using sets_into_space by auto
  from A have "{\<omega>\<in>A. T \<omega> \<le> t} \<inter> {\<omega>\<in>space (F t). S \<omega> \<le> t} \<in> sets (F t)"
    using stopping_timeD[OF S] by (auto simp: pred_def)
  also have "{\<omega>\<in>A. T \<omega> \<le> t} \<inter> {\<omega>\<in>space (F t). S \<omega> \<le> t} = {\<omega>\<in>A. S \<omega> \<le> t}"
    using \<open>A \<subseteq> \<Omega>\<close> sets_into_space[of A] le by (auto simp: space_F intro: order_trans)
  finally show "{\<omega>\<in>A. S \<omega> \<le> t} \<in> sets (F t)"
    by auto
qed

lemma stopping_time_less_const:
  assumes T: "stopping_time F T" shows "Measurable.pred (F t) (\<lambda>\<omega>. T \<omega> < t)"
proof -
  guess D :: "'t set" by (rule countable_dense_setE)
  note D = this
  show ?thesis
  proof cases
    assume *: "\<forall>t'<t. \<exists>t''. t' < t'' \<and> t'' < t"
    { fix t' assume "t' < t"
      with * have "{t' <..< t} \<noteq> {}"
        by fastforce
      with D(2)[OF _ this]
      have "\<exists>d\<in>D. t'< d \<and> d < t"
        by auto }
    note ** = this

    show ?thesis
    proof (rule measurable_cong[THEN iffD2])
      show "T \<omega> < t \<longleftrightarrow> (\<exists>r\<in>{r\<in>D. r < t}. T \<omega> \<le> r)" for \<omega>
        by (auto dest: ** intro: less_imp_le)
      show "Measurable.pred (F t) (\<lambda>w. \<exists>r\<in>{r \<in> D. r < t}. T w \<le> r)"
        by (intro measurable_pred_countable stopping_time_le_const[OF T] countable_Collect D) auto
    qed
  next
    assume "\<not> (\<forall>t'<t. \<exists>t''. t' < t'' \<and> t'' < t)"
    then obtain t' where t': "t' < t" "\<And>t''. t'' < t \<Longrightarrow> t'' \<le> t'"
      by (auto simp: not_less[symmetric])
    show ?thesis
    proof (rule measurable_cong[THEN iffD2])
      show "T \<omega> < t \<longleftrightarrow> T \<omega> \<le> t'" for \<omega>
        using t' by auto
      show "Measurable.pred (F t) (\<lambda>w. T w \<le> t')"
        using \<open>t'<t\<close> by (intro stopping_time_le_const[OF T]) auto
    qed
  qed
qed

lemma stopping_time_eq_const: "stopping_time F T \<Longrightarrow> Measurable.pred (F t) (\<lambda>\<omega>. T \<omega> = t)"
  unfolding eq_iff using stopping_time_less_const[of T t]
  by (intro pred_intros_logic stopping_time_le_const) (auto simp: not_less[symmetric] )

lemma stopping_time_less:
  assumes T: "stopping_time F T" and S: "stopping_time F S"
  shows "Measurable.pred (pre_sigma T) (\<lambda>\<omega>. T \<omega> < S \<omega>)"
proof (rule pred_pre_sigmaI[OF T])
  fix t
  obtain D :: "'t set"
    where [simp]: "countable D" and semidense_D: "\<And>x y. x < y \<Longrightarrow> (\<exists>b\<in>D. x \<le> b \<and> b < y)"
    using countable_separating_set_linorder2 by auto
  show "Measurable.pred (F t) (\<lambda>\<omega>. T \<omega> < S \<omega> \<and> T \<omega> \<le> t)"
  proof (rule measurable_cong[THEN iffD2])
    let ?f = "\<lambda>\<omega>. if T \<omega> = t then \<not> S \<omega> \<le> t else \<exists>s\<in>{s\<in>D. s \<le> t}. T \<omega> \<le> s \<and> \<not> (S \<omega> \<le> s)"
    { fix \<omega> assume "T \<omega> \<le> t" "T \<omega> \<noteq> t" "T \<omega> < S \<omega>"
      then have "T \<omega> < min t (S \<omega>)"
        by auto
      then obtain r where "r \<in> D" "T \<omega> \<le> r" "r < min t (S \<omega>)"
        by (metis semidense_D)
      then have "\<exists>s\<in>{s\<in>D. s \<le> t}. T \<omega> \<le> s \<and> s < S \<omega>"
        by auto }
    then show "(T \<omega> < S \<omega> \<and> T \<omega> \<le> t) = ?f \<omega>" for \<omega>
      by (auto simp: not_le)
    show "Measurable.pred (F t) ?f"
      by (intro pred_intros_logic measurable_If measurable_pred_countable countable_Collect
                stopping_time_le_const predE stopping_time_eq_const T S)
         auto
  qed
qed

end

lemma stopping_time_SUP_enat:
  fixes T :: "nat \<Rightarrow> ('a \<Rightarrow> enat)"
  shows "(\<And>i. stopping_time F (T i)) \<Longrightarrow> stopping_time F (SUP i. T i)"
  unfolding stopping_time_def SUP_apply SUP_le_iff by (auto intro!: pred_intros_countable)

lemma less_eSuc_iff: "a < eSuc b \<longleftrightarrow> (a \<le> b \<and> a \<noteq> \<infinity>)"
  by (cases a) auto

lemma stopping_time_Inf_enat:
  fixes F :: "enat \<Rightarrow> 'a measure"
  assumes F: "filtration \<Omega> F"
  assumes P: "\<And>i. Measurable.pred (F i) (P i)"
  shows "stopping_time F (\<lambda>\<omega>. Inf {i. P i \<omega>})"
proof (rule stopping_timeI, cases)
  fix t :: enat assume "t = \<infinity>" then show "Measurable.pred (F t) (\<lambda>\<omega>. Inf {i. P i \<omega>} \<le> t)"
    by auto
next
  fix t :: enat assume "t \<noteq> \<infinity>"
  moreover
  { fix i \<omega> assume "Inf {i. P i \<omega>} \<le> t"
    with \<open>t \<noteq> \<infinity>\<close> have "(\<exists>i\<le>t. P i \<omega>)"
      unfolding Inf_le_iff by (cases t) (auto elim!: allE[of _ "eSuc t"] simp: less_eSuc_iff) }
  ultimately have *: "\<And>\<omega>. Inf {i. P i \<omega>} \<le> t \<longleftrightarrow> (\<exists>i\<in>{..t}. P i \<omega>)"
    by (auto intro!: Inf_lower2)
  show "Measurable.pred (F t) (\<lambda>\<omega>. Inf {i. P i \<omega>} \<le> t)"
    unfolding * using filtration.sets_F_mono[OF F, of _ t] P
    by (intro pred_intros_countable_bounded) (auto simp: pred_def filtration.space_F[OF F])
qed

lemma stopping_time_Inf_nat:
  fixes F :: "nat \<Rightarrow> 'a measure"
  assumes F: "filtration \<Omega> F"
  assumes P: "\<And>i. Measurable.pred (F i) (P i)" and wf: "\<And>i \<omega>. \<omega> \<in> \<Omega> \<Longrightarrow> \<exists>n. P n \<omega>"
  shows "stopping_time F (\<lambda>\<omega>. Inf {i. P i \<omega>})"
  unfolding stopping_time_def
proof (intro allI, subst measurable_cong)
  fix t \<omega> assume "\<omega> \<in> space (F t)"
  then have "\<omega> \<in> \<Omega>"
    using filtration.space_F[OF F] by auto
  from wf[OF this] have "((LEAST n. P n \<omega>) \<le> t) = (\<exists>i\<le>t. P i \<omega>)"
    by (rule LeastI2_wellorder_ex) auto
  then show "(Inf {i. P i \<omega>} \<le> t) = (\<exists>i\<in>{..t}. P i \<omega>)"
    by (simp add: Inf_nat_def Bex_def)
next
  fix t from P show "Measurable.pred (F t) (\<lambda>w. \<exists>i\<in>{..t}. P i w)"
    using filtration.sets_F_mono[OF F, of _ t]
    by (intro pred_intros_countable_bounded) (auto simp: pred_def filtration.space_F[OF F])
qed

end