Print assn.
Implicit Types alpha beta : assn.
Fixpoint eval alpha s :=
match s with
|Var x ⇒ alpha x
|Imp s t ⇒ if eval alpha s then eval alpha t else true
|Fal ⇒ false
end.
Fixpoint satis alpha s :=
match s with
|Var x ⇒ if alpha x then True else False
|Imp s t ⇒ (satis alpha s) → (satis alpha t)
|Fal ⇒ False
end.
Notation "alpha 'vDash' s" := (satis alpha s) (at level 70).
(* Fact 11.1.1 *)
Lemma satis_eval alpha s :
satis alpha s ↔ eval alpha s = true.
Admitted.
(* Fact 11.1.2 *)
Instance satis_dec alpha s:
dec (alpha vDash s).
Admitted.
Definition sat s :=
∃ alpha, alpha vDash s.
(* Exercise 11.1.4 *)
Goal ∀ alpha s,
satis alpha (Not s) = ¬ satis alpha s.
Proof.
Abort.
(* Exercise 11.1.5 *)
Lemma satis_pos_imp alpha s t :
satis alpha (Imp s t) ↔ ¬ satis alpha s ∨ satis alpha t.
Admitted.
Lemma satis_neg_imp alpha s t :
¬ satis alpha (Imp s t) ↔ satis alpha s ∧ ¬ satis alpha t.
Admitted.
Goal ∀ alpha s,
alpha vDash Not s ↔ ¬ alpha vDash s.
Abort.
Goal ∀ alpha x,
alpha vDash Var x ↔ alpha x = true.
Abort.
Goal ∀ alpha x,
alpha vDash Not (Var x) ↔ alpha x = false.
Abort.
(* Exercise 11.1.6 *)
Goal ∀ X (dec_X : dec X) (Y: Prop),
(X → Y) ↔ if (decision X) then Y else True.
Abort.
Goal ∀ X (dec_X : dec X) (Y: Prop),
(X ∧ Y) ↔ if (decision X) then Y else False.
Abort.
Goal ∀ X (dec_X : dec X) (Y: Prop),
(X ∨ Y) ↔ if (decision X) then True else Y.
Abort.
Definition valid (s: form) :=
∀ alpha, alpha vDash s.
(* Fact 11.2.1 *)
Lemma valid_unsat s :
valid s ↔ ¬ ∃ alpha, satis alpha (Not s).
Admitted.
Inductive hilc (A : context) : form → Prop :=
| hilcA s : s el A → hilc A s
| hilcK s t : hilc A (FK s t)
| hilcS s t u : hilc A (FS s t u)
| hilcC s : hilc A (Imp (Not (Not s)) s)
| hilcMP s t : hilc A (Imp s t) → hilc A s → hilc A t.
(* Fact 11.2.2 *)
Goal ∀ s,
hilc [] s → valid s.
Admitted.
Fixpoint satis_list alpha A :=
match A with
|[] ⇒ True
|s :: A ⇒ alpha vDash s ∧ satis_list alpha A
end.
Lemma satis_list_iff alpha A:
satis_list alpha A ↔ ∀ s, s el A → alpha vDash s.
Proof.
induction A; simpl in *; split; intros; intuition; congruence.
Qed.
Definition bent A s :=
∀ alpha, satis_list alpha A → satis alpha s.
(* Fact 11.2.3 *)
Lemma ndc_bent A s :
ndc A s → bent A s.
Admitted.
Inductive sform : Type :=
|Pos: form → sform
|Neg: form → sform.
Notation "+ s" := (Pos s) (at level 35).
Notation "- s" := (Neg s).
Definition clause := list sform.
Implicit Types S T : sform.
Implicit Types C D : clause.
Instance sform_eq_dec S T : dec (S = T).
Proof.
unfold dec. repeat decide equality.
Qed.
Definition uns S : form :=
match S with +s ⇒ s | -s ⇒ Not s end.
Fixpoint satisc alpha C : Prop :=
match C with
| nil ⇒ True
| T::C' ⇒ satis alpha (uns T) ∧ satisc alpha C'
end.
Definition satc C :=
∃ alpha, satisc alpha C.
Definition cent C D :=
∀ alpha, satisc alpha C → satisc alpha D.
(* Exercise 11.3.1 *)
Lemma satisc_iff alpha C :
satisc alpha C ↔ ∀ s, s el C → alpha vDash (uns s).
Proof.
induction C as [|s C].
- split; intros; simpl in *; intuition.
- simpl. intuition; congruence.
Qed.
Lemma satisc_weak C D alpha:
C <<= D → satisc alpha D → satisc alpha C.
Admitted.
Lemma satc_weak C D:
C <<= D → satc D → satc C.
Admitted.
Lemma satc_clash s C:
+s el C → -s el C → ¬ satc C.
Admitted.
Lemma cent_sub C D:
C <<= D → cent D C.
Admitted.
Lemma cent_trans C D E:
cent C D → cent D E → cent C E.
Admitted.
Lemma cent_satc C D:
cent C D → satc C → satc D.
Admitted.
Definition svar S : Prop :=
match S with
| +Var _ | -Var _ ⇒ True
| _ ⇒ False
end.
Definition solved C : Prop :=
(∀ S, S el C → svar S) ∧ ∀ x, +Var x el C → ¬ -Var x el C.
Definition phi C x := if decision (+Var x el C) then true else false.
(* Exercise 11.4.2 *)
Lemma solved_phi C :
solved C → satisc (phi C) C.
Admitted.
Lemma solved_sat C:
solved C → satc C.
Admitted.
Lemma solved_pos_var x C :
solved C → ¬ -Var x el C → solved (+Var x :: C).
Admitted.
Lemma solved_neg_var x C :
solved C → ¬ +Var x el C → solved (-Var x :: C).
Admitted.
Lemma solved_nil:
solved nil.
Admitted.
Fixpoint sizeF s : nat :=
match s with
| Imp s1 s2 ⇒ 1 + sizeF s1 + sizeF s2
| _ ⇒ 1
end.
Fixpoint size C : nat :=
match C with
| nil ⇒ 0
| +s::C' ⇒ sizeF s + size C'
| -s::C' ⇒ sizeF s + size C'
end.
Inductive rec C : clause → Type :=
| recNil : rec C nil
| recPF D : rec C (+Fal :: D)
| recNF D : rec C D → rec C (-Fal ::D)
| recPV D x : -Var x el C → rec C (+Var x :: D)
| recPV' D x : ¬ -Var x el C → rec (+Var x :: C) D → rec C (+Var x :: D)
| recNV D x : +Var x el C → rec C (-Var x :: D)
| recNV' D x : ¬ +Var x el C → rec (-Var x :: C) D → rec C (-Var x :: D)
| recPI D s t : rec C (-s :: D) → rec C (+t :: D) → rec C (+Imp s t :: D)
| recNI D s t : rec C (+s :: -t :: D) → rec C (-Imp s t :: D).
Lemma provider C D: rec C D.
Proof.
revert C. pattern D. revert D. apply (size_recursion size).
intros [|[[x | s t |] | [x|s t | ]] D] IH C.
- constructor.
- decide (-Var x el C) as [H|H].
+ now constructor.
+ apply recPV'; [assumption| ]. apply IH; simpl; omega.
- apply recPI; apply IH; simpl; omega.
- constructor.
- decide (+Var x el C) as [H|H].
+ now constructor.
+ apply recNV'; [assumption| ]. apply IH; simpl; omega.
- apply recNI; apply IH; simpl; omega.
- constructor. apply IH; simpl; omega.
Qed.
Lemma rec_sat_dec C D:
solved C → rec C D → dec (satc (D ++ C)).
Proof.
intros A H. induction H.
- left. now apply solved_sat.
- right. intros [alpha H]. simpl in ×. intuition.
- destruct (IHrec A) as [IH|IH].
+ left. destruct IH as [alpha IH]. ∃ alpha. simpl. auto.
+ right. intros [alpha B]. apply IH. ∃ alpha. simpl in ×. intuition.
- right. apply satc_clash with (s := Var x); auto.
- destruct (IHrec (solved_pos_var A n)) as [IH|IH].
+ left. apply satc_weak with (D := D ++ + Var x :: C); auto.
+ right. contradict IH. apply satc_weak with (D := (+ Var x :: D) ++ C); auto.
- right. apply satc_clash with (s := Var x); auto.
- destruct (IHrec (solved_neg_var A n)) as [IH|IH].
+ left. apply satc_weak with (D := D ++ - Var x :: C); auto.
+ right. contradict IH. apply satc_weak with (D := (- Var x :: D) ++ C); auto.
- destruct (IHrec1 A) as [IH|IH].
+ left. destruct IH as [alpha IH]. ∃ alpha. simpl in ×. intuition.
+ destruct (IHrec2 A) as [IH' |IH'].
× left. destruct IH' as [alpha IH']. ∃ alpha. simpl in ×. intuition.
× right. intros [alpha [B1 B2]]. simpl in ×. apply IH. ∃ alpha. split; [|assumption].
intros E. apply IH'. ∃ alpha. split; simpl; auto.
- destruct (IHrec A) as [IH|IH].
+ left. destruct IH as [alpha IH]. ∃ alpha. simpl in ×. intuition.
+ right. contradict IH. destruct IH as [alpha IH]. ∃ alpha.
simpl in ×. intuition. decide (alpha vDash s).
× assumption.
× exfalso. apply H0. contradiction.
Qed.
(* Lemma 11.8.1 *)
Instance dec_satc C :
dec (satc C).
Proof.
enough (H: dec (satc (C ++ nil))).
{ revert H. now simpl_list. }
apply rec_sat_dec.
- apply solved_nil.
- apply provider.
Qed.
Lemma satisc_satis_list alpha C:
satisc alpha C ↔ satis_list alpha (map uns C).
Proof.
induction C; [reflexivity|].
simpl. now rewrite IHC.
Qed.
Lemma rec_sat_ndc C D:
solved C → rec C D → {satc (D ++ C)} + {ndc (map uns (D ++ C)) Fal}.
Proof.
intros A H. induction H.
- left. now apply solved_sat.
- right. simpl. apply ndcA. auto.
- destruct (IHrec A) as [IH|IH].
+ left. destruct IH as [alpha IH]. ∃ alpha. simpl. auto.
+ right. simpl. now apply ndc_W.
- right. simpl. apply ndcIE with (s := Var x).
+ apply ndcA. right. apply in_map_iff.
∃ (- Var x). split.
× reflexivity.
× apply in_app_iff. now right.
+ apply ndcA. auto.
- simpl.
destruct (IHrec (solved_pos_var A n)) as [B | B].
+ left. apply satc_weak with (D := D ++ + Var x :: C); auto.
+ right. apply ndc_weak with (A := map uns (D ++ + Var x :: C)); auto.
rewrite !map_app. simpl. auto.
- right. simpl. apply ndcIE with (s := Var x).
+ apply ndcA. auto.
+ apply ndcA. right. rewrite map_app, in_app_iff.
right. apply in_map_iff. ∃ (+ Var x); auto.
- simpl. destruct (IHrec (solved_neg_var A n)) as [B|B].
+ left. apply satc_weak with (D := D ++ - Var x :: C); auto.
+ right. apply ndc_weak with (A := map uns (D ++ - Var x :: C)); auto.
rewrite !map_app. simpl. auto.
- destruct (IHrec1 A).
+ simpl in ×. left. destruct s0 as [alpha IH]. ∃ alpha. simpl in ×.
intuition.
+ destruct (IHrec2 A) as [B|B].
× left. destruct B as [alpha B]. ∃ alpha. simpl in ×. intuition.
× right. simpl in ×. apply ndcIE with (s := Not s).
{ apply ndcII. apply ndc_weak with (A := Not s :: map uns (D ++ C)); auto. }
{ apply ndcII. apply ndcIE with (s := t).
- apply ndcII. apply ndc_weak with (A := t :: map uns (D ++ C)); auto.
- apply ndcIE with (s := s); apply ndcA; auto. }
- destruct (IHrec A) as [B|B].
+ left. destruct B as [alpha B]. ∃ alpha. simpl in ×. intuition.
+ right. simpl in ×. apply ndcIE with (s := Imp s t).
× apply ndcA. auto.
× apply ndcII. apply ndcC.
apply ndc_weak with (A := s :: Not t :: map uns (D ++ C)); auto 6.
Qed.
Lemma sat_ndc C:
{satc C} + {ndc (map uns C) Fal}.
Proof.
enough ({satc (C ++ nil)} + {ndc (map uns (C ++ nil)) Fal }).
- revert H. now simpl_list.
- apply rec_sat_ndc. apply solved_nil. apply provider.
Qed.
Lemma fal_unsat C:
ndc (map uns C) Fal ↔ ¬ satc C.
Proof.
split.
- intros H [alpha A]. apply ndc_bent in H.
apply H with (alpha := alpha). now rewrite <- satisc_satis_list.
- destruct (sat_ndc C); congruence.
Qed.
Lemma ndc_refute A s:
ndc A s ↔ ndc (Not s :: A) Fal.
Proof.
split.
- intros H. apply ndcIE with (s := s).
+ apply ndcA. auto.
+ apply ndc_weak with (A := A); auto.
- intros H. now apply ndcC.
Qed.
Lemma map_pos alpha A:
satis_list alpha A ↔ satisc alpha (map Pos A).
Proof.
induction A; simpl in ×.
- reflexivity.
- rewrite IHA. reflexivity.
Qed.
Lemma map_uns alpha C:
satisc alpha C ↔ satis_list alpha (map uns C).
Proof.
induction C; simpl in *; intuition.
Qed.
Lemma bent_iff_unsat A s :
bent A s ↔ ¬ satc (- s :: map Pos A).
Proof.
unfold satc, bent. split.
- intros D [alpha [H1 H2]]. rewrite <- map_pos in H2. simpl in ×. now apply H1, D.
- intros H alpha H'. decide (alpha vDash s).
+ assumption.
+ exfalso. apply H. ∃ alpha. split.
× assumption.
× now rewrite <- map_pos.
Qed.
Instance bent_dec A s:
dec (bent A s).
Proof.
decide (¬ satc (- s :: map Pos A)) as [H|H].
- left. now apply bent_iff_unsat.
- right. now rewrite bent_iff_unsat.
Qed.
Lemma cancel_uns_pos A :
map uns (map Pos A) = A.
Proof.
induction A; simpl; congruence.
Qed.
Lemma ndc_iff_sem A s :
ndc A s ↔ bent A s.
Proof.
rewrite bent_iff_unsat. rewrite ndc_refute.
rewrite <- fal_unsat. simpl. now rewrite cancel_uns_pos.
Qed.
Instance dec_ndc A s:
dec (ndc A s).
Proof.
decide (bent A s) as [H|H].
- left. now apply ndc_iff_sem.
- right. now rewrite ndc_iff_sem.
Qed.
Record ref_pred (rho : clause → Prop) :=
{ ref_Fal : ∀ C, +Fal el C → rho C;
ref_weak : ∀ C C', C <<= C' → rho C → rho C';
ref_clash : ∀ x C, +Var x el C → -Var x el C → rho C;
ref_pos_imp : ∀ s t C, rho (-s::C) → rho (+t::C) → rho (+Imp s t::C);
ref_neg_imp : ∀ s t C, rho (+s::-t::C) → rho (-Imp s t::C);
ref_sound : ∀ C, rho C → ¬ satc C }.
(* Lemma 11.10.1 *)
Lemma ref_pred_unsat :
ref_pred (fun C ⇒ ¬ satc C).
Proof.
split.
- intros C H [alpha A]. rewrite satisc_iff in A. exact (A _ H).
- intros C C' A B. contradict B. now apply satc_weak with (D := C').
- intros x C H H0. now apply satc_clash with (s := Var x).
- intros s t C A B [alpha [E F]]. apply satis_pos_imp in E as [E|E].
+ apply A. ∃ alpha. simpl. auto.
+ apply B. ∃ alpha. simpl. auto.
- intros s t C A [alpha [E F]]. apply A. ∃ alpha. simpl in ×.
apply satis_neg_imp in E as [E G]. auto.
- auto.
Qed.
(* Lemma 11.10.2 *)
Lemma ref_ndc :
ref_pred (fun C ⇒ ndc (map uns C) Fal).
Proof.
split; simpl.
- intros C A. apply ndcA. exact (in_map uns _ _ A).
- intros C C' A. apply ndc_weak. apply incl_map, A.
- intros x C A B. apply ndcIE with (s:=Var x) ; apply ndcA.
+ exact (in_map uns _ _ B).
+ exact (in_map uns _ _ A).
- intros s t C A B. apply ndcIE with (s:= Not s).
+ apply ndc_W, ndcII, A.
+ apply ndcII. apply ndcIE with (s:=t).
× apply ndc_W, ndc_W, ndcII, B.
× apply ndcIE with (s:=s) ; apply ndcA ; auto.
- intros s t C A. apply ndcIE with (s:= Imp s t).
+ apply ndcA ; auto.
+ apply ndcII, ndc_explosion. apply ndcIE with (s:= Not t).
× { apply ndcIE with (s:= s).
- apply ndc_W, ndc_W, ndcII, ndcII. revert A. apply ndc_weak. firstorder.
- apply ndcA ; auto. }
× { apply ndcII. apply ndcIE with (s:= Imp s t).
- apply ndcA ; auto.
- apply ndcII, ndcA ; auto. }
- intros C F [alpha G].
apply ndc_bent in F. apply (F alpha).
now rewrite <- map_uns.
Qed.
(* Lemma 11.10.3 *)
Lemma Refutation' rho (ref: ref_pred rho) C D:
solved C → rec C D → {satc (D ++ C)} + {rho (D ++ C)}.
Proof.
intros A H. induction H.
- left. now apply solved_sat.
- right. apply ref_Fal; auto.
- destruct (IHrec A) as [IH|IH].
+ left. destruct IH as [alpha IH]. ∃ alpha. simpl. auto.
+ right. apply ref_weak with (C := D ++ C); auto.
- right. apply ref_clash with (x := x); auto.
- destruct (IHrec (solved_pos_var A n)) as [IH|IH].
+ left. apply satc_weak with (D := D ++ + Var x :: C); auto.
+ right. apply ref_weak with (C := D ++ + Var x :: C); auto.
- right. apply ref_clash with (x := x); auto.
- destruct (IHrec (solved_neg_var A n)) as [IH|IH].
+ left. apply satc_weak with (D := D ++ - Var x :: C); auto.
+ right. apply ref_weak with (C := D ++ - Var x :: C); auto.
- destruct (IHrec1 A) as [IH|IH].
+ left. destruct IH as [alpha IH]. ∃ alpha. simpl in ×. intuition.
+ destruct (IHrec2 A) as [IH'|IH'].
× left. destruct IH' as [alpha IH']. ∃ alpha. simpl in ×. intuition.
× right. simpl. apply ref_pos_imp; auto.
- destruct (IHrec A) as [IH|IH].
+ left. destruct IH as [alpha IH]. ∃ alpha. simpl in ×. intuition.
+ right. simpl. apply ref_neg_imp; auto.
Qed.
Lemma Refutation rho (ref: ref_pred rho) C:
{satc C} + {rho C}.
Proof.
enough ({satc (C ++ nil)} + {rho (C ++ nil)}).
{ revert H. now simpl_list. }
apply (Refutation' ref).
- apply solved_nil.
- apply provider.
Qed.
(* Lemma 11.10.4 *)
Lemma ref_unsat rho (ref: ref_pred rho) C:
rho C ↔ ¬ satc C.
Proof.
specialize (Refutation ref C);
specialize (ref_sound ref (C := C));
tauto.
Qed.
(* Lemma 11.10.5 *)
Instance dec_ref_pred rho (ref: ref_pred rho) C:
dec (rho C).
Proof.
destruct (Refutation ref C) as [H|H].
- right. intros A. revert H.
change (¬ satc C).
now rewrite <- (ref_unsat ref).
- now left.
Qed.