Theory LTL3

theory LTL3
  imports Main Traces AnswerIndexedFamilies LinearTemporalLogic
begin

chapter ‹LTL3: Semantics, Equivalence and Formula Progression›

type_synonym 'a AiF3 = answer  'a state dset

primrec and_AiF3 :: 'a AiF3  'a AiF3  'a AiF3 (infixl 3· 60) where
  (a 3· b) T = a T  b T
| (a 3· b) F = a F  b F

primrec or_AiF3 :: 'a AiF3  'a AiF3  'a AiF3 (infixl 3· 59) where
  (a 3· b) T = a T  b T
| (a 3· b) F = a F  b F

fun not_AiF3 :: 'a AiF3  'a AiF3 (¬3· _›) where
  (¬3· a) T = a F
| (¬3· a) F = a T

fun univ_AiF3 :: 'a AiF3 (T3) where
  T3 T = Σ∞
| T3 F = 

fun lsatisfying_AiF3 :: 'a  'a AiF3 (lsat3) where
  lsat3 x T = compr (λt. t  ε  x  L (thead t))
| lsat3 x F = compr (λt. t  ε  x  L (thead t))

fun x3_operator :: 'a AiF3  'a AiF3 (X3·) where
  X3· t T = prepend (t T)
| X3· t F = prepend (t F)

fun iterate :: ('a  'a)  nat  ('a  'a) where
iterate f 0 x = x|
iterate f (Suc n) x = f (iterate f n x)

primrec u3_operator :: 'a AiF3  'a AiF3  'a AiF3 (infix U3· 61) where
  (a U3· b) T =  ( range (λi. iterate (λx. prepend x  a T) i (b T) ))
| (a U3· b) F =  ( range (λi. iterate (λx. prepend x  a F) i (b F) ))

fun triv_true :: 'a  bool where
triv_true x = (s. x L s)

fun triv_false :: 'a  bool where
triv_false x = (s. x L s)

fun nontrivial :: 'a  bool where
nontrivial x = ((s. x L s)  (t. x L t))

fun zero_length :: 'a trace  bool where
  zero_length (Finite t) = (length t = 0)
| zero_length (Infinite t) = False

fun ltl_semantics3 :: 'a ltl  'a AiF3 (_3) where
   truel    3 = T3
|  notl φ   3 = ¬3· φ3
|  propl(a) 3 = lsat3 a
|  φ orl ψ  3 = φ3 3· ψ3
|  φ andl ψ 3 = φ3 3· ψ3
|  Xl φ     3 = X3· φ3
|  φ Ul ψ   3 = φ3 U3· ψ3

section ‹LTL/LTL3 equivalence›

declare dset.Inf_insert[simp del]
declare dset.Sup_insert[simp del]

lemma itdrop_all_split:
  assumes x  A and i<k. itdrop (Suc i) x  A
  shows i < Suc k  itdrop i x  A
using assms proof (cases i)
qed (auto simp: itdrop_def)

lemma itdrop_exists_split[simp]:
  shows (i<Suc k. itdrop i x  A)  (i < k. itdrop (Suc i) x  A)  x  A
proof (rule iffI)
{ fix i
  assume i < Suc k itdrop i x  A x  A
  then have i<k. itdrop (Suc i) x  A
  proof (cases i)
  qed auto
} then show i<Suc k. itdrop i x  A  (i<k. itdrop (Suc i) x  A)  x  A by auto
next
  assume (i<k. itdrop (Suc i) x  A)  x  A
  then show i<Suc k. itdrop i x  A
    by auto
qed

lemma until_iterate : 
  {x. k. (i<k. itdrop i x  A)  itdrop k x  B} =  (range (λk. iterate (λx. iprepend x  A) k B))
proof (rule set_eqI; rule iffI)
  fix x 
{ fix k
  assume  i<k. itdrop i x  A and itdrop k x  B
  then have x  iterate (λx. iprepend x  A) k B
  proof (induct k arbitrary: x)
    case 0
    then show ?case by simp
  next
    case (Suc k)
    from this(2,3) show ?case 
      by (auto intro!: Suc.hyps[where x = itdrop 1 x, simplified])
  qed }
  then show x  {x. k. (i<k. itdrop i x  A)  itdrop k x  B}
            x  (k. iterate (λx. iprepend x  A) k B)
    by blast
