CTL in Coq
Notation "P =p Q" := (forall x, P x <-> Q x) (at level 40).
Definition PredC X (p : X -> Prop) x := ~ p x.
Section Characterizations.
Variables (X : Type) (e : X -> X -> Prop).
Definition cEX (p : X -> Prop) (w : X) : Prop := exists2 v, e w v & p v.
Definition cAX (p : X -> Prop) (w : X) : Prop := forall v, e w v -> p v.
CoInductive cAR (p q : X -> Prop) (w : X) : Prop :=
| AR0 : p w -> q w -> cAR p q w
| ARs : q w -> (forall v, e w v -> cAR p q v) -> cAR p q w.
Inductive cAU (p q : X -> Prop) (w : X) : Prop :=
| AU0 : q w -> cAU p q w
| AUs : p w -> (forall v, e w v -> cAU p q v) -> cAU p q w.
CoInductive cER (p q : X -> Prop) (w : X) : Prop :=
| ER0 : p w -> q w -> cER p q w
| ERs v : q w -> e w v -> cER p q v -> cER p q w.
Inductive cEU (p q : X -> Prop) (w : X) : Prop :=
| EU0 : q w -> cEU p q w
| EUs v : p w -> e w v -> cEU p q v -> cEU p q w.
Lemma cAU_cER (p q : X -> Prop) (w : X) :
cER (PredC p) (PredC q) w -> ~ cAU p q w.
Lemma cAR_cEU (p q : X -> Prop) (w : X) :
cEU (PredC p) (PredC q) w -> ~ cAR p q w.
Lemma AU_strengthen (p1 q1 p2 q2 : X -> Prop) w :
(forall v, p1 v -> p2 v) -> (forall v, q1 v -> q2 v) ->
cAU p1 q1 w -> cAU p2 q2 w.
Lemma AR_strengthen (p1 q1 p2 q2 : X -> Prop) w :
(forall v, p1 v -> p2 v) -> (forall v, q1 v -> q2 v) ->
cAR p1 q1 w -> cAR p2 q2 w.
Lemma ER_strengthen (p1 q1 p2 q2 : X -> Prop) w :
(forall v, p1 v -> p2 v) -> (forall v, q1 v -> q2 v) ->
cER p1 q1 w -> cER p2 q2 w.
Lemma EU_strengthen (p1 q1 p2 q2 : X -> Prop) w :
(forall v, p1 v -> p2 v) -> (forall v, q1 v -> q2 v) ->
cEU p1 q1 w -> cEU p2 q2 w.
Lemma cAU_eq (x y : X) (p q : pred X) :
p x = p y -> q x = q y -> e x =p e y -> cAU p q x -> cAU p q y.
Lemma cEU_eq (x y : X) (p q : pred X) :
p x = p y -> q x = q y -> e x =p e y -> cEU p q x -> cEU p q y.
Implicit Type (pi : nat -> X).
Definition path pi := forall n, e (pi n) (pi n.+1).
Definition pcons x pi k := if k is k.+1 then pi k else x.
Definition ptail pi k := pi k.+1.
Lemma path_pcons x pi : e x (pi 0) -> path pi -> path (pcons x pi).
Lemma path_ptail pi : path pi -> path (ptail pi).
Definition p_until (p q : X -> Prop) pi :=
exists2 n, forall m, m < n -> p (pi m) & q (pi n).
Definition p_release (p q : X -> Prop) pi :=
forall n, (exists2 m, m < n & p (pi m)) \/ q (pi n).
Definition pAU (p q : X -> Prop) (w : X) : Prop :=
forall pi, path pi -> pi 0 = w -> p_until p q pi.
Definition pAR (p q : X -> Prop) (w : X) : Prop :=
forall pi, path pi -> pi 0 = w -> p_release p q pi.
Definition pEU (p q : X -> Prop) (w : X) : Prop :=
exists pi, [/\ path pi, pi 0 = w & p_until p q pi].
Definition pER (p q : X -> Prop) (w : X) : Prop :=
exists pi, [/\ path pi, pi 0 = w & p_release p q pi].
Lemma pAU_pER (p q : X -> Prop) (w : X) :
pER (PredC p) (PredC q) w -> ~ pAU p q w.
Lemma pAR_pEU (p q : X -> Prop) (w : X) :
pEU (PredC p) (PredC q) w -> ~ pAR p q w.
Lemma pAR_strengthen (p1 q1 p2 q2 : X -> Prop) w :
(forall v, p1 v -> p2 v) -> (forall v, q1 v -> q2 v) ->
pAR p1 q1 w -> pAR p2 q2 w.
Lemma pAU_strengthen (p1 q1 p2 q2 : X -> Prop) w :
(forall v, p1 v -> p2 v) -> (forall v, q1 v -> q2 v) ->
pAU p1 q1 w -> pAU p2 q2 w.
Lemma pER_strengthen (p1 q1 p2 q2 : X -> Prop) w :
(forall v, p1 v -> p2 v) -> (forall v, q1 v -> q2 v) ->
pER p1 q1 w -> pER p2 q2 w.
Lemma pEU_strengthen (p1 q1 p2 q2 : X -> Prop) w :
(forall v, p1 v -> p2 v) -> (forall v, q1 v -> q2 v) ->
pEU p1 q1 w -> pEU p2 q2 w.
End Characterizations.
Dependent Choice
Definition DC_ (X : Type) := forall R : X -> X -> Prop,
(forall x, exists y, R x y) -> forall x, exists2 f, f 0 = x & path R f.
Definition DC := forall X, DC_ X.
(forall x, exists y, R x y) -> forall x, exists2 f, f 0 = x & path R f.
Definition DC := forall X, DC_ X.
Definition var := nat.
Inductive form :=
| fF
| fV of var
| fImp of form & form
| fAX of form
| fAR of form & form
| fAU of form & form.
Lemma eq_form_dec (s t : form) : { s = t} + { s <> t}.
Definition form_eqMixin := EqMixin (compareP eq_form_dec).
Canonical Structure form_eqType := Eval hnf in @EqType form form_eqMixin.
To use formulas and other types built around formulas as base type
for the finite set libaray, we need to show that formulas are
countable. We do this by embedding formulas into the Ssreflect's
generic trees
Module formChoice.
Import GenTree.
Fixpoint pickle (s : form) :=
match s with
| fV v => Leaf v
| fF => Node 0 [::]
| fImp s t => Node 1 [:: pickle s ; pickle t]
| fAX s => Node 2 [:: pickle s]
| fAU s t => Node 3 [:: pickle s; pickle t]
| fAR s t => Node 4 [:: pickle s; pickle t]
end.
Fixpoint unpickle t :=
match t with
| Leaf v => Some (fV v)
| Node 0 [::] => Some (fF)
| Node 1 [:: t ; t' ] =>
obind (fun s => obind (fun s' => Some (fImp s s')) (unpickle t')) (unpickle t)
| Node 2 [:: t ] => obind (fun s => Some (fAX s)) (unpickle t)
| Node 3 [:: t ; t' ] =>
obind (fun s => obind (fun s' => Some (fAU s s')) (unpickle t')) (unpickle t)
| Node 4 [:: t ; t' ] =>
obind (fun s => obind (fun s' => Some (fAR s s')) (unpickle t')) (unpickle t)
| _ => None
end.
Lemma pickleP : pcancel pickle unpickle.
End formChoice.
Definition form_countMixin := PcanCountMixin formChoice.pickleP.
Definition form_choiceMixin := CountChoiceMixin form_countMixin.
Canonical Structure form_ChoiceType := Eval hnf in ChoiceType form form_choiceMixin.
Canonical Structure form_CountType := Eval hnf in CountType form form_countMixin.
Models
- raw models or or serial transition systems (sts): Both, the satisfaction
relation for the path semantics satisfies and the inductive satisfaction
relation eval are refined on this class
- finite models (fmodel): models where the type of states is finite and
everything else is decidable
- classical models (cmodel): models eval is logically decidable. This is the largest class of models for which we can show soundness of the hilbert system.
Definition stable X Y (R : X -> Y -> Prop) := forall x y, ~ ~ R x y -> R x y.
Definition ldec X Y (R : X -> Y -> Prop) := forall x y, R x y \/ ~ R x y.
Record sts := STS {
state :> Type;
trans : state -> state -> Prop;
label : var -> state -> Prop;
serial : forall w:state, exists v, trans w v
}.
Record fmodel := FModel {
fstate :> finType;
ftrans : rel fstate;
flabel : var -> pred fstate;
fser w : exists v, ftrans w v
}.
Canonical sts_of_fmodel (M : fmodel) : sts := STS (@flabel M) (@fser M).
Coercion sts_of_fmodel : fmodel >-> sts.
Fixpoint satisfies (M : sts) (s : form) :=
match s with
| fF => (fun _ => False)
| fV v => label v
| fImp s t => (fun w => satisfies M s w -> satisfies M t w)
| fAX s => cAX (@trans M) (satisfies M s)
| fAR s t => pAR trans (satisfies M s) (satisfies M t)
| fAU s t => pAU trans (satisfies M s) (satisfies M t)
end.
Fixpoint eval (M:sts) (s : form) :=
match s with
| fF => (fun _ => False)
| fV v => label v
| fImp s t => (fun w => eval M s w -> eval M t w)
| fAX s => cAX (@trans M) (eval M s)
| fAR s t => cAR trans (eval M s) (eval M t)
| fAU s t => cAU trans (eval M s) (eval M t)
end.
Record cmodel := CModel { sts_of :> sts; modelP : ldec (@eval sts_of) }.
Finite Models
Section Decidability.
Variables (T: finType) (e : rel T) (p q : pred T).
Definition AU_fun (X : {set T}) :=
[set x | q x] :|: [set x | p x && [forall (y | e x y), y \in X]].
Lemma AU_mono : mono AU_fun.
Definition AUb w := w \in lfp AU_fun.
Lemma auP w : reflect (cAU e p q w) (AUb w).
Definition AR_fun (X : {set T}) :=
[set x | p x && q x ] :|: [set x | q x && [forall (y | e x y), y \in X]].
Lemma AR_mono : mono AR_fun.
Definition ARb w := w \in gfp AR_fun.
Lemma arP w : reflect (cAR e p q w) (ARb w).
End Decidability.
Given decidability for AU and AR, decidability of eval follows using a
simple induction on formulas
Section FiniteModels.
Variables (M : fmodel).
Fixpoint evalb s : pred M :=
match s with
| fV p => flabel p
| fF => xpred0
| fImp s t => fun w => evalb s w ==> evalb t w
| fAX s => fun w => [forall (v | ftrans w v) , evalb s v]
| fAU s t => AUb ftrans (evalb s) (evalb t)
| fAR s t => ARb ftrans (evalb s) (evalb t)
end.
Lemma evalP (w:M) s : reflect (eval s w) (evalb s w).
Lemma fin_modelP : ldec (@eval M).
End FiniteModels.
Definition cmodel_of_fmodel (M : fmodel) := CModel (@fin_modelP M).
Coercion cmodel_of_fmodel : fmodel >-> cmodel.
Clauses and Support
Signed Formulas
Definition sform := (form * bool) %type.
Notation "s ^-" := (s,false) (at level 20, format "s ^-").
Notation "s ^+" := (s,true) (at level 20, format "s ^+").
Definition body s := match s with fAX t^+ => t^+ | fAX t^- => t^- | _ => s end.
Definition positive (s:sform) := if s is t^+ then true else false.
Definition positives C := [fset s.1 | s <- [fset t in C | positive t]].
Lemma posE C s : (s \in positives C) = (s^+ \in C).
Definition negative (s:sform) := ~~ positive s.
Definition negatives C := [fset s.1 | s <- [fset t in C | negative t]].
Lemma negE C s : (s \in negatives C) = (s^- \in C).
Definition isBox s := if s is fAX s^+ then true else false.
Inductive isBox_spec s : bool -> Type :=
| isBox_true t : s = fAX t^+ -> isBox_spec s true
| isBox_false : isBox_spec s false.
Lemma isBoxP s : isBox_spec s (isBox s).
Definition isDia s := if s is fAX s^- then true else false.
Inductive isDia_spec s : bool -> Type :=
| isDia_true t : s = fAX t^- -> isDia_spec s true
| isDia_false : isDia_spec s false.
Lemma isDiaP s : isDia_spec s (isDia s).
Definition clause := {fset sform}.
Definition lcons (L : clause) :=
(fF^+ \notin L) && [all s in L, if s is fV p^+ then fV p^- \notin L else true].
Fixpoint literal (s : sform) :=
let: (t,_) := s in
match t with
| fV _ => true
| fAX _ => true
| fF => true
| _ => false
end.
Fixpoint supp (L : clause) u b :=
match u,b with
| fImp s t,true => supp L s false || supp L t true
| fImp s t,false => supp L s true && supp L t false
| fAU s t,true => supp L t true
|| supp L s true && ((fAX (fAU s t),true) \in L)
| fAU s t,false => supp L t false
&& (supp L s false || ((fAX (fAU s t),false) \in L))
| fAR s t,true => supp L t true
&& (supp L s true || ((fAX (fAR s t),true) \in L))
| fAR s t,false => supp L t false
|| supp L s false && ((fAX (fAR s t), false) \in L)
| _,_ => (u,b) \in L
end.
Notation "C |> s ^ b" := (supp C s b) (at level 30, format "C |> s ^ b").
Notation "C |> s ^+" := (supp C s true) (at level 30, format "C |> s ^+").
Notation "C |> s ^-" := (supp C s false) (at level 30, format "C |> s ^-").
Notation "C |> s" := (supp C s.1 s.2) (at level 30).
For a locally consistent clause L, the collection of formulas
supported by L corresponds to an (infinite) Hintikka set.
Lemma supp_mon L1 L2 s : L1 `<=` L2 -> L1 |> s -> L2 |> s.
Fixpoint f_weight (s : form) :=
match s with
| fImp s t => (f_weight s + f_weight t).+1
| fAU s t => (f_weight s + f_weight t).+1
| fAR s t => (f_weight s + f_weight t).+1
| _ => 0
end.
Definition s_weight := [fun s : sform => f_weight (fst s)].
Lemma sweight_lit s : s_weight s = 0 <-> literal s.
Lemma supp_lit C s b : literal (s,b) -> supp C s b = ((s,b) \in C).
Definition form_slClass := SLClass supp_mon supp_lit sweight_lit.
Canonical Structure form_slType := SLType form_slClass.
Lemma suppC1 : (forall L s, suppC L [fset s] = L |> s)
* (forall L s b, suppC L [fset (s,b)] = supp L s b).
Lemma supp0F s : ~~ fset0 |> s.
Lemma suppE L s : L |> s -> L != fset0.
Definition R C := [fset body s | s <- [fset t in C | isBox t]].
Lemma RE C s : (s^+ \in R C) = (fAX s^+ \in C).
Lemma Rpos s C : s^- \notin R C.
Lemma RU (C C' : clause) : R (C `|` C') = (R C `|` R C').
Lemma R1 (s : sform) : R [fset s] = if s is fAX u^+ then [fset u^+] else fset0.
Lemma R0 : R fset0 = fset0.
Definition sf_closed' (F : {fset sform}) (s:sform) :=
match s with
| (fImp s t,b) => ((s,negb b) \in F) && ((t,b) \in F)
| (fAX s, b) => (s,b) \in F
| (fAU s t, b) => [&& (fAX (fAU s t),b) \in F, (s,b) \in F & (t,b) \in F]
| (fAR s t, b) => [&& (fAX (fAR s t),b) \in F, (s,b) \in F & (t,b) \in F]
| _ => true
end.
Definition sf_closed (F :{fset sform}) := forall s, s \in F -> sf_closed' F s.
Lemma sf_closed'_mon (X Y : clause) s : sf_closed' X s -> X `<=` Y -> sf_closed' Y s.
Lemma sfcU (X Y : {fset sform}) : sf_closed X -> sf_closed Y -> sf_closed (X `|` Y).
subformula closure of single formulas
Fixpoint ssub' b s :=
(s,b) |` match s with
| fImp s t => ssub' (negb b) s `|` ssub' b t
| fAX t => ssub' b t
| fAU s t => (fAX (fAU s t),b) |` (ssub' b s `|` ssub' b t)
| fAR s t => (fAX (fAR s t),b) |` (ssub' b s `|` ssub' b t)
| _ => fset0
end.
Definition ssub (s : sform) := let (t,b) := s in (ssub' b t).
Lemma ssub'_refl s b : (s,b) \in ssub' b s.
Lemma ssub_refl s : s \in ssub s.
Lemma sf_ssub F s : sf_closed F -> s \in F -> ssub s `<=` F.
Lemma sfc_ssub s : sf_closed (ssub s).
subformula closure for clauses
Definition sfc C : clause := \bigcup_(s in C) ssub s.
Lemma sfc_bigcup (T : choiceType) (C : {fset T}) S :
(forall s, sf_closed (S s)) -> sf_closed (\bigcup_(s in C) S s).
Lemma closed_sfc C : sf_closed (sfc C).
Lemma sub_sfc C : C `<=` (sfc C).
Lemma RinU (F : clause) : sf_closed F ->
forall C, C \in powerset F -> R C \in powerset F.
Fixpoint f_size (s : form) :=
match s with
| fF => 1
| fV p => 1
| fImp s t => (f_size s + f_size t).+1
| fAX s => (f_size s).+1
| fAU s t => (f_size s + f_size t).+1
| fAR s t => (f_size s + f_size t).+1
end.
Require Import Omega.
Lemma size_ssub (s : form) (b : bool) : size (ssub (s,b)) <= 2 * f_size s.