QRC1.Closure
From mathcomp Require Import all_ssreflect finmap.
Require Import Program.Wf.
From QRC1 Require Import Preamble Language.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Section Formulas.
Variable sig : signature.
Notation term := (term sig).
Notation formula := (formula sig).
Notation ConstName := (ConstName sig).
Notation PredName := (PredName sig).
Notation Var := (Var sig).
Local Open Scope qsp_scope.
Local Open Scope fset.
Definition consts : Type := {fset ConstName}.
Definition formulas : Type := {fset formula}.
Definition constantcountfs (fs : formulas) : nat :=
\max_(A <- fs) (constantcount A).
Definition quantifierdepthfs (fs : formulas) : nat :=
\max_(A <- fs) (quantifierdepth A).
Definition modaldepthfs (fs : formulas) : nat :=
\max_(A <- fs) (modaldepth A).
Definition depthfs (fs : formulas) : nat :=
\max_(A <- fs) (depth A).
Definition closedfs (fs : formulas) : bool :=
all (@closed _) fs.
Definition constantsfs (fs : formulas) : consts :=
\bigcup_(A <- fs) (constants A).
Lemma in_constantsfs (A : formula) (fs : formulas) :
A \in fs -> constants A `<=` constantsfs fs.
Proof. by move=> Ainfs; apply: bigfcup_sup. Qed.
Program Fixpoint closure (C : consts) (A : formula) {measure (depth A)}
: formulas :=
match A with
| T => [fset T _]
| Pred P ts => [fset T _; Pred ts]
| A1 /\ A2 => (A1 /\ A2) |` closure C A1 `|` closure C A2
| <> B => (<> B) |` closure C B
| All x B => (All x B) |` \bigcup_(c <- C) (closure C B`[Var x <- Const c])
end.
Next Obligation.
by apply/leP; rewrite /= ltnS leq_maxl.
Defined.
Next Obligation.
by apply/leP; rewrite /= ltnS leq_maxr.
Defined.
Next Obligation.
by apply/leP; rewrite depth_sub.
Defined.
(* This lemma relies on the Defined proof obligations *)
Lemma closure_eq (C : consts) (A : formula) : closure C A =
match A with
| T => [fset T _]
| Pred P ts => [fset T _; Pred ts]
| A1 /\ A2 => (A1 /\ A2) |` closure C A1 `|` closure C A2
| <> B => (<> B) |` closure C B
| All x B => (All x B) |` \bigcup_(c <- C) (closure C B`[Var x <- Const c])
end.
Proof.
rewrite {1}/closure {1}/closure_func fix_sub_eq -/closure_func.
by case: A.
case=> /= C' B; case: B => //=.
- by move=> A1 A2 f g eq1fg; rewrite !eq1fg.
- by move=> A1 f g ->.
- move=> x A1 f g eq1fg.
congr fsetU; apply/fsetP => /= A'.
apply/bigfcupP/bigfcupP.
move=> [c cinC'true] A'inf.
by exists c => //; rewrite -eq1fg.
move=> [c cinC'true] A'ing.
by exists c => //; rewrite eq1fg.
Qed.
Lemma closure_ind (C : consts) (P : formula -> formulas -> Prop) :
(P (T _) [fset T _]) ->
(forall Q ts, P (@Pred _ Q ts) [fset T _; Pred ts]) ->
(forall A B,
P A (closure C A) ->
P B (closure C B) ->
P (A /\ B) ((A /\ B) |` closure C A `|` closure C B)
) ->
(forall A,
P A (closure C A) ->
P (<> A) (<> A |` closure C A)
) ->
(forall x A,
(forall c, c \in C ->
P A`[Var x <- Const c] (closure C A`[Var x <- Const c])
) ->
P (All x A) ((All x A) |` \bigcup_(c <- C) (closure C A`[Var x <- Const c]))
) ->
forall A, P A (closure C A).
Proof.
move=> HT HP HConj HDiam HAll A.
move: (leqnn (depth A)); move: {2}(depth _) => maxdepth.
elim: maxdepth A.
case=> //=.
by move=> *; apply: HP.
move=> maxdepth IHdepth; case.
- by move=> _; apply: HT.
- by move=> *; apply: HP.
- move=> A B /=; rewrite ltnS geq_max closure_eq => /andP [leqAmax leqBmax].
by apply: HConj; apply: IHdepth.
- move=> A /=; rewrite ltnS closure_eq => leqAmax.
apply: HDiam.
by apply: IHdepth.
- move=> x A /=; rewrite ltnS closure_eq => leqAmax.
apply: HAll => c cinC.
apply: IHdepth.
by rewrite depth_sub.
Qed.
Lemma closure_self (C : consts) (A : formula) : A \in closure C A.
Proof. by case: A => *; rewrite closure_eq !inE eqxx. Qed.
Lemma closure_closed_T (C : consts) :
closedfs (closure C (T _)).
Proof.
by rewrite closure_eq; apply/allP => A; rewrite inE => /eqP ->.
Qed.
Lemma closure_closed_Pred (C : consts) (P : PredName)
(ts : (arity P).-tuple term) :
closed (Pred ts) -> closedfs (closure C (Pred ts)).
Proof.
move=> closedP; rewrite closure_eq.
by apply/allP => A; rewrite 3!inE => /orP [|] /eqP ->.
Qed.
Lemma closedfs1 (A : formula) :
closedfs [fset A] = closed A.
Proof.
rewrite /closedfs; apply/allP => /=; case: ifP.
by move=> clA B; rewrite inE => /eqP ->.
by move=> nclA /(_ A); rewrite nclA inE eqxx => /(_ isT).
Qed.
Lemma closedfs_fsetU (fs1 fs2 : formulas) :
closedfs (fs1 `|` fs2) = closedfs fs1 && closedfs fs2.
Proof. by rewrite /closedfs all_fsetU. Qed.
Lemma closure_closed (C : consts) (A : formula) :
closed A -> closedfs (closure C A).
Proof.
apply closure_ind => {A}.
- by rewrite closure_closed_T.
- by move=> P ts clP; apply: closure_closed_Pred.
- move=> A B IHA IHB /= /[dup] clAB.
rewrite 2!closedfs_fsetU closedE => /andP [/IHA -> /IHB ->].
by rewrite closedfs1 2!andbT.
- move=> A IHA /[dup] clDA.
rewrite closedE closedfs_fsetU => /IHA ->.
by rewrite closedfs1 andbT.
- move=> x A IHA clxA.
rewrite closedfs_fsetU => /=.
apply/andP; split; first by rewrite closedfs1.
apply/allP => /= B /bigfcupP [c /andP [cinC _] BinclAc].
move: clxA; rewrite (closed_All _ _ c) => /IHA -/(_ cinC).
by move=> /allP /(_ B) /(_ BinclAc).
Qed.
Definition closurefs (C : consts) (fs : formulas) : formulas :=
\bigcup_(A <- fs) (closure C A).
Lemma closurefs_self (C : consts) (A : formula) (fs : formulas) :
A \in fs -> A \in closurefs C fs.
Proof.
move=> Ainfs; apply/bigfcupP => /=.
exists A.
by rewrite Ainfs.
by rewrite closure_self.
Qed.
Lemma closurefs_closed (C : consts) (fs : formulas) :
closedfs fs -> closedfs (closurefs C fs).
Proof.
move=> /allP /= clfs.
apply/allP => /= A /bigfcupP /= [B /andP [Binfs _] AinclosureB].
move: (clfs _ Binfs) => /closure_closed => /(_ C) /allP /= clclosureB.
by apply: clclosureB.
Qed.
Lemma closure_sub (A : formula) (x : VarName) (c : ConstName)
(C : consts) :
closure C A`[Var x <- Const c] =
[fset D`[Var x <- Const c] | D in closure C A].
Proof.
move: (leqnn (depth A)); move: {2}(depth _) => maxdepth.
elim: maxdepth A x c.
case=> //= x c.
by rewrite closure_eq fsetmap1.
by move=> P ts _; rewrite 2!closure_eq fsetmap2.
move=> maxdepth IHdepth; case => /=.
- by move=> *; rewrite closure_eq fsetmap1.
- by move=> *; rewrite 2!closure_eq fsetmap2.
- move=> A B x c /=; rewrite ltnS geq_max => /andP [leqAmax leqBmax].
rewrite closure_eq [in RHS]closure_eq.
by rewrite 2!fsetmapU fsetmap1 IHdepth // IHdepth.
- move=> A x c; rewrite ltnS => leqAmax.
rewrite closure_eq [in RHS]closure_eq.
by rewrite fsetmapU fsetmap1 IHdepth.
- move=> y A x c; rewrite ltnS => leqAmax.
rewrite [in RHS]closure_eq.
rewrite fsetmapU fsetmap1 /=.
rewrite fsetmap_bigfcup.
case: eqP => [[->] | neqyx]; rewrite closure_eq; congr fsetU.
apply/fsetP => /= B; apply/bigfcupP/bigfcupP => /=.
move=> [c' c'inCT] BinclAc'.
exists c' => //.
rewrite -IHdepth ?depth_sub //.
by rewrite sub_notfree ?notfv_sub.
move=> [c' c'inCT].
rewrite -IHdepth ?depth_sub //.
rewrite sub_notfree ?notfv_sub // => BinclAc'.
by exists c'.
have neqxy : x <> y by move=> eqxy; move: neqyx; rewrite eqxy.
apply/fsetP => /= B; apply/bigfcupP/bigfcupP => /=.
move=> [c' c'inCT].
rewrite sub_ConstC // IHdepth ?depth_sub // => Bincl.
by exists c'.
move=> [c' c'inCT Bin]; exists c' => //.
by rewrite sub_ConstC // IHdepth ?depth_sub.
Qed.
Lemma constantcount_closure (C : consts) (A : formula) :
constantcount A <= constantcountfs (closure C A)
<= constantcount A + quantifierdepth A.
Proof.
apply/andP; split.
by apply: leq_bigmax_list; apply: closure_self.
apply/bigmax_leqP_list => /=.
elim: A.
- by rewrite closure_eq /= addn0 => B /fset1P ->.
- by move=> P ts; rewrite closure_eq /= addn0 => B /fset2P [-> | ->].
- move=> A IHA B IHB; rewrite closure_eq => D /fsetUP[/fsetUP [/fset1P ->|]|].
+ by rewrite leq_addr.
+ move=> DinclA.
rewrite (leq_trans (IHA _ DinclA)) //.
apply: leq_add; last by rewrite leq_maxl.
by rewrite constantcount_Conjl.
+ move=> DinclB.
rewrite (leq_trans (IHB _ DinclB)) //.
apply: leq_add; last by rewrite leq_maxr.
by rewrite constantcount_Conjr.
- move=> A IHA; rewrite closure_eq => B /fsetUP [/fset1P -> | BinclA].
by rewrite leq_addr.
by rewrite constantcount_Diam /= IHA.
- move=> y A IHA; rewrite closure_eq => B /fsetUP [/fset1P -> |].
by rewrite leq_addr.
move=> /bigfcupP [c /andP [cinC _]].
rewrite closure_sub => /imfsetP /= [B' B'inclA ->].
have /andP [_ leq_ccB'c] := constantcount_sub y c B'.
rewrite (leq_trans leq_ccB'c) // addnS ltnS.
by rewrite (leq_trans (IHA _ B'inclA)).
Qed.
Lemma constantcount_closurefs (C : consts) (fs : formulas) :
constantcountfs fs <= constantcountfs (closurefs C fs)
<= constantcountfs fs + quantifierdepthfs fs.
Proof.
rewrite /constantcountfs /quantifierdepthfs; apply/andP; split.
apply /bigmax_leqP_list => A Ainfs.
by apply: leq_bigmax_list; apply: closurefs_self.
apply/bigmax_leqP_list => /= A /bigfcupP /= [B /andP [Binfs _] AinclB].
have /andP [_] := constantcount_closure C B.
rewrite /constantcountfs => /bigmax_leqP_list /(_ A) /(_ AinclB) leqAB.
by rewrite (leq_trans leqAB) // leq_add //; apply: leq_bigmax_list.
Qed.
Lemma closureT (C : consts) (A : formula) :
(exists c, c \in C) ->
T sig \in closure C A.
Proof.
move=> [c cinC].
apply closure_ind => {A}.
- by rewrite inE.
- by move=> *; rewrite 2!inE.
- by move=> A B _ IHB; rewrite inE IHB orbT.
- by move=> A IHA; rewrite inE IHA orbT.
- move=> x A IHA; rewrite 2!inE /=.
apply/bigfcupP; exists c.
by rewrite cinC.
by apply: IHA.
Qed.
Lemma closureConjl (C : consts) (A B : formula) :
A \in closure C (A /\ B).
Proof. by rewrite closure_eq 2!inE closure_self orbT. Qed.
Lemma closureConjr (C : consts) (A B : formula) :
B \in closure C (A /\ B).
Proof. by rewrite closure_eq 2!inE closure_self orbT. Qed.
Lemma closureConj_in (C : consts) (A B D : formula) :
(A /\ B) \in closure C D -> A \in closure C D /\ B \in closure C D.
Proof.
apply closure_ind.
- by rewrite inE.
- by move=> P ts; rewrite 3!inE.
- move=> E F IHE IHF; rewrite 8!inE.
move=> /orP [| /IHF [-> ->]]; last by rewrite 2!orbT.
move=> /orP [/eqP [-> ->] | /IHE [-> ->]]; last by rewrite 2!orbT.
by rewrite 2!closure_self 2!orbT.
- by move=> E IHE; rewrite 5!inE => /= /IHE [-> ->]; rewrite 2!orbT.
- move=> x E IHE; rewrite 5!inE => /= /bigfcupP /= [c /andP [+ _]].
move=> /[dup] cinC /IHE /[apply] -[AinclEc BinclEc].
by split; apply/orP; right; apply/bigfcupP; exists c; rewrite ?cinC.
Qed.
Lemma closureConj_inl (C : consts) (A B D : formula) :
(A /\ B) \in closure C D -> A \in closure C D.
Proof. by move=> /closureConj_in []. Qed.
Lemma closureConj_inr (C : consts) (A B D : formula) :
(A /\ B) \in closure C D -> B \in closure C D.
Proof. by move=> /closureConj_in []. Qed.
Lemma closureDiam (C : consts) (A : formula) :
A \in closure C (<> A).
Proof. by rewrite closure_eq inE closure_self orbT. Qed.
Lemma substitution_closureAll (C : consts) (c : ConstName) (x : VarName)
(A : formula) :
c \in C -> A`[Var x <- Const c] \in closure C (All x A).
Proof.
move=> cinC; rewrite closure_eq.
apply/fset1UP; right.
apply/bigfcupP; exists c; first by rewrite cinC.
by apply: closure_self.
Qed.
Lemma closurefs_fsetU (C : consts) (fs1 fs2 : formulas) :
closurefs C (fs1 `|` fs2) = (closurefs C fs1) `|` (closurefs C fs2).
Proof.
rewrite /closurefs big_fsetU //=.
by move=> X; rewrite fsetUid.
Qed.
Lemma closure_idempotent (C : consts) (A : formula) :
closurefs C (closure C A) = closure C A.
Proof.
apply closure_ind => {A}.
- by rewrite /closurefs big_seq_fset1 closure_eq.
- move=> P ts.
apply/fsetP => /= A; apply/bigfcupP/fset2P => /=.
move=> [B]; rewrite 3!inE => /orP [/orP [/eqP -> | /eqP ->] | //].
by rewrite closure_eq inE => /eqP ->; left.
by rewrite closure_eq => /fset2P.
move=> [-> | ->].
exists (T sig).
by rewrite 2!inE eqxx.
by rewrite closure_eq inE.
exists (Pred ts).
by rewrite 3!inE eqxx orbT.
by rewrite closure_eq 3!inE eqxx orbT.
- move=> A B IHA IHB.
rewrite 2!closurefs_fsetU IHA IHB.
rewrite /closurefs big_seq_fset1 closure_eq.
by rewrite -fsetUA -[_ |` _ `|` _]fsetUA -fsetUA fsetUid.
- move=> A IHA.
rewrite closurefs_fsetU IHA.
rewrite /closurefs big_seq_fset1 closure_eq.
by rewrite -fsetUA fsetUid.
- move=> x A IHA.
rewrite closurefs_fsetU.
rewrite {1}/closurefs big_seq_fset1 closure_eq.
rewrite -fsetUA.
suff /fsetUidPl -> :
closurefs C (\bigcup_(c <- C) closure C A`[Var x <- Const c])
`<=` \bigcup_(c <- C) closure C A`[Var x <- Const c]
by [].
apply/bigfcupsP => /= B /bigfcupP [c /andP [cinC _] BinclAc _].
apply/fsubsetP => /= E EinclB.
apply/bigfcupP.
exists c; first by rewrite cinC.
rewrite -IHA //.
apply/bigfcupP => /=.
by exists B; first by rewrite BinclAc.
Qed.
Lemma closure_closure (C : consts) (A B : formula) :
A \in closure C B -> closure C A `<=` closure C B.
Proof.
move=> AinclB.
rewrite -[closure _ B]closure_idempotent.
by apply: bigfcup_sup.
Qed.
Lemma closure_closurefs (C : consts) (A : formula) (fs : formulas) :
A \in closurefs C fs -> closure C A `<=` closurefs C fs.
Proof.
move=> /bigfcupP /= [B /andP [Binfs _] AinclB].
apply: (fsubset_trans (closure_closure AinclB)).
by apply: bigfcup_sup.
Qed.
Lemma closurefsDiam (C : consts) (A : formula) (fs : formulas) :
<> A \in closurefs C fs -> A \in closurefs C fs.
Proof.
move=> /closure_closurefs /fsubsetP.
by apply; apply: closureDiam.
Qed.
Lemma substitution_closurefs (C : consts) (x : VarName) (A : formula)
(c : ConstName) (fs : formulas) :
c \in C ->
All x A \in closurefs C fs ->
A`[Var x <- Const c] \in closurefs C fs.
Proof.
move=> cinC xAinclfs.
have /fsubsetP := closure_closurefs xAinclfs.
by apply; apply: substitution_closureAll.
Qed.
Lemma constantsfs_closure (C : consts) (A : formula) :
constantsfs (closure C A) `<=` C `|` constants A.
Proof.
elim: A.
- rewrite closure_eq /= fsetU0.
by rewrite /constantsfs big_seq_fsetE /= big_fset1 /= fsub0set.
- move=> P ts; rewrite closure_eq.
rewrite /constantsfs big_fsetU1 /=; last by rewrite inE.
by rewrite fset0U big_seq_fsetE /= big_fset1 /= fsubsetUr.
- move=> A /bigfcupsP /= IHA B /bigfcupsP /= IHB; rewrite closure_eq.
apply/bigfcupsP => /= D.
rewrite 3!inE => /orP [/orP [/eqP -> /= | DinclA] | DinclB] _.
+ by rewrite fsubsetUr.
+ apply: (fsubset_trans (IHA _ DinclA isT)).
by rewrite fsetUA fsubsetUl.
+ apply: (fsubset_trans (IHB _ DinclB isT)).
by rewrite [constants _ `|` _]fsetUC fsetUA fsubsetUl.
- move=> A /bigfcupsP /= IHA; rewrite closure_eq.
apply/bigfcupsP => /= B.
rewrite 2!inE => /orP [/eqP -> /= | BinclA] _.
by rewrite fsubsetUr.
by apply: IHA.
- move=> x A /bigfcupsP /= IHA; rewrite closure_eq.
apply/bigfcupsP => /= B.
rewrite 2!inE => /orP [/eqP -> /= | /bigfcupP [c /andP [cinC _] Bincl]] _.
by rewrite fsubsetUr.
have [BinclA | BnotinclA] := boolP (B \in closure C A).
by apply: IHA.
move: Bincl; rewrite closure_sub => /imfsetP /= [B' B'inclA ->].
rewrite constants_sub_Const.
case: ifP => _; last by apply: IHA.
rewrite fsubUset IHA // andbT.
by apply: fsubsetU; rewrite fsub1set cinC.
Qed.
Lemma constantsfs_closurefs (C : consts) (fs : formulas) :
constantsfs (closurefs C fs) `<=` C `|` constantsfs fs.
Proof.
apply/bigfcupsP =>/=A /bigfcupP/=[B /andP[Binfs _] /in_constantsfs subAclB] _.
apply: (fsubset_trans subAclB).
apply: (fsubset_trans (constantsfs_closure _ _)).
by apply: fsetUS; apply: in_constantsfs.
Qed.
End Formulas.
Require Import Program.Wf.
From QRC1 Require Import Preamble Language.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Section Formulas.
Variable sig : signature.
Notation term := (term sig).
Notation formula := (formula sig).
Notation ConstName := (ConstName sig).
Notation PredName := (PredName sig).
Notation Var := (Var sig).
Local Open Scope qsp_scope.
Local Open Scope fset.
Definition consts : Type := {fset ConstName}.
Definition formulas : Type := {fset formula}.
Definition constantcountfs (fs : formulas) : nat :=
\max_(A <- fs) (constantcount A).
Definition quantifierdepthfs (fs : formulas) : nat :=
\max_(A <- fs) (quantifierdepth A).
Definition modaldepthfs (fs : formulas) : nat :=
\max_(A <- fs) (modaldepth A).
Definition depthfs (fs : formulas) : nat :=
\max_(A <- fs) (depth A).
Definition closedfs (fs : formulas) : bool :=
all (@closed _) fs.
Definition constantsfs (fs : formulas) : consts :=
\bigcup_(A <- fs) (constants A).
Lemma in_constantsfs (A : formula) (fs : formulas) :
A \in fs -> constants A `<=` constantsfs fs.
Proof. by move=> Ainfs; apply: bigfcup_sup. Qed.
Program Fixpoint closure (C : consts) (A : formula) {measure (depth A)}
: formulas :=
match A with
| T => [fset T _]
| Pred P ts => [fset T _; Pred ts]
| A1 /\ A2 => (A1 /\ A2) |` closure C A1 `|` closure C A2
| <> B => (<> B) |` closure C B
| All x B => (All x B) |` \bigcup_(c <- C) (closure C B`[Var x <- Const c])
end.
Next Obligation.
by apply/leP; rewrite /= ltnS leq_maxl.
Defined.
Next Obligation.
by apply/leP; rewrite /= ltnS leq_maxr.
Defined.
Next Obligation.
by apply/leP; rewrite depth_sub.
Defined.
(* This lemma relies on the Defined proof obligations *)
Lemma closure_eq (C : consts) (A : formula) : closure C A =
match A with
| T => [fset T _]
| Pred P ts => [fset T _; Pred ts]
| A1 /\ A2 => (A1 /\ A2) |` closure C A1 `|` closure C A2
| <> B => (<> B) |` closure C B
| All x B => (All x B) |` \bigcup_(c <- C) (closure C B`[Var x <- Const c])
end.
Proof.
rewrite {1}/closure {1}/closure_func fix_sub_eq -/closure_func.
by case: A.
case=> /= C' B; case: B => //=.
- by move=> A1 A2 f g eq1fg; rewrite !eq1fg.
- by move=> A1 f g ->.
- move=> x A1 f g eq1fg.
congr fsetU; apply/fsetP => /= A'.
apply/bigfcupP/bigfcupP.
move=> [c cinC'true] A'inf.
by exists c => //; rewrite -eq1fg.
move=> [c cinC'true] A'ing.
by exists c => //; rewrite eq1fg.
Qed.
Lemma closure_ind (C : consts) (P : formula -> formulas -> Prop) :
(P (T _) [fset T _]) ->
(forall Q ts, P (@Pred _ Q ts) [fset T _; Pred ts]) ->
(forall A B,
P A (closure C A) ->
P B (closure C B) ->
P (A /\ B) ((A /\ B) |` closure C A `|` closure C B)
) ->
(forall A,
P A (closure C A) ->
P (<> A) (<> A |` closure C A)
) ->
(forall x A,
(forall c, c \in C ->
P A`[Var x <- Const c] (closure C A`[Var x <- Const c])
) ->
P (All x A) ((All x A) |` \bigcup_(c <- C) (closure C A`[Var x <- Const c]))
) ->
forall A, P A (closure C A).
Proof.
move=> HT HP HConj HDiam HAll A.
move: (leqnn (depth A)); move: {2}(depth _) => maxdepth.
elim: maxdepth A.
case=> //=.
by move=> *; apply: HP.
move=> maxdepth IHdepth; case.
- by move=> _; apply: HT.
- by move=> *; apply: HP.
- move=> A B /=; rewrite ltnS geq_max closure_eq => /andP [leqAmax leqBmax].
by apply: HConj; apply: IHdepth.
- move=> A /=; rewrite ltnS closure_eq => leqAmax.
apply: HDiam.
by apply: IHdepth.
- move=> x A /=; rewrite ltnS closure_eq => leqAmax.
apply: HAll => c cinC.
apply: IHdepth.
by rewrite depth_sub.
Qed.
Lemma closure_self (C : consts) (A : formula) : A \in closure C A.
Proof. by case: A => *; rewrite closure_eq !inE eqxx. Qed.
Lemma closure_closed_T (C : consts) :
closedfs (closure C (T _)).
Proof.
by rewrite closure_eq; apply/allP => A; rewrite inE => /eqP ->.
Qed.
Lemma closure_closed_Pred (C : consts) (P : PredName)
(ts : (arity P).-tuple term) :
closed (Pred ts) -> closedfs (closure C (Pred ts)).
Proof.
move=> closedP; rewrite closure_eq.
by apply/allP => A; rewrite 3!inE => /orP [|] /eqP ->.
Qed.
Lemma closedfs1 (A : formula) :
closedfs [fset A] = closed A.
Proof.
rewrite /closedfs; apply/allP => /=; case: ifP.
by move=> clA B; rewrite inE => /eqP ->.
by move=> nclA /(_ A); rewrite nclA inE eqxx => /(_ isT).
Qed.
Lemma closedfs_fsetU (fs1 fs2 : formulas) :
closedfs (fs1 `|` fs2) = closedfs fs1 && closedfs fs2.
Proof. by rewrite /closedfs all_fsetU. Qed.
Lemma closure_closed (C : consts) (A : formula) :
closed A -> closedfs (closure C A).
Proof.
apply closure_ind => {A}.
- by rewrite closure_closed_T.
- by move=> P ts clP; apply: closure_closed_Pred.
- move=> A B IHA IHB /= /[dup] clAB.
rewrite 2!closedfs_fsetU closedE => /andP [/IHA -> /IHB ->].
by rewrite closedfs1 2!andbT.
- move=> A IHA /[dup] clDA.
rewrite closedE closedfs_fsetU => /IHA ->.
by rewrite closedfs1 andbT.
- move=> x A IHA clxA.
rewrite closedfs_fsetU => /=.
apply/andP; split; first by rewrite closedfs1.
apply/allP => /= B /bigfcupP [c /andP [cinC _] BinclAc].
move: clxA; rewrite (closed_All _ _ c) => /IHA -/(_ cinC).
by move=> /allP /(_ B) /(_ BinclAc).
Qed.
Definition closurefs (C : consts) (fs : formulas) : formulas :=
\bigcup_(A <- fs) (closure C A).
Lemma closurefs_self (C : consts) (A : formula) (fs : formulas) :
A \in fs -> A \in closurefs C fs.
Proof.
move=> Ainfs; apply/bigfcupP => /=.
exists A.
by rewrite Ainfs.
by rewrite closure_self.
Qed.
Lemma closurefs_closed (C : consts) (fs : formulas) :
closedfs fs -> closedfs (closurefs C fs).
Proof.
move=> /allP /= clfs.
apply/allP => /= A /bigfcupP /= [B /andP [Binfs _] AinclosureB].
move: (clfs _ Binfs) => /closure_closed => /(_ C) /allP /= clclosureB.
by apply: clclosureB.
Qed.
Lemma closure_sub (A : formula) (x : VarName) (c : ConstName)
(C : consts) :
closure C A`[Var x <- Const c] =
[fset D`[Var x <- Const c] | D in closure C A].
Proof.
move: (leqnn (depth A)); move: {2}(depth _) => maxdepth.
elim: maxdepth A x c.
case=> //= x c.
by rewrite closure_eq fsetmap1.
by move=> P ts _; rewrite 2!closure_eq fsetmap2.
move=> maxdepth IHdepth; case => /=.
- by move=> *; rewrite closure_eq fsetmap1.
- by move=> *; rewrite 2!closure_eq fsetmap2.
- move=> A B x c /=; rewrite ltnS geq_max => /andP [leqAmax leqBmax].
rewrite closure_eq [in RHS]closure_eq.
by rewrite 2!fsetmapU fsetmap1 IHdepth // IHdepth.
- move=> A x c; rewrite ltnS => leqAmax.
rewrite closure_eq [in RHS]closure_eq.
by rewrite fsetmapU fsetmap1 IHdepth.
- move=> y A x c; rewrite ltnS => leqAmax.
rewrite [in RHS]closure_eq.
rewrite fsetmapU fsetmap1 /=.
rewrite fsetmap_bigfcup.
case: eqP => [[->] | neqyx]; rewrite closure_eq; congr fsetU.
apply/fsetP => /= B; apply/bigfcupP/bigfcupP => /=.
move=> [c' c'inCT] BinclAc'.
exists c' => //.
rewrite -IHdepth ?depth_sub //.
by rewrite sub_notfree ?notfv_sub.
move=> [c' c'inCT].
rewrite -IHdepth ?depth_sub //.
rewrite sub_notfree ?notfv_sub // => BinclAc'.
by exists c'.
have neqxy : x <> y by move=> eqxy; move: neqyx; rewrite eqxy.
apply/fsetP => /= B; apply/bigfcupP/bigfcupP => /=.
move=> [c' c'inCT].
rewrite sub_ConstC // IHdepth ?depth_sub // => Bincl.
by exists c'.
move=> [c' c'inCT Bin]; exists c' => //.
by rewrite sub_ConstC // IHdepth ?depth_sub.
Qed.
Lemma constantcount_closure (C : consts) (A : formula) :
constantcount A <= constantcountfs (closure C A)
<= constantcount A + quantifierdepth A.
Proof.
apply/andP; split.
by apply: leq_bigmax_list; apply: closure_self.
apply/bigmax_leqP_list => /=.
elim: A.
- by rewrite closure_eq /= addn0 => B /fset1P ->.
- by move=> P ts; rewrite closure_eq /= addn0 => B /fset2P [-> | ->].
- move=> A IHA B IHB; rewrite closure_eq => D /fsetUP[/fsetUP [/fset1P ->|]|].
+ by rewrite leq_addr.
+ move=> DinclA.
rewrite (leq_trans (IHA _ DinclA)) //.
apply: leq_add; last by rewrite leq_maxl.
by rewrite constantcount_Conjl.
+ move=> DinclB.
rewrite (leq_trans (IHB _ DinclB)) //.
apply: leq_add; last by rewrite leq_maxr.
by rewrite constantcount_Conjr.
- move=> A IHA; rewrite closure_eq => B /fsetUP [/fset1P -> | BinclA].
by rewrite leq_addr.
by rewrite constantcount_Diam /= IHA.
- move=> y A IHA; rewrite closure_eq => B /fsetUP [/fset1P -> |].
by rewrite leq_addr.
move=> /bigfcupP [c /andP [cinC _]].
rewrite closure_sub => /imfsetP /= [B' B'inclA ->].
have /andP [_ leq_ccB'c] := constantcount_sub y c B'.
rewrite (leq_trans leq_ccB'c) // addnS ltnS.
by rewrite (leq_trans (IHA _ B'inclA)).
Qed.
Lemma constantcount_closurefs (C : consts) (fs : formulas) :
constantcountfs fs <= constantcountfs (closurefs C fs)
<= constantcountfs fs + quantifierdepthfs fs.
Proof.
rewrite /constantcountfs /quantifierdepthfs; apply/andP; split.
apply /bigmax_leqP_list => A Ainfs.
by apply: leq_bigmax_list; apply: closurefs_self.
apply/bigmax_leqP_list => /= A /bigfcupP /= [B /andP [Binfs _] AinclB].
have /andP [_] := constantcount_closure C B.
rewrite /constantcountfs => /bigmax_leqP_list /(_ A) /(_ AinclB) leqAB.
by rewrite (leq_trans leqAB) // leq_add //; apply: leq_bigmax_list.
Qed.
Lemma closureT (C : consts) (A : formula) :
(exists c, c \in C) ->
T sig \in closure C A.
Proof.
move=> [c cinC].
apply closure_ind => {A}.
- by rewrite inE.
- by move=> *; rewrite 2!inE.
- by move=> A B _ IHB; rewrite inE IHB orbT.
- by move=> A IHA; rewrite inE IHA orbT.
- move=> x A IHA; rewrite 2!inE /=.
apply/bigfcupP; exists c.
by rewrite cinC.
by apply: IHA.
Qed.
Lemma closureConjl (C : consts) (A B : formula) :
A \in closure C (A /\ B).
Proof. by rewrite closure_eq 2!inE closure_self orbT. Qed.
Lemma closureConjr (C : consts) (A B : formula) :
B \in closure C (A /\ B).
Proof. by rewrite closure_eq 2!inE closure_self orbT. Qed.
Lemma closureConj_in (C : consts) (A B D : formula) :
(A /\ B) \in closure C D -> A \in closure C D /\ B \in closure C D.
Proof.
apply closure_ind.
- by rewrite inE.
- by move=> P ts; rewrite 3!inE.
- move=> E F IHE IHF; rewrite 8!inE.
move=> /orP [| /IHF [-> ->]]; last by rewrite 2!orbT.
move=> /orP [/eqP [-> ->] | /IHE [-> ->]]; last by rewrite 2!orbT.
by rewrite 2!closure_self 2!orbT.
- by move=> E IHE; rewrite 5!inE => /= /IHE [-> ->]; rewrite 2!orbT.
- move=> x E IHE; rewrite 5!inE => /= /bigfcupP /= [c /andP [+ _]].
move=> /[dup] cinC /IHE /[apply] -[AinclEc BinclEc].
by split; apply/orP; right; apply/bigfcupP; exists c; rewrite ?cinC.
Qed.
Lemma closureConj_inl (C : consts) (A B D : formula) :
(A /\ B) \in closure C D -> A \in closure C D.
Proof. by move=> /closureConj_in []. Qed.
Lemma closureConj_inr (C : consts) (A B D : formula) :
(A /\ B) \in closure C D -> B \in closure C D.
Proof. by move=> /closureConj_in []. Qed.
Lemma closureDiam (C : consts) (A : formula) :
A \in closure C (<> A).
Proof. by rewrite closure_eq inE closure_self orbT. Qed.
Lemma substitution_closureAll (C : consts) (c : ConstName) (x : VarName)
(A : formula) :
c \in C -> A`[Var x <- Const c] \in closure C (All x A).
Proof.
move=> cinC; rewrite closure_eq.
apply/fset1UP; right.
apply/bigfcupP; exists c; first by rewrite cinC.
by apply: closure_self.
Qed.
Lemma closurefs_fsetU (C : consts) (fs1 fs2 : formulas) :
closurefs C (fs1 `|` fs2) = (closurefs C fs1) `|` (closurefs C fs2).
Proof.
rewrite /closurefs big_fsetU //=.
by move=> X; rewrite fsetUid.
Qed.
Lemma closure_idempotent (C : consts) (A : formula) :
closurefs C (closure C A) = closure C A.
Proof.
apply closure_ind => {A}.
- by rewrite /closurefs big_seq_fset1 closure_eq.
- move=> P ts.
apply/fsetP => /= A; apply/bigfcupP/fset2P => /=.
move=> [B]; rewrite 3!inE => /orP [/orP [/eqP -> | /eqP ->] | //].
by rewrite closure_eq inE => /eqP ->; left.
by rewrite closure_eq => /fset2P.
move=> [-> | ->].
exists (T sig).
by rewrite 2!inE eqxx.
by rewrite closure_eq inE.
exists (Pred ts).
by rewrite 3!inE eqxx orbT.
by rewrite closure_eq 3!inE eqxx orbT.
- move=> A B IHA IHB.
rewrite 2!closurefs_fsetU IHA IHB.
rewrite /closurefs big_seq_fset1 closure_eq.
by rewrite -fsetUA -[_ |` _ `|` _]fsetUA -fsetUA fsetUid.
- move=> A IHA.
rewrite closurefs_fsetU IHA.
rewrite /closurefs big_seq_fset1 closure_eq.
by rewrite -fsetUA fsetUid.
- move=> x A IHA.
rewrite closurefs_fsetU.
rewrite {1}/closurefs big_seq_fset1 closure_eq.
rewrite -fsetUA.
suff /fsetUidPl -> :
closurefs C (\bigcup_(c <- C) closure C A`[Var x <- Const c])
`<=` \bigcup_(c <- C) closure C A`[Var x <- Const c]
by [].
apply/bigfcupsP => /= B /bigfcupP [c /andP [cinC _] BinclAc _].
apply/fsubsetP => /= E EinclB.
apply/bigfcupP.
exists c; first by rewrite cinC.
rewrite -IHA //.
apply/bigfcupP => /=.
by exists B; first by rewrite BinclAc.
Qed.
Lemma closure_closure (C : consts) (A B : formula) :
A \in closure C B -> closure C A `<=` closure C B.
Proof.
move=> AinclB.
rewrite -[closure _ B]closure_idempotent.
by apply: bigfcup_sup.
Qed.
Lemma closure_closurefs (C : consts) (A : formula) (fs : formulas) :
A \in closurefs C fs -> closure C A `<=` closurefs C fs.
Proof.
move=> /bigfcupP /= [B /andP [Binfs _] AinclB].
apply: (fsubset_trans (closure_closure AinclB)).
by apply: bigfcup_sup.
Qed.
Lemma closurefsDiam (C : consts) (A : formula) (fs : formulas) :
<> A \in closurefs C fs -> A \in closurefs C fs.
Proof.
move=> /closure_closurefs /fsubsetP.
by apply; apply: closureDiam.
Qed.
Lemma substitution_closurefs (C : consts) (x : VarName) (A : formula)
(c : ConstName) (fs : formulas) :
c \in C ->
All x A \in closurefs C fs ->
A`[Var x <- Const c] \in closurefs C fs.
Proof.
move=> cinC xAinclfs.
have /fsubsetP := closure_closurefs xAinclfs.
by apply; apply: substitution_closureAll.
Qed.
Lemma constantsfs_closure (C : consts) (A : formula) :
constantsfs (closure C A) `<=` C `|` constants A.
Proof.
elim: A.
- rewrite closure_eq /= fsetU0.
by rewrite /constantsfs big_seq_fsetE /= big_fset1 /= fsub0set.
- move=> P ts; rewrite closure_eq.
rewrite /constantsfs big_fsetU1 /=; last by rewrite inE.
by rewrite fset0U big_seq_fsetE /= big_fset1 /= fsubsetUr.
- move=> A /bigfcupsP /= IHA B /bigfcupsP /= IHB; rewrite closure_eq.
apply/bigfcupsP => /= D.
rewrite 3!inE => /orP [/orP [/eqP -> /= | DinclA] | DinclB] _.
+ by rewrite fsubsetUr.
+ apply: (fsubset_trans (IHA _ DinclA isT)).
by rewrite fsetUA fsubsetUl.
+ apply: (fsubset_trans (IHB _ DinclB isT)).
by rewrite [constants _ `|` _]fsetUC fsetUA fsubsetUl.
- move=> A /bigfcupsP /= IHA; rewrite closure_eq.
apply/bigfcupsP => /= B.
rewrite 2!inE => /orP [/eqP -> /= | BinclA] _.
by rewrite fsubsetUr.
by apply: IHA.
- move=> x A /bigfcupsP /= IHA; rewrite closure_eq.
apply/bigfcupsP => /= B.
rewrite 2!inE => /orP [/eqP -> /= | /bigfcupP [c /andP [cinC _] Bincl]] _.
by rewrite fsubsetUr.
have [BinclA | BnotinclA] := boolP (B \in closure C A).
by apply: IHA.
move: Bincl; rewrite closure_sub => /imfsetP /= [B' B'inclA ->].
rewrite constants_sub_Const.
case: ifP => _; last by apply: IHA.
rewrite fsubUset IHA // andbT.
by apply: fsubsetU; rewrite fsub1set cinC.
Qed.
Lemma constantsfs_closurefs (C : consts) (fs : formulas) :
constantsfs (closurefs C fs) `<=` C `|` constantsfs fs.
Proof.
apply/bigfcupsP =>/=A /bigfcupP/=[B /andP[Binfs _] /in_constantsfs subAclB] _.
apply: (fsubset_trans subAclB).
apply: (fsubset_trans (constantsfs_closure _ _)).
by apply: fsetUS; apply: in_constantsfs.
Qed.
End Formulas.