next
  fix x 
{ fix k
  assume x  iterate (λx. iprepend x  A) k B
  then have (i<k. itdrop i x  A)  itdrop k x  B
  proof (induct k arbitrary: x)
    case 0
    then show ?case by auto
  next
    case (Suc k)
    from this(2) show ?case
      by (auto dest: Suc.hyps[where x = itdrop 1 x, simplified] 
               intro: itdrop_all_split)
  qed }
  then show x  (k. iterate (λx. iprepend x  A) k B)  x  {x. k. (i<k. itdrop i x  A)  itdrop k x  B}
    by blast
qed

lemma release_iterate:
  {u. k. (i<k. itdrop i u  A)  itdrop k u  B} =  (range (λi. iterate (λx. iprepend x  A) i B))
proof (rule set_eqI; rule iffI)
  fix x 
{ fix i assume k. (i<k. itdrop i x  A)  itdrop k x  B
  then have x  iterate (λx. iprepend x  A) i B
  proof (induct i arbitrary: x)
    case 0
    then show ?case by auto
  next
    case (Suc i)
    show ?case
      apply (clarsimp)
      apply (rule Suc.hyps[where x = itdrop 1 x, simplified])
      using Suc(2)[THEN spec, where x = Suc _,simplified]
      by auto
  qed }
  then show x  {u. k. (i<k. itdrop i u  A)  itdrop k u  B}  x  (i. iterate (λx. iprepend x  A) i B)
    by auto
next
  fix x
{ fix k
  assume i. x  iterate (λx. iprepend x  A) i B
  then have P: i. x  iterate (λx. iprepend x  A) i B 
    by blast
  assume itdrop k x  B with P have i<k. itdrop i x  A
  proof (induct k arbitrary: x)
    case 0
    then show ?case by (simp, metis iterate.simps(1))
  next
    case (Suc k)
    from this(3) show ?case
      apply clarsimp
      apply (rule Suc.hyps[where x = itdrop 1 x, simplified])
      using Suc(2)[THEN spec, where x = Suc _]
      by auto
  qed }
  then show x  (i. iterate (λx. iprepend x  A) i B)  x  {u. k. (i<k. itdrop i u  A)  itdrop k u  B}
    by auto
qed

lemma property_until_iterate: 
  property (iterate (λx. prepend x  A) k B) = iterate (λx. iprepend x  property A) k (property B)
  by (induct k, auto simp: property_Inter property_prepend)

lemma property_release_iterate: 
  property (iterate (λx. prepend x  A) k B) = iterate (λx. iprepend x  property A) k (property B)
  by (induct k, auto simp: property_Union property_prepend)

lemma ltl3_equiv_ltl: 
  shows property ( φ 3 T) =  φ l T
  and   property ( φ 3 F) =  φ l F
proof (induct φ)
  case True_ltl
  {
    case 1
    then show ?case by (simp, transfer, simp)
  next
    case 2
    then show ?case by (simp, transfer, simp)
  }
next
  case (Not_ltl φ)
  {
    case 1
    then show ?case using Not_ltl by simp
  next
    case 2
    then show ?case using Not_ltl by simp
  }
next
  case (Prop_ltl x)
  {
    case 1
    then show ?case
      apply simp
      apply transfer
      apply (simp add: infinites_dprefixes)
      apply (clarsimp simp add: infinites_def  split: trace.split_asm trace.split)
      apply (rule set_eqI, rule iffI)
       apply (clarsimp  split: trace.split_asm trace.split)
       apply (metis zero_length.cases)
       apply (clarsimp split: trace.split_asm trace.split)
      by (metis Traces.append.simps(3) append_is_empty(2) trace.distinct(1) trace.inject(2))
  next
    case 2
    then show ?case
      apply simp
      apply transfer
      apply (simp add: infinites_dprefixes)
      apply (clarsimp simp add: infinites_def  split: trace.split_asm trace.split)
      apply (rule set_eqI, rule iffI)
       apply (clarsimp  split: trace.split_asm trace.split)
       apply (metis zero_length.cases)
       apply (clarsimp split: trace.split_asm trace.split)
      by (metis Traces.append.simps(3) append_is_empty(2) trace.distinct(1) trace.inject(2))
  }
