Require Import Relations.
Require Import mathcomp.ssreflect.ssreflect.
Set Implicit Arguments.
Import Prenex Implicits.
Require Import mathcomp.ssreflect.ssreflect.
Set Implicit Arguments.
Import Prenex Implicits.
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 cAG (p : X -> Prop) (w : X) : Prop :=
| AGs : p w -> (forall v, e w v -> cAG p v) -> cAG p w.
The coinductive definiton of AG is equivalent to the standard
defintion using reflexive transitive closure.
Fact cAG_crt p w :
cAG p w <-> forall v, clos_refl_trans e w v -> p v.
Inductive cEF (p : X -> Prop) (w : X) : Prop :=
| EF0 : p w -> cEF p w
| EFs v : e w v -> cEF p v -> cEF p w.
Lemma cAG_cEF (p : X -> Prop) (w : X) :
cEF (PredC p) w -> ~ cAG p w.
Strengthening Lemmas
Lemma AG_strengthen (p1 p2 : X -> Prop) w :
(forall v, p1 v -> p2 v) -> cAG p1 w -> cAG p2 w.
Lemma EF_strengthen (p1 p2 : X -> Prop) w :
(forall v, p1 v -> p2 v) -> cEF p1 w -> cEF p2 w.
End Characterizations.
Definition var := nat.
Inductive form :=
| fF
| fV of var
| fImp of form & form
| fAX of form
| fAG of 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]
| fAG s => Node 3 [:: pickle s]
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 ] => obind (fun s => Some (fAG s)) (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 transition systems (ts): The inductive
satisfaction relation eval is defined on this class
- finite models (fmodel): models where the type of states is finite and
everything else is decidable
- classical models, i.e., models where eval is logically decidable (cmodel): 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 ts := TS {
state :> Type;
trans : state -> state -> Prop;
label : var -> state -> Prop
}.
Record fmodel := FModel {
fstate :> finType;
ftrans : rel fstate;
flabel : var -> pred fstate
}.
Make ts inferable for states of fmodels
Canonical ts_of_fmodel (M : fmodel) : ts := TS (@ftrans M) (@flabel M).
Coercion ts_of_fmodel : fmodel >-> ts.
Fixpoint eval (M:ts) (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)
| fAG s => cAG trans (eval M s)
end.
Record cmodel := CModel { sts_of :> ts; modelP : ldec (@eval sts_of) }.
Coercion ts_of_fmodel : fmodel >-> ts.
Fixpoint eval (M:ts) (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)
| fAG s => cAG trans (eval M s)
end.
Record cmodel := CModel { sts_of :> ts; modelP : ldec (@eval sts_of) }.
Section Hilbert.
Inductive prv : form -> Prop :=
| rMP s t : prv (s ---> t) -> prv s -> prv t
| axK s t : prv (s ---> t ---> s)
| axS s t u : prv ((u ---> s ---> t) ---> (u ---> s) ---> u ---> t)
| axDN s : prv (((s ---> fF) ---> fF) ---> s)
| rNec s : prv s -> prv (fAX s)
| axN s t : prv (fAX (s ---> t) ---> fAX s ---> fAX t)
| axAGEl s : prv (fAG s ---> s)
| axAGEr s : prv (fAG s ---> fAX (fAG s))
| rAG_ind u s : prv (u ---> fAX u) -> prv (u ---> s) -> prv (u --->fAG s)
.
The hilbert system for K* can be seen as the composition of
Hilbert systems for minimal logic (M), classical propositional logic
(P), basic modal logic (K) and the rules and axioms specific to K*
Canonical Structure prv_mSystem := MSystem rMP axK axS.
Canonical Structure prv_pSystem := PSystem axDN.
Canonical Structure prv_kSystem := KSystem rNec axN.
Canonical Structure prv_ksSystem := KSSystem axAGEl axAGEr rAG_ind.
Definition valid s := forall (M:cmodel) (w:M), eval s w.
With excluded middle, every model is a classical model, and the
Hilbert system is sound for all models
Lemma xm_soundness (xm : forall P, P \/ ~ P) s :
prv s -> forall (M : ts) (w : M), eval s w.
End Hilbert.
Module S.
Section Seg.
Inductive prv : form -> Prop :=
| rMP s t : prv (s ---> t) -> prv s -> prv t
| axK s t : prv (s ---> t ---> s)
| axS s t u : prv ((u ---> s ---> t) ---> (u ---> s) ---> u ---> t)
| axDN s : prv (((s ---> fF) ---> fF) ---> s)
| rNec s : prv s -> prv (fAX s)
| axN s t : prv (fAX (s ---> t) ---> fAX s ---> fAX t)
| axAGEl s : prv (fAG s ---> s)
| axAGEr s : prv (fAG s ---> fAX (fAG s))
| axSeg s : prv (fAG (s ---> fAX s) ---> s ---> fAG s)
| axNS s t : prv (fAG (s ---> t) ---> fAG s ---> fAG t)
| rNecS s : prv s -> prv (fAG s)
.
End Seg.
End S.
Ltac S_rule H :=
first [ eapply S.rMP; first eapply H | eapply S.rMP; first eapply S.rMP; first eapply H ].
Fact prv_Sprv s : prv s <-> S.prv s.
Soundness for Finite Models
Section DecidabilityAndAgreement.
Variables (T: finType) (e : rel T) (p : pred T).
Definition AG_fun (X : {set T}) := [set x | p x && [forall (y | e x y), y \in X]].
Lemma AR_mono : mono AG_fun.
Definition AGb w := w \in gfp AG_fun.
Lemma agP w : reflect (cAG e p w) (AGb w).
End DecidabilityAndAgreement.
Given decidability and correctness for AG, decidavility and
correctness of evalb 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]
| fAG s => AGb ftrans (evalb s)
end.
Lemma evalP (w:M) s : reflect (@eval M s w) (evalb s w).
Lemma fin_modelP : ldec (@eval M).
End FiniteModels.
Every finite decidable model is a clasical model. Therefore, the
Hilberst system is sound for finite decidable models.
Definition cmodel_of_fmodel (M : fmodel) := CModel (@fin_modelP M).
Coercion cmodel_of_fmodel : fmodel >-> cmodel.
Theorem finite_soundness s : prv s -> forall (M:fmodel) (w : M), eval s w.
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
| fAG s,true => supp L s true && ((fAX (fAG s),true) \in L)
| fAG s,false => supp L s false || ((fAX (fAG s),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).
Would like to use
Definition supp' L (s : sform) := let: (t,b) := s in supp L t b.
Notation "L |> t" := (supp' L t) (at level 30)
However, simplification then breaks the notation
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
| fAG s => (f_weight s).+1
| _ => 0
end.
Lemma sweight_lit s : f_weight s.1 = 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.
Canonical Structure form_slpType := @SLPType prv_pSystem form_slClass.
Want suppC on singletons to expose the concrete support operation, not the
abstract one
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.
Fixpoint ssub' b s :=
(s,b) |` match s with
| fImp s t => ssub' (negb b) s `|` ssub' b t
| fAX t => ssub' b t
| fAG s => (fAX (fAG s),b) |` ssub' b s
| _ => fset0
end.
Lemma ssub'_refl s b : (s,b) \in ssub' b s.
Definition ssub (s : sform) := let (t,b) := s in (ssub' b t).
Lemma ssub_refl s : s \in ssub s.
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
| (fAG s, b) => [&& (fAX (fAG s),b) \in F & (s,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 sf_ssub F s : sf_closed F -> s \in F -> ssub s `<=` F.
Lemma sfc_ssub s : sf_closed (ssub s).
Lemma sfcU (X Y : {fset sform}) : sf_closed X -> sf_closed Y -> sf_closed (X `|` Y).
Definition sfc C : clause := \bigcup_(s in C) ssub s.
Lemma sfc_bigcup (T : choiceType) (C : {fset T}) F :
(forall s, sf_closed (F s)) -> sf_closed (\bigcup_(s in C) F 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.
Lemma satA (M:cmodel) (w:M) (C:clause) :
(forall s, s \in C -> eval (interp s) w) <-> eval [af C] w.
Lemma box_request (C : clause) : prv ([af C] ---> AX [af R C]).
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
| fAG s => (f_size s).+1
end.
Require Import Omega.
Lemma size_ssub (s : form) (b : bool) : size (ssub (s,b)) <= 2 * f_size s.