next
  case (Or_ltl φ1 φ2)
  {
    case 1
    then show ?case by (simp add: property_Union Or_ltl)
  next
    case 2
    then show ?case by (simp add: property_Inter Or_ltl)
  }
next
  case (And_ltl φ1 φ2)
  {
    case 1
    then show ?case by (simp add: property_Inter And_ltl)
  next
    case 2
    then show ?case by (simp add: property_Union And_ltl)
  }
next
  case (Next_ltl φ)
  {
    case 1
    then show ?case by (simp add: property_prepend Next_ltl iprepend_def)
    next
    case 2
    then show ?case by (simp add: property_prepend Next_ltl iprepend_def)
  }
next
  case (Until_ltl φ1 φ2)
  {
    case 1
    then show ?case
      apply (simp add: Until_ltl[THEN sym] property_Union image_Collect property_until_iterate)
      using until_iterate[simplified] by blast 
  next
    case 2
    then show ?case 
      apply (simp add: Until_ltl[THEN sym] property_Inter image_Collect property_release_iterate)
      using release_iterate[simplified] by metis
  }
qed

section ‹Equivalence to LTL3 of Bauer et al.›

lemma extension_lemma: in_dset t A = (ω. t  Infinite ω  Infinite ` property A)
proof transfer
  fix t and A :: 'a trace set
  assume D: definitive A 
  show t  A = (ω. t  Infinite ω  Infinite ` infinites A)
  proof (rule iffI)
    assume t  A
    with D have D':  t  A by (rule definitive_contains_extensions)
    { fix ω have t  Infinite ω  A
        by (rule subsetD[OF D'], force simp add: extensions_def)
    } then have ω. t  Infinite ω   A by auto
    thus  ω. t  Infinite ω  Infinite ` infinites A
      by (simp add: infinites_append_right infinites_alt)
  next
    assume ω. t  Infinite ω  Infinite ` infinites A then
    have inA: ω. t  Infinite ω  A
      by (simp add: infinites_alt infinites_append_right)
    have  t  s A 
    proof -
      { fix u 
        obtain ω :: 'a infinite_trace where Infinite ω = u  Infinite undefined
          by (cases u; simp)
        then have v. (t  u)  v  A 
          using inA[THEN spec, where x = ω] by (metis trace.assoc)
      } thus ?thesis unfolding extensions_def prefix_closure_def prefixes_def by auto
    qed
    with D show t  A by (rule definitive_elemI)
  qed
qed

lemma extension: 
  shows in_dset t (ltl_semantics3 φ T) = (ω. (t  Infinite ω)  Infinite ` (ltl_semantics φ T))
  and   in_dset t (ltl_semantics3 φ F) = (ω. (t  Infinite ω)  Infinite ` (ltl_semantics φ F))
  by (simp_all add: ltl3_equiv_ltl[THEN sym] extension_lemma)

section ‹Formula Progression›

fun progress :: 'a ltl  'a state  'a ltl where
  progress truel σ = truel
| progress (notl φ) σ = notl (progress φ) σ
| progress (propl(a)) σ = (if a  L σ then truel else notl truel)
| progress (φ orl ψ) σ = (progress φ σ) orl (progress ψ σ)
| progress (φ andl ψ) σ = (progress φ σ) andl (progress ψ σ)
| progress (Xl φ) σ = φ
| progress (φ Ul ψ) σ = (progress ψ σ) orl ((progress φ σ) andl (φ Ul ψ))

lemma unroll_Union:  (range P) = P 0  ( (range (P  Suc)))
  apply (rule definitives_inverse_eqI)
  apply (simp add: property_Union)
  apply (rule dset.order_antisym)
   apply (clarsimp intro!: definitives_mono; metis not0_implies_Suc)
  by (force intro: definitives_mono)

lemma unroll_Inter:  (range P) = P 0  ( (range (P  Suc)))
  apply (rule definitives_inverse_eqI)
  apply (simp add: property_Inter)
  apply (rule dset.order_antisym)
   apply (force intro: definitives_mono)
  by (clarsimp intro!: definitives_mono; metis not0_implies_Suc)

lemma iterates_nonempty: range (λi. iterate f i X)  {}
  by blast

lemma until_cont: A  {}  prepend ( A)  X =  ((λx. prepend x  X) ` A)
  by (simp add: prepend_Union[THEN sym] dset.SUP_inf)

lemma release_cont: A  {}  prepend ( A)  X =  ((λx. prepend x  X) ` A)
  by (simp add: prepend_Inter[THEN sym] dset.INF_sup)

lemma iterate_unroll_Inter: 
  assumes A. A  {}  f ( A) =  (f ` A) 
  shows  (range (λi. iterate f i X)) = X  f ( (range (λi. iterate f i X )))
  apply (subst unroll_Inter)
  by (force simp: assms[OF iterates_nonempty] property_Inter intro: definitives_inverse_eqI)

lemma iterate_unroll_Union: 
  assumes A. A  {}  f ( A) =  (f ` A) 
  shows  (range (λi. iterate f i X)) = X  f ( (range (λi. iterate f i X )))
  apply (subst unroll_Union)
  by (force simp: assms[OF iterates_nonempty] property_Union intro: definitives_inverse_eqI)


lemma inf_inf: x  (y  z) = (x  y)  (x  z)
  by (simp add: dset.inf_assoc dset.inf_left_commute)



theorem progression_tf :
  prepend (progress φ σ 3 T)  compr (λt. t  ε  thead t = σ)   φ 3 T
  prepend (progress φ σ 3 F)  compr (λt. t  ε  thead t = σ)   φ 3 F
proof (induct φ)
  case True_ltl
  {
    case 1
    then show ?case by simp
  next
    case 2
    then show ?case by (simp, transfer, simp add: prepend'_def)
  }
next
  case (Not_ltl φ)
  {
    case 1
    then show ?case using Not_ltl by simp
  next
    case 2
    then show ?case using Not_ltl by simp
  }
next
  case (Prop_ltl x)
  {
    case 1
    then show ?case
      by (simp, transfer, auto simp: prepend'_def intro: dprefixes_mono[THEN subsetD, rotated])
  next
    case 2
    then show ?case 
      by (simp, transfer, auto simp: prepend'_def intro: dprefixes_mono[THEN subsetD, rotated])
  }
next
  case (Or_ltl φ1 φ2)
  {
    case 1
    then show ?case
      apply (simp add: prepend_Union[THEN sym])
      using Or_ltl(1, 3)
      by (metis (no_types, lifting) dset.inf_sup_distrib2 dset.sup_mono)
  next
    case 2
    then show ?case
      apply (simp add: prepend_Inter[THEN sym])
      using Or_ltl(2,4)
      by (meson dset.dual_order.refl dset.dual_order.trans dset.inf.coboundedI2
                dset.inf_le1 dset.inf_mono)
  }
next
  case (And_ltl φ1 φ2)
  {
    case 1
    then show ?case
      apply (simp add: prepend_Inter[THEN sym])
      using And_ltl(1,3)
      by (meson dset.dual_order.trans dset.inf_le1 dset.inf_le2 dset.le_infI)
  next
    case 2
    then show ?case
      apply (simp add: prepend_Union[THEN sym])
      using And_ltl(2, 4)
      by (metis (no_types, lifting) dset.inf_sup_distrib2 dset.sup_mono)
  }
next
  case (Next_ltl φ)
  {
    case 1
    then show ?case by simp
  next
    case 2
    then show ?case by simp
  }
next
  case (Until_ltl φ1 φ2)
  {
    case 1
    then show ?case (* TODO tidy*)
      apply (simp only: progress.simps)
      apply (simp add: prepend_Union[THEN sym] prepend_Inter[THEN sym])
       apply (subst dset.inf_commute)
      apply (subst dset.distrib(3))
      apply (rule dset.order_trans)
       apply (rule dset.sup_mono[OF _ dset.order_refl])
      apply (subst dset.inf_commute)
       apply (rule Until_ltl(3))
      apply (subst dset.inf_assoc[THEN sym])
      apply (rule dset.order_trans)
       apply (rule dset.sup_mono[OF dset.order_refl])
       apply (rule dset.inf_mono[OF _ dset.order_refl])
       apply (subst dset.inf_commute)
       apply (rule Until_ltl(1))
      apply (subst iterate_unroll_Union[OF until_cont], simp)
      by (simp add: dset.inf.commute prepend_Union)
  next
    case 2
    then show ?case
      apply simp
      apply (subst prepend_Inter[THEN sym] prepend_Union[THEN sym], simp)
      apply (subst dset.inf_commute)
      apply (subst inf_inf)
      apply (rule dset.order_trans)
       apply (rule dset.inf_mono)
        apply (subst dset.inf_commute)
        apply (rule Until_ltl(4))
      apply (simp add: prepend_Union[THEN sym])
      apply (subst dset.distrib(3))
       apply (rule dset.sup_mono)
      apply (subst dset.inf_commute)
        apply (rule Until_ltl(2))
       apply (rule dset.le_infI2, rule dset.order_refl)
      apply (subst iterate_unroll_Inter[OF release_cont,simplified]; simp) 
      by (metis dset.inf_le2 dset.sup.commute)
  }
qed

theorem progression_tf' :
   φ 3 T  compr (λt. t  ε  thead t = σ)  prepend (progress φ σ 3 T)
   φ 3 F  compr (λt. t  ε  thead t = σ)  prepend (progress φ σ 3 F)
proof (induct φ)
  case True_ltl
  {
    case 1
    then show ?case by (simp, transfer, simp add: prepend'_def)
  next
    case 2
    then show ?case by simp
  }
next
  case (Not_ltl φ)
  {
    case 1
    then show ?case using Not_ltl by simp
  next
    case 2
    then show ?case using Not_ltl by simp
  }
next
  case (Prop_ltl x)
  {
    case 1
    then show ?case apply simp
      apply transfer
      apply clarsimp
      apply (clarsimp simp: prepend'_def)
      apply (subst compr'_inter_thead)
      by (metis (mono_tags, lifting) Collect_empty_eq dprefixes_empty)
  next
    case 2
    then show ?case 
      apply simp
      apply transfer
      apply (clarsimp simp: prepend'_def)
      apply (subst compr'_inter_thead)
      by (metis (mono_tags, lifting) Collect_empty_eq dprefixes_empty)
  }
next
  case (Or_ltl φ1 φ2)
  {
    case 1
    then show ?case
      apply (simp add: prepend_Union[THEN sym])
      using Or_ltl(1,3)
      by (metis (no_types, lifting) dset.inf_sup_distrib2 dset.sup_mono)
  next
    case 2
    then show ?case
      apply (simp add: prepend_Inter[THEN sym])
      using Or_ltl(2,4)
      by (meson dset.dual_order.refl dset.dual_order.trans dset.inf.coboundedI2 dset.inf_le1 dset.inf_mono)
  }
next
  case (And_ltl φ1 φ2)
  {
    case 1
    then show ?case 
      apply (simp add: prepend_Inter[THEN sym])
      using And_ltl(1,3)
      by (meson dset.dual_order.refl dset.dual_order.trans dset.le_inf_iff)
  next
    case 2
    then show ?case 
      apply (simp add: prepend_Union[THEN sym])
      using And_ltl(2,4)
      by (metis (no_types,lifting) dset.inf_sup_distrib2 dset.sup_mono)
  }
next
  case (Next_ltl φ)
  {
    case 1
    then show ?case using Next_ltl by simp
  next
    case 2
    then show ?case using Next_ltl by simp
  }
next
  case (Until_ltl φ1 φ2)
  {
    case 1
    then show ?case
    unfolding ltl_semantics3.simps u3_operator.simps
              ltl_semantics.simps progress.simps u_operator.simps or_AiF3.simps and_AiF3.simps
      apply (simp add: full_SetCompr_eq prepend_Union[THEN sym])
      apply (rule dset.order_trans[rotated])
       apply (rule dset.sup_mono [OF _ dset.order_refl], rule Until_ltl(3))
      apply (simp add: prepend_Inter[THEN sym])
      apply (rule dset.order_trans[rotated])
       apply (rule dset.sup_mono [OF dset.order_refl])
       apply (rule dset.inf_mono [OF _ dset.order_refl])
     apply (rule Until_ltl(1))
    apply (subst iterate_unroll_Union[OF until_cont], simp)
    apply (subst dset.inf_commute)
    apply (subst dset.inf_sup_distrib1)
    apply (simp, rule conjI)
     apply (subst dset.inf_commute)
     apply auto[1]
    by (meson dset.eq_refl dset.inf.boundedI dset.le_infE dset.le_supI2)
  next
    case 2
    then show ?case
    unfolding ltl_semantics3.simps u3_operator.simps
              ltl_semantics.simps progress.simps u_operator.simps or_AiF3.simps and_AiF3.simps
      apply (simp add: full_SetCompr_eq prepend_Inter[THEN sym])
      apply (rule conjI,rule dset.order_trans[rotated])
        apply (rule Until_ltl(4))
       apply (rule dset.inf_mono; simp?)
       apply (metis iterate.simps(1) dset.Inf_lower rangeI)
      apply (simp add: prepend_Union[THEN sym])
      apply (rule dset.order_trans[rotated])
       apply (rule dset.sup_mono)
        apply (rule Until_ltl(2))
     apply (rule dset.order_refl)
    apply (subst iterate_unroll_Inter[OF release_cont], simp)
    apply (simp add: prepend_Inter[THEN sym] image_image)
    apply (subst dset.inf_assoc)
    apply (subst dset.sup_inf_distrib2)
    apply (rule dset.le_infI2)
    by (simp add: dset.inf.coboundedI1 insert_commute)
  }
qed

theorem progression_tf'_u:
  shows  φ 3 A  compr (λt. t  ε  thead t = σ)  prepend (progress φ σ 3 A)
  by (cases A; simp add: progression_tf')

theorem progression_tf_u:
  shows prepend (progress φ σ 3 A)  compr (λt. t  ε  thead t = σ)   φ 3 A
  by (cases A; simp add: progression_tf)

lemma fp_compr_helper: in_dset (Finite (a # t)) (compr (λ x. x  ε  thead x = a))
  apply transfer
  apply (simp add: dprefixes_def subset_iff extensions_def prefix_closure_def prefixes_def)
  by (metis ε_def list.distinct(1) nth_Cons_0 thead.simps(1) thead_append trace.inject(1) 
            trace.left_neutral trace.right_neutral)


theorem fp:
shows in_dset (Finite t) ( φ 3 A)   foldl progress φ t 3 A = Σ∞
proof (induct t arbitrary: φ)
  case Nil
  then show ?case 
    by (rule iffI; simp add: in_dset_ε[simplified ε_def] in_dset_UNIV)
next
  case (Cons a t)
  show ?case
  proof (simp add: Cons[where φ=progress φ a, THEN sym], rule)
    assume in_dset (Finite (a # t)) (φ3 A)
    then show in_dset (Finite t) (progress φ a3 A)
      by (force intro: in_dset_prependD in_dset_subset[OF progression_tf'_u] 
                       in_dset_inter fp_compr_helper)
  next
    assume in_dset (Finite t) (progress φ a3 A)
    then show in_dset (Finite (a # t)) (φ3 A)
      by (force intro: in_dset_subset[OF progression_tf_u] in_dset_inter fp_compr_helper 
                       in_dset_prependI[where x = Finite u for u, simplified])
  qed
qed

lemma em_ltl:  φ l T = UNIV - ( φ l F)
  by (rule set_eqI; clarsimp simp add: subset_iff ltl_equivalence[THEN sym])

theorem em:
  shows  φ 3 T = complement ( φ 3 F)
  by (force intro: definitives_inverse_eqI simp: ltl3_equiv_ltl em_ltl)

end